DMARC: verify emails.

src/App/DisplayErrors.purs

@@ -8,9 +8,13 @@ import Data.Maybe (Maybe(..), maybe)
 import Halogen.HTML as HH
 
 import App.Validation.DNS as ValidationDNS
+import App.Validation.Login as L
+import App.Validation.Email as E
+import App.Validation.Password as P
 import App.Validation.Label as ValidationLabel
 import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser
 import GenericParser.IPAddress as IPAddress
+
 import Bulma as Bulma
 
 error_to_paragraph :: forall w i. ValidationDNS.Error -> HH.HTML w i
@@ -155,3 +159,42 @@ show_error_title_label v = case v of
     Just (ValidationLabel.Size min max n) ->
       "Label size should be between " <> show min <> " and " <> show max
       <> " (current size: " <> show n <> ")."
+
+show_error_login :: L.Error -> String
+show_error_login = case _ of
+  L.ParsingError {error, position} ->
+    "position " <> show position <> " " <> maybe "" string_error_login error
+
+string_error_login :: L.LoginParsingError -> String
+string_error_login = case _ of
+  L.CannotParse         -> "cannot parse the login"
+  L.CannotEntirelyParse -> "cannot entirely parse the login"
+  L.Size min max n      -> "login size should be between "
+                           <> show min <> " and " <> show max
+                           <> " (currently: " <> show n <> ")"
+
+show_error_email :: E.Error -> String
+show_error_email = case _ of
+  E.ParsingError {error, position} ->
+    "position " <> show position <> " " <> maybe "" string_error_email error
+
+string_error_email :: E.EmailParsingError -> String
+string_error_email = case _ of
+  E.CannotParse         -> "cannot parse the email"
+  E.CannotEntirelyParse -> "cannot entirely parse the email"
+  E.Size min max n      -> "email size should be between "
+                           <> show min <> " and " <> show max
+                           <> " (currently: " <> show n <> ")"
+
+show_error_password :: P.Error -> String
+show_error_password = case _ of
+  P.ParsingError {error, position} ->
+    "position " <> show position <> " " <> maybe "" string_error_password error
+
+string_error_password :: P.PasswordParsingError -> String
+string_error_password = case _ of
+  P.CannotParse         -> "cannot parse the password"
+  P.CannotEntirelyParse -> "cannot entirely parse the password"
+  P.Size min max n      -> "password size should be between "
+                           <> show min <> " and " <> show max
+                           <> " (currently: " <> show n <> ")"

src/App/Page/Registration.purs

@@ -2,17 +2,16 @@
 -- | Registration requires a login, an email address and a password.
 module App.Page.Registration where
 
-import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), map, show)
+import Prelude (Unit, bind, discard, ($), (<<<), (<>), map)
 
 import Data.Array as A
 import Data.ArrayBuffer.Types (ArrayBuffer)
-import Data.Maybe (Maybe(..), maybe)
+import Data.Maybe (Maybe(..))
 import Data.Either (Either(..))
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
 import Halogen.HTML as HH
 import Halogen.HTML.Events as HE
-import Halogen.HTML.Properties as HP
 import Web.Event.Event as Event
 import Web.Event.Event (Event)
 
@@ -22,6 +21,8 @@ import App.Type.Email as Email
 import App.Type.LogMessage
 import App.Message.AuthenticationDaemon as AuthD
 
+import App.DisplayErrors (show_error_login, show_error_email, show_error_password)
+
 import App.Validation.Login as L
 import App.Validation.Email as E
 import App.Validation.Password as P
@@ -153,42 +154,3 @@ show_error = case _ of
   Login    arr -> "Error with the Login: "    <> (A.fold $ map show_error_login arr)
   Email    arr -> "Error with the Email: "    <> (A.fold $ map show_error_email arr)
   Password arr -> "Error with the Password: " <> (A.fold $ map show_error_password arr)
-
-show_error_login :: L.Error -> String
-show_error_login = case _ of
-  L.ParsingError {error, position} ->
-    "position " <> show position <> " " <> maybe "" string_error_login error
-
-string_error_login :: L.LoginParsingError -> String
-string_error_login = case _ of
-  L.CannotParse         -> "cannot parse the login"
-  L.CannotEntirelyParse -> "cannot entirely parse the login"
-  L.Size min max n      -> "login size should be between "
-                           <> show min <> " and " <> show max
-                           <> " (currently: " <> show n <> ")"
-
-show_error_email :: E.Error -> String
-show_error_email = case _ of
-  E.ParsingError {error, position} ->
-    "position " <> show position <> " " <> maybe "" string_error_email error
-
-string_error_email :: E.EmailParsingError -> String
-string_error_email = case _ of
-  E.CannotParse         -> "cannot parse the email"
-  E.CannotEntirelyParse -> "cannot entirely parse the email"
-  E.Size min max n      -> "email size should be between "
-                           <> show min <> " and " <> show max
-                           <> " (currently: " <> show n <> ")"
-
-show_error_password :: P.Error -> String
-show_error_password = case _ of
-  P.ParsingError {error, position} ->
-    "position " <> show position <> " " <> maybe "" string_error_password error
-
-string_error_password :: P.PasswordParsingError -> String
-string_error_password = case _ of
-  P.CannotParse         -> "cannot parse the password"
-  P.CannotEntirelyParse -> "cannot entirely parse the password"
-  P.Size min max n      -> "password size should be between "
-                           <> show min <> " and " <> show max
-                           <> " (currently: " <> show n <> ")"

