karchnu/halogen-websocket-ipc-playzone
1
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

Largely simplify the Bulma module.

Browse Source
This commit is contained in:
Philippe Pittoli 2024-02-07 04:00:15 +01:00
parent 32fe44e34c
commit 4f785e6dcc
5 changed files with 30 additions and 243 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

4
spago.dhall
View File

@ -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"

7
src/App/AuthenticationDaemonAdminInterface.purs
View File

@ -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;"

7
src/App/AuthenticationForm.purs
View File

@ -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;"

54
src/App/ZoneInterface.purs
View File

@ -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."

201
src/Bulma.purs
View File

@ -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