@@ -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
@@ -15,6 +17,7 @@ import qualified "unordered-containers" Data.HashSet as HashSet
1517import Data.HashMap.Strict (HashMap)
1618import qualified Data.HashMap.Strict as HashMap
1719import Data.Map (Map)
20+import Data.Monoid (mempty)
1821import Data.Proxy
1922import Data.Time
2023import qualified Data.Text as T
@@ -24,6 +27,7 @@ import Data.Word
2427import GHC.Generics
2528
2629import Data.Swagger
30+import Data.Swagger.Declare
2731
2832import Test.Hspec
2933import Test.Hspec.QuickCheck
@@ -32,6 +36,11 @@ import Test.QuickCheck
3236shouldValidate :: (ToJSON a, ToSchema a) => Proxy a -> a -> Bool
3337shouldValidate _ x = validateToJSON x == []
3438
39+shouldNotValidate :: forall a. ToSchema a => (a -> Value) -> a -> Bool
40+shouldNotValidate f = not . null . validateJSON defs sch . f
41+ where
42+ (defs, sch) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
43+
3544spec :: Spec
3645spec = do
3746 describe "Validation" $ do
@@ -77,6 +86,14 @@ spec = do
7786 prop "Paint" $ shouldValidate (Proxy :: Proxy Paint)
7887 prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
7988 prop "Light" $ shouldValidate (Proxy :: Proxy Light)
89+ prop "ButtonImages" $ shouldValidate (Proxy :: Proxy ButtonImages)
90+
91+ describe "invalid cases" $ do
92+ prop "invalidPersonToJSON" $ shouldNotValidate invalidPersonToJSON
93+ prop "invalidColorToJSON" $ shouldNotValidate invalidColorToJSON
94+ prop "invalidPaintToJSON" $ shouldNotValidate invalidPaintToJSON
95+ prop "invalidLightToJSON" $ shouldNotValidate invalidLightToJSON
96+ prop "invalidButtonImagesToJSON" $ shouldNotValidate invalidButtonImagesToJSON
8097
8198main :: IO ()
8299main = hspec spec
@@ -96,6 +113,13 @@ instance ToSchema Person
96113instance Arbitrary Person where
97114 arbitrary = Person <$> arbitrary <*> arbitrary <*> arbitrary
98115
116+invalidPersonToJSON :: Person -> Value
117+invalidPersonToJSON Person{..} = object
118+ [ T.pack "personName" .= toJSON name
119+ , T.pack "personPhone" .= toJSON phone
120+ , T.pack "personEmail" .= toJSON email
121+ ]
122+
99123-- ========================================================================
100124-- Color (enum)
101125-- ========================================================================
@@ -107,6 +131,11 @@ instance ToSchema Color
107131instance Arbitrary Color where
108132 arbitrary = arbitraryBoundedEnum
109133
134+invalidColorToJSON :: Color -> Value
135+invalidColorToJSON Red = toJSON "red"
136+invalidColorToJSON Green = toJSON "green"
137+invalidColorToJSON Blue = toJSON "blue"
138+
110139-- ========================================================================
111140-- Paint (record with bounded enum property)
112141-- ========================================================================
@@ -120,6 +149,9 @@ instance ToSchema Paint
120149instance Arbitrary Paint where
121150 arbitrary = Paint <$> arbitrary
122151
152+invalidPaintToJSON :: Paint -> Value
153+invalidPaintToJSON = toJSON . color
154+
123155-- ========================================================================
124156-- MyRoseTree (custom datatypeNameModifier)
125157-- ========================================================================
@@ -161,6 +193,41 @@ instance Arbitrary Light where
161193 , LightColor <$> arbitrary
162194 ]
163195
196+invalidLightToJSON :: Light -> Value
197+invalidLightToJSON = genericToJSON defaultOptions
198+
199+-- ========================================================================
200+-- ButtonImages (bounded enum key mapping)
201+-- ========================================================================
202+
203+data ButtonState = Neutral | Focus | Active | Hover | Disabled
204+ deriving (Show, Eq, Ord, Bounded, Enum, Generic)
205+
206+instance ToJSON ButtonState
207+instance ToSchema ButtonState
208+instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
209+
210+instance Arbitrary ButtonState where
211+ arbitrary = arbitraryBoundedEnum
212+
213+type ImageUrl = T.Text
214+
215+newtype ButtonImages = ButtonImages { getButtonImages :: Map ButtonState ImageUrl }
216+ deriving (Show, Generic)
217+
218+instance ToJSON ButtonImages where
219+ toJSON = toJSON . getButtonImages
220+
221+instance ToSchema ButtonImages where
222+ declareNamedSchema = genericDeclareNamedSchemaNewtype defaultSchemaOptions
223+ declareSchemaBoundedEnumKeyMapping
224+
225+invalidButtonImagesToJSON :: ButtonImages -> Value
226+invalidButtonImagesToJSON = genericToJSON defaultOptions
227+
228+instance Arbitrary ButtonImages where
229+ arbitrary = ButtonImages <$> arbitrary
230+
164231-- Arbitrary instances for common types
165232
166233instance (Eq k, Hashable k, Arbitrary k, Arbitrary v) => Arbitrary (HashMap k v) where
@@ -193,4 +260,3 @@ instance Arbitrary ZonedTime where
193260
194261instance Arbitrary UTCTime where
195262 arbitrary = UTCTime <$> arbitrary <*> fmap fromInteger (choose (0, 86400))
196−