From aa2e34e7cb334f9f7112582045388374b369ff2a Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Mon, 14 Jul 2025 18:44:53 +0200 Subject: [PATCH] Add proper delegation button. --- src/App/Templates/Modal.purs | 5 +-- src/App/Validation/Delegation.purs | 67 ++++++++---------------------- src/Web.purs | 2 +- src/Web/Button.purs | 8 ++++ 4 files changed, 28 insertions(+), 54 deletions(-) diff --git a/src/App/Templates/Modal.purs b/src/App/Templates/Modal.purs index 400b268..a8f7ae8 100644 --- a/src/App/Templates/Modal.purs +++ b/src/App/Templates/Modal.purs @@ -52,6 +52,7 @@ modal_rr_delete rr_id action_remove_rr action_cancel_modal = Web.modal "Deleting zip_nullable :: forall a. Array a -> Array String -> Array (Tuple a String) zip_nullable txt raw = A.zip txt ([""] <> raw) +type ActionValidate :: forall i. i -> i type ActionValidate i = i type ActionUpdateDelegationForm i = (Delegation.Field -> i) delegation_modal :: forall w i. @@ -74,11 +75,9 @@ delegation_modal selected_domain form action_update_form action_validate action_ ] modal_foot :: Array (HH.HTML w i) modal_foot = - [ Web.btn_add action_validate + [ Web.info_btn "Delegate the domain" action_validate , Web.cancel_button action_cancel_modal ] - side_text_for_name_input name_id - = Web.side_text_above_input name_id "Name" (HH.text $ "Empty name = root domain (" <> selected_domain <> ".)") type Domain = String type ActionUpdateForm i = (Field.Field -> i) diff --git a/src/App/Validation/Delegation.purs b/src/App/Validation/Delegation.purs index 0c5a39c..9a4cd14 100644 --- a/src/App/Validation/Delegation.purs +++ b/src/App/Validation/Delegation.purs @@ -1,66 +1,33 @@ -module App.Validation.DNS where +module App.Validation.Delegation where -import Prelude (apply, between, bind, map, pure, ($), (-), (<), (<>), (==)) +import Prelude (apply, map, pure, ($)) -import Control.Alt ((<|>)) -import Data.Array as A import Data.Either (Either(..)) -import Data.Maybe (Maybe(..), maybe, fromMaybe) -import Data.String.CodeUnits as CU -import Data.String as S import Data.Validation.Semigroup (V, invalid, toEither) -import App.Type.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier) -import App.Type.ResourceRecord (MechanismType(..), ModifierType(..)) as RR -import GenericParser.SomeParsers as SomeParsers import GenericParser.Parser as G import GenericParser.DomainParser.Common (DomainError) as DomainParser -import GenericParser.DomainParser (name, sub_eof) as DomainParser -import GenericParser.IPAddress as IPAddress -import GenericParser.RFC5234 as RFC5234 +import GenericParser.DomainParser (name) as DomainParser -import App.Type.DKIM as DKIM -import App.Type.DMARC as DMARC -import App.Type.CAA as CAA - -import Utils (id) +import App.Type.Delegation as Delegation data Error - = UNKNOWN - | VENameServer1 (G.Error DomainParser.DomainError) + = VENameServer1 (G.Error DomainParser.DomainError) | VENameServer2 (G.Error DomainParser.DomainError) -validationCNAME :: ResourceRecord -> V (Array Error) ResourceRecord -validationCNAME form = ado - name <- parse DomainParser.name form.name VEName - ttl <- is_between min_ttl max_ttl form.ttl VETTL - target <- parse DomainParser.sub_eof form.target VECNAME - in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME", name = name, ttl = ttl, target = target } +-- | `parse` enables to run any parser based on `GenericParser` and provide a validation error. +-- | The actual validation error contains the parser's error including the position. +parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Error) -> V (Array Error) v +parse (G.Parser p) str c = case p { string: str, position: 0 } of + Left x -> invalid $ [c x] + Right x -> pure x.result -is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> Error) -> V (Array Error) Int -is_between min max n ve = if between min max n - then pure n - else invalid [ve min max n] - -validationSRV :: ResourceRecord -> V (Array Error) ResourceRecord -validationSRV form = ado - name <- parse DomainParser.name form.name VEName - in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SRV" - , name = name, ttl = ttl, target = target - , priority = Just priority, port = Just port, protocol = form.protocol, weight = Just weight } - -validation_nameservers :: ResourceRecord -> V (Array Error) ResourceRecord +validation_nameservers :: Delegation.Form -> V (Array Error) Delegation.Form validation_nameservers form = ado - nameserver1 <- parse DomainParser.name form.name VEName - nameserver2 <- parse DomainParser.name form.name VEName - in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SPF" - , name = name, ttl = ttl, target = "" -- `target` is discarded! - , v = form.v, mechanisms = Just mechanisms - , modifiers = Just modifiers, q = form.q } + nameserver1 <- parse DomainParser.name form.nameserver1 VENameServer1 + nameserver2 <- parse DomainParser.name form.nameserver2 VENameServer2 + in { nameserver1, nameserver2 } -- | `validation` provides a way to validate the content of a RR. -validation :: ResourceRecord -> Either (Array Error) ResourceRecord -validation entry = toEither $ validation_nameservers entry - "DKIM" -> toEither $ validationDKIM entry - "DMARC" -> toEither $ validationDMARC entry - _ -> toEither $ invalid [UNKNOWN] +validation :: Delegation.Form -> Either (Array Error) Delegation.Form +validation entry = toEither $ validation_nameservers entry diff --git a/src/Web.purs b/src/Web.purs index 248d8c3..2739b35 100644 --- a/src/Web.purs +++ b/src/Web.purs @@ -24,7 +24,7 @@ module Web import Web.Basics import Web.Box (box, box_, box_with_tag) -import Web.Button (alert_btn, alert_btn_abbr, btn, btn_, btn_abbr, btn_abbr_, btn_add, btn_delete, btn_delete_ro, btn_modify, btn_modify_ro, btn_readonly, btn_ro, btn_save, btn_validation, btn_validation_, cancel_button, delete_btn) +import Web.Button (alert_btn, alert_btn_abbr, btn, btn_, btn_abbr, btn_abbr_, btn_add, btn_delete, btn_delete_ro, btn_modify, btn_modify_ro, btn_readonly, btn_ro, btn_save, btn_validation, btn_validation_, cancel_button, delete_btn, info_btn, info_btn_abbr) import Web.Checkbox (checkbox) import Web.Column (column, column_, columns, columns_) import Web.Data (data_target) diff --git a/src/Web/Button.purs b/src/Web/Button.purs index cf7761a..718e875 100644 --- a/src/Web/Button.purs +++ b/src/Web/Button.purs @@ -17,6 +17,8 @@ module Web.Button , btn_validation_ , cancel_button , delete_btn + , info_btn + , info_btn_abbr ) where import Prelude (($), (<>)) @@ -93,6 +95,12 @@ btn_ classes title action btn :: forall w action. String -> action -> HH.HTML w action btn title action = btn_ [] title action +info_btn :: forall w action. String -> action -> HH.HTML w action +info_btn title action = btn_ [C.is_info] title action + +info_btn_abbr :: forall w action. String -> String -> action -> HH.HTML w action +info_btn_abbr explanation_ title action = btn_abbr_ [C.is_info] [] explanation_ title action + alert_btn :: forall w action. String -> action -> HH.HTML w action alert_btn title action = btn_ [C.is_danger] title action