Skip to content

Commit 298a23c

Browse files
isomorphemeisomorpheme
committed
Support top-level references in components
1 parent efb9a50 commit 298a23c

File tree

8 files changed

+74
-33
lines changed

8 files changed

+74
-33
lines changed

‎src/Data/OpenApi.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -214,7 +214,7 @@ import Data.OpenApi.Internal
214214
--
215215
-- >>> :{
216216
-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
217-
-- & components . schemas .~ IOHM.fromList [ ("User", mempty & type_ ?~ OpenApiString) ]
217+
-- & components . schemas .~ IOHM.fromList [ ("User", Inline $ mempty & type_ ?~ OpenApiString) ]
218218
-- & paths .~
219219
-- IOHM.fromList [ ("/user", mempty & get ?~ (mempty
220220
-- & at 200 ?~ ("OK" & _Inline.content.at "application/json" ?~ (mempty & schema ?~ Ref (Reference "User")))

‎src/Data/OpenApi/Internal.hs

Lines changed: 18 additions & 10 deletions
Original file line numberDiff line numberDiff line change
@@ -66,7 +66,7 @@ import Text.ParserCombinators.ReadP (readP_to_S)
6666
-- >>> import Data.OpenApi.Internal.Utils
6767

6868
-- | A list of definitions that can be used in references.
69-
type Definitions = InsOrdHashMap Text
69+
type Definitions a = InsOrdHashMap Text (Referenced a)
7070

7171
-- | This is the root document object for the API specification.
7272
data OpenApi = OpenApi
@@ -1006,12 +1006,12 @@ deriveGeneric ''OpenApiSpecVersion
10061006
-- =======================================================================
10071007

10081008
instance Semigroup OpenApiSpecVersion where
1009-
(<>) (OpenApiSpecVersion a) (OpenApiSpecVersion b) = OpenApiSpecVersion $ max a b
1010-
1009+
(<>) (OpenApiSpecVersion a) (OpenApiSpecVersion b) = OpenApiSpecVersion $ max a b
1010+
10111011
instance Monoid OpenApiSpecVersion where
10121012
mempty = OpenApiSpecVersion (makeVersion [3,0,0])
10131013
mappend = (<>)
1014-
1014+
10151015
instance Semigroup OpenApi where
10161016
(<>) = genericMappend
10171017
instance Monoid OpenApi where
@@ -1122,7 +1122,13 @@ instance Semigroup SecurityScheme where
11221122

11231123
instance Semigroup SecurityDefinitions where
11241124
(SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =
1125-
SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2
1125+
SecurityDefinitions $ InsOrdHashMap.unionWith mergeRefSecuritySchemes sd1 sd2
1126+
where
1127+
-- If there's a conflict between two inline security schemes, we merge them
1128+
-- recursively, but otherwise we behave as the 'Semigroup' instance on
1129+
-- 'InsOrdHashMap' would, preferring the left value.
1130+
mergeRefSecuritySchemes (Inline s1) (Inline s2) = Inline (s1 <> s2)
1131+
mergeRefSecuritySchemes l _ = l
11261132

11271133
instance Monoid SecurityDefinitions where
11281134
mempty = SecurityDefinitions InsOrdHashMap.empty
@@ -1282,7 +1288,7 @@ instance FromJSON OAuth2AuthorizationCodeFlow where
12821288
-- Manual ToJSON instances
12831289
-- =======================================================================
12841290

1285-
instance ToJSON OpenApiSpecVersion where
1291+
instance ToJSON OpenApiSpecVersion where
12861292
toJSON (OpenApiSpecVersion v)= toJSON . showVersion $ v
12871293

12881294
instance ToJSON MediaType where
@@ -1436,6 +1442,7 @@ instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/compone
14361442
instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"
14371443
instance ToJSON (Referenced Link) where toJSON = referencedToJSON "#/components/links/"
14381444
instance ToJSON (Referenced Callback) where toJSON = referencedToJSON "#/components/callbacks/"
1445+
instance ToJSON (Referenced SecurityScheme) where toJSON = referencedToJSON "#/components/securitySchemes/"
14391446

14401447
instance ToJSON AdditionalProperties where
14411448
toJSON (AdditionalPropertiesAllowed b) = toJSON b
@@ -1456,15 +1463,15 @@ instance FromJSON OpenApiSpecVersion where
14561463
parseJSON = withText "OpenApiSpecVersion" $ \str ->
14571464
let validatedVersion :: Either String Version
14581465
validatedVersion = do
1459-
parsedVersion <- readVersion str
1466+
parsedVersion <- readVersion str
14601467
unless ((parsedVersion >= lowerOpenApiSpecVersion) && (parsedVersion <= upperOpenApiSpecVersion)) $
14611468
Left ("The provided version " <> showVersion parsedVersion <> " is out of the allowed range >=" <> showVersion lowerOpenApiSpecVersion <> " && <=" <> showVersion upperOpenApiSpecVersion)
14621469
return parsedVersion
1463-
in
1470+
in
14641471
either fail (return . OpenApiSpecVersion) validatedVersion
14651472
where
14661473
readVersion :: Text -> Either String Version
1467-
readVersion v = case readP_to_S parseVersion (Text.unpack v) of
1474+
readVersion v = case readP_to_S parseVersion (Text.unpack v) of
14681475
[] -> Left $ "Failed to parse as a version string " <> Text.unpack v
14691476
solutions -> Right (fst . last $ solutions)
14701477

@@ -1593,6 +1600,7 @@ instance FromJSON (Referenced Example) where parseJSON = referencedParseJSON "#
15931600
instance FromJSON (Referenced Header) where parseJSON = referencedParseJSON "#/components/headers/"
15941601
instance FromJSON (Referenced Link) where parseJSON = referencedParseJSON "#/components/links/"
15951602
instance FromJSON (Referenced Callback) where parseJSON = referencedParseJSON "#/components/callbacks/"
1603+
instance FromJSON (Referenced SecurityScheme) where parseJSON = referencedParseJSON "#/components/securitySchemes/"
15961604

15971605
instance FromJSON Xml where
15981606
parseJSON = genericParseJSON (jsonPrefix "xml")
@@ -1649,7 +1657,7 @@ instance HasSwaggerAesonOptions Encoding where
16491657
instance HasSwaggerAesonOptions Link where
16501658
swaggerAesonOptions _ = mkSwaggerAesonOptions "link"
16511659

1652-
instance AesonDefaultValue Version where
1660+
instance AesonDefaultValue Version where
16531661
defaultValue = Just (makeVersion [3,0,0])
16541662
instance AesonDefaultValue OpenApiSpecVersion
16551663
instance AesonDefaultValue Server

‎src/Data/OpenApi/Internal/Schema.hs

Lines changed: 8 additions & 7 deletions
Original file line numberDiff line numberDiff line change
@@ -248,7 +248,7 @@ declareSchemaRef proxy = do
248248
-- this schema this time and thus simply return the reference.
249249
known <- looks (InsOrdHashMap.member name)
250250
when (not known) $ do
251-
declare [(name, schema)]
251+
declare [(name, Inline schema)]
252252
void $ declareNamedSchema proxy
253253
return $ Ref (Reference name)
254254
_ -> Inline <$> declareSchema proxy
@@ -266,7 +266,7 @@ inlineSchemasWhen p defs = template %~ deref
266266
deref r@(Ref (Reference name))
267267
| p name =
268268
case InsOrdHashMap.lookup name defs of
269-
Just schema -> Inline (inlineSchemasWhen p defs schema)
269+
Just schema -> inlineSchemasWhen p defs schema
270270
Nothing -> r
271271
| otherwise = r
272272
deref (Inline schema) = Inline (inlineSchemasWhen p defs schema)
@@ -315,19 +315,20 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
315315
where
316316
nonRecursive name =
317317
case InsOrdHashMap.lookup name defs of
318-
Just schema -> name `notElem` execDeclare (usedNames schema) mempty
318+
Just schema -> name `notElem` execDeclare (schemaRefNames schema) mempty
319319
Nothing -> False
320320

321-
usedNames schema = traverse_ schemaRefNames (schema ^.. template)
321+
schemaNames :: Schema -> Declare [T.Text] ()
322+
schemaNames schema = traverse_ schemaRefNames (schema ^.. template)
322323

323324
schemaRefNames :: Referenced Schema -> Declare [T.Text] ()
324325
schemaRefNames ref = case ref of
325326
Ref (Reference name) -> do
326327
seen <- looks (name `elem`)
327328
when (not seen) $ do
328329
declare [name]
329-
traverse_ usedNames (InsOrdHashMap.lookup name defs)
330-
Inline subschema -> usedNames subschema
330+
traverse_ schemaRefNames (InsOrdHashMap.lookup name defs)
331+
Inline s -> schemaNames s
331332

332333
-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
333334
-- Produced schema can be used for further refinement.
@@ -978,7 +979,7 @@ gdeclareSchemaRef opts proxy = do
978979
-- this schema this time and thus simply return the reference.
979980
known <- looks (InsOrdHashMap.member name)
980981
when (not known) $ do
981-
declare [(name, schema)]
982+
declare [(name, Inline schema)]
982983
void $ gdeclareNamedSchema opts proxy mempty
983984
return $ Ref (Reference name)
984985
_ -> Inline <$> gdeclareSchema opts proxy

‎src/Data/OpenApi/Internal/Schema/Validation.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -299,7 +299,8 @@ withRef :: Reference -> (Schema -> Validation s a) -> Validation s a
299299
withRef (Reference ref) f = withConfig $ \cfg ->
300300
case InsOrdHashMap.lookup ref (configDefinitions cfg) of
301301
Nothing -> invalid $ "unknown schema " ++ show ref
302-
Just s -> f s
302+
Just (Ref ref') -> invalid $ "reference to a reference is currently unsupported: " ++ show ref ++ " refers to the reference " ++ show ref'
303+
Just (Inline s) -> f s
303304

304305
validateWithSchemaRef :: Referenced Schema -> Value -> Validation s ()
305306
validateWithSchemaRef (Ref ref) js = withRef ref $ \sch -> sub sch (validateWithSchema js)

‎src/Data/OpenApi/Operation.hs

Lines changed: 2 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -300,7 +300,8 @@ setResponseForWith ops f code dres swag = swag
300300
(defs, new) = runDeclare dres mempty
301301

302302
combine (Just (Ref (Reference n))) = case swag ^. components.responses.at n of
303-
Just old -> f old new
303+
Just (Inline old) -> f old new
304+
Just (Ref _) -> new -- we don't chase references any further, to avoid a loop in case of recursion
304305
Nothing -> new -- response name can't be dereferenced, replacing with new response
305306
combine (Just (Inline old)) = f old new
306307
combine Nothing = new

‎src/Data/OpenApi/Optics.hs

Lines changed: 1 addition & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -24,7 +24,7 @@
2424
--
2525
-- >>> :{
2626
-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
27-
-- & #components % #schemas .~ IOHM.fromList [ ("User", mempty & #type ?~ OpenApiString) ]
27+
-- & #components % #schemas .~ IOHM.fromList [ ("User", Inline $ mempty & #type ?~ OpenApiString) ]
2828
-- & #paths .~
2929
-- IOHM.fromList [ ("/user", mempty & #get ?~ (mempty
3030
-- & at 200 ?~ ("OK" & #_Inline % #content % at "application/json" ?~ (mempty & #schema ?~ Ref (Reference "User")))

‎src/Data/OpenApi/Schema/Generator.hs

Lines changed: 4 additions & 1 deletion
Original file line numberDiff line numberDiff line change
@@ -101,7 +101,10 @@ schemaGen defns schema =
101101

102102
dereference :: Definitions a -> Referenced a -> a
103103
dereference _ (Inline a) = a
104-
dereference defs (Ref (Reference ref)) = fromJust $ M.lookup ref defs
104+
dereference defs (Ref (Reference ref)) = fromInline $ fromJust $ M.lookup ref defs
105+
where
106+
fromInline (Inline s) = s
107+
fromInline (Ref _) = error "reference to another reference is unsupported"
105108

106109
genValue :: (ToSchema a) => Proxy a -> Gen Value
107110
genValue p =

‎test/Data/OpenApiSpec.hs

Lines changed: 38 additions & 11 deletions
Original file line numberDiff line numberDiff line change
@@ -39,7 +39,7 @@ spec = do
3939
describe "OAuth2 Security Definitions with empty Scope" $ oAuth2SecurityDefinitionsEmptyExample <=> oAuth2SecurityDefinitionsEmptyExampleJSON
4040
describe "Composition Schema Example" $ compositionSchemaExample <=> compositionSchemaExampleJSON
4141
describe "Swagger Object" $ do
42-
context "Example with no paths" $ do
42+
context "Example with no paths" $ do
4343
emptyPathsFieldExample <=> emptyPathsFieldExampleJSON
4444
it "fails to parse a spec with a wrong Openapi spec version" $ do
4545
(fromJSON wrongVersionExampleJSON :: Result OpenApi) `shouldBe` Error "The provided version 3.0.4 is out of the allowed range >=3.0.0 && <=3.0.3"
@@ -49,6 +49,11 @@ spec = do
4949
fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)
5050
it "roundtrips: fmap toJSON . fromJSON" $ do
5151
(toJSON :: OpenApi -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON
52+
context "Ref schema example" $ do
53+
it "decodes successfully" $ do
54+
fromJSON refSchemaExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)
55+
it "roundtrips: fmap toJSON . fromJSON" $ do
56+
(toJSON :: OpenApi -> Value) <$> fromJSON refSchemaExampleJSON `shouldBe` Success refSchemaExampleJSON
5257
context "Security schemes" $ do
5358
it "merged correctly" $ do
5459
let merged = oAuth2SecurityDefinitionsReadOpenApi <> oAuth2SecurityDefinitionsWriteOpenApi <> oAuth2SecurityDefinitionsEmptyOpenApi
@@ -454,17 +459,17 @@ responsesDefinitionExampleJSON = [aesonQQ|
454459

455460
securityDefinitionsExample :: SecurityDefinitions
456461
securityDefinitionsExample = SecurityDefinitions
457-
[ ("api_key", SecurityScheme
462+
[ ("api_key", Inline (SecurityScheme
458463
{ _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "api_key" ApiKeyHeader)
459-
, _securitySchemeDescription = Nothing })
460-
, ("petstore_auth", SecurityScheme
464+
, _securitySchemeDescription = Nothing }))
465+
, ("petstore_auth", Inline (SecurityScheme
461466
{ _securitySchemeType = SecuritySchemeOAuth2 (mempty & implicit ?~ OAuth2Flow
462467
{ _oAuth2Params = OAuth2ImplicitFlow "http://swagger.io/api/oauth/dialog"
463468
, _oAath2RefreshUrl = Nothing
464469
, _oAuth2Scopes =
465470
[ ("write:pets", "modify pets in your account")
466471
, ("read:pets", "read your pets") ] } )
467-
, _securitySchemeDescription = Nothing }) ]
472+
, _securitySchemeDescription = Nothing })) ]
468473

469474
securityDefinitionsExampleJSON :: Value
470475
securityDefinitionsExampleJSON = [aesonQQ|
@@ -492,35 +497,35 @@ securityDefinitionsExampleJSON = [aesonQQ|
492497

493498
oAuth2SecurityDefinitionsReadExample :: SecurityDefinitions
494499
oAuth2SecurityDefinitionsReadExample = SecurityDefinitions
495-
[ ("petstore_auth", SecurityScheme
500+
[ ("petstore_auth", Inline (SecurityScheme
496501
{ _securitySchemeType = SecuritySchemeOAuth2 (mempty & implicit ?~ OAuth2Flow
497502
{ _oAuth2Params = OAuth2ImplicitFlow "http://swagger.io/api/oauth/dialog"
498503
, _oAath2RefreshUrl = Nothing
499504
, _oAuth2Scopes =
500505
[ ("read:pets", "read your pets") ] } )
501-
, _securitySchemeDescription = Nothing })
506+
, _securitySchemeDescription = Nothing }))
502507
]
503508

504509
oAuth2SecurityDefinitionsWriteExample :: SecurityDefinitions
505510
oAuth2SecurityDefinitionsWriteExample = SecurityDefinitions
506-
[ ("petstore_auth", SecurityScheme
511+
[ ("petstore_auth", Inline (SecurityScheme
507512
{ _securitySchemeType = SecuritySchemeOAuth2 (mempty & implicit ?~ OAuth2Flow
508513
{ _oAuth2Params = OAuth2ImplicitFlow "http://swagger.io/api/oauth/dialog"
509514
, _oAath2RefreshUrl = Nothing
510515
, _oAuth2Scopes =
511516
[ ("write:pets", "modify pets in your account") ] } )
512-
, _securitySchemeDescription = Nothing })
517+
, _securitySchemeDescription = Nothing }))
513518
]
514519

515520
oAuth2SecurityDefinitionsEmptyExample :: SecurityDefinitions
516521
oAuth2SecurityDefinitionsEmptyExample = SecurityDefinitions
517-
[ ("petstore_auth", SecurityScheme
522+
[ ("petstore_auth", Inline (SecurityScheme
518523
{ _securitySchemeType = SecuritySchemeOAuth2 (mempty & implicit ?~ OAuth2Flow
519524
{ _oAuth2Params = OAuth2ImplicitFlow "http://swagger.io/api/oauth/dialog"
520525
, _oAath2RefreshUrl = Nothing
521526
, _oAuth2Scopes = []
522527
} )
523-
, _securitySchemeDescription = Nothing })
528+
, _securitySchemeDescription = Nothing }))
524529
]
525530

526531
oAuth2SecurityDefinitionsExample :: SecurityDefinitions
@@ -1003,3 +1008,25 @@ compositionSchemaExampleJSON = [aesonQQ|
10031008
]
10041009
}
10051010
|]
1011+
1012+
refSchemaExampleJSON :: Value
1013+
refSchemaExampleJSON = [aesonQQ|
1014+
{
1015+
"openapi": "3.0.3",
1016+
"info": {
1017+
"version": "1.0.0",
1018+
"title": "Example using references"
1019+
},
1020+
"paths": {},
1021+
"components": {
1022+
"schemas": {
1023+
"Foo": {
1024+
"type": "string"
1025+
},
1026+
"Bar": {
1027+
"$ref": "#/components/schemas/Foo"
1028+
}
1029+
}
1030+
}
1031+
}
1032+
|]

0 commit comments

Comments
 (0)