diff --git a/drop/UnusedCode.purs b/drop/UnusedCode.purs index ff07709..c029077 100644 --- a/drop/UnusedCode.purs +++ b/drop/UnusedCode.purs @@ -21,3 +21,24 @@ nav_bar domain ] ] + + -- type_selection: create a "select" input. + -- Get the changes with "onSelectedIndexChange" which provides an index (from `baseRecords`) + type_selection :: HH.HTML w Action + type_selection = HH.div [HP.classes $ C.select <> C.is_normal] + [ HH.select + [ HE.onSelectedIndexChange (UpdateNewForm <<< Update_New_Form_SRR <<< Update_SRR_Type) ] + $ map type_option baseRecords + ] + type_option n + = HH.option + [ HP.value n + , HP.selected (n == rr.rrtype) + ] [ HH.text n ] + + -- Get the element from the index + H.modify_ _ { _newSRR = changeType state._newSRR (baseRecords A.!! val) } + + changeType :: forall (l :: Row Type). (SimpleRR l) -> Maybe String -> (SimpleRR l) + changeType rr Nothing = rr + changeType rr (Just s) = rr { rrtype = s } diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 6dfd0dd..36326a4 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -17,11 +17,14 @@ module App.ZoneInterface where -import Prelude (Unit, bind, comparing, discard, map, max, otherwise, pure, show, ($), (+), (/=), (<<<), (<>), (==)) +import Prelude (Unit, unit, void + , bind, pure + , comparing, discard, map, max, otherwise, show + , ($), (+), (/=), (<<<), (<>), (==)) import Data.HashMap as Hash import Data.Array as A -import Data.Tuple (Tuple(..)) +import Data.Tuple (Tuple(..), snd) import Data.ArrayBuffer.Types (ArrayBuffer) import Data.Array.NonEmpty as NonEmpty import Data.Either (Either(..)) @@ -32,6 +35,7 @@ import Data.String.Regex as Regex import Data.String.Regex.Flags as RegexFlags import Data.String.Regex.Unsafe as RegexUnsafe import Effect.Aff.Class (class MonadAff) +-- import Effect (foreachE) import Halogen as H import Halogen.HTML as HH import Halogen.HTML.Events as HE @@ -93,33 +97,7 @@ type Input = String -- | - remove a resource record -- | - handle user inputs -data Add_RR - = Add_SRR - | Add_MXRR - | Add_SRVRR - - -- NEW - | Add_A - | Add_AAAA - | Add_TXT - | Add_CNAME - | Add_NS - | Add_MX - | Add_SRV - - -data Update_SRR_Form - = Update_SRR_Type Int - | Update_SRR_Domain RecordName - | Update_SRR_TTL TTL - | Update_SRR_Target RecordTarget - -data Update_MX_Form - = Update_MX_Domain RecordName - | Update_MX_TTL TTL - | Update_MX_Target RecordTarget - | Update_MX_Priority Priority - +-- TODO: rename this. data Update_MODAL_Form = Update_MODAL_Domain RecordName | Update_MODAL_TTL TTL @@ -129,6 +107,21 @@ data Update_MODAL_Form | Update_MODAL_Weight Weight | Update_MODAL_Port Port +-- TODO: remove this. +data Update_SRR_Form + = Update_SRR_Type Int + | Update_SRR_Domain RecordName + | Update_SRR_TTL TTL + | Update_SRR_Target RecordTarget + +-- TODO: remove this. +data Update_MX_Form + = Update_MX_Domain RecordName + | Update_MX_TTL TTL + | Update_MX_Target RecordTarget + | Update_MX_Priority Priority + +-- TODO: remove this. data Update_SRV_Form = Update_SRV_Domain RecordName | Update_SRV_TTL TTL @@ -138,11 +131,11 @@ data Update_SRV_Form | Update_SRV_Weight Weight | Update_SRV_Port Port +-- TODO: remove this. 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 - | Update_New_MODAL_Form_RR Update_MODAL_Form data Update_Local_Form = Update_Local_Form_SRR Update_SRR_Form @@ -157,11 +150,14 @@ data Action | Initialize -- Add new entries. - | AddRR Add_RR + | AddRR AcceptedRRTypes -- Update new entry forms. | UpdateNewForm Update_New_Form + -- Update new entry form (in the `active_new_rr_modal` modal). + | UpdateNewRRForm Update_MODAL_Form + -- Update an already active entry. | UpdateLocalForm RRId Update_Local_Form @@ -289,99 +285,101 @@ render state ] modal_add_new_rr :: forall w. AcceptedRRTypes -> State -> HH.HTML w Action - modal_add_new_rr t { _newRR: rr } = case t of - A -> template "A" (content_simple "A") (foot_content Add_A) - AAAA -> template "AAAA" (content_simple "AAAA") (foot_content Add_AAAA) - TXT -> template "TXT" (content_simple "TXT") (foot_content Add_TXT) - CNAME -> template "CNAME" (content_simple "CNAME") (foot_content Add_CNAME) - NS -> template "NS" (content_simple "NS") (foot_content Add_NS) - MX -> template "MX" content_mx (foot_content Add_MX) - SRV -> template "SRV" content_srv (foot_content Add_SRV) + modal_add_new_rr t state = case t of + A -> template "A" (content_simple "A") (foot_content A) + AAAA -> template "AAAA" (content_simple "AAAA") (foot_content AAAA) + TXT -> template "TXT" (content_simple "TXT") (foot_content TXT) + CNAME -> template "CNAME" (content_simple "CNAME") (foot_content CNAME) + NS -> template "NS" (content_simple "NS") (foot_content NS) + MX -> template "MX" content_mx (foot_content MX) + SRV -> template "SRV" content_srv (foot_content SRV) where -- DRY - updateForm x = UpdateNewForm <<< Update_New_MODAL_Form_RR <<< x + updateForm x = UpdateNewRRForm <<< x content_simple :: String -> Array (HH.HTML w Action) content_simple t = [ Bulma.box_input ("domain" <> t) "Name" "www" -- id, title, placeholder (updateForm Update_MODAL_Domain) -- action - rr.name -- value - rr.valid -- validity (TODO) + state._newRR.name -- value + state._newRR.valid -- validity (TODO) should_be_disabled -- condition , Bulma.box_input ("ttl" <> t) "TTL" "600" (updateForm Update_MODAL_TTL) - rr.ttl - rr.valid + state._newRR.ttl + state._newRR.valid should_be_disabled , Bulma.box_input ("target" <> t) "Target" "198.51.100.5" (updateForm Update_MODAL_Target) - rr.target - rr.valid + state._newRR.target + state._newRR.valid should_be_disabled ] content_mx :: Array (HH.HTML w Action) content_mx = [ Bulma.box_input ("domainMX") "Name" "mail" -- id, title, placeholder (updateForm Update_MODAL_Domain) -- action - rr.name -- value - rr.valid -- validity (TODO) + state._newRR.name -- value + state._newRR.valid -- validity (TODO) should_be_disabled -- condition , Bulma.box_input ("ttlMX") "TTL" "600" (updateForm Update_MODAL_TTL) - rr.ttl - rr.valid + state._newRR.ttl + state._newRR.valid should_be_disabled , Bulma.box_input ("targetMX") "Target" "www" (updateForm Update_MODAL_Target) - rr.target - rr.valid + state._newRR.target + state._newRR.valid should_be_disabled , Bulma.box_input ("priorityMX") "Priority" "10" (updateForm Update_MODAL_Priority) - rr.priority - rr.valid + state._newRR.priority + state._newRR.valid should_be_disabled ] content_srv :: Array (HH.HTML w Action) content_srv = [ Bulma.box_input ("domainSRV") "Name" "_sip._tcp" -- id, title, placeholder (updateForm Update_MODAL_Domain) -- action - rr.name -- value - rr.valid -- validity (TODO) + state._newRR.name -- value + state._newRR.valid -- validity (TODO) should_be_disabled -- condition , Bulma.box_input ("ttlSRV") "TTL" "600" (updateForm Update_MODAL_TTL) - rr.ttl - rr.valid + state._newRR.ttl + state._newRR.valid should_be_disabled , Bulma.box_input ("targetSRV") "Target" "www" (updateForm Update_MODAL_Target) - rr.target - rr.valid + state._newRR.target + state._newRR.valid should_be_disabled , Bulma.box_input ("prioritySRV") "Priority" "10" (updateForm Update_MODAL_Priority) - rr.priority - rr.valid + state._newRR.priority + state._newRR.valid should_be_disabled , Bulma.box_input ("portSRV") "Port" "5061" (updateForm Update_MODAL_Port) - rr.port - rr.valid + state._newRR.port + state._newRR.valid should_be_disabled , Bulma.box_input ("weightSRV") "Weight" "100" (updateForm Update_MODAL_Weight) - rr.weight - rr.valid + state._newRR.weight + state._newRR.valid should_be_disabled , Bulma.box_input ("protocolSRV") "Protocol" "tcp" (updateForm Update_MODAL_Protocol) - rr.protocol - rr.valid + state._newRR.protocol + state._newRR.valid should_be_disabled ] should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true)) - foot_content x = [Bulma.btn_add (AddRR x) (TellSomethingWentWrong rr.rrid "cannot add") rr.valid] + foot_content x = [ Bulma.btn_add (AddRR x) + (TellSomethingWentWrong state._newRR.rrid "cannot add") + state._newRR.valid ] template t content foot = Bulma.modal [ Bulma.modal_background , Bulma.modal_card [Bulma.modal_header $ "New " <> t <> " resource record" @@ -391,13 +389,16 @@ render state handleAction :: forall m. MonadAff m => Action -> H.HalogenM State Action () Output m Unit handleAction = case _ of - -- Works for both modals. + -- | Cancel the current modal being presented. + -- | Works for both "remove RR" and "new RR" modals. CancelModal -> do H.modify_ _ { active_modal = Nothing, active_new_rr_modal = Nothing } + -- | Create the RR modal. DeleteRRModal rr_id -> do H.modify_ _ { active_modal = Just rr_id } + -- | Each time a "new RR" button is clicked, the form resets. NewRRModal t -> do state <- H.get H.modify_ _ { active_new_rr_modal = Just t } @@ -438,45 +439,46 @@ handleAction = case _ of MX -> H.modify_ _ { _newRR = defaultMX } SRV -> H.modify_ _ { _newRR = defaultSRV } + -- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`. Initialize -> do { _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 - -- Update for the new RR form in the new RR modal. - Update_New_MODAL_Form_RR rr_update -> case rr_update of - Update_MODAL_Domain val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry name: " <> val) - state <- H.get - H.modify_ _ { _newRR = state._newRR { name = val } } - Update_MODAL_Target val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry target: " <> val) - state <- H.get - H.modify_ _ { _newRR = state._newRR { target = val } } - -- TODO: FIXME: test all inputs - Update_MODAL_TTL val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val) - state <- H.get - H.modify_ _ { _newRR = state._newRR {ttl = val, valid = isInteger val}} - Update_MODAL_Priority val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val) - state <- H.get - H.modify_ _ { _newRR = state._newRR { priority = val } } - Update_MODAL_Protocol val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val) - state <- H.get - H.modify_ _ { _newRR = state._newRR { protocol = val } } - Update_MODAL_Weight val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val) - state <- H.get - H.modify_ _ { _newRR = state._newRR { weight = val } } - Update_MODAL_Port val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val) - state <- H.get - H.modify_ _ { _newRR = state._newRR { port = val } } + -- Update for the new RR form in the new RR modal. + UpdateNewRRForm rr_update -> case rr_update of + Update_MODAL_Domain val -> do + -- H.raise $ Log $ SimpleLog ("Update new SRV entry name: " <> val) + state <- H.get + H.modify_ _ { _newRR = state._newRR { name = val } } + Update_MODAL_Target val -> do + -- H.raise $ Log $ SimpleLog ("Update new SRV entry target: " <> val) + state <- H.get + H.modify_ _ { _newRR = state._newRR { target = val } } + -- TODO: FIXME: test all inputs + Update_MODAL_TTL val -> do + -- H.raise $ Log $ SimpleLog ("Update new SRV entry ttl: " <> val) + state <- H.get + H.modify_ _ { _newRR = state._newRR {ttl = val, valid = isInteger val}} + Update_MODAL_Priority val -> do + -- H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val) + state <- H.get + H.modify_ _ { _newRR = state._newRR { priority = val } } + Update_MODAL_Protocol val -> do + -- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val) + state <- H.get + H.modify_ _ { _newRR = state._newRR { protocol = val } } + Update_MODAL_Weight val -> do + -- H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val) + state <- H.get + H.modify_ _ { _newRR = state._newRR { weight = val } } + Update_MODAL_Port val -> do + -- H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val) + state <- H.get + H.modify_ _ { _newRR = state._newRR { port = val } } + UpdateNewForm form -> case form of Update_New_Form_SRR rr_update -> case rr_update of Update_SRR_Type val -> do -- let new_type = fromMaybe "unknown" (baseRecords A.!! val) @@ -547,33 +549,33 @@ handleAction = case _ of -- This action only is possible if inputs are correct. AddRR form -> case form of - Add_A -> do - H.raise $ Log $ SimpleLog "TODO: trying to add a A RR blah blah blah" - Add_AAAA -> do + A -> do + H.raise $ Log $ SimpleLog "TODO: trying to add a A RR!" + state <- H.get + try_add_new_entry state._domain (Validation.validateSRR state._newRR) "simple" + AAAA -> do H.raise $ Log $ SimpleLog "TODO: trying to add a AAAA RR blah blah blah" - Add_TXT -> do + state <- H.get + try_add_new_entry state._domain (Validation.validateSRR state._newRR) "simple" + TXT -> do H.raise $ Log $ SimpleLog "TODO: trying to add a TXT RR blah blah blah" - Add_CNAME -> do + state <- H.get + try_add_new_entry state._domain (Validation.validateSRR state._newRR) "simple" + CNAME -> do H.raise $ Log $ SimpleLog "TODO: trying to add a CNAME RR blah blah blah" - Add_NS -> do + state <- H.get + try_add_new_entry state._domain (Validation.validateSRR state._newRR) "simple" + NS -> do H.raise $ Log $ SimpleLog "TODO: trying to add a NS RR blah blah blah" - Add_MX -> do + state <- H.get + try_add_new_entry state._domain (Validation.validateSRR state._newRR) "simple" + MX -> do H.raise $ Log $ SimpleLog "TODO: trying to add a MX RR blah blah blah" - Add_SRV -> do + SRV -> do H.raise $ Log $ SimpleLog "TODO: trying to add a SRV RR blah blah blah" ---- TODO --state <- H.get --try_add_new_entry state._domain (Validation.validateA state._newRR) "simple" - - Add_SRR -> do - state <- H.get - try_add_new_entry state._domain (Validation.validateSRR state._newSRR) "simple" - - Add_MXRR -> do - state <- H.get - try_add_new_entry state._domain (Validation.validateMXRR state._newMXRR) "MX" - - Add_SRVRR -> do state <- H.get try_add_new_entry state._domain (Validation.validateSRVRR state._newSRVRR) "SRV" @@ -682,8 +684,16 @@ handleAction = case _ of H.raise $ Log $ SimpleLog (" => " <> val) where + try_add_new_entry + :: String + -> Either Validation.Errors ResourceRecord + -> String + -> H.HalogenM State Action () Output m Unit try_add_new_entry d v t = case v of - Left _ -> H.raise $ Log $ SimpleLog $ "Cannot add this " <> t <> " RR, some errors occured in the record" + Left actual_errors -> do + H.raise $ Log $ SimpleLog $ "Cannot add this " <> t <> " RR, some errors occured in the record:" + loopE (\v -> H.raise $ Log $ SimpleLog $ "==> " <> v) $ map snd actual_errors + Right newrr -> do H.raise $ Log $ SimpleLog $ "Add new " <> t message <- H.liftEffect @@ -692,7 +702,12 @@ handleAction = case _ of H.raise $ MessageToSend message try_update_entry :: forall r - . String -> (AtLeastRRID r -> Either Validation.Errors ResourceRecord) -> Maybe (AtLeastRRID r) -> String -> _ + . String + -> (AtLeastRRID r + -> Either Validation.Errors ResourceRecord) + -> Maybe (AtLeastRRID r) + -> String + -> H.HalogenM State Action () Output m Unit try_update_entry d validation v t = case v of Nothing -> H.raise $ Log $ SimpleLog $ "Cannot find " <> t <> " RR with this rrid" Just local_rr -> do @@ -976,16 +991,17 @@ render_new_records state , Bulma.btn_add_new_rr (NewRRModal MX) "MX" , Bulma.btn_add_new_rr (NewRRModal SRV) "SRV" ] [] - , Bulma.columns [] - [ 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 - ] +-- , Bulma.columns [] +-- [ 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 +-- ] ] +{- render_new_record_column_simple :: forall (w :: Type) . (SimpleRR ()) -> Hash.HashMap RRId Validation.Errors -> HH.HTML w Action render_new_record_column_simple rr _ @@ -1055,6 +1071,7 @@ render_new_record_colunm_srv rr _ ] where should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true)) +-} -- ACTIONS @@ -1199,6 +1216,17 @@ fromResourceRecordToLocalRepresentationSOARR new_rr = do first :: forall a. (a -> Boolean) -> Array a -> Maybe a first condition = A.head <<< (A.filter condition) +loopE :: forall state action input output m a b + . (a -> H.HalogenM state action input output m b) + -> Array a + -> H.HalogenM state action input output m Unit +loopE f a = case (A.head a) of + Nothing -> pure unit + Just x -> do void $ f x + case (A.tail a) of + Nothing -> pure unit + Just xs -> loopE f xs + getNewID :: State -> Int getNewID state = (_ + 1) $ Foldable.foldl max 0 [ maxIDrr