diff --git a/orb.cabal b/orb.cabal index 8d762ea..5251d4d 100644 --- a/orb.cabal +++ b/orb.cabal @@ -94,6 +94,7 @@ library , json-fleece-aeson , json-fleece-core , mtl + , non-empty-text , openapi3 , optparse-applicative , safe-exceptions @@ -125,6 +126,7 @@ test-suite orb-test Fixtures.NullableRef Fixtures.NullableRefCollectComponents Fixtures.OpenApiSubset + Fixtures.SchemaDescriptions Fixtures.SimpleGet Fixtures.SimplePost Fixtures.TaggedUnion @@ -160,6 +162,7 @@ test-suite orb-test , json-fleece-aeson , json-fleece-core , mtl + , non-empty-text , openapi3 , optparse-applicative , orb diff --git a/package.yaml b/package.yaml index 2b5356d..ad83334 100644 --- a/package.yaml +++ b/package.yaml @@ -66,6 +66,7 @@ dependencies: - json-fleece-aeson - json-fleece-core - mtl + - non-empty-text - openapi3 - optparse-applicative - safe-exceptions diff --git a/src/Orb/OpenApi.hs b/src/Orb/OpenApi.hs index 5d23ca3..3939194 100644 --- a/src/Orb/OpenApi.hs +++ b/src/Orb/OpenApi.hs @@ -35,6 +35,7 @@ import Data.Hashable (Hashable) import Data.List qualified as List import Data.Map.Strict qualified as Map import Data.Maybe qualified as Maybe +import Data.NonEmptyText qualified as NET import Data.OpenApi qualified as OpenApi import Data.Semialign.Indexed qualified as IAlign import Data.Set qualified as Set @@ -562,7 +563,7 @@ mkRequestBody handler = let FleeceOpenApi mkErrOrSchemaInfo = FC.schemaInterpreter schema - schemaInfo <- mkErrOrSchemaInfo [] + schemaInfo <- applySchemaDescription schema <$> mkErrOrSchemaInfo [] let schemaRef = @@ -690,11 +691,11 @@ mkResponses handler = case responseSchema of Response.NoSchemaResponseBody _mbContentType -> pure Nothing - Response.SchemaResponseBody schema -> + Response.SchemaResponseBody schema -> do let FleeceOpenApi mkInfo = FC.schemaInterpreter schema - in - fmap Just (mkInfo []) + + Just . applySchemaDescription schema <$> mkInfo [] Response.EmptyResponseBody -> pure Nothing let @@ -853,9 +854,7 @@ schemaWithComponents = (schemaComponents schemaInfo) } ) - . ($ []) - . unFleeceOpenApi - . FC.schemaInterpreter + . interpretSchemaWithDescription data PathEntry = PathSchema FC.Name @@ -870,6 +869,36 @@ renderPathEntry pathEntry = type Path = [PathEntry] +interpretSchemaWithDescriptionAt :: + Path -> + FC.Schema FleeceOpenApi a -> + Either OpenApiError SchemaInfo +interpretSchemaWithDescriptionAt path schema = do + let + FleeceOpenApi mk = FC.schemaInterpreter schema + + schemaInfo <- mk path + pure (applySchemaDescription schema schemaInfo) + +interpretSchemaWithDescription :: + FC.Schema FleeceOpenApi a -> + Either OpenApiError SchemaInfo +interpretSchemaWithDescription = + interpretSchemaWithDescriptionAt [] + +applySchemaDescription :: + FC.Schema FleeceOpenApi a -> + SchemaInfo -> + SchemaInfo +applySchemaDescription schema schemaInfo = + schemaInfo + { openApiSchema = + (openApiSchema schemaInfo) + { OpenApi._schemaDescription = + NET.toText <$> FC.schemaDescription schema + } + } + addSchemaToPath :: FC.Name -> Path -> Path addSchemaToPath = (:) . PathSchema @@ -1050,7 +1079,11 @@ instance FC.Fleece FleeceOpenApi where let FleeceOpenApi mkErrOrSchemaInfo = FC.schemaInterpreter schema in - fmap (setSchemaInfoFormat (T.pack formatString)) . mkErrOrSchemaInfo + fmap + ( setSchemaInfoFormat (T.pack formatString) + . applySchemaDescription schema + ) + . mkErrOrSchemaInfo interpretNumber name = FleeceOpenApi $ Right . mkPrimitiveSchema name OpenApi.OpenApiNumber @@ -1069,7 +1102,9 @@ instance FC.Fleece FleeceOpenApi where let FleeceOpenApi mkErrOrItemSchemaInfo = FC.schemaInterpreter schema - itemSchemaInfo <- mkErrOrItemSchemaInfo path + itemSchemaInfo <- + applySchemaDescription schema <$> mkErrOrItemSchemaInfo path + components <- collectComponents [itemSchemaInfo] let @@ -1096,7 +1131,7 @@ instance FC.Fleece FleeceOpenApi where let FleeceOpenApi mkErrOrSchemaInfo = FC.schemaInterpreter schema - schemaInfo <- mkErrOrSchemaInfo path + schemaInfo <- applySchemaDescription schema <$> mkErrOrSchemaInfo path let innerSchemaShouldBeNullable = @@ -1125,7 +1160,10 @@ instance FC.Fleece FleeceOpenApi where let FleeceOpenApi mkErrOrSchemaInfo = FC.schemaInterpreter schema - schemaInfo <- mkErrOrSchemaInfo (addFieldToPath name path) + schemaInfo <- + applySchemaDescription schema + <$> mkErrOrSchemaInfo (addFieldToPath name path) + pure $ FieldInfo { fieldName = T.pack name @@ -1138,7 +1176,10 @@ instance FC.Fleece FleeceOpenApi where let FleeceOpenApi mkErrOrSchemaInfo = FC.schemaInterpreter schema - schemaInfo <- mkErrOrSchemaInfo (addFieldToPath name path) + schemaInfo <- + applySchemaDescription schema + <$> mkErrOrSchemaInfo (addFieldToPath name path) + pure $ FieldInfo { fieldName = T.pack name @@ -1171,7 +1212,9 @@ instance FC.Fleece FleeceOpenApi where let FleeceOpenApi mkErrOrSchemaInfo = FC.schemaInterpreter schema - schemaInfo <- mkErrOrSchemaInfo (addSchemaToPath name path) + schemaInfo <- + applySchemaDescription schema + <$> mkErrOrSchemaInfo (addSchemaToPath name path) let key = Just $ fleeceNameToOpenApiKey name @@ -1203,7 +1246,7 @@ instance FC.Fleece FleeceOpenApi where let FleeceOpenApi errOrSchemaInfo = FC.schemaInterpreter schema in - FleeceOpenApi errOrSchemaInfo + FleeceOpenApi (fmap (applySchemaDescription schema) . errOrSchemaInfo) interpretBoundedEnumNamed name toText = let @@ -1259,7 +1302,7 @@ instance FC.Fleece FleeceOpenApi where let FleeceOpenApi mkErrOrSchemaInfo = FC.schemaInterpreter schema - schemaInfo <- mkErrOrSchemaInfo path + schemaInfo <- applySchemaDescription schema <$> mkErrOrSchemaInfo path pure [schemaInfo] unionCombine (UnionMembers left) (UnionMembers right) = diff --git a/test/Fixtures.hs b/test/Fixtures.hs index ad344be..85ea718 100644 --- a/test/Fixtures.hs +++ b/test/Fixtures.hs @@ -9,6 +9,7 @@ import Fixtures.NoPermissions as Export import Fixtures.NullableRef as Export import Fixtures.NullableRefCollectComponents as Export import Fixtures.OpenApiSubset as Export +import Fixtures.SchemaDescriptions as Export import Fixtures.SimpleGet as Export import Fixtures.SimplePost as Export import Fixtures.TaggedUnion as Export diff --git a/test/Fixtures/SchemaDescriptions.hs b/test/Fixtures/SchemaDescriptions.hs new file mode 100644 index 0000000..d0da4cf --- /dev/null +++ b/test/Fixtures/SchemaDescriptions.hs @@ -0,0 +1,71 @@ +{-# LANGUAGE DataKinds #-} +{-# LANGUAGE TypeFamilies #-} + +module Fixtures.SchemaDescriptions + ( schemaDescriptionsOpenApiRouter + ) where + +import Beeline.Routing ((/-), (/:)) +import Beeline.Routing qualified as R +import Data.Text qualified as T +import Fleece.Core ((#+)) +import Fleece.Core qualified as FC +import Shrubbery qualified + +import Fixtures.NoPermissions (NoPermissions (NoPermissions)) +import Orb qualified +import TestDispatchM qualified as TDM + +schemaDescriptionsOpenApiRouter :: + Orb.OpenApiProvider r => + r (Shrubbery.Union '[SchemaDescriptions]) +schemaDescriptionsOpenApiRouter = + Orb.provideOpenApi "schema-descriptions" $ + R.routeList $ + (Orb.get (R.make SchemaDescriptions /- T.pack "schema-descriptions")) + /: R.emptyRoutes + +newtype DescribedObject + = DescribedObject + { describedObjectContent :: T.Text + } + +describedObjectSchema :: FC.Fleece t => FC.Schema t DescribedObject +describedObjectSchema = + let + objectDescription = T.pack "This is the description for DescribedObject." + fieldDescription = T.pack "This is the description for the content field." + in + FC.describeSchema objectDescription $ + FC.object $ + FC.constructor DescribedObject + #+ FC.required "content" describedObjectContent (FC.describeSchema fieldDescription FC.text) + +data SchemaDescriptions = SchemaDescriptions + +instance Orb.HasHandler SchemaDescriptions where + type HandlerResponses SchemaDescriptions = SchemaDescriptionsResponses + type HandlerPermissionAction SchemaDescriptions = NoPermissions + type HandlerMonad SchemaDescriptions = TDM.TestDispatchM + routeHandler = + Orb.Handler + { Orb.handlerId = "SchemaDescriptionsHandler" + , Orb.requestBody = Orb.EmptyRequestBody + , Orb.requestQuery = Orb.EmptyRequestQuery + , Orb.requestHeaders = Orb.EmptyRequestHeaders + , Orb.handlerResponseBodies = + Orb.responseBodies + . Orb.addResponseSchema200 describedObjectSchema + . Orb.addResponseSchema500 Orb.internalServerErrorSchema + $ Orb.noResponseBodies + , Orb.mkPermissionAction = + \_request -> NoPermissions + , Orb.handleRequest = + \_request () -> + Orb.return200 . DescribedObject $ T.pack "Described content." + } + +type SchemaDescriptionsResponses = + [ Orb.Response200 DescribedObject + , Orb.Response500 Orb.InternalServerError + ] diff --git a/test/OpenApi.hs b/test/OpenApi.hs index 19ab706..ada4185 100644 --- a/test/OpenApi.hs +++ b/test/OpenApi.hs @@ -30,6 +30,7 @@ testGroup = , test_nullableRefOpenApi , test_unionOpenApi , test_taggedUnionOpenApi + , test_schemaDescriptionsOpenApi , test_nullableRefCollectComponentsOpenApi ] @@ -124,6 +125,13 @@ test_taggedUnionOpenApi = "test/examples/tagged-union.json" $ mkTestOpenApi Fixtures.taggedUnionOpenApiRouter "tagged-union" +test_schemaDescriptionsOpenApi :: Tasty.TestTree +test_schemaDescriptionsOpenApi = + mkGoldenTest + "Generates the correct schema descriptions." + "test/examples/schema-descriptions.json" + (mkTestOpenApi Fixtures.schemaDescriptionsOpenApiRouter "schema-descriptions") + test_nullableRefCollectComponentsOpenApi :: Tasty.TestTree test_nullableRefCollectComponentsOpenApi = mkGoldenTest diff --git a/test/examples/schema-descriptions.json b/test/examples/schema-descriptions.json new file mode 100644 index 0000000..0f59c35 --- /dev/null +++ b/test/examples/schema-descriptions.json @@ -0,0 +1,66 @@ +{ + "components": { + "schemas": { + "DescribedObject": { + "description": "This is the description for DescribedObject.", + "properties": { + "content": { + "description": "This is the description for the content field.", + "type": "string" + } + }, + "required": [ + "content" + ], + "title": "DescribedObject", + "type": "object" + }, + "InternalServerError": { + "properties": { + "internal_server_error": { + "type": "string" + } + }, + "required": [ + "internal_server_error" + ], + "title": "InternalServerError", + "type": "object" + } + } + }, + "info": { + "title": "", + "version": "" + }, + "openapi": "3.0.0", + "paths": { + "/schema-descriptions": { + "get": { + "operationId": "SchemaDescriptionsHandler", + "responses": { + "200": { + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/DescribedObject" + } + } + }, + "description": "" + }, + "500": { + "content": { + "application/json": { + "schema": { + "$ref": "#/components/schemas/InternalServerError" + } + } + }, + "description": "" + } + } + } + } + } +}