DMARC: more options, better JSON serialization.

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"
+          , Bulma.box_input "ttlDMARC" "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl)
-              (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 } }

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)
+    , rua:   CAR.optional (CA.array codecDMARCURI)
-    , ruf:   CAR.optional (CA.array CA.string)
+    , 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"
+  = [ "Do not provide policy advice"
-    , "strict: \"From:\" and SPF domain must be identical"
+    , "Strict: \"From:\" and SPF domain must be identical"
-    , "relaxed: \"From:\" and SPF domain must be in the same organizational domain"
+    , "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"
+  = [ "Do not provide policy advice"
-    , "strict: \"From:\" and DKIM domain (\"d:\") must be identical"
+    , "Strict: \"From:\" and DKIM domain (\"d:\") must be identical"
-    , "relaxed: \"From:\" and DKIM domain (\"d:\") must be in the same organizational domain"
+    , "Relaxed: \"From:\" and DKIM domain (\"d:\") must be in the same organizational domain"
     ]