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

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

View file

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

View file

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