diff --git a/bun.lockb b/bun.lockb index c42d05c..7e7e2ea 100755 Binary files a/bun.lockb and b/bun.lockb differ diff --git a/package.json b/package.json index e446309..cfb546a 100644 --- a/package.json +++ b/package.json @@ -14,5 +14,5 @@ "peerDependencies": { "typescript": "^5.0.0" }, - "dependencies": {} + "dependencies": { "qed-mail": "^1.0.2" } } diff --git a/spago.yaml b/spago.yaml index a8c16f6..b91fb81 100644 --- a/spago.yaml +++ b/spago.yaml @@ -1,19 +1,25 @@ package: dependencies: - - prelude - aff + - aff-promise + - console - effect - either - - maybe - foldable-traversable - - console + - maybe - newtype + - nullable + - prelude - strings - stringutils - transformers - tuples - typelevel-prelude name: project + test: + dependencies: + - spec + main: Test.Main workspace: extra_packages: {} package_set: diff --git a/src/Data.Email.purs b/src/Data.Email.purs new file mode 100644 index 0000000..d36ffee --- /dev/null +++ b/src/Data.Email.purs @@ -0,0 +1,43 @@ +module Data.Email (Email, parse, toString, username, domain) where + +import Prelude + +import Control.Monad.Error.Class (throwError) +import Data.Array as Array +import Data.Either (Either) +import Data.Maybe (fromMaybe) +import Data.Newtype (wrap) +import Data.String as String +import Data.String.Regex as Regex +import Data.String.Regex.Flags as Regex.Flag + +-- | An email address +data Email = Email String + +instance Show Email where + show (Email e) = "(Email " <> e <> ")" + +instance Eq Email where + eq (Email a) (Email b) = a == b + +-- | https://emailregex.com/ +regex :: String +regex = """^(([^<>()\[\]\\.,;:\s@"]+(\.[^<>()\[\]\\.,;:\s@"]+)*)|(".+"))@((\[[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}\.[0-9]{1,3}])|(([a-zA-Z\-0-9]+\.)+[a-zA-Z]{2,}))$""" + +toString :: Email -> String +toString (Email e) = e + +-- | Username portion of the email address +username :: Email -> String +username (Email raw) = fromMaybe "" $ Array.head $ String.split (wrap "@") raw + +-- | Domain portion of the email address +domain :: Email -> String +domain (Email raw) = fromMaybe "" $ Array.last $ String.split (wrap "@") raw + +-- | Parse a string as an email address +parse :: String -> Either String Email +parse raw = do + re <- Regex.regex regex Regex.Flag.noFlags + when (not $ Regex.test re raw) $ throwError $ "Email address invalid: <" <> raw <> ">" + pure $ Email raw diff --git a/src/Effect.Email.js b/src/Effect.Email.js new file mode 100644 index 0000000..444eda2 --- /dev/null +++ b/src/Effect.Email.js @@ -0,0 +1,4 @@ +import { checkEmail } from 'qed-mail' + +/** @type {(_: string) => () => Promise} */ +export const checkEmailImpl = s => () => checkEmail(s) diff --git a/src/Effect.Email.purs b/src/Effect.Email.purs new file mode 100644 index 0000000..be425ea --- /dev/null +++ b/src/Effect.Email.purs @@ -0,0 +1,79 @@ +module Effect.Email (EmailError(..), emailErrorToString, deliverable) where + +import Prelude + +import Control.Monad.Cont (lift) +import Control.Monad.Error.Class (throwError) +import Control.Monad.Except (ExceptT) +import Control.Promise (Promise) +import Control.Promise as Promise +import Data.Array as Array +import Data.Email (Email) +import Data.Email as Email +import Data.Eq.Generic (genericEq) +import Data.Generic.Rep (class Generic) +import Data.Maybe (maybe) +import Data.Nullable (Nullable) +import Data.Nullable as Nullable +import Data.Show.Generic (genericShow) +import Data.Traversable (for_) +import Effect (Effect) +import Effect.Aff (Aff) +import Type.Function (type ($)) + +foreign import checkEmailImpl :: String -> Effect $ Promise $ QEDResult + +data EmailError + = EmailUnreachable Email + | EmailSyntaxInvalid Email + | EmailMXInvalid Email + | EmailMXNoRecords Email + | EmailSMTPInvalid Email + | EmailSMTPError Email String + +emailErrorToString :: EmailError -> String +emailErrorToString (EmailUnreachable e) = "Email <" <> Email.toString e <> "> is unreachable" +emailErrorToString (EmailSyntaxInvalid e) = "Email <" <> Email.toString e <> "> is invalid" +emailErrorToString (EmailMXInvalid e) = "Email <" <> Email.toString e <> "> domain has invalid MX record" +emailErrorToString (EmailMXNoRecords e) = "Email <" <> Email.toString e <> "> domain has no MX records" +emailErrorToString (EmailSMTPInvalid e) = "Email <" <> Email.toString e <> "> domain has invalid SMTP configuration" +emailErrorToString (EmailSMTPError e err) = "Email <" <> Email.toString e <> "> encountered SMTP error: " <> err + +derive instance Generic EmailError _ +instance Eq EmailError where + eq = genericEq + +instance Show EmailError where + show = genericShow + +type QEDResult = + { email :: String + , reachable :: Boolean + , syntax :: + { valid :: Boolean + , username :: Nullable String + , domain :: Nullable String + } + , mx :: + { valid :: Boolean + , mxRecords :: Nullable $ Array { priority :: Number, exchange :: String } + } + , smtp :: + { valid :: Boolean + , error :: Nullable String + } + } + +deliverable :: Email -> ExceptT EmailError Aff Email +deliverable email' = do + let email = Email.toString email' + + { reachable, syntax, mx, smtp } <- lift $ Promise.toAffE $ checkEmailImpl email + when (not reachable) $ throwError $ EmailUnreachable email' + when (not syntax.valid) $ throwError $ EmailSyntaxInvalid email' + when (not mx.valid) $ throwError $ EmailMXInvalid email' + when (not smtp.valid) $ throwError $ EmailSMTPInvalid email' + when (maybe true Array.null $ Nullable.toMaybe $ mx.mxRecords) $ throwError $ EmailMXNoRecords email' + for_ (Nullable.toMaybe $ smtp.error) $ throwError <<< EmailSMTPError email' + + pure email' diff --git a/test/Test.Main.purs b/test/Test.Main.purs new file mode 100644 index 0000000..07d2c87 --- /dev/null +++ b/test/Test.Main.purs @@ -0,0 +1,77 @@ +module Test.Main where + +import Prelude + +import Control.Monad.Error.Class (class MonadThrow, liftEither, throwError, try) +import Control.Monad.Except (runExceptT) +import Data.Bifunctor (lmap) +import Data.Either (Either(..), isRight) +import Data.Email (Email) +import Data.Email as Email +import Data.Traversable (for_) +import Data.Tuple.Nested ((/\)) +import Effect (Effect) +import Effect.Aff (launchAff_) +import Effect.Email as Effect.Email +import Effect.Exception (Error, error) +import Test.Spec (describe, it) +import Test.Spec.Assertions (shouldEqual) +import Test.Spec.Reporter (consoleReporter) +import Test.Spec.Runner (runSpec) + +emailParse :: forall m. MonadThrow Error m => String -> m Email +emailParse = liftEither <<< lmap error <<< Email.parse + +main :: Effect Unit +main = launchAff_ $ runSpec [ consoleReporter ] do + describe "Data.Email" do + describe "parse" do + for_ + [ "orion@orionkindel.com" /\ true + , "foo.bar@gmail.com" /\ true + , "foo.bar123@gmail.com" /\ true + , "foo-bar@gmail.com" /\ true + , "foo_bar@gmail.com" /\ true + , "foo_@gmail.com" /\ true + , "foo.bar+1@gmail.com" /\ true + , "_foo@gmail.com" /\ true + , "foo,bar@gmail.com" /\ false + , "foo@gmail" /\ false + , "foo@" /\ false + , "foo.com" /\ false + , "@foo.com" /\ false + ] + \(e /\ pass) -> + it + ((if pass then "pass" else "fail") <> " > `" <> e <> "`") + (isRight (Email.parse e) `shouldEqual` pass) + describe "toString" do + for_ + [ "orion@orionkindel.com" + , "foo.bar@gmail.com" + , "foo.bar123@gmail.com" + , "foo-bar@gmail.com" + , "foo_bar@gmail.com" + , "foo_@gmail.com" + , "foo.bar+1@gmail.com" + , "_foo@gmail.com" + ] + \e -> it ("`" <> e <> "`") $ flip shouldEqual e <$> Email.toString =<< emailParse e + describe "Effect.Email" do + describe "deliverable" do + for_ + [ "cakekindel@gmail.com" /\ true + , "george@thunderstrike.ai" /\ true + , "foobarbaz@thunderstrike.ai" /\ false + ] + \(e /\ shouldPass) -> + it ((if shouldPass then "pass" else "fail") <> " > `" <> e <> "`") do + email <- emailParse e + result <- runExceptT $ Effect.Email.deliverable email + case result of + Right _ + | not shouldPass -> throwError $ error "deliverable did not fail but should have!" + | otherwise -> pure unit + Left err + | shouldPass -> throwError $ error $ Effect.Email.emailErrorToString err + | otherwise -> pure unit