@@ -2,13 +2,15 @@
22{-# LANGUAGE DeriveTraversable #-}
33{-# LANGUAGE GeneralizedNewtypeDeriving #-}
44{-# LANGUAGE OverloadedStrings #-}
5+{-# LANGUAGE RecordWildCards #-}
56{-# LANGUAGE TemplateHaskell #-}
67module Data.Swagger.Internal where
78
8−import Data.Aeson (ToJSON, FromJSON)
9−import qualified Data.Aeson as JSON
9+import Data.Aeson
10+import Data.Aeson.TH (deriveToJSON)
1011import Data.Foldable (Foldable)
1112import Data.HashMap.Strict (HashMap)
13+import qualified Data.HashMap.Strict as HashMap
1214import Data.Text (Text)
1315import Data.Traversable (Traversable)
1416import Data.Hashable (Hashable)
@@ -39,28 +41,28 @@ data Swagger = Swagger
3941
4042 -- | A list of MIME types the APIs can consume.
4143 -- This is global to all APIs but can be overridden on specific API calls.
42− , swaggerConsumes :: [MediaType]
44+ , swaggerConsumes :: SwaggerMimeList
4345
4446 -- | A list of MIME types the APIs can produce.
4547 -- This is global to all APIs but can be overridden on specific API calls.
46− , swaggerProduces :: [MediaType]
48+ , swaggerProduces :: SwaggerMimeList
4749
4850 -- | The available paths and operations for the API.
4951 , swaggerPaths :: SwaggerPaths
5052
5153 -- | An object to hold data types produced and consumed by operations.
52− , swaggerDefinitions :: Definitions SwaggerSchema
54+ , swaggerDefinitions :: HashMap Text SwaggerSchema
5355
5456 -- | An object to hold parameters that can be used across operations.
5557 -- This property does not define global parameters for all operations.
56− , swaggerParameters :: Definitions SwaggerParameter
58+ , swaggerParameters :: HashMap Text SwaggerParameter
5759
5860 -- | An object to hold responses that can be used across operations.
5961 -- This property does not define global responses for all operations.
60− , swaggerResponses :: Definitions SwaggerResponse
62+ , swaggerResponses :: HashMap Text SwaggerResponse
6163
6264 -- | Security scheme definitions that can be used across the specification.
63− , swaggerSecurityDefinitions :: Definitions SwaggerSecurityScheme
65+ , swaggerSecurityDefinitions :: HashMap Text SwaggerSecurityScheme
6466
6567 -- | A declaration of which security schemes are applied for the API as a whole.
6668 -- The list of values describes alternative security schemes that can be used
@@ -77,7 +79,7 @@ data Swagger = Swagger
7779
7880 -- | Additional external documentation.
7981 , swaggerExternalDocs :: SwaggerExternalDocs
80− } deriving (Show)
82+ } deriving (Show, Generic)
8183
8284-- | The object provides metadata about the API.
8385-- The metadata can be used by the clients if needed,
@@ -131,6 +133,12 @@ data SwaggerHost = SwaggerHost
131133 , swaggerHostPort :: Maybe PortNumber -- ^ Optional port.
132134 } deriving (Show)
133135
136+instance ToJSON SwaggerHost where
137+ toJSON (SwaggerHost host mport) = toJSON $
138+ case mport of
139+ Nothing -> host
140+ Just port -> host ++ ":" ++ show port
141+
134142-- | The transfer protocol of the API.
135143data SwaggerScheme
136144 = Http
@@ -146,6 +154,9 @@ data SwaggerPaths = SwaggerPaths
146154 swaggerPathsMap :: HashMap FilePath SwaggerPathItem
147155 } deriving (Show)
148156
157+instance ToJSON SwaggerPaths where
158+ toJSON (SwaggerPaths m) = toJSON m
159+
149160-- | Describes the operations available on a single path.
150161-- A @'SwaggerPathItem'@ may be empty, due to ACL constraints.
151162-- The path itself is still exposed to the documentation viewer
@@ -205,12 +216,12 @@ data SwaggerOperation = SwaggerOperation
205216 -- | A list of MIME types the operation can consume.
206217 -- This overrides the @'swaggerConsumes'@.
207218 -- @Just []@ MAY be used to clear the global definition.
208− , swaggerOperationConsumes :: Maybe [MediaType]
219+ , swaggerOperationConsumes :: Maybe SwaggerMimeList
209220
210221 -- | A list of MIME types the operation can produce.
211222 -- This overrides the @'swaggerProduces'@.
212223 -- @Just []@ MAY be used to clear the global definition.
213− , swaggerOperationProduces :: Maybe [MediaType]
224+ , swaggerOperationProduces :: Maybe SwaggerMimeList
214225
215226 -- | A list of parameters that are applicable for this operation.
216227 -- If a parameter is already defined at the @'SwaggerPathItem'@,
@@ -239,6 +250,12 @@ data SwaggerOperation = SwaggerOperation
239250 , swaggerOperationSecurity :: [SwaggerSecurityRequirement]
240251 } deriving (Show)
241252
253+newtype SwaggerMimeList = SwaggerMimeList { getSwaggerMimeList :: [MediaType] }
254+ deriving (Show)
255+
256+instance ToJSON SwaggerMimeList where
257+ toJSON (SwaggerMimeList xs) = toJSON (map show xs)
258+
242259-- | Describes a single operation parameter.
243260-- A unique parameter is defined by a combination of a name and location.
244261data SwaggerParameter = SwaggerParameter
@@ -258,13 +275,20 @@ data SwaggerParameter = SwaggerParameter
258275
259276 -- | Parameter schema.
260277 , swaggerParameterSchema :: SwaggerParameterSchema
261− } deriving (Show)
278+ } deriving (Show, Generic)
279+
280+instance ToJSON SwaggerParameter where
281+ toJSON = genericToJSONWithSub "schema" (jsonPrefix "swaggerParameter")
262282
263283data SwaggerParameterSchema
264284 = SwaggerParameterBody SwaggerSchema
265285 | SwaggerParameterOther SwaggerParameterOtherSchema
266286 deriving (Show)
267287
288+instance ToJSON SwaggerParameterSchema where
289+ toJSON (SwaggerParameterBody s) = toJSON s <+> object [ "in" .= ("body" :: Text) ]
290+ toJSON (SwaggerParameterOther s) = toJSON s
291+
268292data SwaggerParameterOtherSchema = SwaggerParameterOtherSchema
269293 { -- | The location of the parameter.
270294 swaggerParameterOtherSchemaIn :: SwaggerParameterLocation
@@ -294,26 +318,11 @@ data SwaggerParameterOtherSchema = SwaggerParameterOtherSchema
294318 -- Default value is csv.
295319 , swaggerParameterOtherSchemaCollectionFormat :: Maybe SwaggerCollectionFormat
296320
297− -- | Declares the value of the parameter that the server will use if none is provided,
298− -- for example a @"count"@ to control the number of results per page might default to @100@
299− -- if not supplied by the client in the request.
300− -- (Note: "default" has no meaning for required parameters.)
301− -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
302− , swaggerParameterOtherSchemaDefault :: Maybe JSON.Value
303−
304− , swaggerParameterOtherSchemaMaximum :: Maybe Integer
305− , swaggerParameterOtherSchemaExclusiveMaximum :: Maybe Bool
306− , swaggerParameterOtherSchemaMinimum :: Maybe Integer
307− , swaggerParameterOtherSchemaExclusiveMinimum :: Maybe Bool
308− , swaggerParameterOtherSchemaMaxLength :: Maybe Integer
309− , swaggerParameterOtherSchemaMinLength :: Maybe Integer
310− , swaggerParameterOtherSchemaPattern :: Maybe Text
311− , swaggerParameterOtherSchemaMaxItems :: Maybe Integer
312− , swaggerParameterOtherSchemaMinItems :: Maybe Integer
313− , swaggerParameterOtherSchemaUniqueItems :: Maybe Bool
314− , swaggerParameterOtherSchemaEnum :: Maybe [JSON.Value]
315− , swaggerParameterOtherSchemaMultipleOf :: Maybe Integer
316− } deriving (Show)
321+ , swaggerParameterOtherSchemaCommon :: SwaggerSchemaCommon
322+ } deriving (Show, Generic)
323+
324+instance ToJSON SwaggerParameterOtherSchema where
325+ toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerParameterOtherSchema")
317326
318327data SwaggerParameterType
319328 = SwaggerParamString
@@ -393,33 +402,37 @@ data SwaggerSchema = SwaggerSchema
393402
394403 , swaggerSchemaItems :: SwaggerSchemaItems
395404 , swaggerSchemaAllOf :: [SwaggerSchema]
396− , swaggerSchemaProperties :: Definitions SwaggerSchema
405+ , swaggerSchemaProperties :: HashMap Text SwaggerSchema
397406 , swaggerSchemaAdditionalProperties :: Maybe SwaggerSchema
398407
399408 , swaggerSchemaDiscriminator :: Maybe Text
400409 , swaggerSchemaReadOnly :: Maybe Bool
401410 , swaggerSchemaXml :: Maybe SwaggerXml
402411 , swaggerSchemaExternalDocs :: Maybe SwaggerExternalDocs
403− , swaggerSchemaExample :: Maybe JSON.Value
412+ , swaggerSchemaExample :: Maybe Value
404413
405414 , swaggerSchemaMaxProperties :: Maybe Integer
406415 , swaggerSchemaMinProperties :: Maybe Integer
407416
408417 , swaggerSchemaCommon :: SwaggerSchemaCommon
409− } deriving (Show)
418+ } deriving (Show, Generic)
410419
411420data SwaggerSchemaItems
412421 = SwaggerSchemaItemsObject SwaggerSchema
413422 | SwaggerSchemaItemsArray [SwaggerSchema]
414423 deriving (Show)
415424
425+instance ToJSON SwaggerSchemaItems where
426+ toJSON (SwaggerSchemaItemsObject x) = toJSON x
427+ toJSON (SwaggerSchemaItemsArray xs) = toJSON xs
428+
416429data SwaggerSchemaCommon = SwaggerSchemaCommon
417430 { -- | Declares the value of the parameter that the server will use if none is provided,
418431 -- for example a @"count"@ to control the number of results per page might default to @100@
419432 -- if not supplied by the client in the request.
420433 -- (Note: "default" has no meaning for required parameters.)
421434 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
422− swaggerSchemaDefault :: Maybe JSON.Value
435+ swaggerSchemaDefault :: Maybe Value
423436
424437 , swaggerSchemaMaximum :: Maybe Integer
425438 , swaggerSchemaExclusiveMaximum :: Maybe Bool
@@ -431,9 +444,9 @@ data SwaggerSchemaCommon = SwaggerSchemaCommon
431444 , swaggerSchemaMaxItems :: Maybe Integer
432445 , swaggerSchemaMinItems :: Maybe Integer
433446 , swaggerSchemaUniqueItems :: Maybe Bool
434− , swaggerSchemaEnum :: Maybe [JSON.Value]
447+ , swaggerSchemaEnum :: Maybe [Value]
435448 , swaggerSchemaMultipleOf :: Maybe Integer
436− } deriving (Show)
449+ } deriving (Show, Generic)
437450
438451data SwaggerXml = SwaggerXml
439452 { -- | Replaces the name of the element/attribute used for the described schema property.
@@ -479,7 +492,7 @@ data SwaggerItems = SwaggerItems
479492 , swaggerItemsCollectionFormat :: SwaggerItemsCollectionFormat
480493
481494 , swaggerItemsCommon :: SwaggerSchemaCommon
482− } deriving (Show)
495+ } deriving (Show, Generic)
483496
484497-- | A container for the expected responses of an operation.
485498-- The container maps a HTTP response code to the expected response.
@@ -496,6 +509,11 @@ data SwaggerResponses = SwaggerResponses
496509 , swaggerResponsesResponses :: HashMap HttpStatusCode SwaggerResponse
497510 } deriving (Show)
498511
512+instance ToJSON SwaggerResponses where
513+ toJSON (SwaggerResponses def rs) = object
514+ [ "default" .= def
515+ , "responses" .= hashMapMapKeys show rs ]
516+
499517type HttpStatusCode = Int
500518
501519-- | Describes a single response from an API Operation.
@@ -539,11 +557,14 @@ data SwaggerHeader = SwaggerHeader
539557 , swaggerHeaderCollectionFormat :: SwaggerItemsCollectionFormat
540558
541559 , swaggerHeaderCommon :: SwaggerSchemaCommon
542− } deriving (Show)
560+ } deriving (Show, Generic)
543561
544−data SwaggerExample = SwaggerExample
562+data SwaggerExample = SwaggerExample { getSwaggerExample :: HashMap MediaType Value }
545563 deriving (Show)
546564
565+instance ToJSON SwaggerExample where
566+ toJSON = toJSON . hashMapMapKeys show . getSwaggerExample
567+
547568-- | The location of the API key.
548569data SwaggerApiKeyLocation
549570 = SwaggerApiKeyQuery
@@ -577,7 +598,7 @@ data SwaggerOAuth2Params = SwaggerOAuth2Params
577598
578599 -- | The available scopes for the OAuth2 security scheme.
579600 , swaggerOAuth2Scopes :: HashMap Text Text
580− } deriving (Show)
601+ } deriving (Show, Generic)
581602
582603data SwaggerSecuritySchemeType
583604 = SwaggerSecuritySchemeBasic
@@ -591,6 +612,11 @@ data SwaggerSecuritySchemeTypeName
591612 | SwaggerSecuritySchemeTypeOAuth2
592613 deriving (Eq, Read, Show, Generic)
593614
615+swaggerSecuritySchemeTypeNameText :: SwaggerSecuritySchemeTypeName -> Text
616+swaggerSecuritySchemeTypeNameText SwaggerSecuritySchemeTypeBasic = "basic"
617+swaggerSecuritySchemeTypeNameText SwaggerSecuritySchemeTypeApiKey = "apiKey"
618+swaggerSecuritySchemeTypeNameText SwaggerSecuritySchemeTypeOAuth2 = "oauth2"
619+
594620instance Hashable SwaggerSecuritySchemeTypeName
595621
596622data SwaggerSecurityScheme = SwaggerSecurityScheme
@@ -599,7 +625,7 @@ data SwaggerSecurityScheme = SwaggerSecurityScheme
599625
600626 -- | A short description for security scheme.
601627 , swaggerSecuritySchemeDescription :: Maybe Text
602− } deriving (Show)
628+ } deriving (Show, Generic)
603629
604630-- | Lists the required security schemes to execute this operation.
605631-- The object can have multiple security schemes declared in it which are all required
@@ -608,6 +634,9 @@ newtype SwaggerSecurityRequirement = SwaggerSecurityRequirement
608634 { getSwaggerSecurityRequirement :: HashMap SwaggerSecuritySchemeTypeName Text
609635 } deriving (Eq, Read, Show, Monoid)
610636
637+instance ToJSON SwaggerSecurityRequirement where
638+ toJSON (SwaggerSecurityRequirement m) = toJSON (hashMapMapKeys swaggerSecuritySchemeTypeNameText m)
639+
611640-- | Allows adding meta data to a single tag that is used by @SwaggerOperation@.
612641-- It is not mandatory to have a @SwaggerTag@ per tag used there.
613642data SwaggerTag = SwaggerTag
@@ -634,6 +663,70 @@ data SwaggerExternalDocs = SwaggerExternalDocs
634663
635664newtype URL = URL { getUrl :: Text } deriving (Show, ToJSON, FromJSON)
636665
637−newtype Definitions v = Definitions { getDefinitions :: HashMap Text v }
638− deriving (Eq, Read, Show, Monoid, Functor, Foldable, Traversable)
666+deriveToJSON' ''SwaggerOperation
667+deriveToJSON (jsonPrefix "SwaggerParameter") ''SwaggerParameterLocation
668+deriveToJSON (jsonPrefix "SwaggerParam") ''SwaggerParameterType
669+deriveToJSON' ''SwaggerPathItem
670+deriveToJSON' ''SwaggerInfo
671+deriveToJSON' ''SwaggerContact
672+deriveToJSON' ''SwaggerLicense
673+deriveToJSON (jsonPrefix "SwaggerSchema") ''SwaggerSchemaType
674+deriveToJSON (jsonPrefix "SwaggerItems") ''SwaggerItemsType
675+deriveToJSON (jsonPrefix "SwaggerItemsCollection") ''SwaggerItemsCollectionFormat
676+deriveToJSON (jsonPrefix "SwaggerCollection") ''SwaggerCollectionFormat
677+deriveToJSON (jsonPrefix "SwaggerSecuritySchemeType") ''SwaggerSecuritySchemeTypeName
678+deriveToJSON (jsonPrefix "SwaggerApiKey") ''SwaggerApiKeyLocation
679+deriveToJSON (jsonPrefix "swaggerApiKey") ''SwaggerApiKeyParams
680+deriveToJSON' ''SwaggerResponse
681+deriveToJSON' ''SwaggerSchemaCommon
682+deriveToJSONDefault ''SwaggerScheme
683+deriveToJSON' ''SwaggerTag
684+deriveToJSON' ''SwaggerExternalDocs
685+deriveToJSON' ''SwaggerXml
686+
687+instance ToJSON SwaggerOAuth2Flow where
688+ toJSON (SwaggerOAuth2Implicit authUrl) = object
689+ [ "flow" .= ("implicit" :: Text)
690+ , "authorizationUrl" .= authUrl ]
691+ toJSON (SwaggerOAuth2Password tokenUrl) = object
692+ [ "flow" .= ("password" :: Text)
693+ , "tokenUrl" .= tokenUrl ]
694+ toJSON (SwaggerOAuth2Application tokenUrl) = object
695+ [ "flow" .= ("application" :: Text)
696+ , "tokenUrl" .= tokenUrl ]
697+ toJSON (SwaggerOAuth2AccessCode authUrl tokenUrl) = object
698+ [ "flow" .= ("accessCode" :: Text)
699+ , "authorizationUrl" .= authUrl
700+ , "tokenUrl" .= tokenUrl ]
701+
702+instance ToJSON SwaggerOAuth2Params where
703+ toJSON = genericToJSONWithSub "flow" (jsonPrefix "swaggerOAuth2")
704+
705+instance ToJSON SwaggerSecuritySchemeType where
706+ toJSON SwaggerSecuritySchemeBasic
707+ = object [ "type" .= SwaggerSecuritySchemeTypeBasic ]
708+ toJSON (SwaggerSecuritySchemeApiKey params)
709+ = toJSON params
710+ <+> object [ "type" .= SwaggerSecuritySchemeTypeApiKey ]
711+ toJSON (SwaggerSecuritySchemeOAuth2 params)
712+ = toJSON params
713+ <+> object [ "type" .= SwaggerSecuritySchemeTypeOAuth2 ]
714+
715+instance ToJSON Swagger where
716+ toJSON = addVersion . genericToJSON (jsonPrefix "swagger")
717+ where
718+ addVersion (Object o) = Object (HashMap.insert "swagger" "2.0" o)
719+ addVersion _ = error "impossible"
720+
721+instance ToJSON SwaggerSecurityScheme where
722+ toJSON = genericToJSONWithSub "type" (jsonPrefix "swaggerSecurityScheme")
723+
724+instance ToJSON SwaggerSchema where
725+ toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerSchema")
726+
727+instance ToJSON SwaggerHeader where
728+ toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerHeader")
729+
730+instance ToJSON SwaggerItems where
731+ toJSON = genericToJSONWithSub "common" (jsonPrefix "swaggerItems")
639732