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

All updates in only two actions.

beta
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

413
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,171 +251,177 @@ 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_SRR_Type val -> do Update_New_Form_SRR rr_update -> case rr_update of
-- let new_type = fromMaybe "unknown" (baseRecords A.!! val) Update_SRR_Type val -> do
-- H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type) -- let new_type = fromMaybe "unknown" (baseRecords A.!! val)
state <- H.get -- H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type)
H.modify_ _ { _current_entry = changeType state._current_entry (baseRecords A.!! val) } state <- H.get
Update_SRR_Domain val -> do H.modify_ _ { _current_entry = changeType state._current_entry (baseRecords A.!! val) }
-- H.raise $ Log $ SimpleLog ("Update new entry domain: " <> val) Update_SRR_Domain val -> do
H.modify_ _ { _current_entry { domain = val } } -- H.raise $ Log $ SimpleLog ("Update new entry domain: " <> val)
Update_SRR_TTL val -> do H.modify_ _ { _current_entry { domain = val } }
-- H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> val) Update_SRR_TTL val -> do
H.modify_ _ { _current_entry { ttl = val, valid = isInteger val } } -- H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> val)
Update_SRR_Value val -> do H.modify_ _ { _current_entry { ttl = val, valid = isInteger val } }
-- H.raise $ Log $ SimpleLog ("Update new entry value: " <> val) Update_SRR_Value val -> do
H.modify_ _ { _current_entry { value = val } } -- H.raise $ Log $ SimpleLog ("Update new 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
Update_MX_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update new MX entry domain: " <> val)
state <- H.get
H.modify_ _ { _current_entry_mx = state._current_entry_mx { domain = val } }
-- TODO: FIXME: test all inputs
Update_MX_TTL val -> do
-- H.raise $ Log $ SimpleLog ("Update new MX entry ttl: " <> val)
state <- H.get
H.modify_ _ { _current_entry_mx = state._current_entry_mx {ttl = val, valid = isInteger val} }
-- TODO: FIXME: test all inputs
Update_MX_Value val -> do
-- H.raise $ Log $ SimpleLog ("Update new MX entry value: " <> val)
state <- H.get
H.modify_ _ { _current_entry_mx = state._current_entry_mx { value = val } }
Update_MX_Priority val -> do
-- H.raise $ Log $ SimpleLog ("Update new MX entry priority: " <> val)
state <- H.get
H.modify_ _ { _current_entry_mx = state._current_entry_mx { priority = val } }
UpdateNewSRVForm rr_update -> case rr_update of
Update_SRV_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry domain: " <> val)
state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv { domain = val } }
Update_SRV_Value val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry value: " <> val)
state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv { value = val } }
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
Update_SRV_TTL val -> do Update_MX_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val) -- H.raise $ Log $ SimpleLog ("Update new MX entry domain: " <> val)
state <- H.get state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv {ttl = val, valid = isInteger val}} H.modify_ _ { _current_entry_mx = state._current_entry_mx { domain = val } }
Update_SRV_Priority val -> do -- TODO: FIXME: test all inputs
-- H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val) Update_MX_TTL val -> do
state <- H.get -- H.raise $ Log $ SimpleLog ("Update new MX entry ttl: " <> val)
H.modify_ _ { _current_entry_srv = state._current_entry_srv { priority = val } } state <- H.get
Update_SRV_Protocol val -> do H.modify_ _ { _current_entry_mx = state._current_entry_mx {ttl = val, valid = isInteger val} }
-- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val) -- TODO: FIXME: test all inputs
state <- H.get Update_MX_Value val -> do
H.modify_ _ { _current_entry_srv = state._current_entry_srv { protocol = val } } -- H.raise $ Log $ SimpleLog ("Update new MX entry value: " <> val)
Update_SRV_Weight val -> do state <- H.get
-- H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val) H.modify_ _ { _current_entry_mx = state._current_entry_mx { value = val } }
state <- H.get Update_MX_Priority val -> do
H.modify_ _ { _current_entry_srv = state._current_entry_srv { weight = val } } -- H.raise $ Log $ SimpleLog ("Update new MX entry priority: " <> val)
Update_SRV_Port val -> do state <- H.get
-- H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val) H.modify_ _ { _current_entry_mx = state._current_entry_mx { priority = val } }
state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv { port = val } }
Update_New_Form_SRVRR rr_update -> case rr_update of
Update_SRV_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry domain: " <> val)
state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv { domain = val } }
Update_SRV_Value val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry value: " <> val)
state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv { value = val } }
-- TODO: FIXME: test all inputs
Update_SRV_TTL val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val)
state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv {ttl = val, valid = isInteger val}}
Update_SRV_Priority val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val)
state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv { priority = val } }
Update_SRV_Protocol val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val)
state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv { protocol = val } }
Update_SRV_Weight val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val)
state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv { weight = val } }
Update_SRV_Port val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val)
state <- H.get
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
state <- H.get Add_SRR -> do
let newrr = fromLocalSimpleRRRepresentationToResourceRecord state._current_entry state <- H.get
H.raise $ Log $ SimpleLog ("Add new simple RR: " <> show state._current_entry) let newrr = fromLocalSimpleRRRepresentationToResourceRecord state._current_entry
message <- H.liftEffect H.raise $ Log $ SimpleLog ("Add new simple RR: " <> show state._current_entry)
$ DNSManager.serialize message <- H.liftEffect
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr } $ DNSManager.serialize
H.raise $ MessageToSend message $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
AddMX -> do H.raise $ MessageToSend message
state <- H.get
let newrr = fromLocalMXRRRepresentationToResourceRecord state._current_entry_mx
H.raise $ Log $ SimpleLog ("Add new MX: " <> show state._current_entry_mx)
message <- H.liftEffect
$ DNSManager.serialize
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
H.raise $ MessageToSend message
AddSRV -> do
state <- H.get
let newrr = fromLocalSRVRRepresentationToResourceRecord state._current_entry_srv
H.raise $ Log $ SimpleLog ("Add new SRV: " <> show state._current_entry_srv)
message <- H.liftEffect
$ DNSManager.serialize
$ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
H.raise $ MessageToSend message
UpdateLocalSRRForm rr_id rr_update -> case rr_update of Add_MXRR -> do
Update_SRR_Type val -> do
let new_type = fromMaybe "unknown" (baseRecords A.!! 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 A.!! val) }
Update_SRR_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " domain: " <> val)
state <- H.get state <- H.get
H.modify_ _ { _srr = (update_domain rr_id val state._srr) } let newrr = fromLocalMXRRRepresentationToResourceRecord state._current_entry_mx
Update_SRR_TTL val -> do H.raise $ Log $ SimpleLog ("Add new MX: " <> show state._current_entry_mx)
-- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " TTL: " <> val) message <- H.liftEffect
state <- H.get $ DNSManager.serialize
H.modify_ _ { _srr = (update_ttl rr_id val state._srr) } $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
Update_SRR_Value val -> do H.raise $ MessageToSend message
-- 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) }
UpdateLocalMXForm rr_id rr_update -> case rr_update of Add_SRVRR -> do
-- TODO: FIXME: test all inputs
Update_MX_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update local MX RR " <> show rr_id <> " domain: " <> val)
state <- H.get state <- H.get
H.modify_ _ { _mxrr = (update_domain rr_id val state._mxrr) } case fromLocalToRR state._current_entry_srv of
-- TODO: FIXME: test all inputs Left errmsg -> H.raise $ Log $ SimpleLog $ "Add new SRV failed: " <> errmsg
Update_MX_TTL val -> do Right newrr -> do
-- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry ttl: " <> val) H.raise $ Log $ SimpleLog $ "Add new SRV: " <> show state._current_entry_srv
state <- H.get message <- H.liftEffect
H.modify_ _ { _mxrr = (update_ttl rr_id val state._mxrr) } $ DNSManager.serialize
-- TODO: FIXME: test all inputs $ DNSManager.MkAddRR { domain: state._current_domain, rr: newrr }
Update_MX_Value val -> do H.raise $ MessageToSend message
-- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry value: " <> val)
state <- H.get
H.modify_ _ { _mxrr = (update_value rr_id val state._mxrr) }
Update_MX_Priority val -> do
-- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry priority: " <> val)
state <- H.get
H.modify_ _ { _mxrr = (update_priority rr_id val state._mxrr) }
UpdateLocalSRVForm rr_id rr_update -> case rr_update of UpdateLocalForm rr_id form -> case form of
Update_SRV_Domain val -> do Update_Local_Form_SRR rr_update -> case rr_update of
-- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry domain: " <> val) Update_SRR_Type val -> do
state <- H.get let new_type = fromMaybe "unknown" (baseRecords A.!! val)
H.modify_ _ { _srvrr = (update_domain rr_id val state._srvrr) } H.raise $ Log $ SimpleLog ("TODO: Update local RR " <> show rr_id <> " type: " <> new_type)
Update_SRV_Value val -> do -- state <- H.get
-- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry value: " <> val) -- H.modify_ _ { _srr = changeType state._current_entry (baseRecords A.!! val) }
state <- H.get Update_SRR_Domain val -> do
H.modify_ _ { _srvrr = (update_value rr_id val state._srvrr) } -- 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) }
Update_Local_Form_MXRR rr_update -> case rr_update of
-- TODO: FIXME: test all inputs -- TODO: FIXME: test all inputs
Update_SRV_TTL val -> do Update_MX_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry ttl: " <> val) -- H.raise $ Log $ SimpleLog ("Update local MX RR " <> show rr_id <> " domain: " <> val)
state <- H.get state <- H.get
H.modify_ _ { _srvrr = (update_ttl rr_id val state._srvrr) } H.modify_ _ { _mxrr = (update_domain rr_id val state._mxrr) }
Update_SRV_Priority val -> do -- TODO: FIXME: test all inputs
-- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry priority: " <> val) Update_MX_TTL val -> do
state <- H.get -- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry ttl: " <> val)
H.modify_ _ { _srvrr = (update_priority rr_id val state._srvrr) } state <- H.get
Update_SRV_Protocol val -> do H.modify_ _ { _mxrr = (update_ttl rr_id val state._mxrr) }
-- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val) -- TODO: FIXME: test all inputs
state <- H.get Update_MX_Value val -> do
H.modify_ _ { _srvrr = (update_protocol rr_id val state._srvrr) } -- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry value: " <> val)
Update_SRV_Weight val -> do state <- H.get
-- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry weight: " <> val) H.modify_ _ { _mxrr = (update_value rr_id val state._mxrr) }
state <- H.get Update_MX_Priority val -> do
H.modify_ _ { _srvrr = (update_weight rr_id val state._srvrr) } -- H.raise $ Log $ SimpleLog ("Update local MX " <> show rr_id <> " entry priority: " <> val)
Update_SRV_Port val -> do state <- H.get
-- H.raise $ Log $ SimpleLog ("Update local SRV " <> show rr_id <> " entry port: " <> val) H.modify_ _ { _mxrr = (update_priority rr_id val state._mxrr) }
state <- H.get
H.modify_ _ { _srvrr = (update_port rr_id val state._srvrr) } Update_Local_Form_SRVRR 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_Protocol val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val)
state <- H.get
H.modify_ _ { _srvrr = (update_protocol 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
SyncRR rr_id -> do SyncRR rr_id -> do
@ -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
] ]
] ]
@ -750,7 +765,7 @@ new_soa :: State -> Maybe (SOARR ()) -> State
new_soa state = case _ of new_soa state = case _ of
Nothing -> state Nothing -> state
Just rr -> state { _soa = Just rr } Just rr -> state { _soa = Just rr }
changeType :: forall (l :: Row Type). (SimpleRR l) -> Maybe String -> (SimpleRR l) changeType :: forall (l :: Row Type). (SimpleRR l) -> Maybe String -> (SimpleRR l)
changeType rr Nothing = rr changeType rr Nothing = rr
changeType rr (Just s) = rr { t = s } changeType rr (Just s) = rr { t = s }