WIP: SPF

src/App/ResourceRecord.purs

@@ -1,6 +1,6 @@
 module App.ResourceRecord where
 
-import Data.Maybe (Maybe)
+import Data.Maybe (Maybe(..))
 
 import Data.Codec.Argonaut (JsonCodec)
 import Data.Codec.Argonaut as CA
@@ -30,6 +30,15 @@ type ResourceRecord
     , retry   :: Maybe Int
     , expire  :: Maybe Int
     , minttl  :: Maybe Int
+
+    -- SPF specific entries.
+    , v          :: Maybe String  -- Default: spf1
+    , mechanisms :: Maybe (Array Mechanism)
+    , modifiers  :: Maybe (Array Modifier)
+    , q          :: Maybe Int     -- Qualifier for default mechanism (`all`).
+
+    -- TODO: DKIM specific entries.
+    -- TODO: DMARC specific entries.
     }
 
 codec :: JsonCodec ResourceRecord
@@ -58,4 +67,65 @@ codec = CA.object "ResourceRecord"
     , retry:   CAR.optional CA.int
     , expire:  CAR.optional CA.int
     , minttl:  CAR.optional CA.int
+
+    -- SPF specific entries.
+    , v:          CAR.optional CA.string
+    , mechanisms: CAR.optional (CA.array codecMechanism)
+    , modifiers:  CAR.optional (CA.array codecModifier)
+    , q:          CAR.optional CA.int
     })
+
+type Mechanism
+  = { q :: Maybe Int -- Qualifier (0 = Pass, 1 = Neutral, 2 = soft fail, 3 = hard fail)
+    , 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).
+    }
+
+codecMechanism :: JsonCodec Mechanism
+codecMechanism = CA.object "Mechanism"
+  (CAR.record
+    { q: CAR.optional CA.int
+    , t: CA.int
+    , v: CA.string
+    })
+
+type Modifier
+  = { t :: Int     -- Type of modifier (0 = EXP, 1 = REDIRECT)
+    , v :: String  -- Value (domain).
+    }
+
+codecModifier :: JsonCodec Modifier
+codecModifier = CA.object "Modifier" (CAR.record { t: CA.int, v: CA.string })
+
+emptyRR :: ResourceRecord
+emptyRR
+  = { rrid:         0
+    , readonly:     false
+    , rrtype:       ""
+    , name:         ""
+    , ttl:          1800
+    , target:       ""
+
+    -- MX + SRV
+    , priority:     Nothing
+
+    -- SRV
+    , port:         Nothing
+    , protocol:     Nothing
+    , weight:       Nothing
+
+    -- SOA
+    , mname:        Nothing
+    , rname:        Nothing
+    , serial:       Nothing
+    , refresh:      Nothing
+    , retry:        Nothing
+    , expire:       Nothing
+    , minttl:       Nothing
+
+    -- SPF specific entries.
+    , v:            Nothing
+    , mechanisms:   Nothing
+    , modifiers:    Nothing
+    , q:            Nothing
+    }

src/App/Validation/DNS.purs

@@ -9,7 +9,7 @@ import Data.Maybe (Maybe(..), maybe)
 import Data.String.CodeUnits as CU
 import Data.Validation.Semigroup (V, invalid, toEither)
 
-import App.ResourceRecord (ResourceRecord)
+import App.ResourceRecord (ResourceRecord, emptyRR)
 import GenericParser.SomeParsers as SomeParsers
 import GenericParser.Parser as G
 import GenericParser.DomainParser.Common (DomainError) as DomainParser
@@ -84,64 +84,6 @@ type RRRetry    = Maybe Int
 type RRExpire   = Maybe Int
 type RRMinttl   = Maybe Int
 
