src/Main.hs

   1 {-# LANGUAGE DoAndIfThenElse #-}
   2
   3 module Main
   4 where
   5
   6 import Control.Monad (filterM)
   7 import qualified Data.ByteString.UTF8 as BS
   8 import Network.DNS (
   9   Domain,
  10   Resolver,
  11   ResolvConf(..),
  12   defaultResolvConf,
  13   makeResolvSeed,
  14   withResolver)
  15 import Network.DNS.Lookup (lookupMX)
  16 import System.IO (hGetContents, hFlush, hPutStrLn, stdin, stdout)
  17
  18
  19 type Address = BS.ByteString
  20
  21 resolv_conf ::  ResolvConf
  22 resolv_conf = defaultResolvConf { resolvTimeout = 5 * 1000 * 1000 }
  23
  24 validate_mx :: Resolver -> Domain -> IO Bool
  25 validate_mx resolver domain = do
  26   result <- lookupMX resolver domain
  27   case result of
  28       Nothing -> return False
  29       _       -> return True
  30
  31 validate_syntax :: Address -> IO Bool
  32 validate_syntax address = do
  33   return True
  34
  35 utf8_split = undefined
  36
  37 validate :: Resolver -> Address -> IO Bool
  38 validate resolver address = do
  39   valid_syntax <- validate_syntax address
  40   if valid_syntax then do
  41     let domain = utf8_split address (BS.fromString "@")
  42     validate_mx resolver domain
  43   else do
  44     return False
  45
  46 empty_string :: BS.ByteString
  47 empty_string = BS.fromString ""
  48
  49 main :: IO ()
  50 main = do
  51   input <- hGetContents stdin
  52
  53   let addresses = BS.lines $ BS.fromString input
  54   let nonempty_addresses = filter (/= empty_string) addresses
  55
  56   rs <- makeResolvSeed resolv_conf
  57   withResolver rs $ \resolver -> do
  58     good_addresses <- filterM (validate resolver) nonempty_addresses
  59     let good_address_strings = map BS.toString good_addresses
  60     mapM_ (hPutStrLn stdout) good_address_strings
  61
  62   hFlush stdout