CAA: first draft.

src/App/Page/Zone.purs

@@ -225,20 +225,6 @@ data RRModal
   | UpdateRRModal
   | RemoveRRModal RRId
 
-string_to_acceptedtype :: String -> Maybe AcceptedRRTypes
-string_to_acceptedtype str = case str of
-  "A"     -> Just     A
-  "AAAA"  -> Just  AAAA
-  "TXT"   -> Just   TXT
-  "CNAME" -> Just CNAME
-  "NS"    -> Just    NS
-  "MX"    -> Just    MX
-  "SRV"   -> Just   SRV
-  "SPF"   -> Just   SPF
-  "DKIM"  -> Just  DKIM
-  "DMARC" -> Just DMARC
-  _       -> Nothing
-
 data Tab = Zone | TheBasics | TokenExplanation
 derive instance eqTab :: Eq Tab
 derive instance genericTab :: Generic Tab _
@@ -395,6 +381,7 @@ render state
       "CNAME" -> template (modal_content_simple CNAME) (foot_content CNAME)
       "NS"    -> template (modal_content_simple NS)    (foot_content NS)
       "MX"    -> template modal_content_mx     (foot_content MX)
+      "CAA"   -> template modal_content_caa    (foot_content CAA)
       "SRV"   -> template modal_content_srv    (foot_content SRV)
       "SPF"   -> template modal_content_spf    (foot_content SPF)
       "DKIM"  -> template modal_content_dkim   (foot_content DKIM)
@@ -458,6 +445,24 @@ render state
               (updateForm Field_Priority)
               (maybe "" show state._currentRR.priority)
           ]
+        modal_content_caa :: Array (HH.HTML w Action)
+        modal_content_caa =
+          [ render_errors
+          , Bulma.div_content [] [Bulma.explanation Explanations.caa_introduction]
+          , Bulma.input_with_side_text "domainCAA" "Name" "www"
+              (updateForm Field_Domain)
+              state._currentRR.name
+              display_domain_side
+          , Bulma.box_input ("ttlCAA") "TTL" "600"
+              (updateForm Field_TTL)
+              (show state._currentRR.ttl)
+          , Bulma.box_input ("targetCAA") "Target" "www"
+              (updateForm Field_Target)
+              state._currentRR.target
+          , Bulma.box_input ("priorityCAA") "Priority" "10"
+              (updateForm Field_Priority)
+              (maybe "" show state._currentRR.priority)
+          ]
         modal_content_srv :: Array (HH.HTML w Action)
         modal_content_srv =
           [ Bulma.div_content [] [Bulma.explanation Explanations.srv_introduction]
@@ -683,6 +688,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_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" ""
@@ -700,6 +706,7 @@ handleAction = case _ of
       CNAME -> H.modify_ _ { _currentRR = default_rr_CNAME }
       NS    -> H.modify_ _ { _currentRR = default_rr_NS }
       MX    -> H.modify_ _ { _currentRR = default_rr_MX }
+      CAA   -> H.modify_ _ { _currentRR = default_rr_CAA }
       SRV   -> H.modify_ _ { _currentRR = default_rr_SRV }
       SPF   -> H.modify_ _ { _currentRR = default_rr_SPF }
       DKIM  -> H.modify_ _ { _currentRR = default_rr_DKIM }

src/App/Text/Explanations.purs

@@ -259,6 +259,26 @@ ns_introduction =
   , Bulma.notification_danger' "🚨 Advice for beginners: do not use this resource record."
   ]
 
