Better new RR forms.
parent
e60664b522
commit
8e83eb3b56
|
|
@ -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
|
||||
|
|
|
|||
Loading…
Reference in New Issue