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

All updates in only two actions.

Browse Source
This commit is contained in:
Philippe Pittoli 2023-07-12 14:19:07 +02:00
parent c307e1679e
commit f0db34d694
1 changed files with 214 additions and 199 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

127
src/App/ZoneInterface.purs
View File

@ -77,6 +77,11 @@ type Input = String
-- | - remove a resource record -- | - remove a resource record
-- | - handle user inputs -- | - handle user inputs
data Add_RR
= Add_SRR
| Add_MXRR
| Add_SRVRR
data Update_SRR_Form data Update_SRR_Form
= Update_SRR_Type Int = Update_SRR_Type Int
| Update_SRR_Domain RecordDomain | Update_SRR_Domain RecordDomain
@ -98,6 +103,16 @@ data Update_SRV_Form
| Update_SRV_Weight Weight | Update_SRV_Weight Weight
| Update_SRV_Port Port | Update_SRV_Port Port
data Update_New_Form
= Update_New_Form_SRR Update_SRR_Form
| Update_New_Form_MXRR Update_MX_Form
| Update_New_Form_SRVRR Update_SRV_Form
data Update_Local_Form
= Update_Local_Form_SRR Update_SRR_Form
| Update_Local_Form_MXRR Update_MX_Form
| Update_Local_Form_SRVRR Update_SRV_Form
data Action data Action
= DeleteRRModal RRId = DeleteRRModal RRId
| CancelModal | CancelModal
@ -105,20 +120,14 @@ data Action
| Initialize | Initialize
| Finalize | Finalize
-- New entries.
| UpdateNewSRRForm Update_SRR_Form
| UpdateNewMXForm Update_MX_Form
| UpdateNewSRVForm Update_SRV_Form
-- Add new entries. -- Add new entries.
| AddSRR | AddRR Add_RR
| AddMX
| AddSRV
-- Entry already in our zone. -- Update new entry forms.
| UpdateLocalSRRForm RRId Update_SRR_Form | UpdateNewForm Update_New_Form
| UpdateLocalMXForm RRId Update_MX_Form
| UpdateLocalSRVForm RRId Update_SRV_Form -- Update an already active entry.
| UpdateLocalForm RRId Update_Local_Form
| SyncRR RRId | SyncRR RRId
| RemoveRR RRId | RemoveRR RRId
@ -242,7 +251,8 @@ handleAction = case _ of
Finalize -> do Finalize -> do
H.raise $ Log $ SimpleLog "Finalized!" H.raise $ Log $ SimpleLog "Finalized!"
UpdateNewSRRForm rr_update -> case rr_update of UpdateNewForm form -> case form of
Update_New_Form_SRR rr_update -> case rr_update of
Update_SRR_Type val -> do Update_SRR_Type val -> do
-- let new_type = fromMaybe "unknown" (baseRecords A.!! val) -- let new_type = fromMaybe "unknown" (baseRecords A.!! val)
-- H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type) -- H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type)
@ -258,7 +268,7 @@ handleAction = case _ of
-- H.raise $ Log $ SimpleLog ("Update new entry value: " <> val) -- H.raise $ Log $ SimpleLog ("Update new entry value: " <> val)
H.modify_ _ { _current_entry { value = val } } H.modify_ _ { _current_entry { value = val } }
UpdateNewMXForm rr_update -> case rr_update of Update_New_Form_MXRR rr_update -> case rr_update of
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
Update_MX_Domain val -> do Update_MX_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update new MX entry domain: " <> val) -- H.raise $ Log $ SimpleLog ("Update new MX entry domain: " <> val)
@ -279,7 +289,7 @@ handleAction = case _ of
state <- H.get state <- H.get
H.modify_ _ { _current_entry_mx = state._current_entry_mx { priority = val } } H.modify_ _ { _current_entry_mx = state._current_entry_mx { priority = val } }
UpdateNewSRVForm rr_update -> case rr_update of Update_New_Form_SRVRR rr_update -> case rr_update of
Update_SRV_Domain val -> do Update_SRV_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry domain: " <> val) -- H.raise $ Log $ SimpleLog ("Update new SRV entry domain: " <> val)
state <- H.get state <- H.get
@ -310,9 +320,9 @@ handleAction = case _ of
state <- H.get state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv { port = val } } H.modify_ _ { _current_entry_srv = state._current_entry_srv { port = val } }
-- This action only is possible if inputs are correct. -- This action only is possible if inputs are correct.
AddSRR -> do AddRR form -> case form of
Add_SRR -> do
state <- H.get state <- H.get
let newrr = fromLocalSimpleRRRepresentationToResourceRecord state._current_entry let newrr = fromLocalSimpleRRRepresentationToResourceRecord state._current_entry
H.raise $ Log $ SimpleLog ("Add new simple RR: " <> show state._current_entry) H.raise $ Log $ SimpleLog ("Add new simple RR: " <> show state._current_entry)
@ -320,7 +330,8 @@ handleAction = case _ of
$ DNSManager.serialize $ DNSManager.serialize
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr } $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
H.raise $ MessageToSend message H.raise $ MessageToSend message
AddMX -> do
Add_MXRR -> do
state <- H.get state <- H.get
let newrr = fromLocalMXRRRepresentationToResourceRecord state._current_entry_mx let newrr = fromLocalMXRRRepresentationToResourceRecord state._current_entry_mx
H.raise $ Log $ SimpleLog ("Add new MX: " <> show state._current_entry_mx) H.raise $ Log $ SimpleLog ("Add new MX: " <> show state._current_entry_mx)
@ -328,16 +339,20 @@ handleAction = case _ of
$ DNSManager.serialize $ DNSManager.serialize
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr } $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
H.raise $ MessageToSend message H.raise $ MessageToSend message
AddSRV -> do
Add_SRVRR -> do
state <- H.get state <- H.get
let newrr = fromLocalSRVRRepresentationToResourceRecord state._current_entry_srv case fromLocalToRR state._current_entry_srv of
H.raise $ Log $ SimpleLog ("Add new SRV: " <> show state._current_entry_srv) Left errmsg -> H.raise $ Log $ SimpleLog $ "Add new SRV failed: " <> errmsg
Right newrr -> do
H.raise $ Log $ SimpleLog $ "Add new SRV: " <> show state._current_entry_srv
message <- H.liftEffect message <- H.liftEffect
$ DNSManager.serialize $ DNSManager.serialize
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr } $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
H.raise $ MessageToSend message H.raise $ MessageToSend message
UpdateLocalSRRForm rr_id rr_update -> case rr_update of UpdateLocalForm rr_id form -> case form of
Update_Local_Form_SRR rr_update -> case rr_update of
Update_SRR_Type val -> do Update_SRR_Type val -> do
let new_type = fromMaybe "unknown" (baseRecords A.!! val) let new_type = fromMaybe "unknown" (baseRecords A.!! val)
H.raise $ Log $ SimpleLog ("TODO: Update local RR " <> show rr_id <> " type: " <> new_type) H.raise $ Log $ SimpleLog ("TODO: Update local RR " <> show rr_id <> " type: " <> new_type)
@ -356,7 +371,7 @@ handleAction = case _ of
state <- H.get state <- H.get
H.modify_ _ { _srr = (update_value rr_id val state._srr) } H.modify_ _ { _srr = (update_value rr_id val state._srr) }
UpdateLocalMXForm rr_id rr_update -> case rr_update of Update_Local_Form_MXRR rr_update -> case rr_update of
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
Update_MX_Domain val -> do Update_MX_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update local MX RR " <> show rr_id <> " domain: " <> val) -- H.raise $ Log $ SimpleLog ("Update local MX RR " <> show rr_id <> " domain: " <> val)
@ -377,7 +392,7 @@ handleAction = case _ of
state <- H.get state <- H.get
H.modify_ _ { _mxrr = (update_priority rr_id val state._mxrr) } H.modify_ _ { _mxrr = (update_priority rr_id val state._mxrr) }
UpdateLocalSRVForm rr_id rr_update -> case rr_update of Update_Local_Form_SRVRR rr_update -> case rr_update of
Update_SRV_Domain val -> do Update_SRV_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry domain: " <> val) -- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry domain: " <> val)
state <- H.get state <- H.get
@ -595,9 +610,9 @@ render_records records
row rr = HH.tr_ $ row rr = HH.tr_ $
[ Bulma.txt_name rr.t [ Bulma.txt_name rr.t
, HH.td_ [ Bulma.input_domain ((UpdateLocalSRRForm rr.id) <<< Update_SRR_Domain) rr.domain rr.valid ] , HH.td_ [ Bulma.input_domain ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRR <<< Update_SRR_Domain) rr.domain rr.valid ]
, HH.td_ [ Bulma.input_ttl ((UpdateLocalSRRForm rr.id) <<< Update_SRR_TTL ) rr.ttl rr.valid ] , HH.td_ [ Bulma.input_ttl ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRR <<< Update_SRR_TTL ) rr.ttl rr.valid ]
, HH.td_ [ Bulma.input_value ((UpdateLocalSRRForm rr.id) <<< Update_SRR_Value) rr.value rr.valid ] , HH.td_ [ Bulma.input_value ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRR <<< Update_SRR_Value) rr.value rr.valid ]
, HH.td_ [ Bulma.btn_change (SyncRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ] , HH.td_ [ Bulma.btn_change (SyncRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ]
, HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.id) ] , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.id) ]
] ]
@ -619,10 +634,10 @@ render_mx_records records
table_content = HH.tbody_ $ map row records table_content = HH.tbody_ $ map row records
row rr = HH.tr_ $ row rr = HH.tr_ $
[ HH.td_ [ Bulma.input_domain ((UpdateLocalMXForm rr.id) <<< Update_MX_Domain) rr.domain rr.valid ] [ HH.td_ [ Bulma.input_domain ((UpdateLocalForm rr.id) <<< Update_Local_Form_MXRR <<< Update_MX_Domain) rr.domain rr.valid ]
, HH.td_ [ Bulma.input_ttl ((UpdateLocalMXForm rr.id) <<< Update_MX_TTL) rr.ttl rr.valid ] , HH.td_ [ Bulma.input_ttl ((UpdateLocalForm rr.id) <<< Update_Local_Form_MXRR <<< Update_MX_TTL) rr.ttl rr.valid ]
, HH.td_ [ Bulma.input_priority ((UpdateLocalMXForm rr.id) <<< Update_MX_Priority) rr.priority rr.valid ] , HH.td_ [ Bulma.input_priority ((UpdateLocalForm rr.id) <<< Update_Local_Form_MXRR <<< Update_MX_Priority) rr.priority rr.valid ]
, HH.td_ [ Bulma.input_value ((UpdateLocalMXForm rr.id) <<< Update_MX_Value) rr.value rr.valid ] , HH.td_ [ Bulma.input_value ((UpdateLocalForm rr.id) <<< Update_Local_Form_MXRR <<< Update_MX_Value) rr.value rr.valid ]
, HH.td_ [ Bulma.btn_change (SyncRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ] , HH.td_ [ Bulma.btn_change (SyncRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ]
, HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.id) ] , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.id) ]
] ]
@ -643,13 +658,13 @@ render_srv_records records
table_content = HH.tbody_ $ map row records table_content = HH.tbody_ $ map row records
row rr = HH.tr_ $ row rr = HH.tr_ $
[ HH.td_ [ Bulma.input_domain ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Domain ) rr.domain rr.valid ] [ HH.td_ [ Bulma.input_domain ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_Domain ) rr.domain rr.valid ]
, HH.td_ [ Bulma.input_ttl ((UpdateLocalSRVForm rr.id) <<< Update_SRV_TTL ) rr.ttl rr.valid ] , HH.td_ [ Bulma.input_ttl ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_TTL ) rr.ttl rr.valid ]
, HH.td_ [ Bulma.input_priority ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Priority) rr.priority rr.valid ] , HH.td_ [ Bulma.input_priority ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_Priority) rr.priority rr.valid ]
, HH.td_ [ Bulma.input_protocol ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Protocol) rr.protocol rr.valid ] , HH.td_ [ Bulma.input_protocol ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_Protocol) rr.protocol rr.valid ]
, HH.td_ [ Bulma.input_weight ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Weight ) rr.weight rr.valid ] , HH.td_ [ Bulma.input_weight ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_Weight ) rr.weight rr.valid ]
, HH.td_ [ Bulma.input_port ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Port ) rr.port rr.valid ] , HH.td_ [ Bulma.input_port ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_Port ) rr.port rr.valid ]
, HH.td_ [ Bulma.input_value ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Value ) rr.value rr.valid ] , HH.td_ [ Bulma.input_value ((UpdateLocalForm rr.id) <<< Update_Local_Form_SRVRR <<< Update_SRV_Value ) rr.value rr.valid ]
, HH.td_ [ Bulma.btn_change (SyncRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ] , HH.td_ [ Bulma.btn_change (SyncRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ]
, HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.id) ] , HH.td_ [ Bulma.btn_delete (\_ -> DeleteRRModal rr.id) ]
] ]
@ -681,16 +696,16 @@ render_new_record_column_simple rr
= Bulma.column_ $ [ Bulma.box = Bulma.column_ $ [ Bulma.box
[ Bulma.zone_rr_title "NS, A, AAAA, CNAME, TXT" [ Bulma.zone_rr_title "NS, A, AAAA, CNAME, TXT"
, type_selection , type_selection
, Bulma.box_input_domain (UpdateNewSRRForm <<< Update_SRR_Domain) rr.domain rr.valid , Bulma.box_input_domain (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Domain) rr.domain rr.valid
, Bulma.box_input_ttl (UpdateNewSRRForm <<< Update_SRR_TTL) rr.ttl rr.valid , Bulma.box_input_ttl (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_TTL) rr.ttl rr.valid
, Bulma.box_input_value (UpdateNewSRRForm <<< Update_SRR_Value) rr.value rr.valid , Bulma.box_input_value (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Value) rr.value rr.valid
, Bulma.btn_add AddSRR (TellSomethingWentWrong rr.id "cannot add") rr.valid , Bulma.btn_add (AddRR Add_SRR) (TellSomethingWentWrong rr.id "cannot add") rr.valid
] ]
] ]
where where
-- type_selection :: forall w i. HH.HTML w i -- type_selection :: forall w i. HH.HTML w i
type_selection = HH.select type_selection = HH.select
[ HE.onSelectedIndexChange (UpdateNewSRRForm <<< Update_SRR_Type) ] [ HE.onSelectedIndexChange (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Type) ]
$ map type_option baseRecords $ map type_option baseRecords
type_option n type_option n
= HH.option = HH.option
@ -703,11 +718,11 @@ render_new_record_colunm_mx :: forall (w :: Type). (MXRR ()) -> HH.HTML w Action
render_new_record_colunm_mx rr render_new_record_colunm_mx rr
= Bulma.column_ $ [ Bulma.box = Bulma.column_ $ [ Bulma.box
[ Bulma.zone_rr_title "MX" [ Bulma.zone_rr_title "MX"
, Bulma.box_input_domain (UpdateNewMXForm <<< Update_MX_Domain) rr.domain rr.valid , Bulma.box_input_domain (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Domain) rr.domain rr.valid
, Bulma.box_input_ttl (UpdateNewMXForm <<< Update_MX_TTL) rr.ttl rr.valid , Bulma.box_input_ttl (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_TTL) rr.ttl rr.valid
, Bulma.box_input_priority (UpdateNewMXForm <<< Update_MX_Priority) rr.priority rr.valid , Bulma.box_input_priority (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Priority) rr.priority rr.valid
, Bulma.box_input_value (UpdateNewMXForm <<< Update_MX_Value) rr.value rr.valid , Bulma.box_input_value (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Value) rr.value rr.valid
, Bulma.btn_add AddMX (TellSomethingWentWrong rr.id "cannot add") rr.valid , Bulma.btn_add (AddRR Add_MXRR) (TellSomethingWentWrong rr.id "cannot add") rr.valid
] ]
] ]
@ -715,14 +730,14 @@ render_new_record_colunm_srv :: forall (w :: Type). (SRVRR ()) -> HH.HTML w Acti
render_new_record_colunm_srv rr render_new_record_colunm_srv rr
= Bulma.column_ $ [ Bulma.box = Bulma.column_ $ [ Bulma.box
[ Bulma.zone_rr_title "SRV" [ Bulma.zone_rr_title "SRV"
, Bulma.box_input_domain (UpdateNewSRVForm <<< Update_SRV_Domain) rr.domain rr.valid , Bulma.box_input_domain (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Domain) rr.domain rr.valid
, Bulma.box_input_ttl (UpdateNewSRVForm <<< Update_SRV_TTL) rr.ttl rr.valid , Bulma.box_input_ttl (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_TTL) rr.ttl rr.valid
, Bulma.box_input_priority (UpdateNewSRVForm <<< Update_SRV_Priority) rr.priority rr.valid , Bulma.box_input_priority (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Priority) rr.priority rr.valid
, Bulma.box_input_protocol (UpdateNewSRVForm <<< Update_SRV_Protocol) rr.protocol rr.valid , Bulma.box_input_protocol (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Protocol) rr.protocol rr.valid
, Bulma.box_input_weight (UpdateNewSRVForm <<< Update_SRV_Weight) rr.weight rr.valid , Bulma.box_input_weight (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Weight) rr.weight rr.valid
, Bulma.box_input_port (UpdateNewSRVForm <<< Update_SRV_Port) rr.port rr.valid , Bulma.box_input_port (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Port) rr.port rr.valid
, Bulma.box_input_value (UpdateNewSRVForm <<< Update_SRV_Value) rr.value rr.valid , Bulma.box_input_value (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Value) rr.value rr.valid
, Bulma.btn_add AddSRV (TellSomethingWentWrong rr.id "cannot add") rr.valid , Bulma.btn_add (AddRR Add_SRVRR) (TellSomethingWentWrong rr.id "cannot add") rr.valid
] ]
] ]