diff --git a/src/App/Page/Zone.purs b/src/App/Page/Zone.purs index 284114d..ca88c48 100644 --- a/src/App/Page/Zone.purs +++ b/src/App/Page/Zone.purs @@ -57,6 +57,7 @@ import App.Type.ResourceRecord (ResourceRecord, emptyRR , mechanism_types, qualifier_types, modifier_types) 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) @@ -181,6 +182,8 @@ data Action -- | Add a SPF modifier to the currently modified (SPF) entry (see `_currentRR`). | SPF_Modifier_Add + | DMARC_policy Int + | DKIM_hash_algo Int | DKIM_sign_algo Int | DKIM_pubkey String @@ -203,6 +206,7 @@ string_to_acceptedtype str = case str of "SRV" -> Just SRV "SPF" -> Just SPF "DKIM" -> Just DKIM + "DMARC" -> Just DMARC _ -> Nothing data Tab = Zone | TheBasics | TokenExplanation @@ -233,6 +237,7 @@ type State = , spf_modifier_v :: String , dkim :: DKIM.DKIM + , dmarc :: DMARC.DMARC , _zonefile :: Maybe String @@ -285,6 +290,7 @@ initialState domain = , spf_modifier_t: "redirect" , spf_modifier_v: "" , dkim: DKIM.emptyDKIMRR + , dmarc: DMARC.emptyDMARCRR , current_tab: Zone } @@ -353,6 +359,7 @@ render state "SRV" -> template modal_content_srv (foot_content SRV) "SPF" -> template modal_content_spf (foot_content SPF) "DKIM" -> template modal_content_dkim (foot_content DKIM) + "DMARC" -> template modal_content_dmarc (foot_content DMARC) _ -> Bulma.p $ "Invalid type: " <> state._currentRR.rrtype where -- DRY @@ -494,6 +501,21 @@ render state , Bulma.box_input "noteDKIM" "Note" "Note for fellow administrators." DKIM_note (fromMaybe "" state.dkim.n) ] + modal_content_dmarc :: Array (HH.HTML w Action) + modal_content_dmarc = + [ Bulma.div_content [Bulma.explanation Explanations.dmarc_introduction] + , render_errors + , Bulma.input_with_side_text "domainDMARC" "Name" "_dmarc" + (updateForm Field_Domain) + state._currentRR.name + display_domain_side + , Bulma.box_input "ttlDMARC" "TTL" "600" + (updateForm Field_TTL) + (show state._currentRR.ttl) + , Bulma.hr + , Bulma.selection_field "idDMARCPolicy" "Policy" DMARC_policy (map show DMARC.policies) (show state.dmarc.p) + ] + display_domain_side = (if state._currentRR.name == (state._domain <> ".") then "" else "." <> state._domain) newtokenbtn = Bulma.btn (maybe "🏁​ Ask for a token" (\_ -> "🏁​ Ask for a new token") state._currentRR.token) (NewToken state._currentRR.rrid) foot_content x = @@ -562,6 +584,7 @@ handleAction = case _ of , q = Just RR.HardFail } default_rr_DKIM = emptyRR { rrtype = "DKIM", name = "default._domainkey", target = "" } + default_rr_DMARC = emptyRR { rrtype = "DMARC", name = "_dmarc", target = "" } case t of A -> H.modify_ _ { _currentRR = default_rr_A } @@ -573,6 +596,7 @@ handleAction = case _ of SRV -> H.modify_ _ { _currentRR = default_rr_SRV } SPF -> H.modify_ _ { _currentRR = default_rr_SPF } DKIM -> H.modify_ _ { _currentRR = default_rr_DKIM } + DMARC -> H.modify_ _ { _currentRR = default_rr_DMARC } -- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`. Initialize -> do @@ -741,6 +765,8 @@ handleAction = case _ of H.modify_ _ { _currentRR { modifiers = new_value }} handleAction $ ResetSPF + DMARC_policy v -> H.modify_ _ { dmarc { p = fromMaybe DMARC.None $ DMARC.policies A.!! v } } + DKIM_hash_algo v -> H.modify_ _ { dkim { h = DKIM.hash_algos A.!! v } } DKIM_sign_algo v -> H.modify_ _ { dkim { k = DKIM.sign_algos A.!! v } } DKIM_pubkey v -> H.modify_ _ { dkim { p = v } } @@ -998,9 +1024,9 @@ render_new_records _ , Bulma.h1 "Special records about the mail system" -- use "level" to get horizontal buttons next to each other (probably vertical on mobile) , Bulma.level [ - Bulma.btn "SPF" (CreateNewRRModal SPF) - , Bulma.btn "DKIM" (CreateNewRRModal DKIM) - , Bulma.btn_ro (C.is_small <> C.is_warning) "DMARC (soon)" + Bulma.btn "SPF" (CreateNewRRModal SPF) + , Bulma.btn "DKIM" (CreateNewRRModal DKIM) + , Bulma.btn "DMARC" (CreateNewRRModal DMARC) ] [] , Bulma.hr , Bulma.level [ diff --git a/src/App/Text/Explanations.purs b/src/App/Text/Explanations.purs index 29c78b3..bc0e349 100644 --- a/src/App/Text/Explanations.purs +++ b/src/App/Text/Explanations.purs @@ -155,6 +155,18 @@ dkim_introduction = ] ] +dmarc_introduction :: forall w i. Array (HH.HTML w i) +dmarc_introduction = + [ Bulma.p """ + DMARC is a spam mitigation mechanism on top of SPF and DKIM. + Upon receiving a mail, the server checks whether the "From:" field of the mail is consistent with the SPF and DKIM + records of the sender's domain. + The DMARC record tells what to do with the mail in case of an inconsistency, and DMARC allows to define email + addresses that should receive error reports. + """ + ] + + dkim_default_algorithms :: forall w i. Array (HH.HTML w i) dkim_default_algorithms = [ Bulma.p """ diff --git a/src/App/Type/AcceptedRRTypes.purs b/src/App/Type/AcceptedRRTypes.purs index c524702..29348f2 100644 --- a/src/App/Type/AcceptedRRTypes.purs +++ b/src/App/Type/AcceptedRRTypes.purs @@ -17,6 +17,7 @@ data AcceptedRRTypes | SRV | SPF | DKIM + | DMARC derive instance genericAcceptedRRTypes :: Generic AcceptedRRTypes _ diff --git a/src/App/Type/DKIM.purs b/src/App/Type/DKIM.purs index 6937674..222d452 100644 --- a/src/App/Type/DKIM.purs +++ b/src/App/Type/DKIM.purs @@ -85,5 +85,5 @@ codecVersion = CA.prismaticCodec "Version" str_to_version generic_serialization str_to_version :: String -> Maybe Version str_to_version = case _ of - "dkim1" -> Just DKIM1 - _ -> Nothing + "dkim1" -> Just DKIM1 + _ -> Nothing diff --git a/src/App/Type/DMARC.purs b/src/App/Type/DMARC.purs index 8eef733..63d0977 100644 --- a/src/App/Type/DMARC.purs +++ b/src/App/Type/DMARC.purs @@ -203,6 +203,9 @@ data Policy -- | "Reject" means to not accept any failure of DKIM or SPF. | Reject +policies :: Array Policy +policies = [None, Quarantine, Reject] + -- | Codec for just encoding a single value of type `Policy`. codecPolicy :: CA.JsonCodec Policy codecPolicy = CA.prismaticCodec "Policy" str_to_policy generic_serialization CA.string