karchnu/halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

ZoneInterface: the interface change is almost complete.

Browse Source
This commit is contained in:
Philippe Pittoli 2024-02-06 03:20:29 +01:00
parent cf6370640d
commit 6367bf8a86
3 changed files with 53 additions and 35 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

20
src/App/Validation.purs
View File

@ -579,16 +579,16 @@ validationSRV form = ado
weight <- is_between min_weight max_weight (maybe 0 id form.weight) VEWeight
in toRR_srv form.rrid form.readonly "SRV" name ttl target priority port protocol weight
validation :: ResourceRecord -> AcceptedRRTypes -> Either AVErrors ResourceRecord
validation entry t = case t of
A -> toEither $ validationA entry
AAAA -> toEither $ validationAAAA entry
TXT -> toEither $ validationTXT entry
CNAME -> toEither $ validationCNAME entry
NS -> toEither $ validationNS entry
MX -> toEither $ validationMX entry
SRV -> toEither $ validationSRV entry
--_ -> toEither $ invalid [UNKNOWN]
validation :: ResourceRecord -> Either AVErrors ResourceRecord
validation entry = case entry.rrtype of
"A" -> toEither $ validationA entry
"AAAA" -> toEither $ validationAAAA entry
"TXT" -> toEither $ validationTXT entry
"CNAME" -> toEither $ validationCNAME entry
"NS" -> toEither $ validationNS entry
"MX" -> toEither $ validationMX entry
"SRV" -> toEither $ validationSRV entry
_ -> toEither $ invalid [UNKNOWN]
id :: forall a. a -> a
id x = x

47
src/App/ZoneInterface.purs
View File

