Delegation: validation for name server addresses.

This commit is contained in:
Philippe Pittoli 2025-07-15 00:50:53 +02:00
parent aa2e34e7cb
commit d6249f363c
5 changed files with 53 additions and 15 deletions

View file

@ -11,11 +11,19 @@ import App.Validation.DNS as ValidationDNS
import App.Validation.Login as L import App.Validation.Login as L
import App.Validation.Email as E import App.Validation.Email as E
import App.Validation.Password as P import App.Validation.Password as P
import App.Type.Delegation as Delegation
import App.Validation.Label as ValidationLabel import App.Validation.Label as ValidationLabel
import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser
import GenericParser.IPAddress as IPAddress import GenericParser.IPAddress as IPAddress
import Web as Web import Web as Web
delegation_error_to_paragraph :: forall w i. Delegation.Error -> HH.HTML w i
delegation_error_to_paragraph v = Web.error_message (Web.p $ show_delegation_error_title v)
(case v of
Delegation.VENameServer1 err -> maybe default_error show_error_domain err.error
Delegation.VENameServer2 err -> maybe default_error show_error_domain err.error
)
where default_error = Web.p ""
error_to_paragraph :: forall w i. ValidationDNS.Error -> HH.HTML w i error_to_paragraph :: forall w i. ValidationDNS.Error -> HH.HTML w i
error_to_paragraph v = Web.error_message (Web.p $ show_error_title v) error_to_paragraph v = Web.error_message (Web.p $ show_error_title v)
@ -65,6 +73,13 @@ show_error_key_sizes min max
else Web.p $ "Chosen signature algorithm only accepts public key input between " else Web.p $ "Chosen signature algorithm only accepts public key input between "
<> show min <> " and " <> show max <> " characters." <> show min <> " and " <> show max <> " characters."
-- | `show_delegation_error_title` provide a simple title string to display to the user
-- | in case of an error with an entry in the delegation form.
show_delegation_error_title :: Delegation.Error -> String
show_delegation_error_title v = case v of
Delegation.VENameServer1 _ -> "Invalid domain for name server 1"
Delegation.VENameServer2 _ -> "Invalid domain for name server 2"
-- | `show_error_title` provide a simple title string to display to the user in case of an error with an entry. -- | `show_error_title` provide a simple title string to display to the user in case of an error with an entry.
show_error_title :: ValidationDNS.Error -> String show_error_title :: ValidationDNS.Error -> String
show_error_title v = case v of show_error_title v = case v of

View file

@ -442,7 +442,15 @@ handleAction = case _ of
-- | Validate the delegation of the domain. -- | Validate the delegation of the domain.
ValidateDelegation -> do ValidateDelegation -> do
H.raise $ Log $ SystemLog "Validate the delegation" H.raise $ Log $ SystemLog "Validate the delegation"
handleAction $ SaveDelegation
state <- H.get
case ValidationDelegation.validation state._delegation_form of
Left delegation_errors -> do
H.modify_ _ { _delegation_form { errors = delegation_errors } }
Right _ -> do
H.modify_ _ { _delegation_form { errors = [] } }
handleAction $ SaveDelegation
-- | Save the delegation of the domain. -- | Save the delegation of the domain.
SaveDelegation -> do SaveDelegation -> do

View file

