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 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 in toRR_srv form.rrid form.readonly "SRV" name ttl target priority port protocol weight
validation :: ResourceRecord -> AcceptedRRTypes -> Either AVErrors ResourceRecord validation :: ResourceRecord -> Either AVErrors ResourceRecord
validation entry t = case t of validation entry = case entry.rrtype of
A -> toEither $ validationA entry "A" -> toEither $ validationA entry
AAAA -> toEither $ validationAAAA entry "AAAA" -> toEither $ validationAAAA entry
TXT -> toEither $ validationTXT entry "TXT" -> toEither $ validationTXT entry
CNAME -> toEither $ validationCNAME entry "CNAME" -> toEither $ validationCNAME entry
NS -> toEither $ validationNS entry "NS" -> toEither $ validationNS entry
MX -> toEither $ validationMX entry "MX" -> toEither $ validationMX entry
SRV -> toEither $ validationSRV entry "SRV" -> toEither $ validationSRV entry
--_ -> toEither $ invalid [UNKNOWN] _ -> toEither $ invalid [UNKNOWN]
id :: forall a. a -> a id :: forall a. a -> a
id x = x id x = x

55
src/App/ZoneInterface.purs
View File

@ -162,7 +162,8 @@ data Action
| ValidateRR AcceptedRRTypes | ValidateRR AcceptedRRTypes
-- | Validate the entries in an already existing resource record. -- | 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. -- | Save the changes done in an already existing resource record.
| SaveRR ResourceRecord | SaveRR ResourceRecord
@ -465,9 +466,10 @@ render state
] ]
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_content x = [ Bulma.btn_add (ValidateRR x) foot_content x = [ case state.rr_modal of
(TellSomethingWentWrong state._currentRR.rrid "cannot add") NewRRModal _ -> Bulma.btn_add (ValidateRR x) (TellSomethingWentWrong state._currentRR.rrid "cannot add") true -- state._currentRR.valid
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 template content foot = Bulma.modal
[ Bulma.modal_background [ Bulma.modal_background
@ -497,7 +499,9 @@ handleAction = case _ of
state <- H.get state <- H.get
case first (\rr -> rr.rrid == rr_id) state._resources of case first (\rr -> rr.rrid == rr_id) state._resources of
Nothing -> H.raise $ Log $ SimpleLog $ "RR not found (RR " <> show rr_id <> ")" 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. -- | Each time a "new RR" button is clicked, the form resets.
CreateNewRRModal t -> do CreateNewRRModal t -> do
@ -649,7 +653,7 @@ handleAction = case _ of
-- | Else, the different errors are added to the state. -- | Else, the different errors are added to the state.
ValidateRR t -> do ValidateRR t -> do
state <- H.get state <- H.get
case Validation.validation state._currentRR t of case Validation.validation state._currentRR of
Left actual_errors -> do Left actual_errors -> do
-- H.raise $ Log $ SimpleLog $ "Cannot add this " <> show t <> " RR, some errors occured in the record:" -- 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 -- loopE (\v -> H.raise $ Log $ SimpleLog $ "==> " <> show_error v) actual_errors
@ -755,22 +759,17 @@ handleAction = case _ of
state <- H.get state <- H.get
H.modify_ _ { _srvrr = (update_port rr_id val state._srvrr) } H.modify_ _ { _srvrr = (update_port rr_id val state._srvrr) }
-- | validate any local RR with the new _resources and _local_errors. -- | Validate any local RR with the new `_resources` and `_local_errors`.
ValidateLocal local_rr_id t -> do ValidateLocal -> do
state <- H.get state <- H.get
case first (\rr -> rr.rrid == local_rr_id) state._resources of case Validation.validation state._currentRR of
Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find RR number: " <> show local_rr_id Left actual_errors -> do
Just local_rr -> do H.modify_ _ { _currentRR_errors = actual_errors }
case Validation.validation local_rr t of H.raise $ Log $ SimpleLog $ "[😈] Errors in RR id " <> show state._currentRR.rrid
Left actual_errors -> do <> ". Please fix them before update."
let new_error_hash = Hash.insert local_rr.rrid actual_errors state._local_errors Right rr -> do
H.modify_ _ { _local_errors = new_error_hash } H.modify_ _ { _currentRR_errors = [] }
H.raise $ Log $ SimpleLog $ "[😈] Errors in RR id " <> show local_rr_id handleAction $ SaveRR rr
<> ". 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 }
handleAction $ SaveRR rr
SaveRR rr -> do SaveRR rr -> do
state <- H.get state <- H.get
@ -848,6 +847,9 @@ handleQuery = case _ of
case message of case message of
(DNSManager.MkRRUpdated response) -> do (DNSManager.MkRRUpdated response) -> do
replace_entry response.rr 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 (DNSManager.MkRRAdded response) -> do
state <- H.get state <- H.get
let new_rr = response.rr let new_rr = response.rr
@ -862,6 +864,7 @@ handleQuery = case _ of
H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= response.rrid) state._srr H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= response.rrid) state._srr
, _mxrr = A.filter (\rr -> rr.rrid /= response.rrid) state._mxrr , _mxrr = A.filter (\rr -> rr.rrid /= response.rrid) state._mxrr
, _srvrr = A.filter (\rr -> rr.rrid /= response.rrid) state._srvrr , _srvrr = A.filter (\rr -> rr.rrid /= response.rrid) state._srvrr
, _resources = A.filter (\rr -> rr.rrid /= response.rrid) state._resources
} }
-- Remove its possible errors. -- Remove its possible errors.
let new_error_hash = Hash.delete response.rrid state._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 H.modify_ _ { _srr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._srr
, _mxrr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._mxrr , _mxrr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._mxrr
, _srvrr = A.filter (\rr -> rr.rrid /= new_rr.rrid) state._srvrr , _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 new_state <- H.get
@ -895,6 +899,7 @@ handleQuery = case _ of
Right s -> H.put s Right s -> H.put s
new_state2 <- H.get new_state2 <- H.get
H.put $ add_RR new_state2 new_rr 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 [] = H.raise $ Log $ SimpleLog "[🎉] Zone fully loaded!"
add_entries arr = do add_entries arr = do
@ -1010,7 +1015,7 @@ render_resources errors records
] ]
where where
table_rr = Bulma.table [] [ table_content ] 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 rows rr = [ HH.tr_ $ render_row rr ] -- <> error_row rr
-- error_row rr = case Hash.lookup rr.rrid errors of -- 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.weight ]
, HH.td_ [ Bulma.p $ maybe "" show rr.port ] , HH.td_ [ Bulma.p $ maybe "" show rr.port ]
, HH.td_ [ Bulma.p rr.target ] , 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) ] , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.rrid) ]
] ]
"MX" -> "MX" ->
@ -1046,7 +1051,7 @@ render_resources errors records
, HH.td_ [ Bulma.p $ show rr.ttl ] , HH.td_ [ Bulma.p $ show rr.ttl ]
, HH.td_ [ Bulma.p $ maybe "" show rr.priority ] , HH.td_ [ Bulma.p $ maybe "" show rr.priority ]
, HH.td_ [ Bulma.p rr.target ] , 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) ] , 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 rr.name]
, HH.td_ [ Bulma.p $ show rr.ttl ] , HH.td_ [ Bulma.p $ show rr.ttl ]
, HH.td_ [ Bulma.p rr.target ] , 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) ] , 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 ] , 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 :: forall w i. i -> i -> Boolean -> Boolean -> HH.HTML w i
btn_change action1 action2 modified validity btn_change action1 action2 modified validity