semigroup instance for security scheme

src/Data/Swagger.hs

@@ -87,6 +87,7 @@ module Data.Swagger (
   SecurityScheme(..),
   SecuritySchemeType(..),
   SecurityRequirement(..),
+  SecurityDefinitions(..),
 
   -- *** API key
   ApiKeyParams(..),
@@ -274,7 +275,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

@@ -112,7 +112,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
@@ -750,6 +750,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).
@@ -890,6 +906,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
 -- =======================================================================
@@ -904,6 +931,7 @@ instance SwaggerMonoid Responses
 instance SwaggerMonoid Response
 instance SwaggerMonoid ExternalDocs
 instance SwaggerMonoid Operation
+instance SwaggerMonoid SecurityDefinitions
 
 instance SwaggerMonoid MimeList
 deriving instance SwaggerMonoid URL
@@ -920,18 +948,6 @@ instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
   swaggerMempty = InsOrdHashMap.empty
   swaggerMappend = InsOrdHashMap.unionWith mappend
 
-instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap Text SecurityScheme) where
-  swaggerMempty = InsOrdHashMap.empty
-  swaggerMappend = InsOrdHashMap.unionWith mergeFun
-    where
-      mergeFun 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
-            s2
-      mergeFun _ ss = ss
-
 instance Monoid a => SwaggerMonoid (Referenced a) where
   swaggerMempty = Inline mempty
   swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
@@ -1104,6 +1120,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 ]
 
@@ -1242,6 +1261,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
@@ -1349,3 +1371,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

test/Data/SwaggerSpec.hs

@@ -42,6 +42,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
@@ -445,8 +446,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 })
@@ -478,6 +479,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
 -- =======================================================================