Delegation.

src/App/Page/Zone.purs

@@ -52,6 +52,7 @@ import App.Type.DMARC as DMARC
 import App.Type.LogMessage (LogMessage(..))
 import App.Message.DNSManagerDaemon as DNSManager
 import App.Validation.DNS as Validation
+import App.Validation.Delegation as ValidationDelegation
 
 import App.Type.RRForm (RRForm, RRUpdateValue(..), default_caa, default_rr, mkEmptyRRForm, update_form)
 
@@ -127,6 +128,12 @@ data Action
   -- | Update a delegation form field (new nameservers for the domain).
   | UpdateDelegationForm Delegation.Field
 
+  -- | Validate the delegation.
+  | ValidateDelegation
+
+  -- | Save the delegation.
+  | SaveDelegation
+
   -- | Validate a new resource record before adding it.
   | ValidateRR AcceptedRRTypes
 
@@ -241,7 +248,7 @@ render state
 
     delegation_modal
       = Modal.delegation_modal state._domain state._delegation_form
-          UpdateDelegationForm CancelModal
+          UpdateDelegationForm ValidateDelegation CancelModal
 
     render_zone =
       case state.rr_modal of
@@ -432,6 +439,15 @@ handleAction = case _ of
     -- Modal doesn't need to be active anymore.
     handleAction CancelModal
 
+  -- | Validate the delegation of the domain.
+  ValidateDelegation -> do
+    H.raise $ Log $ SystemLog "Validate the delegation"
+    handleAction $ SaveDelegation
+
+  -- | Save the delegation of the domain.
+  SaveDelegation -> do
+    H.raise $ Log $ SystemLog "Save the delegation"
+
   NewToken rr_id -> do
     { _domain } <- H.get
     H.raise $ Log $ SystemLog $ "Ask a token for rrid " <> show rr_id

src/App/Templates/Modal.purs

@@ -52,10 +52,11 @@ 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 i = i
 type ActionUpdateDelegationForm  i = (Delegation.Field -> i)
 delegation_modal :: forall w i.
-  Domain -> Delegation.Form -> ActionUpdateDelegationForm i -> ActionCancelModal i -> HH.HTML w i
+  Domain -> Delegation.Form -> ActionUpdateDelegationForm i -> ActionValidate i -> ActionCancelModal i -> HH.HTML w i
-delegation_modal selected_domain form action_update_form action_cancel_modal =
+delegation_modal selected_domain form action_update_form action_validate action_cancel_modal =
     Web.modal modal_title modal_content modal_foot
     where
     modal_title = "Delegation for " <> selected_domain
@@ -73,14 +74,12 @@ delegation_modal selected_domain form action_update_form action_cancel_modal =
       ]
     modal_foot :: Array (HH.HTML w i)
     modal_foot =
