{-# 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
-- Copyright:   (c) 2015 GetShopTV
-- License:     BSD3
-- Maintainer:  Nickolay Kudasov <nickolay@getshoptv.com>
-- Stability:   experimental
--
-- Validate JSON values with Swagger Schema.
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

-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
-- This can be used with QuickCheck to ensure those instances are coherent:
--
-- prop> validateToJSON (x :: Int) == []
--
-- /NOTE:/ @'validateToJSON'@ does not perform string pattern validation.
-- See @'validateToJSONWithPatternChecker'@.
--
-- See 'renderValidationErrors' on how the output is structured.
validatePrettyToJSON :: forall a. (ToJSON a, ToSchema a) => a -> Maybe String
validatePrettyToJSON :: a -> Maybe String
validatePrettyToJSON = (a -> [String]) -> a -> Maybe String
forall a.
(ToJSON a, ToSchema a) =>
(a -> [String]) -> a -> Maybe String
renderValidationErrors a -> [String]
forall a. (ToJSON a, ToSchema a) => a -> [String]
validateToJSON

-- | Variant of 'validatePrettyToJSON' with typed output.
validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [ValidationError]
validateToJSON :: a -> [String]
validateToJSON = (Pattern -> Pattern -> Bool) -> a -> [String]
forall a.
(ToJSON a, ToSchema a) =>
(Pattern -> Pattern -> Bool) -> a -> [String]
validateToJSONWithPatternChecker (\_pattern :: Pattern
_pattern _str :: Pattern
_str -> Bool
True)

-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value and pattern checker.
-- This can be used with QuickCheck to ensure those instances are coherent.
--
-- For validation without patterns see @'validateToJSON'@.  See also:
-- 'renderValidationErrors'.
validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) => (Pattern -> Text -> Bool) -> a -> [ValidationError]
validateToJSONWithPatternChecker :: (Pattern -> Pattern -> Bool) -> a -> [String]
validateToJSONWithPatternChecker checker :: Pattern -> Pattern -> Bool
checker = (Pattern -> Pattern -> Bool)
-> Definitions Schema -> Schema -> Value -> [String]
validateJSONWithPatternChecker Pattern -> Pattern -> Bool
checker Definitions Schema
defs Schema
sch (Value -> [String]) -> (a -> Value) -> a -> [String]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> Value
forall a. ToJSON a => a -> Value
toJSON
  where
    (defs :: Definitions Schema
defs, sch :: Schema
sch) = Declare (Definitions Schema) Schema
-> Definitions Schema -> (Definitions Schema, Schema)
forall d a. Declare d a -> d -> (d, a)
runDeclare (Proxy a -> Declare (Definitions Schema) Schema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
declareSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) Definitions Schema
forall a. Monoid a => a
mempty

-- | Pretty print validation errors
-- together with actual JSON and Swagger Schema
-- (using 'encodePretty').
--
-- >>> import Data.Aeson as Aeson
-- >>> import Data.Foldable (traverse_)
-- >>> import GHC.Generics
-- >>> data Phone = Phone { value :: String } deriving (Generic)
-- >>> data Person = Person { name :: String, phone :: Phone } deriving (Generic)
-- >>> instance ToJSON Person where toJSON p = object [ "name" Aeson..= name p ]
-- >>> instance ToSchema Phone
-- >>> instance ToSchema Person
-- >>> let person = Person { name = "John", phone = Phone "123456" }
-- >>> traverse_ putStrLn $ renderValidationErrors validateToJSON person
-- Validation against the schema fails:
--   * property "phone" is required, but not found in "{\"name\":\"John\"}"
-- <BLANKLINE>
-- JSON value:
-- {
--     "name": "John"
-- }
-- <BLANKLINE>
-- Swagger Schema:
-- {
--     "properties": {
--         "name": {
--             "type": "string"
--         },
--         "phone": {
--             "$ref": "#/definitions/Phone"
--         }
--     },
--     "required": [
--         "name",
--         "phone"
--     ],
--     "type": "object"
-- }
-- <BLANKLINE>
-- Swagger Description Context:
-- {
--     "Phone": {
--         "properties": {
--             "value": {
--                 "type": "string"
--             }
--         },
--         "required": [
--             "value"
--         ],
--         "type": "object"
--     }
-- }
-- <BLANKLINE>
renderValidationErrors
  :: forall a. (ToJSON a, ToSchema a)
  => (a -> [ValidationError]) -> a -> Maybe String
renderValidationErrors :: (a -> [String]) -> a -> Maybe String
renderValidationErrors f :: a -> [String]
f x :: a
x =
  case a -> [String]
f a
x of
    []      -> Maybe String
forall a. Maybe a
Nothing
    errors :: [String]
errors  -> String -> Maybe String
forall a. a -> Maybe a
Just (String -> Maybe String) -> String -> Maybe String
forall a b. (a -> b) -> a -> b
$ [String] -> String
unlines
      [ "Validation against the schema fails:"
      , [String] -> String
unlines ((String -> String) -> [String] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map ("  * " String -> String -> String
forall a. [a] -> [a] -> [a]
++) [String]
errors)
      , "JSON value:"
      , Value -> String
ppJSONString (a -> Value
forall a. ToJSON a => a -> Value
toJSON a
x)
      , ""
      , "Swagger Schema:"
      , Value -> String
ppJSONString (Schema -> Value
forall a. ToJSON a => a -> Value
toJSON Schema
schema_)
      , ""
      , "Swagger Description Context:"
      , Value -> String
ppJSONString (Definitions Schema -> Value
forall a. ToJSON a => a -> Value
toJSON Definitions Schema
refs_)
      ]
  where
    ppJSONString :: Value -> String
ppJSONString = Text -> String
TL.unpack (Text -> String) -> (Value -> Text) -> Value -> String
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Text
TL.decodeUtf8 (ByteString -> Text) -> (Value -> ByteString) -> Value -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> ByteString
forall a. ToJSON a => a -> ByteString
encodePretty
    (refs_ :: Definitions Schema
refs_, schema_ :: Schema
schema_) = Declare (Definitions Schema) Schema
-> Definitions Schema -> (Definitions Schema, Schema)
forall d a. Declare d a -> d -> (d, a)
runDeclare (Proxy a -> Declare (Definitions Schema) Schema
forall a.
ToSchema a =>
Proxy a -> Declare (Definitions Schema) Schema
declareSchema (Proxy a
forall k (t :: k). Proxy t
Proxy :: Proxy a)) Definitions Schema
forall a. Monoid a => a
mempty

-- | Validate JSON @'Value'@ against Swagger @'Schema'@.
--
-- prop> validateJSON mempty (toSchema (Proxy :: Proxy Int)) (toJSON (x :: Int)) == []
--
-- /NOTE:/ @'validateJSON'@ does not perform string pattern validation.
-- See @'validateJSONWithPatternChecker'@.
validateJSON :: Definitions Schema -> Schema -> Value -> [ValidationError]
validateJSON :: Definitions Schema -> Schema -> Value -> [String]
validateJSON = (Pattern -> Pattern -> Bool)
-> Definitions Schema -> Schema -> Value -> [String]
validateJSONWithPatternChecker (\_pattern :: Pattern
_pattern _str :: Pattern
_str -> Bool
True)

-- | Validate JSON @'Value'@ agains Swagger @'ToSchema'@ for a given value and pattern checker.
--
-- For validation without patterns see @'validateJSON'@.
validateJSONWithPatternChecker :: (Pattern -> Text -> Bool) -> Definitions Schema -> Schema -> Value -> [ValidationError]
validateJSONWithPatternChecker :: (Pattern -> Pattern -> Bool)
-> Definitions Schema -> Schema -> Value -> [String]
validateJSONWithPatternChecker checker :: Pattern -> Pattern -> Bool
checker defs :: Definitions Schema
defs sch :: Schema
sch js :: Value
js =
  case Validation Schema () -> Config -> Schema -> Result ()
forall s a. Validation s a -> Config -> s -> Result a
runValidation (Value -> Validation Schema ()
validateWithSchema Value
js) Config
cfg Schema
sch of
    Failed xs :: [String]
xs -> [String]
xs
    Passed _  -> [String]
forall a. Monoid a => a
mempty
  where
    cfg :: Config
cfg = Config
defaultConfig
            { configPatternChecker :: Pattern -> Pattern -> Bool
configPatternChecker = Pattern -> Pattern -> Bool
checker
            , configDefinitions :: Definitions Schema
configDefinitions = Definitions Schema
defs }

-- | Validation error message.
type ValidationError = String

