git.iko.soy/typeable/swagger2
on master help sign in
add some tests from FromJSON validation
357f72dBen Weitzman
src/Data/Swagger/Schema/Generator.hs+25−8
compare with master
unifiedsplit
@@ -12,8 +12,10 @@ import Data.Aeson
12import Data.Aeson.Types
12import Data.Aeson.Types
13import qualified Data.HashMap.Strict.InsOrd as M
13import qualified Data.HashMap.Strict.InsOrd as M
14import Data.Maybe
14import Data.Maybe
15+import Data.Maybe
15import Data.Proxy
16import Data.Proxy
16import Data.Scientific
17import Data.Scientific
18+import qualified Data.Set as S
17import Data.Swagger
19import Data.Swagger
18import Data.Swagger.Declare
20import Data.Swagger.Declare
19import qualified Data.Text as T
21import qualified Data.Text as T
@@ -45,20 +47,35 @@ schemaGen defns schema =
45 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
47 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
46 | Just items <- schema ^. items ->
48 | Just items <- schema ^. items ->
47 case items of
49 case items of
48− SwaggerItemsObject ref ->
50+ SwaggerItemsObject ref -> do
51+ size <- getSize
49 let itemSchema = dereference defns ref
52 let itemSchema = dereference defns ref
53+ minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems
54+ maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxItems
55+ arrayLength <- choose (minLength', max minLength' maxLength')
50− in fmap (Array . V.fromList) . listOf $ schemaGen defns itemSchema
56+ generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema
57+ return . Array $ V.fromList generatedArray
51 SwaggerItemsArray refs ->
58 SwaggerItemsArray refs ->
52 let itemGens = schemaGen defns . dereference defns <$> refs
59 let itemGens = schemaGen defns . dereference defns <$> refs
53 in fmap (Array . V.fromList) $ sequence itemGens
60 in fmap (Array . V.fromList) $ sequence itemGens
54− SwaggerString -> String . T.pack <$> arbitrary
61+ SwaggerString -> do
62+ size <- getSize
63+ let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
64+ let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
65+ length <- choose (minLength', max minLength' maxLength')
66+ str <- vectorOf length arbitrary
67+ return . String $ T.pack str
55 SwaggerObject -> do
68 SwaggerObject -> do
69+ size <- getSize
56 let props = dereference defns <$> schema ^. properties
70 let props = dereference defns <$> schema ^. properties
57− reqKeys = schema ^. required
71+ reqKeys = S.fromList $ schema ^. required
58− allKeys = M.keys $ schema ^. properties
72+ allKeys = S.fromList . M.keys $ schema ^. properties
59− presentKeys <- filterM (\key -> if key `elem` reqKeys
73+ optionalKeys = allKeys S.\\ reqKeys
60− then return True
74+ minProps' = fromMaybe 0 $ fromInteger <$> schema ^. minProperties
61− else arbitrary) allKeys
75+ maxProps' = fromMaybe size $ fromInteger <$> schema ^. maxProperties
76+ shuffledOptional <- shuffle $ S.toList optionalKeys
77+ numProps <- choose (minProps', max minProps' maxProps')
78+ let presentKeys = take numProps $ S.toList reqKeys ++ shuffledOptional
62 let presentProps = M.filterWithKey (\k _ -> k `elem` presentKeys) props
79 let presentProps = M.filterWithKey (\k _ -> k `elem` presentKeys) props
63 let gens = schemaGen defns <$> presentProps
80 let gens = schemaGen defns <$> presentProps
64 x <- sequence gens
81 x <- sequence gens
swagger2.cabal+1
@@ -126,6 +126,7 @@ test-suite spec
126 Data.Swagger.ParamSchemaSpec
126 Data.Swagger.ParamSchemaSpec
127 Data.Swagger.SchemaSpec
127 Data.Swagger.SchemaSpec
128 Data.Swagger.Schema.ValidationSpec
128 Data.Swagger.Schema.ValidationSpec
129+ Data.Swagger.Schema.GeneratorSpec
129 default-language: Haskell2010
130 default-language: Haskell2010
130
131
131test-suite doctests
132test-suite doctests
test/Data/Swagger/Schema/GeneratorSpec.hsnew file+168
@@ -0,0 +1,168 @@
1+{-# LANGUAGE OverloadedLists #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE PackageImports #-}
4+module Data.Swagger.Schema.GeneratorSpec where
5+
6+import Prelude ()
7+import Prelude.Compat
8+
9+import Data.Swagger
10+import Data.Swagger.Schema.Generator
11+
12+import Control.Lens.Operators
13+import Data.Aeson
14+import Data.Hashable (Hashable)
15+import Data.HashMap.Strict (HashMap)
16+import qualified Data.HashMap.Strict as HashMap
17+import "unordered-containers" Data.HashSet (HashSet)
18+import qualified "unordered-containers" Data.HashSet as HashSet
19+import Data.Int
20+import Data.IntMap (IntMap)
21+import Data.List.NonEmpty.Compat (NonEmpty (..), nonEmpty)
22+import Data.Map (Map, fromList)
23+import Data.Monoid (mempty)
24+import Data.Proxy
25+import Data.Proxy
26+import Data.Set (Set)
27+import qualified Data.Text as T
28+import qualified Data.Text.Lazy as TL
29+import Data.Time
30+import Data.Version (Version)
31+import Data.Word
32+import GHC.Generics
33+
34+import Test.Hspec
35+import Test.Hspec.QuickCheck
36+import Test.QuickCheck
37+
38+shouldValidate :: (FromJSON a, ToSchema a) => Proxy a -> Property
39+shouldValidate = validateFromJSON
40+
41+
42+shouldNotValidate :: (FromJSON a, ToSchema a) => Proxy a -> Property
43+shouldNotValidate = expectFailure . shouldValidate
44+
45+
46+spec :: Spec
47+spec = do
48+ describe "FromJSON validation" $ do
49+ prop "Bool" $ shouldValidate (Proxy :: Proxy Bool)
50+ prop "Char" $ shouldValidate (Proxy :: Proxy Char)
51+ prop "Double" $ shouldValidate (Proxy :: Proxy Double)
52+ prop "Float" $ shouldValidate (Proxy :: Proxy Float)
53+ prop "Int" $ shouldValidate (Proxy :: Proxy Int)
54+ prop "Int8" $ shouldValidate (Proxy :: Proxy Int8)
55+ prop "Int16" $ shouldValidate (Proxy :: Proxy Int16)
56+ prop "Int32" $ shouldValidate (Proxy :: Proxy Int32)
57+ prop "Int64" $ shouldValidate (Proxy :: Proxy Int64)
58+ prop "Integer" $ shouldValidate (Proxy :: Proxy Integer)
59+ prop "Word" $ shouldValidate (Proxy :: Proxy Word)
60+ prop "Word8" $ shouldValidate (Proxy :: Proxy Word8)
61+ prop "Word16" $ shouldValidate (Proxy :: Proxy Word16)
62+ prop "Word32" $ shouldValidate (Proxy :: Proxy Word32)
63+ prop "Word64" $ shouldValidate (Proxy :: Proxy Word64)
64+ prop "String" $ shouldValidate (Proxy :: Proxy String)
65+ prop "()" $ shouldValidate (Proxy :: Proxy ())
66+-- prop "ZonedTime" $ shouldValidate (Proxy :: Proxy ZonedTime)
67+-- prop "UTCTime" $ shouldValidate (Proxy :: Proxy UTCTime)
68+ prop "T.Text" $ shouldValidate (Proxy :: Proxy T.Text)
69+ prop "TL.Text" $ shouldValidate (Proxy :: Proxy TL.Text)
70+ prop "[String]" $ shouldValidate (Proxy :: Proxy [String])
71+ -- prop "(Maybe [Int])" $ shouldValidate (Proxy :: Proxy (Maybe [Int]))
72+ prop "(IntMap String)" $ shouldValidate (Proxy :: Proxy (IntMap String))
73+ prop "(Set Bool)" $ shouldValidate (Proxy :: Proxy (Set Bool))
74+ prop "(NonEmpty Bool)" $ shouldValidate (Proxy :: Proxy (NonEmpty Bool))
75+ prop "(HashSet Bool)" $ shouldValidate (Proxy :: Proxy (HashSet Bool))
76+ prop "(Either Int String)" $ shouldValidate (Proxy :: Proxy (Either Int String))
77+ prop "(Int, String)" $ shouldValidate (Proxy :: Proxy (Int, String))
78+ prop "(Map String Int)" $ shouldValidate (Proxy :: Proxy (Map String Int))
79+ prop "(Map T.Text Int)" $ shouldValidate (Proxy :: Proxy (Map T.Text Int))
80+ prop "(Map TL.Text Bool)" $ shouldValidate (Proxy :: Proxy (Map TL.Text Bool))
81+ prop "(HashMap String Int)" $ shouldValidate (Proxy :: Proxy (HashMap String Int))
82+ prop "(HashMap T.Text Int)" $ shouldValidate (Proxy :: Proxy (HashMap T.Text Int))
83+ prop "(HashMap TL.Text Bool)" $ shouldValidate (Proxy :: Proxy (HashMap TL.Text Bool))
84+ prop "Object" $ shouldValidate (Proxy :: Proxy Object)
85+ prop "(Int, String, Double)" $ shouldValidate (Proxy :: Proxy (Int, String, Double))
86+ prop "(Int, String, Double, [Int])" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int]))
87+ prop "(Int, String, Double, [Int], Int)" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int], Int))
88+ describe "Invalid FromJSON validation" $ do
89+ prop "WrongType" $ shouldNotValidate (Proxy :: Proxy WrongType)
90+ prop "MissingRequired" $ shouldNotValidate (Proxy :: Proxy MissingRequired)
91+ prop "MissingProperty" $ shouldNotValidate (Proxy :: Proxy MissingProperty)
92+ prop "WrongPropType" $ shouldNotValidate (Proxy :: Proxy WrongPropType)
93+
94+-- =============================
95+-- Data types and bunk instances
96+-- =============================
97+
98+data WrongType = WrongType Bool
99+
100+instance FromJSON WrongType where
101+ parseJSON = withBool "WrongType" $ return . WrongType
102+
103+instance ToSchema WrongType where
104+ declareNamedSchema _ = return . NamedSchema (Just "WrongType") $
105+ mempty
106+ & type_ .~ SwaggerObject
107+
108+
109+data MissingRequired = MissingRequired
110+ { propA :: String
111+ , propB :: Bool
112+ }
113+
114+instance FromJSON MissingRequired where
115+ parseJSON = withObject "MissingRequired" $ \o ->
116+ MissingRequired
117+ <$> o .: "propA"
118+ <*> o .: "propB"
119+
120+instance ToSchema MissingRequired where
121+ declareNamedSchema _ = do
122+ stringSchema <- declareSchemaRef (Proxy :: Proxy String)
123+ boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)
124+ return . NamedSchema (Just "MissingRequired") $
125+ mempty
126+ & type_ .~ SwaggerObject
127+ & properties .~ [("propA", stringSchema)
128+ ,("propB", boolSchema)
129+ ]
130+ & required .~ ["propA"]
131+
132+data MissingProperty = MissingProperty
133+ { propC :: String
134+ , propD :: Bool
135+ }
136+
137+instance FromJSON MissingProperty where
138+ parseJSON = withObject "MissingProperty" $ \o ->
139+ MissingProperty
140+ <$> o .: "propC"
141+ <*> o .: "propD"
142+
143+instance ToSchema MissingProperty where
144+ declareNamedSchema _ = do
145+ stringSchema <- declareSchemaRef (Proxy :: Proxy String)
146+ return . NamedSchema (Just "MissingProperty") $
147+ mempty
148+ & type_ .~ SwaggerObject
149+ & properties .~ [("propC", stringSchema)]
150+ & required .~ ["propC"]
151+
152+data WrongPropType = WrongPropType
153+ { propE :: Bool
154+ }
155+
156+instance FromJSON WrongPropType where
157+ parseJSON = withObject "WrongPropType" $ \o ->
158+ WrongPropType
159+ <$> o .: "propE"
160+
161+instance ToSchema WrongPropType where
162+ declareNamedSchema _ = do
163+ boolSchema <- declareSchemaRef (Proxy :: Proxy WrongPropType)
164+ return . NamedSchema (Just "MissingRequired") $
165+ mempty
166+ & type_ .~ SwaggerObject
167+ & properties .~ [("propE", boolSchema)]
168+ & required .~ ["propE"]