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)
|
||||
| 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]
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue