WIP: SPF interface.

src/App/AcceptedRRTypes.purs

@@ -15,6 +15,7 @@ data AcceptedRRTypes
   | NS
   | MX
   | SRV
+  | SPF
 
 derive instance genericMyADT :: Generic AcceptedRRTypes _
 

src/App/DisplayErrors.purs

@@ -34,6 +34,7 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
                                          <> ", current value: " <> show n <> "."
       ValidationDNS.VEWeight min max n   -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max
                                          <> ", current value: " <> show n <> "."
+      ValidationDNS.VESPF      err       -> maybe default_error show_error_domain err.error
   )
   where default_error = Bulma.p ""
 
@@ -54,6 +55,7 @@ show_error_title v = case v of
   ValidationDNS.VEProtocol err       -> "The Protocol input is wrong (position: "      <> show err.position <> ")"
   ValidationDNS.VEPort min max n     -> "Invalid Port (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")"
   ValidationDNS.VEWeight min max n   -> "Invalid Weight (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")"
+  ValidationDNS.VESPF      err       -> "The SPF target input is wrong (position: "    <> show err.position <> ")"
 
 show_error_domain :: forall w i. DomainParser.DomainError -> HH.HTML w i
 show_error_domain e = case e of

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 Int     -- Qualifier for default mechanism (`all`).
+    , q          :: Maybe String  -- Qualifier for default mechanism (`all`).
 
     -- TODO: DKIM specific entries.
     -- TODO: DMARC specific entries.
@@ -72,7 +72,7 @@ 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.int
+    , q:          CAR.optional CA.string
     })
 
 type Mechanism

src/App/Setup.purs

@@ -2,11 +2,9 @@
 -- | Users can also erase their account.
 module App.SetupInterface where
 
-import Prelude (Unit, bind, discard, pure, ($), (<<<), (<>), (==))
+import Prelude (Unit, bind, discard, pure, ($), (<<<), (==))
 
-import Data.ArrayBuffer.Types (ArrayBuffer)
 import Data.Maybe (Maybe(..))
-import Data.Tuple (Tuple(..))
 import Effect.Aff.Class (class MonadAff)
 import Halogen as H
 import Halogen.HTML as HH
@@ -17,7 +15,6 @@ import Web.Event.Event (Event)
 
 import Bulma as Bulma
 
-import App.Email as Email
 import App.LogMessage
 import App.Messages.AuthenticationDaemon as AuthD
 

src/App/Validation/DNS.purs

@@ -44,6 +44,7 @@ data Error
   | VEMX (G.Error DomainParser.DomainError)
   | VEPriority Int Int Int
   | VESRV (G.Error DomainParser.DomainError)
+  | VESPF (G.Error DomainParser.DomainError)
   | VEProtocol (G.Error ProtocolError)
   | VEPort Int Int Int
   | VEWeight Int Int Int
@@ -178,6 +179,16 @@ validationSRV form = ado
              , name = name, ttl = ttl, target = target
              , priority = Just priority, port = Just port, protocol = Just protocol, weight = Just weight }
 
+validationSPF :: ResourceRecord -> V (Array Error) ResourceRecord
+validationSPF 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   VESPF
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SPF"
+             , name = name, ttl = ttl, target = target
+             , v = form.v, mechanisms = maybe (Just []) Just form.mechanisms
+             , modifiers = form.modifiers, q = form.q }
+
 validation :: ResourceRecord -> Either (Array Error) ResourceRecord
 validation entry = case entry.rrtype of
   "A"     -> toEither $ validationA     entry
@@ -187,6 +198,7 @@ validation entry = case entry.rrtype of
   "NS"    -> toEither $ validationNS    entry
   "MX"    -> toEither $ validationMX    entry
   "SRV"   -> toEither $ validationSRV   entry
+  "SPF"   -> toEither $ validationSPF   entry
   _       -> toEither $ invalid [UNKNOWN]
 
 id :: forall a. a -> a

src/App/ZoneInterface.purs

