From 1e19f664a51af693769c1a08f9f841d55c0cef5a Mon Sep 17 00:00:00 2001
From: Philippe PITTOLI <karchnu@karchnu.fr>
Date: Thu, 11 Apr 2024 23:29:13 +0200
Subject: [PATCH] JSON encoding of DMARC. Lacks size limit on reports.

---
 src/App/Type/DMARC.purs | 117 +++++++++++++++++++++++++++++++++++++---
 1 file changed, 111 insertions(+), 6 deletions(-)

diff --git a/src/App/Type/DMARC.purs b/src/App/Type/DMARC.purs
index 7850da2..8eef733 100644
--- a/src/App/Type/DMARC.purs
+++ b/src/App/Type/DMARC.purs
@@ -1,10 +1,11 @@
+-- | DMARC is a spam mitigation mechanism described in RFC7489.
+-- | DMARC is built on top of DKIM and SPF.
 module App.Type.DMARC where
 
 import Prelude
 import Data.Generic.Rep (class Generic)
 import Data.Show.Generic (genericShow)
 
-import Data.Tuple (Tuple(..))
 import App.Type.GenericSerialization (generic_serialization)
 import Data.Maybe (Maybe(..))
 
@@ -43,19 +44,51 @@ type DMARC
     , fo :: Maybe ReportOccasion
 
     -- | rua= Optional. Addresses to which aggregate feedback is to be sent.
-    -- | A size limit can be provided (in KB).
-    , rua :: Maybe (Array (Tuple MailTo Int))
+    -- | **TODO**: A size limit can be provided (in KB).
+    , rua :: Maybe (Array MailTo)
 
     -- | ruf= Optional. Addresses to which message-specific failure information is to be reported.
-    , ruf :: Array MailTo
+    , ruf :: Maybe (Array MailTo)
 
     -- | rf= Optional. List of accepted report format, AFRF by default.
-    , rf :: Maybe (Array Format)
+    , rf :: Maybe (Array ReportFormat)
 
     -- | ri= Optional. Interval requested between aggregate reports. Default is 86400.
     , ri :: Maybe Int
     }
 
+emptyDMARCRR :: DMARC
+emptyDMARCRR =
+  { adkim: Nothing
+  , aspf: Nothing
+  , v: Nothing     -- default: DMARC1
+  , pct: Nothing   -- default: 100%
+  , p: Reject
+  , sp: Nothing
+  , fo: Nothing
+  , rua: Nothing
+  , ruf: Nothing
+  , rf: Nothing    -- default: AFRF
+  , ri: Nothing    -- default: 86400
+  }
+
+codec :: JsonCodec DMARC
+codec = CA.object "DMARC"
+  (CAR.record
+    { v: CAR.optional codecVersion
+
+    , adkim: CAR.optional codecConsistencyPolicy
+    , aspf:  CAR.optional codecConsistencyPolicy
+    , pct:   CAR.optional CA.int
+    , p:     codecPolicy
+    , sp:    CAR.optional codecPolicy
+    , fo:    CAR.optional codecReportOccasion
+    , rua:   CAR.optional (CA.array CA.string)
+    , ruf:   CAR.optional (CA.array CA.string)
+    , rf:    CAR.optional (CA.array codecReportFormat)
+    , ri:    CAR.optional CA.int
+    })
+
 data ReportOccasion
   -- | Both DKIM and SPF should be in error to have a report.
   = Both
@@ -66,6 +99,22 @@ data ReportOccasion
   -- | Produce a report whether SPF or DKIM is erroneous.
   | Any
 
+-- | 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
+
+str_to_report_occasion :: String -> Maybe ReportOccasion
+str_to_report_occasion = case _ of
+  "both"     -> Just Both
+  "dkimonly" -> Just DKIMonly
+  "spfonly"  -> Just SPFonly
+  "any"      -> Just Any
+  _ -> Nothing
+
+derive instance genericReportOccasion :: Generic ReportOccasion _
+instance showReportOccasion :: Show ReportOccasion where
+  show = genericShow
+
 data ConsistencyPolicy
   -- | s = strict.
   -- |
@@ -96,15 +145,56 @@ data ConsistencyPolicy
   -- | See https://publicsuffix.org/ for a list of organizational domains.
   | Relaxed
 
-data Format
+-- | Codec for just encoding a single value of type `ConsistencyPolicy`.
+codecConsistencyPolicy :: CA.JsonCodec ConsistencyPolicy
+codecConsistencyPolicy
+  = CA.prismaticCodec "ConsistencyPolicy" str_to_consistency_policy generic_serialization CA.string
+
+str_to_consistency_policy :: String -> Maybe ConsistencyPolicy
+str_to_consistency_policy = case _ of
+  "relaxed" -> Just Relaxed
+  "strict"  -> Just Strict
+  _ -> Nothing
+
+derive instance genericConsistencyPolicy :: Generic ConsistencyPolicy _
+instance showConsistencyPolicy :: Show ConsistencyPolicy where
+  show = genericShow
+
+data ReportFormat
   -- | Authentication Failure Reporting Format, see RFC6591. Currently the only format referenced in RFC7489.
   = AFRF
 
+-- | Codec for just encoding a single value of type `ReportFormat`.
+codecReportFormat :: CA.JsonCodec ReportFormat
+codecReportFormat = CA.prismaticCodec "ReportFormat" str_to_report_format generic_serialization CA.string
+
+str_to_report_format :: String -> Maybe ReportFormat
+str_to_report_format = case _ of
+  "afrf" -> Just AFRF
+  _ -> Nothing
+
+derive instance genericFormat :: Generic ReportFormat _
+instance showFormat :: Show ReportFormat where
+  show = genericShow
+
 data Version
   -- | Version of DMARC only accepts DMARC1 currently.
   -- | So, for dnsmanager, this field is just ignored for now.
   = DMARC1
 
+-- | Codec for just encoding a single value of type `Version`.
+codecVersion :: CA.JsonCodec Version
+codecVersion = CA.prismaticCodec "Version" str_to_version generic_serialization CA.string
+
+str_to_version :: String -> Maybe Version
+str_to_version = case _ of
+  "dmarc1"      -> Just DMARC1
+  _ -> Nothing
+
+derive instance genericVersion :: Generic Version _
+instance showVersion :: Show Version where
+  show = genericShow
+
 data Policy
   -- | "None" means to basically just accept the mail.
   = None
@@ -112,3 +202,18 @@ data Policy
   | Quarantine
   -- | "Reject" means to not accept any failure of DKIM or SPF.
   | 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
+
+str_to_policy :: String -> Maybe Policy
+str_to_policy = case _ of
+  "none"       -> Just None
+  "quarantine" -> Just Quarantine
+  "reject"     -> Just Reject
+  _ -> Nothing
+
+derive instance genericPolicy :: Generic Policy _
+instance showPolicy :: Show Policy where
+  show = genericShow