Delegation: validation WIP.
This commit is contained in:
parent
575ba76c18
commit
56cd013471
1 changed files with 5 additions and 252 deletions
|
|
@ -30,78 +30,6 @@ data Error
|
||||||
| VENameServer1 (G.Error DomainParser.DomainError)
|
| VENameServer1 (G.Error DomainParser.DomainError)
|
||||||
| VENameServer2 (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 :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||||
validationCNAME form = ado
|
validationCNAME form = ado
|
||||||
name <- parse DomainParser.name form.name VEName
|
name <- parse DomainParser.name form.name VEName
|
||||||
|
|
@ -109,205 +37,30 @@ validationCNAME form = ado
|
||||||
target <- parse DomainParser.sub_eof form.target VECNAME
|
target <- parse DomainParser.sub_eof form.target VECNAME
|
||||||
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "CNAME", name = name, ttl = ttl, target = target }
|
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 :: Int -> Int -> Int -> (Int -> Int -> Int -> Error) -> V (Array Error) Int
|
||||||
is_between min max n ve = if between min max n
|
is_between min max n ve = if between min max n
|
||||||
then pure n
|
then pure n
|
||||||
else invalid [ve min max 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 :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||||
validationSRV form = ado
|
validationSRV form = ado
|
||||||
name <- parse DomainParser.name form.name VEName
|
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"
|
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SRV"
|
||||||
, name = name, ttl = ttl, target = target
|
, name = name, ttl = ttl, target = target
|
||||||
, priority = Just priority, port = Just port, protocol = form.protocol, weight = Just weight }
|
, priority = Just priority, port = Just port, protocol = form.protocol, weight = Just weight }
|
||||||
|
|
||||||
-- My version of "map" lol.
|
validation_nameservers :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||||
verification_loop :: forall a e. (a -> V (Array e) a) -> Array a -> V (Array e) (Array a)
|
validation_nameservers form = ado
|
||||||
verification_loop _ [] = pure []
|
nameserver1 <- parse DomainParser.name form.name VEName
|
||||||
verification_loop f arr =
|
nameserver2 <- parse DomainParser.name form.name VEName
|
||||||
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"
|
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SPF"
|
||||||
, name = name, ttl = ttl, target = "" -- `target` is discarded!
|
, name = name, ttl = ttl, target = "" -- `target` is discarded!
|
||||||
, v = form.v, mechanisms = Just mechanisms
|
, v = form.v, mechanisms = Just mechanisms
|
||||||
, modifiers = Just modifiers, q = form.q }
|
, 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` provides a way to validate the content of a RR.
|
||||||
validation :: ResourceRecord -> Either (Array Error) ResourceRecord
|
validation :: ResourceRecord -> Either (Array Error) ResourceRecord
|
||||||
validation entry = case entry.rrtype of
|
validation entry = toEither $ validation_nameservers entry
|
||||||
"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
|
"DKIM" -> toEither $ validationDKIM entry
|
||||||
"DMARC" -> toEither $ validationDMARC entry
|
"DMARC" -> toEither $ validationDMARC entry
|
||||||
_ -> toEither $ invalid [UNKNOWN]
|
_ -> toEither $ invalid [UNKNOWN]
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue