{-# OPTIONS_GHC -Wall #-}
{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DeriveFunctor #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE FunctionalDependencies #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE PackageImports #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TemplateHaskell #-}
{-# LANGUAGE UndecidableInstances #-}
module Data.Swagger.Internal.Schema.Validation where
import Prelude ()
import Prelude.Compat
import Control.Applicative
import Control.Lens
import Control.Monad (when)
import Data.Aeson hiding (Result)
import Data.Aeson.Encode.Pretty (encodePretty)
import Data.Foldable (for_, sequenceA_,
traverse_)
import Data.HashMap.Strict (HashMap)
import qualified Data.HashMap.Strict as HashMap
import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
import qualified "unordered-containers" Data.HashSet as HashSet
import Data.Proxy
import Data.Scientific (Scientific, isInteger)
import Data.Text (Text)
import qualified Data.Text as Text
import qualified Data.Text.Lazy as TL
import qualified Data.Text.Lazy.Encoding as TL
import Data.Vector (Vector)
import qualified Data.Vector as Vector
import Data.Swagger.Declare
import Data.Swagger.Internal
import Data.Swagger.Internal.Schema
import Data.Swagger.Lens
import qualified Data.Aeson.KeyMap as KM
validatePrettyToJSON :: forall a. (ToJSON a, ToSchema a) => a -> Maybe String
validatePrettyToJSON :: forall a. (ToJSON a, ToSchema a) => a -> Maybe String
validatePrettyToJSON = forall a.
(ToJSON a, ToSchema a) =>
(a -> [String]) -> a -> Maybe String
renderValidationErrors forall a. (ToJSON a, ToSchema a) => a -> [String]
validateToJSON
validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [ValidationError]
validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [String]
validateToJSON = forall a.
(ToJSON a, ToSchema a) =>
(Text -> Text -> Bool) -> a -> [String]
validateToJSONWithPatternChecker (\Text
_pattern Text
_str -> Bool
True)
validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) => (Pattern -> Text -> Bool) -> a -> [ValidationError]
validateToJSONWithPatternChecker :: forall a.
(ToJSON a, ToSchema a) =>
(Text -> Text -> Bool) -> a -> [String]
validateToJSONWithPatternChecker Text -> Text -> Bool
checker = (Text -> Text -> Bool)
-> Definitions Schema -> Schema -> Value -> [String]
validateJSONWithPatternChecker Text -> Text -> Bool
checker Definitions Schema
defs Schema
sch forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> Value
toJSON
where
(Definitions Schema
defs, Schema
sch) = forall d a. Declare d a -> d -> (d, a)
runDeclare (forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
declareSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) forall a. Monoid a => a
mempty
renderValidationErrors
:: forall a. (ToJSON a, ToSchema a)
=> (a -> [ValidationError]) -> a -> Maybe String
renderValidationErrors :: forall a.
(ToJSON a, ToSchema a) =>
(a -> [String]) -> a -> Maybe String
renderValidationErrors a -> [String]
f a
x =
case a -> [String]
f a
x of
[] -> forall a. Maybe a
Nothing
[String]
errors -> forall a. a -> Maybe a
Just forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ String
"Validation against the schema fails:"
, [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (String
" * " forall a. [a] -> [a] -> [a]
++) [String]
errors)
, String
"JSON value:"
, Value -> String
ppJSONString (forall a. ToJSON a => a -> Value
toJSON a
x)
, String
""
, String
"Swagger Schema:"
, Value -> String
ppJSONString (forall a. ToJSON a => a -> Value
toJSON Schema
schema_)
, String
""
, String
"Swagger Description Context:"
, Value -> String
ppJSONString (forall a. ToJSON a => a -> Value
toJSON Definitions Schema
refs_)
]
where
ppJSONString :: Value -> String
ppJSONString = Text -> String
TL.unpack forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. ToJSON a => a -> ByteString
encodePretty
(Definitions Schema
refs_, Schema
schema_) = forall d a. Declare d a -> d -> (d, a)
runDeclare (forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
declareSchema (forall {k} (t :: k). Proxy t
Proxy :: Proxy a)) forall a. Monoid a => a
mempty
validateJSON :: Definitions Schema -> Schema -> Value -> [ValidationError]
validateJSON :: Definitions Schema -> Schema -> Value -> [String]
validateJSON = (Text -> Text -> Bool)
-> Definitions Schema -> Schema -> Value -> [String]
validateJSONWithPatternChecker (\Text
_pattern Text
_str -> Bool
True)
validateJSONWithPatternChecker :: (Pattern -> Text -> Bool) -> Definitions Schema -> Schema -> Value -> [ValidationError]
validateJSONWithPatternChecker :: (Text -> Text -> Bool)
-> Definitions Schema -> Schema -> Value -> [String]
validateJSONWithPatternChecker Text -> Text -> Bool
checker Definitions Schema
defs Schema
sch Value
js =
case forall s a. Validation s a -> Config -> s -> Result a
runValidation (Value -> Validation Schema ()
validateWithSchema Value
js) Config
cfg Schema
sch of
Failed [String]
xs -> [String]
xs
Passed ()
_ -> forall a. Monoid a => a
mempty
where
cfg :: Config
cfg = Config
defaultConfig
{ configPatternChecker :: Text -> Text -> Bool
configPatternChecker = Text -> Text -> Bool
checker
, configDefinitions :: Definitions Schema
configDefinitions = Definitions Schema
defs }
type ValidationError = String
data Result a
= Failed [ValidationError]
| Passed a
deriving (Result a -> Result a -> Bool
forall a. Eq a => Result a -> Result a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Result a -> Result a -> Bool
$c/= :: forall a. Eq a => Result a -> Result a -> Bool
== :: Result a -> Result a -> Bool
$c== :: forall a. Eq a => Result a -> Result a -> Bool
Eq, Int -> Result a -> String -> String
forall a. Show a => Int -> Result a -> String -> String
forall a. Show a => [Result a] -> String -> String
forall a. Show a => Result a -> String
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [Result a] -> String -> String
$cshowList :: forall a. Show a => [Result a] -> String -> String
show :: Result a -> String
$cshow :: forall a. Show a => Result a -> String
showsPrec :: Int -> Result a -> String -> String
$cshowsPrec :: forall a. Show a => Int -> Result a -> String -> String
Show, forall a b. a -> Result b -> Result a
forall a b. (a -> b) -> Result a -> Result b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: forall a b. (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
Functor)
instance Applicative Result where
pure :: forall a. a -> Result a
pure = forall a. a -> Result a
Passed
Passed a -> b
f <*> :: forall a b. Result (a -> b) -> Result a -> Result b
<*> Passed a
x = forall a. a -> Result a
Passed (a -> b
f a
x)
Failed [String]
xs <*> Failed [String]
ys = forall a. [String] -> Result a
Failed ([String]
xs forall a. Semigroup a => a -> a -> a
<> [String]
ys)
Failed [String]
xs <*> Result a
_ = forall a. [String] -> Result a
Failed [String]
xs
Result (a -> b)
_ <*> Failed [String]
ys = forall a. [String] -> Result a
Failed [String]
ys
instance Alternative Result where
empty :: forall a. Result a
empty = forall a. [String] -> Result a
Failed forall a. Monoid a => a
mempty
Passed a
x <|> :: forall a. Result a -> Result a -> Result a
<|> Result a
_ = forall a. a -> Result a
Passed a
x
Result a
_ <|> Result a
y = Result a
y
instance Monad Result where
return :: forall a. a -> Result a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Passed a
x >>= :: forall a b. Result a -> (a -> Result b) -> Result b
>>= a -> Result b
f = a -> Result b
f a
x
Failed [String]
xs >>= a -> Result b
_ = forall a. [String] -> Result a
Failed [String]
xs
data Config = Config
{
Config -> Text -> Text -> Bool
configPatternChecker :: Pattern -> Text -> Bool
, Config -> Definitions Schema
configDefinitions :: Definitions Schema
}
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config
{ configPatternChecker :: Text -> Text -> Bool
configPatternChecker = \Text
_pattern Text
_str -> Bool
True
, configDefinitions :: Definitions Schema
configDefinitions = forall a. Monoid a => a
mempty
}
newtype Validation s a = Validation { forall s a. Validation s a -> Config -> s -> Result a
runValidation :: Config -> s -> Result a }
deriving (forall a b. a -> Validation s b -> Validation s a
forall a b. (a -> b) -> Validation s a -> Validation s b
forall s a b. a -> Validation s b -> Validation s a
forall s a b. (a -> b) -> Validation s a -> Validation s b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
<$ :: forall a b. a -> Validation s b -> Validation s a
$c<$ :: forall s a b. a -> Validation s b -> Validation s a
fmap :: forall a b. (a -> b) -> Validation s a -> Validation s b
$cfmap :: forall s a b. (a -> b) -> Validation s a -> Validation s b
Functor)
instance Applicative (Validation schema) where
pure :: forall a. a -> Validation schema a
pure a
x = forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\Config
_ schema
_ -> forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
Validation Config -> schema -> Result (a -> b)
f <*> :: forall a b.
Validation schema (a -> b)
-> Validation schema a -> Validation schema b
<*> Validation Config -> schema -> Result a
x = forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\Config
c schema
s -> Config -> schema -> Result (a -> b)
f Config
c schema
s forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Config -> schema -> Result a
x Config
c schema
s)
instance Alternative (Validation schema) where
empty :: forall a. Validation schema a
empty = forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\Config
_ schema
_ -> forall (f :: * -> *) a. Alternative f => f a
empty)
Validation Config -> schema -> Result a
x <|> :: forall a.
Validation schema a -> Validation schema a -> Validation schema a
<|> Validation Config -> schema -> Result a
y = forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\Config
c schema
s -> Config -> schema -> Result a
x Config
c schema
s forall (f :: * -> *) a. Alternative f => f a -> f a -> f a
<|> Config -> schema -> Result a
y Config
c schema
s)
instance Profunctor Validation where
dimap :: forall a b c d.
(a -> b) -> (c -> d) -> Validation b c -> Validation a d
dimap a -> b
f c -> d
g (Validation Config -> b -> Result c
k) = forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\Config
c a
s -> forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap c -> d
g (Config -> b -> Result c
k Config
c (a -> b
f a
s)))
instance Choice Validation where
left' :: forall a b c.
Validation a b -> Validation (Either a c) (Either b c)
left' (Validation Config -> a -> Result b
g) = forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\Config
c -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. a -> Either a b
Left forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> a -> Result b
g Config
c) (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. b -> Either a b
Right))
right' :: forall a b c.
Validation a b -> Validation (Either c a) (Either c b)
right' (Validation Config -> a -> Result b
g) = forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\Config
c -> forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (forall (f :: * -> *) a. Applicative f => a -> f a
pure forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> Either a b
Left) (forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a b. b -> Either a b
Right forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> a -> Result b
g Config
c))
instance Monad (Validation s) where
return :: forall a. a -> Validation s a
return = forall (f :: * -> *) a. Applicative f => a -> f a
pure
Validation Config -> s -> Result a
x >>= :: forall a b.
Validation s a -> (a -> Validation s b) -> Validation s b
>>= a -> Validation s b
f = forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\Config
c s
s -> Config -> s -> Result a
x Config
c s
s forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \a
y -> forall s a. Validation s a -> Config -> s -> Result a
runValidation (a -> Validation s b
f a
y) Config
c s
s)
>> :: forall a b. Validation s a -> Validation s b -> Validation s b
(>>) = forall (f :: * -> *) a b. Applicative f => f a -> f b -> f b
(*>)
withConfig :: (Config -> Validation s a) -> Validation s a
withConfig :: forall s a. (Config -> Validation s a) -> Validation s a
withConfig Config -> Validation s a
f = forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\Config
c -> forall s a. Validation s a -> Config -> s -> Result a
runValidation (Config -> Validation s a
f Config
c) Config
c)
withSchema :: (s -> Validation s a) -> Validation s a
withSchema :: forall s a. (s -> Validation s a) -> Validation s a
withSchema s -> Validation s a
f = forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\Config
c s
s -> forall s a. Validation s a -> Config -> s -> Result a
runValidation (s -> Validation s a
f s
s) Config
c s
s)
invalid :: String -> Validation schema a
invalid :: forall schema a. String -> Validation schema a
invalid String
msg = forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\Config
_ schema
_ -> forall a. [String] -> Result a
Failed [String
msg])
valid :: Validation schema ()
valid :: forall schema. Validation schema ()
valid = forall (f :: * -> *) a. Applicative f => a -> f a
pure ()
checkMissing :: Validation s () -> Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
checkMissing :: forall s a.
Validation s ()
-> Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
checkMissing Validation s ()
missing Lens' s (Maybe a)
l a -> Validation s ()
g = forall s a. (s -> Validation s a) -> Validation s a
withSchema forall a b. (a -> b) -> a -> b
$ \s
sch ->
case s
sch forall s a. s -> Getting a s a -> a
^. Lens' s (Maybe a)
l of
Maybe a
Nothing -> Validation s ()
missing
Just a
x -> a -> Validation s ()
g a
x
check :: Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check :: forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check = forall s a.
Validation s ()
-> Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
checkMissing forall schema. Validation schema ()
valid
sub :: t -> Validation t a -> Validation s a
sub :: forall t a s. t -> Validation t a -> Validation s a
sub = forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. a -> b -> a
const
sub_ :: Getting a s a -> Validation a r -> Validation s r
sub_ :: forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ = forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view
withRef :: Reference -> (Schema -> Validation s a) -> Validation s a
withRef :: forall s a.
Reference -> (Schema -> Validation s a) -> Validation s a
withRef (Reference Text
ref) Schema -> Validation s a
f = forall s a. (Config -> Validation s a) -> Validation s a
withConfig forall a b. (a -> b) -> a -> b
$ \Config
cfg ->
case forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup Text
ref (Config -> Definitions Schema
configDefinitions Config
cfg) of
Maybe Schema
Nothing -> forall schema a. String -> Validation schema a
invalid forall a b. (a -> b) -> a -> b
$ String
"unknown schema " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
ref
Just Schema
s -> Schema -> Validation s a
f Schema
s
validateWithSchemaRef :: Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef :: forall s. Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef (Ref Reference
ref) Value
js = forall s a.
Reference -> (Schema -> Validation s a) -> Validation s a
withRef Reference
ref forall a b. (a -> b) -> a -> b
$ \Schema
sch -> forall t a s. t -> Validation t a -> Validation s a
sub Schema
sch (Value -> Validation Schema ()
validateWithSchema Value
js)
validateWithSchemaRef (Inline Schema
s) Value
js = forall t a s. t -> Validation t a -> Validation s a
sub Schema
s (Value -> Validation Schema ()
validateWithSchema Value
js)
validateWithSchema :: Value -> Validation Schema ()
validateWithSchema :: Value -> Validation Schema ()
validateWithSchema Value
value = do
Value -> Validation Schema ()
validateSchemaType Value
value
forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ forall s a. HasParamSchema s a => Lens' s a
paramSchema forall a b. (a -> b) -> a -> b
$ forall (t :: SwaggerKind (*)).
Value -> Validation (ParamSchema t) ()
validateEnum Value
value
validateWithParamSchema :: Value -> Validation (ParamSchema t) ()
validateWithParamSchema :: forall (t :: SwaggerKind (*)).
Value -> Validation (ParamSchema t) ()
validateWithParamSchema Value
value = do
forall (t :: SwaggerKind (*)).
Value -> Validation (ParamSchema t) ()
validateParamSchemaType Value
value
forall (t :: SwaggerKind (*)).
Value -> Validation (ParamSchema t) ()
validateEnum Value
value
validateInteger :: Scientific -> Validation (ParamSchema t) ()
validateInteger :: forall (t :: SwaggerKind (*)).
Scientific -> Validation (ParamSchema t) ()
validateInteger Scientific
n = do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Scientific -> Bool
isInteger Scientific
n)) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"not an integer")
forall (t :: SwaggerKind (*)).
Scientific -> Validation (ParamSchema t) ()
validateNumber Scientific
n
validateNumber :: Scientific -> Validation (ParamSchema t) ()
validateNumber :: forall (t :: SwaggerKind (*)).
Scientific -> Validation (ParamSchema t) ()
validateNumber Scientific
n = forall s a. (Config -> Validation s a) -> Validation s a
withConfig forall a b. (a -> b) -> a -> b
$ \Config
_cfg -> forall s a. (s -> Validation s a) -> Validation s a
withSchema forall a b. (a -> b) -> a -> b
$ \ParamSchema t
sch -> do
let exMax :: Bool
exMax = forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== ParamSchema t
sch forall s a. s -> Getting a s a -> a
^. forall s a. HasExclusiveMaximum s a => Lens' s a
exclusiveMaximum
exMin :: Bool
exMin = forall a. a -> Maybe a
Just Bool
True forall a. Eq a => a -> a -> Bool
== ParamSchema t
sch forall s a. s -> Getting a s a -> a
^. forall s a. HasExclusiveMinimum s a => Lens' s a
exclusiveMinimum
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMaximum s a => Lens' s a
maximum_ forall a b. (a -> b) -> a -> b
$ \Scientific
m ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (if Bool
exMax then (Scientific
n forall a. Ord a => a -> a -> Bool
>= Scientific
m) else (Scientific
n forall a. Ord a => a -> a -> Bool
> Scientific
m)) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Scientific
n forall a. [a] -> [a] -> [a]
++ String
" exceeds maximum (should be " forall a. [a] -> [a] -> [a]
++ if Bool
exMax then String
"<" else String
"<=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Scientific
m forall a. [a] -> [a] -> [a]
++ String
")")
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMinimum s a => Lens' s a
minimum_ forall a b. (a -> b) -> a -> b
$ \Scientific
m ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (if Bool
exMin then (Scientific
n forall a. Ord a => a -> a -> Bool
<= Scientific
m) else (Scientific
n forall a. Ord a => a -> a -> Bool
< Scientific
m)) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"value " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Scientific
n forall a. [a] -> [a] -> [a]
++ String
" falls below minimum (should be " forall a. [a] -> [a] -> [a]
++ if Bool
exMin then String
">" else String
">=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Scientific
m forall a. [a] -> [a] -> [a]
++ String
")")
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMultipleOf s a => Lens' s a
multipleOf forall a b. (a -> b) -> a -> b
$ \Scientific
k ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Scientific -> Bool
isInteger (Scientific
n forall a. Fractional a => a -> a -> a
/ Scientific
k))) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"expected a multiple of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Scientific
k forall a. [a] -> [a] -> [a]
++ String
" but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Scientific
n)
validateString :: Text -> Validation (ParamSchema t) ()
validateString :: forall (t :: SwaggerKind (*)).
Text -> Validation (ParamSchema t) ()
validateString Text
s = do
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMaxLength s a => Lens' s a
maxLength forall a b. (a -> b) -> a -> b
$ \Integer
n ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Ord a => a -> a -> Bool
> forall a. Num a => Integer -> a
fromInteger Integer
n) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"string is too long (length should be <=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
n forall a. [a] -> [a] -> [a]
++ String
")")
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMinLength s a => Lens' s a
minLength forall a b. (a -> b) -> a -> b
$ \Integer
n ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Ord a => a -> a -> Bool
< forall a. Num a => Integer -> a
fromInteger Integer
n) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"string is too short (length should be >=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
n forall a. [a] -> [a] -> [a]
++ String
")")
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasPattern s a => Lens' s a
pattern forall a b. (a -> b) -> a -> b
$ \Text
regex -> do
forall s a. (Config -> Validation s a) -> Validation s a
withConfig forall a b. (a -> b) -> a -> b
$ \Config
cfg -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Config -> Text -> Text -> Bool
configPatternChecker Config
cfg Text
regex Text
s)) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"string does not match pattern " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
regex)
where
len :: Int
len = Text -> Int
Text.length Text
s
validateArray :: Vector Value -> Validation (ParamSchema t) ()
validateArray :: forall (t :: SwaggerKind (*)).
Vector Value -> Validation (ParamSchema t) ()
validateArray Vector Value
xs = do
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMaxItems s a => Lens' s a
maxItems forall a b. (a -> b) -> a -> b
$ \Integer
n ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Ord a => a -> a -> Bool
> forall a. Num a => Integer -> a
fromInteger Integer
n) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"array exceeds maximum size (should be <=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
n forall a. [a] -> [a] -> [a]
++ String
")")
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMinItems s a => Lens' s a
minItems forall a b. (a -> b) -> a -> b
$ \Integer
n ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Ord a => a -> a -> Bool
< forall a. Num a => Integer -> a
fromInteger Integer
n) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"array is too short (size should be >=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
n forall a. [a] -> [a] -> [a]
++ String
")")
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasItems s a => Lens' s a
items forall a b. (a -> b) -> a -> b
$ \case
SwaggerItemsPrimitive Maybe (CollectionFormat t)
_ ParamSchema t
itemSchema -> forall t a s. t -> Validation t a -> Validation s a
sub ParamSchema t
itemSchema forall a b. (a -> b) -> a -> b
$ forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ forall (t :: SwaggerKind (*)).
Value -> Validation (ParamSchema t) ()
validateWithParamSchema Vector Value
xs
SwaggerItemsObject Referenced Schema
itemSchema -> forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (forall s. Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef Referenced Schema
itemSchema) Vector Value
xs
SwaggerItemsArray [Referenced Schema]
itemSchemas -> do
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len forall a. Eq a => a -> a -> Bool
/= forall (t :: * -> *) a. Foldable t => t a -> Int
length [Referenced Schema]
itemSchemas) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"array size is invalid (should be exactly " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) a. Foldable t => t a -> Int
length [Referenced Schema]
itemSchemas) forall a. [a] -> [a] -> [a]
++ String
")")
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ (forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith forall s. Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef [Referenced Schema]
itemSchemas (forall a. Vector a -> [a]
Vector.toList Vector Value
xs))
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasUniqueItems s a => Lens' s a
uniqueItems forall a b. (a -> b) -> a -> b
$ \Bool
unique ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
unique Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
allUnique) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"array is expected to contain unique items, but it does not")
where
len :: Int
len = forall a. Vector a -> Int
Vector.length Vector Value
xs
allUnique :: Bool
allUnique = Int
len forall a. Eq a => a -> a -> Bool
== forall a. HashSet a -> Int
HashSet.size (forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList (forall a. Vector a -> [a]
Vector.toList Vector Value
xs))
validateObject :: HashMap Text Value -> Validation Schema ()
validateObject :: HashMap Text Value -> Validation Schema ()
validateObject HashMap Text Value
o = forall s a. (s -> Validation s a) -> Validation s a
withSchema forall a b. (a -> b) -> a -> b
$ \Schema
sch ->
case Schema
sch forall s a. s -> Getting a s a -> a
^. forall s a. HasDiscriminator s a => Lens' s a
discriminator of
Just Text
pname -> case forall a. FromJSON a => Value -> Result a
fromJSON forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Text
pname HashMap Text Value
o of
Just (Success Referenced Schema
ref) -> forall s. Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef Referenced Schema
ref (Object -> Value
Object forall a b. (a -> b) -> a -> b
$ forall v. HashMap Text v -> KeyMap v
KM.fromHashMapText HashMap Text Value
o)
Just (Error String
msg) -> forall schema a. String -> Validation schema a
invalid (String
"failed to parse discriminator property " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
pname forall a. [a] -> [a] -> [a]
++ String
": " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show String
msg)
Maybe (Result (Referenced Schema))
Nothing -> forall schema a. String -> Validation schema a
invalid (String
"discriminator property " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
pname forall a. [a] -> [a] -> [a]
++ String
"is missing")
Maybe Text
Nothing -> do
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMaxProperties s a => Lens' s a
maxProperties forall a b. (a -> b) -> a -> b
$ \Integer
n ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
size forall a. Ord a => a -> a -> Bool
> Integer
n) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"object size exceeds maximum (total number of properties should be <=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
n forall a. [a] -> [a] -> [a]
++ String
")")
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMinProperties s a => Lens' s a
minProperties forall a b. (a -> b) -> a -> b
$ \Integer
n ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
size forall a. Ord a => a -> a -> Bool
< Integer
n) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"object size is too small (total number of properties should be >=" forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Integer
n forall a. [a] -> [a] -> [a]
++ String
")")
Validation Schema ()
validateRequired
Validation Schema ()
validateProps
where
size :: Integer
size = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall k v. HashMap k v -> Int
HashMap.size HashMap Text Value
o)
validateRequired :: Validation Schema ()
validateRequired = forall s a. (s -> Validation s a) -> Validation s a
withSchema forall a b. (a -> b) -> a -> b
$ \Schema
sch -> forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Text -> Validation Schema ()
validateReq (Schema
sch forall s a. s -> Getting a s a -> a
^. forall s a. HasRequired s a => Lens' s a
required)
validateReq :: Text -> Validation Schema ()
validateReq Text
n =
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Text
n HashMap Text Value
o)) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"property " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Text
n forall a. [a] -> [a] -> [a]
++ String
" is required, but not found in " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. ToJSON a => a -> ByteString
encode HashMap Text Value
o))
validateProps :: Validation Schema ()
validateProps = forall s a. (s -> Validation s a) -> Validation s a
withSchema forall a b. (a -> b) -> a -> b
$ \Schema
sch -> do
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Text Value
o) forall a b. (a -> b) -> a -> b
$ \(Text
k, Value
v) ->
case Value
v of
Value
Null | Bool -> Bool
not (Text
k forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Schema
sch forall s a. s -> Getting a s a -> a
^. forall s a. HasRequired s a => Lens' s a
required)) -> forall schema. Validation schema ()
valid
Value
_ ->
case forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup Text
k (Schema
sch forall s a. s -> Getting a s a -> a
^. forall s a. HasProperties s a => Lens' s a
properties) of
Maybe (Referenced Schema)
Nothing -> forall s a.
Validation s ()
-> Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
checkMissing (forall s a. Text -> Validation s a
unknownProperty Text
k) forall s a. HasAdditionalProperties s a => Lens' s a
additionalProperties forall a b. (a -> b) -> a -> b
$ forall {a} {schema}.
Show a =>
a -> Value -> AdditionalProperties -> Validation schema ()
validateAdditional Text
k Value
v
Just Referenced Schema
s -> forall s. Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef Referenced Schema
s Value
v
validateAdditional :: a -> Value -> AdditionalProperties -> Validation schema ()
validateAdditional a
_ Value
_ (AdditionalPropertiesAllowed Bool
True) = forall schema. Validation schema ()
valid
validateAdditional a
k Value
_ (AdditionalPropertiesAllowed Bool
False) = forall schema a. String -> Validation schema a
invalid forall a b. (a -> b) -> a -> b
$ String
"additionalProperties=false but extra property " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show a
k forall a. Semigroup a => a -> a -> a
<> String
" found"
validateAdditional a
_ Value
v (AdditionalPropertiesSchema Referenced Schema
s) = forall s. Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef Referenced Schema
s Value
v
unknownProperty :: Text -> Validation s a
unknownProperty :: forall s a. Text -> Validation s a
unknownProperty Text
pname = forall schema a. String -> Validation schema a
invalid forall a b. (a -> b) -> a -> b
$
String
"property " forall a. Semigroup a => a -> a -> a
<> forall a. Show a => a -> String
show Text
pname forall a. Semigroup a => a -> a -> a
<> String
" is found in JSON value, but it is not mentioned in Swagger schema"
validateEnum :: Value -> Validation (ParamSchema t) ()
validateEnum :: forall (t :: SwaggerKind (*)).
Value -> Validation (ParamSchema t) ()
validateEnum Value
value = do
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasEnum s a => Lens' s a
enum_ forall a b. (a -> b) -> a -> b
$ \[Value]
xs ->
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Value
value forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Value]
xs) forall a b. (a -> b) -> a -> b
$
forall schema a. String -> Validation schema a
invalid (String
"expected one of " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall a. ToJSON a => a -> ByteString
encode [Value]
xs) forall a. [a] -> [a] -> [a]
++ String
" but got " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Value
value)
inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]
inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]
inferSchemaTypes Schema
sch = forall (t :: SwaggerKind (*)). ParamSchema t -> [SwaggerType t]
inferParamSchemaTypes (Schema
sch forall s a. s -> Getting a s a -> a
^. forall s a. HasParamSchema s a => Lens' s a
paramSchema) forall a. [a] -> [a] -> [a]
++
[ SwaggerType 'SwaggerKindSchema
SwaggerObject | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b. (a -> b) -> a -> b
$ Schema
sch)
[ forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasAdditionalProperties s a => Lens' s a
additionalPropertiesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
, forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasMaxProperties s a => Lens' s a
maxPropertiesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
, forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasMinProperties s a => Lens' s a
minPropertiesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
, forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasProperties s a => Lens' s a
propertiesforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded)
, forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasRequired s a => Lens' s a
requiredforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded) ] ]
inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]
inferParamSchemaTypes :: forall (t :: SwaggerKind (*)). ParamSchema t -> [SwaggerType t]
inferParamSchemaTypes ParamSchema t
sch = forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
[ [ forall (t :: SwaggerKind (*)). SwaggerType t
SwaggerArray | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b. (a -> b) -> a -> b
$ ParamSchema t
sch)
[ forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasItems s a => Lens' s a
itemsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
, forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasMaxItems s a => Lens' s a
maxItemsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
, forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasMinItems s a => Lens' s a
minItemsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
, forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasUniqueItems s a => Lens' s a
uniqueItemsforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just) ] ]
, [ forall (t :: SwaggerKind (*)). SwaggerType t
SwaggerInteger | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b. (a -> b) -> a -> b
$ ParamSchema t
sch)
[ forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasExclusiveMaximum s a => Lens' s a
exclusiveMaximumforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
, forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasExclusiveMinimum s a => Lens' s a
exclusiveMinimumforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
, forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasMaximum s a => Lens' s a
maximum_forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
, forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasMinimum s a => Lens' s a
minimum_forall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
, forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasMultipleOf s a => Lens' s a
multipleOfforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just) ] ]
, [ forall (t :: SwaggerKind (*)). SwaggerType t
SwaggerString | forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (forall a b. (a -> b) -> a -> b
$ ParamSchema t
sch)
[ forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasMaxLength s a => Lens' s a
maxLengthforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
, forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasMinLength s a => Lens' s a
minLengthforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
, forall s a. Getting Any s a -> s -> Bool
has (forall s a. HasPattern s a => Lens' s a
patternforall b c a. (b -> c) -> (a -> b) -> a -> c
.forall a b. Prism (Maybe a) (Maybe b) a b
_Just) ] ]
]
validateSchemaType :: Value -> Validation Schema ()
validateSchemaType :: Value -> Validation Schema ()
validateSchemaType Value
value = forall s a. (s -> Validation s a) -> Validation s a
withSchema forall a b. (a -> b) -> a -> b
$ \Schema
sch ->
case (Schema
sch forall s a. s -> Getting a s a -> a
^. forall s a. HasType s a => Lens' s a
type_, Value
value) of
(Just SwaggerType 'SwaggerKindSchema
SwaggerNull, Value
Null) -> forall schema. Validation schema ()
valid
(Just SwaggerType 'SwaggerKindSchema
SwaggerBoolean, Bool Bool
_) -> forall schema. Validation schema ()
valid
(Just SwaggerType 'SwaggerKindSchema
SwaggerInteger, Number Scientific
n) -> forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ forall s a. HasParamSchema s a => Lens' s a
paramSchema (forall (t :: SwaggerKind (*)).
Scientific -> Validation (ParamSchema t) ()
validateInteger Scientific
n)
(Just SwaggerType 'SwaggerKindSchema
SwaggerNumber, Number Scientific
n) -> forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ forall s a. HasParamSchema s a => Lens' s a
paramSchema (forall (t :: SwaggerKind (*)).
Scientific -> Validation (ParamSchema t) ()
validateNumber Scientific
n)
(Just SwaggerType 'SwaggerKindSchema
SwaggerString, String Text
s) -> forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ forall s a. HasParamSchema s a => Lens' s a
paramSchema (forall (t :: SwaggerKind (*)).
Text -> Validation (ParamSchema t) ()
validateString Text
s)
(Just SwaggerType 'SwaggerKindSchema
SwaggerArray, Array Vector Value
xs) -> forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ forall s a. HasParamSchema s a => Lens' s a
paramSchema (forall (t :: SwaggerKind (*)).
Vector Value -> Validation (ParamSchema t) ()
validateArray Vector Value
xs)
(Just SwaggerType 'SwaggerKindSchema
SwaggerObject, Object Object
o) -> HashMap Text Value -> Validation Schema ()
validateObject forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> HashMap Text v
KM.toHashMapText Object
o
(Maybe (SwaggerType 'SwaggerKindSchema)
Nothing, Value
Null) -> forall schema. Validation schema ()
valid
(Maybe (SwaggerType 'SwaggerKindSchema)
Nothing, Bool Bool
_) -> forall schema. Validation schema ()
valid
(Maybe (SwaggerType 'SwaggerKindSchema)
Nothing, Number Scientific
n) -> forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ forall s a. HasParamSchema s a => Lens' s a
paramSchema (forall (t :: SwaggerKind (*)).
Scientific -> Validation (ParamSchema t) ()
validateNumber Scientific
n)
(Maybe (SwaggerType 'SwaggerKindSchema)
Nothing, String Text
s) -> forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ forall s a. HasParamSchema s a => Lens' s a
paramSchema (forall (t :: SwaggerKind (*)).
Text -> Validation (ParamSchema t) ()
validateString Text
s)
(Maybe (SwaggerType 'SwaggerKindSchema)
Nothing, Array Vector Value
xs) -> forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ forall s a. HasParamSchema s a => Lens' s a
paramSchema (forall (t :: SwaggerKind (*)).
Vector Value -> Validation (ParamSchema t) ()
validateArray Vector Value
xs)
(Maybe (SwaggerType 'SwaggerKindSchema)
Nothing, Object Object
o) -> HashMap Text Value -> Validation Schema ()
validateObject forall a b. (a -> b) -> a -> b
$ forall v. KeyMap v -> HashMap Text v
KM.toHashMapText Object
o
(Maybe (SwaggerType 'SwaggerKindSchema), Value)
bad -> forall schema a. String -> Validation schema a
invalid forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
[ [String] -> String
unwords [String
"expected JSON value of type", forall (t :: SwaggerKind (*)).
(Maybe (SwaggerType t), Value) -> String
showType (Maybe (SwaggerType 'SwaggerKindSchema), Value)
bad]
, String
" with context:"
, String
" " forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords [String
"SwaggerType:", forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> a
fst (Maybe (SwaggerType 'SwaggerKindSchema), Value)
bad]
, String
" " forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords [String
"Aeson Value:", forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ forall a b. (a, b) -> b
snd (Maybe (SwaggerType 'SwaggerKindSchema), Value)
bad]
, String
" " forall a. Semigroup a => a -> a -> a
<> [String] -> String
unwords [String
"Schema title:", forall a. Show a => a -> String
show forall a b. (a -> b) -> a -> b
$ Schema
sch forall s a. s -> Getting a s a -> a
^. forall s a. HasTitle s a => Lens' s a
title]
]
validateParamSchemaType :: Value -> Validation (ParamSchema t) ()
validateParamSchemaType :: forall (t :: SwaggerKind (*)).
Value -> Validation (ParamSchema t) ()
validateParamSchemaType Value
value = forall s a. (s -> Validation s a) -> Validation s a
withSchema forall a b. (a -> b) -> a -> b
$ \ParamSchema t
sch ->
case (ParamSchema t
sch forall s a. s -> Getting a s a -> a
^. forall s a. HasType s a => Lens' s a
type_, Value
value) of
(Just SwaggerType t
SwaggerBoolean, Bool Bool
_) -> forall schema. Validation schema ()
valid
(Just SwaggerType t
SwaggerInteger, Number Scientific
n) -> forall (t :: SwaggerKind (*)).
Scientific -> Validation (ParamSchema t) ()
validateInteger Scientific
n
(Just SwaggerType t
SwaggerNumber, Number Scientific
n) -> forall (t :: SwaggerKind (*)).
Scientific -> Validation (ParamSchema t) ()
validateNumber Scientific
n
(Just SwaggerType t
SwaggerString, String Text
s) -> forall (t :: SwaggerKind (*)).
Text -> Validation (ParamSchema t) ()
validateString Text
s
(Just SwaggerType t
SwaggerArray, Array Vector Value
xs) -> forall (t :: SwaggerKind (*)).
Vector Value -> Validation (ParamSchema t) ()
validateArray Vector Value
xs
(Maybe (SwaggerType t)
Nothing, Bool Bool
_) -> forall schema. Validation schema ()
valid
(Maybe (SwaggerType t)
Nothing, Number Scientific
n) -> forall (t :: SwaggerKind (*)).
Scientific -> Validation (ParamSchema t) ()
validateNumber Scientific
n
(Maybe (SwaggerType t)
Nothing, String Text
s) -> forall (t :: SwaggerKind (*)).
Text -> Validation (ParamSchema t) ()
validateString Text
s
(Maybe (SwaggerType t)
Nothing, Array Vector Value
xs) -> forall (t :: SwaggerKind (*)).
Vector Value -> Validation (ParamSchema t) ()
validateArray Vector Value
xs
(Maybe (SwaggerType t), Value)
bad -> forall schema a. String -> Validation schema a
invalid forall a b. (a -> b) -> a -> b
$ String
"expected JSON value of type " forall a. [a] -> [a] -> [a]
++ forall (t :: SwaggerKind (*)).
(Maybe (SwaggerType t), Value) -> String
showType (Maybe (SwaggerType t), Value)
bad
showType :: (Maybe (SwaggerType t), Value) -> String
showType :: forall (t :: SwaggerKind (*)).
(Maybe (SwaggerType t), Value) -> String
showType (Just SwaggerType t
ty, Value
_) = forall a. Show a => a -> String
show SwaggerType t
ty
showType (Maybe (SwaggerType t)
Nothing, Value
Null) = String
"SwaggerNull"
showType (Maybe (SwaggerType t)
Nothing, Bool Bool
_) = String
"SwaggerBoolean"
showType (Maybe (SwaggerType t)
Nothing, Number Scientific
_) = String
"SwaggerNumber"
showType (Maybe (SwaggerType t)
Nothing, String Text
_) = String
"SwaggerString"
showType (Maybe (SwaggerType t)
Nothing, Array Vector Value
_) = String
"SwaggerArray"
showType (Maybe (SwaggerType t)
Nothing, Object Object
_) = String
"SwaggerObject"