From 56cd0134716c1d703742a41c2681ea5ab6cf5117 Mon Sep 17 00:00:00 2001 From: Philippe Pittoli Date: Fri, 11 Jul 2025 15:28:49 +0200 Subject: [PATCH] Delegation: validation WIP. --- src/App/Validation/Delegation.purs | 257 +---------------------------- 1 file changed, 5 insertions(+), 252 deletions(-) diff --git a/src/App/Validation/Delegation.purs b/src/App/Validation/Delegation.purs index 2a91215..0c5a39c 100644 --- a/src/App/Validation/Delegation.purs +++ b/src/App/Validation/Delegation.purs @@ -30,78 +30,6 @@ data Error | 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 @@ -109,205 +37,30 @@ validationCNAME form = ado 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. +validation_nameservers :: ResourceRecord -> V (Array Error) ResourceRecord +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 } --- | 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 +validation entry = toEither $ validation_nameservers entry "DKIM" -> toEither $ validationDKIM entry "DMARC" -> toEither $ validationDMARC entry _ -> toEither $ invalid [UNKNOWN]