From 73fcdd0b7c97fc2b0c90f2fd891933d2218aa491 Mon Sep 17 00:00:00 2001
From: Philippe Pittoli <karchnu@karchnu.fr>
Date: Thu, 29 Feb 2024 04:14:53 +0100
Subject: [PATCH] WIP: SPF. Add Qualifier type.

---
 src/App/ResourceRecord.purs | 30 ++++++++++++++++++++++++++----
 src/App/ZoneInterface.purs  |  4 ++--
 2 files changed, 28 insertions(+), 6 deletions(-)

diff --git a/src/App/ResourceRecord.purs b/src/App/ResourceRecord.purs
index 713dd2e..bd1f617 100644
--- a/src/App/ResourceRecord.purs
+++ b/src/App/ResourceRecord.purs
@@ -35,7 +35,7 @@ type ResourceRecord
     , v          :: Maybe String  -- Default: spf1
     , mechanisms :: Maybe (Array Mechanism)
     , modifiers  :: Maybe (Array Modifier)
-    , q          :: Maybe String  -- Qualifier for default mechanism (`all`).
+    , q          :: Maybe Qualifier  -- Qualifier for default mechanism (`all`).
 
     -- TODO: DKIM specific entries.
     -- TODO: DMARC specific entries.
@@ -72,11 +72,11 @@ codec = CA.object "ResourceRecord"
     , v:          CAR.optional CA.string
     , mechanisms: CAR.optional (CA.array codecMechanism)
     , modifiers:  CAR.optional (CA.array codecModifier)
-    , q:          CAR.optional CA.string
+    , q:          CAR.optional codecQualifier
     })
 
 type Mechanism
-  = { q :: Maybe Int -- Qualifier (0 = Pass, 1 = Neutral, 2 = soft fail, 3 = hard fail)
+  = { q :: Maybe Qualifier
     , t :: Int       -- Type of mechanism (0 = A, 1 = IP4, 2 = IP6, 3 = MX, 4 = PTR, 5 = EXISTS, 6 = INCLUDE)
     , v :: String    -- Value (IP addresses or ranges, or domains).
     }
@@ -84,7 +84,7 @@ type Mechanism
 codecMechanism :: JsonCodec Mechanism
 codecMechanism = CA.object "Mechanism"
   (CAR.record
-    { q: CAR.optional CA.int
+    { q: CAR.optional codecQualifier
     , t: CA.int
     , v: CA.string
     })
@@ -129,3 +129,25 @@ emptyRR
     , modifiers:    Nothing
     , q:            Nothing
     }
+
+data Qualifier = Pass | None | SoftFail | HardFail
+
+-- | Codec for just encoding a single value of type `Qualifier`.
+codecQualifier :: CA.JsonCodec Qualifier
+codecQualifier =
+  CA.prismaticCodec "Qualifier" from to CA.string
+  where
+    from :: String -> Maybe Qualifier
+    from = case _ of
+      "pass"      -> Just Pass      -- +
+      "none"      -> Just None      -- ?
+      "soft_fail" -> Just SoftFail  -- ~
+      "hard_fail" -> Just HardFail  -- -
+      _ -> Nothing
+
+    to :: Qualifier -> String
+    to = case _ of
+      Pass      -> "pass"
+      None      -> "none"
+      SoftFail  -> "soft_fail"
+      HardFail  -> "hard_fail"
diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs
index bf9a886..2f5dcc3 100644
--- a/src/App/ZoneInterface.purs
+++ b/src/App/ZoneInterface.purs
@@ -39,7 +39,7 @@ import Bulma as Bulma
 import CSSClasses as C
 
 import App.AcceptedRRTypes (AcceptedRRTypes(..))
-import App.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier)
+import App.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier, Qualifier)
 
 import App.DisplayErrors (error_to_paragraph)
 
@@ -88,7 +88,7 @@ data Field
   | Field_SPF_v          String
   | Field_SPF_mechanisms (Array Mechanism)
   | Field_SPF_modifiers  (Array Modifier)
-  | Field_SPF_q          String
+  | Field_SPF_q          Qualifier
 
 -- | Steps to create a new RR:
 -- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type.