From b86e00ec2339b787483827458a980731f161d4c4 Mon Sep 17 00:00:00 2001 From: Philippe PITTOLI Date: Sun, 14 Apr 2024 12:06:35 +0200 Subject: [PATCH] DMARC: verify emails. --- src/App/DisplayErrors.purs | 43 +++++++++++++++++++++ src/App/Page/Registration.purs | 46 ++--------------------- src/App/Page/Zone.purs | 68 +++++++++++++++++++++------------- src/Bulma.purs | 7 ++++ 4 files changed, 97 insertions(+), 67 deletions(-) diff --git a/src/App/DisplayErrors.purs b/src/App/DisplayErrors.purs index 26f8093..c016037 100644 --- a/src/App/DisplayErrors.purs +++ b/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 <> ")" diff --git a/src/App/Page/Registration.purs b/src/App/Page/Registration.purs index 7766af3..171787e 100644 --- a/src/App/Page/Registration.purs +++ b/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 <> ")" diff --git a/src/App/Page/Zone.purs b/src/App/Page/Zone.purs index ed5c42b..b2822fb 100644 --- a/src/App/Page/Zone.purs +++ b/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 - Nothing -> [] - Just dmarc -> fromMaybe [] dmarc.rua - dmarc_mail = state.dmarc_mail - dmarc_mail_limit = state.dmarc_mail_limit - new_list = current_ruas <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ] - new_dmarc = case state._currentRR.dmarc of - Nothing -> DMARC.emptyDMARCRR { rua = Just new_list } - Just dmarc -> dmarc { rua = Just new_list } - H.modify_ _ { _currentRR { dmarc = Just new_dmarc } } - handleAction $ ResetTemporaryValues + case Email.email state.dmarc_mail of + Left errors -> H.modify_ _ { _dmarc_mail_errors = errors } + Right _ -> do + let current_ruas = case state._currentRR.dmarc of + Nothing -> [] + Just dmarc -> fromMaybe [] dmarc.rua + dmarc_mail = state.dmarc_mail + dmarc_mail_limit = state.dmarc_mail_limit + new_list = current_ruas <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ] + new_dmarc = case state._currentRR.dmarc of + 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 - Nothing -> [] - Just dmarc -> fromMaybe [] dmarc.ruf - dmarc_mail = state.dmarc_mail - dmarc_mail_limit = state.dmarc_mail_limit - new_list = current_rufs <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ] - new_dmarc = case state._currentRR.dmarc of - Nothing -> DMARC.emptyDMARCRR { ruf = Just new_list } - Just dmarc -> dmarc { ruf = Just new_list } - H.modify_ _ { _currentRR { dmarc = Just new_dmarc } } - handleAction $ ResetTemporaryValues + case Email.email state.dmarc_mail of + Left errors -> H.modify_ _ { _dmarc_mail_errors = errors } + Right _ -> do + let current_rufs = case state._currentRR.dmarc of + Nothing -> [] + Just dmarc -> fromMaybe [] dmarc.ruf + dmarc_mail = state.dmarc_mail + dmarc_mail_limit = state.dmarc_mail_limit + new_list = current_rufs <> [ {mail: dmarc_mail, limit: dmarc_mail_limit} ] + new_dmarc = case state._currentRR.dmarc of + 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 diff --git a/src/Bulma.purs b/src/Bulma.purs index 9b371a1..39a7934 100644 --- a/src/Bulma.purs +++ b/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;"