From 4f785e6dcc84d5068c3d256b9297d87db869882d Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Wed, 7 Feb 2024 04:00:15 +0100 Subject: [PATCH] Largely simplify the Bulma module. --- spago.dhall | 4 +- .../AuthenticationDaemonAdminInterface.purs | 7 +- src/App/AuthenticationForm.purs | 7 - src/App/ZoneInterface.purs | 54 +---- src/Bulma.purs | 201 ++---------------- 5 files changed, 30 insertions(+), 243 deletions(-) diff --git a/spago.dhall b/spago.dhall index dc05645..4a31ca1 100644 --- a/spago.dhall +++ b/spago.dhall @@ -1,4 +1,4 @@ -{ name = "halogen-project" +{ name = "dnsmanager-interface" , dependencies = [ "aff" , "argonaut-core" @@ -32,8 +32,6 @@ , "transformers" , "tuples" , "uint" - , "unordered-collections" - , "uri" , "validation" , "web-encoding" , "web-events" diff --git a/src/App/AuthenticationDaemonAdminInterface.purs b/src/App/AuthenticationDaemonAdminInterface.purs index 5d2b9fb..88d0d27 100644 --- a/src/App/AuthenticationDaemonAdminInterface.purs +++ b/src/App/AuthenticationDaemonAdminInterface.purs @@ -101,22 +101,17 @@ render { addUserForm, wsUp } [ Bulma.box_input "login" "User login" "login" -- title, placeholder (HandleAddUserInput <<< ADDUSER_INP_login) -- action addUserForm.login -- value - true -- validity (TODO) should_be_disabled -- condition , Bulma.btn (show addUserForm.admin) -- value - (HandleAddUserInput ADDUSER_toggle_admin) -- action1 - (HandleAddUserInput ADDUSER_toggle_admin) -- action2 - true -- validity + (HandleAddUserInput ADDUSER_toggle_admin) -- action , Bulma.box_input "email" "User email" "email" -- title, placeholder (HandleAddUserInput <<< ADDUSER_INP_email) -- action addUserForm.email -- value - true -- validity (TODO) should_be_disabled -- condition , Bulma.box_password "password" "User password" "password" -- title, placeholder (HandleAddUserInput <<< ADDUSER_INP_pass) -- action addUserForm.pass -- value - true -- validity (TODO) should_be_disabled -- condition , HH.button [ HP.style "padding: 0.5rem 1.25rem;" diff --git a/src/App/AuthenticationForm.purs b/src/App/AuthenticationForm.purs index 6d6b305..9e6b191 100644 --- a/src/App/AuthenticationForm.purs +++ b/src/App/AuthenticationForm.purs @@ -118,12 +118,10 @@ render { wsUp, authenticationForm, registrationForm, passwordRecoveryForm} [ Bulma.box_input "loginLOGIN" "Login" "login" -- title, placeholder (HandleAuthenticationInput <<< AUTH_INP_login) -- action authenticationForm.login -- value - true -- validity (TODO) should_be_disabled -- condition , Bulma.box_password "passwordLOGIN" "Password" "password" -- title, placeholder (HandleAuthenticationInput <<< AUTH_INP_pass) -- action authenticationForm.pass -- value - true -- validity (TODO) should_be_disabled -- condition , HH.button [ HP.style "padding: 0.5rem 1.25rem;" @@ -138,17 +136,14 @@ render { wsUp, authenticationForm, registrationForm, passwordRecoveryForm} [ Bulma.box_input "loginREGISTER" "Login" "login" -- title, placeholder (HandleRegisterInput <<< REG_INP_login) -- action registrationForm.login -- value - true -- validity (TODO) should_be_disabled -- condition , Bulma.box_input "emailREGISTER" "Email" "email@example.com" -- title, placeholder (HandleRegisterInput <<< REG_INP_email) -- action registrationForm.email -- value - true -- validity (TODO) should_be_disabled -- condition , Bulma.box_password "passwordREGISTER" "Password" "password" -- title, placeholder (HandleRegisterInput <<< REG_INP_pass) -- action registrationForm.pass -- value - true -- validity (TODO) should_be_disabled -- condition , HH.div_ [ HH.button @@ -165,12 +160,10 @@ render { wsUp, authenticationForm, registrationForm, passwordRecoveryForm} [ Bulma.box_input "loginPASSR" "Login" "login" -- title, placeholder (HandlePasswordRecovery <<< PASSR_INP_login) -- action passwordRecoveryForm.login -- value - true -- validity (TODO) should_be_disabled -- condition , Bulma.box_input "emailPASSR" "Email" "email" -- title, placeholder (HandlePasswordRecovery <<< PASSR_INP_email) -- action passwordRecoveryForm.email -- value - true -- validity (TODO) should_be_disabled -- condition , HH.button [ HP.style "padding: 0.5rem 1.25rem;" diff --git a/src/App/ZoneInterface.purs b/src/App/ZoneInterface.purs index f767d31..99789ff 100644 --- a/src/App/ZoneInterface.purs +++ b/src/App/ZoneInterface.purs @@ -1,23 +1,19 @@ -- | `App.ZoneInterface` provides an interface to display and modify a DNS zone. -- | -- | This interface allows to: --- | - display all resource records of a zone --- | - * DONE: SOA, NS, A, AAAA, CNAME, TXT, MX, SRV --- | - DONE: add new resource records --- | - DONE: modify resource records --- | - DONE: remove resource records --- | - DONE: ask for confirmation on deletion +-- | - display all resource records of a zone (SOA, NS, A, AAAA, CNAME, TXT, MX, SRV) +-- | - add, modify, remove resource records -- | --- | WIP: adding a new record should be through a modal presenting a specific form for each RR. --- | This allows to present relevant information, such as use cases. --- | Also, errors could be shown and further explained with more available screen space. +-- | **WIP**: Display relevant information for each record type in the (add/mod) modal. +-- | This includes explaining use cases and displaying an appropriate interface for the +-- | task at hand. For example, having a dedicated interface for DKIM. +-- | +-- | TODO: display errors not only for a record but for the whole zone. +-- | A DNS zone is bound by a set of rules, the whole zone must be consistent. +-- | For example, a CNAME `target` has to point to the `name` of an existing record. -- | -- | TODO: do not allow for the modification of read-only resource records. -- | --- | TODO: new RR modal: don't allow to click on the "add" button before the entry is validated. --- | --- | TODO: existing RR: don't allow to click on the "save" button before the entry is validated. --- | -- | TODO: move all serialization code to a single module. module App.ZoneInterface where @@ -26,7 +22,6 @@ import Prelude (Unit, unit, void , comparing, discard, map, show , ($), (/=), (<<<), (<>), (==), (>)) ---import Data.HashMap as Hash import Data.Array as A import Data.Int (fromString) import Data.ArrayBuffer.Types (ArrayBuffer) @@ -104,9 +99,6 @@ data Field -- | 2. `UpdateCurrentRR Field`: modify the currently displayed RR. -- | 3. `ValidateLocal RRId AcceptedRRTypes`: validate the 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`. data Action -- | Initiate the component. This means asking the content of the zone to `dnsmanagerd`. @@ -144,8 +136,6 @@ data Action -- | Automatically closes the modal. | RemoveRR RRId - | TellSomethingWentWrong RRId String - data RRModal = NoModal | NewRRModal AcceptedRRTypes @@ -316,17 +306,14 @@ render state , Bulma.box_input ("domain" <> state._currentRR.rrtype) "Name" "www" -- id, title, placeholder (updateForm Field_Domain) -- action state._currentRR.name -- value - true -- state._currentRR.valid -- validity (TODO) should_be_disabled -- condition , Bulma.box_input ("ttl" <> state._currentRR.rrtype) "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl) - true -- state._currentRR.valid should_be_disabled , Bulma.box_input ("target" <> state._currentRR.rrtype) "Target" "198.51.100.5" (updateForm Field_Target) state._currentRR.target - true -- state._currentRR.valid should_be_disabled ] content_mx :: Array (HH.HTML w Action) @@ -335,22 +322,18 @@ render state , Bulma.box_input ("domainMX") "Name" "mail" -- id, title, placeholder (updateForm Field_Domain) -- action state._currentRR.name -- value - true -- state._currentRR.valid -- validity (TODO) should_be_disabled -- condition , Bulma.box_input ("ttlMX") "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl) - true -- state._currentRR.valid should_be_disabled , Bulma.box_input ("targetMX") "Target" "www" (updateForm Field_Target) state._currentRR.target - true -- state._currentRR.valid should_be_disabled , Bulma.box_input ("priorityMX") "Priority" "10" (updateForm Field_Priority) (maybe "" show state._currentRR.priority) - true -- state._currentRR.valid should_be_disabled ] content_srv :: Array (HH.HTML w Action) @@ -359,43 +342,36 @@ render state , Bulma.box_input ("domainSRV") "Name" "_sip._tcp" -- id, title, placeholder (updateForm Field_Domain) -- action state._currentRR.name -- value - true -- state._currentRR.valid -- validity (TODO) should_be_disabled -- condition , Bulma.box_input ("ttlSRV") "TTL" "600" (updateForm Field_TTL) (show state._currentRR.ttl) - true -- state._currentRR.valid should_be_disabled , Bulma.box_input ("targetSRV") "Target" "www" (updateForm Field_Target) state._currentRR.target - true -- state._currentRR.valid should_be_disabled , Bulma.box_input ("prioritySRV") "Priority" "10" (updateForm Field_Priority) (maybe "" show state._currentRR.priority) - true -- state._currentRR.valid should_be_disabled , Bulma.box_input ("portSRV") "Port" "5061" (updateForm Field_Port) (maybe "" show state._currentRR.port) - true -- state._currentRR.valid should_be_disabled , Bulma.box_input ("weightSRV") "Weight" "100" (updateForm Field_Weight) (maybe "" show state._currentRR.weight) - true -- state._currentRR.valid should_be_disabled , Bulma.box_input ("protocolSRV") "Protocol" "tcp" (updateForm Field_Protocol) (fromMaybe "tcp" state._currentRR.protocol) - true -- state._currentRR.valid should_be_disabled ] should_be_disabled = (if true then (HP.enabled true) else (HP.disabled true)) foot_content x = [ case state.rr_modal of - NewRRModal _ -> Bulma.btn_add (ValidateRR x) (TellSomethingWentWrong state._currentRR.rrid "cannot add") true -- state._currentRR.valid + NewRRModal _ -> Bulma.btn_add (ValidateRR x) true -- state._currentRR.valid UpdateRRModal -> Bulma.btn_save ValidateLocal _ -> Bulma.p "state.rr_modal should either be NewRRModal or UpdateRRModal." ] @@ -638,14 +614,6 @@ handleAction = case _ of -- Modal doesn't need to be active anymore. handleAction CancelModal - -- TODO: change the state to indicate problems? - TellSomethingWentWrong rr_id val -> do - H.raise $ Log $ SimpleLog ("Sorry, your record " <> show rr_id <> " has problems: ") - -- H.raise $ Log $ SimpleLog (show rr) - H.raise $ Log $ SimpleLog (" => " <> val) - -type AtLeastRRID r = { rrid :: Int | r } - handleQuery :: forall a m. MonadAff m => Query a -> H.HalogenM State Action () Output m (Maybe a) handleQuery = case _ of @@ -848,8 +816,6 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v) <> ", current value: " <> show n <> "." Validation.VEWeight min max n -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max <> ", current value: " <> show n <> "." --- Nothing -> "no error reported" --- Just e -> "error reported, will soon appear!" ) where default_error = Bulma.p "No actual error reported." diff --git a/src/Bulma.purs b/src/Bulma.purs index c2c9c3e..5d64869 100644 --- a/src/Bulma.purs +++ b/src/Bulma.purs @@ -51,9 +51,8 @@ hdiv = HH.div [ HP.classes [HH.ClassName "mt-5"] ] --offcolumn offset size -- = column [ HH.ClassName ("is-offset-" <> (show offset) <> " is-" <> (show size)) ] -input_classes :: Boolean -> Array HH.ClassName -input_classes true = C.input <> C.is_small <> C.is_info -input_classes false = C.input <> C.is_small <> C.is_danger +input_classes :: Array HH.ClassName +input_classes = C.input <> C.is_small <> C.is_info table :: forall w i. HH.Node DHI.HTMLtable w i table prop xs = HH.table ([ HP.classes $ C.table ] <> prop) xs @@ -99,109 +98,6 @@ txt_name t rr_name_style = HP.style "width: 80px;" rr_name_text = HH.text t -input_email :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -input_email action "" validity - = HH.input [ HE.onValueInput action - , HP.placeholder "email" - , HP.classes $ input_classes validity - ] -input_email action email validity - = HH.input - [ HE.onValueInput action - , HP.value email - , HP.placeholder "email" - , HP.classes $ input_classes validity - ] - -box_input_email :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -box_input_email action email validity = HH.label [ ] - [ HH.label [HP.classes C.label ] [ HH.text "Email" ] - , HH.div [HP.classes C.control ] [ input_email action email validity ] - ] - -input_password :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -input_password action "" validity - = HH.input [ HE.onValueInput action - , HP.placeholder "password" - , HP.classes $ input_classes validity - ] -input_password action password validity - = HH.input - [ HE.onValueInput action - , HP.value password - , HP.placeholder "password" - , HP.classes $ input_classes validity - ] - -box_input_password :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -box_input_password action password validity = HH.label [ ] - [ HH.label [HP.classes C.label ] [ HH.text "Password" ] - , HH.div [HP.classes C.control ] [ input_password action password validity ] - ] - -input_domain :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -input_domain action domain validity - = HH.input - [ HE.onValueInput action - , HP.value domain - , HP.placeholder "domain" - , HP.classes $ input_classes validity - ] - -box_input_domain :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -box_input_domain action domain validity = HH.label [ ] - [ HH.label [HP.classes C.label ] [ HH.text "Domain" ] - , HH.div [HP.classes C.control ] [ input_domain action domain validity ] - ] - -input_ttl :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -input_ttl action ttl validity - = HH.input - [ HE.onValueInput action - , HP.value ttl - , MissingProperties.size 6 - , HP.placeholder "ttl" - , HP.classes $ input_classes validity - ] - -box_input_ttl :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -box_input_ttl action value validity = HH.label [ ] - [ HH.label [HP.classes C.label ] [ HH.text "TTL" ] - , HH.div [HP.classes C.control ] [ input_ttl action value validity ] - ] - -input_priority :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -input_priority action priority validity - = HH.input - [ HE.onValueInput action - , HP.value priority - , MissingProperties.size 6 - , HP.placeholder "priority" - , HP.classes $ input_classes validity - ] - -box_input_priority :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -box_input_priority action value validity = HH.label [ ] - [ HH.label [HP.classes C.label ] [ HH.text "Priority" ] - , HH.div [HP.classes C.control ] [ input_priority action value validity ] - ] - -input_protocol :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -input_protocol action protocol validity - = HH.input - [ HE.onValueInput action - , HP.value protocol - , MissingProperties.size 6 - , HP.placeholder "_tcp" - , HP.classes $ input_classes validity - ] - -box_input_protocol :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -box_input_protocol action value validity = HH.label [ ] - [ HH.label [HP.classes C.label ] [ HH.text "Protocol" ] - , HH.div [HP.classes C.control ] [ input_protocol action value validity ] - ] - -- | For textareas I don't use Bulma's "textarea" class since it doesn't allow to expand -- | textareas horizontaly, which makes edition of TXT records painful. textarea_classes :: Boolean -> Array HH.ClassName @@ -217,55 +113,6 @@ textarea action value validity , HP.classes $ textarea_classes validity ] -input_target :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -input_target action value validity - = HH.input - [ HE.onValueInput action - , HP.value value - , HP.placeholder "target" - , HP.classes $ input_classes validity - ] - -box_input_target :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -box_input_target action value validity = HH.label [ ] - [ HH.label [HP.classes C.label ] [ HH.text "Target" ] - , HH.div [HP.classes C.control ] [ input_target action value validity ] - ] - - -input_weight :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -input_weight action weight validity - = HH.input - [ HE.onValueInput action - , HP.value weight - , MissingProperties.size 6 - , HP.placeholder "weight" - , HP.classes $ input_classes validity - ] - -box_input_weight :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -box_input_weight action weight validity = HH.label [ ] - [ HH.label [HP.classes C.label ] [ HH.text "Weight" ] - , HH.div [HP.classes C.control ] [ input_weight action weight validity ] - ] - - -input_port :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -input_port action port validity - = HH.input - [ HE.onValueInput action - , HP.value port - , MissingProperties.size 6 - , HP.placeholder "port" - , HP.classes $ input_classes validity - ] - -box_input_port :: forall w i. (String -> i) -> String -> Boolean -> HH.HTML w i -box_input_port action port validity = HH.label [ ] - [ HH.label [HP.classes C.label ] [ HH.text "Port" ] - , HH.div [HP.classes C.control ] [ input_port action port validity ] - ] - btn_modify :: forall w i. i -> HH.HTML w i btn_modify action = HH.button @@ -280,18 +127,6 @@ btn_save action , HP.classes $ btn_classes true ] [ HH.text "save" ] -btn_change :: forall w i. i -> i -> Boolean -> Boolean -> HH.HTML w i -btn_change action1 action2 modified validity - = HH.button - [ HP.disabled (not modified) - , btn_change_action validity - , HP.classes $ btn_classes validity - ] [ HH.text "save" ] - where - btn_change_action = case _ of - true -> HE.onClick \_ -> action1 - _ -> HE.onClick \_ -> action2 - btn_delete :: forall w i. (MouseEvent -> i) -> HH.HTML w i btn_delete action = HH.button @@ -299,10 +134,10 @@ btn_delete action , HP.classes [ HH.ClassName "button is-small is-danger" ] ] [ HH.text "remove" ] -btn_add :: forall w i. i -> i -> Boolean -> HH.HTML w i -btn_add action1 action2 validity +btn_add :: forall w i. i -> Boolean -> HH.HTML w i +btn_add action validity = HH.button - [ if validity then (HE.onClick \_ -> action1) else (HE.onClick \_ -> action2) + [ HE.onClick \_ -> action , HP.classes $ btn_classes validity ] [ HH.text "Add" ] @@ -322,21 +157,21 @@ btn_add_new_rr action title , HP.classes $ C.button <> C.is_small <> C.is_info ] [ HH.text title ] -btn :: forall w action. String -> action -> action -> Boolean -> HH.HTML w action -btn title action1 action2 validity +btn :: forall w action. String -> action -> HH.HTML w action +btn title action = HH.button - [ if validity then (HE.onClick \_ -> action1) else (HE.onClick \_ -> action2) - , HP.classes $ btn_classes validity + [ HE.onClick \_ -> action + , HP.classes $ btn_classes true ] [ HH.text title ] render_input :: forall w i. - Boolean -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i -render_input password id placeholder action value validity cond + Boolean -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i +render_input password id placeholder action value cond = HH.input $ [ HE.onValueInput action , HP.value value , HP.placeholder placeholder - , HP.classes $ input_classes validity + , HP.classes $ input_classes , HP.id id , cond ] <> case password of @@ -344,11 +179,11 @@ render_input password id placeholder action value validity cond true -> [ HP.type_ HP.InputPassword ] field_inner :: forall w i. - Boolean -> String -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i -field_inner ispassword id title placeholder action value validity cond + Boolean -> String -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i +field_inner ispassword id title placeholder action value cond = div_field [ div_field_label - , div_field_content $ render_input ispassword id placeholder action value validity cond + , div_field_content $ render_input ispassword id placeholder action value cond ] where div_field = HH.div [ HP.classes (C.field <> C.is_horizontal) ] @@ -363,11 +198,11 @@ field_inner ispassword id title placeholder action value validity cond ] box_input :: forall w i. - String -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i -box_input = field_inner false + String -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i +box_input = field_inner false box_password :: forall w i. - String -> String -> String -> (String -> i) -> String -> Boolean -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i + String -> String -> String -> (String -> i) -> String -> (HP.IProp DHI.HTMLinput i) -> HH.HTML w i box_password = field_inner true section_small :: forall w i. Array (HH.HTML w i) -> HH.HTML w i