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

ZoneInterface another stab at cleaning the whole module.

Browse Source
This commit is contained in:
Philippe Pittoli 2023-07-09 17:37:49 +02:00
parent d9518bc563
commit c0d38d09bb
1 changed files with 205 additions and 190 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

395
src/App/ZoneInterface.purs
View File

@ -91,25 +91,25 @@ 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 data Update_SRR_Form
= Update_New_SRR_Type Int = Update_SRR_Type Int
| Update_New_SSR_Domain RecordDomain | Update_SRR_Domain RecordDomain
| Update_New_SSR_TTL TTL | Update_SRR_TTL TTL
| Update_New_SSR_Value RecordValue | Update_SRR_Value RecordValue
data Update_New_MX_Form data Update_MX_Form
= Update_New_MX_Domain RecordDomain = Update_MX_Domain RecordDomain
| Update_New_MX_TTL TTL | Update_MX_TTL TTL
| Update_New_MX_Value RecordValue | Update_MX_Value RecordValue
| Update_New_MX_Priority Priority | Update_MX_Priority Priority
data Update_New_SRV_Form data Update_SRV_Form
= Update_New_SRV_Domain RecordDomain = Update_SRV_Domain RecordDomain
| Update_New_SRV_TTL TTL | Update_SRV_TTL TTL
| Update_New_SRV_Value RecordValue | Update_SRV_Value RecordValue
| Update_New_SRV_Priority Priority | Update_SRV_Priority Priority
| Update_New_SRV_Weight Weight | Update_SRV_Weight Weight
| Update_New_SRV_Port Port | Update_SRV_Port Port
data Action data Action
= DeleteRRModal String = DeleteRRModal String
@ -121,30 +121,21 @@ data Action
| DoNothing String | DoNothing String
-- New entries. -- New entries.
| UpdateNewSimpleRRForm Update_New_SimpleRR_Form | UpdateNewSRRForm Update_SRR_Form
| UpdateNewMXForm Update_New_MX_Form | UpdateNewMXForm Update_MX_Form
| UpdateNewSRVForm Update_New_SRV_Form | UpdateNewSRVForm Update_SRV_Form
-- Add new entries. -- Add new entries.
| AddSimple | AddSRR
| AddMX | AddMX
| AddSRV | AddSRV
-- Entry already in our zone. -- Entry already in our zone.
| UpdateLocalTTL RRId TTL | UpdateLocalSRRForm RRId Update_SRR_Form
| UpdateLocalTTLMX RRId TTL | UpdateLocalMXForm RRId Update_MX_Form
| UpdateLocalTTLSRV RRId TTL | UpdateLocalSRVForm RRId Update_SRV_Form
| UpdateLocalValue RRId RecordValue | SyncRR RRId
| UpdateLocalValueMX RRId RecordValue
| UpdateLocalValueSRV RRId RecordValue
| UpdateLocalPriorityMX RRId Priority
| UpdateLocalPrioritySRV RRId Priority
| UpdateLocalWeight RRId Weight
| UpdateLocalPort RRId Port
| UpdateOnServer RRId
| DeleteSimple RRId | DeleteSimple RRId
| DeleteMX RRId | DeleteMX RRId
@ -156,7 +147,7 @@ data Action
type State = type State =
{ _current_domain :: RecordDomain { _current_domain :: RecordDomain
, _rr :: Array (SimpleRR ()) , _srr :: Array (SimpleRR ())
, _mxrr :: Array (MXRR ()) , _mxrr :: Array (MXRR ())
, _srvrr :: Array (SRVRR ()) , _srvrr :: Array (SRVRR ())
, _current_entry :: (SimpleRR ()) , _current_entry :: (SimpleRR ())
@ -191,7 +182,7 @@ initialState domain =
, active_modal: Nothing , active_modal: Nothing
, _current_domain: domain , _current_domain: domain
, _rr: defaultResourceRecords , _srr: defaultResourceRecords
, _mxrr: defaultMXResourceRecords , _mxrr: defaultMXResourceRecords
, _srvrr: [] , _srvrr: []
, _current_entry: defaultResourceA , _current_entry: defaultResourceA
@ -217,7 +208,7 @@ render state
sorted = foldl (<>) [] sorted = foldl (<>) []
$ map (sortBy (comparing (_.domain))) $ map (sortBy (comparing (_.domain)))
$ map toArray $ map toArray
$ groupAllBy (comparing (_.t)) state._rr $ groupAllBy (comparing (_.t)) state._srr
modal_rr_delete :: forall w. String -> HH.HTML w Action modal_rr_delete :: forall w. String -> HH.HTML w Action
modal_rr_delete domain = modal_rr_delete domain =
@ -265,76 +256,76 @@ 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)"
UpdateNewSimpleRRForm rr_update -> case rr_update of UpdateNewSRRForm rr_update -> case rr_update of
Update_New_SRR_Type val -> do Update_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.modify_ _ { _current_entry = changeType state._current_entry (baseRecords !! val) }
Update_New_SSR_Domain val -> do Update_SRR_Domain 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.modify_ _ { _current_entry { domain = val } }
Update_New_SSR_TTL val -> do Update_SRR_TTL val -> do
H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> val) H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> val)
state <- H.get state <- H.get
H.put $ state { _current_entry = state._current_entry { ttl = val, valid = isInteger val } } H.modify_ _ { _current_entry { ttl = val, valid = isInteger val } }
Update_New_SSR_Value val -> do Update_SRR_Value 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.modify_ _ { _current_entry { value = val } }
UpdateNewMXForm rr_update -> case rr_update of UpdateNewMXForm rr_update -> case rr_update of
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
Update_New_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)
state <- H.get state <- H.get
H.put $ state { _current_entry_mx = state._current_entry_mx { domain = val } } H.modify_ _ { _current_entry_mx = state._current_entry_mx { domain = val } }
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
Update_New_MX_TTL val -> do Update_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.modify_ _ { _current_entry_mx = state._current_entry_mx {ttl = val, valid = isInteger val} }
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
Update_New_MX_Value val -> do Update_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.modify_ _ { _current_entry_mx = state._current_entry_mx { value = val } }
Update_New_MX_Priority val -> do Update_MX_Priority 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.modify_ _ { _current_entry_mx = state._current_entry_mx { priority = val } }
UpdateNewSRVForm rr_update -> case rr_update of UpdateNewSRVForm rr_update -> case rr_update of
Update_New_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
H.put $ state { _current_entry_srv = state._current_entry_srv { domain = val } } H.modify_ _ { _current_entry_srv = state._current_entry_srv { domain = val } }
Update_New_SRV_Value val -> do Update_SRV_Value val -> do
H.raise $ Log $ SimpleLog ("Update new SRV entry value: " <> val) H.raise $ Log $ SimpleLog ("Update new SRV entry value: " <> val)
state <- H.get state <- H.get
H.put $ state { _current_entry_srv = state._current_entry_srv { value = val } } H.modify_ _ { _current_entry_srv = state._current_entry_srv { value = val } }
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
Update_New_SRV_TTL val -> do Update_SRV_TTL val -> do
H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val) H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val)
state <- H.get state <- H.get
H.put $ state { _current_entry_srv = state._current_entry_srv {ttl = val, valid = isInteger val}} H.modify_ _ { _current_entry_srv = state._current_entry_srv {ttl = val, valid = isInteger val}}
Update_New_SRV_Priority val -> do Update_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.modify_ _ { _current_entry_srv = state._current_entry_srv { priority = val } }
Update_New_SRV_Weight val -> do Update_SRV_Weight 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.modify_ _ { _current_entry_srv = state._current_entry_srv { weight = val } }
Update_New_SRV_Port val -> do Update_SRV_Port 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.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.
AddSimple -> do AddSRR -> do
H.raise $ Log $ SimpleLog ("Add simple entry") H.raise $ Log $ SimpleLog ("Add simple entry")
state <- H.get state <- H.get
H.raise $ Log $ SimpleLog ("Add simple entry: " <> show state._current_entry) H.raise $ Log $ SimpleLog ("Add simple entry: " <> show state._current_entry)
@ -348,77 +339,96 @@ handleAction = case _ of
H.raise $ Log $ SimpleLog ("Add new SRV: " <> show state._current_entry_srv) H.raise $ Log $ SimpleLog ("Add new SRV: " <> show state._current_entry_srv)
H.put $ add_new_srv state state._current_entry_srv H.put $ add_new_srv state state._current_entry_srv
UpdateLocalSRRForm rr_id rr_update -> case rr_update of
Update_SRR_Type val -> do
let new_type = fromMaybe "unknown" (baseRecords !! val)
H.raise $ Log $ SimpleLog ("TODO: Update local RR " <> show rr_id <> " type: " <> new_type)
-- state <- H.get
-- H.modify_ _ { _srr = changeType state._current_entry (baseRecords !! val) }
Update_SRR_Domain val -> do
H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " domain: " <> val)
state <- H.get
H.modify_ _ { _srr = (update_domain rr_id val state._srr) }
Update_SRR_TTL val -> do
H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " TTL: " <> val)
state <- H.get
H.modify_ _ { _srr = (update_ttl rr_id val state._srr) }
Update_SRR_Value val -> do
H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " value: " <> val)
state <- H.get
H.modify_ _ { _srr = (update_value rr_id val state._srr) }
UpdateLocalValue rrid val -> do UpdateLocalMXForm rr_id rr_update -> case rr_update of
H.raise $ Log $ SimpleLog ("Update RR " <> show rrid <> " value: " <> val) -- TODO: FIXME: test all inputs
state <- H.get Update_MX_Domain val -> do
H.put $ state { _rr = (update_value rrid val state._rr) } H.raise $ Log $ SimpleLog ("Update local MX RR " <> show rr_id <> " domain: " <> val)
UpdateLocalValueMX rrid val -> do state <- H.get
H.raise $ Log $ SimpleLog ("Update MX RR " <> show rrid <> " value: " <> val) H.modify_ _ { _mxrr = (update_domain rr_id val state._mxrr) }
state <- H.get -- TODO: FIXME: test all inputs
H.put $ state { _mxrr = (update_value rrid val state._mxrr) } Update_MX_TTL val -> do
UpdateLocalValueSRV rrid val -> do H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry ttl: " <> val)
H.raise $ Log $ SimpleLog ("Update SRV RR " <> show rrid <> " value: " <> val) state <- H.get
state <- H.get H.modify_ _ { _mxrr = (update_ttl rr_id val state._mxrr) }
H.put $ state { _srvrr = (update_value rrid val state._srvrr) } -- TODO: FIXME: test all inputs
Update_MX_Value val -> do
UpdateLocalTTL rrid val -> do H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry value: " <> val)
H.raise $ Log $ SimpleLog ("Update RR " <> show rrid <> " TTL: " <> val) state <- H.get
state <- H.get H.modify_ _ { _mxrr = (update_value rr_id val state._mxrr) }
H.put $ state { _rr = (update_ttl rrid val state._rr) } Update_MX_Priority val -> do
UpdateLocalTTLMX rrid val -> do H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry priority: " <> val)
H.raise $ Log $ SimpleLog ("Update MX RR " <> show rrid <> " TTL: " <> val) state <- H.get
state <- H.get H.modify_ _ { _mxrr = (update_priority rr_id val state._mxrr) }
H.put $ state { _mxrr = (update_ttl rrid val state._mxrr) }
UpdateLocalTTLSRV rrid val -> do
H.raise $ Log $ SimpleLog ("Update SRV RR " <> show rrid <> " TTL: " <> val)
state <- H.get
H.put $ state { _srvrr = (update_ttl rrid val state._srvrr) }
UpdateLocalPriorityMX rrid val -> do
H.raise $ Log $ SimpleLog ("Update MX RR " <> show rrid <> " priority: " <> val)
state <- H.get
H.put $ state { _mxrr = (update_priority rrid val state._mxrr) }
UpdateLocalPrioritySRV rrid val -> do
H.raise $ Log $ SimpleLog ("Update SRV RR " <> show rrid <> " priority: " <> val)
state <- H.get
H.put $ state { _srvrr = (update_priority rrid val state._srvrr) }
UpdateLocalWeight rrid val -> do
H.raise $ Log $ SimpleLog ("Update RR " <> show rrid <> " weight: " <> val)
state <- H.get
H.put $ state { _srvrr = (update_weight rrid val state._srvrr) }
UpdateLocalPort rrid val -> do
H.raise $ Log $ SimpleLog ("Update RR " <> show rrid <> " port: " <> val)
state <- H.get
H.put $ state { _srvrr = (update_port rrid val state._srvrr) }
DeleteSimple rrid -> do
H.raise $ Log $ SimpleLog ("Delete SimpleRR: " <> show rrid)
state <- H.get
H.put $ state { _rr = filter (\rr -> rr.id /= rrid) state._rr }
H.raise $ Log $ SimpleLog ("TODO: remove from server")
DeleteMX rrid -> do
H.raise $ Log $ SimpleLog ("Delete MX: " <> show rrid)
state <- H.get
H.put $ state { _mxrr = filter (\rr -> rr.id /= rrid) state._mxrr }
H.raise $ Log $ SimpleLog ("TODO: remove from server")
DeleteSRV rrid -> do
H.raise $ Log $ SimpleLog ("Delete SRV: " <> show rrid)
state <- H.get
H.put $ state { _srvrr = filter (\rr -> rr.id /= rrid) state._srvrr }
H.raise $ Log $ SimpleLog ("TODO: remove from server")
UpdateLocalSRVForm rr_id rr_update -> case rr_update of
Update_SRV_Domain val -> do
H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry domain: " <> val)
state <- H.get
H.modify_ _ { _srvrr = (update_domain rr_id val state._srvrr) }
Update_SRV_Value val -> do
H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry value: " <> val)
state <- H.get
H.modify_ _ { _srvrr = (update_value rr_id val state._srvrr) }
-- TODO: FIXME: test all inputs
Update_SRV_TTL val -> do
H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry ttl: " <> val)
state <- H.get
H.modify_ _ { _srvrr = (update_ttl rr_id val state._srvrr) }
Update_SRV_Priority val -> do
H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry priority: " <> val)
state <- H.get
H.modify_ _ { _srvrr = (update_priority rr_id val state._srvrr) }
Update_SRV_Weight val -> do
H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry weight: " <> val)
state <- H.get
H.modify_ _ { _srvrr = (update_weight rr_id val state._srvrr) }
Update_SRV_Port val -> do
H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry port: " <> val)
state <- H.get
H.modify_ _ { _srvrr = (update_port rr_id val state._srvrr) }
-- TODO: network operations -- TODO: network operations
UpdateOnServer rrid -> do SyncRR rr_id -> do
H.raise $ Log $ SimpleLog ("TODO: UpdateOnServer: " <> show rrid) H.raise $ Log $ SimpleLog ("TODO: SyncRR: " <> show rr_id)
DeleteSimple rr_id -> do
H.raise $ Log $ SimpleLog ("Delete SimpleRR: " <> show rr_id)
state <- H.get
H.modify_ _ { _srr = filter (\rr -> rr.id /= rr_id) state._srr }
H.raise $ Log $ SimpleLog ("TODO: remove from server")
DeleteMX rr_id -> do
H.raise $ Log $ SimpleLog ("Delete MX: " <> show rr_id)
state <- H.get
H.modify_ _ { _mxrr = filter (\rr -> rr.id /= rr_id) state._mxrr }
H.raise $ Log $ SimpleLog ("TODO: remove from server")
DeleteSRV rr_id -> do
H.raise $ Log $ SimpleLog ("Delete SRV: " <> show rr_id)
state <- H.get
H.modify_ _ { _srvrr = filter (\rr -> rr.id /= rr_id) state._srvrr }
H.raise $ Log $ SimpleLog ("TODO: remove from server")
-- TODO: change the state to indicate problems? -- TODO: change the state to indicate problems?
TellSomethingWentWrong rrid val -> do TellSomethingWentWrong rr_id val -> do
H.raise $ Log $ SimpleLog ("Sorry, your record " <> show rrid <> " has problems: ") H.raise $ Log $ SimpleLog ("Sorry, your record " <> show rr_id <> " has problems: ")
-- H.raise $ Log $ SimpleLog (show rr) -- H.raise $ Log $ SimpleLog (show rr)
H.raise $ Log $ SimpleLog (" => " <> val) H.raise $ Log $ SimpleLog (" => " <> val)
@ -544,10 +554,10 @@ render_records records
row rr = HH.tr_ $ row rr = HH.tr_ $
[ S.txt_name rr.t [ S.txt_name rr.t
, HH.td_ [ S.input_domain DoNothing rr.domain rr.valid ] , HH.td_ [ S.input_domain ((UpdateLocalSRRForm rr.id) <<< Update_SRR_Domain) rr.domain rr.valid ]
, HH.td_ [ S.input_ttl (UpdateLocalTTL rr.id) rr.ttl rr.valid ] , HH.td_ [ S.input_ttl ((UpdateLocalSRRForm rr.id) <<< Update_SRR_TTL ) rr.ttl rr.valid ]
, HH.td_ [ S.input_value (UpdateLocalValue rr.id) rr.value rr.valid ] , HH.td_ [ S.input_value ((UpdateLocalSRRForm rr.id) <<< Update_SRR_Value) rr.value rr.valid ]
, HH.td_ [ S.btn_change (UpdateOnServer rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ] , HH.td_ [ S.btn_change (SyncRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ]
, HH.td_ [ S.btn_delete (\_ -> DeleteSimple rr.id) ] , HH.td_ [ S.btn_delete (\_ -> DeleteSimple rr.id) ]
] ]
@ -568,11 +578,11 @@ 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_ [ S.input_domain DoNothing rr.domain rr.valid ] [ HH.td_ [ S.input_domain ((UpdateLocalMXForm rr.id) <<< Update_MX_Domain) rr.domain rr.valid ]
, HH.td_ [ S.input_ttl (UpdateLocalTTLMX rr.id) rr.ttl rr.valid ] , HH.td_ [ S.input_ttl ((UpdateLocalMXForm rr.id) <<< Update_MX_TTL) rr.ttl rr.valid ]
, HH.td_ [ S.input_value (UpdateLocalValueMX rr.id) rr.value rr.valid ] , HH.td_ [ S.input_priority ((UpdateLocalMXForm rr.id) <<< Update_MX_Priority) rr.priority rr.valid ]
, HH.td_ [ S.input_priority (UpdateLocalPriorityMX rr.id) rr.priority rr.valid ] , HH.td_ [ S.input_value ((UpdateLocalMXForm rr.id) <<< Update_MX_Value) rr.value rr.valid ]
, HH.td_ [ S.btn_change (UpdateOnServer rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ] , HH.td_ [ S.btn_change (SyncRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ]
, HH.td_ [ S.btn_delete (\_ -> DeleteMX rr.id) ] , HH.td_ [ S.btn_delete (\_ -> DeleteMX rr.id) ]
] ]
@ -592,13 +602,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_ [ S.input_domain DoNothing rr.domain rr.valid ] [ HH.td_ [ S.input_domain ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Domain ) rr.domain rr.valid ]
, HH.td_ [ S.input_ttl (UpdateLocalTTLSRV rr.id) rr.ttl rr.valid ] , HH.td_ [ S.input_ttl ((UpdateLocalSRVForm rr.id) <<< Update_SRV_TTL ) rr.ttl rr.valid ]
, HH.td_ [ S.input_priority (UpdateLocalPrioritySRV rr.id) rr.priority rr.valid ] , HH.td_ [ S.input_priority ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Priority) rr.priority rr.valid ]
, HH.td_ [ S.input_weight (UpdateLocalWeight rr.id) rr.weight rr.valid ] , HH.td_ [ S.input_weight ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Weight ) rr.weight rr.valid ]
, HH.td_ [ S.input_port (UpdateLocalPort rr.id) rr.port rr.valid ] , HH.td_ [ S.input_port ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Port ) rr.port rr.valid ]
, HH.td_ [ S.input_value (UpdateLocalValueSRV rr.id) rr.value rr.valid ] , HH.td_ [ S.input_value ((UpdateLocalSRVForm rr.id) <<< Update_SRV_Value ) rr.value rr.valid ]
, HH.td_ [ S.btn_change (UpdateOnServer rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ] , HH.td_ [ S.btn_change (SyncRR rr.id) (TellSomethingWentWrong rr.id "cannot update") rr.modified rr.valid ]
, HH.td_ [ S.btn_delete (\_ -> DeleteSRV rr.id) ] , HH.td_ [ S.btn_delete (\_ -> DeleteSRV rr.id) ]
] ]
@ -617,15 +627,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 (UpdateNewSimpleRRForm <<< Update_New_SSR_Domain) rr.domain rr.valid ] , HH.td_ [ S.input_domain (UpdateNewSRRForm <<< Update_SRR_Domain) rr.domain rr.valid ]
, HH.td_ [ S.input_ttl (UpdateNewSimpleRRForm <<< Update_New_SSR_TTL) rr.ttl rr.valid ] , HH.td_ [ S.input_ttl (UpdateNewSRRForm <<< Update_SRR_TTL) rr.ttl rr.valid ]
, HH.td_ [ S.input_value (UpdateNewSimpleRRForm <<< Update_New_SSR_Value) rr.value rr.valid ] , HH.td_ [ S.input_value (UpdateNewSRRForm <<< Update_SRR_Value) rr.value rr.valid ]
, HH.td_ [ S.btn_add AddSimple (TellSomethingWentWrong rr.id "cannot add") rr.valid ] , HH.td_ [ S.btn_add AddSRR (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 (UpdateNewSimpleRRForm <<< Update_New_SRR_Type) ] [ HE.onSelectedIndexChange (UpdateNewSRRForm <<< Update_SRR_Type) ]
$ map type_option baseRecords $ map type_option baseRecords
type_option n type_option n
= HH.option = HH.option
@ -644,10 +654,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 (UpdateNewMXForm <<< Update_New_MX_Domain) rr.domain rr.valid ] [ HH.td_ [ S.input_domain (UpdateNewMXForm <<< Update_MX_Domain) rr.domain rr.valid ]
, HH.td_ [ S.input_ttl (UpdateNewMXForm <<< Update_New_MX_TTL) rr.ttl rr.valid ] , HH.td_ [ S.input_ttl (UpdateNewMXForm <<< Update_MX_TTL) rr.ttl rr.valid ]
, HH.td_ [ S.input_priority (UpdateNewMXForm <<< Update_New_MX_Priority) rr.priority rr.valid ] , HH.td_ [ S.input_priority (UpdateNewMXForm <<< Update_MX_Priority) rr.priority rr.valid ]
, HH.td_ [ S.input_value (UpdateNewMXForm <<< Update_New_MX_Value) rr.value rr.valid ] , HH.td_ [ S.input_value (UpdateNewMXForm <<< Update_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 ]
] ]
@ -661,12 +671,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 (UpdateNewSRVForm <<< Update_New_SRV_Domain) rr.domain rr.valid ] [ HH.td_ [ S.input_domain (UpdateNewSRVForm <<< Update_SRV_Domain) rr.domain rr.valid ]
, HH.td_ [ S.input_ttl (UpdateNewSRVForm <<< Update_New_SRV_TTL) rr.ttl rr.valid ] , HH.td_ [ S.input_ttl (UpdateNewSRVForm <<< Update_SRV_TTL) rr.ttl rr.valid ]
, HH.td_ [ S.input_priority (UpdateNewSRVForm <<< Update_New_SRV_Priority) rr.priority rr.valid ] , HH.td_ [ S.input_priority (UpdateNewSRVForm <<< Update_SRV_Priority) rr.priority rr.valid ]
, HH.td_ [ S.input_weight (UpdateNewSRVForm <<< Update_New_SRV_Weight) rr.weight rr.valid ] , HH.td_ [ S.input_weight (UpdateNewSRVForm <<< Update_SRV_Weight) rr.weight rr.valid ]
, HH.td_ [ S.input_port (UpdateNewSRVForm <<< Update_New_SRV_Port) rr.port rr.valid ] , HH.td_ [ S.input_port (UpdateNewSRVForm <<< Update_SRV_Port) rr.port rr.valid ]
, HH.td_ [ S.input_value (UpdateNewSRVForm <<< Update_New_SRV_Value) rr.value rr.valid ] , HH.td_ [ S.input_value (UpdateNewSRVForm <<< Update_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 ]
] ]
@ -694,16 +704,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 (UpdateNewSimpleRRForm <<< Update_New_SSR_Domain) rr.domain rr.valid , S.box_input_domain (UpdateNewSRRForm <<< Update_SRR_Domain) rr.domain rr.valid
, S.box_input_ttl (UpdateNewSimpleRRForm <<< Update_New_SSR_TTL) rr.ttl rr.valid , S.box_input_ttl (UpdateNewSRRForm <<< Update_SRR_TTL) rr.ttl rr.valid
, S.box_input_value (UpdateNewSimpleRRForm <<< Update_New_SSR_Value) rr.value rr.valid , S.box_input_value (UpdateNewSRRForm <<< Update_SRR_Value) rr.value rr.valid
, S.btn_add AddSimple (TellSomethingWentWrong rr.id "cannot add") rr.valid , S.btn_add AddSRR (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 (UpdateNewSimpleRRForm <<< Update_New_SRR_Type) ] [ HE.onSelectedIndexChange (UpdateNewSRRForm <<< Update_SRR_Type) ]
$ map type_option baseRecords $ map type_option baseRecords
type_option n type_option n
= HH.option = HH.option
@ -716,10 +726,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 (UpdateNewMXForm <<< Update_New_MX_Domain) rr.domain rr.valid , S.box_input_domain (UpdateNewMXForm <<< Update_MX_Domain) rr.domain rr.valid
, S.box_input_ttl (UpdateNewMXForm <<< Update_New_MX_TTL) rr.ttl rr.valid , S.box_input_ttl (UpdateNewMXForm <<< Update_MX_TTL) rr.ttl rr.valid
, S.box_input_priority (UpdateNewMXForm <<< Update_New_MX_Priority) rr.priority rr.valid , S.box_input_priority (UpdateNewMXForm <<< Update_MX_Priority) rr.priority rr.valid
, S.box_input_value (UpdateNewMXForm <<< Update_New_MX_Value) rr.value rr.valid , S.box_input_value (UpdateNewMXForm <<< Update_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
] ]
] ]
@ -728,12 +738,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 (UpdateNewSRVForm <<< Update_New_SRV_Domain) rr.domain rr.valid , S.box_input_domain (UpdateNewSRVForm <<< Update_SRV_Domain) rr.domain rr.valid
, S.box_input_ttl (UpdateNewSRVForm <<< Update_New_SRV_TTL) rr.ttl rr.valid , S.box_input_ttl (UpdateNewSRVForm <<< Update_SRV_TTL) rr.ttl rr.valid
, S.box_input_priority (UpdateNewSRVForm <<< Update_New_SRV_Priority) rr.priority rr.valid , S.box_input_priority (UpdateNewSRVForm <<< Update_SRV_Priority) rr.priority rr.valid
, S.box_input_weight (UpdateNewSRVForm <<< Update_New_SRV_Weight) rr.weight rr.valid , S.box_input_weight (UpdateNewSRVForm <<< Update_SRV_Weight) rr.weight rr.valid
, S.box_input_port (UpdateNewSRVForm <<< Update_New_SRV_Port) rr.port rr.valid , S.box_input_port (UpdateNewSRVForm <<< Update_SRV_Port) rr.port rr.valid
, S.box_input_value (UpdateNewSRVForm <<< Update_New_SRV_Value) rr.value rr.valid , S.box_input_value (UpdateNewSRVForm <<< Update_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
] ]
] ]
@ -778,9 +788,9 @@ nav_bar domain
-- add a new record and get a new placeholter -- add a new record and get a new placeholter
add_new_entry :: State -> (SimpleRR ()) -> State add_new_entry :: State -> (SimpleRR ()) -> State
add_new_entry state rr add_new_entry state rr
= state { _rr = new_rr_list, _current_entry = new_placeholder } = state { _srr = new_rr_list, _current_entry = new_placeholder }
where new_placeholder = defaultResourceA where new_placeholder = defaultResourceA
new_rr_list = state._rr <> [ new_rr ] new_rr_list = state._srr <> [ new_rr ]
new_rr = rr { id = getNewID state } new_rr = rr { id = getNewID state }
-- add a new record and get a new placeholter -- add a new record and get a new placeholter
@ -803,24 +813,29 @@ changeType :: forall (l :: Row Type). (SimpleRR l) -> Maybe String -> (SimpleRR
changeType rr Nothing = rr changeType rr Nothing = rr
changeType rr (Just s) = rr { t = s } changeType rr (Just s) = rr { t = s }
update_domain :: forall (l :: Row Type).
Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l)
update_domain rr_id val
= update (\rr -> rr { modified = true, domain = val }) rr_id
update_value :: forall (l :: Row Type). update_value :: forall (l :: Row Type).
Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l) Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l)
update_value rrid val update_value rr_id val
= update (\rr -> rr { modified = true, value = val }) rrid = update (\rr -> rr { modified = true, value = val }) rr_id
update_ttl :: forall (l :: Row Type). update_ttl :: forall (l :: Row Type).
Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l) Int -> String -> Array (SimpleRR l) -> Array (SimpleRR l)
update_ttl rrid val update_ttl rr_id val
= update (\rr -> rr { modified = true, ttl = val, valid = isInteger val }) rrid = update (\rr -> rr { modified = true, ttl = val, valid = isInteger val }) rr_id
update_priority :: forall (l :: Row Type). Int -> Priority -> Array (MXRR l) -> Array (MXRR l) update_priority :: forall (l :: Row Type). Int -> Priority -> Array (MXRR l) -> Array (MXRR l)
update_priority rrid val = update (\rr -> rr { modified = true, priority = val}) rrid update_priority rr_id val = update (\rr -> rr { modified = true, priority = val}) rr_id
update_weight :: forall (l :: Row Type). Int -> Priority -> Array (SRVRR l) -> Array (SRVRR l) update_weight :: forall (l :: Row Type). Int -> Priority -> Array (SRVRR l) -> Array (SRVRR l)
update_weight rrid val = update (\rr -> rr { modified = true, weight = val}) rrid update_weight rr_id val = update (\rr -> rr { modified = true, weight = val}) rr_id
update_port :: Int -> Priority -> Array (SRVRR ()) -> Array (SRVRR ()) update_port :: Int -> Priority -> Array (SRVRR ()) -> Array (SRVRR ())
update_port rrid val = update (\rr -> rr { modified = true, port = val}) rrid update_port rr_id val = update (\rr -> rr { modified = true, port = val}) rr_id
isIntRegex :: Regex isIntRegex :: Regex
@ -831,10 +846,10 @@ isInteger = test isIntRegex
update :: forall (l :: Row Type). update :: forall (l :: Row Type).
(SimpleRR l -> SimpleRR l) -> Int -> Array (SimpleRR l) -> Array (SimpleRR l) (SimpleRR l -> SimpleRR l) -> Int -> Array (SimpleRR l) -> Array (SimpleRR l)
update f rrid records = map doSmth records update f rr_id records = map doSmth records
where where
doSmth rr doSmth rr
| rrid == rr.id = f rr | rr_id == rr.id = f rr
| otherwise = rr | otherwise = rr
@ -845,7 +860,7 @@ getNewID state = (_ + 1) $ foldl max 0 [ maxIDrr
] ]
where where
maxIDrr = foldl max 0 $ map _.id state._rr maxIDrr = foldl max 0 $ map _.id state._srr
maxIDmxrr = foldl max 0 $ map _.id state._mxrr maxIDmxrr = foldl max 0 $ map _.id state._mxrr
maxIDsrvrr = foldl max 0 $ map _.id state._srvrr maxIDsrvrr = foldl max 0 $ map _.id state._srvrr