+caa_introduction :: forall w i. Array (HH.HTML w i)
+caa_introduction =
+  [ Bulma.p """
+    The CAA record enables to specify a certification authority that is authorized to issue certificates for the domain.
+    The idea is to reduce the risk of unintended certificate mis-issue.
+    """
+  , Bulma.p """
+    Certification authorities (CA) may issue certificates for any domain.
+    Thus, any CA may provide certificates for a domain (let's say google.com) to any hacker that can now impersonate the domain.
+    The CAA record allows to say what is the authorized CA for the domain, preventing this kind of attacks.
+    """
+  -- , HH.p []
+  --   [ HH.text "🚨 "
+  --   , HH.u_ [HH.text "Advice for beginners"]
+  --   , HH.text ":"
+  --   , HH.text """
+  --     """
+  --   ]
+  ]
+
 dkim_introduction :: forall w i. Array (HH.HTML w i)
 dkim_introduction =
   [ Bulma.p """

src/App/Type/AcceptedRRTypes.purs

@@ -14,6 +14,7 @@ data AcceptedRRTypes
   | CNAME
   | NS
   | MX
+  | CAA
   | SRV
   | SPF
   | DKIM

src/App/Type/CAA.purs

@@ -0,0 +1,57 @@
+-- | The Certification Authority Authorization (CAA) record is described in RFC8859.
+-- | The CAA record allows to specify Certification Authorities (CAs) authorized to issue certificates.
+module App.Type.CAA where
+
+import Prelude
+import Data.Generic.Rep (class Generic)
+import Data.Show.Generic (genericShow)
+
+import App.Type.GenericSerialization (generic_serialization)
+import Data.Maybe (Maybe(..))
+
+import Data.Codec.Argonaut (JsonCodec)
+import Data.Codec.Argonaut as CA
+import Data.Codec.Argonaut.Record as CAR
+
+-- | Flag: integer from 0 to 255.
+type CAA = { flag :: Int, tag :: Tag, value :: String }
+
+emptyCAARR :: CAA
+emptyCAARR = { flag: 0, tag: Issue, value: "" }
+
+codec :: JsonCodec CAA
+codec = CA.object "CAA" (CAR.record { flag: CA.int, tag: codecTag, value: CA.string })
+
+data Tag = Issue | IssueWild | IOdef | ContactEmail | ContactPhone
+
+tags :: Array Tag
+tags = [Issue, IssueWild, IOdef, ContactEmail, ContactPhone]
+
+tags_raw :: Array String
+tags_raw = map show tags
+
+tags_txt :: Array String
+tags_txt
+  = [ "Issue"
+    , "Issue for wildcard certificate requests"
+    , "Incident object description exchange format"
+    , "Contact email"
+    , "Contact phone"
+    ]
+
+-- | Codec for just encoding a single value of type `ReportOccasion`.
+codecTag :: CA.JsonCodec Tag
+codecTag = CA.prismaticCodec "Tag" str_to_tag generic_serialization CA.string
+
+str_to_tag :: String -> Maybe Tag
+str_to_tag = case _ of
+  "issue"        -> Just Issue
+  "issuewild"    -> Just IssueWild
+  "iodef"        -> Just IOdef
+  "contactemail" -> Just ContactEmail
+  "contactphone" -> Just ContactPhone
+  _ -> Nothing
+
+derive instance genericTag :: Generic Tag _
+instance showTag :: Show Tag where
+  show = genericShow

src/App/Type/ResourceRecord.purs

@@ -46,8 +46,7 @@ type ResourceRecord
 
     , dkim :: Maybe DKIM.DKIM
     , dmarc :: Maybe DMARC.DMARC
-
-    -- TODO: DMARC specific entries.
+    , caa :: Maybe CAA.CAA
     }
 
 codec :: JsonCodec ResourceRecord
@@ -87,6 +86,7 @@ codec = CA.object "ResourceRecord"
 
     , dkim:       CAR.optional DKIM.codec
     , dmarc:      CAR.optional DMARC.codec
+    , caa:        CAR.optional CAA.codec
     })
 
 type Mechanism
@@ -229,6 +229,7 @@ emptyRR
 
     , dkim:         Nothing
     , dmarc:        Nothing
+    , caa:          Nothing
     }
 
 data Qualifier = Pass | Neutral | SoftFail | HardFail