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

Better new RR forms.

Browse Source
This commit is contained in:
Philippe Pittoli 2023-07-15 04:13:51 +02:00
parent e60664b522
commit 8e83eb3b56
1 changed files with 82 additions and 67 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

149
src/App/ZoneInterface.purs
View File

@ -142,18 +142,24 @@ data Action
-- |
type State =
{ _current_domain :: RecordName
{ _domain :: RecordName
, wsUp :: Boolean
, active_modal :: Maybe Int
-- current entries
, _soa :: Maybe (SOARR ())
, _srr :: Array (SimpleRR ())
, _mxrr :: Array (MXRR ())
, _srvrr :: Array (SRVRR ())
, _current_entry :: (SimpleRR ())
, _current_entry_mx :: (MXRR ())
, _current_entry_srv :: (SRVRR ())
, _errors :: Hash.HashMap RRId Validation.Errors
, wsUp :: Boolean
, active_modal :: Maybe Int
-- potential future entries
, _newSRR :: (SimpleRR ())
, _newMXRR :: (MXRR ())
, _newSRVRR :: (SRVRR ())
, _newSRR_errors :: Hash.HashMap RRId Validation.Errors
, _newMXRR_errors :: Hash.HashMap RRId Validation.Errors
, _newSRVRR_errors :: Hash.HashMap RRId Validation.Errors
}
component :: forall m. MonadAff m => H.Component Query Input Output m
@ -178,15 +184,20 @@ initialState domain =
{ wsUp: true
, active_modal: Nothing
, _current_domain: domain
, _domain: domain
, _soa: Nothing
, _srr: []
, _mxrr: []
, _srvrr: []
, _current_entry: defaultResourceA
, _current_entry_mx: defaultResourceMX
, _current_entry_srv: defaultResourceSRV
, _errors: Hash.empty
, _newSRR: defaultResourceA
, _newMXRR: defaultResourceMX
, _newSRVRR: defaultResourceSRV
, _newSRR_errors: Hash.empty
, _newMXRR_errors: Hash.empty
, _newSRVRR_errors: Hash.empty
}
type SortableRecord l = Record (rrtype :: String, rrid :: Int | l)
@ -197,7 +208,7 @@ render state
[ case state.wsUp, state.active_modal of
false, _ -> Bulma.p "You are disconnected."
true, Just rr_id -> modal_rr_delete rr_id
true, Nothing -> HH.div_ [ Bulma.h1 state._current_domain
true, Nothing -> HH.div_ [ Bulma.h1 state._domain
, Bulma.hr
, render_soa state._soa
, render_records state._errors $ sorted state._srr
@ -252,9 +263,9 @@ handleAction = case _ of
H.modify_ _ { active_modal = Just rr_id }
Initialize -> do
{ _current_domain } <- H.get
H.raise $ Log $ SimpleLog $ "Asking the server for the zone" <> _current_domain
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetZone { domain: _current_domain }
{ _domain } <- H.get
H.raise $ Log $ SimpleLog $ "Asking the server for the zone" <> _domain
message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetZone { domain: _domain }
H.raise $ MessageToSend message
UpdateNewForm form -> case form of
@ -263,82 +274,82 @@ handleAction = case _ of
-- let new_type = fromMaybe "unknown" (baseRecords A.!! val)
-- H.raise $ Log $ SimpleLog ("Update new entry type: " <> new_type)
state <- H.get
H.modify_ _ { _current_entry = changeType state._current_entry (baseRecords A.!! val) }
H.modify_ _ { _newSRR = changeType state._newSRR (baseRecords A.!! val) }
Update_SRR_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update new entry name: " <> val)
H.modify_ _ { _current_entry { name = val } }
H.modify_ _ { _newSRR { name = val } }
Update_SRR_TTL val -> do
-- H.raise $ Log $ SimpleLog ("Update new entry ttl: " <> val)
H.modify_ _ { _current_entry { ttl = val, valid = isInteger val } }
H.modify_ _ { _newSRR { ttl = val, valid = isInteger val } }
Update_SRR_Target val -> do
-- H.raise $ Log $ SimpleLog ("Update new entry target: " <> val)
H.modify_ _ { _current_entry { target = val } }
H.modify_ _ { _newSRR { target = val } }
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 name: " <> val)
state <- H.get
H.modify_ _ { _current_entry_mx = state._current_entry_mx { name = val } }
H.modify_ _ { _newMXRR = state._newMXRR { name = 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} }
H.modify_ _ { _newMXRR = state._newMXRR {ttl = val, valid = isInteger val} }
-- TODO: FIXME: test all inputs
Update_MX_Target val -> do
-- H.raise $ Log $ SimpleLog ("Update new MX entry target: " <> val)
state <- H.get
H.modify_ _ { _current_entry_mx = state._current_entry_mx { target = val } }
H.modify_ _ { _newMXRR = state._newMXRR { target = 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 } }
H.modify_ _ { _newMXRR = state._newMXRR { priority = val } }
Update_New_Form_SRVRR rr_update -> case rr_update of
Update_SRV_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry name: " <> val)
state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv { name = val } }
H.modify_ _ { _newSRVRR = state._newSRVRR { name = val } }
Update_SRV_Target val -> do
-- H.raise $ Log $ SimpleLog ("Update new SRV entry target: " <> val)
state <- H.get
H.modify_ _ { _current_entry_srv = state._current_entry_srv { target = val } }
H.modify_ _ { _newSRVRR = state._newSRVRR { target = 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}}
H.modify_ _ { _newSRVRR = state._newSRVRR {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 } }
H.modify_ _ { _newSRVRR = state._newSRVRR { 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 } }
H.modify_ _ { _newSRVRR = state._newSRVRR { 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 } }
H.modify_ _ { _newSRVRR = state._newSRVRR { 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 } }
H.modify_ _ { _newSRVRR = state._newSRVRR { port = val } }
-- This action only is possible if inputs are correct.
AddRR form -> case form of
Add_SRR -> do
state <- H.get
try_add_new_entry state._current_domain (Validation.validateSRR state._current_entry) "simple"
try_add_new_entry state._domain (Validation.validateSRR state._newSRR) "simple"
Add_MXRR -> do
state <- H.get
try_add_new_entry state._current_domain (Validation.validateMXRR state._current_entry_mx) "MX"
try_add_new_entry state._domain (Validation.validateMXRR state._newMXRR) "MX"
Add_SRVRR -> do
state <- H.get
try_add_new_entry state._current_domain (Validation.validateSRVRR state._current_entry_srv) "SRV"
try_add_new_entry state._domain (Validation.validateSRVRR state._newSRVRR) "SRV"
UpdateLocalForm rr_id form -> case form of
Update_Local_Form_SRR rr_update -> case rr_update of
@ -346,7 +357,7 @@ handleAction = case _ of
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) }
-- H.modify_ _ { _srr = changeType state._newSRR (baseRecords A.!! val) }
Update_SRR_Domain val -> do
-- H.raise $ Log $ SimpleLog ("Update local RR " <> show rr_id <> " name: " <> val)
state <- H.get
@ -415,25 +426,25 @@ handleAction = case _ of
SaveSRR local_rr_id -> do
state <- H.get
let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._srr
try_update_entry state._current_domain Validation.validateSRR maybe_local_rr "simple"
try_update_entry state._domain Validation.validateSRR maybe_local_rr "simple"
SaveMXRR local_rr_id -> do
state <- H.get
let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._mxrr
try_update_entry state._current_domain Validation.validateMXRR maybe_local_rr "MX"
try_update_entry state._domain Validation.validateMXRR maybe_local_rr "MX"
SaveSRVRR local_rr_id -> do
state <- H.get
let maybe_local_rr = first (\rr -> rr.rrid == local_rr_id) state._srvrr
try_update_entry state._current_domain Validation.validateSRVRR maybe_local_rr "SRV"
try_update_entry state._domain Validation.validateSRVRR maybe_local_rr "SRV"
RemoveRR rr_id -> do
{ _current_domain } <- H.get
{ _domain } <- H.get
H.raise $ Log $ SimpleLog $ "Ask to remove rr (rrid: " <> show rr_id <> ")"
-- Send a removal message.
message <- H.liftEffect
$ DNSManager.serialize
$ DNSManager.MkDeleteRR { domain: _current_domain, rrid: rr_id }
$ DNSManager.MkDeleteRR { domain: _domain, rrid: rr_id }
H.raise $ MessageToSend message
-- Modal doesn't need to be active anymore.
H.modify_ _ { active_modal = Nothing }
@ -794,12 +805,12 @@ render_new_records state
[ Bulma.h1 "Adding new records"
, Bulma.hr
, Bulma.columns []
[ render_new_record_column_simple state._current_entry state._errors
, render_new_record_colunm_mx state._current_entry_mx state._errors
, render_new_record_colunm_srv state._current_entry_srv state._errors
-- , render_current_target state._current_entry
-- , render_mx_current_target state._current_entry_mx
-- , render_srv_current_target state._current_entry_srv
[ render_new_record_column_simple state._newSRR state._errors
, render_new_record_colunm_mx state._newMXRR state._errors
, render_new_record_colunm_srv state._newSRVRR state._errors
-- , render_current_target state._newSRR
-- , render_mx_current_target state._newMXRR
-- , render_srv_current_target state._newSRVRR
]
]
@ -843,31 +854,35 @@ render_new_record_column_simple rr errors
render_new_record_colunm_mx :: forall (w :: Type)
. (MXRR ()) -> Hash.HashMap RRId Validation.Errors -> HH.HTML w Action
render_new_record_colunm_mx rr errors
= Bulma.column_ $ [ Bulma.box
[ Bulma.zone_rr_title "MX"
, Bulma.box_input_domain (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Domain) rr.name rr.valid
, Bulma.box_input_ttl (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_TTL) rr.ttl rr.valid
, Bulma.box_input_priority (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Priority) rr.priority rr.valid
, Bulma.box_input_target (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Target) rr.target rr.valid
, Bulma.btn_add (AddRR Add_MXRR) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid
]
= Bulma.column_
[ Bulma.zone_rr_title "MX"
, Bulma.hr
, Bulma.box_input "domainMX" "Domain" "mail" (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Domain) rr.name rr.valid should_be_disabled
, Bulma.box_input "ttlMX" "TTL" "3600" (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_TTL) rr.ttl rr.valid should_be_disabled
, Bulma.box_input "priorityMX" "Priority" "10" (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Priority) rr.priority rr.valid should_be_disabled
, Bulma.box_input "targetMX" "Target" "www" (UpdateNewForm <<< Update_New_Form_MXRR <<< Update_MX_Target) rr.target rr.valid should_be_disabled
, Bulma.btn_add (AddRR Add_MXRR) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid
]
where
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
render_new_record_colunm_srv :: forall (w :: Type)
. (SRVRR ()) -> Hash.HashMap RRId Validation.Errors -> HH.HTML w Action
render_new_record_colunm_srv rr errors
= Bulma.column_ $ [ Bulma.box
[ Bulma.zone_rr_title "SRV"
, Bulma.box_input_domain (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Domain) rr.name rr.valid
, Bulma.box_input_ttl (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_TTL) rr.ttl rr.valid
, Bulma.box_input_priority (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Priority) rr.priority rr.valid
, Bulma.box_input_protocol (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Protocol) rr.protocol rr.valid
, Bulma.box_input_weight (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Weight) rr.weight rr.valid
, Bulma.box_input_port (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Port) rr.port rr.valid
, Bulma.box_input_target (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Target) rr.target rr.valid
, Bulma.btn_add (AddRR Add_SRVRR) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid
]
= Bulma.column_
[ Bulma.zone_rr_title "SRV"
, Bulma.hr
, Bulma.box_input "nameSRV" "Name" "_sip._tcp" (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Domain) rr.name rr.valid should_be_disabled
, Bulma.box_input "ttlSRV" "TTL" "3600" (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_TTL) rr.ttl rr.valid should_be_disabled
, Bulma.box_input "prioritySRV" "Priority" "10" (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Priority) rr.priority rr.valid should_be_disabled
, Bulma.box_input "protocolSRV" "Protocol" "tcp" (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Protocol) rr.protocol rr.valid should_be_disabled
, Bulma.box_input "weightSRV" "Weight" "10" (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Weight) rr.weight rr.valid should_be_disabled
, Bulma.box_input "portSRV" "Port" "80" (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Port) rr.port rr.valid should_be_disabled
, Bulma.box_input "targetSRV" "Target" "example.com." (UpdateNewForm <<< Update_New_Form_SRVRR <<< Update_SRV_Target) rr.target rr.valid should_be_disabled
, Bulma.btn_add (AddRR Add_SRVRR) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid
]
where
should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true))
-- ACTIONS
@ -875,19 +890,19 @@ render_new_record_colunm_srv rr errors
add_new_entry :: State -> Maybe (SimpleRR ()) -> State
add_new_entry state = case _ of
Nothing -> state
Just rr -> state { _srr = (state._srr <> [ rr ]), _current_entry = defaultResourceA }
Just rr -> state { _srr = (state._srr <> [ rr ]), _newSRR = defaultResourceA }
-- add a new record and get a new placeholter
add_new_mx :: State -> Maybe (MXRR ()) -> State
add_new_mx state = case _ of
Nothing -> state
Just rr -> state { _mxrr = (state._mxrr <> [ rr ]), _current_entry_mx = defaultResourceMX }
Just rr -> state { _mxrr = (state._mxrr <> [ rr ]), _newMXRR = defaultResourceMX }
-- add a new record and get a new placeholter
add_new_srv :: State -> Maybe (SRVRR ()) -> State
add_new_srv state = case _ of
Nothing -> state
Just rr -> state { _srvrr = (state._srvrr <> [ rr ]), _current_entry_srv = defaultResourceSRV }
Just rr -> state { _srvrr = (state._srvrr <> [ rr ]), _newSRVRR = defaultResourceSRV }
new_soa :: State -> Maybe (SOARR ()) -> State
new_soa state = case _ of