From d9518bc5637ef37cff5dd357a46e1fc76ef6286b Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Sun, 9 Jul 2023 16:00:36 +0200 Subject: [PATCH] ZoneInterface rewrite: WIP. Updates for new RR are now cleaner (1 action). --- src/App/ZoneInterface.purs | 226 +++++++++++++++++++------------------ 1 file changed, 114 insertions(+), 112 deletions(-) diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index b239870..4a78587 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -91,6 +91,26 @@ type Input = String -- | - TODO: remove a resource record -- | - 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 = DeleteRRModal String | CancelModal @@ -101,26 +121,11 @@ data Action | DoNothing String -- New entries. - | UpdateNewType Int - - | UpdateNewDomainSimple RecordDomain - | UpdateNewDomainMX RecordDomain - | UpdateNewDomainSRV RecordDomain - - | UpdateNewTTLSimple TTL - | UpdateNewTTLMX TTL - | UpdateNewTTLSRV TTL - - | UpdateNewEntryValue RecordValue - | UpdateNewMXValue RecordValue - | UpdateNewSRVValue RecordValue - - | UpdateNewMXPriority Priority - | UpdateNewSRVPriority Priority - - | UpdateNewSRVWeight Weight - | UpdateNewSRVPort Port + | UpdateNewSimpleRRForm Update_New_SimpleRR_Form + | UpdateNewMXForm Update_New_MX_Form + | UpdateNewSRVForm Update_New_SRV_Form + -- Add new entries. | AddSimple | AddMX | AddSRV @@ -145,7 +150,6 @@ data Action | DeleteMX RRId | DeleteSRV RRId - | TellSomethingWentWrong RRId String -- | @@ -261,74 +265,72 @@ handleAction = case _ of DoNothing _ -> do H.raise $ Log $ SimpleLog "This action does nothing (at least for now)" - UpdateNewType val -> do - let new_type = fromMaybe "unknown" (baseRecords !! val) - H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type) - state <- H.get - H.put $ state { _current_entry = changeType state._current_entry (baseRecords !! val) } + UpdateNewSimpleRRForm rr_update -> case rr_update of + Update_New_SRR_Type val -> do + let new_type = fromMaybe "unknown" (baseRecords !! val) + H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type) + state <- H.get + H.put $ state { _current_entry = changeType state._current_entry (baseRecords !! val) } + Update_New_SSR_Domain val -> do + H.raise $ Log $ SimpleLog ("Update new entry domain: " <> val) + state <- H.get + H.put $ state { _current_entry = state._current_entry { domain = val } } + Update_New_SSR_TTL 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 } } + Update_New_SSR_Value val -> do + H.raise $ Log $ SimpleLog ("Update new entry value: " <> val) + state <- H.get + H.put $ state { _current_entry = state._current_entry { value = val } } + + UpdateNewMXForm rr_update -> case rr_update of -- TODO: FIXME: test all inputs - - 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 } } + 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 - 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) - state <- H.get - H.put $ state { _current_entry = state._current_entry { domain = val } } + 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 - UpdateNewDomainMX 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 } } - UpdateNewDomainSRV 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) - state <- H.get - H.put $ state { _current_entry = state._current_entry { value = val } } - -- TODO: FIXME: test all inputs - UpdateNewMXValue val -> do - H.raise $ Log $ SimpleLog ("Update new MX entry value: " <> val) - state <- H.get - H.put $ state { _current_entry_mx = state._current_entry_mx { value = val } } - UpdateNewSRVValue 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) - state <- H.get - H.put $ state { _current_entry_mx = state._current_entry_mx { priority = val } } - UpdateNewSRVPriority val -> do - H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val) - state <- H.get - H.put $ state { _current_entry_srv = state._current_entry_srv { priority = val } } - - UpdateNewSRVWeight val -> do - H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val) - state <- H.get - H.put $ state { _current_entry_srv = state._current_entry_srv { weight = val } } - - UpdateNewSRVPort val -> do - H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val) - state <- H.get - H.put $ state { _current_entry_srv = state._current_entry_srv { port = val } } + Update_New_MX_Value val -> do + H.raise $ Log $ SimpleLog ("Update new MX entry value: " <> val) + state <- H.get + H.put $ state { _current_entry_mx = state._current_entry_mx { value = val } } + Update_New_MX_Priority val -> do + H.raise $ Log $ SimpleLog ("Update new MX entry priority: " <> val) + state <- H.get + H.put $ state { _current_entry_mx = state._current_entry_mx { priority = val } } + 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) + state <- H.get + H.put $ state { _current_entry_srv = state._current_entry_srv { priority = val } } + Update_New_SRV_Weight val -> do + H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val) + state <- H.get + H.put $ state { _current_entry_srv = state._current_entry_srv { weight = val } } + Update_New_SRV_Port val -> do + H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val) + state <- H.get + H.put $ state { _current_entry_srv = state._current_entry_srv { port = val } } -- This action only is possible if inputs are correct. @@ -615,15 +617,15 @@ render_new_record rr render_record_builder = HH.tr_ [ HH.td_ [ type_selection ] - , HH.td_ [ S.input_domain UpdateNewDomainSimple rr.domain rr.valid ] - , HH.td_ [ S.input_ttl UpdateNewTTLSimple rr.ttl rr.valid ] - , HH.td_ [ S.input_value UpdateNewEntryValue rr.value rr.valid ] + , HH.td_ [ S.input_domain (UpdateNewSimpleRRForm <<< Update_New_SSR_Domain) rr.domain rr.valid ] + , HH.td_ [ S.input_ttl (UpdateNewSimpleRRForm <<< Update_New_SSR_TTL) rr.ttl 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 ] ] -- type_selection :: forall w i. HH.HTML w i type_selection = HH.select - [ HE.onSelectedIndexChange UpdateNewType ] + [ HE.onSelectedIndexChange (UpdateNewSimpleRRForm <<< Update_New_SRR_Type) ] $ map type_option baseRecords type_option n = HH.option @@ -642,10 +644,10 @@ render_mx_new_record rr -- render_record_builder :: forall w. HH.HTML w Action render_record_builder = HH.tr_ - [ HH.td_ [ S.input_domain UpdateNewDomainMX rr.domain rr.valid ] - , HH.td_ [ S.input_ttl UpdateNewTTLMX rr.ttl rr.valid ] - , HH.td_ [ S.input_priority UpdateNewMXPriority rr.priority rr.valid ] - , HH.td_ [ S.input_value UpdateNewMXValue rr.value rr.valid ] + [ HH.td_ [ S.input_domain (UpdateNewMXForm <<< Update_New_MX_Domain) rr.domain rr.valid ] + , HH.td_ [ S.input_ttl (UpdateNewMXForm <<< Update_New_MX_TTL) rr.ttl rr.valid ] + , HH.td_ [ S.input_priority (UpdateNewMXForm <<< Update_New_MX_Priority) rr.priority 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 ] ] @@ -659,12 +661,12 @@ render_srv_new_record rr -- render_record_builder :: forall w. HH.HTML w Action render_record_builder = HH.tr_ - [ HH.td_ [ S.input_domain UpdateNewDomainSRV rr.domain rr.valid ] - , HH.td_ [ S.input_ttl UpdateNewTTLSRV rr.ttl rr.valid ] - , HH.td_ [ S.input_priority UpdateNewSRVPriority rr.priority rr.valid ] - , HH.td_ [ S.input_weight UpdateNewSRVWeight rr.weight rr.valid ] - , HH.td_ [ S.input_port UpdateNewSRVPort rr.port rr.valid ] - , HH.td_ [ S.input_value UpdateNewSRVValue rr.value rr.valid ] + [ HH.td_ [ S.input_domain (UpdateNewSRVForm <<< Update_New_SRV_Domain) rr.domain rr.valid ] + , HH.td_ [ S.input_ttl (UpdateNewSRVForm <<< Update_New_SRV_TTL) rr.ttl rr.valid ] + , HH.td_ [ S.input_priority (UpdateNewSRVForm <<< Update_New_SRV_Priority) rr.priority rr.valid ] + , HH.td_ [ S.input_weight (UpdateNewSRVForm <<< Update_New_SRV_Weight) rr.weight rr.valid ] + , HH.td_ [ S.input_port (UpdateNewSRVForm <<< Update_New_SRV_Port) rr.port 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 ] ] @@ -692,16 +694,16 @@ render_new_record_column_simple rr = S.column_ $ [ S.box [ Bulma.zone_rr_title "NS, A, AAAA, CNAME, TXT" , type_selection - , S.box_input_domain UpdateNewDomainSimple rr.domain rr.valid - , S.box_input_ttl UpdateNewTTLSimple rr.ttl rr.valid - , S.box_input_value UpdateNewEntryValue rr.value rr.valid + , S.box_input_domain (UpdateNewSimpleRRForm <<< Update_New_SSR_Domain) rr.domain rr.valid + , S.box_input_ttl (UpdateNewSimpleRRForm <<< Update_New_SSR_TTL) rr.ttl 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 ] ] where -- type_selection :: forall w i. HH.HTML w i type_selection = HH.select - [ HE.onSelectedIndexChange UpdateNewType ] + [ HE.onSelectedIndexChange (UpdateNewSimpleRRForm <<< Update_New_SRR_Type) ] $ map type_option baseRecords type_option n = 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 = S.column_ $ [ S.box [ Bulma.zone_rr_title "MX" - , S.box_input_domain UpdateNewDomainMX rr.domain rr.valid - , S.box_input_ttl UpdateNewTTLMX rr.ttl rr.valid - , S.box_input_priority UpdateNewMXPriority rr.priority rr.valid - , S.box_input_value UpdateNewMXValue rr.value rr.valid + , S.box_input_domain (UpdateNewMXForm <<< Update_New_MX_Domain) rr.domain rr.valid + , S.box_input_ttl (UpdateNewMXForm <<< Update_New_MX_TTL) rr.ttl rr.valid + , S.box_input_priority (UpdateNewMXForm <<< Update_New_MX_Priority) rr.priority 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 ] ] @@ -726,12 +728,12 @@ render_new_record_colunm_srv :: forall (w :: Type). (SRVRR ()) -> HH.HTML w Acti render_new_record_colunm_srv rr = S.column_ $ [ S.box [ Bulma.zone_rr_title "SRV" - , S.box_input_domain UpdateNewDomainSRV rr.domain rr.valid - , S.box_input_ttl UpdateNewTTLSRV rr.ttl rr.valid - , S.box_input_priority UpdateNewSRVPriority rr.priority rr.valid - , S.box_input_weight UpdateNewSRVWeight rr.weight rr.valid - , S.box_input_port UpdateNewSRVPort rr.port rr.valid - , S.box_input_value UpdateNewSRVValue rr.value rr.valid + , S.box_input_domain (UpdateNewSRVForm <<< Update_New_SRV_Domain) rr.domain rr.valid + , S.box_input_ttl (UpdateNewSRVForm <<< Update_New_SRV_TTL) rr.ttl rr.valid + , S.box_input_priority (UpdateNewSRVForm <<< Update_New_SRV_Priority) rr.priority rr.valid + , S.box_input_weight (UpdateNewSRVForm <<< Update_New_SRV_Weight) rr.weight rr.valid + , S.box_input_port (UpdateNewSRVForm <<< Update_New_SRV_Port) rr.port 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 ] ]