@@ -2,6 +2,7 @@
 -- |
 -- | This interface allows to:
 -- |   - display all resource records of a zone (SOA, NS, A, AAAA, CNAME, TXT, MX, SRV)
+-- |   - TODO: dedicated interfaces for: SPF, DKIM, DMARC
 -- |   - add, modify, remove resource records
 -- |
 -- | **WIP**: Display relevant information for each record type in the (add/mod) modal.
@@ -38,7 +39,7 @@ import Bulma as Bulma
 import CSSClasses as C
 
 import App.AcceptedRRTypes (AcceptedRRTypes(..))
-import App.ResourceRecord (ResourceRecord, emptyRR)
+import App.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier)
 
 import App.DisplayErrors (error_to_paragraph)
 
@@ -84,6 +85,10 @@ data Field
   | Field_Protocol  String
   | Field_Weight    String
   | Field_Port      String
+  | Field_SPF_v          String
+  | Field_SPF_mechanisms (Array Mechanism)
+  | Field_SPF_modifiers  (Array Modifier)
+  | Field_SPF_q          String
 
 -- | Steps to create a new RR:
 -- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type.
@@ -152,6 +157,7 @@ show_accepted_type = case _ of
   NS    -> "NS"
   MX    -> "MX"
   SRV   -> "SRV"
+  SPF   -> "SPF"
 
 string_to_acceptedtype :: String -> Maybe AcceptedRRTypes
 string_to_acceptedtype str = case str of
@@ -162,6 +168,7 @@ string_to_acceptedtype str = case str of
   "NS"    -> Just    NS
   "MX"    -> Just    MX
   "SRV"   -> Just   SRV
+  "SPF"   -> Just   SPF
   _       -> Nothing
 
 type State =
@@ -270,6 +277,7 @@ render state
       "NS"    -> template content_simple (foot_content NS)
       "MX"    -> template content_mx     (foot_content MX)
       "SRV"   -> template content_srv    (foot_content SRV)
+      "SPF"   -> template content_spf    (foot_content SPF)
       _       -> Bulma.p $ "Invalid type: " <> state._currentRR.rrtype
       where
         -- DRY
@@ -349,6 +357,34 @@ render state
               (fromMaybe "tcp" state._currentRR.protocol)
               should_be_disabled
           ]