src/App/Page/Zone.purs

@@ -27,6 +27,8 @@ import Web.HTML (window) as HTML
 import Web.HTML.Window (sessionStorage) as Window
 import Web.Storage.Storage as Storage
 
+import App.Validation.Email as Email
+
 import Data.Eq (class Eq)
 import Data.Array as A
 import Data.Int (fromString)
@@ -59,7 +61,7 @@ import App.Type.ResourceRecord (Mechanism, Modifier, Qualifier(..)) as RR
 import App.Type.DKIM as DKIM
 import App.Type.DMARC as DMARC
 
-import App.DisplayErrors (error_to_paragraph)
+import App.DisplayErrors (error_to_paragraph, show_error_email)
 
 import App.Type.LogMessage (LogMessage(..))
 import App.Message.DNSManagerDaemon as DNSManager
@@ -254,6 +256,7 @@ type State =
   -- Unique RR form.
   , _currentRR :: ResourceRecord
   , _currentRR_errors :: Array Validation.Error
+  , _dmarc_mail_errors :: Array Email.Error
 
   -- SPF details.
   , spf_mechanism_q :: String
@@ -312,6 +315,7 @@ initialState domain =
   , _currentRR: default_empty_rr
   -- List of errors within the form in new RR modal.
   , _currentRR_errors: []
+  , _dmarc_mail_errors: []
   , _zonefile: Nothing
 
   , spf_mechanism_q: "pass"
@@ -574,6 +578,7 @@ render state
             (display_dmarc_mail_addresses "Addresses to contact for detailed reports" DMARC_remove_ruf) current_rufs
 
           , Bulma.hr
+          , render_dmarc_mail_errors
           , Bulma.box_input "idDMARCmail"      "Address to contact" "admin@example.com" DMARC_mail state.dmarc_mail
           , Bulma.box_input "idDMARCmaillimit" "Report size limit (in KB)" "2000" DMARC_mail_limit (maybe "0" show state.dmarc_mail_limit)
           , Bulma.level [ Bulma.btn "New address for aggregated report" DMARC_rua_Add
@@ -585,6 +590,11 @@ render state
           , Bulma.box_input "idDMARCri" "Report interval (in seconds)" "86400" DMARC_ri (maybe "0" show state.dmarc_ri)
           ]
 
+        render_dmarc_mail_errors
+          = if A.length state._dmarc_mail_errors > 0
+            then Bulma.notification_danger_block'
+                   $ [ Bulma.h3 "Invalid mail 😥" ] <> map (Bulma.p <<< show_error_email) state._dmarc_mail_errors
+            else HH.div_ [ ]
         current_ruas = case state._currentRR.dmarc of
           Nothing    -> Nothing
           Just dmarc -> dmarc.rua
@@ -618,6 +628,7 @@ handleAction = case _ of
   CancelModal -> do
     H.modify_ _ { rr_modal = NoModal }
     H.modify_ _ { _currentRR_errors = [] }
+    H.modify_ _ { _dmarc_mail_errors = [] }
     handleAction $ ResetTemporaryValues
 
   -- | Create the RR modal.
@@ -710,7 +721,7 @@ handleAction = case _ of
         -- loopE (\v -> H.raise $ Log $ ErrorLog $ "==> " <> show_error v) actual_errors
         H.modify_ _ { _currentRR_errors = actual_errors }
       Right newrr -> do
-        H.modify_ _ { _currentRR_errors = [], dkim = DKIM.emptyDKIMRR }
+        H.modify_ _ { _currentRR_errors = [], _dmarc_mail_errors = [], dkim = DKIM.emptyDKIMRR }
         handleAction $ AddRR t newrr
         handleAction CancelModal
 
@@ -747,7 +758,7 @@ handleAction = case _ of
       Left actual_errors -> do
         H.modify_ _ { _currentRR_errors = actual_errors }
       Right rr -> do
-        H.modify_ _ { _currentRR_errors = [] }
+        H.modify_ _ { _currentRR_errors = [], _dmarc_mail_errors = [] }
         handleAction $ SaveRR rr
 
   ResetTemporaryValues -> do
