feat: initial commit

package.json

@@ -14,5 +14,5 @@
   "peerDependencies": {
     "typescript": "^5.0.0"
   },
-  "dependencies": {}
+  "dependencies": { "qed-mail": "^1.0.2" }
 }

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:

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

src/Effect.Email.js

@@ -0,0 +1,4 @@
+import { checkEmail } from 'qed-mail'
+
+/** @type {(_: string) => () => Promise<import('qed-mail/src/types.js').Result>} */
+export const checkEmailImpl = s => () => checkEmail(s)

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'

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