A new path for the validation process. Will be rewritten with GenericParser!
parent
28c1d56b6f
commit
1171703b62
|
@ -1,6 +1,6 @@
|
||||||
module App.Validation where
|
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.Validation.Semigroup (V, andThen, invalid, toEither)
|
||||||
-- import Data.Array as A
|
-- import Data.Array as A
|
||||||
|
@ -15,9 +15,12 @@ import Data.Int (fromString)
|
||||||
import URI.Host.IPv4Address as IPv4
|
import URI.Host.IPv4Address as IPv4
|
||||||
import URI.Host.IPv6Address as IPv6
|
import URI.Host.IPv6Address as IPv6
|
||||||
|
|
||||||
|
import Control.Alt ((<|>))
|
||||||
|
|
||||||
import App.RR
|
import App.RR
|
||||||
import App.AcceptedRRTypes (AcceptedRRTypes(..))
|
import App.AcceptedRRTypes (AcceptedRRTypes(..))
|
||||||
import App.ResourceRecord (ResourceRecord)
|
import App.ResourceRecord (ResourceRecord)
|
||||||
|
import GenericParser.SomeParsers as SomeParsers
|
||||||
import GenericParser.Parser as G
|
import GenericParser.Parser as G
|
||||||
import GenericParser.IPAddress as IPAddress
|
import GenericParser.IPAddress as IPAddress
|
||||||
|
|
||||||
|
@ -45,6 +48,7 @@ data ValidationError
|
||||||
= UNKNOWN
|
= UNKNOWN
|
||||||
| VEIPv4 (G.Error IPAddress.IPv4Error)
|
| VEIPv4 (G.Error IPAddress.IPv4Error)
|
||||||
| VEIPv6 (G.Error IPAddress.IPv6Error)
|
| VEIPv6 (G.Error IPAddress.IPv6Error)
|
||||||
|
| VETTL (G.Error TTLError)
|
||||||
|
|
||||||
type AVErrors = Array ValidationError
|
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)
|
= toRR rrid readonly rrtype rrname ttl target (Just priority) (Just port) (Just protocol) (Just weight)
|
||||||
Nothing Nothing Nothing Nothing Nothing Nothing Nothing
|
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.
|
-- | `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.
|
-- | 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
|
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 :: forall l. SimpleRR (|l) -> V AVErrors ResourceRecord
|
||||||
validationA form = ado
|
validationA form = ado
|
||||||
-- name <- validate_name form.name
|
-- name <- validate_name form.name
|
||||||
-- ttl <- validate_ttl form.ttl
|
ttl <- parse ttl_parser form.ttl VETTL
|
||||||
target <- parse IPAddress.ipv4 form.target VEIPv4
|
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" 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 :: forall l. SRVRR (|l) -> AcceptedRRTypes -> Either AVErrors ResourceRecord
|
||||||
validation entry t = case t of
|
validation entry t = case t of
|
||||||
A -> toEither <<< validationA entry
|
A -> toEither $ validationA entry
|
||||||
_ -> invalid $ UNKNOWN
|
_ -> toEither $ invalid [UNKNOWN]
|
||||||
|
|
Loading…
Reference in New Issue