git.iko.soy/typeable/swagger2
on master help sign in
Validation test for additionalProperties = true

Tests only the simple, positive case of no other schema attributes and arbitrary unnested object values.

commit42f69fd59fc09f6dffc349ab43b19d71ed8cb061 authorMoss Prescott <moss@tvisioninsights.com> dateThu 28 Jun 2018, 14:08 (8 years ago) parente725fd2
1 file changed+27−1
test/Data/Swagger/Schema/ValidationSpec.hs+27−1
test/Data/Swagger/Schema/ValidationSpec.hs+27−1
@@ -7,6 +7,7 @@
77module Data.Swagger.Schema.ValidationSpec where
88
99import Control.Applicative
10+import Control.Lens ((&), (.~), (?~))
1011import Data.Aeson
1112import Data.Aeson.Types
1213import Data.Int
@@ -17,7 +18,7 @@ import qualified "unordered-containers" Data.HashSet as HashSet
1718import Data.HashMap.Strict (HashMap)
1819import qualified Data.HashMap.Strict as HashMap
1920import Data.List.NonEmpty.Compat (NonEmpty(..), nonEmpty)
20−import Data.Map (Map)
21+import Data.Map (Map, fromList)
2122import Data.Monoid (mempty)
2223import Data.Proxy
2324import Data.Time
@@ -92,6 +93,7 @@ spec = do
9293 prop "Light" $ shouldValidate (Proxy :: Proxy Light)
9394 prop "ButtonImages" $ shouldValidate (Proxy :: Proxy ButtonImages)
9495 prop "Version" $ shouldValidate (Proxy :: Proxy Version)
96+ prop "FreeForm" $ shouldValidate (Proxy :: Proxy FreeForm)
9597
9698 describe "invalid cases" $ do
9799 prop "invalidPersonToJSON" $ shouldNotValidate invalidPersonToJSON
@@ -233,5 +235,29 @@ invalidButtonImagesToJSON = genericToJSON defaultOptions
233235instance Arbitrary ButtonImages where
234236 arbitrary = ButtonImages <$> arbitrary
235237
238+-- ========================================================================
239+-- FreeForm (wraps a raw JSON Value)
240+-- ========================================================================
241+
242+data FreeForm = FreeForm { jsonContent :: Map T.Text Value }
243+ deriving (Show, Generic)
244+
245+instance ToJSON FreeForm where
246+ toJSON = toJSON . jsonContent
247+
248+instance ToSchema FreeForm where
249+ declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
250+ & type_ .~ SwaggerObject
251+ & additionalProperties ?~ AdditionalPropertiesAllowed True
252+
253+instance Arbitrary FreeForm where
254+ arbitrary = (FreeForm . fromList) <$> genObj
255+ where
256+ genObj = listOf $ do
257+ k <- arbitrary
258+ v <- oneof [ String <$> arbitrary, Number <$> arbitrary, Bool <$> arbitrary, pure Null ]
259+ pure (k, v)
260+
236261instance Eq ZonedTime where
237262 ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y
263+