@ -34,7 +34,7 @@ import App.Type.AcceptedRRTypes (AcceptedRRTypes(..))
import App.Type.ResourceRecord (mechanism_types, modifier_types, qualifier_types, show_qualifier) import App.Type.ResourceRecord (mechanism_types, modifier_types, qualifier_types, show_qualifier)
import App.Type.ResourceRecord as RR import App.Type.ResourceRecord as RR
import App.DisplayErrors (error_to_paragraph, show_error_email) import App.DisplayErrors (error_to_paragraph, delegation_error_to_paragraph, show_error_email)
type ActionCancelModal :: forall k. k -> k type ActionCancelModal :: forall k. k -> k
type ActionCancelModal i = i type ActionCancelModal i = i
@ -66,6 +66,7 @@ delegation_modal selected_domain form action_update_form action_validate action_
[ HH.div [HP.classes [C.notification, C.is_warning]] [ HH.div [HP.classes [C.notification, C.is_warning]]
[ Web.p "⚠️​ You are about to delegate your domain to another server, you won't be able to manage entries from netlibre." [ Web.p "⚠️​ You are about to delegate your domain to another server, you won't be able to manage entries from netlibre."
] ]
, render_errors
, Web.box_input "nameserver1" "name server 1" "ns0.example.com" , Web.box_input "nameserver1" "name server 1" "ns0.example.com"
(action_update_form <<< Delegation.NameServer1) (action_update_form <<< Delegation.NameServer1)
form.nameserver1 form.nameserver1
@ -78,6 +79,9 @@ delegation_modal selected_domain form action_update_form action_validate action_
[ Web.info_btn "Delegate the domain" action_validate [ Web.info_btn "Delegate the domain" action_validate
, Web.cancel_button action_cancel_modal , Web.cancel_button action_cancel_modal
] ]
render_errors = if A.length form.errors > 0
then HH.div_ $ [ Web.h3 "Errors: " ] <> map delegation_error_to_paragraph form.errors
else HH.div_ [ ]
type Domain = String type Domain = String
type ActionUpdateForm i = (Field.Field -> i) type ActionUpdateForm i = (Field.Field -> i)

View file

@ -1,15 +1,30 @@
module App.Type.Delegation where module App.Type.Delegation where
type Form = { nameserver1 :: String, nameserver2 :: String } import GenericParser.Parser as G
import GenericParser.DomainParser.Common (DomainError) as DomainParser
type Form
= { nameserver1 :: String
, nameserver2 :: String
, errors :: Array Error
}
data Field data Field
= NameServer1 String = NameServer1 String
| NameServer2 String | NameServer2 String
mkEmptyDelegationForm :: Form mkEmptyDelegationForm :: Form
mkEmptyDelegationForm = { nameserver1: "ns0.example.com", nameserver2: "ns1.example.com" } mkEmptyDelegationForm
= { nameserver1: "ns0.example.com"
, nameserver2: "ns1.example.com"
, errors: []
}
update_delegation_field :: Form -> Field -> Form update_delegation_field :: Form -> Field -> Form
update_delegation_field form updated_field = case updated_field of update_delegation_field form updated_field = case updated_field of
NameServer1 val -> form { nameserver1 = val } NameServer1 val -> form { nameserver1 = val }
NameServer2 val -> form { nameserver2 = val } NameServer2 val -> form { nameserver2 = val }
data Error
= VENameServer1 (G.Error DomainParser.DomainError)
| VENameServer2 (G.Error DomainParser.DomainError)

View file

@ -9,25 +9,21 @@ import GenericParser.Parser as G
import GenericParser.DomainParser.Common (DomainError) as DomainParser import GenericParser.DomainParser.Common (DomainError) as DomainParser
import GenericParser.DomainParser (name) as DomainParser import GenericParser.DomainParser (name) as DomainParser
import App.Type.Delegation as Delegation import App.Type.Delegation (mkEmptyDelegationForm, Form, Error(..)) as Delegation
data Error
= VENameServer1 (G.Error DomainParser.DomainError)
| VENameServer2 (G.Error DomainParser.DomainError)
-- | `parse` enables to run any parser based on `GenericParser` and provide a validation error. -- | `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. -- | 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 :: forall e v. G.Parser e v -> String -> ((G.Error e) -> Delegation.Error) -> V (Array Delegation.Error) v
parse (G.Parser p) str c = case p { string: str, position: 0 } of parse (G.Parser p) str c = case p { string: str, position: 0 } of
Left x -> invalid $ [c x] Left x -> invalid $ [c x]
Right x -> pure x.result Right x -> pure x.result
validation_nameservers :: Delegation.Form -> V (Array Error) Delegation.Form validation_nameservers :: Delegation.Form -> V (Array Delegation.Error) Delegation.Form
validation_nameservers form = ado validation_nameservers form = ado
nameserver1 <- parse DomainParser.name form.nameserver1 VENameServer1 nameserver1 <- parse DomainParser.name form.nameserver1 Delegation.VENameServer1
nameserver2 <- parse DomainParser.name form.nameserver2 VENameServer2 nameserver2 <- parse DomainParser.name form.nameserver2 Delegation.VENameServer2
in { nameserver1, nameserver2 } in Delegation.mkEmptyDelegationForm
-- | `validation` provides a way to validate the content of a RR. -- | `validation` provides a way to validate the content of a RR.
validation :: Delegation.Form -> Either (Array Error) Delegation.Form validation :: Delegation.Form -> Either (Array Delegation.Error) Delegation.Form
validation entry = toEither $ validation_nameservers entry validation entry = toEither $ validation_nameservers entry