Merge OAuth2 scopes

src/Data/Swagger.hs

@@ -89,6 +89,7 @@ module Data.Swagger (
   SecurityScheme(..),
   SecuritySchemeType(..),
   SecurityRequirement(..),
+  SecurityDefinitions(..),
 
   -- *** API key
   ApiKeyParams(..),
@@ -279,7 +280,7 @@ import Data.Swagger.Internal
 -- >>> encode $ toSchema (Proxy :: Proxy Person)
 -- "{\"required\":[\"name\",\"age\"],\"properties\":{\"name\":{\"type\":\"string\"},\"age\":{\"type\":\"integer\"}},\"type\":\"object\"}"
 --
--- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a 
+-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a
 -- schema for basic enums like
 --
 -- >>> data SampleEnum = ChoiceOne | ChoiceTwo deriving Generic

src/Data/Swagger/Internal.hs

@@ -117,7 +117,7 @@ data Swagger = Swagger
   , _swaggerResponses :: Definitions Response
 
     -- | Security scheme definitions that can be used across the specification.
-  , _swaggerSecurityDefinitions :: Definitions SecurityScheme
+  , _swaggerSecurityDefinitions :: SecurityDefinitions
 
     -- | A declaration of which security schemes are applied for the API as a whole.
     -- The list of values describes alternative security schemes that can be used
@@ -755,6 +755,22 @@ data SecurityScheme = SecurityScheme
   , _securitySchemeDescription :: Maybe Text
   } deriving (Eq, Show, Generic, Data, Typeable)
 
+
+-- | merge scopes of two OAuth2 security schemes when their flows are identical.
+-- In other case returns first security scheme
+mergeSecurityScheme :: SecurityScheme -> SecurityScheme -> SecurityScheme
+mergeSecurityScheme s1@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 scopes1)) desc)
+                    s2@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow2 scopes2)) _)
+  = if flow1 == flow2 then
+      SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 (scopes1 <> scopes2))) desc
+    else
+      s1
+mergeSecurityScheme s1 _ = s1
+
+newtype SecurityDefinitions
+  = SecurityDefinitions (Definitions SecurityScheme)
+  deriving (Eq, Show, Generic, Data, Typeable)
+
 -- | Lists the required security schemes to execute this operation.
 -- The object can have multiple security schemes declared in it which are all required
 -- (that is, there is a logical AND between the schemes).
@@ -904,6 +920,17 @@ instance Monoid Example where
   mempty = genericMempty
   mappend = (<>)
 
