CAA record: modal seems fine.

src/App/Page/Zone.purs

@@ -30,6 +30,7 @@ import Web.HTML.Window (sessionStorage) as Window
 import Web.Storage.Storage as Storage
 
 import App.Validation.Email as Email
+import App.Type.CAA as CAA
 
 import Data.Eq (class Eq)
 import Data.Array as A
@@ -108,6 +109,9 @@ data Field
   | Field_SPF_modifiers  (Array RR.Modifier)
   | Field_SPF_q          RR.Qualifier
 
+  | Field_CAA_flag  String
+  | Field_CAA_value String
+
 -- | Steps to create a new RR:
 -- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type.
 -- | 2. `UpdateCurrentRR Field`: modify the fields of the future new RR.
@@ -169,6 +173,8 @@ data Action
   -- | Ask `dnsmanagerd` for the generated zone file.
   | AskZoneFile
 
+  | CAA_tag Int
+
   | SPF_Mechanism_q Int
   | SPF_Mechanism_t Int
   | SPF_Mechanism_v String
@@ -288,6 +294,7 @@ default_empty_rr :: ResourceRecord
 default_empty_rr = default_rr_A
 
 default_qualifier_str = "hard_fail" :: String
+default_caa = { flag: 0, tag: CAA.Issue, value: "" } :: CAA.CAA
 
 initialState :: Input -> State
 initialState domain =
@@ -456,12 +463,14 @@ render state
           , Bulma.box_input ("ttlCAA") "TTL" "600"
               (updateForm Field_TTL)
               (show state._currentRR.ttl)
-          , Bulma.box_input ("targetCAA") "Target" "www"
+          , Bulma.hr
-              (updateForm Field_Target)
+          , Bulma.box_input ("flagCAA") "Flag" ""
+              (updateForm Field_CAA_flag)
               state._currentRR.target
-          , Bulma.box_input ("priorityCAA") "Priority" "10"
+          , Bulma.selection_field'' "tagCAA" "Tag" CAA_tag (A.zip CAA.tags_txt CAA.tags_raw)
-              (updateForm Field_Priority)
+            CAA.Issue
-              (maybe "" show state._currentRR.priority)
+            (Just (fromMaybe default_caa state._currentRR.caa).tag)
+          , Bulma.box_input "valueCAA" "Value" "" (updateForm Field_CAA_value) state._currentRR.name
           ]
         modal_content_srv :: Array (HH.HTML w Action)
         modal_content_srv =
@@ -688,7 +697,7 @@ handleAction = case _ of
         default_rr_CNAME = emptyRR { rrtype = "CNAME", name = "www", target = "server1" }
         default_rr_NS    = emptyRR { rrtype = "NS", name = (state._domain <> "."), target = "ns0.example.com." }
         default_rr_MX    = emptyRR { rrtype = "MX", name = "mail", target = "server1", priority = Just 10 }
-        default_rr_CAA   = emptyRR { rrtype = "CAA", name = "" } -- TODO: implement a default CAA entry.
+        default_rr_CAA   = emptyRR { rrtype = "CAA", name = "", caa = Just default_caa }
         default_rr_SRV   = emptyRR { rrtype = "SRV", name = "voip", target = "server1"
                                    , port = Just 5061, weight = Just 100, priority = Just 10, protocol = Just "tcp" }
         default_mechanisms = maybe [] (\x -> [x]) $ to_mechanism "pass" "mx" ""
@@ -844,6 +853,11 @@ handleAction = case _ of
       $ DNSManager.MkAskGeneratedZoneFile { domain: state._domain }
     H.raise $ MessageToSend message
 
+  CAA_tag         v -> do
+    state <- H.get
+    let new_caa = (fromMaybe default_caa state._currentRR.caa) { tag = fromMaybe CAA.Issue $ CAA.tags A.!! v }
+    H.modify_ _ { _currentRR { caa = Just new_caa } }
+
   SPF_Mechanism_q v -> H.modify_ _ { spf_mechanism_q = maybe "pass"     id $ qualifier_types A.!! v }
   SPF_Mechanism_t v -> H.modify_ _ { spf_mechanism_t = maybe "a"        id $ mechanism_types A.!! v }
   SPF_Mechanism_v v -> H.modify_ _ { spf_mechanism_v = v                                            }
@@ -1015,6 +1029,7 @@ render_resources records
          (rr_box tag_soa       bg_color_ro Bulma.soa_table_header       table_content        all_soa_rr)
       <> (rr_box tag_basic     []          Bulma.simple_table_header    table_content_w_seps all_basic_rr)
       <> (rr_box tag_mx        []          Bulma.mx_table_header        table_content        all_mx_rr)
+      <> (rr_box tag_caa       []          Bulma.caa_table_header       table_content        all_caa_rr)
       <> (rr_box tag_srv       []          Bulma.srv_table_header       table_content        all_srv_rr)
       <> (rr_box tag_spf       []          Bulma.spf_table_header       table_content        all_spf_rr)
       <> (rr_box tag_dkim      []          Bulma.dkim_table_header      table_content        all_dkim_rr)
@@ -1026,6 +1041,7 @@ render_resources records
   all_XX_rr str   = A.filter (\rr -> rr.rrtype == str) records
   all_soa_rr      = all_XX_rr "SOA"
   all_mx_rr       = all_XX_rr "MX"
