From 42bd6920773dd1a9fa9f27184f34d59705a6414c Mon Sep 17 00:00:00 2001 From: Philippe PITTOLI Date: Fri, 12 Apr 2024 18:38:17 +0200 Subject: [PATCH] DMARC: more options, better JSON serialization. --- src/App/Page/Zone.purs | 18 +++++++++++++---- src/App/Type/DMARC.purs | 43 ++++++++++++++++++++++++++++------------- 2 files changed, 44 insertions(+), 17 deletions(-) diff --git a/src/App/Page/Zone.purs b/src/App/Page/Zone.purs index 6fe6090..2070814 100644 --- a/src/App/Page/Zone.purs +++ b/src/App/Page/Zone.purs @@ -183,8 +183,11 @@ data Action | SPF_Modifier_Add | DMARC_policy Int + | DMARC_sp_policy Int | DMARC_adkim Int | DMARC_aspf Int + | DMARC_pct String + | DMARC_fo Int | DKIM_hash_algo Int | DKIM_sign_algo Int @@ -511,14 +514,18 @@ render state (updateForm Field_Domain) state._currentRR.name display_domain_side - , Bulma.box_input "ttlDMARC" "TTL" "600" - (updateForm Field_TTL) - (show state._currentRR.ttl) + , 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) + , Bulma.selection_field "idDMARCPolicy_sp" "Policy for subdomains" DMARC_sp_policy + (["do not provide policy advice"] <> map show DMARC.policies) (maybe "-" show state.dmarc.sp) , Bulma.hr , Bulma.selection_field "idDMARCadkim" "Consistency Policy for DKIM" DMARC_adkim DMARC.consistency_policies_txt_dkim (maybe "-" show state.dmarc.adkim) , Bulma.selection_field "idDMARCaspf" "Consistency Policy for SPF" DMARC_aspf DMARC.consistency_policies_txt_spf (maybe "-" show state.dmarc.aspf) + , Bulma.hr + , Bulma.box_input "idDMARCpct" "% of dropped emails" "100" DMARC_pct (maybe "100" show state.dmarc.pct) + , Bulma.hr + , Bulma.selection_field "idDMARCfo" "When to send a report" DMARC_fo DMARC.report_occasions_txt (maybe "-" show state.dmarc.fo) ] display_domain_side = (if state._currentRR.name == (state._domain <> ".") then "" else "." <> state._domain) @@ -770,9 +777,12 @@ 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 } } + DMARC_policy v -> H.modify_ _ { dmarc { p = fromMaybe DMARC.None $ DMARC.policies A.!! v } } + DMARC_sp_policy v -> H.modify_ _ { dmarc { sp = DMARC.policies A.!! (v - 1) } } DMARC_adkim v -> H.modify_ _ { dmarc { adkim = DMARC.consistency_policies A.!! (v - 1) } } DMARC_aspf v -> H.modify_ _ { dmarc { aspf = DMARC.consistency_policies A.!! (v - 1) } } + DMARC_pct v -> H.modify_ _ { dmarc { pct = Just $ fromMaybe 100 (fromString v) } } + DMARC_fo v -> H.modify_ _ { dmarc { fo = DMARC.report_occasions A.!! (v - 1) } } 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 } } diff --git a/src/App/Type/DMARC.purs b/src/App/Type/DMARC.purs index 7d59b76..ed2f7ed 100644 --- a/src/App/Type/DMARC.purs +++ b/src/App/Type/DMARC.purs @@ -13,9 +13,6 @@ import Data.Codec.Argonaut (JsonCodec) import Data.Codec.Argonaut as CA import Data.Codec.Argonaut.Record as CAR --- | MailTo is a simple alias for String. This is an over-simplification that may change in the future. -type MailTo = String - type DMARC = { -- | adkim= Optional. @@ -45,10 +42,10 @@ type DMARC -- | rua= Optional. Addresses to which aggregate feedback is to be sent. -- | **TODO**: A size limit can be provided (in KB). - , rua :: Maybe (Array MailTo) + , rua :: Maybe (Array DMARCURI) -- | ruf= Optional. Addresses to which message-specific failure information is to be reported. - , ruf :: Maybe (Array MailTo) + , ruf :: Maybe (Array DMARCURI) -- | rf= Optional. List of accepted report format, AFRF by default. , rf :: Maybe (Array ReportFormat) @@ -83,12 +80,20 @@ codec = CA.object "DMARC" , p: codecPolicy , sp: CAR.optional codecPolicy , fo: CAR.optional codecReportOccasion - , rua: CAR.optional (CA.array CA.string) - , ruf: CAR.optional (CA.array CA.string) + , rua: CAR.optional (CA.array codecDMARCURI) + , ruf: CAR.optional (CA.array codecDMARCURI) , rf: CAR.optional (CA.array codecReportFormat) , ri: CAR.optional CA.int }) +-- | DMARCURI is both an email and an eventual size. +-- | This is a simplification of the actual specs, but that's good enough. +type DMARCURI = { mail :: String, limit :: Maybe Int } + +-- | Codec for just encoding a single value of type `DMARCURI`. +codecDMARCURI :: JsonCodec DMARCURI +codecDMARCURI = CA.object "DMARCURI" (CAR.record { mail: CA.string, limit: CAR.optional CA.int }) + data ReportOccasion -- | Both DKIM and SPF should be in error to have a report. = Both @@ -99,6 +104,18 @@ data ReportOccasion -- | Produce a report whether SPF or DKIM is erroneous. | Any +report_occasions :: Array ReportOccasion +report_occasions = [Both, DKIMonly, SPFonly, Any] + +report_occasions_txt :: Array String +report_occasions_txt + = [ "Do not tell when to send reports (default: when both fail)" + , "When both SPF and DKIM fail" + , "Upon a DKIM error" + , "Upon an SPF error" + , "Upon any error" + ] + -- | Codec for just encoding a single value of type `ReportOccasion`. codecReportOccasion :: CA.JsonCodec ReportOccasion codecReportOccasion = CA.prismaticCodec "ReportOccasion" str_to_report_occasion generic_serialization CA.string @@ -150,16 +167,16 @@ consistency_policies = [Strict, Relaxed] consistency_policies_txt_spf :: Array String consistency_policies_txt_spf - = [ "do not provide policy advice" - , "strict: \"From:\" and SPF domain must be identical" - , "relaxed: \"From:\" and SPF domain must be in the same organizational domain" + = [ "Do not provide policy advice" + , "Strict: \"From:\" and SPF domain must be identical" + , "Relaxed: \"From:\" and SPF domain must be in the same organizational domain" ] consistency_policies_txt_dkim :: Array String consistency_policies_txt_dkim - = [ "do not provide policy advice" - , "strict: \"From:\" and DKIM domain (\"d:\") must be identical" - , "relaxed: \"From:\" and DKIM domain (\"d:\") must be in the same organizational domain" + = [ "Do not provide policy advice" + , "Strict: \"From:\" and DKIM domain (\"d:\") must be identical" + , "Relaxed: \"From:\" and DKIM domain (\"d:\") must be in the same organizational domain" ]