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.Email as E
import App.Validation.Password as P
import App.Type.Delegation as Delegation
import App.Validation.Label as ValidationLabel
import GenericParser.DomainParser.Common (DomainError(..)) as DomainParser
import GenericParser.IPAddress as IPAddress
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 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 "
<> 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 :: ValidationDNS.Error -> String
show_error_title v = case v of

View file

@ -442,7 +442,15 @@ handleAction = case _ of
-- | Validate the delegation of the domain.
ValidateDelegation -> do
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.
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 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 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]]
[ 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"
(action_update_form <<< Delegation.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.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 ActionUpdateForm i = (Field.Field -> i)

View file

@ -1,15 +1,30 @@
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
= NameServer1 String
| NameServer2 String
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 updated_field = case updated_field of
NameServer1 val -> form { nameserver1 = 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 (name) as DomainParser
import App.Type.Delegation as Delegation
data Error
= VENameServer1 (G.Error DomainParser.DomainError)
| VENameServer2 (G.Error DomainParser.DomainError)
import App.Type.Delegation (mkEmptyDelegationForm, Form, Error(..)) as Delegation
-- | `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 :: 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
Left x -> invalid $ [c x]
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
nameserver1 <- parse DomainParser.name form.nameserver1 VENameServer1
nameserver2 <- parse DomainParser.name form.nameserver2 VENameServer2
in { nameserver1, nameserver2 }
nameserver1 <- parse DomainParser.name form.nameserver1 Delegation.VENameServer1
nameserver2 <- parse DomainParser.name form.nameserver2 Delegation.VENameServer2
in Delegation.mkEmptyDelegationForm
-- | `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