diff --git a/.github/workflows/haskell-ci.yml b/.github/workflows/haskell-ci.yml index dead0a16..0d255481 100644 --- a/.github/workflows/haskell-ci.yml +++ b/.github/workflows/haskell-ci.yml @@ -8,9 +8,9 @@ # # For more information, see https://github.com/haskell-CI/haskell-ci # -# version: 0.16.3 +# version: 0.17.20231110 # -# REGENDATA ("0.16.3",["github","cabal.project"]) +# REGENDATA ("0.17.20231110",["github","cabal.project"]) # name: Haskell-CI on: @@ -32,19 +32,24 @@ jobs: strategy: matrix: include: - - compiler: ghc-9.6.1 + - compiler: ghc-9.8.1 compilerKind: ghc - compilerVersion: 9.6.1 + compilerVersion: 9.8.1 setup-method: ghcup allow-failure: true - - compiler: ghc-9.4.5 + - compiler: ghc-9.6.3 compilerKind: ghc - compilerVersion: 9.4.5 + compilerVersion: 9.6.3 setup-method: ghcup allow-failure: true - - compiler: ghc-9.2.7 + - compiler: ghc-9.4.8 compilerKind: ghc - compilerVersion: 9.2.7 + compilerVersion: 9.4.8 + setup-method: ghcup + allow-failure: true + - compiler: ghc-9.2.8 + compilerKind: ghc + compilerVersion: 9.2.8 setup-method: ghcup allow-failure: true - compiler: ghc-9.0.2 @@ -80,18 +85,18 @@ jobs: apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5 if [ "${{ matrix.setup-method }}" = ghcup ]; then mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER" || (cat "$HOME"/.ghcup/logs/*.* && false) - "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) else apt-add-repository -y 'ppa:hvr/ghc' apt-get update apt-get install -y "$HCNAME" mkdir -p "$HOME/.ghcup/bin" - curl -sL https://downloads.haskell.org/ghcup/0.1.19.2/x86_64-linux-ghcup-0.1.19.2 > "$HOME/.ghcup/bin/ghcup" + curl -sL https://downloads.haskell.org/ghcup/0.1.20.0/x86_64-linux-ghcup-0.1.20.0 > "$HOME/.ghcup/bin/ghcup" chmod a+x "$HOME/.ghcup/bin/ghcup" - "$HOME/.ghcup/bin/ghcup" install cabal 3.10.1.0 || (cat "$HOME"/.ghcup/logs/*.* && false) + "$HOME/.ghcup/bin/ghcup" install cabal 3.10.2.0 || (cat "$HOME"/.ghcup/logs/*.* && false) fi env: HCKIND: ${{ matrix.compilerKind }} @@ -105,17 +110,19 @@ jobs: echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV" HCDIR=/opt/$HCKIND/$HCVER if [ "${{ matrix.setup-method }}" = ghcup ]; then - HC=$HOME/.ghcup/bin/$HCKIND-$HCVER + HC=$("$HOME/.ghcup/bin/ghcup" whereis ghc "$HCVER") + HCPKG=$(echo "$HC" | sed 's#ghc$#ghc-pkg#') + HADDOCK=$(echo "$HC" | sed 's#ghc$#haddock#') echo "HC=$HC" >> "$GITHUB_ENV" - echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV" - echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "HCPKG=$HCPKG" >> "$GITHUB_ENV" + echo "HADDOCK=$HADDOCK" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" else HC=$HCDIR/bin/$HCKIND echo "HC=$HC" >> "$GITHUB_ENV" echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV" echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV" - echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.1.0 -vnormal+nowrap" >> "$GITHUB_ENV" + echo "CABAL=$HOME/.ghcup/bin/cabal-3.10.2.0 -vnormal+nowrap" >> "$GITHUB_ENV" fi HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))') @@ -244,10 +251,14 @@ jobs: rm -f cabal.project.local - name: constraint set aeson-2 run: | + $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson >=2.0' all --dry-run + cabal-plan topo | sort $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson >=2.0' --dependencies-only -j2 all $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson >=2.0' all - name: constraint set aeson-1 run: | + if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson <2.0' all --dry-run ; fi + if [ $((HCNUMVER < 90200)) -ne 0 ] ; then cabal-plan topo | sort ; fi if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson <2.0' --dependencies-only -j2 all ; fi if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson <2.0' all ; fi - name: save cache diff --git a/CHANGELOG.md b/CHANGELOG.md index 78399a41..0ae62105 100644 --- a/CHANGELOG.md +++ b/CHANGELOG.md @@ -1,6 +1,10 @@ Unreleased ---------- +3.2.4 +----- +- Give `title` to sub schemas of sum types [#88](https://github.com/biocad/openapi3/pull/88). + 3.2.3 ----- diff --git a/openapi3.cabal b/openapi3.cabal index 871424c9..5e467090 100644 --- a/openapi3.cabal +++ b/openapi3.cabal @@ -1,6 +1,6 @@ cabal-version: >=1.10 name: openapi3 -version: 3.2.3 +version: 3.2.4 synopsis: OpenAPI 3.0 data model category: Web, Swagger, OpenApi @@ -28,9 +28,10 @@ tested-with: || ==8.8.4 || ==8.10.7 || ==9.0.2 - || ==9.2.7 - || ==9.4.5 - || ==9.6.1 + || ==9.2.8 + || ==9.4.8 + || ==9.6.3 + || ==9.8.1 custom-setup setup-depends: @@ -65,16 +66,16 @@ library -- GHC boot libraries build-depends: - base >=4.11.1.0 && <4.19 - , bytestring >=0.10.8.2 && <0.12 - , containers >=0.5.11.0 && <0.7 - , template-haskell >=2.13.0.0 && <2.21 + base >=4.11.1.0 && <4.20 + , bytestring >=0.10.8.2 && <0.13 + , containers >=0.5.11.0 && <0.8 + , template-haskell >=2.13.0.0 && <2.22 , time >=1.8.0.2 && <1.14 , transformers >=0.5.5.0 && <0.7 build-depends: mtl >=2.2.2 && <2.4 - , text >=1.2.3.1 && <2.1 + , text >=1.2.3.1 && <2.2 -- other dependencies build-depends: @@ -82,19 +83,19 @@ library , aeson >=1.4.2.0 && <1.6 || >=2.0.1.0 && < 2.3 , aeson-pretty >=0.8.7 && <0.9 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint - , cookie >=0.4.3 && <0.5 + , cookie >=0.4.3 && <0.6 , generics-sop >=0.5.1.0 && <0.6 , hashable >=1.2.7.0 && <1.5 , http-media >=0.8.0.0 && <0.9 , insert-ordered-containers >=0.2.3 && <0.3 - , lens >=4.16.1 && <5.3 + , lens >=4.16.1 && <5.4 , optics-core >=0.2 && <0.5 , optics-th >=0.2 && <0.5 , scientific >=0.3.6.2 && <0.4 , unordered-containers >=0.2.9.0 && <0.3 , uuid-types >=1.0.3 && <1.1 , vector >=0.12.0.1 && <0.14 - , QuickCheck >=2.10.1 && <2.15 + , QuickCheck >=2.10.1 && <2.16 default-language: Haskell2010 diff --git a/src/Data/OpenApi.hs b/src/Data/OpenApi.hs index 75ed43bb..a9ce8f3d 100644 --- a/src/Data/OpenApi.hs +++ b/src/Data/OpenApi.hs @@ -392,6 +392,7 @@ import Data.OpenApi.Internal -- "userId", -- "tag" -- ], +-- "title": "ErrorNoUser", -- "type": "object" -- }, -- { @@ -410,6 +411,7 @@ import Data.OpenApi.Internal -- "requiredPermission", -- "tag" -- ], +-- "title": "ErrorAccessDenied", -- "type": "object" -- } -- ] diff --git a/src/Data/OpenApi/Internal/Schema.hs b/src/Data/OpenApi/Internal/Schema.hs index 1f886bd7..da56acf0 100644 --- a/src/Data/OpenApi/Internal/Schema.hs +++ b/src/Data/OpenApi/Internal/Schema.hs @@ -27,6 +27,7 @@ import Prelude.Compat import Control.Lens hiding (allOf) import Data.Data.Lens (template) +import Control.Applicative ((<|>)) import Control.Monad import Control.Monad.Writer hiding (First, Last) import Data.Aeson (Object (..), SumEncoding (..), ToJSON (..), ToJSONKey (..), @@ -1026,7 +1027,7 @@ instance ( GSumToSchema f ) => GToSchema (f :+: g) where -- Aeson does not unwrap unary record in sum types. - gdeclareNamedSchema opts p s = gdeclareNamedSumSchema (opts { unwrapUnaryRecords = False } )p s + gdeclareNamedSchema opts = gdeclareNamedSumSchema (opts { unwrapUnaryRecords = False }) gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema gdeclareNamedSumSchema opts proxy _ @@ -1055,8 +1056,15 @@ instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where -- | Convert one component of the sum to schema, to be later combined with @oneOf@. gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) => Maybe (Referenced Schema) -> SchemaOptions -> Proxy (C1 c f) -> (T.Text, Referenced Schema) -gsumConToSchemaWith ref opts _ = (tag, schema) +gsumConToSchemaWith ref opts _ = (tag, withTitle) where + -- Give sub-schemas @title@ attribute with constructor name, if none present. + -- This will look prettier in swagger-ui. + withTitle = case schema of + Inline sub -> Inline $ sub + & title %~ (<|> Just (T.pack constructorName)) + s -> s + schema = case sumEncoding opts of TaggedObject tagField contentsField -> case ref of @@ -1064,13 +1072,13 @@ gsumConToSchemaWith ref opts _ = (tag, schema) -- to the record, as Aeson does it. Just (Inline sub) | sub ^. type_ == Just OpenApiObject && isRecord -> Inline $ sub & required <>~ [T.pack tagField] - & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) + & properties . at (T.pack tagField) ?~ Inline (mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) -- If it is not a record, we need to put subschema into "contents" field. _ | not isRecord -> Inline $ mempty & type_ ?~ OpenApiObject & required .~ [T.pack tagField] - & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) + & properties . at (T.pack tagField) ?~ Inline (mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) -- If constructor is nullary, there is no content. & case ref of Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField]) @@ -1081,7 +1089,7 @@ gsumConToSchemaWith ref opts _ = (tag, schema) & allOf ?~ [Inline $ mempty & type_ ?~ OpenApiObject & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField]) - & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])] + & properties . at (T.pack tagField) ?~ Inline (mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])] & if isRecord then allOf . _Just <>~ [refOrNullary] else allOf . _Just <>~ [Inline $ mempty & type_ ?~ OpenApiObject & properties . at (T.pack contentsField) ?~ refOrNullary] @@ -1092,7 +1100,8 @@ gsumConToSchemaWith ref opts _ = (tag, schema) & properties . at tag ?~ refOrNullary TwoElemArray -> error "unrepresentable in OpenAPI 3" - tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p))) + constructorName = conName (Proxy3 :: Proxy3 c f p) + tag = T.pack (constructorTagModifier opts constructorName) isRecord = conIsRecord (Proxy3 :: Proxy3 c f p) refOrNullary = fromMaybe (Inline nullarySchema) ref refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) ref diff --git a/src/Data/OpenApi/Internal/Schema/Validation.hs b/src/Data/OpenApi/Internal/Schema/Validation.hs index 5554ccf8..501e0f09 100644 --- a/src/Data/OpenApi/Internal/Schema/Validation.hs +++ b/src/Data/OpenApi/Internal/Schema/Validation.hs @@ -28,7 +28,7 @@ import Prelude () import Prelude.Compat import Control.Applicative -import Control.Lens hiding (allOf) +import Control.Lens hiding (allOf, anyOf) import Control.Monad (forM, forM_, when) import Data.Aeson hiding (Result) @@ -480,13 +480,20 @@ inferParamSchemaTypes sch = concat , has (pattern._Just) ] ] ] +-- compute number of passing variants and variants +countPassingVariants :: Value -> [Referenced Schema] -> Validation s Int +countPassingVariants val variants = do + res <- forM variants $ \var -> + True <$ validateWithSchemaRef var val <|> return False + pure $ length $ filter id res + + validateSchemaType :: Value -> Validation Schema () validateSchemaType val = withSchema $ \sch -> case sch of (view oneOf -> Just variants) -> do - res <- forM variants $ \var -> - (True <$ validateWithSchemaRef var val) <|> (return False) - case length $ filter id res of + npassing <- countPassingVariants val variants + case npassing of 0 -> invalid $ "Value not valid under any of 'oneOf' schemas: " ++ show val 1 -> valid _ -> invalid $ "Value matches more than one of 'oneOf' schemas: " ++ show val @@ -495,6 +502,11 @@ validateSchemaType val = withSchema $ \sch -> -- variant does not match. forM_ variants $ \var -> validateWithSchemaRef var val + (view anyOf -> Just variants) -> do + npassing <- countPassingVariants val variants + case npassing of + 0 -> invalid $ "Value not valid under any of 'anyOf' schemas: " ++ show val + _ -> valid _ -> case (sch ^. type_, val) of diff --git a/test/Data/OpenApi/CommonTestTypes.hs b/test/Data/OpenApi/CommonTestTypes.hs index 3a83703b..99a39ec7 100644 --- a/test/Data/OpenApi/CommonTestTypes.hs +++ b/test/Data/OpenApi/CommonTestTypes.hs @@ -277,6 +277,7 @@ characterSchemaJSON = [aesonQQ| "tag", "contents" ], + "title": "PC", "type": "object", "properties": { "tag": { @@ -296,6 +297,7 @@ characterSchemaJSON = [aesonQQ| "npcPosition", "tag" ], + "title": "NPC", "type": "object", "properties": { "tag": { @@ -326,6 +328,7 @@ characterInlinedSchemaJSON = [aesonQQ| "tag", "contents" ], + "title": "PC", "type": "object", "properties": { "tag": { @@ -367,6 +370,7 @@ characterInlinedSchemaJSON = [aesonQQ| "npcPosition", "tag" ], + "title": "NPC", "type": "object", "properties": { "tag": { @@ -410,6 +414,7 @@ characterInlinedPlayerSchemaJSON = [aesonQQ| "tag", "contents" ], + "title": "PC", "type": "object", "properties": { "tag": { @@ -437,6 +442,7 @@ characterInlinedPlayerSchemaJSON = [aesonQQ| "npcPosition", "tag" ], + "title": "NPC", "type": "object", "properties": { "tag": { @@ -636,6 +642,7 @@ lightSchemaJSON = [aesonQQ| "required": [ "tag" ], + "title": "NoLight", "type": "object", "properties": { "tag": { @@ -651,6 +658,7 @@ lightSchemaJSON = [aesonQQ| "tag", "contents" ], + "title": "LightFreq", "type": "object", "properties": { "tag": { @@ -670,6 +678,7 @@ lightSchemaJSON = [aesonQQ| "tag", "contents" ], + "title": "LightColor", "type": "object", "properties": { "tag": { @@ -688,6 +697,7 @@ lightSchemaJSON = [aesonQQ| "waveLength", "tag" ], + "title": "LightWaveLength", "type": "object", "properties": { "tag": { @@ -714,6 +724,7 @@ lightInlinedSchemaJSON = [aesonQQ| "required": [ "tag" ], + "title": "NoLight", "type": "object", "properties": { "tag": { @@ -729,6 +740,7 @@ lightInlinedSchemaJSON = [aesonQQ| "tag", "contents" ], + "title": "LightFreq", "type": "object", "properties": { "tag": { @@ -748,6 +760,7 @@ lightInlinedSchemaJSON = [aesonQQ| "tag", "contents" ], + "title": "LightColor", "type": "object", "properties": { "tag": { @@ -771,6 +784,7 @@ lightInlinedSchemaJSON = [aesonQQ| "waveLength", "tag" ], + "title": "LightWaveLength", "type": "object", "properties": { "tag": { @@ -914,6 +928,7 @@ predicateSchemaDeclareJSON = [aesonQQ| "tag": { "enum": ["PredicateNoun"], "type": "string" } }, "required": ["tag", "contents"], + "title": "PredicateNoun", "type": "object" }, { @@ -922,6 +937,7 @@ predicateSchemaDeclareJSON = [aesonQQ| "tag": { "enum": ["PredicateOmitted"], "type": "string" } }, "required": ["tag", "contents"], + "title": "PredicateOmitted", "type": "object" } ] @@ -953,6 +969,7 @@ predicateSchemaDeclareJSON = [aesonQQ| "tag": { "enum": ["ModifierNoun"], "type": "string" } }, "required": ["tag", "contents"], + "title": "ModifierNoun", "type": "object" }, { @@ -961,6 +978,7 @@ predicateSchemaDeclareJSON = [aesonQQ| "tag": { "enum": ["ModifierOmitted"], "type": "string" } }, "required": ["tag", "contents"], + "title": "ModifierOmitted", "type": "object" } ]