diff --git a/src/App/Validation.purs b/src/App/Validation.purs index 5f4c15f..9b55964 100644 --- a/src/App/Validation.purs +++ b/src/App/Validation.purs @@ -1,6 +1,6 @@ module App.Validation where -import Prelude (class Eq, apply, map, otherwise, pure, show, ($), (&&), (<), (<<<), (<=), (<>), (>=)) +import Prelude (class Eq, apply, map, otherwise, pure, show, ($), (&&), (<), (<<<), (<=), (<>), (>=), between, bind) import Data.Validation.Semigroup (V, andThen, invalid, toEither) -- import Data.Array as A @@ -15,9 +15,12 @@ import Data.Int (fromString) import URI.Host.IPv4Address as IPv4 import URI.Host.IPv6Address as IPv6 +import Control.Alt ((<|>)) + import App.RR import App.AcceptedRRTypes (AcceptedRRTypes(..)) import App.ResourceRecord (ResourceRecord) +import GenericParser.SomeParsers as SomeParsers import GenericParser.Parser as G import GenericParser.IPAddress as IPAddress @@ -45,6 +48,7 @@ data ValidationError = UNKNOWN | VEIPv4 (G.Error IPAddress.IPv4Error) | VEIPv6 (G.Error IPAddress.IPv6Error) + | VETTL (G.Error TTLError) type AVErrors = Array ValidationError @@ -410,6 +414,16 @@ toRR_srv rrid readonly rrtype rrname ttl target priority port protocol weight = toRR rrid readonly rrtype rrname ttl target (Just priority) (Just port) (Just protocol) (Just weight) Nothing Nothing Nothing Nothing Nothing Nothing Nothing +data TTLError + = NotInt + | NotBetween Int Int Int +ttl_parser :: G.Parser TTLError Int +ttl_parser = do pos <- G.current_position + n <- SomeParsers.nat <|> G.Parser \_ -> G.failureError pos (Just NotInt) + if between min_ttl max_ttl n + then pure n + else G.Parser \_ -> G.failureError pos (Just $ NotBetween min_ttl max_ttl n) + -- | `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) -> ValidationError) -> V AVErrors v @@ -420,12 +434,12 @@ parse (G.Parser p) str c = case p { string: str, position: 0 } of validationA :: forall l. SimpleRR (|l) -> V AVErrors ResourceRecord validationA form = ado -- name <- validate_name form.name - -- ttl <- validate_ttl form.ttl + ttl <- parse ttl_parser form.ttl VETTL target <- parse IPAddress.ipv4 form.target VEIPv4 -- in toRR_basic form.rrid form.readonly "A" name ttl target - in toRR_basic form.rrid form.readonly "A" form.name form.ttl target + in toRR_basic form.rrid form.readonly "A" form.name ttl target validation :: forall l. SRVRR (|l) -> AcceptedRRTypes -> Either AVErrors ResourceRecord validation entry t = case t of - A -> toEither <<< validationA entry - _ -> invalid $ UNKNOWN + A -> toEither $ validationA entry + _ -> toEither $ invalid [UNKNOWN]