diff --git a/src/App/Page/Zone.purs b/src/App/Page/Zone.purs index 2c1bd4d..3e29a3e 100644 --- a/src/App/Page/Zone.purs +++ b/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 } diff --git a/src/App/Text/Explanations.purs b/src/App/Text/Explanations.purs index 85520a8..f41514d 100644 --- a/src/App/Text/Explanations.purs +++ b/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 """ diff --git a/src/App/Type/AcceptedRRTypes.purs b/src/App/Type/AcceptedRRTypes.purs index 29348f2..9a6aaa4 100644 --- a/src/App/Type/AcceptedRRTypes.purs +++ b/src/App/Type/AcceptedRRTypes.purs @@ -14,6 +14,7 @@ data AcceptedRRTypes | CNAME | NS | MX + | CAA | SRV | SPF | DKIM diff --git a/src/App/Type/CAA.purs b/src/App/Type/CAA.purs new file mode 100644 index 0000000..d3ccbcc --- /dev/null +++ b/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 diff --git a/src/App/Type/ResourceRecord.purs b/src/App/Type/ResourceRecord.purs index 647f168..4745178 100644 --- a/src/App/Type/ResourceRecord.purs +++ b/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