+instance Semigroup SecurityScheme where
+  (<>) = mergeSecurityScheme
+
+instance Semigroup SecurityDefinitions where
+  (SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =
+     SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2
+
+instance Monoid SecurityDefinitions where
+  mempty = SecurityDefinitions $ InsOrdHashMap.empty
+  mappend = (<>)
+
 -- =======================================================================
 -- SwaggerMonoid helper instances
 -- =======================================================================
@@ -918,6 +945,7 @@ instance SwaggerMonoid Responses
 instance SwaggerMonoid Response
 instance SwaggerMonoid ExternalDocs
 instance SwaggerMonoid Operation
+instance SwaggerMonoid SecurityDefinitions
 instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
 
 instance SwaggerMonoid MimeList
@@ -1118,6 +1146,9 @@ instance ToJSON PathItem where
 instance ToJSON Example where
   toJSON = toJSON . Map.mapKeys show . getExample
 
+instance ToJSON SecurityDefinitions where
+  toJSON (SecurityDefinitions sd) = toJSON sd
+
 instance ToJSON Reference where
   toJSON (Reference ref) = object [ "$ref" .= ref ]
 
@@ -1279,6 +1310,9 @@ instance FromJSON Operation where
 instance FromJSON PathItem where
   parseJSON = sopSwaggerGenericParseJSON
 
+instance FromJSON SecurityDefinitions where
+  parseJSON js = SecurityDefinitions <$> parseJSON js
+
 instance FromJSON Reference where
   parseJSON (Object o) = Reference <$> o .: "$ref"
   parseJSON _ = empty
@@ -1390,3 +1424,4 @@ instance AesonDefaultValue (SwaggerType a)
 instance AesonDefaultValue MimeList where defaultValue = Just mempty
 instance AesonDefaultValue Info
 instance AesonDefaultValue ParamLocation
+instance AesonDefaultValue SecurityDefinitions where defaultValue = Just $ SecurityDefinitions mempty

src/Data/Swagger/Lens.hs

@@ -96,6 +96,12 @@ instance At   Responses where at n = responses . at n
 instance Ixed Operation where ix n = responses . ix n
 instance At   Operation where at n = responses . at n
 
+type instance Index SecurityDefinitions = Text
+type instance IxValue SecurityDefinitions = SecurityScheme
+
+instance Ixed SecurityDefinitions where ix n = (coerced :: Lens' SecurityDefinitions (Definitions SecurityScheme)). ix n
+instance At   SecurityDefinitions where at n = (coerced :: Lens' SecurityDefinitions (Definitions SecurityScheme)). at n
+
 instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema
 
 -- HasType instances

test/Data/SwaggerSpec.hs

@@ -43,6 +43,7 @@ spec = do
   describe "Parameters Definition Object" $ paramsDefinitionExample <=> paramsDefinitionExampleJSON
   describe "Responses Definition Object" $ responsesDefinitionExample <=> responsesDefinitionExampleJSON
   describe "Security Definitions Object" $ securityDefinitionsExample <=> securityDefinitionsExampleJSON
+  describe "OAuth2 Security Definitions with merged Scope" $ oAuth2SecurityDefinitionsExample <=> oAuth2SecurityDefinitionsExampleJSON
   describe "Composition Schema Example" $ compositionSchemaExample <=> compositionSchemaExampleJSON
   describe "Swagger Object" $ do
     context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
@@ -459,8 +460,8 @@ responsesDefinitionExampleJSON = [aesonQQ|
 -- Responses Definition object
 -- =======================================================================
 
-securityDefinitionsExample :: HashMap Text SecurityScheme
-securityDefinitionsExample =
+securityDefinitionsExample :: SecurityDefinitions
+securityDefinitionsExample = SecurityDefinitions
   [ ("api_key", SecurityScheme
       { _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "api_key" ApiKeyHeader)
       , _securitySchemeDescription = Nothing })
@@ -492,6 +493,46 @@ securityDefinitionsExampleJSON = [aesonQQ|
 }
 |]
 
+oAuth2SecurityDefinitionsReadExample :: SecurityDefinitions
+oAuth2SecurityDefinitionsReadExample = SecurityDefinitions
+  [ ("petstore_auth", SecurityScheme
+      { _securitySchemeType = SecuritySchemeOAuth2 (OAuth2Params
+          { _oauth2Flow = OAuth2Implicit "http://swagger.io/api/oauth/dialog"
+          , _oauth2Scopes =
+              [ ("read:pets", "read your pets") ] } )
+      , _securitySchemeDescription = Nothing })
+  ]
+
+oAuth2SecurityDefinitionsWriteExample :: SecurityDefinitions
+oAuth2SecurityDefinitionsWriteExample = SecurityDefinitions
+  [ ("petstore_auth", SecurityScheme
+      { _securitySchemeType = SecuritySchemeOAuth2 (OAuth2Params
+          { _oauth2Flow = OAuth2Implicit "http://swagger.io/api/oauth/dialog"
+          , _oauth2Scopes =
+              [ ("write:pets", "modify pets in your account") ] } )
+      , _securitySchemeDescription = Nothing })
+  ]
+
+oAuth2SecurityDefinitionsExample :: SecurityDefinitions
+oAuth2SecurityDefinitionsExample =
+  oAuth2SecurityDefinitionsWriteExample <>
+  oAuth2SecurityDefinitionsReadExample
+
+oAuth2SecurityDefinitionsExampleJSON :: Value
+oAuth2SecurityDefinitionsExampleJSON = [aesonQQ|
+{
+  "petstore_auth": {
+    "type": "oauth2",
+    "authorizationUrl": "http://swagger.io/api/oauth/dialog",
+    "flow": "implicit",
+    "scopes": {
+      "write:pets": "modify pets in your account",
+      "read:pets": "read your pets"
+    }
+  }
+}
+|]
+
 -- =======================================================================
 -- Swagger object
 -- =======================================================================