@@ -1,6 +1,8 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE DeriveGeneric #-}
33{-# LANGUAGE PackageImports #-}
4+{-# LANGUAGE RecordWildCards #-}
5+{-# LANGUAGE ScopedTypeVariables #-}
46{-# OPTIONS_GHC -fno-warn-orphans #-}
57module Data.Swagger.Schema.ValidationSpec where
68
@@ -24,6 +26,7 @@ import Data.Word
2426import GHC.Generics
2527
2628import Data.Swagger
29+import Data.Swagger.Declare
2730
2831import Test.Hspec
2932import Test.Hspec.QuickCheck
@@ -32,6 +35,11 @@ import Test.QuickCheck
3235shouldValidate :: (ToJSON a, ToSchema a) => Proxy a -> a -> Bool
3336shouldValidate _ x = validateToJSON x == []
3437
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+
3543spec :: Spec
3644spec = do
3745 describe "Validation" $ do
@@ -78,6 +86,12 @@ spec = do
7886 prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
7987 prop "Light" $ shouldValidate (Proxy :: Proxy Light)
8088
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+
8195main :: IO ()
8296main = hspec spec
8397
@@ -96,6 +110,13 @@ instance ToSchema Person
96110instance Arbitrary Person where
97111 arbitrary = Person <$> arbitrary <*> arbitrary <*> arbitrary
98112
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+
99120-- ========================================================================
100121-- Color (enum)
101122-- ========================================================================
@@ -107,6 +128,11 @@ instance ToSchema Color
107128instance Arbitrary Color where
108129 arbitrary = arbitraryBoundedEnum
109130
131+invalidColorToJSON :: Color -> Value
132+invalidColorToJSON Red = toJSON "red"
133+invalidColorToJSON Green = toJSON "green"
134+invalidColorToJSON Blue = toJSON "blue"
135+
110136-- ========================================================================
111137-- Paint (record with bounded enum property)
112138-- ========================================================================
@@ -120,6 +146,9 @@ instance ToSchema Paint
120146instance Arbitrary Paint where
121147 arbitrary = Paint <$> arbitrary
122148
149+invalidPaintToJSON :: Paint -> Value
150+invalidPaintToJSON = toJSON . color
151+
123152-- ========================================================================
124153-- MyRoseTree (custom datatypeNameModifier)
125154-- ========================================================================
@@ -161,6 +190,9 @@ instance Arbitrary Light where
161190 , LightColor <$> arbitrary
162191 ]
163192
193+invalidLightToJSON :: Light -> Value
194+invalidLightToJSON = genericToJSON defaultOptions
195+
164196-- Arbitrary instances for common types
165197
166198instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where
@@ -193,4 +225,3 @@ instance Arbitrary ZonedTime where
193225
194226instance Arbitrary UTCTime where
195227 arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
196−