+  all_caa_rr      = all_XX_rr "CAA"
   all_srv_rr      = all_XX_rr "SRV"
   all_spf_rr      = all_XX_rr "SPF"
   all_dkim_rr     = all_XX_rr "DKIM"
@@ -1034,6 +1050,7 @@ render_resources records
   tag_soa      = tags [tag_ro "SOA", tag_ro "read only"]
   tag_basic    = tags [tag "Basic Resource Records (A, AAAA, PTR, NS, TXT)"]
   tag_mx       = tags [tag "MX"]
+  tag_caa      = tags [tag "CAA"]
   tag_srv      = tags [tag "SRV"]
   tag_spf      = tags [tag "SPF"]
   tag_dkim     = tags [tag "DKIM"]
@@ -1094,6 +1111,19 @@ render_resources records
           then HH.td_ [ Bulma.btn_readonly ]
           else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
         ]
+      "CAA"  ->
+        [ HH.td_ [ Bulma.p rr.name ]
+        , HH.td_ [ Bulma.p $ show rr.ttl ]
+        ] <> case rr.caa of
+          Just caa ->
+            [ HH.td_ [ Bulma.p $ show caa.flag ]
+            , HH.td_ [ Bulma.p $ show caa.tag ]
+            , HH.td_ [ Bulma.p caa.value ]
+            , if rr.readonly
+              then HH.td_ [ Bulma.btn_readonly ]
+              else HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid), Bulma.btn_delete (DeleteRRModal rr.rrid) ]
+            ]
+          Nothing -> [Bulma.p "Problem: there is no CAA data." ]
       "SPF"  ->
         [ HH.td_ [ Bulma.p rr.name ]
         , HH.td_ [ Bulma.p $ show rr.ttl ]
@@ -1231,10 +1261,11 @@ render_new_records _
           , Bulma.btn   "SRV" (CreateNewRRModal SRV)
           ] []
       , Bulma.hr
-      , Bulma.h1 "Special records about the mail system"
+      , Bulma.h1 "Special records about certifications and the mail system"
       -- use "level" to get horizontal buttons next to each other (probably vertical on mobile)
       , Bulma.level [
-            Bulma.btn "SPF"   (CreateNewRRModal SPF)
+            Bulma.btn "CAA"   (CreateNewRRModal CAA)
+          , Bulma.btn "SPF"   (CreateNewRRModal SPF)
           , Bulma.btn "DKIM"  (CreateNewRRModal DKIM)
           , Bulma.btn "DMARC" (CreateNewRRModal DMARC)
           ] []
@@ -1277,6 +1308,14 @@ update_field rr updated_field = case updated_field of
   Field_SPF_modifiers val    -> rr { modifiers  = Just val }
   Field_SPF_q val            -> rr { q          = Just val }
 
+  Field_CAA_flag val ->
+    let new_caa = (fromMaybe default_caa rr.caa) { flag = fromMaybe 0 $ fromString val }
+    in rr { caa = Just new_caa }
+
+  Field_CAA_value val ->
+    let new_caa = (fromMaybe default_caa rr.caa) { value = val }
+    in rr { caa = Just new_caa }
+
 attach_id :: forall a. Int -> Array a -> Array (Tuple Int a)
 attach_id _ []  = []
 attach_id i arr = case A.head arr of

src/App/Type/ResourceRecord.purs

@@ -10,6 +10,7 @@ import Data.Codec.Argonaut.Record as CAR
 
 import App.Type.DKIM as DKIM
 import App.Type.DMARC as DMARC
+import App.Type.CAA as CAA
 
 type ResourceRecord
   = { rrtype   :: String

src/Bulma.purs

@@ -2,6 +2,7 @@
 module Bulma where
 import Prelude
 
+import Data.Maybe (Maybe, fromMaybe)
 import Data.Tuple (Tuple, fst, snd)
 import Halogen.HTML as HH
 import DOM.HTML.Indexed as DHI
@@ -136,6 +137,17 @@ mx_table_header
                        ]
               ]
 
+caa_table_header :: forall w i. HH.HTML w i
+caa_table_header
+  = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name"  ]
+                       , HH.th_ [ HH.text "TTL"   ]
+                       , HH.th_ [ HH.text "Flag" ]
+                       , HH.th_ [ HH.text "Tag" ]
+                       , HH.th_ [ HH.text "Value" ]
+                       , HH.th_ [ HH.text "" ]
+                       ]
+              ]
+
 srv_table_header :: forall w i. HH.HTML w i
 srv_table_header
   = HH.thead_ [ HH.tr_ [ HH.th_ [ HH.text "Name"  ]
@@ -542,6 +554,16 @@ selection_field' id title action values selected
       , div_field_content $ selection' action values selected
       ]
 
+selection_field'' :: forall w i t. Show t =>
+  String -> String -> (Int -> i) -> Array (Tuple String String) -> t -> Maybe t -> HH.HTML w i
+selection_field'' id title action values default_value selected
+  = div_field
+      [ div_field_label id title
+      , div_field_content $ selection' action values selected_value
+      ]
+  where
+  selected_value = (show $ fromMaybe default_value selected)
+
 -- | selection': as `selection` but takes an array of tuple as values.
 -- | First value in the tuple is what to display, the second one is what to match on.
 selection' :: forall w i. (Int -> i) -> Array (Tuple String String) -> String -> HH.HTML w i