WIP: modal forms.

This commit is contained in:
Philippe Pittoli 2024-01-22 05:44:29 +01:00
parent c448521df7
commit 272237a5a1

View File

@ -100,6 +100,13 @@ data Add_RR
-- NEW -- NEW
| Add_A | Add_A
| Add_AAAA
| Add_TXT
| Add_CNAME
| Add_NS
| Add_MX
| Add_SRV
data Update_SRR_Form data Update_SRR_Form
= Update_SRR_Type Int = Update_SRR_Type Int
@ -283,35 +290,98 @@ render state
modal_add_new_rr :: forall w. AcceptedRRTypes -> State -> HH.HTML w Action modal_add_new_rr :: forall w. AcceptedRRTypes -> State -> HH.HTML w Action
modal_add_new_rr t { _newRR: rr } = case t of modal_add_new_rr t { _newRR: rr } = case t of
A -> template "A" content_a foot_a A -> template "A" (content_simple "A") (foot_content Add_A)
AAAA -> template "AAAA" [ Bulma.p "hello, new AAAA RR!" ] [] AAAA -> template "AAAA" (content_simple "AAAA") (foot_content Add_AAAA)
TXT -> template "TXT" [ Bulma.p "hello, new TXT RR!" ] [] TXT -> template "TXT" (content_simple "TXT") (foot_content Add_TXT)
CNAME -> template "CNAME" [ Bulma.p "hello, new CNAME RR!" ] [] CNAME -> template "CNAME" (content_simple "CNAME") (foot_content Add_CNAME)
NS -> template "NS" [ Bulma.p "hello, new NS RR!" ] [] NS -> template "NS" (content_simple "NS") (foot_content Add_NS)
MX -> template "MX" [ Bulma.p "hello, new MX RR!" ] [] MX -> template "MX" content_mx (foot_content Add_MX)
SRV -> template "SRV" [ Bulma.p "hello, new SRV RR!" ] [] SRV -> template "SRV" content_srv (foot_content Add_SRV)
where where
-- DRY -- DRY
update x = UpdateNewForm <<< Update_New_MODAL_Form_RR <<< x updateForm x = UpdateNewForm <<< Update_New_MODAL_Form_RR <<< x
content_a = content_simple :: String -> Array (HH.HTML w Action)
[ Bulma.box_input "domainA" "Domain" "www" -- id, title, placeholder content_simple t =
(update Update_MODAL_Domain) -- action [ Bulma.box_input ("domain" <> t) "Name" "www" -- id, title, placeholder
(updateForm Update_MODAL_Domain) -- action
rr.name -- value rr.name -- value
rr.valid -- validity (TODO) rr.valid -- validity (TODO)
should_be_disabled -- condition should_be_disabled -- condition
, Bulma.box_input "ttlA" "TTL" "3600" , Bulma.box_input ("ttl" <> t) "TTL" "600"
(update Update_MODAL_TTL) (updateForm Update_MODAL_TTL)
rr.ttl rr.ttl
rr.valid rr.valid
should_be_disabled should_be_disabled
, Bulma.box_input "targetA" "Target" "198.51.100.5" , Bulma.box_input ("target" <> t) "Target" "198.51.100.5"
(update Update_MODAL_Target) (updateForm Update_MODAL_Target)
rr.target rr.target
rr.valid rr.valid
should_be_disabled should_be_disabled
] ]
content_mx :: Array (HH.HTML w Action)
content_mx =
[ Bulma.box_input ("domainMX") "Name" "mail" -- id, title, placeholder
(updateForm Update_MODAL_Domain) -- action
rr.name -- value
rr.valid -- validity (TODO)
should_be_disabled -- condition
, Bulma.box_input ("ttlMX") "TTL" "600"
(updateForm Update_MODAL_TTL)
rr.ttl
rr.valid
should_be_disabled
, Bulma.box_input ("targetMX") "Target" "www"
(updateForm Update_MODAL_Target)
rr.target
rr.valid
should_be_disabled
, Bulma.box_input ("priorityMX") "Priority" "10"
(updateForm Update_MODAL_Priority)
rr.priority
rr.valid
should_be_disabled
]
content_srv :: Array (HH.HTML w Action)
content_srv =
[ Bulma.box_input ("domainSRV") "Name" "_sip._tcp" -- id, title, placeholder
(updateForm Update_MODAL_Domain) -- action
rr.name -- value
rr.valid -- validity (TODO)
should_be_disabled -- condition
, Bulma.box_input ("ttlSRV") "TTL" "600"
(updateForm Update_MODAL_TTL)
rr.ttl
rr.valid
should_be_disabled
, Bulma.box_input ("targetSRV") "Target" "www"
(updateForm Update_MODAL_Target)
rr.target
rr.valid
should_be_disabled
, Bulma.box_input ("prioritySRV") "Priority" "10"
(updateForm Update_MODAL_Priority)
rr.priority
rr.valid
should_be_disabled
, Bulma.box_input ("portSRV") "Port" "5061"
(updateForm Update_MODAL_Port)
rr.port
rr.valid
should_be_disabled
, Bulma.box_input ("weightSRV") "Weight" "100"
(updateForm Update_MODAL_Weight)
rr.weight
rr.valid
should_be_disabled
, Bulma.box_input ("protocolSRV") "Protocol" "tcp"
(updateForm Update_MODAL_Protocol)
rr.protocol
rr.valid
should_be_disabled
]
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true)) should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
foot_a = [Bulma.btn_add (AddRR Add_A) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid] foot_content x = [Bulma.btn_add (AddRR x) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid]
template t content foot = Bulma.modal template t content foot = Bulma.modal
[ Bulma.modal_background [ Bulma.modal_background
, Bulma.modal_card [Bulma.modal_header $ "New " <> t <> " resource record" , Bulma.modal_card [Bulma.modal_header $ "New " <> t <> " resource record"
@ -329,7 +399,44 @@ handleAction = case _ of
H.modify_ _ { active_modal = Just rr_id } H.modify_ _ { active_modal = Just rr_id }
NewRRModal t -> do NewRRModal t -> do
state <- H.get
H.modify_ _ { active_new_rr_modal = Just t } H.modify_ _ { active_new_rr_modal = Just t }
let defaultA = { rrtype: "A", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
, name: "www"
, target: "192.0.2.1"
, port: "", weight: "", priority: "", protocol: ""}
defaultAAAA = { rrtype: "AAAA", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
, name: "www"
, target: "2001:db8::1"
, port: "", weight: "", priority: "", protocol: ""}
defaultTXT = { rrtype: "TXT", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
, name: "txt"
, target: "some text"
, port: "", weight: "", priority: "", protocol: ""}
defaultCNAME = { rrtype: "CNAME", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
, name: "blog"
, target: "www"
, port: "", weight: "", priority: "", protocol: ""}
defaultNS = { rrtype: "NS", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
, name: (state._domain <> ".")
, target: "ns0.example.com."
, port: "", weight: "", priority: "", protocol: ""}
defaultMX = { rrtype: "MX", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
, name: "mail"
, target: "www"
, port: "", weight: "", priority: "10", protocol: ""}
defaultSRV = { rrtype: "SRV", rrid: 0, modified: false, valid: true, ttl: "600", readonly: false
, name: "_sip._tcp"
, target: "www"
, port: "5061", weight: "100", priority: "10", protocol: "tcp"}
case t of
A -> H.modify_ _ { _newRR = defaultA }
AAAA -> H.modify_ _ { _newRR = defaultAAAA }
TXT -> H.modify_ _ { _newRR = defaultTXT }
CNAME -> H.modify_ _ { _newRR = defaultCNAME }
NS -> H.modify_ _ { _newRR = defaultNS }
MX -> H.modify_ _ { _newRR = defaultMX }
SRV -> H.modify_ _ { _newRR = defaultSRV }
Initialize -> do Initialize -> do
{ _domain } <- H.get { _domain } <- H.get
@ -442,6 +549,18 @@ handleAction = case _ of
AddRR form -> case form of AddRR form -> case form of
Add_A -> do Add_A -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a A RR blah blah blah" H.raise $ Log $ SimpleLog "TODO: trying to add a A RR blah blah blah"
Add_AAAA -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a AAAA RR blah blah blah"
Add_TXT -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a TXT RR blah blah blah"
Add_CNAME -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a CNAME RR blah blah blah"
Add_NS -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a NS RR blah blah blah"
Add_MX -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a MX RR blah blah blah"
Add_SRV -> do
H.raise $ Log $ SimpleLog "TODO: trying to add a SRV RR blah blah blah"
---- TODO ---- TODO
--state <- H.get --state <- H.get
--try_add_new_entry state._domain (Validation.validateA state._newRR) "simple" --try_add_new_entry state._domain (Validation.validateA state._newRR) "simple"