git.iko.soy/typeable/openapi3
on master help sign in
Add a couple of tests for invalid JSON-Schema pairs
d7e6d5cNickolay Kudasov
test/Data/Swagger/Schema/ValidationSpec.hs+32−1
compare with master
unifiedsplit
@@ -1,6 +1,8 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE PackageImports #-}
3{-# LANGUAGE PackageImports #-}
4+{-# LANGUAGE RecordWildCards #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
4{-# OPTIONS_GHC -fno-warn-orphans #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
5module Data.Swagger.Schema.ValidationSpec where
7module Data.Swagger.Schema.ValidationSpec where
6
8
@@ -24,6 +26,7 @@ import Data.Word
24import GHC.Generics
26import GHC.Generics
25
27
26import Data.Swagger
28import Data.Swagger
29+import Data.Swagger.Declare
27
30
28import Test.Hspec
31import Test.Hspec
29import Test.Hspec.QuickCheck
32import Test.Hspec.QuickCheck
@@ -32,6 +35,11 @@ import Test.QuickCheck
32shouldValidate :: (ToJSON a, ToSchema a) => Proxy a -> a -> Bool
35shouldValidate :: (ToJSON a, ToSchema a) => Proxy a -> a -> Bool
33shouldValidate _ x = validateToJSON x == []
36shouldValidate _ x = validateToJSON x == []
34
37
38+shouldNotValidate :: forall a. ToSchema a => (a -> Value) -> a -> Bool
39+shouldNotValidate f = not . null . validateJSON defs sch . f
40+ where
41+ (defs, sch) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
42+
35spec :: Spec
43spec :: Spec
36spec = do
44spec = do
37 describe "Validation" $ do
45 describe "Validation" $ do
@@ -78,6 +86,12 @@ spec = do
78 prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
86 prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
79 prop "Light" $ shouldValidate (Proxy :: Proxy Light)
87 prop "Light" $ shouldValidate (Proxy :: Proxy Light)
80
88
89+ describe "invalid cases" $ do
90+ prop "invalidPersonToJSON" $ shouldNotValidate invalidPersonToJSON
91+ prop "invalidColorToJSON" $ shouldNotValidate invalidColorToJSON
92+ prop "invalidPaintToJSON" $ shouldNotValidate invalidPaintToJSON
93+ prop "invalidLightToJSON" $ shouldNotValidate invalidLightToJSON
94+
81main :: IO ()
95main :: IO ()
82main = hspec spec
96main = hspec spec
83
97
@@ -96,6 +110,13 @@ instance ToSchema Person
96instance Arbitrary Person where
110instance Arbitrary Person where
97 arbitrary = Person <$> arbitrary <*> arbitrary <*> arbitrary
111 arbitrary = Person <$> arbitrary <*> arbitrary <*> arbitrary
98
112
113+invalidPersonToJSON :: Person -> Value
114+invalidPersonToJSON Person{..} = object
115+ [ T.pack "personName" .= toJSON name
116+ , T.pack "personPhone" .= toJSON phone
117+ , T.pack "personEmail" .= toJSON email
118+ ]
119+
99-- ========================================================================
120-- ========================================================================
100-- Color (enum)
121-- Color (enum)
101-- ========================================================================
122-- ========================================================================
@@ -107,6 +128,11 @@ instance ToSchema Color
107instance Arbitrary Color where
128instance Arbitrary Color where
108 arbitrary = arbitraryBoundedEnum
129 arbitrary = arbitraryBoundedEnum
109
130
131+invalidColorToJSON :: Color -> Value
132+invalidColorToJSON Red = toJSON "red"
133+invalidColorToJSON Green = toJSON "green"
134+invalidColorToJSON Blue = toJSON "blue"
135+
110-- ========================================================================
136-- ========================================================================
111-- Paint (record with bounded enum property)
137-- Paint (record with bounded enum property)
112-- ========================================================================
138-- ========================================================================
@@ -120,6 +146,9 @@ instance ToSchema Paint
120instance Arbitrary Paint where
146instance Arbitrary Paint where
121 arbitrary = Paint <$> arbitrary
147 arbitrary = Paint <$> arbitrary
122
148
149+invalidPaintToJSON :: Paint -> Value
150+invalidPaintToJSON = toJSON . color
151+
123-- ========================================================================
152-- ========================================================================
124-- MyRoseTree (custom datatypeNameModifier)
153-- MyRoseTree (custom datatypeNameModifier)
125-- ========================================================================
154-- ========================================================================
@@ -161,6 +190,9 @@ instance Arbitrary Light where
161 , LightColor <$> arbitrary
190 , LightColor <$> arbitrary
162 ]
191 ]
163
192
193+invalidLightToJSON :: Light -> Value
194+invalidLightToJSON = genericToJSON defaultOptions
195+
164-- Arbitrary instances for common types
196-- Arbitrary instances for common types
165
197
166instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where
198instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where
@@ -193,4 +225,3 @@ instance Arbitrary ZonedTime where
193
225
194instance Arbitrary UTCTime where
226instance Arbitrary UTCTime where
195 arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
227 arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
196−