git.iko.soy/typeable/swagger2
on master help sign in
Add validation tests for user-defined data types
ee3ddd5Nickolay Kudasov
test/Data/Swagger/Schema/ValidationSpec.hs+76−1
@@ -1,9 +1,12 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DeriveAnyClass #-}
3+{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE PackageImports #-}
4{-# LANGUAGE PackageImports #-}
3module Data.Swagger.Schema.ValidationSpec where
5module Data.Swagger.Schema.ValidationSpec where
4
6
5import Control.Applicative
7import Control.Applicative
6import Data.Aeson
8import Data.Aeson
9+import Data.Aeson.Types
7import Data.Int
10import Data.Int
8import Data.IntMap (IntMap)
11import Data.IntMap (IntMap)
9import qualified Data.IntMap as IntMap
12import qualified Data.IntMap as IntMap
@@ -22,8 +25,10 @@ import qualified Data.Text.Lazy as TL
22import Data.Set (Set)
25import Data.Set (Set)
23import qualified Data.Set as Set
26import qualified Data.Set as Set
24import Data.Word
27import Data.Word
28+import GHC.Generics
25
29
26import Data.Swagger
30import Data.Swagger
31+import Data.Swagger.Declare
27import Data.Swagger.Schema.Validation
32import Data.Swagger.Schema.Validation
28
33
29import SpecCommon
34import SpecCommon
@@ -34,7 +39,8 @@ import Test.QuickCheck
34shouldValidate :: (ToJSON a, ToSchema a) => Proxy a -> a -> Bool
39shouldValidate :: (ToJSON a, ToSchema a) => Proxy a -> a -> Bool
35shouldValidate proxy x = res == Passed ()
40shouldValidate proxy x = res == Passed ()
36 where
41 where
37− res = runValidation (validateWithSchema (toJSON x)) defaultConfig (toSchema proxy)
42+ res = runValidation (validateWithSchema (toJSON x)) defaultConfig { configDefinitions = defs } schema
43+ (defs, schema) = runDeclare (declareSchema proxy) mempty
38
44
39spec :: Spec
45spec :: Spec
40spec = do
46spec = do
@@ -76,10 +82,79 @@ spec = do
76 prop "(Int, String, Double)" $ shouldValidate (Proxy :: Proxy (Int, String, Double))
82 prop "(Int, String, Double)" $ shouldValidate (Proxy :: Proxy (Int, String, Double))
77 prop "(Int, String, Double, [Int])" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int]))
83 prop "(Int, String, Double, [Int])" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int]))
78 prop "(Int, String, Double, [Int], Int)" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int], Int))
84 prop "(Int, String, Double, [Int], Int)" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int], Int))
85+ prop "Person" $ shouldValidate (Proxy :: Proxy Person)
86+ prop "Color" $ shouldValidate (Proxy :: Proxy Color)
87+ prop "Paint" $ shouldValidate (Proxy :: Proxy Paint)
88+ prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
89+ prop "Light" $ shouldValidate (Proxy :: Proxy Light)
79
90
80main :: IO ()
91main :: IO ()
81main = hspec spec
92main = hspec spec
82
93
94+-- ========================================================================
95+-- Person (simple record with optional fields)
96+-- ========================================================================
97+data Person = Person { name :: String , phone :: Integer , email :: Maybe String } deriving (Show, Generic, ToSchema, ToJSON)
98+
99+instance Arbitrary Person where
100+ arbitrary = Person <$> arbitrary <*> arbitrary <*> arbitrary
101+
102+-- ========================================================================
103+-- Color (enum)
104+-- ========================================================================
105+data Color = Red | Green | Blue deriving (Show, Generic, ToSchema, ToJSON, Bounded, Enum)
106+
107+instance Arbitrary Color where
108+ arbitrary = arbitraryBoundedEnum
109+
110+-- ========================================================================
111+-- Paint (record with bounded enum property)
112+-- ========================================================================
113+
114+newtype Paint = Paint { color :: Color }
115+ deriving (Show, Generic, ToSchema, ToJSON)
116+
117+instance Arbitrary Paint where
118+ arbitrary = Paint <$> arbitrary
119+
120+-- ========================================================================
121+-- MyRoseTree (custom datatypeNameModifier)
122+-- ========================================================================
123+
124+data MyRoseTree = MyRoseTree
125+ { root :: String
126+ , trees :: [MyRoseTree]
127+ } deriving (Show, Generic, ToJSON)
128+
129+instance ToSchema MyRoseTree where
130+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
131+ { datatypeNameModifier = drop (length "My") }
132+
133+instance Arbitrary MyRoseTree where
134+ arbitrary = fmap (cut limit) $ MyRoseTree <$> arbitrary <*> (take limit <$> arbitrary)
135+ where
136+ limit = 4
137+ cut 0 (MyRoseTree x _ ) = MyRoseTree x []
138+ cut n (MyRoseTree x xs) = MyRoseTree x (map (cut (n - 1)) xs)
139+
140+-- ========================================================================
141+-- Light (sum type)
142+-- ========================================================================
143+
144+data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic, ToSchema)
145+
146+instance ToJSON Light where
147+ toJSON = genericToJSON defaultOptions { sumEncoding = ObjectWithSingleField }
148+
149+instance Arbitrary Light where
150+ arbitrary = oneof
151+ [ return NoLight
152+ , LightFreq <$> arbitrary
153+ , LightColor <$> arbitrary
154+ ]
155+
156+-- Arbitrary instances for common types
157+
83#if MIN_VERSION_QuickCheck(2,8,2)
158#if MIN_VERSION_QuickCheck(2,8,2)
84#else
159#else
85instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where
160instance (Ord k, Arbitrary k, Arbitrary v) => Arbitrary (Map k v) where