git.iko.soy/typeable/swagger2
on master help sign in
Merge pull request #164 from GetShopTV/inferred-schema-type
6448fcfOleg Grenrus
src/Data/Swagger.hs+3−3
compare with master
unifiedsplit
@@ -181,7 +181,7 @@ import Data.Swagger.Internal
181--
181--
182-- >>> :{
182-- >>> :{
183-- encode $ (mempty :: Swagger)
183-- encode $ (mempty :: Swagger)
184−-- & definitions .~ [ ("User", mempty & type_ .~ SwaggerString) ]
184+-- & definitions .~ [ ("User", mempty & type_ ?~ SwaggerString) ]
185-- & paths .~
185-- & paths .~
186-- [ ("/user", mempty & get ?~ (mempty
186-- [ ("/user", mempty & get ?~ (mempty
187-- & produces ?~ MimeList ["application/json"]
187-- & produces ?~ MimeList ["application/json"]
@@ -204,7 +204,7 @@ import Data.Swagger.Internal
204-- "{\"description\":\"No content\"}"
204-- "{\"description\":\"No content\"}"
205-- >>> :{
205-- >>> :{
206-- encode $ (mempty :: Schema)
206-- encode $ (mempty :: Schema)
207−-- & type_ .~ SwaggerBoolean
207+-- & type_ ?~ SwaggerBoolean
208-- & description ?~ "To be or not to be"
208-- & description ?~ "To be or not to be"
209-- :}
209-- :}
210-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"
210-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"
@@ -213,7 +213,7 @@ import Data.Swagger.Internal
213-- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.
213-- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.
214-- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:
214-- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:
215--
215--
216−-- >>> encode $ (mempty :: Header) & type_ .~ SwaggerNumber
216+-- >>> encode $ (mempty :: Header) & type_ ?~ SwaggerNumber
217-- "{\"type\":\"number\"}"
217-- "{\"type\":\"number\"}"
218--
218--
219-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
219-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
src/Data/Swagger/Internal.hs+1−1
@@ -593,7 +593,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
593 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
593 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
594 _paramSchemaDefault :: Maybe Value
594 _paramSchemaDefault :: Maybe Value
595
595
596− , _paramSchemaType :: SwaggerType t
596+ , _paramSchemaType :: Maybe (SwaggerType t)
597 , _paramSchemaFormat :: Maybe Format
597 , _paramSchemaFormat :: Maybe Format
598 , _paramSchemaItems :: Maybe (SwaggerItems t)
598 , _paramSchemaItems :: Maybe (SwaggerItems t)
599 , _paramSchemaMaximum :: Maybe Scientific
599 , _paramSchemaMaximum :: Maybe Scientific
src/Data/Swagger/Internal/ParamSchema.hs+21−21
@@ -59,20 +59,20 @@ import GHC.TypeLits (TypeError, ErrorMessage(..))
59-- | Default schema for binary data (any sequence of octets).
59-- | Default schema for binary data (any sequence of octets).
60binaryParamSchema :: ParamSchema t
60binaryParamSchema :: ParamSchema t
61binaryParamSchema = mempty
61binaryParamSchema = mempty
62− & type_ .~ SwaggerString
62+ & type_ ?~ SwaggerString
63 & format ?~ "binary"
63 & format ?~ "binary"
64
64
65-- | Default schema for binary data (base64 encoded).
65-- | Default schema for binary data (base64 encoded).
66byteParamSchema :: ParamSchema t
66byteParamSchema :: ParamSchema t
67byteParamSchema = mempty
67byteParamSchema = mempty
68− & type_ .~ SwaggerString
68+ & type_ ?~ SwaggerString
69 & format ?~ "byte"
69 & format ?~ "byte"
70
70
71-- | Default schema for password string.
71-- | Default schema for password string.
72-- @"password"@ format is used to hint UIs the input needs to be obscured.
72-- @"password"@ format is used to hint UIs the input needs to be obscured.
73passwordParamSchema :: ParamSchema t
73passwordParamSchema :: ParamSchema t
74passwordParamSchema = mempty
74passwordParamSchema = mempty
75− & type_ .~ SwaggerString
75+ & type_ ?~ SwaggerString
76 & format ?~ "password"
76 & format ?~ "password"
77
77
78-- | Convert a type into a plain @'ParamSchema'@.
78-- | Convert a type into a plain @'ParamSchema'@.
@@ -88,7 +88,7 @@ passwordParamSchema = mempty
88--
88--
89-- instance ToParamSchema Direction where
89-- instance ToParamSchema Direction where
90-- toParamSchema _ = mempty
90-- toParamSchema _ = mempty
91−-- & type_ .~ SwaggerString
91+-- & type_ ?~ SwaggerString
92-- & enum_ ?~ [ \"Up\", \"Down\" ]
92-- & enum_ ?~ [ \"Up\", \"Down\" ]
93-- @
93-- @
94--
94--
@@ -120,17 +120,17 @@ class ToParamSchema a where
120 toParamSchema = genericToParamSchema defaultSchemaOptions
120 toParamSchema = genericToParamSchema defaultSchemaOptions
121
121
122instance OVERLAPPING_ ToParamSchema String where
122instance OVERLAPPING_ ToParamSchema String where
123− toParamSchema _ = mempty & type_ .~ SwaggerString
123+ toParamSchema _ = mempty & type_ ?~ SwaggerString
124
124
125instance ToParamSchema Bool where
125instance ToParamSchema Bool where
126− toParamSchema _ = mempty & type_ .~ SwaggerBoolean
126+ toParamSchema _ = mempty & type_ ?~ SwaggerBoolean
127
127
128instance ToParamSchema Integer where
128instance ToParamSchema Integer where
129− toParamSchema _ = mempty & type_ .~ SwaggerInteger
129+ toParamSchema _ = mempty & type_ ?~ SwaggerInteger
130
130
131instance ToParamSchema Natural where
131instance ToParamSchema Natural where
132 toParamSchema _ = mempty
132 toParamSchema _ = mempty
133− & type_ .~ SwaggerInteger
133+ & type_ ?~ SwaggerInteger
134 & minimum_ ?~ 0
134 & minimum_ ?~ 0
135 & exclusiveMinimum ?~ False
135 & exclusiveMinimum ?~ False
136
136
@@ -156,37 +156,37 @@ instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral
156-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
156-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
157toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema t
157toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema t
158toParamSchemaBoundedIntegral _ = mempty
158toParamSchemaBoundedIntegral _ = mempty
159− & type_ .~ SwaggerInteger
159+ & type_ ?~ SwaggerInteger
160 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
160 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
161 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
161 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
162
162
163instance ToParamSchema Char where
163instance ToParamSchema Char where
164 toParamSchema _ = mempty
164 toParamSchema _ = mempty
165− & type_ .~ SwaggerString
165+ & type_ ?~ SwaggerString
166 & maxLength ?~ 1
166 & maxLength ?~ 1
167 & minLength ?~ 1
167 & minLength ?~ 1
168
168
169instance ToParamSchema Scientific where
169instance ToParamSchema Scientific where
170− toParamSchema _ = mempty & type_ .~ SwaggerNumber
170+ toParamSchema _ = mempty & type_ ?~ SwaggerNumber
171
171
172instance HasResolution a => ToParamSchema (Fixed a) where
172instance HasResolution a => ToParamSchema (Fixed a) where
173 toParamSchema _ = mempty
173 toParamSchema _ = mempty
174− & type_ .~ SwaggerNumber
174+ & type_ ?~ SwaggerNumber
175 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
175 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
176
176
177instance ToParamSchema Double where
177instance ToParamSchema Double where
178 toParamSchema _ = mempty
178 toParamSchema _ = mempty
179− & type_ .~ SwaggerNumber
179+ & type_ ?~ SwaggerNumber
180 & format ?~ "double"
180 & format ?~ "double"
181
181
182instance ToParamSchema Float where
182instance ToParamSchema Float where
183 toParamSchema _ = mempty
183 toParamSchema _ = mempty
184− & type_ .~ SwaggerNumber
184+ & type_ ?~ SwaggerNumber
185 & format ?~ "float"
185 & format ?~ "float"
186
186
187timeParamSchema :: String -> ParamSchema t
187timeParamSchema :: String -> ParamSchema t
188timeParamSchema fmt = mempty
188timeParamSchema fmt = mempty
189− & type_ .~ SwaggerString
189+ & type_ ?~ SwaggerString
190 & format ?~ T.pack fmt
190 & format ?~ T.pack fmt
191
191
192-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
192-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -222,12 +222,12 @@ instance ToParamSchema TL.Text where
222
222
223instance ToParamSchema Version where
223instance ToParamSchema Version where
224 toParamSchema _ = mempty
224 toParamSchema _ = mempty
225− & type_ .~ SwaggerString
225+ & type_ ?~ SwaggerString
226 & pattern ?~ "^\\d+(\\.\\d+)*$"
226 & pattern ?~ "^\\d+(\\.\\d+)*$"
227
227
228instance ToParamSchema SetCookie where
228instance ToParamSchema SetCookie where
229 toParamSchema _ = mempty
229 toParamSchema _ = mempty
230− & type_ .~ SwaggerString
230+ & type_ ?~ SwaggerString
231
231
232
232
233#if __GLASGOW_HASKELL__ < 800
233#if __GLASGOW_HASKELL__ < 800
@@ -254,7 +254,7 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t
254
254
255instance ToParamSchema a => ToParamSchema [a] where
255instance ToParamSchema a => ToParamSchema [a] where
256 toParamSchema _ = mempty
256 toParamSchema _ = mempty
257− & type_ .~ SwaggerArray
257+ & type_ ?~ SwaggerArray
258 & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))
258 & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))
259
259
260instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
260instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
@@ -274,12 +274,12 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
274-- "{\"type\":\"string\",\"enum\":[\"_\"]}"
274-- "{\"type\":\"string\",\"enum\":[\"_\"]}"
275instance ToParamSchema () where
275instance ToParamSchema () where
276 toParamSchema _ = mempty
276 toParamSchema _ = mempty
277− & type_ .~ SwaggerString
277+ & type_ ?~ SwaggerString
278 & enum_ ?~ ["_"]
278 & enum_ ?~ ["_"]
279
279
280instance ToParamSchema UUID where
280instance ToParamSchema UUID where
281 toParamSchema _ = mempty
281 toParamSchema _ = mempty
282− & type_ .~ SwaggerString
282+ & type_ ?~ SwaggerString
283 & format ?~ "uuid"
283 & format ?~ "uuid"
284
284
285-- | A configurable generic @'ParamSchema'@ creator.
285-- | A configurable generic @'ParamSchema'@ creator.
@@ -317,7 +317,7 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g)
317
317
318instance Constructor c => GEnumParamSchema (C1 c U1) where
318instance Constructor c => GEnumParamSchema (C1 c U1) where
319 genumParamSchema opts _ s = s
319 genumParamSchema opts _ s = s
320− & type_ .~ SwaggerString
320+ & type_ ?~ SwaggerString
321 & enum_ %~ addEnumValue tag
321 & enum_ %~ addEnumValue tag
322 where
322 where
323 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
323 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
src/Data/Swagger/Internal/Schema.hs+28−28
@@ -111,7 +111,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
111-- declareNamedSchema _ = do
111-- declareNamedSchema _ = do
112-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
112-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
113-- return $ NamedSchema (Just \"Coord\") $ mempty
113-- return $ NamedSchema (Just \"Coord\") $ mempty
114−-- & type_ .~ SwaggerObject
114+-- & type_ ?~ SwaggerObject
115-- & properties .~
115-- & properties .~
116-- [ (\"x\", doubleSchema)
116-- [ (\"x\", doubleSchema)
117-- , (\"y\", doubleSchema)
117-- , (\"y\", doubleSchema)
@@ -294,20 +294,20 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
294-- | Default schema for binary data (any sequence of octets).
294-- | Default schema for binary data (any sequence of octets).
295binarySchema :: Schema
295binarySchema :: Schema
296binarySchema = mempty
296binarySchema = mempty
297− & type_ .~ SwaggerString
297+ & type_ ?~ SwaggerString
298 & format ?~ "binary"
298 & format ?~ "binary"
299
299
300-- | Default schema for binary data (base64 encoded).
300-- | Default schema for binary data (base64 encoded).
301byteSchema :: Schema
301byteSchema :: Schema
302byteSchema = mempty
302byteSchema = mempty
303− & type_ .~ SwaggerString
303+ & type_ ?~ SwaggerString
304 & format ?~ "byte"
304 & format ?~ "byte"
305
305
306-- | Default schema for password string.
306-- | Default schema for password string.
307-- @"password"@ format is used to hint UIs the input needs to be obscured.
307-- @"password"@ format is used to hint UIs the input needs to be obscured.
308passwordSchema :: Schema
308passwordSchema :: Schema
309passwordSchema = mempty
309passwordSchema = mempty
310− & type_ .~ SwaggerString
310+ & type_ ?~ SwaggerString
311 & format ?~ "password"
311 & format ?~ "password"
312
312
313-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
313-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
@@ -333,12 +333,12 @@ sketchSchema = sketch . toJSON
333 sketch js@(Bool _) = go js
333 sketch js@(Bool _) = go js
334 sketch js = go js & example ?~ js
334 sketch js = go js & example ?~ js
335
335
336− go Null = mempty & type_ .~ SwaggerNull
336+ go Null = mempty & type_ ?~ SwaggerNull
337− go (Bool _) = mempty & type_ .~ SwaggerBoolean
337+ go (Bool _) = mempty & type_ ?~ SwaggerBoolean
338− go (String _) = mempty & type_ .~ SwaggerString
338+ go (String _) = mempty & type_ ?~ SwaggerString
339− go (Number _) = mempty & type_ .~ SwaggerNumber
339+ go (Number _) = mempty & type_ ?~ SwaggerNumber
340 go (Array xs) = mempty
340 go (Array xs) = mempty
341− & type_ .~ SwaggerArray
341+ & type_ ?~ SwaggerArray
342 & items ?~ case ischema of
342 & items ?~ case ischema of
343 Just s -> SwaggerItemsObject (Inline s)
343 Just s -> SwaggerItemsObject (Inline s)
344 _ -> SwaggerItemsArray (map Inline ys)
344 _ -> SwaggerItemsArray (map Inline ys)
@@ -350,7 +350,7 @@ sketchSchema = sketch . toJSON
350 (z:_) | allSame -> Just z
350 (z:_) | allSame -> Just z
351 _ -> Nothing
351 _ -> Nothing
352 go (Object o) = mempty
352 go (Object o) = mempty
353− & type_ .~ SwaggerObject
353+ & type_ ?~ SwaggerObject
354 & required .~ HashMap.keys o
354 & required .~ HashMap.keys o
355 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
355 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
356
356
@@ -373,24 +373,24 @@ sketchSchema = sketch . toJSON
373sketchStrictSchema :: ToJSON a => a -> Schema
373sketchStrictSchema :: ToJSON a => a -> Schema
374sketchStrictSchema = go . toJSON
374sketchStrictSchema = go . toJSON
375 where
375 where
376− go Null = mempty & type_ .~ SwaggerNull
376+ go Null = mempty & type_ ?~ SwaggerNull
377 go js@(Bool _) = mempty
377 go js@(Bool _) = mempty
378− & type_ .~ SwaggerBoolean
378+ & type_ ?~ SwaggerBoolean
379 & enum_ ?~ [js]
379 & enum_ ?~ [js]
380 go js@(String s) = mempty
380 go js@(String s) = mempty
381− & type_ .~ SwaggerString
381+ & type_ ?~ SwaggerString
382 & maxLength ?~ fromIntegral (T.length s)
382 & maxLength ?~ fromIntegral (T.length s)
383 & minLength ?~ fromIntegral (T.length s)
383 & minLength ?~ fromIntegral (T.length s)
384 & pattern ?~ s
384 & pattern ?~ s
385 & enum_ ?~ [js]
385 & enum_ ?~ [js]
386 go js@(Number n) = mempty
386 go js@(Number n) = mempty
387− & type_ .~ SwaggerNumber
387+ & type_ ?~ SwaggerNumber
388 & maximum_ ?~ n
388 & maximum_ ?~ n
389 & minimum_ ?~ n
389 & minimum_ ?~ n
390 & multipleOf ?~ n
390 & multipleOf ?~ n
391 & enum_ ?~ [js]
391 & enum_ ?~ [js]
392 go js@(Array xs) = mempty
392 go js@(Array xs) = mempty
393− & type_ .~ SwaggerArray
393+ & type_ ?~ SwaggerArray
394 & maxItems ?~ fromIntegral sz
394 & maxItems ?~ fromIntegral sz
395 & minItems ?~ fromIntegral sz
395 & minItems ?~ fromIntegral sz
396 & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
396 & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
@@ -400,7 +400,7 @@ sketchStrictSchema = go . toJSON
400 sz = length xs
400 sz = length xs
401 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
401 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
402 go js@(Object o) = mempty
402 go js@(Object o) = mempty
403− & type_ .~ SwaggerObject
403+ & type_ ?~ SwaggerObject
404 & required .~ names
404 & required .~ names
405 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
405 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
406 & maxProperties ?~ fromIntegral (length names)
406 & maxProperties ?~ fromIntegral (length names)
@@ -416,7 +416,7 @@ instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
416 declareNamedSchema _ = do
416 declareNamedSchema _ = do
417 ref <- declareSchemaRef (Proxy :: Proxy a)
417 ref <- declareSchemaRef (Proxy :: Proxy a)
418 return $ unnamed $ mempty
418 return $ unnamed $ mempty
419− & type_ .~ SwaggerArray
419+ & type_ ?~ SwaggerArray
420 & items ?~ SwaggerItemsObject ref
420 & items ?~ SwaggerItemsObject ref
421
421
422instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
422instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
@@ -466,7 +466,7 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f
466
466
467timeSchema :: T.Text -> Schema
467timeSchema :: T.Text -> Schema
468timeSchema fmt = mempty
468timeSchema fmt = mempty
469− & type_ .~ SwaggerString
469+ & type_ ?~ SwaggerString
470 & format ?~ fmt
470 & format ?~ fmt
471
471
472-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
472-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -528,7 +528,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
528 declareObjectMapSchema = do
528 declareObjectMapSchema = do
529 schema <- declareSchemaRef (Proxy :: Proxy v)
529 schema <- declareSchemaRef (Proxy :: Proxy v)
530 return $ unnamed $ mempty
530 return $ unnamed $ mempty
531− & type_ .~ SwaggerObject
531+ & type_ ?~ SwaggerObject
532 & additionalProperties ?~ AdditionalPropertiesSchema schema
532 & additionalProperties ?~ AdditionalPropertiesSchema schema
533
533
534instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
534instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
@@ -540,7 +540,7 @@ instance ToSchema a => ToSchema (Map String a) where
540 declareNamedSchema _ = do
540 declareNamedSchema _ = do
541 schema <- declareSchemaRef (Proxy :: Proxy a)
541 schema <- declareSchemaRef (Proxy :: Proxy a)
542 return $ unnamed $ mempty
542 return $ unnamed $ mempty
543− & type_ .~ SwaggerObject
543+ & type_ ?~ SwaggerObject
544 & additionalProperties ?~ schema
544 & additionalProperties ?~ schema
545
545
546instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
546instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
@@ -554,7 +554,7 @@ instance ToSchema a => ToSchema (HashMap TL.Text a) where declareNamedSchema _ =
554
554
555instance OVERLAPPING_ ToSchema Object where
555instance OVERLAPPING_ ToSchema Object where
556 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
556 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
557− & type_ .~ SwaggerObject
557+ & type_ ?~ SwaggerObject
558 & description ?~ "Arbitrary JSON object."
558 & description ?~ "Arbitrary JSON object."
559 & additionalProperties ?~ AdditionalPropertiesAllowed True
559 & additionalProperties ?~ AdditionalPropertiesAllowed True
560
560
@@ -595,7 +595,7 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
595-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
595-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
596toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
596toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
597toSchemaBoundedIntegral _ = mempty
597toSchemaBoundedIntegral _ = mempty
598− & type_ .~ SwaggerInteger
598+ & type_ ?~ SwaggerInteger
599 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
599 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
600 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
600 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
601
601
@@ -641,7 +641,7 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
641 let allKeys = [minBound..maxBound :: key]
641 let allKeys = [minBound..maxBound :: key]
642 mkPair k = (keyToText k, valueRef)
642 mkPair k = (keyToText k, valueRef)
643 return $ mempty
643 return $ mempty
644− & type_ .~ SwaggerObject
644+ & type_ ?~ SwaggerObject
645 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
645 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
646
646
647-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
647-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -715,7 +715,7 @@ paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
715
715
716nullarySchema :: Schema
716nullarySchema :: Schema
717nullarySchema = mempty
717nullarySchema = mempty
718− & type_ .~ SwaggerArray
718+ & type_ ?~ SwaggerArray
719 & items ?~ SwaggerItemsArray []
719 & items ?~ SwaggerItemsArray []
720
720
721gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
721gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
@@ -786,12 +786,12 @@ withFieldSchema opts _ isRequiredField schema = do
786 return $
786 return $
787 if T.null fname
787 if T.null fname
788 then schema
788 then schema
789− & type_ .~ SwaggerArray
789+ & type_ ?~ SwaggerArray
790 & items %~ appendItem ref
790 & items %~ appendItem ref
791 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
791 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
792 & minItems %~ Just . maybe 1 (+1) -- increment minItems
792 & minItems %~ Just . maybe 1 (+1) -- increment minItems
793 else schema
793 else schema
794− & type_ .~ SwaggerObject
794+ & type_ ?~ SwaggerObject
795 & properties . at fname ?~ ref
795 & properties . at fname ?~ ref
796 & if isRequiredField
796 & if isRequiredField
797 then required %~ (++ [fname])
797 then required %~ (++ [fname])
@@ -828,7 +828,7 @@ gdeclareNamedSumSchema opts proxy s
828 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
828 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
829
829
830 toStringTag schema = mempty
830 toStringTag schema = mempty
831− & type_ .~ SwaggerString
831+ & type_ ?~ SwaggerString
832 & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
832 & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
833
833
834type AllNullary = All
834type AllNullary = All
@@ -842,7 +842,7 @@ instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
842gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
842gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
843 Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
843 Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
844gsumConToSchemaWith ref opts _ schema = schema
844gsumConToSchemaWith ref opts _ schema = schema
845− & type_ .~ SwaggerObject
845+ & type_ ?~ SwaggerObject
846 & properties . at tag ?~ ref
846 & properties . at tag ?~ ref
847 & maxProperties ?~ 1
847 & maxProperties ?~ 1
848 & minProperties ?~ 1
848 & minProperties ?~ 1
src/Data/Swagger/Internal/Schema/Validation.hs+110−37
@@ -1,15 +1,17 @@
1+{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE DataKinds #-}
1−{-# LANGUAGE DeriveFunctor #-}
3+{-# LANGUAGE DeriveFunctor #-}
2−{-# LANGUAGE FlexibleInstances #-}
4+{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE FunctionalDependencies #-}
5+{-# LANGUAGE FunctionalDependencies #-}
4−{-# LANGUAGE GADTs #-}
6+{-# LANGUAGE GADTs #-}
5{-# LANGUAGE GeneralizedNewtypeDeriving #-}
7{-# LANGUAGE GeneralizedNewtypeDeriving #-}
6−{-# LANGUAGE LambdaCase #-}
8+{-# LANGUAGE LambdaCase #-}
7−{-# LANGUAGE MultiParamTypeClasses #-}
9+{-# LANGUAGE MultiParamTypeClasses #-}
8−{-# LANGUAGE PackageImports #-}
10+{-# LANGUAGE PackageImports #-}
9−{-# LANGUAGE RankNTypes #-}
11+{-# LANGUAGE RankNTypes #-}
10−{-# LANGUAGE ScopedTypeVariables #-}
12+{-# LANGUAGE ScopedTypeVariables #-}
11−{-# LANGUAGE TemplateHaskell #-}
13+{-# LANGUAGE TemplateHaskell #-}
12−{-# LANGUAGE UndecidableInstances #-}
14+{-# LANGUAGE UndecidableInstances #-}
13-- |
15-- |
14-- Module: Data.Swagger.Internal.Schema.Validation
16-- Module: Data.Swagger.Internal.Schema.Validation
15-- Copyright: (c) 2015 GetShopTV
17-- Copyright: (c) 2015 GetShopTV
@@ -20,28 +22,30 @@
20-- Validate JSON values with Swagger Schema.
22-- Validate JSON values with Swagger Schema.
21module Data.Swagger.Internal.Schema.Validation where
23module Data.Swagger.Internal.Schema.Validation where
22
24
23−import Control.Applicative
25+import Control.Applicative
24−import Control.Lens
26+import Control.Lens
25−import Control.Monad (when)
27+import Control.Monad (when)
26
28
27−import Data.Aeson hiding (Result)
29+import Data.Aeson hiding (Result)
28−import Data.Foldable (traverse_, for_, sequenceA_)
30+import Data.Foldable (for_, sequenceA_,
31+ traverse_)
29−import Data.HashMap.Strict (HashMap)
32+import Data.HashMap.Strict (HashMap)
30−import qualified Data.HashMap.Strict as HashMap
33+import qualified Data.HashMap.Strict as HashMap
34+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
31import qualified "unordered-containers" Data.HashSet as HashSet
35import qualified "unordered-containers" Data.HashSet as HashSet
32−import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
36+import Data.List (intercalate)
33−import Data.Monoid
37+import Data.Monoid
34−import Data.Proxy
38+import Data.Proxy
35−import Data.Scientific (Scientific, isInteger)
39+import Data.Scientific (Scientific, isInteger)
36−import Data.Text (Text)
40+import Data.Text (Text)
37−import qualified Data.Text as Text
41+import qualified Data.Text as Text
38−import Data.Vector (Vector)
42+import Data.Vector (Vector)
39−import qualified Data.Vector as Vector
43+import qualified Data.Vector as Vector
40−
44+
41−import Data.Swagger.Declare
45+import Data.Swagger.Declare
42−import Data.Swagger.Internal
46+import Data.Swagger.Internal
43−import Data.Swagger.Internal.Schema
47+import Data.Swagger.Internal.Schema
44−import Data.Swagger.Lens
48+import Data.Swagger.Lens
45
49
46-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
50-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
47-- This can be used with QuickCheck to ensure those instances are coherent:
51-- This can be used with QuickCheck to ensure those instances are coherent:
@@ -320,8 +324,8 @@ validateObject o = withSchema $ \sch ->
320 validateAdditional _ v (AdditionalPropertiesSchema s) = validateWithSchemaRef s v
324 validateAdditional _ v (AdditionalPropertiesSchema s) = validateWithSchemaRef s v
321
325
322 unknownProperty :: Text -> Validation s a
326 unknownProperty :: Text -> Validation s a
323− unknownProperty name = invalid $
327+ unknownProperty pname = invalid $
324− "property " <> show name <> " is found in JSON value, but it is not mentioned in Swagger schema"
328+ "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"
325
329
326validateEnum :: Value -> Validation (ParamSchema t) ()
330validateEnum :: Value -> Validation (ParamSchema t) ()
327validateEnum value = do
331validateEnum value = do
@@ -329,9 +333,67 @@ validateEnum value = do
329 when (value `notElem` xs) $
333 when (value `notElem` xs) $
330 invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)
334 invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)
331
335
336+-- | Infer schema type based on used properties.
337+--
338+-- This is like 'inferParamSchemaTypes', but also works for objects:
339+--
340+-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"
341+-- Just [SwaggerObject]
342+inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]
343+inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++
344+ [ SwaggerObject | any ($ sch)
345+ [ has (additionalProperties._Just)
346+ , has (maxProperties._Just)
347+ , has (minProperties._Just)
348+ , has (properties.folded)
349+ , has (required.folded) ] ]
350+
351+-- | Infer schema type based on used properties.
352+--
353+-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"
354+-- Just [SwaggerString]
355+--
356+-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"
357+-- Just [SwaggerArray]
358+--
359+-- From numeric properties 'SwaggerInteger' type is inferred.
360+-- If you want 'SwaggerNumber' instead, you must specify it explicitly.
361+--
362+-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"
363+-- Just [SwaggerInteger]
364+inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]
365+inferParamSchemaTypes sch = concat
366+ [ [ SwaggerArray | any ($ sch)
367+ [ has (items._Just)
368+ , has (maxItems._Just)
369+ , has (minItems._Just)
370+ , has (uniqueItems._Just) ] ]
371+ , [ SwaggerInteger | any ($ sch)
372+ [ has (exclusiveMaximum._Just)
373+ , has (exclusiveMinimum._Just)
374+ , has (maximum_._Just)
375+ , has (minimum_._Just)
376+ , has (multipleOf._Just) ] ]
377+ , [ SwaggerString | any ($ sch)
378+ [ has (maxLength._Just)
379+ , has (minLength._Just)
380+ , has (pattern._Just) ] ]
381+ ]
382+
332validateSchemaType :: Value -> Validation Schema ()
383validateSchemaType :: Value -> Validation Schema ()
333validateSchemaType value = withSchema $ \sch ->
384validateSchemaType value = withSchema $ \sch ->
334− case (sch ^. type_, value) of
385+ case sch ^. type_ of
386+ Just explicitType -> validateSchemaTypeAs explicitType value
387+ Nothing ->
388+ case inferSchemaTypes sch of
389+ [t] -> validateSchemaTypeAs t value
390+ [] -> invalid $ "unable to infer type for schema, please provide type explicitly"
391+ ts -> invalid $ "unable to infer type for schema, possible candidates: " ++ intercalate ", " (map show ts)
392+
393+validateSchemaTypeAs
394+ :: SwaggerType 'SwaggerKindSchema -> Value -> Validation Schema ()
395+validateSchemaTypeAs t value =
396+ case (t, value) of
335 (SwaggerNull, Null) -> valid
397 (SwaggerNull, Null) -> valid
336 (SwaggerBoolean, Bool _) -> valid
398 (SwaggerBoolean, Bool _) -> valid
337 (SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)
399 (SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)
@@ -339,15 +401,26 @@ validateSchemaType value = withSchema $ \sch ->
339 (SwaggerString, String s) -> sub_ paramSchema (validateString s)
401 (SwaggerString, String s) -> sub_ paramSchema (validateString s)
340 (SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)
402 (SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)
341 (SwaggerObject, Object o) -> validateObject o
403 (SwaggerObject, Object o) -> validateObject o
342− (t, _) -> invalid $ "expected JSON value of type " ++ show t
404+ _ -> invalid $ "expected JSON value of type " ++ show t
343
405
344validateParamSchemaType :: Value -> Validation (ParamSchema t) ()
406validateParamSchemaType :: Value -> Validation (ParamSchema t) ()
345validateParamSchemaType value = withSchema $ \sch ->
407validateParamSchemaType value = withSchema $ \sch ->
346− case (sch ^. type_, value) of
408+ case sch ^. type_ of
409+ Just explicitType -> validateParamSchemaTypeAs explicitType value
410+ Nothing ->
411+ case inferParamSchemaTypes sch of
412+ [t] -> validateParamSchemaTypeAs t value
413+ [] -> invalid $ "unable to infer type for schema, please provide type explicitly"
414+ ts -> invalid $ "unable to infer type for schema, possible candidates: " ++ intercalate ", " (map show ts)
415+
416+validateParamSchemaTypeAs
417+ :: SwaggerType t -> Value -> Validation (ParamSchema t) ()
418+validateParamSchemaTypeAs t value =
419+ case (t, value) of
347 (SwaggerBoolean, Bool _) -> valid
420 (SwaggerBoolean, Bool _) -> valid
348 (SwaggerInteger, Number n) -> validateInteger n
421 (SwaggerInteger, Number n) -> validateInteger n
349 (SwaggerNumber, Number n) -> validateNumber n
422 (SwaggerNumber, Number n) -> validateNumber n
350 (SwaggerString, String s) -> validateString s
423 (SwaggerString, String s) -> validateString s
351 (SwaggerArray, Array xs) -> validateArray xs
424 (SwaggerArray, Array xs) -> validateArray xs
352− (t, _) -> invalid $ "expected JSON value of type " ++ show t
425+ _ -> invalid $ "expected JSON value of type " ++ show t
353
426
src/Data/Swagger/Lens.hs+4−4
@@ -99,10 +99,10 @@ instance At Operation where at n = responses . at n
99instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema
99instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema
100
100
101-- HasType instances
101-- HasType instances
102−instance HasType Header (SwaggerType ('SwaggerKindNormal Header)) where type_ = paramSchema.type_
102+instance HasType Header (Maybe (SwaggerType ('SwaggerKindNormal Header))) where type_ = paramSchema.type_
103−instance HasType Schema (SwaggerType 'SwaggerKindSchema) where type_ = paramSchema.type_
103+instance HasType Schema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_
104−instance HasType NamedSchema (SwaggerType 'SwaggerKindSchema) where type_ = paramSchema.type_
104+instance HasType NamedSchema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_
105−instance HasType ParamOtherSchema (SwaggerType 'SwaggerKindParamOtherSchema) where type_ = paramSchema.type_
105+instance HasType ParamOtherSchema (Maybe (SwaggerType 'SwaggerKindParamOtherSchema)) where type_ = paramSchema.type_
106
106
107-- HasDefault instances
107-- HasDefault instances
108instance HasDefault Header (Maybe Value) where default_ = paramSchema.default_
108instance HasDefault Header (Maybe Value) where default_ = paramSchema.default_
src/Data/Swagger/Schema/Generator.hs+19−14
@@ -4,24 +4,25 @@
4
4
5module Data.Swagger.Schema.Generator where
5module Data.Swagger.Schema.Generator where
6
6
7−import Prelude ()
7+import Prelude ()
8import Prelude.Compat
8import Prelude.Compat
9
9
10import Control.Lens.Operators
10import Control.Lens.Operators
11−import Control.Monad (filterM)
11+import Control.Monad (filterM)
12import Data.Aeson
12import Data.Aeson
13import Data.Aeson.Types
13import Data.Aeson.Types
14−import qualified Data.HashMap.Strict.InsOrd as M
14+import qualified Data.HashMap.Strict.InsOrd as M
15import Data.Maybe
15import Data.Maybe
16import Data.Maybe
16import Data.Maybe
17import Data.Proxy
17import Data.Proxy
18import Data.Scientific
18import Data.Scientific
19−import qualified Data.Set as S
19+import qualified Data.Set as S
20import Data.Swagger
20import Data.Swagger
21import Data.Swagger.Declare
21import Data.Swagger.Declare
22+import Data.Swagger.Internal.Schema.Validation (inferSchemaTypes)
22−import qualified Data.Text as T
23+import qualified Data.Text as T
23−import qualified Data.Vector as V
24+import qualified Data.Vector as V
24−import Test.QuickCheck (arbitrary)
25+import Test.QuickCheck (arbitrary)
25import Test.QuickCheck.Gen
26import Test.QuickCheck.Gen
26import Test.QuickCheck.Property
27import Test.QuickCheck.Property
27
28
@@ -30,21 +31,25 @@ schemaGen _ schema
30 | Just cases <- schema ^. paramSchema . enum_ = elements cases
31 | Just cases <- schema ^. paramSchema . enum_ = elements cases
31schemaGen defns schema =
32schemaGen defns schema =
32 case schema ^. type_ of
33 case schema ^. type_ of
34+ Nothing ->
35+ case inferSchemaTypes schema of
36+ [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)
37+ _ -> fail "unable to infer schema type"
33− SwaggerBoolean -> Bool <$> elements [True, False]
38+ Just SwaggerBoolean -> Bool <$> elements [True, False]
34− SwaggerNull -> pure Null
39+ Just SwaggerNull -> pure Null
35− SwaggerNumber
40+ Just SwaggerNumber
36 | Just min <- schema ^. minimum_
41 | Just min <- schema ^. minimum_
37 , Just max <- schema ^. maximum_ ->
42 , Just max <- schema ^. maximum_ ->
38 Number . fromFloatDigits <$>
43 Number . fromFloatDigits <$>
39 choose (toRealFloat min, toRealFloat max :: Double)
44 choose (toRealFloat min, toRealFloat max :: Double)
40 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)
45 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)
41− SwaggerInteger
46+ Just SwaggerInteger
42 | Just min <- schema ^. minimum_
47 | Just min <- schema ^. minimum_
43 , Just max <- schema ^. maximum_ ->
48 , Just max <- schema ^. maximum_ ->
44 Number . fromInteger <$>
49 Number . fromInteger <$>
45 choose (truncate min, truncate max)
50 choose (truncate min, truncate max)
46 | otherwise -> Number . fromInteger <$> arbitrary
51 | otherwise -> Number . fromInteger <$> arbitrary
47− SwaggerArray
52+ Just SwaggerArray
48 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
53 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
49 | Just items <- schema ^. items ->
54 | Just items <- schema ^. items ->
50 case items of
55 case items of
@@ -59,14 +64,14 @@ schemaGen defns schema =
59 SwaggerItemsArray refs ->
64 SwaggerItemsArray refs ->
60 let itemGens = schemaGen defns . dereference defns <$> refs
65 let itemGens = schemaGen defns . dereference defns <$> refs
61 in fmap (Array . V.fromList) $ sequence itemGens
66 in fmap (Array . V.fromList) $ sequence itemGens
62− SwaggerString -> do
67+ Just SwaggerString -> do
63 size <- getSize
68 size <- getSize
64 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
69 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
65 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
70 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
66 length <- choose (minLength', max minLength' maxLength')
71 length <- choose (minLength', max minLength' maxLength')
67 str <- vectorOf length arbitrary
72 str <- vectorOf length arbitrary
68 return . String $ T.pack str
73 return . String $ T.pack str
69− SwaggerObject -> do
74+ Just SwaggerObject -> do
70 size <- getSize
75 size <- getSize
71 let props = dereference defns <$> schema ^. properties
76 let props = dereference defns <$> schema ^. properties
72 reqKeys = S.fromList $ schema ^. required
77 reqKeys = S.fromList $ schema ^. required
test/Data/Swagger/Schema/GeneratorSpec.hs+4−4
@@ -103,7 +103,7 @@ instance FromJSON WrongType where
103instance ToSchema WrongType where
103instance ToSchema WrongType where
104 declareNamedSchema _ = return . NamedSchema (Just "WrongType") $
104 declareNamedSchema _ = return . NamedSchema (Just "WrongType") $
105 mempty
105 mempty
106− & type_ .~ SwaggerObject
106+ & type_ ?~ SwaggerObject
107
107
108
108
109data MissingRequired = MissingRequired
109data MissingRequired = MissingRequired
@@ -123,7 +123,7 @@ instance ToSchema MissingRequired where
123 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)
123 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)
124 return . NamedSchema (Just "MissingRequired") $
124 return . NamedSchema (Just "MissingRequired") $
125 mempty
125 mempty
126− & type_ .~ SwaggerObject
126+ & type_ ?~ SwaggerObject
127 & properties .~ [("propA", stringSchema)
127 & properties .~ [("propA", stringSchema)
128 ,("propB", boolSchema)
128 ,("propB", boolSchema)
129 ]
129 ]
@@ -145,7 +145,7 @@ instance ToSchema MissingProperty where
145 stringSchema <- declareSchemaRef (Proxy :: Proxy String)
145 stringSchema <- declareSchemaRef (Proxy :: Proxy String)
146 return . NamedSchema (Just "MissingProperty") $
146 return . NamedSchema (Just "MissingProperty") $
147 mempty
147 mempty
148− & type_ .~ SwaggerObject
148+ & type_ ?~ SwaggerObject
149 & properties .~ [("propC", stringSchema)]
149 & properties .~ [("propC", stringSchema)]
150 & required .~ ["propC"]
150 & required .~ ["propC"]
151
151
@@ -163,6 +163,6 @@ instance ToSchema WrongPropType where
163 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)
163 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)
164 return . NamedSchema (Just "WrongPropType") $
164 return . NamedSchema (Just "WrongPropType") $
165 mempty
165 mempty
166− & type_ .~ SwaggerObject
166+ & type_ ?~ SwaggerObject
167 & properties .~ [("propE", boolSchema)]
167 & properties .~ [("propE", boolSchema)]
168 & required .~ ["propE"]
168 & required .~ ["propE"]
test/Data/Swagger/Schema/ValidationSpec.hs+1−1
@@ -248,7 +248,7 @@ instance ToJSON FreeForm where
248
248
249instance ToSchema FreeForm where
249instance ToSchema FreeForm where
250 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
250 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
251− & type_ .~ SwaggerObject
251+ & type_ ?~ SwaggerObject
252 & additionalProperties ?~ AdditionalPropertiesAllowed True
252 & additionalProperties ?~ AdditionalPropertiesAllowed True
253
253
254instance Arbitrary FreeForm where
254instance Arbitrary FreeForm where
test/Data/SwaggerSpec.hs+26−26
@@ -158,7 +158,7 @@ operationExample = mempty
158 stringSchema :: ParamLocation -> ParamOtherSchema
158 stringSchema :: ParamLocation -> ParamOtherSchema
159 stringSchema loc = mempty
159 stringSchema loc = mempty
160 & in_ .~ loc
160 & in_ .~ loc
161− & type_ .~ SwaggerString
161+ & type_ ?~ SwaggerString
162
162
163operationExampleJSON :: Value
163operationExampleJSON :: Value
164operationExampleJSON = [aesonQQ|
164operationExampleJSON = [aesonQQ|
@@ -224,7 +224,7 @@ operationExampleJSON = [aesonQQ|
224
224
225schemaPrimitiveExample :: Schema
225schemaPrimitiveExample :: Schema
226schemaPrimitiveExample = mempty
226schemaPrimitiveExample = mempty
227− & type_ .~ SwaggerString
227+ & type_ ?~ SwaggerString
228 & format ?~ "email"
228 & format ?~ "email"
229
229
230schemaPrimitiveExampleJSON :: Value
230schemaPrimitiveExampleJSON :: Value
@@ -237,14 +237,14 @@ schemaPrimitiveExampleJSON = [aesonQQ|
237
237
238schemaSimpleModelExample :: Schema
238schemaSimpleModelExample :: Schema
239schemaSimpleModelExample = mempty
239schemaSimpleModelExample = mempty
240− & type_ .~ SwaggerObject
240+ & type_ ?~ SwaggerObject
241 & required .~ [ "name" ]
241 & required .~ [ "name" ]
242 & properties .~
242 & properties .~
243− [ ("name", Inline (mempty & type_ .~ SwaggerString))
243+ [ ("name", Inline (mempty & type_ ?~ SwaggerString))
244 , ("address", Ref (Reference "Address"))
244 , ("address", Ref (Reference "Address"))
245 , ("age", Inline $ mempty
245 , ("age", Inline $ mempty
246 & minimum_ ?~ 0
246 & minimum_ ?~ 0
247− & type_ .~ SwaggerInteger
247+ & type_ ?~ SwaggerInteger
248 & format ?~ "int32" ) ]
248 & format ?~ "int32" ) ]
249
249
250schemaSimpleModelExampleJSON :: Value
250schemaSimpleModelExampleJSON :: Value
@@ -272,8 +272,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|
272
272
273schemaModelDictExample :: Schema
273schemaModelDictExample :: Schema
274schemaModelDictExample = mempty
274schemaModelDictExample = mempty
275− & type_ .~ SwaggerObject
275+ & type_ ?~ SwaggerObject
276− & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ .~ SwaggerString))
276+ & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ SwaggerString))
277
277
278schemaModelDictExampleJSON :: Value
278schemaModelDictExampleJSON :: Value
279schemaModelDictExampleJSON = [aesonQQ|
279schemaModelDictExampleJSON = [aesonQQ|
@@ -287,7 +287,7 @@ schemaModelDictExampleJSON = [aesonQQ|
287
287
288schemaAdditionalExample :: Schema
288schemaAdditionalExample :: Schema
289schemaAdditionalExample = mempty
289schemaAdditionalExample = mempty
290− & type_ .~ SwaggerObject
290+ & type_ ?~ SwaggerObject
291 & additionalProperties ?~ AdditionalPropertiesAllowed True
291 & additionalProperties ?~ AdditionalPropertiesAllowed True
292
292
293schemaAdditionalExampleJSON :: Value
293schemaAdditionalExampleJSON :: Value
@@ -300,13 +300,13 @@ schemaAdditionalExampleJSON = [aesonQQ|
300
300
301schemaWithExampleExample :: Schema
301schemaWithExampleExample :: Schema
302schemaWithExampleExample = mempty
302schemaWithExampleExample = mempty
303− & type_ .~ SwaggerObject
303+ & type_ ?~ SwaggerObject
304 & properties .~
304 & properties .~
305 [ ("id", Inline $ mempty
305 [ ("id", Inline $ mempty
306− & type_ .~ SwaggerInteger
306+ & type_ ?~ SwaggerInteger
307 & format ?~ "int64" )
307 & format ?~ "int64" )
308 , ("name", Inline $ mempty
308 , ("name", Inline $ mempty
309− & type_ .~ SwaggerString) ]
309+ & type_ ?~ SwaggerString) ]
310 & required .~ [ "name" ]
310 & required .~ [ "name" ]
311 & example ?~ [aesonQQ|
311 & example ?~ [aesonQQ|
312 {
312 {
@@ -345,19 +345,19 @@ schemaWithExampleExampleJSON = [aesonQQ|
345definitionsExample :: HashMap Text Schema
345definitionsExample :: HashMap Text Schema
346definitionsExample =
346definitionsExample =
347 [ ("Category", mempty
347 [ ("Category", mempty
348− & type_ .~ SwaggerObject
348+ & type_ ?~ SwaggerObject
349 & properties .~
349 & properties .~
350 [ ("id", Inline $ mempty
350 [ ("id", Inline $ mempty
351− & type_ .~ SwaggerInteger
351+ & type_ ?~ SwaggerInteger
352 & format ?~ "int64")
352 & format ?~ "int64")
353− , ("name", Inline (mempty & type_ .~ SwaggerString)) ] )
353+ , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] )
354 , ("Tag", mempty
354 , ("Tag", mempty
355− & type_ .~ SwaggerObject
355+ & type_ ?~ SwaggerObject
356 & properties .~
356 & properties .~
357 [ ("id", Inline $ mempty
357 [ ("id", Inline $ mempty
358− & type_ .~ SwaggerInteger
358+ & type_ ?~ SwaggerInteger
359 & format ?~ "int64")
359 & format ?~ "int64")
360− , ("name", Inline (mempty & type_ .~ SwaggerString)) ] ) ]
360+ , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] ) ]
361
361
362definitionsExampleJSON :: Value
362definitionsExampleJSON :: Value
363definitionsExampleJSON = [aesonQQ|
363definitionsExampleJSON = [aesonQQ|
@@ -401,7 +401,7 @@ paramsDefinitionExample =
401 & required ?~ True
401 & required ?~ True
402 & schema .~ ParamOther (mempty
402 & schema .~ ParamOther (mempty
403 & in_ .~ ParamQuery
403 & in_ .~ ParamQuery
404− & type_ .~ SwaggerInteger
404+ & type_ ?~ SwaggerInteger
405 & format ?~ "int32" ))
405 & format ?~ "int32" ))
406 , ("limitParam", mempty
406 , ("limitParam", mempty
407 & name .~ "limit"
407 & name .~ "limit"
@@ -409,7 +409,7 @@ paramsDefinitionExample =
409 & required ?~ True
409 & required ?~ True
410 & schema .~ ParamOther (mempty
410 & schema .~ ParamOther (mempty
411 & in_ .~ ParamQuery
411 & in_ .~ ParamQuery
412− & type_ .~ SwaggerInteger
412+ & type_ ?~ SwaggerInteger
413 & format ?~ "int32" )) ]
413 & format ?~ "int32" )) ]
414
414
415paramsDefinitionExampleJSON :: Value
415paramsDefinitionExampleJSON :: Value
@@ -510,7 +510,7 @@ swaggerExample = mempty
510 & at 200 ?~ Inline (mempty
510 & at 200 ?~ Inline (mempty
511 & description .~ "OK"
511 & description .~ "OK"
512 & schema ?~ Inline (mempty
512 & schema ?~ Inline (mempty
513− & type_ .~ SwaggerObject
513+ & type_ ?~ SwaggerObject
514 & example ?~ [aesonQQ|
514 & example ?~ [aesonQQ|
515 {
515 {
516 "created": 100,
516 "created": 100,
@@ -519,9 +519,9 @@ swaggerExample = mempty
519 & description ?~ "This is some real Todo right here"
519 & description ?~ "This is some real Todo right here"
520 & properties .~
520 & properties .~
521 [ ("created", Inline $ mempty
521 [ ("created", Inline $ mempty
522− & type_ .~ SwaggerInteger
522+ & type_ ?~ SwaggerInteger
523 & format ?~ "int32")
523 & format ?~ "int32")
524− , ("description", Inline (mempty & type_ .~ SwaggerString))]))
524+ , ("description", Inline (mempty & type_ ?~ SwaggerString))]))
525 & produces ?~ MimeList [ "application/json" ]
525 & produces ?~ MimeList [ "application/json" ]
526 & parameters .~
526 & parameters .~
527 [ Inline $ mempty
527 [ Inline $ mempty
@@ -530,7 +530,7 @@ swaggerExample = mempty
530 & description ?~ "TodoId param"
530 & description ?~ "TodoId param"
531 & schema .~ ParamOther (mempty
531 & schema .~ ParamOther (mempty
532 & in_ .~ ParamPath
532 & in_ .~ ParamPath
533− & type_ .~ SwaggerString ) ]
533+ & type_ ?~ SwaggerString ) ]
534 & tags .~ Set.fromList [ "todo" ] ))
534 & tags .~ Set.fromList [ "todo" ] ))
535
535
536swaggerExampleJSON :: Value
536swaggerExampleJSON :: Value
@@ -1632,14 +1632,14 @@ petstoreExampleJSON = [aesonQQ|
1632
1632
1633compositionSchemaExample :: Schema
1633compositionSchemaExample :: Schema
1634compositionSchemaExample = mempty
1634compositionSchemaExample = mempty
1635− & type_ .~ SwaggerObject
1635+ & type_ ?~ SwaggerObject
1636 & Data.Swagger.allOf ?~ [
1636 & Data.Swagger.allOf ?~ [
1637 Ref (Reference "Other")
1637 Ref (Reference "Other")
1638 , Inline (mempty
1638 , Inline (mempty
1639− & type_ .~ SwaggerObject
1639+ & type_ ?~ SwaggerObject
1640 & properties .~
1640 & properties .~
1641 [ ("greet", Inline $ mempty
1641 [ ("greet", Inline $ mempty
1642− & type_ .~ SwaggerString) ])
1642+ & type_ ?~ SwaggerString) ])
1643 ]
1643 ]
1644
1644
1645compositionSchemaExampleJSON :: Value
1645compositionSchemaExampleJSON :: Value