WIP: SPF verifications.
parent
645d6836c3
commit
6178d60faa
|
@ -34,6 +34,11 @@ error_to_paragraph v = Bulma.error_message (Bulma.p $ show_error_title v)
|
||||||
<> ", current value: " <> show n <> "."
|
<> ", current value: " <> show n <> "."
|
||||||
ValidationDNS.VEWeight min max n -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max
|
ValidationDNS.VEWeight min max n -> Bulma.p $ "Weight should have a value between " <> show min <> " and " <> show max
|
||||||
<> ", current value: " <> show n <> "."
|
<> ", current value: " <> show n <> "."
|
||||||
|
|
||||||
|
-- SPF dedicated RR
|
||||||
|
ValidationDNS.VESPFMechanismName err -> maybe default_error show_error_domain err.error
|
||||||
|
ValidationDNS.VESPFMechanismIPv4 err -> maybe default_error show_error_ip4 err.error
|
||||||
|
ValidationDNS.VESPFMechanismIPv6 err -> maybe default_error show_error_ip6 err.error
|
||||||
)
|
)
|
||||||
where default_error = Bulma.p ""
|
where default_error = Bulma.p ""
|
||||||
|
|
||||||
|
@ -55,6 +60,11 @@ show_error_title v = case v of
|
||||||
ValidationDNS.VEPort min max n -> "Invalid Port (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")"
|
ValidationDNS.VEPort min max n -> "Invalid Port (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")"
|
||||||
ValidationDNS.VEWeight min max n -> "Invalid Weight (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")"
|
ValidationDNS.VEWeight min max n -> "Invalid Weight (min: " <> show min <> ", max: " <> show max <> ", n: " <> show n <> ")"
|
||||||
|
|
||||||
|
-- SPF dedicated RR
|
||||||
|
ValidationDNS.VESPFMechanismName err -> "The name (domain label) in a SPF mechanism is wrong (position: " <> show err.position <> ")"
|
||||||
|
ValidationDNS.VESPFMechanismIPv4 err -> "The IPv4 address in a SPF mechanism is wrong (position: " <> show err.position <> ")"
|
||||||
|
ValidationDNS.VESPFMechanismIPv6 err -> "The IPv6 address in a SPF mechanism is wrong (position: " <> show err.position <> ")"
|
||||||
|
|
||||||
show_error_domain :: forall w i. DomainParser.DomainError -> HH.HTML w i
|
show_error_domain :: forall w i. DomainParser.DomainError -> HH.HTML w i
|
||||||
show_error_domain e = case e of
|
show_error_domain e = case e of
|
||||||
DomainParser.LabelTooLarge size ->
|
DomainParser.LabelTooLarge size ->
|
||||||
|
|
|
@ -1,6 +1,6 @@
|
||||||
module App.Validation.DNS where
|
module App.Validation.DNS where
|
||||||
|
|
||||||
import Prelude (apply, between, bind, map, pure, ($), (-), (<))
|
import Prelude (apply, between, bind, map, pure, ($), (-), (<), (<$>), (<>))
|
||||||
|
|
||||||
import Control.Alt ((<|>))
|
import Control.Alt ((<|>))
|
||||||
import Data.Array as A
|
import Data.Array as A
|
||||||
|
@ -9,7 +9,8 @@ import Data.Maybe (Maybe(..), maybe)
|
||||||
import Data.String.CodeUnits as CU
|
import Data.String.CodeUnits as CU
|
||||||
import Data.Validation.Semigroup (V, invalid, toEither)
|
import Data.Validation.Semigroup (V, invalid, toEither)
|
||||||
|
|
||||||
import App.ResourceRecord (ResourceRecord, emptyRR)
|
import App.ResourceRecord (ResourceRecord, emptyRR, Mechanism, Modifier, Qualifier)
|
||||||
|
import App.ResourceRecord (MechanismType(..), ModifierType(..)) as RR
|
||||||
import GenericParser.SomeParsers as SomeParsers
|
import GenericParser.SomeParsers as SomeParsers
|
||||||
import GenericParser.Parser as G
|
import GenericParser.Parser as G
|
||||||
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
import GenericParser.DomainParser.Common (DomainError) as DomainParser
|
||||||
|
@ -48,6 +49,11 @@ data Error
|
||||||
| VEPort Int Int Int
|
| VEPort Int Int Int
|
||||||
| VEWeight 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
|
type AVErrors = Array Error
|
||||||
|
|
||||||
-- | Current default values.
|
-- | Current default values.
|
||||||
|
@ -178,13 +184,54 @@ validationSRV form = ado
|
||||||
, name = name, ttl = ttl, target = target
|
, name = name, ttl = ttl, target = target
|
||||||
, priority = Just priority, port = Just port, protocol = Just protocol, weight = Just weight }
|
, 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 :: ResourceRecord -> V (Array Error) ResourceRecord
|
||||||
validationSPF form = ado
|
validationSPF form = ado
|
||||||
name <- parse DomainParser.sub_eof form.name VEName
|
name <- parse DomainParser.sub_eof form.name VEName
|
||||||
ttl <- is_between min_ttl max_ttl form.ttl VETTL
|
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"
|
in emptyRR { rrid = form.rrid, readonly = form.readonly, rrtype = "SPF"
|
||||||
, name = name, ttl = ttl, target = ""
|
, name = name, ttl = ttl, target = "" -- `target` is discarded!
|
||||||
, v = form.v, mechanisms = maybe (Just []) Just form.mechanisms
|
, v = form.v, mechanisms = Just mechanisms
|
||||||
, modifiers = form.modifiers, q = form.q }
|
, modifiers = form.modifiers, q = form.q }
|
||||||
|
|
||||||
validation :: ResourceRecord -> Either (Array Error) ResourceRecord
|
validation :: ResourceRecord -> Either (Array Error) ResourceRecord
|
||||||
|
|
|
@ -158,10 +158,14 @@ data Action
|
||||||
| SPF_Modifier_v String
|
| SPF_Modifier_v String
|
||||||
| SPF_Qualifier Int
|
| SPF_Qualifier Int
|
||||||
|
|
||||||
|
-- | Remove a SPF mechanism of the currently modified (SPF) entry (see `_currentRR`).
|
||||||
| SPF_remove_mechanism Int
|
| SPF_remove_mechanism Int
|
||||||
|
-- | Remove a SPF modifier of the currently modified (SPF) entry (see `_currentRR`).
|
||||||
| SPF_remove_modifier Int
|
| SPF_remove_modifier Int
|
||||||
|
|
||||||
|
-- | Add a SPF mechanism to the currently modified (SPF) entry (see `_currentRR`).
|
||||||
| SPF_Mechanism_Add
|
| SPF_Mechanism_Add
|
||||||
|
-- | Add a SPF modifier to the currently modified (SPF) entry (see `_currentRR`).
|
||||||
| SPF_Modifier_Add
|
| SPF_Modifier_Add
|
||||||
|
|
||||||
data RRModal
|
data RRModal
|
||||||
|
|
Loading…
Reference in New Issue