From bf2da895e046145a849044aae1a1493badcae047 Mon Sep 17 00:00:00 2001 From: Philippe PITTOLI Date: Sat, 8 Jun 2024 01:23:17 +0200 Subject: [PATCH] CAA record: modal seems fine. --- src/App/Page/Zone.purs | 55 +++++++++++++++++++++++++++----- src/App/Type/ResourceRecord.purs | 1 + src/Bulma.purs | 22 +++++++++++++ 3 files changed, 70 insertions(+), 8 deletions(-) diff --git a/src/App/Page/Zone.purs b/src/App/Page/Zone.purs index 3e29a3e..a9d656b 100644 --- a/src/App/Page/Zone.purs +++ b/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" - (updateForm Field_Target) + , Bulma.hr + , Bulma.box_input ("flagCAA") "Flag" "" + (updateForm Field_CAA_flag) state._currentRR.target - , Bulma.box_input ("priorityCAA") "Priority" "10" - (updateForm Field_Priority) - (maybe "" show state._currentRR.priority) + , Bulma.selection_field'' "tagCAA" "Tag" CAA_tag (A.zip CAA.tags_txt CAA.tags_raw) + CAA.Issue + (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 diff --git a/src/App/Type/ResourceRecord.purs b/src/App/Type/ResourceRecord.purs index 4745178..17166bd 100644 --- a/src/App/Type/ResourceRecord.purs +++ b/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 diff --git a/src/Bulma.purs b/src/Bulma.purs index c0df9f8..5ce9f84 100644 --- a/src/Bulma.purs +++ b/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