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

ZoneInterface rewrite: WIP. Updates for new RR are now cleaner (1 action).

Browse Source
This commit is contained in:
Philippe Pittoli 2023-07-09 16:00:36 +02:00
parent f9ab384d06
commit d9518bc563
1 changed files with 114 additions and 112 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

180
src/App/ZoneInterface.purs
View File

@ -91,6 +91,26 @@ type Input = String
-- | - TODO: remove a resource record -- | - TODO: remove a resource record
-- | - TODO: handle user inputs -- | - TODO: handle user inputs
data Update_New_SimpleRR_Form
= Update_New_SRR_Type Int
| Update_New_SSR_Domain RecordDomain
| Update_New_SSR_TTL TTL
| Update_New_SSR_Value RecordValue
data Update_New_MX_Form
= Update_New_MX_Domain RecordDomain
| Update_New_MX_TTL TTL
| Update_New_MX_Value RecordValue
| Update_New_MX_Priority Priority
data Update_New_SRV_Form
= Update_New_SRV_Domain RecordDomain
| Update_New_SRV_TTL TTL
| Update_New_SRV_Value RecordValue
| Update_New_SRV_Priority Priority
| Update_New_SRV_Weight Weight
| Update_New_SRV_Port Port
data Action data Action
= DeleteRRModal String = DeleteRRModal String
| CancelModal | CancelModal
@ -101,26 +121,11 @@ data Action
| DoNothing String | DoNothing String
-- New entries. -- New entries.
| UpdateNewType Int | UpdateNewSimpleRRForm Update_New_SimpleRR_Form
| UpdateNewMXForm Update_New_MX_Form
| UpdateNewDomainSimple RecordDomain | UpdateNewSRVForm Update_New_SRV_Form
| UpdateNewDomainMX RecordDomain
| UpdateNewDomainSRV RecordDomain
| UpdateNewTTLSimple TTL
| UpdateNewTTLMX TTL
| UpdateNewTTLSRV TTL
| UpdateNewEntryValue RecordValue
| UpdateNewMXValue RecordValue
| UpdateNewSRVValue RecordValue
| UpdateNewMXPriority Priority
| UpdateNewSRVPriority Priority
| UpdateNewSRVWeight Weight
| UpdateNewSRVPort Port
-- Add new entries.
| AddSimple | AddSimple
| AddMX | AddMX
| AddSRV | AddSRV
@ -145,7 +150,6 @@ data Action
| DeleteMX RRId | DeleteMX RRId
| DeleteSRV RRId | DeleteSRV RRId
| TellSomethingWentWrong RRId String | TellSomethingWentWrong RRId String
-- | -- |
@ -261,76 +265,74 @@ handleAction = case _ of
DoNothing _ -> do DoNothing _ -> do
H.raise $ Log $ SimpleLog "This action does nothing (at least for now)" H.raise $ Log $ SimpleLog "This action does nothing (at least for now)"
UpdateNewType val -> do UpdateNewSimpleRRForm rr_update -> case rr_update of
Update_New_SRR_Type val -> do
let new_type = fromMaybe "unknown" (baseRecords !! val) let new_type = fromMaybe "unknown" (baseRecords !! val)
H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type) H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type)
state <- H.get state <- H.get
H.put $ state { _current_entry = changeType state._current_entry (baseRecords !! val) } H.put $ state { _current_entry = changeType state._current_entry (baseRecords !! val) }
-- TODO: FIXME: test all inputs Update_New_SSR_Domain val -> do
UpdateNewTTLSimple val -> do
H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> val)
state <- H.get
H.put $ state { _current_entry = state._current_entry { ttl = val, valid = isInteger val } }
-- TODO: FIXME: test all inputs
UpdateNewTTLMX val -> do
H.raise $ Log $ SimpleLog ("Update new MX entry ttl: " <> val)
state <- H.get
H.put $ state { _current_entry_mx = state._current_entry_mx {ttl = val, valid = isInteger val} }
UpdateNewTTLSRV val -> do
H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val)
state <- H.get
H.put $ state { _current_entry_srv = state._current_entry_srv {ttl = val, valid = isInteger val}}
UpdateNewDomainSimple val -> do
H.raise $ Log $ SimpleLog ("Update new entry domain: " <> val) H.raise $ Log $ SimpleLog ("Update new entry domain: " <> val)
state <- H.get state <- H.get
H.put $ state { _current_entry = state._current_entry { domain = val } } H.put $ state { _current_entry = state._current_entry { domain = val } }
-- TODO: FIXME: test all inputs Update_New_SSR_TTL val -> do
UpdateNewDomainMX val -> do H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> val)
H.raise $ Log $ SimpleLog ("Update new MX entry domain: " <> val)
state <- H.get state <- H.get
H.put $ state { _current_entry_mx = state._current_entry_mx { domain = val } } H.put $ state { _current_entry = state._current_entry { ttl = val, valid = isInteger val } }
UpdateNewDomainSRV val -> do Update_New_SSR_Value val -> do
H.raise $ Log $ SimpleLog ("Update new SRV entry domain: " <> val)
state <- H.get
H.put $ state { _current_entry_srv = state._current_entry_srv { domain = val } }
UpdateNewEntryValue val -> do
H.raise $ Log $ SimpleLog ("Update new entry value: " <> val) H.raise $ Log $ SimpleLog ("Update new entry value: " <> val)
state <- H.get state <- H.get
H.put $ state { _current_entry = state._current_entry { value = val } } H.put $ state { _current_entry = state._current_entry { value = val } }
UpdateNewMXForm rr_update -> case rr_update of
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
UpdateNewMXValue val -> do Update_New_MX_Domain val -> do
H.raise $ Log $ SimpleLog ("Update new MX entry domain: " <> val)
state <- H.get
H.put $ state { _current_entry_mx = state._current_entry_mx { domain = val } }
-- TODO: FIXME: test all inputs
Update_New_MX_TTL val -> do
H.raise $ Log $ SimpleLog ("Update new MX entry ttl: " <> val)
state <- H.get
H.put $ state { _current_entry_mx = state._current_entry_mx {ttl = val, valid = isInteger val} }
-- TODO: FIXME: test all inputs
Update_New_MX_Value val -> do
H.raise $ Log $ SimpleLog ("Update new MX entry value: " <> val) H.raise $ Log $ SimpleLog ("Update new MX entry value: " <> val)
state <- H.get state <- H.get
H.put $ state { _current_entry_mx = state._current_entry_mx { value = val } } H.put $ state { _current_entry_mx = state._current_entry_mx { value = val } }
UpdateNewSRVValue val -> do Update_New_MX_Priority val -> do
H.raise $ Log $ SimpleLog ("Update new SRV entry value: " <> val)
state <- H.get
H.put $ state { _current_entry_srv = state._current_entry_srv { value = val } }
UpdateNewMXPriority val -> do
H.raise $ Log $ SimpleLog ("Update new MX entry priority: " <> val) H.raise $ Log $ SimpleLog ("Update new MX entry priority: " <> val)
state <- H.get state <- H.get
H.put $ state { _current_entry_mx = state._current_entry_mx { priority = val } } H.put $ state { _current_entry_mx = state._current_entry_mx { priority = val } }
UpdateNewSRVPriority val -> do
UpdateNewSRVForm rr_update -> case rr_update of
Update_New_SRV_Domain val -> do
H.raise $ Log $ SimpleLog ("Update new SRV entry domain: " <> val)
state <- H.get
H.put $ state { _current_entry_srv = state._current_entry_srv { domain = val } }
Update_New_SRV_Value val -> do
H.raise $ Log $ SimpleLog ("Update new SRV entry value: " <> val)
state <- H.get
H.put $ state { _current_entry_srv = state._current_entry_srv { value = val } }
-- TODO: FIXME: test all inputs
Update_New_SRV_TTL val -> do
H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val)
state <- H.get
H.put $ state { _current_entry_srv = state._current_entry_srv {ttl = val, valid = isInteger val}}
Update_New_SRV_Priority val -> do
H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val) H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val)
state <- H.get state <- H.get
H.put $ state { _current_entry_srv = state._current_entry_srv { priority = val } } H.put $ state { _current_entry_srv = state._current_entry_srv { priority = val } }
Update_New_SRV_Weight val -> do
UpdateNewSRVWeight val -> do
H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val) H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val)
state <- H.get state <- H.get
H.put $ state { _current_entry_srv = state._current_entry_srv { weight = val } } H.put $ state { _current_entry_srv = state._current_entry_srv { weight = val } }
Update_New_SRV_Port val -> do
UpdateNewSRVPort val -> do
H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val) H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val)
state <- H.get state <- H.get
H.put $ state { _current_entry_srv = state._current_entry_srv { port = val } } H.put $ state { _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.
AddSimple -> do AddSimple -> do
H.raise $ Log $ SimpleLog ("Add simple entry") H.raise $ Log $ SimpleLog ("Add simple entry")
@ -615,15 +617,15 @@ render_new_record rr
render_record_builder render_record_builder
= HH.tr_ = HH.tr_
[ HH.td_ [ type_selection ] [ HH.td_ [ type_selection ]
, HH.td_ [ S.input_domain UpdateNewDomainSimple rr.domain rr.valid ] , HH.td_ [ S.input_domain (UpdateNewSimpleRRForm <<< Update_New_SSR_Domain) rr.domain rr.valid ]
, HH.td_ [ S.input_ttl UpdateNewTTLSimple rr.ttl rr.valid ] , HH.td_ [ S.input_ttl (UpdateNewSimpleRRForm <<< Update_New_SSR_TTL) rr.ttl rr.valid ]
, HH.td_ [ S.input_value UpdateNewEntryValue rr.value rr.valid ] , HH.td_ [ S.input_value (UpdateNewSimpleRRForm <<< Update_New_SSR_Value) rr.value rr.valid ]
, HH.td_ [ S.btn_add AddSimple (TellSomethingWentWrong rr.id "cannot add") rr.valid ] , HH.td_ [ S.btn_add AddSimple (TellSomethingWentWrong rr.id "cannot add") rr.valid ]
] ]
-- 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 UpdateNewType ] [ HE.onSelectedIndexChange (UpdateNewSimpleRRForm <<< Update_New_SRR_Type) ]
$ map type_option baseRecords $ map type_option baseRecords
type_option n type_option n
= HH.option = HH.option
@ -642,10 +644,10 @@ render_mx_new_record rr
-- render_record_builder :: forall w. HH.HTML w Action -- render_record_builder :: forall w. HH.HTML w Action
render_record_builder render_record_builder
= HH.tr_ = HH.tr_
[ HH.td_ [ S.input_domain UpdateNewDomainMX rr.domain rr.valid ] [ HH.td_ [ S.input_domain (UpdateNewMXForm <<< Update_New_MX_Domain) rr.domain rr.valid ]
, HH.td_ [ S.input_ttl UpdateNewTTLMX rr.ttl rr.valid ] , HH.td_ [ S.input_ttl (UpdateNewMXForm <<< Update_New_MX_TTL) rr.ttl rr.valid ]
, HH.td_ [ S.input_priority UpdateNewMXPriority rr.priority rr.valid ] , HH.td_ [ S.input_priority (UpdateNewMXForm <<< Update_New_MX_Priority) rr.priority rr.valid ]
, HH.td_ [ S.input_value UpdateNewMXValue rr.value rr.valid ] , HH.td_ [ S.input_value (UpdateNewMXForm <<< Update_New_MX_Value) rr.value rr.valid ]
, HH.td_ [ S.btn_add AddMX (TellSomethingWentWrong rr.id "cannot add") rr.valid ] , HH.td_ [ S.btn_add AddMX (TellSomethingWentWrong rr.id "cannot add") rr.valid ]
] ]
@ -659,12 +661,12 @@ render_srv_new_record rr
-- render_record_builder :: forall w. HH.HTML w Action -- render_record_builder :: forall w. HH.HTML w Action
render_record_builder render_record_builder
= HH.tr_ = HH.tr_
[ HH.td_ [ S.input_domain UpdateNewDomainSRV rr.domain rr.valid ] [ HH.td_ [ S.input_domain (UpdateNewSRVForm <<< Update_New_SRV_Domain) rr.domain rr.valid ]
, HH.td_ [ S.input_ttl UpdateNewTTLSRV rr.ttl rr.valid ] , HH.td_ [ S.input_ttl (UpdateNewSRVForm <<< Update_New_SRV_TTL) rr.ttl rr.valid ]
, HH.td_ [ S.input_priority UpdateNewSRVPriority rr.priority rr.valid ] , HH.td_ [ S.input_priority (UpdateNewSRVForm <<< Update_New_SRV_Priority) rr.priority rr.valid ]
, HH.td_ [ S.input_weight UpdateNewSRVWeight rr.weight rr.valid ] , HH.td_ [ S.input_weight (UpdateNewSRVForm <<< Update_New_SRV_Weight) rr.weight rr.valid ]
, HH.td_ [ S.input_port UpdateNewSRVPort rr.port rr.valid ] , HH.td_ [ S.input_port (UpdateNewSRVForm <<< Update_New_SRV_Port) rr.port rr.valid ]
, HH.td_ [ S.input_value UpdateNewSRVValue rr.value rr.valid ] , HH.td_ [ S.input_value (UpdateNewSRVForm <<< Update_New_SRV_Value) rr.value rr.valid ]
, HH.td_ [ S.btn_add AddSRV (TellSomethingWentWrong rr.id "cannot add") rr.valid ] , HH.td_ [ S.btn_add AddSRV (TellSomethingWentWrong rr.id "cannot add") rr.valid ]
] ]
@ -692,16 +694,16 @@ render_new_record_column_simple rr
= S.column_ $ [ S.box = S.column_ $ [ S.box
[ Bulma.zone_rr_title "NS, A, AAAA, CNAME, TXT" [ Bulma.zone_rr_title "NS, A, AAAA, CNAME, TXT"
, type_selection , type_selection
, S.box_input_domain UpdateNewDomainSimple rr.domain rr.valid , S.box_input_domain (UpdateNewSimpleRRForm <<< Update_New_SSR_Domain) rr.domain rr.valid
, S.box_input_ttl UpdateNewTTLSimple rr.ttl rr.valid , S.box_input_ttl (UpdateNewSimpleRRForm <<< Update_New_SSR_TTL) rr.ttl rr.valid
, S.box_input_value UpdateNewEntryValue rr.value rr.valid , S.box_input_value (UpdateNewSimpleRRForm <<< Update_New_SSR_Value) rr.value rr.valid
, S.btn_add AddSimple (TellSomethingWentWrong rr.id "cannot add") rr.valid , S.btn_add AddSimple (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 UpdateNewType ] [ HE.onSelectedIndexChange (UpdateNewSimpleRRForm <<< Update_New_SRR_Type) ]
$ map type_option baseRecords $ map type_option baseRecords
type_option n type_option n
= HH.option = HH.option
@ -714,10 +716,10 @@ 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
= S.column_ $ [ S.box = S.column_ $ [ S.box
[ Bulma.zone_rr_title "MX" [ Bulma.zone_rr_title "MX"
, S.box_input_domain UpdateNewDomainMX rr.domain rr.valid , S.box_input_domain (UpdateNewMXForm <<< Update_New_MX_Domain) rr.domain rr.valid
, S.box_input_ttl UpdateNewTTLMX rr.ttl rr.valid , S.box_input_ttl (UpdateNewMXForm <<< Update_New_MX_TTL) rr.ttl rr.valid
, S.box_input_priority UpdateNewMXPriority rr.priority rr.valid , S.box_input_priority (UpdateNewMXForm <<< Update_New_MX_Priority) rr.priority rr.valid
, S.box_input_value UpdateNewMXValue rr.value rr.valid , S.box_input_value (UpdateNewMXForm <<< Update_New_MX_Value) rr.value rr.valid
, S.btn_add AddMX (TellSomethingWentWrong rr.id "cannot add") rr.valid , S.btn_add AddMX (TellSomethingWentWrong rr.id "cannot add") rr.valid
] ]
] ]
@ -726,12 +728,12 @@ 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
= S.column_ $ [ S.box = S.column_ $ [ S.box
[ Bulma.zone_rr_title "SRV" [ Bulma.zone_rr_title "SRV"
, S.box_input_domain UpdateNewDomainSRV rr.domain rr.valid , S.box_input_domain (UpdateNewSRVForm <<< Update_New_SRV_Domain) rr.domain rr.valid
, S.box_input_ttl UpdateNewTTLSRV rr.ttl rr.valid , S.box_input_ttl (UpdateNewSRVForm <<< Update_New_SRV_TTL) rr.ttl rr.valid
, S.box_input_priority UpdateNewSRVPriority rr.priority rr.valid , S.box_input_priority (UpdateNewSRVForm <<< Update_New_SRV_Priority) rr.priority rr.valid
, S.box_input_weight UpdateNewSRVWeight rr.weight rr.valid , S.box_input_weight (UpdateNewSRVForm <<< Update_New_SRV_Weight) rr.weight rr.valid
, S.box_input_port UpdateNewSRVPort rr.port rr.valid , S.box_input_port (UpdateNewSRVForm <<< Update_New_SRV_Port) rr.port rr.valid
, S.box_input_value UpdateNewSRVValue rr.value rr.valid , S.box_input_value (UpdateNewSRVForm <<< Update_New_SRV_Value) rr.value rr.valid
, S.btn_add AddSRV (TellSomethingWentWrong rr.id "cannot add") rr.valid , S.btn_add AddSRV (TellSomethingWentWrong rr.id "cannot add") rr.valid
] ]
] ]