@ -162,7 +162,8 @@ data Action
| ValidateRR AcceptedRRTypes
-- | Validate the entries in an already existing resource record.
| ValidateLocal RRId AcceptedRRTypes
-- | Automatically calls for `SaveRR` once record is verified.
| ValidateLocal
-- | Save the changes done in an already existing resource record.
| SaveRR ResourceRecord
@ -465,9 +466,10 @@ render state
]
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
foot_content x = [ Bulma.btn_add (ValidateRR x)
(TellSomethingWentWrong state._currentRR.rrid "cannot add")
true -- state._currentRR.valid
foot_content x = [ case state.rr_modal of
NewRRModal _ -> Bulma.btn_add (ValidateRR x) (TellSomethingWentWrong state._currentRR.rrid "cannot add") true -- state._currentRR.valid
UpdateRRModal -> Bulma.btn_save ValidateLocal
_ -> Bulma.p "state.rr_modal should either be NewRRModal or UpdateRRModal."
]
template content foot = Bulma.modal
[ Bulma.modal_background
@ -497,7 +499,9 @@ handleAction = case _ of
state <- H.get
case first (\rr -> rr.rrid == rr_id) state._resources of
Nothing -> H.raise $ Log $ SimpleLog $ "RR not found (RR " <> show rr_id <> ")"
Just rr -> H.modify_ _ { _currentRR = rr }
Just rr -> do
H.modify_ _ { _currentRR = rr }
H.modify_ _ { rr_modal = UpdateRRModal }
-- | Each time a "new RR" button is clicked, the form resets.
CreateNewRRModal t -> do
@ -649,7 +653,7 @@ handleAction = case _ of
-- | Else, the different errors are added to the state.
ValidateRR t -> do
state <- H.get
case Validation.validation state._currentRR t of
case Validation.validation state._currentRR of
Left actual_errors -> do
-- H.raise $ Log $ SimpleLog $ "Cannot add this " <> show t <> " RR, some errors occured in the record:"
-- loopE (\v -> H.raise $ Log $ SimpleLog $ "==> " <> show_error v) actual_errors
@ -755,21 +759,16 @@ handleAction = case _ of
state <- H.get
H.modify_ _ { _srvrr = (update_port rr_id val state._srvrr) }
-- | validate any local RR with the new _resources and _local_errors.
ValidateLocal local_rr_id t -> do
-- | Validate any local RR with the new `_resources` and `_local_errors`.
ValidateLocal -> do
state <- H.get
case first (\rr -> rr.rrid == local_rr_id) state._resources of
Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find RR number: " <> show local_rr_id
Just local_rr -> do
case Validation.validation local_rr t of
case Validation.validation state._currentRR of
Left actual_errors -> do
let new_error_hash = Hash.insert local_rr.rrid actual_errors state._local_errors
H.modify_ _ { _local_errors = new_error_hash }
H.raise $ Log $ SimpleLog $ "[😈] Errors in RR id " <> show local_rr_id
H.modify_ _ { _currentRR_errors = actual_errors }
H.raise $ Log $ SimpleLog $ "[😈] Errors in RR id " <> show state._currentRR.rrid
<> ". Please fix them before update."
Right rr -> do
let new_error_hash = Hash.delete local_rr.rrid state._local_errors
H.modify_ _ { _local_errors = new_error_hash }
H.modify_ _ { _currentRR_errors = [] }
handleAction $ SaveRR rr
SaveRR rr -> do
@ -848,6 +847,9 @@ handleQuery = case _ of
case message of
(DNSManager.MkRRUpdated response) -> do
replace_entry response.rr
-- When an update is received for a record, it means
-- the update request has been accepted, the current modal can be closed.
H.modify_ _ { rr_modal = NoModal }
(DNSManager.MkRRAdded response) -> do
state <- H.get
let new_rr = response.rr
@ -862,6 +864,7 @@ handleQuery = case _ of
H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= response.rrid) state._srr
, _mxrr = A.filter (\rr -> rr.rrid /= response.rrid) state._mxrr
, _srvrr = A.filter (\rr -> rr.rrid /= response.rrid) state._srvrr
, _resources = A.filter (\rr -> rr.rrid /= response.rrid) state._resources
}
-- Remove its possible errors.
let new_error_hash = Hash.delete response.rrid state._errors
@ -887,6 +890,7 @@ handleQuery = case _ of
H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._srr
, _mxrr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._mxrr
, _srvrr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._srvrr
, _resources = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._resources
}
new_state <- H.get
@ -895,6 +899,7 @@ handleQuery = case _ of
Right s -> H.put s
new_state2 <- H.get
H.put $ add_RR new_state2 new_rr
H.raise $ Log $ SimpleLog $ "Replacing a resource record! Should be visible everywhere!"
add_entries [] = H.raise $ Log $ SimpleLog "[🎉] Zone fully loaded!"
add_entries arr = do
@ -1010,7 +1015,7 @@ render_resources errors records
]
where
table_rr = Bulma.table [] [ table_content ]
table_content = HH.tbody_ $ A.concat $ map rows records
table_content = HH.tbody_ $ A.concat $ map rows $ A.filter (\rr -> rr.rrtype /= "SOA") records
rows rr = [ HH.tr_ $ render_row rr ] -- <> error_row rr
-- error_row rr = case Hash.lookup rr.rrid errors of
@ -1037,7 +1042,7 @@ render_resources errors records
, HH.td_ [ Bulma.p $ maybe "" show rr.weight ]
, HH.td_ [ Bulma.p $ maybe "" show rr.port ]
, HH.td_ [ Bulma.p rr.target ]
, HH.td_ [ Bulma.btn_change (CreateUpdateRRModal rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") true true ]
, HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
, HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
]
"MX" ->
@ -1046,7 +1051,7 @@ render_resources errors records
, HH.td_ [ Bulma.p $ show rr.ttl ]
, HH.td_ [ Bulma.p $ maybe "" show rr.priority ]
, HH.td_ [ Bulma.p rr.target ]
, HH.td_ [ Bulma.btn_change (CreateUpdateRRModal rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") true true ]
, HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
, HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
]
_ ->
@ -1054,7 +1059,7 @@ render_resources errors records
, HH.td_ [ Bulma.p rr.name]
, HH.td_ [ Bulma.p $ show rr.ttl ]
, HH.td_ [ Bulma.p rr.target ]
, HH.td_ [ Bulma.btn_change (CreateUpdateRRModal rr.rrid) (TellSomethingWentWrong rr.rrid "cannot update") true true ]
, HH.td_ [ Bulma.btn_modify (CreateUpdateRRModal rr.rrid) ]
, HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
]

13
src/Bulma.purs
View File

@ -266,6 +266,19 @@ box_input_port action port validity = HH.label [ ]
, HH.div [HP.classes C.control ] [ input_port action port validity ]
]
btn_modify :: forall w i. i -> HH.HTML w i
btn_modify action
= HH.button
[ HE.onClick \_ -> action
, HP.classes $ btn_classes true
] [ HH.text "modify" ]
btn_save :: forall w i. i -> HH.HTML w i
btn_save action
= HH.button
[ HE.onClick \_ -> action
, HP.classes $ btn_classes true
] [ HH.text "save" ]
btn_change :: forall w i. i -> i -> Boolean -> Boolean -> HH.HTML w i
btn_change action1 action2 modified validity