diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 4fec87d..8486482 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -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