From: Michael Orlitzky Date: Tue, 28 May 2013 21:04:08 +0000 (-0400) Subject: Initial commit, nothing working. X-Git-Tag: 0.0.2~15 X-Git-Url: http://gitweb.michael.orlitzky.com/?p=email-validator.git;a=commitdiff_plain;h=9c30c25bb499e843a40062e2bd1e118c515aa159 Initial commit, nothing working. --- 9c30c25bb499e843a40062e2bd1e118c515aa159 diff --git a/Setup.hs b/Setup.hs new file mode 100644 index 0000000..9a994af --- /dev/null +++ b/Setup.hs @@ -0,0 +1,2 @@ +import Distribution.Simple +main = defaultMain diff --git a/email-validator.cabal b/email-validator.cabal new file mode 100644 index 0000000..6bd5caf --- /dev/null +++ b/email-validator.cabal @@ -0,0 +1,94 @@ +name: email-validator +version: 0.0.1 +cabal-version: >= 1.8 +author: Michael Orlitzky +maintainer: Michael Orlitzky +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 diff --git a/makefile b/makefile new file mode 100644 index 0000000..4d37b72 --- /dev/null +++ b/makefile @@ -0,0 +1,29 @@ +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 diff --git a/src/Main.hs b/src/Main.hs new file mode 100644 index 0000000..3e99d0d --- /dev/null +++ b/src/Main.hs @@ -0,0 +1,62 @@ +{-# 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