-- | Validation result type.
data Result a
  = Failed [ValidationError]  -- ^ Validation failed with a list of error messages.
  | Passed a                  -- ^ Validation passed.
  deriving (Result a -> Result a -> Bool
(Result a -> Result a -> Bool)
-> (Result a -> Result a -> Bool) -> Eq (Result a)
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
[Result a] -> String -> String
Result a -> String
(Int -> Result a -> String -> String)
-> (Result a -> String)
-> ([Result a] -> String -> String)
-> Show (Result a)
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, a -> Result b -> Result a
(a -> b) -> Result a -> Result b
(forall a b. (a -> b) -> Result a -> Result b)
-> (forall a b. a -> Result b -> Result a) -> Functor Result
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
<$ :: a -> Result b -> Result a
$c<$ :: forall a b. a -> Result b -> Result a
fmap :: (a -> b) -> Result a -> Result b
$cfmap :: forall a b. (a -> b) -> Result a -> Result b
Functor)

instance Applicative Result where
  pure :: a -> Result a
pure = a -> Result a
forall a. a -> Result a
Passed
  Passed f :: a -> b
f <*> :: Result (a -> b) -> Result a -> Result b
<*> Passed x :: a
x = b -> Result b
forall a. a -> Result a
Passed (a -> b
f a
x)
  Failed xs :: [String]
xs <*> Failed ys :: [String]
ys = [String] -> Result b
forall a. [String] -> Result a
Failed ([String]
xs [String] -> [String] -> [String]
forall a. Semigroup a => a -> a -> a
<> [String]
ys)
  Failed xs :: [String]
xs <*> _ = [String] -> Result b
forall a. [String] -> Result a
Failed [String]
xs
  _ <*> Failed ys :: [String]
ys = [String] -> Result b
forall a. [String] -> Result a
Failed [String]
ys

instance Alternative Result where
  empty :: Result a
empty = [String] -> Result a
forall a. [String] -> Result a
Failed [String]
forall a. Monoid a => a
mempty
  Passed x :: a
x <|> :: Result a -> Result a -> Result a
<|> _ = a -> Result a
forall a. a -> Result a
Passed a
x
  _        <|> y :: Result a
y = Result a
y

instance Monad Result where
  return :: a -> Result a
return = a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Passed x :: a
x >>= :: Result a -> (a -> Result b) -> Result b
>>=  f :: a -> Result b
f = a -> Result b
f a
x
  Failed xs :: [String]
xs >>= _ = [String] -> Result b
forall a. [String] -> Result a
Failed [String]
xs

-- | Validation configuration.
data Config = Config
  { -- | Pattern checker for @'_paramSchemaPattern'@ validation.
    Config -> Pattern -> Pattern -> Bool
configPatternChecker :: Pattern -> Text -> Bool
    -- | Schema definitions in scope to resolve references.
  , Config -> Definitions Schema
configDefinitions    :: Definitions Schema
  }

-- | Default @'Config'@:
--
-- @
-- defaultConfig = 'Config'
--   { 'configPatternChecker' = \\_pattern _str -> True
--   , 'configDefinitions'    = mempty
--   }
-- @
defaultConfig :: Config
defaultConfig :: Config
defaultConfig = Config :: (Pattern -> Pattern -> Bool) -> Definitions Schema -> Config
Config
  { configPatternChecker :: Pattern -> Pattern -> Bool
configPatternChecker = \_pattern :: Pattern
_pattern _str :: Pattern
_str -> Bool
True
  , configDefinitions :: Definitions Schema
configDefinitions    = Definitions Schema
forall a. Monoid a => a
mempty
  }

-- | Value validation.
newtype Validation s a = Validation { Validation s a -> Config -> s -> Result a
runValidation :: Config -> s -> Result a }
  deriving (a -> Validation s b -> Validation s a
(a -> b) -> Validation s a -> Validation s b
(forall a b. (a -> b) -> Validation s a -> Validation s b)
-> (forall a b. a -> Validation s b -> Validation s a)
-> Functor (Validation s)
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
<$ :: a -> Validation s b -> Validation s a
$c<$ :: forall s a b. a -> Validation s b -> Validation s a
fmap :: (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 :: a -> Validation schema a
pure x :: a
x = (Config -> schema -> Result a) -> Validation schema a
forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\_ _ -> a -> Result a
forall (f :: * -> *) a. Applicative f => a -> f a
pure a
x)
  Validation f :: Config -> schema -> Result (a -> b)
f <*> :: Validation schema (a -> b)
-> Validation schema a -> Validation schema b
<*> Validation x :: Config -> schema -> Result a
x = (Config -> schema -> Result b) -> Validation schema b
forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\c :: Config
c s :: schema
s -> Config -> schema -> Result (a -> b)
f Config
c schema
s Result (a -> b) -> Result a -> Result b
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 :: Validation schema a
empty = (Config -> schema -> Result a) -> Validation schema a
forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\_ _ -> Result a
forall (f :: * -> *) a. Alternative f => f a
empty)
  Validation x :: Config -> schema -> Result a
x <|> :: Validation schema a -> Validation schema a -> Validation schema a
<|> Validation y :: Config -> schema -> Result a
y = (Config -> schema -> Result a) -> Validation schema a
forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\c :: Config
c s :: schema
s -> Config -> schema -> Result a
x Config
c schema
s Result a -> Result a -> Result a
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 :: (a -> b) -> (c -> d) -> Validation b c -> Validation a d
dimap f :: a -> b
f g :: c -> d
g (Validation k :: Config -> b -> Result c
k) = (Config -> a -> Result d) -> Validation a d
forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\c :: Config
c s :: a
s -> (c -> d) -> Result c -> Result d
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' :: Validation a b -> Validation (Either a c) (Either b c)
left'  (Validation g :: Config -> a -> Result b
g) = (Config -> Either a c -> Result (Either b c))
-> Validation (Either a c) (Either b c)
forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\c :: Config
c -> (a -> Result (Either b c))
-> (c -> Result (Either b c)) -> Either a c -> Result (Either b c)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either ((b -> Either b c) -> Result b -> Result (Either b c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either b c
forall a b. a -> Either a b
Left (Result b -> Result (Either b c))
-> (a -> Result b) -> a -> Result (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> a -> Result b
g Config
c) (Either b c -> Result (Either b c)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either b c -> Result (Either b c))
-> (c -> Either b c) -> c -> Result (Either b c)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either b c
forall a b. b -> Either a b
Right))
  right' :: Validation a b -> Validation (Either c a) (Either c b)
right' (Validation g :: Config -> a -> Result b
g) = (Config -> Either c a -> Result (Either c b))
-> Validation (Either c a) (Either c b)
forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\c :: Config
c -> (c -> Result (Either c b))
-> (a -> Result (Either c b)) -> Either c a -> Result (Either c b)
forall a c b. (a -> c) -> (b -> c) -> Either a b -> c
either (Either c b -> Result (Either c b)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Either c b -> Result (Either c b))
-> (c -> Either c b) -> c -> Result (Either c b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. c -> Either c b
forall a b. a -> Either a b
Left) ((b -> Either c b) -> Result b -> Result (Either c b)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap b -> Either c b
forall a b. b -> Either a b
Right (Result b -> Result (Either c b))
-> (a -> Result b) -> a -> Result (Either c b)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Config -> a -> Result b
g Config
c))

instance Monad (Validation s) where
  return :: a -> Validation s a
return = a -> Validation s a
forall (f :: * -> *) a. Applicative f => a -> f a
pure
  Validation x :: Config -> s -> Result a
x >>= :: Validation s a -> (a -> Validation s b) -> Validation s b
>>= f :: a -> Validation s b
f = (Config -> s -> Result b) -> Validation s b
forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\c :: Config
c s :: s
s -> Config -> s -> Result a
x Config
c s
s Result a -> (a -> Result b) -> Result b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \y :: a
y -> Validation s b -> Config -> s -> Result b
forall s a. Validation s a -> Config -> s -> Result a
runValidation (a -> Validation s b
f a
y) Config
c s
s)
  >> :: Validation s a -> Validation s b -> Validation s 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 :: (Config -> Validation s a) -> Validation s a
withConfig f :: Config -> Validation s a
f = (Config -> s -> Result a) -> Validation s a
forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\c :: Config
c -> Validation s a -> Config -> s -> Result a
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 :: (s -> Validation s a) -> Validation s a
withSchema f :: s -> Validation s a
f = (Config -> s -> Result a) -> Validation s a
forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\c :: Config
c s :: s
s -> Validation s a -> Config -> s -> Result a
forall s a. Validation s a -> Config -> s -> Result a
runValidation (s -> Validation s a
f s
s) Config
c s
s)

-- | Issue an error message.
invalid :: String -> Validation schema a
invalid :: String -> Validation schema a
invalid msg :: String
msg = (Config -> schema -> Result a) -> Validation schema a
forall s a. (Config -> s -> Result a) -> Validation s a
Validation (\_ _ -> [String] -> Result a
forall a. [String] -> Result a
Failed [String
msg])

