Delegation: validation for name server addresses.

src/App/DisplayErrors.purs

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

src/App/Page/Zone.purs

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

src/App/Templates/Modal.purs

@@ -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
@@ -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.
@@ -65,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
@@ -74,11 +76,12 @@ 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 <> ".)")
+    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)

src/App/Type/Delegation.purs

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

src/App/Validation/Delegation.purs

@@ -1,66 +1,29 @@
-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 App.Type.Delegation (mkEmptyDelegationForm, Form, Error(..)) as Delegation
 
-import Utils (id)
+-- | `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) -> 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
 
-data Error
-  = UNKNOWN
-  | 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 }
-
-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 Delegation.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 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 :: 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 Delegation.Error) Delegation.Form
+validation entry = toEither $ validation_nameservers entry

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)

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