DMARC: more options, better JSON serialization.

This commit is contained in:
Philippe PITTOLI 2024-04-12 18:38:17 +02:00
parent f21a7dd3cf
commit 42bd692077
2 changed files with 44 additions and 17 deletions

View File

@ -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)
@ -771,8 +778,11 @@ handleAction = case _ of
handleAction $ ResetSPF
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 } }

View File

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