-        [ Web.p "should be a button here mdr"
+        [ Web.btn_add action_validate
-        --[ Web.btn_add action_update_form
         , 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)
 type ActionNewToken        i = (RRId -> i)

src/App/Validation/Delegation.purs

@@ -0,0 +1,313 @@
+module App.Validation.DNS where
+
+import Prelude (apply, between, bind, 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 App.Type.DKIM as DKIM
+import App.Type.DMARC as DMARC
+import App.Type.CAA as CAA
+
+import Utils (id)
+
+data Error
+  = UNKNOWN
+  | VENameServer1 (G.Error DomainParser.DomainError)
+  | VENameServer2 (G.Error DomainParser.DomainError)
+
+-- | Current default values.
+min_ttl      =     30 :: Int
+max_ttl      =  86000 :: Int
+max_txt      =    500 :: Int
+min_priority =      0 :: Int
+max_priority =  65535 :: Int
+min_port     =      0 :: Int
+max_port     =  65535 :: Int
+min_weight   =      0 :: Int
+max_weight   =  65535 :: Int
+
+-- Functions handling network-related structures (ResourceRecord).
+
+type RRPriority = Maybe Int
+type RRPort     = Maybe Int
+type RRWeight   = Maybe Int
+type RRMname    = Maybe String
+type RRRname    = Maybe String
+type RRSerial   = Maybe Int
+type RRRefresh  = Maybe Int
+type RRRetry    = Maybe Int
+type RRExpire   = Maybe Int
+type RRMinttl   = Maybe Int
+
+data TXTError
+  = TXTInvalidCharacter
+  | TXTTooLong Int Int -- max current
+-- | TODO: `txt_parser` is currently accepting any printable character (`vchar + sp`).
+txt_parser :: G.Parser TXTError String
+txt_parser = do pos <- G.current_position
+                v <- A.many (RFC5234.vchar <|> RFC5234.sp)
+                e <- G.tryMaybe SomeParsers.eof
+                pos2 <- G.current_position
+                case e of
+                  Nothing -> G.errorParser $ Just TXTInvalidCharacter
+                  Just _ -> do
+                    let nbchar = pos2 - pos
+                    if nbchar < max_txt
+                    then pure $ CU.fromCharArray v
+                    else G.Parser \_ -> G.failureError pos (Just $ TXTTooLong max_txt nbchar)
+
+-- | `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
+
+validationA :: ResourceRecord -> V (Array Error) ResourceRecord
+validationA form = ado
+  name   <- parse DomainParser.name form.name   VEName
+  ttl    <- is_between min_ttl max_ttl form.ttl    VETTL
+  target <- parse IPAddress.ipv4       form.target VEIPv4
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "A", name = name, ttl = ttl, target = target
+             , token = form.token }
+
+validationAAAA :: ResourceRecord -> V (Array Error) ResourceRecord
+validationAAAA form = ado
+  name   <- parse DomainParser.name form.name VEName
+  ttl    <- is_between min_ttl max_ttl form.ttl  VETTL
+  -- use read_input to get unaltered input (the IPv6 parser expands the input)
+  target <- parse (G.read_input IPAddress.ipv6) form.target VEIPv6
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "AAAA", name = name, ttl = ttl, target = target
+             , token = form.token }
+
+validationTXT :: ResourceRecord -> V (Array Error) ResourceRecord
+validationTXT form = ado
+  name   <- parse DomainParser.name form.name   VEName
+  ttl    <- is_between min_ttl max_ttl form.ttl    VETTL
+  target <- parse txt_parser           form.target VETXT
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "TXT", name = name, ttl = ttl, target = target }
+
+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 }
+
+validationNS :: ResourceRecord -> V (Array Error) ResourceRecord
+validationNS 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 VENS
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "NS", 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]
+
+validationMX :: ResourceRecord -> V (Array Error) ResourceRecord
+validationMX 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   VEMX
+  priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority
+  in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "MX"
+             , name = name, ttl = ttl, target = target, priority = Just priority }
+
+validationSRV :: ResourceRecord -> V (Array Error) ResourceRecord
+validationSRV 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   VESRV
+  priority <- is_between min_priority max_priority (maybe 0 id form.priority) VEPriority
+  port     <- is_between min_port max_port (maybe 0 id form.port)       VEPort
+  weight   <- is_between min_weight max_weight (maybe 0 id form.weight) VEWeight
+  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 }
+
+-- My version of "map" lol.
+verification_loop :: forall a e. (a -> V (Array e) a) -> Array a -> V (Array e) (Array a)
+verification_loop _ [] = pure []
+verification_loop f arr =
+  case A.head arr, A.tail arr of
+    Nothing, _ -> pure []
+    Just value, tail -> ado
+      v <- f value
+      following <- verification_loop f $ maybe [] id tail
+      in [v] <> following
+
+first :: forall a b. a -> b -> a
+first a _ = a
+
+or_nothing :: forall e. G.Parser e String -> G.Parser e String
+or_nothing p = do v <- G.tryMaybe p
+                  e <- G.tryMaybe SomeParsers.eof
+                  case v, e of
+                    Just value, _       -> pure value
+                    _,          Just _  -> pure ""
+                    Nothing,    Nothing -> p -- at least give the right error results
+
+-- | `validate_SPF_mechanism` validates the different values for each mechanism.
+-- | A and MX can both either doesn't have a value or a domain name.
+-- | EXISTS requires a domain name.
+-- |
+-- | **What differs from RFC7208**:
+-- | Some features of the mechanisms described in RFC7208 are lacking.
+-- | For instance, INCLUDE, A, MX, PTR and EXISTS accept domain *specs* not simply domain *names*.
+-- | Also, some of them should accept a CIDR, which currently isn't a thing.
+-- |
+-- | TODO: I don't intend to implement the full RFC7208, but accepting CIDR can be done.
+validate_SPF_mechanism :: Mechanism -> V (Array Error) Mechanism
+validate_SPF_mechanism m = case m.t of
+  -- RFC: `a         = "a"      [ ":" domain-spec ] [ dual-cidr-length ]`
+  RR.A       -> test (or_nothing DomainParser.sub_eof)          VESPFMechanismName
+
+  -- RFC: `mx        = "mx"     [ ":" domain-spec ] [ dual-cidr-length ]`
+  RR.MX      -> test (or_nothing DomainParser.sub_eof)          VESPFMechanismName
+
+  -- RFC: `exists    = "exists"   ":" domain-spec`
+  RR.EXISTS  -> test DomainParser.sub_eof                       VESPFMechanismName
+
+  -- RFC: `ptr       = "ptr"    [ ":" domain-spec ]`
+  RR.PTR     -> test (or_nothing DomainParser.sub_eof)          VESPFMechanismName
+
+  -- RFC: `ip4       = "ip4"      ":" ip4-network   [ ip4-cidr-length ]`
+  RR.IP4     -> test (IPAddress.ipv4_range <|> IPAddress.ipv4)  VESPFMechanismIPv4
+
+  -- RFC: `ip6       = "ip6"      ":" ip6-network   [ ip6-cidr-length ]`
+  RR.IP6     -> test (IPAddress.ipv6_range <|> IPAddress.ipv6)  VESPFMechanismIPv6
+
+  -- RFC: `include   = "include"  ":" domain-spec`
+  RR.INCLUDE -> test DomainParser.sub_eof                       VESPFMechanismName
+
+  where
+  test :: forall e. G.Parser e String -> ((G.Error e) -> Error) -> V (Array Error) Mechanism
+  test p e = ado
+    name <- parse p m.v e
+    in first m name -- name is discarded
+
+validate_SPF_modifier :: Modifier -> V (Array Error) Modifier
+validate_SPF_modifier m = case m.t of
+  RR.EXP -> ado
+    name <- parse DomainParser.sub_eof m.v VESPFModifierName
+    in first m name -- name is discarded
+  RR.REDIRECT -> ado
+    name <- parse DomainParser.sub_eof m.v VESPFModifierName
+    in first m name -- name is discarded
+
+validationSPF :: ResourceRecord -> V (Array Error) ResourceRecord
+validationSPF form = ado
+  name     <- parse DomainParser.name form.name     VEName
+  ttl      <- is_between min_ttl max_ttl form.ttl      VETTL
+  mechanisms <- verification_loop validate_SPF_mechanism (maybe [] id form.mechanisms)
+  modifiers  <- verification_loop validate_SPF_modifier  (maybe [] id form.modifiers)
+  -- No need to validate the target, actually, it will be completely discarded.
+  -- The different specific entries replace `target` completely.
+  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 }
+
+-- | Accepted RSA key sizes = 1024, 2048 or 4096 bits, 256 bits for ED25519.
+-- |
+-- | Since the public key representation for the RSA algorithm is in PKCS format (RFC 5958)
+-- | then converted in PEM (RFC 7468), and knowing this format enables some optional parameters,
+-- | it is not possible to expect an exact size for the public key input.
+-- | Consequently, we expect *at least* an input of 128 bytes for public key, loosely leading
+-- | to accept key sizes of at least 1024 bits. Maximum allowed key size is also arbitrary.
+rsa_min_key_size = 128  :: Int
+rsa_max_key_size = 1000 :: Int
+
+-- | Contrary to RSA, ED25519 doesn't use a PEM-converted PKCS representation to exchange
+-- | public keys, and the key size is 256 bits (32 bytes).
+-- | This key is converted directly in base64, leading to a simple 44-byte key representation.
+ed25519_key_size = 44 :: Int
+
+verify_public_key :: DKIM.SignatureAlgorithm -> DKIM.PublicKey -> V (Array Error) DKIM.PublicKey
+verify_public_key signalgo key = case signalgo of
+  DKIM.RSA -> ado
+    k <- if between rsa_min_key_size rsa_max_key_size (S.length key)
+         then pure key
+         else invalid [DKIMInvalidKeySize rsa_min_key_size rsa_max_key_size]
+    in k
+  DKIM.ED25519 -> ado
+    k <- if S.length key == ed25519_key_size
+         then pure key
+         else invalid [DKIMInvalidKeySize ed25519_key_size ed25519_key_size]
+    in k
+
+validationDKIM :: ResourceRecord -> V (Array Error) ResourceRecord
+validationDKIM form =
+  let dkim = fromMaybe DKIM.emptyDKIMRR form.dkim
+  in ado
+    name     <- parse DomainParser.name form.name     VEName
+    ttl      <- is_between min_ttl max_ttl form.ttl      VETTL
+    -- TODO: v n
+    p        <- verify_public_key (fromMaybe DKIM.RSA dkim.k) dkim.p
+    -- No need to validate the target, actually, it will be completely discarded.
+    -- The different specific entries replace `target` completely.
+    in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "DKIM"
+               , name = name, ttl = ttl, target = "" -- `target` is discarded!
+               , dkim = Just $ dkim { p = p } }
+
+validationDMARC :: ResourceRecord -> V (Array Error) ResourceRecord
+validationDMARC form =
+  let dmarc = fromMaybe DMARC.emptyDMARCRR form.dmarc
+  in ado
+    name     <- parse DomainParser.name form.name     VEName
+    ttl      <- is_between min_ttl max_ttl form.ttl      VETTL
+    pct      <- is_between 0 100      (fromMaybe 100   dmarc.pct) VEDMARCpct
+    ri       <- is_between 0 1000000  (fromMaybe 86400 dmarc.ri)  VEDMARCri
+    -- No need to validate the target, actually, it will be completely discarded.
+    -- The different specific entries replace `target` completely.
+    in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "DMARC"
+               , name = name, ttl = ttl, target = "" -- `target` is discarded!
+               , dmarc = Just $ dmarc { pct = Just pct, ri = Just ri } }
+
+validationCAA :: ResourceRecord -> V (Array Error) ResourceRecord
+validationCAA form =
+  let caa = fromMaybe CAA.emptyCAARR form.caa
+  in ado
+    name     <- parse DomainParser.name form.name  VEName
+    ttl      <- is_between min_ttl max_ttl form.ttl   VETTL
+    flag     <- is_between 0 255           caa.flag   VECAAflag
+    -- TODO: verify the `value` field.
+    -- No need to validate the target, actually, it will be completely discarded.
+    -- The different specific entries replace `target` completely.
+    in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CAA"
+               , name = name, ttl = ttl, target = "" -- `target` is discarded!
+               , caa = Just $ caa { flag = flag } }
+
+
+-- | `validation` provides a way to validate the content of a RR.
+validation :: ResourceRecord -> Either (Array Error) ResourceRecord
+validation entry = case entry.rrtype of
+  "A"     -> toEither $ validationA     entry
+  "AAAA"  -> toEither $ validationAAAA  entry
+  "TXT"   -> toEither $ validationTXT   entry
+  "CNAME" -> toEither $ validationCNAME entry
+  "NS"    -> toEither $ validationNS    entry
+  "MX"    -> toEither $ validationMX    entry
+  "CAA"   -> toEither $ validationCAA   entry
+  "SRV"   -> toEither $ validationSRV   entry
+  "SPF"   -> toEither $ validationSPF   entry
+  "DKIM"  -> toEither $ validationDKIM  entry
+  "DMARC" -> toEither $ validationDMARC entry
+  _       -> toEither $ invalid [UNKNOWN]