-
-toRR :: Int -> Boolean -> String -> String -> Int -> String
-     -> RRPriority
-     -> RRPort
-     -> RRProtocol
-     -> RRWeight
-     -> RRMname
-     -> RRRname
-     -> RRSerial
-     -> RRRefresh
-     -> RRRetry
-     -> RRExpire
-     -> RRMinttl
-     -> ResourceRecord
-toRR rrid readonly rrtype rrname ttl target
-     priority port protocol weight mname rname serial refresh retry expire minttl
-  = { rrid:         rrid
-    , readonly:     readonly
-    , rrtype:       rrtype
-    , name:         rrname
-    , ttl:          ttl
-    , target:       target
-
-    -- MX + SRV
-    , priority:     priority
-
-    -- SRV
-    , port:         port
-    , protocol:     protocol
-    , weight:       weight
-
-    -- SOA
-    , mname:        mname
-    , rname:        rname
-    , serial:       serial
-    , refresh:      refresh
-    , retry:        retry
-    , expire:       expire
-    , minttl:       minttl
-    }
-
-toRR_basic :: Int -> Boolean -> String -> String -> Int -> String -> ResourceRecord
-toRR_basic rrid readonly rrtype rrname ttl target
-  = toRR rrid readonly rrtype rrname ttl target
-         Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
-
--- last + priority
-toRR_mx :: Int -> Boolean -> String -> String -> Int -> String -> Int -> ResourceRecord
-toRR_mx rrid readonly rrtype rrname ttl target priority
-  = toRR rrid readonly rrtype rrname ttl target (Just priority)
-         Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing
-
--- last + port + protocol + weight
-toRR_srv :: Int -> Boolean -> String -> String -> Int -> String -> Int -> Int -> String -> Int -> ResourceRecord
-toRR_srv rrid readonly rrtype rrname ttl target priority port protocol weight
-  = toRR rrid readonly rrtype rrname ttl target (Just priority) (Just port) (Just protocol) (Just weight)
-         Nothing Nothing Nothing Nothing Nothing Nothing Nothing
-
 data TXTError
   = TXTInvalidCharacter
   | TXTTooLong Int Int -- max current
@@ -171,7 +113,7 @@ validationA form = ado
   name   <- parse DomainParser.sub_eof form.name   VEName
   ttl    <- is_between min_ttl max_ttl form.ttl    VETTL
   target <- parse IPAddress.ipv4       form.target VEIPv4
-  in toRR_basic form.rrid form.readonly "A" name ttl target
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A", name = name, ttl = ttl, target = target }
 
 validationAAAA :: ResourceRecord -> V (Array Error) ResourceRecord
 validationAAAA form = ado
@@ -179,28 +121,28 @@ validationAAAA form = ado
   ttl    <- is_between min_ttl max_ttl form.ttl  VETTL
   -- use read_input to get unaltered input (the IPv6 parser expands the input)
   target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6
-  in toRR_basic form.rrid form.readonly "AAAA" name ttl target
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "AAAA", name = name, ttl = ttl, target = target }
 
 validationTXT :: ResourceRecord -> V (Array Error) ResourceRecord
 validationTXT form = ado
   name   <- parse DomainParser.sub_eof form.name   VEName
   ttl    <- is_between min_ttl max_ttl form.ttl    VETTL
   target <- parse txt_parser           form.target VETXT
-  in toRR_basic form.rrid form.readonly "TXT" name ttl target
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "TXT", name = name, ttl = ttl, target = target }
 
 validationCNAME :: ResourceRecord -> V (Array Error) ResourceRecord
 validationCNAME form = ado
   name   <- parse DomainParser.sub_eof form.name VEName
   ttl    <- is_between min_ttl max_ttl form.ttl      VETTL
   target <- parse DomainParser.sub_eof form.target VECNAME
-  in toRR_basic form.rrid form.readonly "CNAME" name ttl target
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME", name = name, ttl = ttl, target = target }
 
 validationNS :: ResourceRecord -> V (Array Error) ResourceRecord
 validationNS form = ado
   name   <- parse DomainParser.sub_eof form.name   VEName
   ttl    <- is_between min_ttl max_ttl form.ttl    VETTL
   target <- parse DomainParser.sub_eof form.target VENS
-  in toRR_basic form.rrid form.readonly "NS" name ttl target
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS", name = name, ttl = ttl, target = target }
 
 data ProtocolError
   = InvalidProtocol
