ZoneInterface rewrite: WIP. Updates for new RR are now cleaner (1 action).
This commit is contained in:
parent
f9ab384d06
commit
d9518bc563
@ -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,74 +265,72 @@ 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
|
||||||
let new_type = fromMaybe "unknown" (baseRecords !! val)
|
Update_New_SRR_Type val -> do
|
||||||
H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type)
|
let new_type = fromMaybe "unknown" (baseRecords !! val)
|
||||||
state <- H.get
|
H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type)
|
||||||
H.put $ state { _current_entry = changeType state._current_entry (baseRecords !! val) }
|
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
|
-- TODO: FIXME: test all inputs
|
||||||
|
Update_New_MX_Domain val -> do
|
||||||
UpdateNewTTLSimple val -> do
|
H.raise $ Log $ SimpleLog ("Update new MX entry domain: " <> val)
|
||||||
H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> 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 } }
|
|
||||||
-- TODO: FIXME: test all inputs
|
-- TODO: FIXME: test all inputs
|
||||||
UpdateNewTTLMX val -> do
|
Update_New_MX_TTL val -> do
|
||||||
H.raise $ Log $ SimpleLog ("Update new MX entry ttl: " <> val)
|
H.raise $ Log $ SimpleLog ("Update new MX entry ttl: " <> val)
|
||||||
state <- H.get
|
state <- H.get
|
||||||
H.put $ state { _current_entry_mx = state._current_entry_mx {ttl = val, valid = isInteger val} }
|
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 } }
|
|
||||||
-- TODO: FIXME: test all inputs
|
-- TODO: FIXME: test all inputs
|
||||||
UpdateNewDomainMX val -> do
|
Update_New_MX_Value val -> do
|
||||||
H.raise $ Log $ SimpleLog ("Update new MX entry domain: " <> 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 { domain = val } }
|
H.put $ state { _current_entry_mx = state._current_entry_mx { value = val } }
|
||||||
UpdateNewDomainSRV val -> do
|
Update_New_MX_Priority val -> do
|
||||||
H.raise $ Log $ SimpleLog ("Update new SRV entry domain: " <> val)
|
H.raise $ Log $ SimpleLog ("Update new MX entry priority: " <> val)
|
||||||
state <- H.get
|
state <- H.get
|
||||||
H.put $ state { _current_entry_srv = state._current_entry_srv { domain = val } }
|
H.put $ state { _current_entry_mx = state._current_entry_mx { priority = 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 } }
|
|
||||||
|
|
||||||
|
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.
|
-- This action only is possible if inputs are correct.
|
||||||
@ -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
|
||||||
]
|
]
|
||||||
]
|
]
|
||||||
|
|||||||
Loading…
Reference in New Issue
Block a user