@@ -1,15 +1,16 @@
1−{-# LANGUAGE DeriveFunctor #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE FunctionalDependencies #-}
4−{-# LANGUAGE GADTs #-}
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE DeriveFunctor #-}
3+{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE FunctionalDependencies #-}
5+{-# LANGUAGE GADTs #-}
56{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6−{-# LANGUAGE LambdaCase #-}
7−{-# LANGUAGE MultiParamTypeClasses #-}
8−{-# LANGUAGE PackageImports #-}
9−{-# LANGUAGE RankNTypes #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE TemplateHaskell #-}
12−{-# LANGUAGE UndecidableInstances #-}
7+{-# LANGUAGE LambdaCase #-}
8+{-# LANGUAGE MultiParamTypeClasses #-}
9+{-# LANGUAGE PackageImports #-}
10+{-# LANGUAGE RankNTypes #-}
11+{-# LANGUAGE ScopedTypeVariables #-}
12+{-# LANGUAGE TemplateHaskell #-}
13+{-# LANGUAGE UndecidableInstances #-}
1314-- |
1415-- Module: Data.Swagger.Internal.Schema.Validation
1516-- Copyright: (c) 2015 GetShopTV
@@ -20,28 +21,29 @@
2021-- Validate JSON values with Swagger Schema.
2122module Data.Swagger.Internal.Schema.Validation where
2223
23−import Control.Applicative
24−import Control.Lens
25−import Control.Monad (when)
24+import Control.Applicative
25+import Control.Lens
26+import Control.Monad (when)
2627
27−import Data.Aeson hiding (Result)
28−import Data.Foldable (traverse_, for_, sequenceA_)
29−import Data.HashMap.Strict (HashMap)
30−import qualified Data.HashMap.Strict as HashMap
28+import Data.Aeson hiding (Result)
29+import Data.Foldable (for_, sequenceA_,
30+ traverse_)
31+import Data.HashMap.Strict (HashMap)
32+import qualified Data.HashMap.Strict as HashMap
33+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
3134import qualified "unordered-containers" Data.HashSet as HashSet
32−import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
33−import Data.Monoid
34−import Data.Proxy
35−import Data.Scientific (Scientific, isInteger)
36−import Data.Text (Text)
37−import qualified Data.Text as Text
38−import Data.Vector (Vector)
39−import qualified Data.Vector as Vector
40−
41−import Data.Swagger.Declare
42−import Data.Swagger.Internal
43−import Data.Swagger.Internal.Schema
44−import Data.Swagger.Lens
35+import Data.Monoid
36+import Data.Proxy
37+import Data.Scientific (Scientific, isInteger)
38+import Data.Text (Text)
39+import qualified Data.Text as Text
40+import Data.Vector (Vector)
41+import qualified Data.Vector as Vector
42+
43+import Data.Swagger.Declare
44+import Data.Swagger.Internal
45+import Data.Swagger.Internal.Schema
46+import Data.Swagger.Lens
4547
4648-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
4749-- This can be used with QuickCheck to ensure those instances are coherent:
@@ -329,6 +331,42 @@ validateEnum value = do
329331 when (value `notElem` xs) $
330332 invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)
331333
334+-- | Infer schema type based on used properties.
335+--
336+-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"
337+-- Just [SwaggerString]
338+inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]
339+inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++
340+ [ SwaggerObject | any ($ sch)
341+ [ has (additionalProperties._Just)
342+ , has (maxProperties._Just)
343+ , has (minProperties._Just)
344+ , has (properties.folded)
345+ , has (required.folded) ] ]
346+
347+-- | Infer schema type based on used properties.
348+--
349+-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"
350+-- Just [SwaggerString]
351+inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]
352+inferParamSchemaTypes sch = concat
353+ [ [ SwaggerArray | any ($ sch)
354+ [ has (items._Just)
355+ , has (maxItems._Just)
356+ , has (minItems._Just)
357+ , has (uniqueItems._Just) ] ]
358+ , [ SwaggerInteger | any ($ sch)
359+ [ has (exclusiveMaximum._Just)
360+ , has (exclusiveMinimum._Just)
361+ , has (maximum_._Just)
362+ , has (minimum_._Just)
363+ , has (multipleOf._Just) ] ]
364+ , [ SwaggerString | any ($ sch)
365+ [ has (maxLength._Just)
366+ , has (minLength._Just)
367+ , has (pattern._Just) ] ]
368+ ]
369+
332370validateSchemaType :: Value -> Validation Schema ()
333371validateSchemaType value = withSchema $ \sch ->
334372 case (sch ^. type_, value) of