Skip to content
New issue

Have a question about this project? Sign up for a free GitHub account to open an issue and contact its maintainers and the community.

Sign up for GitHub

By clicking “Sign up for GitHub”, you agree to our terms of service and privacy statement. We’ll occasionally send you account related emails.

Already on GitHub? Sign in to your account

Jump to bottom

add anyOf case to validateSchemaType #87

Open
wants to merge 7 commits into
base: master
Choose a base branch
from
Open

add anyOf case to validateSchemaType #87

Show file tree
Hide file tree
Changes from all commits
Commits
Show all changes
7 commits
Select commit Hold shift + click to select a range
f22c316
add anyOf case to validateSchemaType
paolino Nov 10, 2023
666f766
Give title to sub-schemas of oneOf for sum types
maksbotan Nov 18, 2023
84ccfaa
version 3.2.4
maksbotan Nov 20, 2023
0965a7a
Bump versions for GHC 9.8
maksbotan Nov 27, 2023
f002189
Allow `lens ^>=5.3`
JackKelly-Bellroy May 14, 2024
bdc21a3
Allow `QuickCheck ^>=2.15`
JackKelly-Bellroy May 14, 2024
fab96d6
Allow cookie-0.5
spencerjanssen Apr 29, 2024
File filter

Filter by extension

Filter by extension
Conversations
Failed to load comments.
Loading
Jump to
Jump to file
Failed to load files.
Loading
Diff view
Diff view
45 changes: 28 additions & 17 deletions .github/workflows/haskell-ci.yml
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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:
Expand All @@ -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
Expand Down Expand Up @@ -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 }}
Expand All @@ -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))')
Expand Down Expand Up @@ -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
Expand Down
4 changes: 4 additions & 0 deletions CHANGELOG.md
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
-----

Expand Down
25 changes: 13 additions & 12 deletions openapi3.cabal
View file
Open in desktop
Original file line number Diff line number Diff line change
@@ -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
Expand Down Expand Up @@ -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:
Expand Down Expand Up @@ -65,36 +66,36 @@ 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:
base-compat-batteries >=0.11.1 && <0.14
, 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

Expand Down
2 changes: 2 additions & 0 deletions src/Data/OpenApi.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -392,6 +392,7 @@ import Data.OpenApi.Internal
-- "userId",
-- "tag"
-- ],
-- "title": "ErrorNoUser",
-- "type": "object"
-- },
-- {
Expand All @@ -410,6 +411,7 @@ import Data.OpenApi.Internal
-- "requiredPermission",
-- "tag"
-- ],
-- "title": "ErrorAccessDenied",
-- "type": "object"
-- }
-- ]
Expand Down
21 changes: 15 additions & 6 deletions src/Data/OpenApi/Internal/Schema.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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 (..),
Expand Down Expand Up @@ -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 _
Expand Down Expand Up @@ -1055,22 +1056,29 @@ 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
-- If subschema is an object and constructor is a record, we add tag directly
-- 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])
Expand All @@ -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]
Expand All @@ -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
Expand Down
20 changes: 16 additions & 4 deletions src/Data/OpenApi/Internal/Schema/Validation.hs
View file
Open in desktop
Original file line number Diff line number Diff line change
Expand Up @@ -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)
Expand Down Expand Up @@ -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
Expand All @@ -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
Expand Down
Loading