-- | Validation passed.
valid :: Validation schema ()
valid :: Validation schema ()
valid = () -> Validation schema ()
forall (f :: * -> *) a. Applicative f => a -> f a
pure ()

-- | Validate schema's property given a lens into that property
-- and property checker.
checkMissing :: Validation s () -> Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
checkMissing :: Validation s ()
-> Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
checkMissing missing :: Validation s ()
missing l :: Lens' s (Maybe a)
l g :: a -> Validation s ()
g = (s -> Validation s ()) -> Validation s ()
forall s a. (s -> Validation s a) -> Validation s a
withSchema ((s -> Validation s ()) -> Validation s ())
-> (s -> Validation s ()) -> Validation s ()
forall a b. (a -> b) -> a -> b
$ \sch :: s
sch ->
  case s
sch s -> Getting (Maybe a) s (Maybe a) -> Maybe a
forall s a. s -> Getting a s a -> a
^. Getting (Maybe a) s (Maybe a)
Lens' s (Maybe a)
l of
    Nothing -> Validation s ()
missing
    Just x :: a
x  -> a -> Validation s ()
g a
x

-- | Validate schema's property given a lens into that property
-- and property checker.
-- If property is missing in schema, consider it valid.
check :: Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check :: Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check = Validation s ()
-> Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
forall s a.
Validation s ()
-> Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
checkMissing Validation s ()
forall schema. Validation schema ()
valid

-- | Validate same value with different schema.
sub :: t -> Validation t a -> Validation s a
sub :: t -> Validation t a -> Validation s a
sub = (s -> t) -> Validation t a -> Validation s a
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap ((s -> t) -> Validation t a -> Validation s a)
-> (t -> s -> t) -> t -> Validation t a -> Validation s a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. t -> s -> t
forall a b. a -> b -> a
const

-- | Validate same value with a part of the original schema.
sub_ :: Getting a s a -> Validation a r -> Validation s r
sub_ :: Getting a s a -> Validation a r -> Validation s r
sub_ = (s -> a) -> Validation a r -> Validation s r
forall (p :: * -> * -> *) a b c.
Profunctor p =>
(a -> b) -> p b c -> p a c
lmap ((s -> a) -> Validation a r -> Validation s r)
-> (Getting a s a -> s -> a)
-> Getting a s a
-> Validation a r
-> Validation s r
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Getting a s a -> s -> a
forall s (m :: * -> *) a. MonadReader s m => Getting a s a -> m a
view

-- | Validate value against a schema given schema reference and validation function.
withRef :: Reference -> (Schema -> Validation s a) -> Validation s a
withRef :: Reference -> (Schema -> Validation s a) -> Validation s a
withRef (Reference ref :: Pattern
ref) f :: Schema -> Validation s a
f = (Config -> Validation s a) -> Validation s a
forall s a. (Config -> Validation s a) -> Validation s a
withConfig ((Config -> Validation s a) -> Validation s a)
-> (Config -> Validation s a) -> Validation s a
forall a b. (a -> b) -> a -> b
$ \cfg :: Config
cfg ->
  case Pattern -> Definitions Schema -> Maybe Schema
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup Pattern
ref (Config -> Definitions Schema
configDefinitions Config
cfg) of
    Nothing -> String -> Validation s a
forall schema a. String -> Validation schema a
invalid (String -> Validation s a) -> String -> Validation s a
forall a b. (a -> b) -> a -> b
$ "unknown schema " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Pattern -> String
forall a. Show a => a -> String
show Pattern
ref
    Just s :: Schema
s  -> Schema -> Validation s a
f Schema
s

validateWithSchemaRef :: Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef :: Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef (Ref ref :: Reference
ref)  js :: Value
js = Reference -> (Schema -> Validation s ()) -> Validation s ()
forall s a.
Reference -> (Schema -> Validation s a) -> Validation s a
withRef Reference
ref ((Schema -> Validation s ()) -> Validation s ())
-> (Schema -> Validation s ()) -> Validation s ()
forall a b. (a -> b) -> a -> b
$ \sch :: Schema
sch -> Schema -> Validation Schema () -> Validation s ()
forall t a s. t -> Validation t a -> Validation s a
sub Schema
sch (Value -> Validation Schema ()
validateWithSchema Value
js)
validateWithSchemaRef (Inline s :: Schema
s) js :: Value
js = Schema -> Validation Schema () -> Validation s ()
forall t a s. t -> Validation t a -> Validation s a
sub Schema
s (Value -> Validation Schema ()
validateWithSchema Value
js)

-- | Validate JSON @'Value'@ with Swagger @'Schema'@.
validateWithSchema :: Value -> Validation Schema ()
validateWithSchema :: Value -> Validation Schema ()
validateWithSchema value :: Value
value = do
  Value -> Validation Schema ()
validateSchemaType Value
value
  Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
