From e34352314256060ba7b1739e846bfc24778abcbe Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Mon, 5 Feb 2024 04:17:56 +0100 Subject: [PATCH] WIP: modals. CANNOT COMPILE ATM. --- src/App/ZoneInterface.purs | 283 +++++++++++++++++++------------------ 1 file changed, 149 insertions(+), 134 deletions(-) diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index 0a457bc..1369793 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -124,15 +124,16 @@ data Update_Local_Form -- | Steps to create a new RR: -- | 1. `CreateNewRRModal AcceptedRRTypes`: create a modal with default values based on selected accepted type. --- | 2. `ValidateRR AcceptedRRTypes`: validate the new RR stored in `_newRR`. +-- | 2. `UpdateCurrentRR Field`: modify the fields of the future new RR. +-- | 3. `ValidateRR AcceptedRRTypes`: validate the new RR stored in `_currentRR`. -- | In case it works, automatically call `AddRR` then `CancelModal`. --- | 3. `AddRR AcceptedRRTypes ResourceRecord`: send a message to `dnsmanagerd`. +-- | 4. `AddRR AcceptedRRTypes ResourceRecord`: send a message to `dnsmanagerd`. -- | -- | Steps to update an entry: -- | 1. `CreateUpdateRRModal RRId`: create a modal from the values of the RR in `_resources` to update. --- | 2. `UpdateCurrentRR RRId Field`: modify the currently displayed RR. +-- | 2. `UpdateCurrentRR Field`: modify the currently displayed RR. -- | 3. `ValidateLocal RRId AcceptedRRTypes`: validate the RR. --- | 4. `UpdateRR ResourceRecord`: save the _validated_ RR. +-- | 4. `SaveRR ResourceRecord`: save the _validated_ RR by sending a message to `dnsmanagerd`. -- | -- | TODO: -- | In both cases, once the add (or update) is performed, the resource should be added (updated) in `_resources`. @@ -163,18 +164,15 @@ data Action | ValidateLocal RRId AcceptedRRTypes -- | Save the changes done in an already existing resource record. - | UpdateRR ResourceRecord + | SaveRR ResourceRecord -- | Update new entry form (in the `rr_modal` modal). - | UpdateCurrentlyDisplayedRRForm Field + | UpdateCurrentRR Field - -- TODO: Update an already existing resource record (update _resources). - | UpdateCurrentRR RRId Field - - -- | Update an already active entry. + -- | TODO: OLD: Update an already active entry. | UpdateLocalRR RRId Update_Local_Form - -- TODO: Update an already existing resource record (update _resources). + -- TODO: OLD: Update an already existing resource record (update _resources). | SaveSRR RRId | SaveMXRR RRId | SaveSRVRR RRId @@ -185,13 +183,39 @@ data Action -- | +data RRModal + = NoModal + | NewRRModal AcceptedRRTypes + | UpdateRRModal + | RemoveRRModal RRId + +show_accepted_type :: AcceptedRRTypes -> String +show_accepted_type = case _ of + A -> "A" + AAAA -> "AAAA" + TXT -> "TXT" + CNAME -> "CNAME" + NS -> "NS" + MX -> "MX" + SRV -> "SRV" + +string_to_acceptedtype :: String -> Maybe AcceptedRRTypes +string_to_acceptedtype str = case str of + "A" -> Just A + "AAAA" -> Just AAAA + "TXT" -> Just TXT + "CNAME" -> Just CNAME + "NS" -> Just NS + "MX" -> Just MX + "SRV" -> Just SRV + _ -> Nothing + type State = { _domain :: RecordName , wsUp :: Boolean - , deletion_modal :: Maybe Int -- A modal to present a form for adding a new RR. - , rr_modal :: Maybe AcceptedRRTypes + , rr_modal :: RRModal -- TODO: get all the resources in a single entry. -- Better that way: simpler code. @@ -206,8 +230,8 @@ type State = , _errors :: Hash.HashMap RRId Validation.Errors -- Unique RR form. - , _newRR :: (SRVRR ()) -- SRVRR contains all relevant information for every RR. - , _newRR_errors :: Array Validation.ValidationError + , _currentRR :: (SRVRR ()) -- SRVRR contains all relevant information for every RR. + , _currentRR_errors :: Array Validation.ValidationError -- potential future entries , _newSRR :: (SimpleRR ()) @@ -238,8 +262,7 @@ default_domain = "netlib.re" initialState :: Input -> State initialState domain = { wsUp: true - , deletion_modal: Nothing - , rr_modal: Nothing + , rr_modal: NoModal , _domain: domain @@ -253,9 +276,9 @@ initialState domain = , _errors: Hash.empty -- This is the state for the new RR modal. - , _newRR: defaultResourceSRV + , _currentRR: defaultResourceSRV -- List of errors within the form in new RR modal. - , _newRR_errors: [] + , _currentRR_errors: [] , _newSRR: defaultResourceA , _newMXRR: defaultResourceMX @@ -270,20 +293,22 @@ type SortableRecord l = Record (rrtype :: String, rrid :: Int | l) render :: forall m. State -> H.ComponentHTML Action () m render state = Bulma.section_small - [ case state.wsUp, state.deletion_modal, state.rr_modal of - false, _, _ -> Bulma.p "You are disconnected." - true, Just rr_id, _ -> modal_rr_delete rr_id - true, Nothing, Just t -> modal_add_new_rr t - true, Nothing, Nothing -> HH.div_ [ Bulma.h1 state._domain - , Bulma.hr - , render_resources state._local_errors $ sorted state._resources - , Bulma.hr - , render_soa state._soa - , render_records state._errors $ sorted state._srr - , render_mx_records state._errors $ sorted state._mxrr - , render_srv_records state._errors $ sorted state._srvrr - , render_new_records state - ] + [ case state.wsUp, state.rr_modal of + false, _ -> Bulma.p "You are disconnected." + true, RemoveRRModal rr_id -> modal_rr_delete rr_id + true, NewRRModal t -> modal_add_new_rr t + true, UpdateRRModal -> modal_add_new_rr -- render_current_rr_modal rr_id + true, NoModal -> HH.div_ + [ Bulma.h1 state._domain + , Bulma.hr + , render_resources state._local_errors $ sorted state._resources + , Bulma.hr + , render_soa state._soa + , render_records state._errors $ sorted state._srr + , render_mx_records state._errors $ sorted state._mxrr + , render_srv_records state._errors $ sorted state._srvrr + , render_new_records state + ] ] where sorted :: forall l. Array (SortableRecord (l)) -> Array (SortableRecord (l)) @@ -311,38 +336,49 @@ render state , HH.text "." ] + -- TODO: this seems overly complicated. + -- Verification if the RR exists has been already done. + render_current_rr_modal :: forall w. RRId -> HH.HTML w Action + render_current_rr_modal rr_id = do + case first (\rr -> rr.rrid == rr_id) state._resources of + Nothing -> H.raise $ Log $ SimpleLog $ "RR not found (RR " <> show rr_id <> ")" + Just entry -> do + case string_to_acceptedtype entry.rrtype of + Nothing -> H.raise $ Log $ SimpleLog $ "RR " <> show rr_id <> ": cannot determine the type" + Just type_ -> modal_add_new_rr type_ + modal_add_new_rr :: forall w. AcceptedRRTypes -> HH.HTML w Action modal_add_new_rr t = 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) + A -> template (content_simple "A") (foot_content t) + AAAA -> template (content_simple "AAAA") (foot_content t) + TXT -> template (content_simple "TXT") (foot_content t) + CNAME -> template (content_simple "CNAME") (foot_content t) + NS -> template (content_simple "NS") (foot_content t) + MX -> template content_mx (foot_content t) + SRV -> template content_srv (foot_content t) where -- DRY - updateForm x = UpdateCurrentlyDisplayedRRForm <<< x - render_errors = if A.length state._newRR_errors > 0 - then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._newRR_errors + updateForm x = UpdateCurrentRR <<< x + render_errors = if A.length state._currentRR_errors > 0 + then HH.div_ $ [ Bulma.h3 "Errors: " ] <> map error_to_paragraph state._currentRR_errors else HH.div_ [ ] content_simple :: String -> Array (HH.HTML w Action) content_simple t_ = [ render_errors , Bulma.box_input ("domain" <> t_) "Name" "www" -- id, title, placeholder (updateForm Field_Domain) -- action - state._newRR.name -- value - state._newRR.valid -- validity (TODO) + state._currentRR.name -- value + state._currentRR.valid -- validity (TODO) should_be_disabled -- condition , Bulma.box_input ("ttl" <> t_) "TTL" "600" (updateForm Field_TTL) - state._newRR.ttl - state._newRR.valid + state._currentRR.ttl + state._currentRR.valid should_be_disabled , Bulma.box_input ("target" <> t_) "Target" "198.51.100.5" (updateForm Field_Target) - state._newRR.target - state._newRR.valid + state._currentRR.target + state._currentRR.valid should_be_disabled ] content_mx :: Array (HH.HTML w Action) @@ -350,23 +386,23 @@ render state [ render_errors , Bulma.box_input ("domainMX") "Name" "mail" -- id, title, placeholder (updateForm Field_Domain) -- action - state._newRR.name -- value - state._newRR.valid -- validity (TODO) + state._currentRR.name -- value + state._currentRR.valid -- validity (TODO) should_be_disabled -- condition , Bulma.box_input ("ttlMX") "TTL" "600" (updateForm Field_TTL) - state._newRR.ttl - state._newRR.valid + state._currentRR.ttl + state._currentRR.valid should_be_disabled , Bulma.box_input ("targetMX") "Target" "www" (updateForm Field_Target) - state._newRR.target - state._newRR.valid + state._currentRR.target + state._currentRR.valid should_be_disabled , Bulma.box_input ("priorityMX") "Priority" "10" (updateForm Field_Priority) - state._newRR.priority - state._newRR.valid + state._currentRR.priority + state._currentRR.valid should_be_disabled ] content_srv :: Array (HH.HTML w Action) @@ -374,48 +410,52 @@ render state [ render_errors , Bulma.box_input ("domainSRV") "Name" "_sip._tcp" -- id, title, placeholder (updateForm Field_Domain) -- action - state._newRR.name -- value - state._newRR.valid -- validity (TODO) + state._currentRR.name -- value + state._currentRR.valid -- validity (TODO) should_be_disabled -- condition , Bulma.box_input ("ttlSRV") "TTL" "600" (updateForm Field_TTL) - state._newRR.ttl - state._newRR.valid + state._currentRR.ttl + state._currentRR.valid should_be_disabled , Bulma.box_input ("targetSRV") "Target" "www" (updateForm Field_Target) - state._newRR.target - state._newRR.valid + state._currentRR.target + state._currentRR.valid should_be_disabled , Bulma.box_input ("prioritySRV") "Priority" "10" (updateForm Field_Priority) - state._newRR.priority - state._newRR.valid + state._currentRR.priority + state._currentRR.valid should_be_disabled , Bulma.box_input ("portSRV") "Port" "5061" (updateForm Field_Port) - state._newRR.port - state._newRR.valid + state._currentRR.port + state._currentRR.valid should_be_disabled , Bulma.box_input ("weightSRV") "Weight" "100" (updateForm Field_Weight) - state._newRR.weight - state._newRR.valid + state._currentRR.weight + state._currentRR.valid should_be_disabled , Bulma.box_input ("protocolSRV") "Protocol" "tcp" (updateForm Field_Protocol) - state._newRR.protocol - state._newRR.valid + state._currentRR.protocol + state._currentRR.valid should_be_disabled ] should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true)) foot_content x = [ Bulma.btn_add (ValidateRR x) - (TellSomethingWentWrong state._newRR.rrid "cannot add") - state._newRR.valid ] - template t_ content foot = Bulma.modal + (TellSomethingWentWrong state._currentRR.rrid "cannot add") + state._currentRR.valid ] + template content foot = Bulma.modal [ Bulma.modal_background - , Bulma.modal_card [Bulma.modal_header $ "New " <> t_ <> " resource record" + , Bulma.modal_card [Bulma.modal_header $ case state.rr_modal of + NoModal -> "Error: no modal should be displayed" + NewRRModal t_ -> "New " <> show_accepted_type t_ <> " resource record" + UpdateRRModal -> "Update RR " <> show state._currentRR.rrid <> " resource record" + RemoveRRModal rr_id -> "Error: should display removal modal instead (for RR " <> show rr_id <> ")" , Bulma.modal_body content ] , Bulma.modal_foot (foot <> [Bulma.modal_cancel_button CancelModal]) ] @@ -425,19 +465,19 @@ handleAction = case _ of -- | Cancel the current modal being presented. -- | Works for both "new RR", "update RR" and "remove RR" modals. CancelModal -> do - H.modify_ _ { deletion_modal = Nothing, rr_modal = Nothing } - H.modify_ _ { _newRR_errors = [] } + H.modify_ _ { rr_modal = NoModal } + H.modify_ _ { _currentRR_errors = [] } -- | Create the RR modal. DeleteRRModal rr_id -> do - H.modify_ _ { deletion_modal = Just rr_id } + H.modify_ _ { rr_modal = RemoveRRModal rr_id } -- | Create modal (a form) for a resource record to update. CreateUpdateRRModal rr_id -> do state <- H.get case first (\rr -> rr.rrid == rr_id) state._resources of Nothing -> H.raise $ Log $ SimpleLog $ "RR not found (RR " <> show rr_id <> ")" - Just rr -> H.modify_ _ { _newRR = rr } + Just rr -> H.modify_ _ { _currentRR = rr } -- | Each time a "new RR" button is clicked, the form resets. CreateNewRRModal t -> do @@ -472,13 +512,13 @@ handleAction = case _ of , target: "www" , port: "5061", weight: "100", priority: "10", protocol: "tcp"} case t of - A -> H.modify_ _ { _newRR = defaultA } - AAAA -> H.modify_ _ { _newRR = defaultAAAA } - TXT -> H.modify_ _ { _newRR = defaultTXT } - CNAME -> H.modify_ _ { _newRR = defaultCNAME } - NS -> H.modify_ _ { _newRR = defaultNS } - MX -> H.modify_ _ { _newRR = defaultMX } - SRV -> H.modify_ _ { _newRR = defaultSRV } + A -> H.modify_ _ { _currentRR = defaultA } + AAAA -> H.modify_ _ { _currentRR = defaultAAAA } + TXT -> H.modify_ _ { _currentRR = defaultTXT } + CNAME -> H.modify_ _ { _currentRR = defaultCNAME } + NS -> H.modify_ _ { _currentRR = defaultNS } + MX -> H.modify_ _ { _currentRR = defaultMX } + SRV -> H.modify_ _ { _currentRR = defaultSRV } -- | Initialize the ZoneInterface component: ask for the domain zone to `dnsmanagerd`. Initialize -> do @@ -487,49 +527,17 @@ handleAction = case _ of message <- H.liftEffect $ DNSManager.serialize $ DNSManager.MkGetZone { domain: _domain } H.raise $ MessageToSend message - -- Update for the new RR form in the new RR modal. - UpdateCurrentlyDisplayedRRForm rr_update -> case rr_update of - Field_Domain val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry name: " <> val) - state <- H.get - H.modify_ _ { _newRR = state._newRR { name = val } } - Field_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 - Field_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}} - Field_Priority val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry priority: " <> val) - state <- H.get - H.modify_ _ { _newRR = state._newRR { priority = val } } - Field_Protocol val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry protocol: " <> val) - state <- H.get - H.modify_ _ { _newRR = state._newRR { protocol = val } } - Field_Weight val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry weight: " <> val) - state <- H.get - H.modify_ _ { _newRR = state._newRR { weight = val } } - Field_Port val -> do - -- H.raise $ Log $ SimpleLog ("Update new SRV entry port: " <> val) - state <- H.get - H.modify_ _ { _newRR = state._newRR { port = val } } - -- | Perform validation. In case the record is valid, it is added to the zone then the modal is closed. -- | Else, the different errors are added to the state. ValidateRR t -> do state <- H.get - case Validation.validation state._newRR t of + case Validation.validation state._currentRR t of Left actual_errors -> do -- H.raise $ Log $ SimpleLog $ "Cannot add this " <> show t <> " RR, some errors occured in the record:" -- loopE (\v -> H.raise $ Log $ SimpleLog $ "==> " <> show_error v) actual_errors - H.modify_ _ { _newRR_errors = actual_errors } + H.modify_ _ { _currentRR_errors = actual_errors } Right newrr -> do - H.modify_ _ { _newRR_errors = [] } + H.modify_ _ { _currentRR_errors = [] } handleAction $ AddRR t newrr handleAction CancelModal @@ -543,17 +551,24 @@ handleAction = case _ of $ DNSManager.MkAddRR { domain: state._domain, rr: newrr } H.raise $ MessageToSend message - UpdateCurrentRR rr_id field -> do + -- | Update the currently displayed RR form (new or update RR). + UpdateCurrentRR field -> do state <- H.get - H.raise $ Log $ SimpleLog $ "Let's try to update entry number " <> show rr_id - let replaceRR rr1 rr2 | rr1.rrid == rr2.rrid = rr1 - | otherwise = rr2 - maybeentry = first (\rr -> rr.rrid == rr_id) state._resources - case maybeentry of - Nothing -> H.raise $ Log $ SimpleLog ("Local Update Failed (RR " <> show rr_id <> ")") - Just entry -> do - let new_entry = update_field entry field - H.modify_ _ { _resources = (map (replaceRR entry) state._resources) } + let newRR = update_field state._currentRR field + H.modify_ _ { _currentRR = newRR } + +-- TODO: this code can be used to replace the old RR with the updated one, once received by `dnsmanagerd`. +-- Update_Current_RR rr_id field -> do +-- state <- H.get +-- H.raise $ Log $ SimpleLog $ "Let's try to update entry number " <> show rr_id +-- let replaceRR rr1 rr2 | rr1.rrid == rr2.rrid = rr1 +-- | otherwise = rr2 +-- maybeentry = first (\rr -> rr.rrid == rr_id) state._resources +-- case maybeentry of +-- Nothing -> H.raise $ Log $ SimpleLog ("Local Update Failed (RR " <> show rr_id <> ")") +-- Just entry -> do +-- let new_entry = update_field entry field +-- H.modify_ _ { _resources = (map (replaceRR entry) state._resources) } UpdateLocalRR rr_id form -> case form of Update_Local_Form_SRR rr_update -> case rr_update of @@ -637,9 +652,9 @@ handleAction = case _ of Right rr -> do let new_error_hash = Hash.delete local_rr.rrid state._local_errors H.modify_ _ { _local_errors = new_error_hash } - handleAction $ UpdateRR rr + handleAction $ SaveRR rr - UpdateRR rr -> do + SaveRR rr -> do state <- H.get H.raise $ Log $ SimpleLog $ "Updating RR " <> show rr.rrid message <- H.liftEffect @@ -671,7 +686,7 @@ handleAction = case _ of $ DNSManager.MkDeleteRR { domain: _domain, rrid: rr_id } H.raise $ MessageToSend message -- Modal doesn't need to be active anymore. - H.modify_ _ { deletion_modal = Nothing } + handleAction CancelModal -- TODO: change the state to indicate problems? TellSomethingWentWrong rr_id val -> do