@@ -220,7 +162,8 @@ validationMX form = ado
   ttl      <- is_between min_ttl max_ttl form.ttl      VETTL
   target   <- parse DomainParser.sub_eof form.target   VEMX
   priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority
-  in toRR_mx form.rrid form.readonly "MX" name ttl target priority
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "MX"
+             , name = name, ttl = ttl, target = target, priority = Just priority }
 
 validationSRV :: ResourceRecord -> V (Array Error) ResourceRecord
 validationSRV form = ado
@@ -231,7 +174,9 @@ validationSRV form = ado
   protocol <- parse protocol_parser      (maybe "" id   form.protocol)  VEProtocol
   port     <- is_between min_port max_port (maybe 0 id form.port)       VEPort
   weight   <- is_between min_weight max_weight (maybe 0 id form.weight) VEWeight
-  in toRR_srv form.rrid form.readonly "SRV" name ttl target priority port protocol weight
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SRV"
+             , name = name, ttl = ttl, target = target
+             , priority = Just priority, port = Just port, protocol = Just protocol, weight = Just weight }
 
 validation :: ResourceRecord -> Either (Array Error) ResourceRecord
 validation entry = case entry.rrtype of

src/App/ZoneInterface.purs

@@ -38,7 +38,7 @@ import Bulma as Bulma
 import CSSClasses as C
 
 import App.AcceptedRRTypes (AcceptedRRTypes(..))
-import App.ResourceRecord (ResourceRecord)
+import App.ResourceRecord (ResourceRecord, emptyRR)
 
 import App.DisplayErrors (error_to_paragraph)
 
@@ -199,32 +199,11 @@ component =
 default_domain :: String
 default_domain = "netlib.re"
 
+default_rr_A :: ResourceRecord
+default_rr_A = emptyRR { rrtype = "A", name = "www", target = "10.0.0.1" }
+
 default_empty_rr :: ResourceRecord
-default_empty_rr
+default_empty_rr = default_rr_A
-  = { rrtype: "A"
-    , rrid: 0
-    , name: "www"
-    , ttl: 1800
-    , target: "10.0.0.1"
-    , readonly: false
-
-    -- MX (and SRV) specific entry.
-    , priority: Nothing
-
-    -- SRV specific entries.
-    , port: Nothing
-    , protocol: Nothing
-    , weight: Nothing
-
-    -- SOA specific entries.
-    , mname: Nothing
-    , rname: Nothing
-    , serial: Nothing
-    , refresh: Nothing
-    , retry: Nothing
-    , expire: Nothing
-    , minttl: Nothing
-    }
 
 initialState :: Input -> State
 initialState domain =
@@ -411,140 +390,21 @@ handleAction = case _ of
   CreateNewRRModal t -> do
     state <- H.get
     H.modify_ _ { rr_modal = NewRRModal t }