-> Validation (ParamSchema 'SwaggerKindSchema) ()
-> Validation Schema ()
forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
forall s a. HasParamSchema s a => Lens' s a
paramSchema (Validation (ParamSchema 'SwaggerKindSchema) ()
 -> Validation Schema ())
-> Validation (ParamSchema 'SwaggerKindSchema) ()
-> Validation Schema ()
forall a b. (a -> b) -> a -> b
$ Value -> Validation (ParamSchema 'SwaggerKindSchema) ()
forall (t :: SwaggerKind *). Value -> Validation (ParamSchema t) ()
validateEnum Value
value

-- | Validate JSON @'Value'@ with Swagger @'ParamSchema'@.
validateWithParamSchema :: Value -> Validation (ParamSchema t) ()
validateWithParamSchema :: Value -> Validation (ParamSchema t) ()
validateWithParamSchema value :: Value
value = do
  Value -> Validation (ParamSchema t) ()
forall (t :: SwaggerKind *). Value -> Validation (ParamSchema t) ()
validateParamSchemaType Value
value
  Value -> Validation (ParamSchema t) ()
forall (t :: SwaggerKind *). Value -> Validation (ParamSchema t) ()
validateEnum Value
value

validateInteger :: Scientific -> Validation (ParamSchema t) ()
validateInteger :: Scientific -> Validation (ParamSchema t) ()
validateInteger n :: Scientific
n = do
  Bool
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Scientific -> Bool
isInteger Scientific
n)) (Validation (ParamSchema t) () -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$
    String -> Validation (ParamSchema t) ()
forall schema a. String -> Validation schema a
invalid ("not an integer")
  Scientific -> Validation (ParamSchema t) ()
forall (t :: SwaggerKind *).
Scientific -> Validation (ParamSchema t) ()
validateNumber Scientific
n

validateNumber :: Scientific -> Validation (ParamSchema t) ()
validateNumber :: Scientific -> Validation (ParamSchema t) ()
validateNumber n :: Scientific
n = (Config -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a. (Config -> Validation s a) -> Validation s a
withConfig ((Config -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (Config -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \_cfg :: Config
_cfg -> (ParamSchema t -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a. (s -> Validation s a) -> Validation s a
withSchema ((ParamSchema t -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (ParamSchema t -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \sch :: ParamSchema t
sch -> do
  let exMax :: Bool
exMax = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ParamSchema t
sch ParamSchema t
-> Getting (Maybe Bool) (ParamSchema t) (Maybe Bool) -> Maybe Bool
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Bool) (ParamSchema t) (Maybe Bool)
forall s a. HasExclusiveMaximum s a => Lens' s a
exclusiveMaximum
      exMin :: Bool
exMin = Bool -> Maybe Bool
forall a. a -> Maybe a
Just Bool
True Maybe Bool -> Maybe Bool -> Bool
forall a. Eq a => a -> a -> Bool
== ParamSchema t
sch ParamSchema t
-> Getting (Maybe Bool) (ParamSchema t) (Maybe Bool) -> Maybe Bool
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Bool) (ParamSchema t) (Maybe Bool)
forall s a. HasExclusiveMinimum s a => Lens' s a
exclusiveMinimum

  Lens' (ParamSchema t) (Maybe Scientific)
-> (Scientific -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMaximum s a => Lens' s a
Lens' (ParamSchema t) (Maybe Scientific)
maximum_ ((Scientific -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (Scientific -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \m :: Scientific
m ->
    Bool
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (if Bool
exMax then (Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
>= Scientific
m) else (Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
> Scientific
m)) (Validation (ParamSchema t) () -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$
      String -> Validation (ParamSchema t) ()
forall schema a. String -> Validation schema a
invalid ("value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ " exceeds maximum (should be " String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
exMax then "<" else "<=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")

  Lens' (ParamSchema t) (Maybe Scientific)
-> (Scientific -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMinimum s a => Lens' s a
Lens' (ParamSchema t) (Maybe Scientific)
minimum_ ((Scientific -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (Scientific -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \m :: Scientific
m ->
    Bool
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (if Bool
exMin then (Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
<= Scientific
m) else (Scientific
n Scientific -> Scientific -> Bool
forall a. Ord a => a -> a -> Bool
< Scientific
m)) (Validation (ParamSchema t) () -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$
      String -> Validation (ParamSchema t) ()
forall schema a. String -> Validation schema a
invalid ("value " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ " falls below minimum (should be " String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Bool
exMin then ">" else ">=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
m String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")

  Lens' (ParamSchema t) (Maybe Scientific)
-> (Scientific -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMultipleOf s a => Lens' s a
Lens' (ParamSchema t) (Maybe Scientific)
multipleOf ((Scientific -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (Scientific -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \k :: Scientific
k ->
    Bool
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Scientific -> Bool
isInteger (Scientific
n Scientific -> Scientific -> Scientific
forall a. Fractional a => a -> a -> a
/ Scientific
k))) (Validation (ParamSchema t) () -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$
      String -> Validation (ParamSchema t) ()
forall schema a. String -> Validation schema a
invalid ("expected a multiple of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
k String -> String -> String
forall a. [a] -> [a] -> [a]
++ " but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Scientific -> String
forall a. Show a => a -> String
show Scientific
n)

validateString :: Text -> Validation (ParamSchema t) ()
validateString :: Pattern -> Validation (ParamSchema t) ()
validateString s :: Pattern
s = do
  Lens' (ParamSchema t) (Maybe Integer)
-> (Integer -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMaxLength s a => Lens' s a
Lens' (ParamSchema t) (Maybe Integer)
maxLength ((Integer -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (Integer -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \n :: Integer
n ->
    Bool
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) (Validation (ParamSchema t) () -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$
      String -> Validation (ParamSchema t) ()
forall schema a. String -> Validation schema a
invalid ("string is too long (length should be <=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")

  Lens' (ParamSchema t) (Maybe Integer)
-> (Integer -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMinLength s a => Lens' s a
Lens' (ParamSchema t) (Maybe Integer)
minLength ((Integer -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (Integer -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \n :: Integer
n ->
    Bool
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) (Validation (ParamSchema t) () -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$
      String -> Validation (ParamSchema t) ()
forall schema a. String -> Validation schema a
invalid ("string is too short (length should be >=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")

  Lens' (ParamSchema t) (Maybe Pattern)
-> (Pattern -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasPattern s a => Lens' s a
Lens' (ParamSchema t) (Maybe Pattern)
pattern ((Pattern -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (Pattern -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \regex :: Pattern
regex -> do
    (Config -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a. (Config -> Validation s a) -> Validation s a
withConfig ((Config -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (Config -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \cfg :: Config
cfg -> do
      Bool
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Config -> Pattern -> Pattern -> Bool
configPatternChecker Config
cfg Pattern
regex Pattern
s)) (Validation (ParamSchema t) () -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$
        String -> Validation (ParamSchema t) ()
forall schema a. String -> Validation schema a
invalid ("string does not match pattern " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Pattern -> String
forall a. Show a => a -> String
show Pattern
regex)
  where
    len :: Int
len = Pattern -> Int
Text.length Pattern
s

validateArray :: Vector Value -> Validation (ParamSchema t) ()
validateArray :: Vector Value -> Validation (ParamSchema t) ()
validateArray xs :: Vector Value
xs = do
  Lens' (ParamSchema t) (Maybe Integer)
-> (Integer -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMaxItems s a => Lens' s a
Lens' (ParamSchema t) (Maybe Integer)
maxItems ((Integer -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (Integer -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \n :: Integer
n ->
    Bool
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) (Validation (ParamSchema t) () -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$
      String -> Validation (ParamSchema t) ()
forall schema a. String -> Validation schema a
invalid ("array exceeds maximum size (should be <=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")

  Lens' (ParamSchema t) (Maybe Integer)
-> (Integer -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMinItems s a => Lens' s a
Lens' (ParamSchema t) (Maybe Integer)
minItems ((Integer -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (Integer -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \n :: Integer
n ->
    Bool
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Integer -> Int
forall a. Num a => Integer -> a
fromInteger Integer
n) (Validation (ParamSchema t) () -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$
      String -> Validation (ParamSchema t) ()
forall schema a. String -> Validation schema a
invalid ("array is too short (size should be >=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")

  Lens' (ParamSchema t) (Maybe (SwaggerItems t))
-> (SwaggerItems t -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasItems s a => Lens' s a
Lens' (ParamSchema t) (Maybe (SwaggerItems t))
items ((SwaggerItems t -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (SwaggerItems t -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \case
    SwaggerItemsPrimitive _ itemSchema :: ParamSchema t
itemSchema -> ParamSchema t
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall t a s. t -> Validation t a -> Validation s a
sub ParamSchema t
itemSchema (Validation (ParamSchema t) () -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ (Value -> Validation (ParamSchema t) ())
-> Vector Value -> Validation (ParamSchema t) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Value -> Validation (ParamSchema t) ()
forall (t :: SwaggerKind *). Value -> Validation (ParamSchema t) ()
validateWithParamSchema Vector Value
xs
    SwaggerItemsObject itemSchema :: Referenced Schema
itemSchema      -> (Value -> Validation (ParamSchema t) ())
-> Vector Value -> Validation (ParamSchema t) ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ (Referenced Schema -> Value -> Validation (ParamSchema t) ()
forall s. Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef Referenced Schema
itemSchema) Vector Value
xs
    SwaggerItemsArray itemSchemas :: [Referenced Schema]
itemSchemas -> do
      Bool
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= [Referenced Schema] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Referenced Schema]
itemSchemas) (Validation (ParamSchema t) () -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$
        String -> Validation (ParamSchema t) ()
forall schema a. String -> Validation schema a
invalid ("array size is invalid (should be exactly " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show ([Referenced Schema] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Referenced Schema]
itemSchemas) String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")
      [Validation (ParamSchema t) ()] -> Validation (ParamSchema t) ()
forall (t :: * -> *) (f :: * -> *) a.
(Foldable t, Applicative f) =>
t (f a) -> f ()
sequenceA_ ((Referenced Schema -> Value -> Validation (ParamSchema t) ())
-> [Referenced Schema]
-> [Value]
-> [Validation (ParamSchema t) ()]
forall a b c. (a -> b -> c) -> [a] -> [b] -> [c]
zipWith Referenced Schema -> Value -> Validation (ParamSchema t) ()
forall s. Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef [Referenced Schema]
itemSchemas (Vector Value -> [Value]
forall a. Vector a -> [a]
Vector.toList Vector Value
xs))

  Lens' (ParamSchema t) (Maybe Bool)
-> (Bool -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasUniqueItems s a => Lens' s a
Lens' (ParamSchema t) (Maybe Bool)
uniqueItems ((Bool -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (Bool -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \unique :: Bool
unique ->
    Bool
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
unique Bool -> Bool -> Bool
&& Bool -> Bool
not Bool
allUnique) (Validation (ParamSchema t) () -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$
      String -> Validation (ParamSchema t) ()
forall schema a. String -> Validation schema a
invalid ("array is expected to contain unique items, but it does not")
  where
    len :: Int
len = Vector Value -> Int
forall a. Vector a -> Int
Vector.length Vector Value
xs
    allUnique :: Bool
allUnique = Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== HashSet Value -> Int
forall a. HashSet a -> Int
HashSet.size ([Value] -> HashSet Value
forall a. (Eq a, Hashable a) => [a] -> HashSet a
HashSet.fromList (Vector Value -> [Value]
forall a. Vector a -> [a]
Vector.toList Vector Value
xs))

validateObject :: HashMap Text Value -> Validation Schema ()
validateObject :: HashMap Pattern Value -> Validation Schema ()
validateObject o :: HashMap Pattern Value
o = (Schema -> Validation Schema ()) -> Validation Schema ()
forall s a. (s -> Validation s a) -> Validation s a
withSchema ((Schema -> Validation Schema ()) -> Validation Schema ())
-> (Schema -> Validation Schema ()) -> Validation Schema ()
forall a b. (a -> b) -> a -> b
$ \sch :: Schema
sch ->
  case Schema
sch Schema
-> Getting (Maybe Pattern) Schema (Maybe Pattern) -> Maybe Pattern
forall s a. s -> Getting a s a -> a
^. Getting (Maybe Pattern) Schema (Maybe Pattern)
forall s a. HasDiscriminator s a => Lens' s a
discriminator of
    Just pname :: Pattern
pname -> case Value -> Result (Referenced Schema)
forall a. FromJSON a => Value -> Result a
fromJSON (Value -> Result (Referenced Schema))
-> Maybe Value -> Maybe (Result (Referenced Schema))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Pattern -> HashMap Pattern Value -> Maybe Value
forall k v. (Eq k, Hashable k) => k -> HashMap k v -> Maybe v
HashMap.lookup Pattern
pname HashMap Pattern Value
o of
      Just (Success ref :: Referenced Schema
ref) -> Referenced Schema -> Value -> Validation Schema ()
forall s. Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef Referenced Schema
ref (Object -> Value
Object (Object -> Value) -> Object -> Value
forall a b. (a -> b) -> a -> b
$ HashMap Pattern Value -> Object
forall v. HashMap Pattern v -> KeyMap v
KM.fromHashMapText HashMap Pattern Value
o)
      Just (Error msg :: String
msg)   -> String -> Validation Schema ()
forall schema a. String -> Validation schema a
invalid ("failed to parse discriminator property " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Pattern -> String
forall a. Show a => a -> String
show Pattern
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ ": " String -> String -> String
forall a. [a] -> [a] -> [a]
++ String -> String
forall a. Show a => a -> String
show String
msg)
      Nothing            -> String -> Validation Schema ()
forall schema a. String -> Validation schema a
invalid ("discriminator property " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Pattern -> String
forall a. Show a => a -> String
show Pattern
pname String -> String -> String
forall a. [a] -> [a] -> [a]
++ "is missing")
    Nothing -> do
      Lens' Schema (Maybe Integer)
-> (Integer -> Validation Schema ()) -> Validation Schema ()
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMaxProperties s a => Lens' s a
Lens' Schema (Maybe Integer)
maxProperties ((Integer -> Validation Schema ()) -> Validation Schema ())
-> (Integer -> Validation Schema ()) -> Validation Schema ()
forall a b. (a -> b) -> a -> b
$ \n :: Integer
n ->
        Bool -> Validation Schema () -> Validation Schema ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
> Integer
n) (Validation Schema () -> Validation Schema ())
-> Validation Schema () -> Validation Schema ()
forall a b. (a -> b) -> a -> b
$
          String -> Validation Schema ()
forall schema a. String -> Validation schema a
invalid ("object size exceeds maximum (total number of properties should be <=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")

      Lens' Schema (Maybe Integer)
-> (Integer -> Validation Schema ()) -> Validation Schema ()
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasMinProperties s a => Lens' s a
Lens' Schema (Maybe Integer)
minProperties ((Integer -> Validation Schema ()) -> Validation Schema ())
-> (Integer -> Validation Schema ()) -> Validation Schema ()
forall a b. (a -> b) -> a -> b
$ \n :: Integer
n ->
        Bool -> Validation Schema () -> Validation Schema ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Integer
size Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
n) (Validation Schema () -> Validation Schema ())
-> Validation Schema () -> Validation Schema ()
forall a b. (a -> b) -> a -> b
$
          String -> Validation Schema ()
forall schema a. String -> Validation schema a
invalid ("object size is too small (total number of properties should be >=" String -> String -> String
forall a. [a] -> [a] -> [a]
++ Integer -> String
forall a. Show a => a -> String
show Integer
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ ")")

      Validation Schema ()
validateRequired
      Validation Schema ()
validateProps
  where
    size :: Integer
size = Int -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (HashMap Pattern Value -> Int
forall k v. HashMap k v -> Int
HashMap.size HashMap Pattern Value
o)

    validateRequired :: Validation Schema ()
validateRequired = (Schema -> Validation Schema ()) -> Validation Schema ()
forall s a. (s -> Validation s a) -> Validation s a
withSchema ((Schema -> Validation Schema ()) -> Validation Schema ())
-> (Schema -> Validation Schema ()) -> Validation Schema ()
forall a b. (a -> b) -> a -> b
$ \sch :: Schema
sch -> (Pattern -> Validation Schema ())
-> [Pattern] -> Validation Schema ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
(a -> f b) -> t a -> f ()
traverse_ Pattern -> Validation Schema ()
validateReq (Schema
sch Schema -> Getting [Pattern] Schema [Pattern] -> [Pattern]
forall s a. s -> Getting a s a -> a
^. Getting [Pattern] Schema [Pattern]
forall s a. HasRequired s a => Lens' s a
required)
    validateReq :: Pattern -> Validation Schema ()
validateReq n :: Pattern
n =
      Bool -> Validation Schema () -> Validation Schema ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool -> Bool
not (Pattern -> HashMap Pattern Value -> Bool
forall k a. (Eq k, Hashable k) => k -> HashMap k a -> Bool
HashMap.member Pattern
n HashMap Pattern Value
o)) (Validation Schema () -> Validation Schema ())
-> Validation Schema () -> Validation Schema ()
forall a b. (a -> b) -> a -> b
$
        String -> Validation Schema ()
forall schema a. String -> Validation schema a
invalid ("property " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Pattern -> String
forall a. Show a => a -> String
show Pattern
n String -> String -> String
forall a. [a] -> [a] -> [a]
++ " is required, but not found in " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show (HashMap Pattern Value -> ByteString
forall a. ToJSON a => a -> ByteString
encode HashMap Pattern Value
o))

    validateProps :: Validation Schema ()
validateProps = (Schema -> Validation Schema ()) -> Validation Schema ()
forall s a. (s -> Validation s a) -> Validation s a
withSchema ((Schema -> Validation Schema ()) -> Validation Schema ())
-> (Schema -> Validation Schema ()) -> Validation Schema ()
forall a b. (a -> b) -> a -> b
$ \sch :: Schema
sch -> do
      [(Pattern, Value)]
-> ((Pattern, Value) -> Validation Schema ())
-> Validation Schema ()
forall (t :: * -> *) (f :: * -> *) a b.
(Foldable t, Applicative f) =>
t a -> (a -> f b) -> f ()
for_ (HashMap Pattern Value -> [(Pattern, Value)]
forall k v. HashMap k v -> [(k, v)]
HashMap.toList HashMap Pattern Value
o) (((Pattern, Value) -> Validation Schema ())
 -> Validation Schema ())
-> ((Pattern, Value) -> Validation Schema ())
-> Validation Schema ()
forall a b. (a -> b) -> a -> b
$ \(k :: Pattern
k, v :: Value
v) ->
        case Value
v of
          Null | Bool -> Bool
not (Pattern
k Pattern -> [Pattern] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` (Schema
sch Schema -> Getting [Pattern] Schema [Pattern] -> [Pattern]
forall s a. s -> Getting a s a -> a
^. Getting [Pattern] Schema [Pattern]
forall s a. HasRequired s a => Lens' s a
required)) -> Validation Schema ()
forall schema. Validation schema ()
valid  -- null is fine for non-required property
          _ ->
            case Pattern
-> InsOrdHashMap Pattern (Referenced Schema)
-> Maybe (Referenced Schema)
forall k v. (Eq k, Hashable k) => k -> InsOrdHashMap k v -> Maybe v
InsOrdHashMap.lookup Pattern
k (Schema
sch Schema
-> Getting
     (InsOrdHashMap Pattern (Referenced Schema))
     Schema
     (InsOrdHashMap Pattern (Referenced Schema))
-> InsOrdHashMap Pattern (Referenced Schema)
forall s a. s -> Getting a s a -> a
^. Getting
  (InsOrdHashMap Pattern (Referenced Schema))
  Schema
  (InsOrdHashMap Pattern (Referenced Schema))
forall s a. HasProperties s a => Lens' s a
properties) of
              Nothing -> Validation Schema ()
-> Lens' Schema (Maybe AdditionalProperties)
-> (AdditionalProperties -> Validation Schema ())
-> Validation Schema ()
forall s a.
Validation s ()
-> Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
checkMissing (Pattern -> Validation Schema ()
forall s a. Pattern -> Validation s a
unknownProperty Pattern
k) forall s a. HasAdditionalProperties s a => Lens' s a
Lens' Schema (Maybe AdditionalProperties)
additionalProperties ((AdditionalProperties -> Validation Schema ())
 -> Validation Schema ())
-> (AdditionalProperties -> Validation Schema ())
-> Validation Schema ()
forall a b. (a -> b) -> a -> b
$ Pattern -> Value -> AdditionalProperties -> Validation Schema ()
forall a schema.
Show a =>
a -> Value -> AdditionalProperties -> Validation schema ()
validateAdditional Pattern
k Value
v
              Just s :: Referenced Schema
s  -> Referenced Schema -> Value -> Validation Schema ()
forall s. Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef Referenced Schema
s Value
v

    validateAdditional :: a -> Value -> AdditionalProperties -> Validation schema ()
validateAdditional _ _ (AdditionalPropertiesAllowed True) = Validation schema ()
forall schema. Validation schema ()
valid
    validateAdditional k :: a
k _ (AdditionalPropertiesAllowed False) = String -> Validation schema ()
forall schema a. String -> Validation schema a
invalid (String -> Validation schema ()) -> String -> Validation schema ()
forall a b. (a -> b) -> a -> b
$ "additionalProperties=false but extra property " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> a -> String
forall a. Show a => a -> String
show a
k String -> String -> String
forall a. Semigroup a => a -> a -> a
<> " found"
    validateAdditional _ v :: Value
v (AdditionalPropertiesSchema s :: Referenced Schema
s) = Referenced Schema -> Value -> Validation schema ()
forall s. Referenced Schema -> Value -> Validation s ()
validateWithSchemaRef Referenced Schema
s Value
v

    unknownProperty :: Text -> Validation s a
    unknownProperty :: Pattern -> Validation s a
unknownProperty pname :: Pattern
pname = String -> Validation s a
forall schema a. String -> Validation schema a
invalid (String -> Validation s a) -> String -> Validation s a
forall a b. (a -> b) -> a -> b
$
      "property " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Pattern -> String
forall a. Show a => a -> String
show Pattern
pname String -> String -> String
forall a. Semigroup a => a -> a -> a
<> " is found in JSON value, but it is not mentioned in Swagger schema"

validateEnum :: Value -> Validation (ParamSchema t) ()
validateEnum :: Value -> Validation (ParamSchema t) ()
validateEnum value :: Value
value = do
  Lens' (ParamSchema t) (Maybe [Value])
-> ([Value] -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a.
Lens' s (Maybe a) -> (a -> Validation s ()) -> Validation s ()
check forall s a. HasEnum s a => Lens' s a
Lens' (ParamSchema t) (Maybe [Value])
enum_ (([Value] -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> ([Value] -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \xs :: [Value]
xs ->
    Bool
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Value
value Value -> [Value] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`notElem` [Value]
xs) (Validation (ParamSchema t) () -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) () -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$
      String -> Validation (ParamSchema t) ()
forall schema a. String -> Validation schema a
invalid ("expected one of " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ByteString -> String
forall a. Show a => a -> String
show ([Value] -> ByteString
forall a. ToJSON a => a -> ByteString
encode [Value]
xs) String -> String -> String
forall a. [a] -> [a] -> [a]
++ " but got " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Value -> String
forall a. Show a => a -> String
show Value
value)

-- | Infer schema type based on used properties.
--
-- This is like 'inferParamSchemaTypes', but also works for objects:
--
-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"
-- Just [SwaggerObject]
inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]
inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]
inferSchemaTypes sch :: Schema
sch = ParamSchema 'SwaggerKindSchema -> [SwaggerType 'SwaggerKindSchema]
forall (t :: SwaggerKind *). ParamSchema t -> [SwaggerType t]
inferParamSchemaTypes (Schema
sch Schema
-> Getting
     (ParamSchema 'SwaggerKindSchema)
     Schema
     (ParamSchema 'SwaggerKindSchema)
-> ParamSchema 'SwaggerKindSchema
forall s a. s -> Getting a s a -> a
^. Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
forall s a. HasParamSchema s a => Lens' s a
paramSchema) [SwaggerType 'SwaggerKindSchema]
-> [SwaggerType 'SwaggerKindSchema]
-> [SwaggerType 'SwaggerKindSchema]
forall a. [a] -> [a] -> [a]
++
  [ SwaggerType 'SwaggerKindSchema
SwaggerObject | ((Schema -> Bool) -> Bool) -> [Schema -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((Schema -> Bool) -> Schema -> Bool
forall a b. (a -> b) -> a -> b
$ Schema
sch)
       [ Getting Any Schema AdditionalProperties -> Schema -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe AdditionalProperties
 -> Const Any (Maybe AdditionalProperties))
-> Schema -> Const Any Schema
forall s a. HasAdditionalProperties s a => Lens' s a
additionalProperties((Maybe AdditionalProperties
  -> Const Any (Maybe AdditionalProperties))
 -> Schema -> Const Any Schema)
-> ((AdditionalProperties -> Const Any AdditionalProperties)
    -> Maybe AdditionalProperties
    -> Const Any (Maybe AdditionalProperties))
-> Getting Any Schema AdditionalProperties
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(AdditionalProperties -> Const Any AdditionalProperties)
-> Maybe AdditionalProperties
-> Const Any (Maybe AdditionalProperties)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
       , Getting Any Schema Integer -> Schema -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Integer -> Const Any (Maybe Integer))
-> Schema -> Const Any Schema
forall s a. HasMaxProperties s a => Lens' s a
maxProperties((Maybe Integer -> Const Any (Maybe Integer))
 -> Schema -> Const Any Schema)
-> ((Integer -> Const Any Integer)
    -> Maybe Integer -> Const Any (Maybe Integer))
-> Getting Any Schema Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Integer -> Const Any Integer)
-> Maybe Integer -> Const Any (Maybe Integer)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
       , Getting Any Schema Integer -> Schema -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Integer -> Const Any (Maybe Integer))
-> Schema -> Const Any Schema
forall s a. HasMinProperties s a => Lens' s a
minProperties((Maybe Integer -> Const Any (Maybe Integer))
 -> Schema -> Const Any Schema)
-> ((Integer -> Const Any Integer)
    -> Maybe Integer -> Const Any (Maybe Integer))
-> Getting Any Schema Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Integer -> Const Any Integer)
-> Maybe Integer -> Const Any (Maybe Integer)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
       , Getting Any Schema (Referenced Schema) -> Schema -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((InsOrdHashMap Pattern (Referenced Schema)
 -> Const Any (InsOrdHashMap Pattern (Referenced Schema)))
-> Schema -> Const Any Schema
forall s a. HasProperties s a => Lens' s a
properties((InsOrdHashMap Pattern (Referenced Schema)
  -> Const Any (InsOrdHashMap Pattern (Referenced Schema)))
 -> Schema -> Const Any Schema)
-> ((Referenced Schema -> Const Any (Referenced Schema))
    -> InsOrdHashMap Pattern (Referenced Schema)
    -> Const Any (InsOrdHashMap Pattern (Referenced Schema)))
-> Getting Any Schema (Referenced Schema)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Referenced Schema -> Const Any (Referenced Schema))
-> InsOrdHashMap Pattern (Referenced Schema)
-> Const Any (InsOrdHashMap Pattern (Referenced Schema))
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded)
       , Getting Any Schema Pattern -> Schema -> Bool
forall s a. Getting Any s a -> s -> Bool
has (([Pattern] -> Const Any [Pattern]) -> Schema -> Const Any Schema
forall s a. HasRequired s a => Lens' s a
required(([Pattern] -> Const Any [Pattern]) -> Schema -> Const Any Schema)
-> ((Pattern -> Const Any Pattern)
    -> [Pattern] -> Const Any [Pattern])
-> Getting Any Schema Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Pattern -> Const Any Pattern) -> [Pattern] -> Const Any [Pattern]
forall (f :: * -> *) a. Foldable f => IndexedFold Int (f a) a
folded) ] ]

-- | Infer schema type based on used properties.
--
-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"
-- Just [SwaggerString]
--
-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"
-- Just [SwaggerArray]
--
-- From numeric properties 'SwaggerInteger' type is inferred.
-- If you want 'SwaggerNumber' instead, you must specify it explicitly.
--
-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"
-- Just [SwaggerInteger]
inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]
inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]
inferParamSchemaTypes sch :: ParamSchema t
sch = [[SwaggerType t]] -> [SwaggerType t]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat
  [ [ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerArray | ((ParamSchema t -> Bool) -> Bool)
-> [ParamSchema t -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ParamSchema t -> Bool) -> ParamSchema t -> Bool
forall a b. (a -> b) -> a -> b
$ ParamSchema t
sch)
        [ Getting Any (ParamSchema t) (SwaggerItems t)
-> ParamSchema t -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe (SwaggerItems t) -> Const Any (Maybe (SwaggerItems t)))
-> ParamSchema t -> Const Any (ParamSchema t)
forall s a. HasItems s a => Lens' s a
items((Maybe (SwaggerItems t) -> Const Any (Maybe (SwaggerItems t)))
 -> ParamSchema t -> Const Any (ParamSchema t))
-> ((SwaggerItems t -> Const Any (SwaggerItems t))
    -> Maybe (SwaggerItems t) -> Const Any (Maybe (SwaggerItems t)))
-> Getting Any (ParamSchema t) (SwaggerItems t)
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(SwaggerItems t -> Const Any (SwaggerItems t))
-> Maybe (SwaggerItems t) -> Const Any (Maybe (SwaggerItems t))
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
        , Getting Any (ParamSchema t) Integer -> ParamSchema t -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Integer -> Const Any (Maybe Integer))
-> ParamSchema t -> Const Any (ParamSchema t)
forall s a. HasMaxItems s a => Lens' s a
maxItems((Maybe Integer -> Const Any (Maybe Integer))
 -> ParamSchema t -> Const Any (ParamSchema t))
-> ((Integer -> Const Any Integer)
    -> Maybe Integer -> Const Any (Maybe Integer))
-> Getting Any (ParamSchema t) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Integer -> Const Any Integer)
-> Maybe Integer -> Const Any (Maybe Integer)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
        , Getting Any (ParamSchema t) Integer -> ParamSchema t -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Integer -> Const Any (Maybe Integer))
-> ParamSchema t -> Const Any (ParamSchema t)
forall s a. HasMinItems s a => Lens' s a
minItems((Maybe Integer -> Const Any (Maybe Integer))
 -> ParamSchema t -> Const Any (ParamSchema t))
-> ((Integer -> Const Any Integer)
    -> Maybe Integer -> Const Any (Maybe Integer))
-> Getting Any (ParamSchema t) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Integer -> Const Any Integer)
-> Maybe Integer -> Const Any (Maybe Integer)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
        , Getting Any (ParamSchema t) Bool -> ParamSchema t -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Bool -> Const Any (Maybe Bool))
-> ParamSchema t -> Const Any (ParamSchema t)
forall s a. HasUniqueItems s a => Lens' s a
uniqueItems((Maybe Bool -> Const Any (Maybe Bool))
 -> ParamSchema t -> Const Any (ParamSchema t))
-> ((Bool -> Const Any Bool)
    -> Maybe Bool -> Const Any (Maybe Bool))
-> Getting Any (ParamSchema t) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Any Bool) -> Maybe Bool -> Const Any (Maybe Bool)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) ] ]
  , [ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerInteger | ((ParamSchema t -> Bool) -> Bool)
-> [ParamSchema t -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ParamSchema t -> Bool) -> ParamSchema t -> Bool
forall a b. (a -> b) -> a -> b
$ ParamSchema t
sch)
        [ Getting Any (ParamSchema t) Bool -> ParamSchema t -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Bool -> Const Any (Maybe Bool))
-> ParamSchema t -> Const Any (ParamSchema t)
forall s a. HasExclusiveMaximum s a => Lens' s a
exclusiveMaximum((Maybe Bool -> Const Any (Maybe Bool))
 -> ParamSchema t -> Const Any (ParamSchema t))
-> ((Bool -> Const Any Bool)
    -> Maybe Bool -> Const Any (Maybe Bool))
-> Getting Any (ParamSchema t) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Any Bool) -> Maybe Bool -> Const Any (Maybe Bool)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
        , Getting Any (ParamSchema t) Bool -> ParamSchema t -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Bool -> Const Any (Maybe Bool))
-> ParamSchema t -> Const Any (ParamSchema t)
forall s a. HasExclusiveMinimum s a => Lens' s a
exclusiveMinimum((Maybe Bool -> Const Any (Maybe Bool))
 -> ParamSchema t -> Const Any (ParamSchema t))
-> ((Bool -> Const Any Bool)
    -> Maybe Bool -> Const Any (Maybe Bool))
-> Getting Any (ParamSchema t) Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Bool -> Const Any Bool) -> Maybe Bool -> Const Any (Maybe Bool)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
        , Getting Any (ParamSchema t) Scientific -> ParamSchema t -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Scientific -> Const Any (Maybe Scientific))
-> ParamSchema t -> Const Any (ParamSchema t)
forall s a. HasMaximum s a => Lens' s a
maximum_((Maybe Scientific -> Const Any (Maybe Scientific))
 -> ParamSchema t -> Const Any (ParamSchema t))
-> ((Scientific -> Const Any Scientific)
    -> Maybe Scientific -> Const Any (Maybe Scientific))
-> Getting Any (ParamSchema t) Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Scientific -> Const Any Scientific)
-> Maybe Scientific -> Const Any (Maybe Scientific)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
        , Getting Any (ParamSchema t) Scientific -> ParamSchema t -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Scientific -> Const Any (Maybe Scientific))
-> ParamSchema t -> Const Any (ParamSchema t)
forall s a. HasMinimum s a => Lens' s a
minimum_((Maybe Scientific -> Const Any (Maybe Scientific))
 -> ParamSchema t -> Const Any (ParamSchema t))
-> ((Scientific -> Const Any Scientific)
    -> Maybe Scientific -> Const Any (Maybe Scientific))
-> Getting Any (ParamSchema t) Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Scientific -> Const Any Scientific)
-> Maybe Scientific -> Const Any (Maybe Scientific)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
        , Getting Any (ParamSchema t) Scientific -> ParamSchema t -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Scientific -> Const Any (Maybe Scientific))
-> ParamSchema t -> Const Any (ParamSchema t)
forall s a. HasMultipleOf s a => Lens' s a
multipleOf((Maybe Scientific -> Const Any (Maybe Scientific))
 -> ParamSchema t -> Const Any (ParamSchema t))
-> ((Scientific -> Const Any Scientific)
    -> Maybe Scientific -> Const Any (Maybe Scientific))
-> Getting Any (ParamSchema t) Scientific
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Scientific -> Const Any Scientific)
-> Maybe Scientific -> Const Any (Maybe Scientific)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) ] ]
  , [ SwaggerType t
forall (t :: SwaggerKind *). SwaggerType t
SwaggerString | ((ParamSchema t -> Bool) -> Bool)
-> [ParamSchema t -> Bool] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any ((ParamSchema t -> Bool) -> ParamSchema t -> Bool
forall a b. (a -> b) -> a -> b
$ ParamSchema t
sch)
        [ Getting Any (ParamSchema t) Integer -> ParamSchema t -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Integer -> Const Any (Maybe Integer))
-> ParamSchema t -> Const Any (ParamSchema t)
forall s a. HasMaxLength s a => Lens' s a
maxLength((Maybe Integer -> Const Any (Maybe Integer))
 -> ParamSchema t -> Const Any (ParamSchema t))
-> ((Integer -> Const Any Integer)
    -> Maybe Integer -> Const Any (Maybe Integer))
-> Getting Any (ParamSchema t) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Integer -> Const Any Integer)
-> Maybe Integer -> Const Any (Maybe Integer)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
        , Getting Any (ParamSchema t) Integer -> ParamSchema t -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Integer -> Const Any (Maybe Integer))
-> ParamSchema t -> Const Any (ParamSchema t)
forall s a. HasMinLength s a => Lens' s a
minLength((Maybe Integer -> Const Any (Maybe Integer))
 -> ParamSchema t -> Const Any (ParamSchema t))
-> ((Integer -> Const Any Integer)
    -> Maybe Integer -> Const Any (Maybe Integer))
-> Getting Any (ParamSchema t) Integer
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Integer -> Const Any Integer)
-> Maybe Integer -> Const Any (Maybe Integer)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just)
        , Getting Any (ParamSchema t) Pattern -> ParamSchema t -> Bool
forall s a. Getting Any s a -> s -> Bool
has ((Maybe Pattern -> Const Any (Maybe Pattern))
-> ParamSchema t -> Const Any (ParamSchema t)
forall s a. HasPattern s a => Lens' s a
pattern((Maybe Pattern -> Const Any (Maybe Pattern))
 -> ParamSchema t -> Const Any (ParamSchema t))
-> ((Pattern -> Const Any Pattern)
    -> Maybe Pattern -> Const Any (Maybe Pattern))
-> Getting Any (ParamSchema t) Pattern
forall b c a. (b -> c) -> (a -> b) -> a -> c
.(Pattern -> Const Any Pattern)
-> Maybe Pattern -> Const Any (Maybe Pattern)
forall a b. Prism (Maybe a) (Maybe b) a b
_Just) ] ]
  ]

validateSchemaType :: Value -> Validation Schema ()
validateSchemaType :: Value -> Validation Schema ()
validateSchemaType value :: Value
value = (Schema -> Validation Schema ()) -> Validation Schema ()
forall s a. (s -> Validation s a) -> Validation s a
withSchema ((Schema -> Validation Schema ()) -> Validation Schema ())
-> (Schema -> Validation Schema ()) -> Validation Schema ()
forall a b. (a -> b) -> a -> b
$ \sch :: Schema
sch ->
  case (Schema
sch Schema
-> Getting
     (Maybe (SwaggerType 'SwaggerKindSchema))
     Schema
     (Maybe (SwaggerType 'SwaggerKindSchema))
-> Maybe (SwaggerType 'SwaggerKindSchema)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (SwaggerType 'SwaggerKindSchema))
  Schema
  (Maybe (SwaggerType 'SwaggerKindSchema))
forall s a. HasType s a => Lens' s a
type_, Value
value) of
    (Just SwaggerNull,    Null)       -> Validation Schema ()
forall schema. Validation schema ()
valid
    (Just SwaggerBoolean, Bool _)     -> Validation Schema ()
forall schema. Validation schema ()
valid
    (Just SwaggerInteger, Number n :: Scientific
n)   -> Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
-> Validation (ParamSchema 'SwaggerKindSchema) ()
-> Validation Schema ()
forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
forall s a. HasParamSchema s a => Lens' s a
paramSchema (Scientific -> Validation (ParamSchema 'SwaggerKindSchema) ()
forall (t :: SwaggerKind *).
Scientific -> Validation (ParamSchema t) ()
validateInteger Scientific
n)
    (Just SwaggerNumber,  Number n :: Scientific
n)   -> Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
-> Validation (ParamSchema 'SwaggerKindSchema) ()
-> Validation Schema ()
forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
forall s a. HasParamSchema s a => Lens' s a
paramSchema (Scientific -> Validation (ParamSchema 'SwaggerKindSchema) ()
forall (t :: SwaggerKind *).
Scientific -> Validation (ParamSchema t) ()
validateNumber Scientific
n)
    (Just SwaggerString,  String s :: Pattern
s)   -> Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
-> Validation (ParamSchema 'SwaggerKindSchema) ()
-> Validation Schema ()
forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
forall s a. HasParamSchema s a => Lens' s a
paramSchema (Pattern -> Validation (ParamSchema 'SwaggerKindSchema) ()
forall (t :: SwaggerKind *).
Pattern -> Validation (ParamSchema t) ()
validateString Pattern
s)
    (Just SwaggerArray,   Array xs :: Vector Value
xs)   -> Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
-> Validation (ParamSchema 'SwaggerKindSchema) ()
-> Validation Schema ()
forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
forall s a. HasParamSchema s a => Lens' s a
paramSchema (Vector Value -> Validation (ParamSchema 'SwaggerKindSchema) ()
forall (t :: SwaggerKind *).
Vector Value -> Validation (ParamSchema t) ()
validateArray Vector Value
xs)
    (Just SwaggerObject,  Object o :: Object
o)   -> HashMap Pattern Value -> Validation Schema ()
validateObject (HashMap Pattern Value -> Validation Schema ())
-> HashMap Pattern Value -> Validation Schema ()
forall a b. (a -> b) -> a -> b
$ Object -> HashMap Pattern Value
forall v. KeyMap v -> HashMap Pattern v
KM.toHashMapText Object
o
    (Nothing, Null)                   -> Validation Schema ()
forall schema. Validation schema ()
valid
    (Nothing, Bool _)                 -> Validation Schema ()
forall schema. Validation schema ()
valid
    -- Number by default
    (Nothing, Number n :: Scientific
n)               -> Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
-> Validation (ParamSchema 'SwaggerKindSchema) ()
-> Validation Schema ()
forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
forall s a. HasParamSchema s a => Lens' s a
paramSchema (Scientific -> Validation (ParamSchema 'SwaggerKindSchema) ()
forall (t :: SwaggerKind *).
Scientific -> Validation (ParamSchema t) ()
validateNumber Scientific
n)
    (Nothing, String s :: Pattern
s)               -> Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
-> Validation (ParamSchema 'SwaggerKindSchema) ()
-> Validation Schema ()
forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
forall s a. HasParamSchema s a => Lens' s a
paramSchema (Pattern -> Validation (ParamSchema 'SwaggerKindSchema) ()
forall (t :: SwaggerKind *).
Pattern -> Validation (ParamSchema t) ()
validateString Pattern
s)
    (Nothing, Array xs :: Vector Value
xs)               -> Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
-> Validation (ParamSchema 'SwaggerKindSchema) ()
-> Validation Schema ()
forall a s r. Getting a s a -> Validation a r -> Validation s r
sub_ Getting
  (ParamSchema 'SwaggerKindSchema)
  Schema
  (ParamSchema 'SwaggerKindSchema)
forall s a. HasParamSchema s a => Lens' s a
paramSchema (Vector Value -> Validation (ParamSchema 'SwaggerKindSchema) ()
forall (t :: SwaggerKind *).
Vector Value -> Validation (ParamSchema t) ()
validateArray Vector Value
xs)
    (Nothing, Object o :: Object
o)               -> HashMap Pattern Value -> Validation Schema ()
validateObject (HashMap Pattern Value -> Validation Schema ())
-> HashMap Pattern Value -> Validation Schema ()
forall a b. (a -> b) -> a -> b
$ Object -> HashMap Pattern Value
forall v. KeyMap v -> HashMap Pattern v
KM.toHashMapText Object
o
    bad :: (Maybe (SwaggerType 'SwaggerKindSchema), Value)
bad -> String -> Validation Schema ()
forall schema a. String -> Validation schema a
invalid (String -> Validation Schema ()) -> String -> Validation Schema ()
forall a b. (a -> b) -> a -> b
$ "expected JSON value of type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Maybe (SwaggerType 'SwaggerKindSchema), Value) -> String
forall (t :: SwaggerKind *).
(Maybe (SwaggerType t), Value) -> String
showType (Maybe (SwaggerType 'SwaggerKindSchema), Value)
bad

validateParamSchemaType :: Value -> Validation (ParamSchema t) ()
validateParamSchemaType :: Value -> Validation (ParamSchema t) ()
validateParamSchemaType value :: Value
value = (ParamSchema t -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall s a. (s -> Validation s a) -> Validation s a
withSchema ((ParamSchema t -> Validation (ParamSchema t) ())
 -> Validation (ParamSchema t) ())
-> (ParamSchema t -> Validation (ParamSchema t) ())
-> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ \sch :: ParamSchema t
sch ->
  case (ParamSchema t
sch ParamSchema t
-> Getting
     (Maybe (SwaggerType t)) (ParamSchema t) (Maybe (SwaggerType t))
-> Maybe (SwaggerType t)
forall s a. s -> Getting a s a -> a
^. Getting
  (Maybe (SwaggerType t)) (ParamSchema t) (Maybe (SwaggerType t))
forall s a. HasType s a => Lens' s a
type_, Value
value) of
    (Just SwaggerBoolean, Bool _)     -> Validation (ParamSchema t) ()
forall schema. Validation schema ()
valid
    (Just SwaggerInteger, Number n :: Scientific
n)   -> Scientific -> Validation (ParamSchema t) ()
forall (t :: SwaggerKind *).
Scientific -> Validation (ParamSchema t) ()
validateInteger Scientific
n
    (Just SwaggerNumber,  Number n :: Scientific
n)   -> Scientific -> Validation (ParamSchema t) ()
forall (t :: SwaggerKind *).
Scientific -> Validation (ParamSchema t) ()
validateNumber Scientific
n
    (Just SwaggerString,  String s :: Pattern
s)   -> Pattern -> Validation (ParamSchema t) ()
forall (t :: SwaggerKind *).
Pattern -> Validation (ParamSchema t) ()
validateString Pattern
s
    (Just SwaggerArray,   Array xs :: Vector Value
xs)   -> Vector Value -> Validation (ParamSchema t) ()
forall (t :: SwaggerKind *).
Vector Value -> Validation (ParamSchema t) ()
validateArray Vector Value
xs
    (Nothing, Bool _)                 -> Validation (ParamSchema t) ()
forall schema. Validation schema ()
valid
    -- Number by default
    (Nothing, Number n :: Scientific
n)               -> Scientific -> Validation (ParamSchema t) ()
forall (t :: SwaggerKind *).
Scientific -> Validation (ParamSchema t) ()
validateNumber Scientific
n
    (Nothing, String s :: Pattern
s)               -> Pattern -> Validation (ParamSchema t) ()
forall (t :: SwaggerKind *).
Pattern -> Validation (ParamSchema t) ()
validateString Pattern
s
    (Nothing, Array xs :: Vector Value
xs)               -> Vector Value -> Validation (ParamSchema t) ()
forall (t :: SwaggerKind *).
Vector Value -> Validation (ParamSchema t) ()
validateArray Vector Value
xs
    bad :: (Maybe (SwaggerType t), Value)
bad -> String -> Validation (ParamSchema t) ()
forall schema a. String -> Validation schema a
invalid (String -> Validation (ParamSchema t) ())
-> String -> Validation (ParamSchema t) ()
forall a b. (a -> b) -> a -> b
$ "expected JSON value of type " String -> String -> String
forall a. [a] -> [a] -> [a]
++ (Maybe (SwaggerType t), Value) -> String
forall (t :: SwaggerKind *).
(Maybe (SwaggerType t), Value) -> String
showType (Maybe (SwaggerType t), Value)
bad

showType :: (Maybe (SwaggerType t), Value) -> String
showType :: (Maybe (SwaggerType t), Value) -> String
showType (Just ty :: SwaggerType t
ty, _)        = SwaggerType t -> String
forall a. Show a => a -> String
show SwaggerType t
ty
showType (Nothing, Null)     = "SwaggerNull"
showType (Nothing, Bool _)   = "SwaggerBoolean"
showType (Nothing, Number _) = "SwaggerNumber"
showType (Nothing, String _) = "SwaggerString"
showType (Nothing, Array _)  = "SwaggerArray"
showType (Nothing, Object _) = "SwaggerObject"