CAA record: modal seems fine.
parent
36e532a61a
commit
bf2da895e0
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue