swagger2 1.0 → 1.1

raw patch · 9 files changed

+121/−105 lines, 9 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +14/−0
• src/Data/Swagger.hs +4/−2
• src/Data/Swagger/Internal.hs +43/−67
• src/Data/Swagger/Internal/ParamSchema.hs +29/−8
• src/Data/Swagger/Internal/Schema.hs +6/−10
• src/Data/Swagger/Internal/Utils.hs +14/−4
• src/Data/Swagger/Lens.hs +0/−3
• swagger2.cabal +1/−1
• test/Data/Swagger/SchemaSpec.hs +10/−10

@@ -1,3 +1,17 @@+1.1+---+* Major changes:+    * Put `CollectionFormat` in one place (see [`3cc860d`](https://github.com/GetShopTV/swagger2/commit/3cc860dd3f002ab984f4d0e4ce1d1799f985832e)).++* Minor changes:+    * Use Swagger formats for `Int32`, `Int64`, `Float`, `Double`, `Day` and `ZonedTime` (see [#32](https://github.com/GetShopTV/swagger2/pull/32));+    * Export `HeaderName`, `TagName`, `HttpStatusCode` type synonyms;+    * Add `ToParamSchema` instances for `[a]`, `Set a` and `HashSet a`;+    * Add `Monoid` instances for `Header` and `Example`.++* Fixes:+    * Use overwrite strategy for `HashMap` `SwaggerMonoid` instances by default.+ 1.0 --- * Major changes:

@@ -38,8 +38,9 @@   PathItem(..),    -- ** Operations-  Tag(..),   Operation(..),+  Tag(..),+  TagName,    -- ** Types and formats   SwaggerType(..),@@ -52,8 +53,8 @@   ParamOtherSchema(..),   ParamLocation(..),   ParamName,-  Items(..),   Header(..),+  HeaderName,   Example(..),    -- ** Schemas@@ -65,6 +66,7 @@   -- ** Responses   Responses(..),   Response(..),+  HttpStatusCode,    -- ** Security   SecurityScheme(..),

@@ -211,7 +211,7 @@ data Operation = Operation   { -- | A list of tags for API documentation control.     -- Tags can be used for logical grouping of operations by resources or any other qualifier.-    _operationTags :: [Text]+    _operationTags :: [TagName]      -- | A short summary of what the operation does.     -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.@@ -319,15 +319,21 @@     -- Default value is @False@.   , _paramOtherSchemaAllowEmptyValue :: Maybe Bool -    -- | Determines the format of the array if @'ParamArray'@ is used.-    -- Default value is csv.-  , _paramOtherSchemaCollectionFormat :: Maybe (CollectionFormat Param)-   , _paramOtherSchemaParamSchema :: ParamSchema ParamOtherSchema   } deriving (Eq, Show, Generic, Data, Typeable) +-- | Items for @'SwaggerArray'@ schemas.+--+-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.+-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.+-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.+-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.+--+-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.+--+-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s. data SwaggerItems t where-  SwaggerItemsPrimitive :: Items               -> SwaggerItems t+  SwaggerItemsPrimitive :: Maybe (CollectionFormat t) -> ParamSchema t -> SwaggerItems t   SwaggerItemsObject    :: Referenced Schema   -> SwaggerItems Schema   SwaggerItemsArray     :: [Referenced Schema] -> SwaggerItems Schema @@ -341,9 +347,9 @@ swaggerItemsDataType :: DataType swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr] -instance {-# OVERLAPPABLE #-} Typeable t => Data (SwaggerItems t) where+instance {-# OVERLAPPABLE #-} Data t => Data (SwaggerItems t) where   gunfold k z c = case constrIndex c of-    1 -> k (z SwaggerItemsPrimitive)+    1 -> k (k (z SwaggerItemsPrimitive))     _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."   toConstr _ = swaggerItemsPrimitiveConstr   dataTypeOf _ = swaggerItemsDataType@@ -508,7 +514,7 @@  data Xml = Xml   { -- | Replaces the name of the element/attribute used for the described schema property.-    -- When defined within the @'Items'@ (items), it will affect the name of the individual XML elements within the list.+    -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.     -- When defined alongside type being array (outside the items),     -- it will affect the wrapping element and only if wrapped is true.     -- If wrapped is false, it will be ignored.@@ -534,14 +540,6 @@   , _xmlWrapped :: Maybe Bool   } deriving (Eq, Show, Generic, Data, Typeable) -data Items = Items-  { -- | Determines the format of the array if type array is used.-    -- Default value is @'ItemsCollectionCSV'@.-    _itemsCollectionFormat :: Maybe (CollectionFormat Items)--  , _itemsParamSchema :: ParamSchema Items-  } deriving (Eq, Show, Generic, Data, Typeable)- -- | A container for the expected responses of an operation. -- The container maps a HTTP response code to the expected response. -- It is not expected from the documentation to necessarily cover all possible HTTP response codes,@@ -585,10 +583,6 @@   { -- | A short description of the header.     _headerDescription :: Maybe Text -    -- | Determines the format of the array if type array is used.-    -- Default value is @'ItemsCollectionCSV'@.-  , _headerCollectionFormat :: Maybe (CollectionFormat Items)-   , _headerParamSchema :: ParamSchema Header   } deriving (Eq, Show, Generic, Data, Typeable) @@ -664,11 +658,14 @@   { getSecurityRequirement :: HashMap Text [Text]   } deriving (Eq, Read, Show, Monoid, ToJSON, FromJSON, Data, Typeable) +-- | Tag name.+type TagName = Text+ -- | Allows adding meta data to a single tag that is used by @Operation@. -- It is not mandatory to have a @Tag@ per tag used there. data Tag = Tag   { -- | The name of the tag.-    _tagName :: Text+    _tagName :: TagName      -- | A short description for the tag.     -- GFM syntax can be used for rich text representation.@@ -736,6 +733,10 @@   mempty = genericMempty   mappend = genericMappend +instance Monoid Header where+  mempty = genericMempty+  mappend = genericMappend+ instance Monoid Responses where   mempty = genericMempty   mappend = genericMappend@@ -752,6 +753,10 @@   mempty = genericMempty   mappend = genericMappend +instance Monoid Example where+  mempty = genericMempty+  mappend = genericMappend+ -- ======================================================================= -- SwaggerMonoid helper instances -- =======================================================================@@ -779,43 +784,15 @@   swaggerMempty = ParamQuery   swaggerMappend _ y = y -instance SwaggerMonoid (HashMap Text Schema) where+instance SwaggerMonoid (HashMap FilePath PathItem) where   swaggerMempty = HashMap.empty   swaggerMappend = HashMap.unionWith mappend -instance SwaggerMonoid (HashMap Text (Referenced Schema)) where-  swaggerMempty = HashMap.empty-  swaggerMappend = HashMap.unionWith swaggerMappend- instance Monoid a => SwaggerMonoid (Referenced a) where   swaggerMempty = Inline mempty   swaggerMappend (Inline x) (Inline y) = Inline (x <> y)   swaggerMappend _ y = y -instance SwaggerMonoid (HashMap Text Param) where-  swaggerMempty = HashMap.empty-  swaggerMappend = HashMap.unionWith mappend--instance SwaggerMonoid (HashMap Text Response) where-  swaggerMempty = HashMap.empty-  swaggerMappend = flip HashMap.union--instance SwaggerMonoid (HashMap Text SecurityScheme) where-  swaggerMempty = HashMap.empty-  swaggerMappend = flip HashMap.union--instance SwaggerMonoid (HashMap FilePath PathItem) where-  swaggerMempty = HashMap.empty-  swaggerMappend = HashMap.unionWith mappend--instance SwaggerMonoid (HashMap HeaderName Header) where-  swaggerMempty = HashMap.empty-  swaggerMappend = flip HashMap.union--instance SwaggerMonoid (HashMap HttpStatusCode (Referenced Response)) where-  swaggerMempty = HashMap.empty-  swaggerMappend = flip HashMap.union- instance SwaggerMonoid ParamAnySchema where   swaggerMempty = ParamOther swaggerMempty   swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)@@ -934,13 +911,12 @@ instance ToJSON Header where   toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "header") -instance ToJSON Items where-  toJSON = genericToJSONWithSub "paramSchema" (jsonPrefix "items")- instance ToJSON (SwaggerItems t) where-  toJSON (SwaggerItemsPrimitive x) = toJSON x-  toJSON (SwaggerItemsObject    x) = toJSON x-  toJSON (SwaggerItemsArray     x) = toJSON x+  toJSON (SwaggerItemsPrimitive fmt schema) = object+    [ "collectionFormat" .= fmt+    , "items"            .= schema ]+  toJSON (SwaggerItemsObject x) = object [ "items" .= x ]+  toJSON (SwaggerItemsArray  x) = object [ "items" .= x ]  instance ToJSON Host where   toJSON (Host host mport) = toJSON $@@ -1009,7 +985,7 @@   toJSON CollectionMulti = "multi"  instance ToJSON (ParamSchema t) where-  toJSON = genericToJSON (jsonPrefix "paramSchema")+  toJSON = omitEmpties . genericToJSONWithSub "items" (jsonPrefix "paramSchema")  -- ======================================================================= -- Manual FromJSON instances@@ -1068,11 +1044,10 @@ instance FromJSON Header where   parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "header") -instance FromJSON Items where-  parseJSON = genericParseJSONWithSub "paramSchema" (jsonPrefix "items")--instance {-# OVERLAPPABLE #-} FromJSON (SwaggerItems t) where-  parseJSON js = SwaggerItemsPrimitive <$> parseJSON js+instance {-# OVERLAPPABLE #-} (FromJSON (CollectionFormat t), FromJSON (ParamSchema t)) => FromJSON (SwaggerItems t) where+  parseJSON (Object o) = SwaggerItemsPrimitive+    <$> o .:? "collectionFormat"+    <*> (o .: "items" >>= parseJSON)  instance {-# OVERLAPPING #-} FromJSON (SwaggerItems Schema) where   parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js@@ -1166,16 +1141,17 @@ instance {-# OVERLAPPABLE #-} FromJSON (SwaggerType t) where   parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray] +instance {-# OVERLAPPABLE #-} FromJSON (CollectionFormat t) where+  parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]+ instance FromJSON (CollectionFormat Param) where   parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti] -instance FromJSON (CollectionFormat Items) where-  parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]- -- NOTE: The constraints @FromJSON (SwaggerType t)@ and -- @FromJSON (SwaggerItems t)@ are necessary here! -- Without the constraint the general instance will be used -- that only accepts common types (i.e. NOT object, null or file) -- and primitive array items. instance (FromJSON (SwaggerType t), FromJSON (SwaggerItems t)) => FromJSON (ParamSchema t) where-  parseJSON = genericParseJSON (jsonPrefix "ParamSchema")+  parseJSON = genericParseJSONWithSub "items" (jsonPrefix "ParamSchema")+

@@ -3,6 +3,7 @@ {-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE KindSignatures #-} {-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PackageImports #-} {-# LANGUAGE PolyKinds #-} {-# LANGUAGE ScopedTypeVariables #-} {-# LANGUAGE TypeOperators #-}@@ -15,7 +16,9 @@ import GHC.Generics  import Data.Int+import "unordered-containers" Data.HashSet (HashSet) import Data.Monoid+import Data.Set (Set) import Data.Scientific import qualified Data.Text as T import qualified Data.Text.Lazy as TL@@ -82,9 +85,13 @@ instance ToParamSchema Int    where toParamSchema = toParamSchemaBoundedIntegral instance ToParamSchema Int8   where toParamSchema = toParamSchemaBoundedIntegral instance ToParamSchema Int16  where toParamSchema = toParamSchemaBoundedIntegral-instance ToParamSchema Int32  where toParamSchema = toParamSchemaBoundedIntegral-instance ToParamSchema Int64  where toParamSchema = toParamSchemaBoundedIntegral +instance ToParamSchema Int32 where+  toParamSchema proxy = toParamSchemaBoundedIntegral proxy & schemaFormat ?~ "int32"++instance ToParamSchema Int64 where+  toParamSchema proxy = toParamSchemaBoundedIntegral proxy & schemaFormat ?~ "int64"+ instance ToParamSchema Word   where toParamSchema = toParamSchemaBoundedIntegral instance ToParamSchema Word8  where toParamSchema = toParamSchemaBoundedIntegral instance ToParamSchema Word16 where toParamSchema = toParamSchemaBoundedIntegral@@ -111,21 +118,23 @@   toParamSchema _ = mempty & schemaType .~ SwaggerNumber  instance ToParamSchema Double where-  toParamSchema _ = mempty & schemaType .~ SwaggerNumber+  toParamSchema _ = mempty+    & schemaType   .~ SwaggerNumber+    & schemaFormat ?~ "double"  instance ToParamSchema Float where-  toParamSchema _ = mempty & schemaType .~ SwaggerNumber+  toParamSchema _ = mempty+    & schemaType   .~ SwaggerNumber+    & schemaFormat ?~ "float"  timeParamSchema :: String -> ParamSchema t timeParamSchema format = mempty   & schemaType      .~ SwaggerString   & schemaFormat    ?~ T.pack format --- |--- >>> toParamSchema (Proxy :: Proxy Day) ^. schemaFormat--- Just "yyyy-mm-dd"+-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format. instance ToParamSchema Day where-  toParamSchema _ = timeParamSchema "yyyy-mm-dd"+  toParamSchema _ = timeParamSchema "date"  -- | -- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. schemaFormat@@ -161,6 +170,18 @@ instance ToParamSchema a => ToParamSchema (First a)   where toParamSchema _ = toParamSchema (Proxy :: Proxy a) instance ToParamSchema a => ToParamSchema (Last a)    where toParamSchema _ = toParamSchema (Proxy :: Proxy a) instance ToParamSchema a => ToParamSchema (Dual a)    where toParamSchema _ = toParamSchema (Proxy :: Proxy a)++instance ToParamSchema a => ToParamSchema [a] where+  toParamSchema _ = mempty+    & schemaType  .~ SwaggerArray+    & schemaItems ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))++instance ToParamSchema a => ToParamSchema (Set a) where+  toParamSchema _ = toParamSchema (Proxy :: Proxy [a])+    & schemaUniqueItems ?~ True++instance ToParamSchema a => ToParamSchema (HashSet a) where+  toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))  -- | -- >>> encode $ toParamSchema (Proxy :: Proxy ())

@@ -128,7 +128,7 @@ -- (Nothing,"{\"type\":\"string\"}") -- -- >>> encode <$> toNamedSchema (Proxy :: Proxy Day)--- (Just "Day","{\"format\":\"yyyy-mm-dd\",\"type\":\"string\"}")+-- (Just "Day","{\"format\":\"date\",\"type\":\"string\"}") toNamedSchema :: ToSchema a => proxy a -> NamedSchema toNamedSchema = undeclare . declareNamedSchema @@ -228,7 +228,7 @@ -- | Convert a type into a schema without references. -- -- >>> encode $ toInlinedSchema (Proxy :: Proxy [Day])--- "{\"items\":{\"format\":\"yyyy-mm-dd\",\"type\":\"string\"},\"type\":\"array\"}"+-- "{\"items\":{\"format\":\"date\",\"type\":\"string\"},\"type\":\"array\"}" -- -- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema -- when inlining recursive schemas.@@ -305,11 +305,9 @@   & schemaType .~ SwaggerString   & schemaFormat ?~ format --- |--- >>> toSchema (Proxy :: Proxy Day) ^. schemaFormat--- Just "yyyy-mm-dd"+-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format. instance ToSchema Day where-  declareNamedSchema _ = pure $ named "Day" (timeSchema "yyyy-mm-dd")+  declareNamedSchema _ = pure $ named "Day" (timeSchema "date")  -- | -- >>> toSchema (Proxy :: Proxy LocalTime) ^. schemaFormat@@ -317,11 +315,9 @@ instance ToSchema LocalTime where   declareNamedSchema _ = pure $ named "LocalTime" (timeSchema "yyyy-mm-ddThh:MM:ss") --- |--- >>> toSchema (Proxy :: Proxy ZonedTime) ^. schemaFormat--- Just "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"+-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format. instance ToSchema ZonedTime where-  declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "yyyy-mm-ddThh:MM:ss(Z|+hh:MM)"+  declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"  instance ToSchema NominalDiffTime where   declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy Integer)

@@ -1,5 +1,6 @@ {-# LANGUAGE DefaultSignatures #-} {-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RankNTypes #-} {-# LANGUAGE TypeOperators #-}@@ -14,6 +15,7 @@ import Data.Hashable (Hashable) import Data.HashMap.Strict (HashMap) import qualified Data.HashMap.Strict as HashMap+import Data.Map (Map) import Data.Monoid import Data.Text (Text) import GHC.Generics@@ -66,14 +68,17 @@ genericToJSONWithSub sub opts x =   case genericToJSON opts x of     Object o ->-      let so = HashMap.lookupDefault (error "impossible") sub o-      in Object (HashMap.delete sub o) <+> so+      case HashMap.lookup sub o of+        Just so -> Object (HashMap.delete sub o) <+> so+        Nothing -> Object o -- no subjson, leaving object as is     _ -> error "genericToJSONWithSub: subjson is not an object"  genericParseJSONWithSub :: (Generic a, GFromJSON (Rep a)) => Text -> Options -> Value -> Parser a-genericParseJSONWithSub sub opts (Object o) = genericParseJSON opts js+genericParseJSONWithSub sub opts js@(Object o)+    = genericParseJSON opts js    -- try without subjson+  <|> genericParseJSON opts js'   -- try with subjson   where-    js = Object (HashMap.insert sub (Object o) o)+    js' = Object (HashMap.insert sub (Object o) o) genericParseJSONWithSub _ _ _ = error "genericParseJSONWithSub: given json is not an object"  (<+>) :: Value -> Value -> Value@@ -119,6 +124,11 @@   swaggerMappend = mappend  instance SwaggerMonoid [a]+instance Ord k => SwaggerMonoid (Map k v)++instance {-# OVERLAPPABLE #-} (Eq k, Hashable k) => SwaggerMonoid (HashMap k v) where+  swaggerMempty = mempty+  swaggerMappend = HashMap.unionWith (\_old new -> new)  instance SwaggerMonoid Text where   swaggerMempty = mempty

@@ -38,8 +38,6 @@ makePrisms ''ParamAnySchema -- ** 'ParamOtherSchema' lenses makeLenses ''ParamOtherSchema--- ** 'Items' lenses-makeLenses ''Items -- ** 'Header' lenses makeLenses ''Header -- ** 'Schema' lenses@@ -86,7 +84,6 @@  instance HasParamSchema Schema Schema where parameterSchema = schemaParamSchema instance HasParamSchema ParamOtherSchema ParamOtherSchema where parameterSchema = paramOtherSchemaParamSchema-instance HasParamSchema Items Items where parameterSchema = itemsParamSchema instance HasParamSchema Header Header where parameterSchema = headerParamSchema instance HasParamSchema (ParamSchema t) t where parameterSchema = id 

@@ -1,5 +1,5 @@ name:                swagger2-version:             1.0+version:             1.1 synopsis:            Swagger 2.0 data model description:         Please see README.md homepage:            https://github.com/GetShopTV/swagger2

@@ -152,8 +152,8 @@   "type": "object",   "properties":     {-      "x": { "type": "number" },-      "y": { "type": "number" }+      "x": { "type": "number", "format": "double" },+      "y": { "type": "number", "format": "double" }     },   "required": ["x", "y"] }@@ -458,8 +458,8 @@                   "type": "object",                   "properties":                     {-                      "x": { "type": "number" },-                      "y": { "type": "number" }+                      "x": { "type": "number", "format": "double" },+                      "y": { "type": "number", "format": "double" }                     },                   "required": ["x", "y"]                 }@@ -477,8 +477,8 @@                   "type": "object",                   "properties":                     {-                      "x": { "type": "number" },-                      "y": { "type": "number" }+                      "x": { "type": "number", "format": "double" },+                      "y": { "type": "number", "format": "double" }                     },                   "required": ["x", "y"]                 }@@ -545,9 +545,9 @@   "type": "object",   "properties":     {-      "LightFreq": { "type": "number" },+      "LightFreq": { "type": "number", "format": "double" },       "LightColor": { "$ref": "#/definitions/Color" },-      "LightWaveLength": { "type": "number" }+      "LightWaveLength": { "type": "number", "format": "double" }     },   "maxProperties": 1,   "minProperties": 1@@ -560,13 +560,13 @@   "type": "object",   "properties":     {-      "LightFreq": { "type": "number" },+      "LightFreq": { "type": "number", "format": "double" },       "LightColor":         {           "type": "string",           "enum": ["Red", "Green", "Blue"]         },-      "LightWaveLength": { "type": "number" }+      "LightWaveLength": { "type": "number", "format": "double" }     },   "maxProperties": 1,   "minProperties": 1