Baguette/dnsmanager-webclient
3
1
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

DMARC: verify emails.

Browse Source
This commit is contained in:
Philippe PITTOLI 2024-04-14 12:06:35 +02:00
parent 080b8c042c
commit b86e00ec23
4 changed files with 97 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

43
src/App/DisplayErrors.purs
View File

@ -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 <> ")"

46
src/App/Page/Registration.purs
View File

@ -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 <> ")"

68
src/App/Page/Zone.purs
View File

@ -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

7
src/Bulma.purs
View File

@ -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;"