-    let defaultA = { rrtype: "A"
+    let default_rr_AAAA  = emptyRR { rrtype = "AAAA", name = "www", target = "2001:db8::1" }
-          , rrid: 0
+        default_rr_TXT   = emptyRR { rrtype = "TXT", name = "txt", target = "some text" }
-          , ttl: 600
+        default_rr_CNAME = emptyRR { rrtype = "CNAME", name = "blog", target = "www" }
-          , readonly: false
+        default_rr_NS    = emptyRR { rrtype = "NS", name = (state._domain <> "."), target = "ns0.example.com." }
-          , name:     "www"
+        default_rr_MX    = emptyRR { rrtype = "MX", name = "mail", target = "www", priority = Just 10 }
-          , target:   "192.0.2.1"
+        default_rr_SRV   = emptyRR { rrtype = "SRV", name = "_sip._tcp", target = "www"
-          , port: Nothing
+                                   , port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" }
-          , weight: Nothing
-          , priority: Nothing
-          , protocol: Nothing
-          , mname: Nothing
-          , rname: Nothing
-          , serial: Nothing
-          , refresh: Nothing
-          , retry: Nothing
-          , expire: Nothing
-          , minttl: Nothing
-          }
-        defaultAAAA = { rrtype: "AAAA"
-          , rrid: 0
-          , ttl: 600
-          , readonly: false
-          , name:     "www"
-          , target:   "2001:db8::1"
-          , port: Nothing
-          , weight: Nothing
-          , priority: Nothing
-          , protocol: Nothing
-          , mname: Nothing
-          , rname: Nothing
-          , serial: Nothing
-          , refresh: Nothing
-          , retry: Nothing
-          , expire: Nothing
-          , minttl: Nothing
-          }
-        defaultTXT = { rrtype: "TXT"
-          , rrid: 0
-          , ttl: 600
-          , readonly: false
-          , name:     "txt"
-          , target:   "some text"
-          , port: Nothing
-          , weight: Nothing
-          , priority: Nothing
-          , protocol: Nothing
-          , mname: Nothing
-          , rname: Nothing
-          , serial: Nothing
-          , refresh: Nothing
-          , retry: Nothing
-          , expire: Nothing
-          , minttl: Nothing
-          }
-        defaultCNAME = { rrtype: "CNAME"
-          , rrid: 0
-          , ttl: 600
-          , readonly: false
-          , name:     "blog"
-          , target:   "www"
-          , port: Nothing
-          , weight: Nothing
-          , priority: Nothing
-          , protocol: Nothing
-          , mname: Nothing
-          , rname: Nothing
-          , serial: Nothing
-          , refresh: Nothing
-          , retry: Nothing
-          , expire: Nothing
-          , minttl: Nothing
-          }
-        defaultNS = { rrtype: "NS"
-          , rrid: 0
-          , ttl: 600
-          , readonly: false
-          , name:     (state._domain <> ".")
-          , target:   "ns0.example.com."
-          , port: Nothing
-          , weight: Nothing
-          , priority: Nothing
-          , protocol: Nothing
-          , mname: Nothing
-          , rname: Nothing
-          , serial: Nothing
-          , refresh: Nothing
-          , retry: Nothing
-          , expire: Nothing
-          , minttl: Nothing
-          }
-        defaultMX = { rrtype: "MX"
-          , rrid: 0
-          , ttl: 600
-          , readonly: false
-          , name:     "mail"
-          , target:   "www"
-          , port: Nothing
-          , weight: Nothing
-          , priority: Just 10
-          , protocol: Nothing
-          , mname: Nothing
-          , rname: Nothing
-          , serial: Nothing
-          , refresh: Nothing
-          , retry: Nothing
-          , expire: Nothing
-          , minttl: Nothing
-          }
-        defaultSRV = { rrtype: "SRV"
-          , rrid: 0
-          , ttl: 600
-          , readonly: false
-          , name:     "_sip._tcp"
-          , target:   "www"
-          , port: Just 5061
-          , weight: Just 100
-          , priority: Just 10
-          , protocol: Just "tcp"
-          , mname: Nothing
-          , rname: Nothing
-          , serial: Nothing
-          , refresh: Nothing
-          , retry: Nothing
-          , expire: Nothing
-          , minttl: Nothing
-          }
     case t of
-      A     -> H.modify_ _ { _currentRR = defaultA }
+      A     -> H.modify_ _ { _currentRR = default_rr_A }
-      AAAA  -> H.modify_ _ { _currentRR = defaultAAAA }
+      AAAA  -> H.modify_ _ { _currentRR = default_rr_AAAA }
-      TXT   -> H.modify_ _ { _currentRR = defaultTXT }
+      TXT   -> H.modify_ _ { _currentRR = default_rr_TXT }
-      CNAME -> H.modify_ _ { _currentRR = defaultCNAME }
+      CNAME -> H.modify_ _ { _currentRR = default_rr_CNAME }
-      NS    -> H.modify_ _ { _currentRR = defaultNS }
+      NS    -> H.modify_ _ { _currentRR = default_rr_NS }
-      MX    -> H.modify_ _ { _currentRR = defaultMX }
+      MX    -> H.modify_ _ { _currentRR = default_rr_MX }
-      SRV   -> H.modify_ _ { _currentRR = defaultSRV }
+      SRV   -> H.modify_ _ { _currentRR = default_rr_SRV }
 
   -- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`.
   Initialize -> do