264 lines
11 KiB
Plaintext
264 lines
11 KiB
Plaintext
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)
|
|
import Data.String.CodeUnits as CU
|
|
import Data.Validation.Semigroup (V, invalid, toEither)
|
|
|
|
import App.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier, Qualifier)
|
|
import App.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 (sub_eof) as DomainParser
|
|
import GenericParser.IPAddress as IPAddress
|
|
import GenericParser.RFC5234 as RFC5234
|
|
|
|
-- | **History:**
|
|
-- | The module once used dedicated types for each type of RR.
|
|
-- | That comes with several advantages.
|
|
-- | First, type verification was a thing, and function were dedicated to a certain type of record.
|
|
-- | Second, these dedicated types used strings for their fields,
|
|
-- | which simplifies the typing when dealing with forms.
|
|
-- | Finally, the validation was a way to convert dedicated types (used in forms)
|
|
-- | to the general type (used for network serialization).
|
|
-- | This ensures each resource record is verified before being sent to `dnsmanagerd`.
|
|
-- |
|
|
-- | The problem is that, with dedicated types, you are then required to have dedicated functions.
|
|
-- | Conversion functions are also required.
|
|
-- |
|
|
-- | Maybe the code will change again in the future, but for now it will be enough.
|
|
|
|
data Error
|
|
= UNKNOWN
|
|
| VEIPv4 (G.Error IPAddress.IPv4Error)
|
|
| VEIPv6 (G.Error IPAddress.IPv6Error)
|
|
| VEName (G.Error DomainParser.DomainError)
|
|
| VETTL Int Int Int
|
|
| VETXT (G.Error TXTError)
|
|
| VECNAME (G.Error DomainParser.DomainError)
|
|
| VENS (G.Error DomainParser.DomainError)
|
|
| VEMX (G.Error DomainParser.DomainError)
|
|
| VEPriority Int Int Int
|
|
| VESRV (G.Error DomainParser.DomainError)
|
|
| VEProtocol (G.Error ProtocolError)
|
|
| VEPort Int Int Int
|
|
| VEWeight Int Int Int
|
|
|
|
-- SPF
|
|
| VESPFMechanismName (G.Error DomainParser.DomainError)
|
|
| VESPFMechanismIPv4 (G.Error IPAddress.IPv4Error)
|
|
| VESPFMechanismIPv6 (G.Error IPAddress.IPv6Error)
|
|
|
|
type AVErrors = Array Error
|
|
|
|
-- | Current default values.
|
|
min_ttl :: Int
|
|
min_ttl = 30
|
|
max_ttl :: Int
|
|
max_ttl = 86000
|
|
max_txt :: Int
|
|
max_txt = 500
|
|
min_priority :: Int
|
|
min_priority = 0
|
|
max_priority :: Int
|
|
max_priority = 65535
|
|
min_port :: Int
|
|
min_port = 0
|
|
max_port :: Int
|
|
max_port = 65535
|
|
min_weight :: Int
|
|
min_weight = 0
|
|
max_weight :: Int
|
|
max_weight = 65535
|
|
|
|
-- Functions handling network-related structures (ResourceRecord).
|
|
|
|
type RRPriority = Maybe Int
|
|
type RRPort = Maybe Int
|
|
type RRProtocol = Maybe String
|
|
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` allows 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.sub_eof 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 }
|
|
|
|
validationAAAA :: ResourceRecord -> V (Array Error) ResourceRecord
|
|
validationAAAA form = ado
|
|
name <- parse DomainParser.sub_eof 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 }
|
|
|
|
validationTXT :: ResourceRecord -> V (Array Error) ResourceRecord
|
|
validationTXT form = ado
|
|
name <- parse DomainParser.sub_eof 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.sub_eof 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.sub_eof 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 }
|
|
|
|
data ProtocolError
|
|
= InvalidProtocol
|
|
|
|
protocol_parser :: G.Parser ProtocolError String
|
|
protocol_parser = do
|
|
G.string "tcp" <|> G.string "udp" G.<:> \_ -> InvalidProtocol
|
|
|
|
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.sub_eof 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.sub_eof 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
|
|
protocol <- parse protocol_parser (maybe "" id form.protocol) VEProtocol
|
|
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 = Just 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 :: Mechanism -> V (Array Error) Mechanism
|
|
validate_SPF_mechanism m = case m.t of
|
|
RR.A -> ado
|
|
name <- parse (or_nothing DomainParser.sub_eof) m.v VESPFMechanismName
|
|
in first m name -- name is discarded
|
|
RR.MX -> ado
|
|
name <- parse (or_nothing DomainParser.sub_eof) m.v VESPFMechanismName
|
|
in first m name -- name is discarded
|
|
RR.IP4 -> ado
|
|
name <- parse IPAddress.ipv4 m.v VESPFMechanismIPv4
|
|
in first m name -- name is discarded
|
|
RR.IP6 -> ado
|
|
name <- parse IPAddress.ipv6 m.v VESPFMechanismIPv6
|
|
in first m name -- name is discarded
|
|
_ -> pure m
|
|
|
|
validationSPF :: ResourceRecord -> V (Array Error) ResourceRecord
|
|
validationSPF form = ado
|
|
name <- parse DomainParser.sub_eof form.name VEName
|
|
ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
|
mechanisms <- verification_loop validate_SPF_mechanism (maybe [] id form.mechanisms)
|
|
-- 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 = form.modifiers, q = form.q }
|
|
|
|
--validationDKIM :: ResourceRecord -> V (Array Error) ResourceRecord
|
|
--validationDKIM form = ado
|
|
-- name <- parse DomainParser.sub_eof form.name VEName
|
|
-- ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
|
-- mechanisms <- verification_loop validate_DKIM_mechanism (maybe [] id form.mechanisms)
|
|
-- -- 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!
|
|
-- , v = form.v, mechanisms = Just mechanisms
|
|
-- , modifiers = form.modifiers, q = form.q }
|
|
|
|
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
|
|
"SRV" -> toEither $ validationSRV entry
|
|
"SPF" -> toEither $ validationSPF entry
|
|
--"DKIM" -> toEither $ validationDKIM entry
|
|
_ -> toEither $ invalid [UNKNOWN]
|
|
|
|
id :: forall a. a -> a
|
|
id x = x
|