--- /dev/null
+name: email-validator
+version: 0.0.1
+cabal-version: >= 1.8
+author: Michael Orlitzky
+maintainer: Michael Orlitzky <michael@orlitzky.com>
+synopsis:
+ Perform basic syntax and deliverability checks on email addresses.
+build-type: Simple
+
+
+executable email_validator
+ build-depends:
+ base == 4.*,
+ dns == 0.3.*,
+ HUnit == 1.2.*,
+ QuickCheck == 2.6.*,
+ regex-pcre == 0.94.*,
+ test-framework == 0.8.*,
+ test-framework-hunit == 0.3.*,
+ test-framework-quickcheck2 == 0.3.*,
+ utf8-string == 0.3.*
+
+ main-is:
+ Main.hs
+
+ hs-source-dirs:
+ src/
+
+ ghc-options:
+ -Wall
+ -fwarn-hi-shadowing
+ -fwarn-missing-signatures
+ -fwarn-name-shadowing
+ -fwarn-orphans
+ -fwarn-type-defaults
+ -fwarn-tabs
+ -fwarn-incomplete-record-updates
+ -fwarn-monomorphism-restriction
+ -fwarn-unused-do-bind
+ -funbox-strict-fields
+ -fexcess-precision
+ -fno-spec-constr-count
+ -rtsopts
+ -threaded
+ -optc-O3
+ -optc-march=native
+ -O2
+
+ ghc-prof-options:
+ -prof
+ -auto-all
+ -caf-all
+
+
+test-suite testsuite
+ type: exitcode-stdio-1.0
+ hs-source-dirs: src test
+ main-is: TestSuite.hs
+ build-depends:
+ base == 4.*,
+ dns == 0.3.*,
+ HUnit == 1.2.*,
+ QuickCheck == 2.6.*,
+ regex-pcre == 0.94.*,
+ test-framework == 0.8.*,
+ test-framework-hunit == 0.3.*,
+ test-framework-quickcheck2 == 0.3.*,
+ utf8-string == 0.3.*
+
+ -- It's not entirely clear to me why I have to reproduce all of this.
+ ghc-options:
+ -Wall
+ -fwarn-hi-shadowing
+ -fwarn-missing-signatures
+ -fwarn-name-shadowing
+ -fwarn-orphans
+ -fwarn-type-defaults
+ -fwarn-tabs
+ -fwarn-incomplete-record-updates
+ -fwarn-monomorphism-restriction
+ -fwarn-unused-do-bind
+ -funbox-strict-fields
+ -fexcess-precision
+ -fno-spec-constr-count
+ -rtsopts
+ -threaded
+ -optc-O3
+ -optc-march=native
+ -O2
+
+source-repository head
+ type: git
+ location: http://michael.orlitzky.com/git/email-validator.git
+ branch: master
--- /dev/null
+BIN = dist/build/email_validator/email_validator
+TESTSUITE_BIN = dist/build/testsuite/testsuite
+
+.PHONY : test
+
+$(BIN): src/*.hs
+ runghc Setup.hs clean
+ runghc Setup.hs configure --user
+ runghc Setup.hs build
+
+profile: src/*.hs
+ runghc Setup.hs clean
+ runghc Setup.hs configure --user --enable-executable-profiling
+ runghc Setup.hs build
+
+clean:
+ runghc Setup.hs clean
+
+
+$(TESTSUITE_BIN): src/*.hs test/TestSuite.hs
+ runghc Setup.hs configure --user --flags=${FLAGS} --enable-tests
+ runghc Setup.hs build
+
+test: $(BIN) $(TESTSUITE_BIN)
+ runghc Setup.hs test
+
+dist:
+ runghc Setup.hs configure
+ runghc Setup.hs sdist
--- /dev/null
+{-# LANGUAGE DoAndIfThenElse #-}
+
+module Main
+where
+
+import Control.Monad (filterM)
+import qualified Data.ByteString.UTF8 as BS
+import Network.DNS (
+ Domain,
+ Resolver,
+ ResolvConf(..),
+ defaultResolvConf,
+ makeResolvSeed,
+ withResolver)
+import Network.DNS.Lookup (lookupMX)
+import System.IO (hGetContents, hFlush, hPutStrLn, stdin, stdout)
+
+
+type Address = BS.ByteString
+
+resolv_conf :: ResolvConf
+resolv_conf = defaultResolvConf { resolvTimeout = 5 * 1000 * 1000 }
+
+validate_mx :: Resolver -> Domain -> IO Bool
+validate_mx resolver domain = do
+ result <- lookupMX resolver domain
+ case result of
+ Nothing -> return False
+ _ -> return True
+
+validate_syntax :: Address -> IO Bool
+validate_syntax address = do
+ return True
+
+utf8_split = undefined
+
+validate :: Resolver -> Address -> IO Bool
+validate resolver address = do
+ valid_syntax <- validate_syntax address
+ if valid_syntax then do
+ let domain = utf8_split address (BS.fromString "@")
+ validate_mx resolver domain
+ else do
+ return False
+
+empty_string :: BS.ByteString
+empty_string = BS.fromString ""
+
+main :: IO ()
+main = do
+ input <- hGetContents stdin
+
+ let addresses = BS.lines $ BS.fromString input
+ let nonempty_addresses = filter (/= empty_string) addresses
+
+ rs <- makeResolvSeed resolv_conf
+ withResolver rs $ \resolver -> do
+ good_addresses <- filterM (validate resolver) nonempty_addresses
+ let good_address_strings = map BS.toString good_addresses
+ mapM_ (hPutStrLn stdout) good_address_strings
+
+ hFlush stdout