Add proper delegation button.

This commit is contained in:
Philippe Pittoli 2025-07-14 18:44:53 +02:00
parent 56cd013471
commit aa2e34e7cb
4 changed files with 28 additions and 54 deletions

View file

@ -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 :: forall a. Array a -> Array String -> Array (Tuple a String)
zip_nullable txt raw = A.zip txt ([""] <> raw) zip_nullable txt raw = A.zip txt ([""] <> raw)
type ActionValidate :: forall i. i -> i
type ActionValidate i = i type ActionValidate i = i
type ActionUpdateDelegationForm i = (Delegation.Field -> i) type ActionUpdateDelegationForm i = (Delegation.Field -> i)
delegation_modal :: forall w 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 :: Array (HH.HTML w i)
modal_foot = modal_foot =
[ Web.btn_add action_validate [ Web.info_btn "Delegate the domain" action_validate
, Web.cancel_button action_cancel_modal , 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 Domain = String
type ActionUpdateForm i = (Field.Field -> i) type ActionUpdateForm i = (Field.Field -> i)

View file

@ -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.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 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.Parser as G
import GenericParser.DomainParser.Common (DomainError) as DomainParser import GenericParser.DomainParser.Common (DomainError) as DomainParser
import GenericParser.DomainParser (name, sub_eof) as DomainParser import GenericParser.DomainParser (name) as DomainParser
import GenericParser.IPAddress as IPAddress
import GenericParser.RFC5234 as RFC5234
import App.Type.DKIM as DKIM import App.Type.Delegation as Delegation
import App.Type.DMARC as DMARC
import App.Type.CAA as CAA
import Utils (id)
data Error data Error
= UNKNOWN = VENameServer1 (G.Error DomainParser.DomainError)
| VENameServer1 (G.Error DomainParser.DomainError)
| VENameServer2 (G.Error DomainParser.DomainError) | VENameServer2 (G.Error DomainParser.DomainError)
validationCNAME :: ResourceRecord -> V (Array Error) ResourceRecord -- | `parse` enables to run any parser based on `GenericParser` and provide a validation error.
validationCNAME form = ado -- | The actual validation error contains the parser's error including the position.
name <- parse DomainParser.name form.name VEName parse :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Error) -> V (Array Error) v
ttl <- is_between min_ttl max_ttl form.ttl VETTL parse (G.Parser p) str c = case p { string: str, position: 0 } of
target <- parse DomainParser.sub_eof form.target VECNAME Left x -> invalid $ [c x]
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME", name = name, ttl = ttl, target = target } Right x -> pure x.result
is_between :: Int -> Int -> Int -> (Int -> Int -> Int -> Error) -> V (Array Error) Int validation_nameservers :: Delegation.Form -> V (Array Error) Delegation.Form
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 form = ado validation_nameservers form = ado
nameserver1 <- parse DomainParser.name form.name VEName nameserver1 <- parse DomainParser.name form.nameserver1 VENameServer1
nameserver2 <- parse DomainParser.name form.name VEName nameserver2 <- parse DomainParser.name form.nameserver2 VENameServer2
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SPF" in { nameserver1, nameserver2 }
, name = name, ttl = ttl, target = "" -- `target` is discarded!
, v = form.v, mechanisms = Just mechanisms
, modifiers = Just modifiers, q = form.q }
-- | `validation` provides a way to validate the content of a RR. -- | `validation` provides a way to validate the content of a RR.
validation :: ResourceRecord -> Either (Array Error) ResourceRecord validation :: Delegation.Form -> Either (Array Error) Delegation.Form
validation entry = toEither $ validation_nameservers entry validation entry = toEither $ validation_nameservers entry
"DKIM" -> toEither $ validationDKIM entry
"DMARC" -> toEither $ validationDMARC entry
_ -> toEither $ invalid [UNKNOWN]

View file

@ -24,7 +24,7 @@ module Web
import Web.Basics import Web.Basics
import Web.Box (box, box_, box_with_tag) 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.Checkbox (checkbox)
import Web.Column (column, column_, columns, columns_) import Web.Column (column, column_, columns, columns_)
import Web.Data (data_target) import Web.Data (data_target)

View file

@ -17,6 +17,8 @@ module Web.Button
, btn_validation_ , btn_validation_
, cancel_button , cancel_button
, delete_btn , delete_btn
, info_btn
, info_btn_abbr
) where ) where
import Prelude (($), (<>)) import Prelude (($), (<>))
@ -93,6 +95,12 @@ btn_ classes title action
btn :: forall w action. String -> action -> HH.HTML w action btn :: forall w action. String -> action -> HH.HTML w action
btn title action = btn_ [] title 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 :: forall w action. String -> action -> HH.HTML w action
alert_btn title action = btn_ [C.is_danger] title action alert_btn title action = btn_ [C.is_danger] title action