A new path for the validation process. Will be rewritten with GenericParser!

beta
Philippe Pittoli 2024-02-01 16:11:53 +01:00
parent 28c1d56b6f
commit 1171703b62
1 changed files with 19 additions and 5 deletions

View File

@ -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]