@@ -759,6 +770,7 @@ handleAction = case _ of
                 , dmarc_mail = ""
                 , dmarc_mail_limit = Nothing
                 , dmarc_ri = Nothing
+                , _dmarc_mail_errors = []
                 }
 
   SaveRR rr -> do
@@ -849,31 +861,37 @@ handleAction = case _ of
   DMARC_ri v -> H.modify_ _ { dmarc_ri = fromString v }
   DMARC_rua_Add -> do
     state <- H.get
-    let current_ruas = case state._currentRR.dmarc of
+    case Email.email state.dmarc_mail of
-          Nothing    -> []
+      Left errors -> H.modify_ _ { _dmarc_mail_errors = errors }
-          Just dmarc -> fromMaybe [] dmarc.rua
+      Right _     -> do
-        dmarc_mail       = state.dmarc_mail
+        let current_ruas = case state._currentRR.dmarc of
-        dmarc_mail_limit = state.dmarc_mail_limit
+              Nothing    -> []
-        new_list = current_ruas <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ]
+              Just dmarc -> fromMaybe [] dmarc.rua
-        new_dmarc = case state._currentRR.dmarc of
+            dmarc_mail       = state.dmarc_mail
-          Nothing    -> DMARC.emptyDMARCRR { rua = Just new_list }
+            dmarc_mail_limit = state.dmarc_mail_limit
-          Just dmarc -> dmarc              { rua = Just new_list }
+            new_list = current_ruas <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ]
-    H.modify_ _ { _currentRR { dmarc = Just new_dmarc } }
+            new_dmarc = case state._currentRR.dmarc of
-    handleAction $ ResetTemporaryValues
+              Nothing    -> DMARC.emptyDMARCRR { rua = Just new_list }
+              Just dmarc -> dmarc              { rua = Just new_list }
+        H.modify_ _ { _currentRR { dmarc = Just new_dmarc } }
+        handleAction $ ResetTemporaryValues
 
   DMARC_ruf_Add -> do
     state <- H.get
-    let current_rufs = case state._currentRR.dmarc of
+    case Email.email state.dmarc_mail of
-          Nothing    -> []
+      Left errors -> H.modify_ _ { _dmarc_mail_errors = errors }
-          Just dmarc -> fromMaybe [] dmarc.ruf
+      Right _     -> do
-        dmarc_mail       = state.dmarc_mail
+        let current_rufs = case state._currentRR.dmarc of
-        dmarc_mail_limit = state.dmarc_mail_limit
+              Nothing    -> []
-        new_list = current_rufs <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ]
+              Just dmarc -> fromMaybe [] dmarc.ruf
-        new_dmarc = case state._currentRR.dmarc of
+            dmarc_mail       = state.dmarc_mail
-          Nothing    -> DMARC.emptyDMARCRR { ruf = Just new_list }
+            dmarc_mail_limit = state.dmarc_mail_limit
-          Just dmarc -> dmarc              { ruf = Just new_list }
+            new_list = current_rufs <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ]
-    H.modify_ _ { _currentRR { dmarc = Just new_dmarc } }
+            new_dmarc = case state._currentRR.dmarc of
-    handleAction $ ResetTemporaryValues
+              Nothing    -> DMARC.emptyDMARCRR { ruf = Just new_list }
+              Just dmarc -> dmarc              { ruf = Just new_list }
+        H.modify_ _ { _currentRR { dmarc = Just new_dmarc } }
+        handleAction $ ResetTemporaryValues
 
   DMARC_remove_rua i -> do
     state <- H.get

src/Bulma.purs

@@ -540,6 +540,10 @@ notification_success value deleteaction = notification C.is_success value delete
 notification_danger :: forall w i. String -> i -> HH.HTML w i
 notification_danger value deleteaction = notification C.is_danger value deleteaction
 
+notification_block' :: forall w i. Array HH.ClassName -> Array (HH.HTML w i) -> HH.HTML w i
+notification_block' classes content =
+  HH.div [HP.classes (C.notification <> classes)] content
+
 notification' :: forall w i. Array HH.ClassName -> String -> HH.HTML w i
 notification' classes value =
   HH.div [HP.classes (C.notification <> classes)]
@@ -548,6 +552,9 @@ notification' classes value =
 notification_danger' :: forall w i. String -> HH.HTML w i
 notification_danger' value = notification' C.is_danger value
 
+notification_danger_block' :: forall w i. Array (HH.HTML w i) -> HH.HTML w i
+notification_danger_block' content = notification_block' C.is_danger content
+
 btn_validation_ :: forall w i. String -> HH.HTML w i
 btn_validation_ str = HH.button
   -- [ HP.style "padding: 0.5rem 1.25rem;"