+        content_spf :: Array (HH.HTML w Action)
+        content_spf =
+          [ render_errors
+          , Bulma.input_with_side_text "domainSPF" "Name" "www" -- id, title, placeholder
+              (updateForm Field_Domain)             -- action
+              state._currentRR.name                 -- value
+              ("." <> state._domain)                -- sidetext
+          , Bulma.box_input ("ttlSPF") "TTL" "600"
+              (updateForm Field_TTL)
+              (show state._currentRR.ttl)
+              should_be_disabled
+          , Bulma.box_input ("targetSPF") "Target" "www"
+              (updateForm Field_Target)
+              state._currentRR.target
+              should_be_disabled
+          , case state._currentRR.v of
+            Nothing -> Bulma.p "default value for the version (spf1)"
+            Just v  -> Bulma.box_input ("vSPF") "Version" "spf1" (updateForm Field_SPF_v) v should_be_disabled
+          , Bulma.p "TODO: mechanisms"
+          , Bulma.p "TODO: modifiers"
+          , Bulma.p "TODO: qualifier"
+          --case state._currentRR.mechanisms of
+          --  Nothing -> Bulma.p "no mechanisms"
+          --  Just ms -> Bulma.box_input ("mechanismsSPF") "Mechanisms" ""
+          --    (updateForm Field_SPF_mechanisms)
+          --    (maybe "" show state._currentRR.v)
+          --    should_be_disabled
+          ]
 
         should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
         foot_content x = [ case state.rr_modal of
@@ -397,6 +433,8 @@ handleAction = case _ of
         default_rr_MX    = emptyRR { rrtype = "MX", name = "mail", target = "www", priority = Just 10 }
         default_rr_SRV   = emptyRR { rrtype = "SRV", name = "_sip._tcp", target = "www"
                                    , port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" }
+        default_rr_SPF   = emptyRR { rrtype = "SPF", name = "", target = "www" }
+
     case t of
       A     -> H.modify_ _ { _currentRR = default_rr_A }
       AAAA  -> H.modify_ _ { _currentRR = default_rr_AAAA }
@@ -405,6 +443,7 @@ handleAction = case _ of
       NS    -> H.modify_ _ { _currentRR = default_rr_NS }
       MX    -> H.modify_ _ { _currentRR = default_rr_MX }
       SRV   -> H.modify_ _ { _currentRR = default_rr_SRV }
+      SPF   -> H.modify_ _ { _currentRR = default_rr_SPF }
 
   -- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`.
   Initialize -> do
@@ -568,17 +607,19 @@ render_resources []
               , Bulma.subtitle "No records for now"
               ]
 render_resources records
-  = HH.div_ [ render_soa $ A.head $ A.filter (\rr -> rr.rrtype == "SOA") records
+  = HH.div_ $ [ render_soa $ A.head $ A.filter (\rr -> rr.rrtype == "SOA") records ]
-            , Bulma.box [ basic_records_section ]
+      <> (if A.length all_basic_rr    > 0 then [Bulma.box [basic_records_section]] else [])
-            , Bulma.box [ mx_records_section    ]
+      <> (if A.length all_mx_rr       > 0 then [Bulma.box [mx_records_section   ]] else [])
-            , Bulma.box [ srv_records_section   ]
+      <> (if A.length all_srv_rr      > 0 then [Bulma.box [srv_records_section  ]] else [])
-            , Bulma.box_ C.has_background_warning_light [ basic_readonly_records_section ]
+      <> (if A.length all_spf_rr      > 0 then [Bulma.box [spf_records_section  ]] else [])
-            ]
+      <> (if A.length all_basic_ro_rr > 0
+          then [Bulma.box_ C.has_background_warning_light [basic_readonly_records_section]] else [])
   where
   all_basic_rr    = A.filter (\rr -> A.elem rr.rrtype baseRecords && not rr.readonly) records
   all_basic_ro_rr = A.filter (\rr -> A.elem rr.rrtype baseRecords && rr.readonly)     records
-  all_mx_rr    = A.filter (\rr -> rr.rrtype == "MX") records
+  all_mx_rr       = A.filter (\rr -> rr.rrtype == "MX") records
-  all_srv_rr   = A.filter (\rr -> rr.rrtype == "SRV") records
+  all_srv_rr      = A.filter (\rr -> rr.rrtype == "SRV") records
+  all_spf_rr      = A.filter (\rr -> rr.rrtype == "SPF") records
 
   basic_records_section
     = if A.length all_basic_rr > 0
@@ -600,9 +641,15 @@ render_resources records
       then Bulma.table [] [ Bulma.srv_table_header, render_srv_records ]
       else Bulma.p "no srv records"
 
+  spf_records_section
+    = if A.length all_spf_rr > 0
+      then Bulma.table [] [ Bulma.spf_table_header, render_spf_records ]
+      else Bulma.p "no spf records"
+
   render_basic_records _rrs = table_content_with_separations _rrs
   render_mx_records = table_content all_mx_rr
   render_srv_records = table_content all_srv_rr
+  render_spf_records = table_content all_spf_rr
 
   table_content_with_separations records_ = HH.tbody_ $
     A.groupAllBy (comparing (_.rrtype)) records_ -- [x x y y z] -> [NE[xx], NE[yy], NE[z]]
@@ -637,6 +684,22 @@ render_resources records
           then HH.td_ [ Bulma.btn_readonly ]
           else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
         ]
+      "SPF"  ->
+        [ Bulma.txt_name rr.rrtype
+        , HH.td_ [ Bulma.p rr.name]
+        , HH.td_ [ Bulma.p $ show rr.ttl ]
+        , HH.td_ [ Bulma.p rr.target ]
+        , HH.td_ [ Bulma.p $ maybe "spf1 (default)" id rr.v ]
+        , HH.td_ [ Bulma.p $ maybe "" (\ _ -> "TODO: mechanisms") rr.mechanisms ]
+        , HH.td_ [ Bulma.p $ maybe "" (\ _ -> "TODO: modifiers")  rr.modifiers ]
+        , HH.td_ [ Bulma.p $ maybe "qualifier" (\ _ -> "qualifier")  rr.q ]
+        , if rr.readonly
+          then HH.td_ [ Bulma.btn_readonly ]
+          else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
+        , if rr.readonly
+          then HH.td_ [ Bulma.btn_readonly ]
+          else HH.td_ [ Bulma.btn_delete (DeleteRRModal rr.rrid) ]
+        ]
       "MX"  ->
         [ Bulma.txt_name rr.rrtype
         , HH.td_ [ Bulma.p rr.name]
@@ -684,7 +747,7 @@ render_new_records _
       , Bulma.h1 "Special records about the mail system (soon)"
       -- use "level" to get horizontal buttons next to each other (probably vertical on mobile)
       , Bulma.level [
-            Bulma.btn_ro (C.is_small <> C.is_warning) "SPF"
+            Bulma.btn "SPF" (CreateNewRRModal SPF)
           , Bulma.btn_ro (C.is_small <> C.is_warning) "DKIM"
           , Bulma.btn_ro (C.is_small <> C.is_warning) "DMARC"
           ] []
@@ -715,10 +778,14 @@ loopE f a = case (A.head a) of
 
 update_field :: ResourceRecord -> Field -> ResourceRecord
 update_field rr updated_field = case updated_field of
-  Field_Domain val   -> rr { name = val }
+  Field_Domain val           -> rr { name       = val }
-  Field_Target val   -> rr { target = val }
+  Field_Target val           -> rr { target     = val }
-  Field_TTL val      -> rr { ttl = fromMaybe 0 (fromString val) }
+  Field_TTL val              -> rr { ttl        = fromMaybe 0 (fromString val) }
-  Field_Priority val -> rr { priority = fromString val }
+  Field_Priority val         -> rr { priority   = fromString val }
-  Field_Protocol val -> rr { protocol = Just val }
+  Field_Protocol val         -> rr { protocol   = Just val }
-  Field_Weight val   -> rr { weight = fromString val }
+  Field_Weight val           -> rr { weight     = fromString val }
-  Field_Port val     -> rr { port = fromString val }
+  Field_Port val             -> rr { port       = fromString val }
+  Field_SPF_v val            -> rr { v          = Just val }
+  Field_SPF_mechanisms val   -> rr { mechanisms = Just val }
+  Field_SPF_modifiers val    -> rr { modifiers  = Just val }
+  Field_SPF_q val            -> rr { q          = Just val }

src/Bulma.purs

@@ -106,6 +106,23 @@ srv_table_header
                        ]
               ]
 
+spf_table_header :: forall w i. HH.HTML w i
+spf_table_header
+  = HH.thead_ [ HH.tr_ [ HH.th  [ HP.style "width: 50px;" ] [ HH.text "Type"  ]
+                       , HH.th_ [ HH.text "Name"  ]
+                       , HH.th_ [ HH.text "TTL"   ]
+                       , HH.th_ [ HH.text "Target" ]
+                       , HH.th_ [ HH.text "Version" ]
+                       , HH.th_ [ HH.text "Mechanisms" ]
+                       , HH.th_ [ HH.text "Modifiers" ]
+                       , HH.th_ [ HH.text "Qualifier" ]
+                       , HH.th_ [ HH.text "" ]
+                       , HH.th_ [ HH.text "" ]
+                       , HH.th_ [ HH.text "" ]
+                       , HH.th_ [ HH.text "" ]
+                       ]
+              ]
+
 soa_table_header :: forall w i. HH.HTML w i
 soa_table_header
   = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "name"]