git.iko.soy/typeable/openapi3
on master help sign in
34 files changed+1950−1058
since splitsnapshots
unifiedsplit
.github/workflows/haskell-ci.yml+243 .travis.yml−149 CHANGELOG.md+47 README.md+13−11 cabal.haskell-ci+11 cabal.project+2 examples/hackage.hs+16−20 swagger2.cabal → openapi3.cabal+62−52 src/Data/Swagger.hs → src/Data/OpenApi.hs+178−49 src/Data/OpenApi/Aeson/Compat.hs+76 src/Data/Swagger/Declare.hs → src/Data/OpenApi/Declare.hs+2−2 src/Data/Swagger/Internal.hs → src/Data/OpenApi/Internal.hs+202−137 src/Data/Swagger/Internal/AesonUtils.hs → src/Data/OpenApi/Internal/AesonUtils.hs+12−13 src/Data/Swagger/Internal/ParamSchema.hs → src/Data/OpenApi/Internal/ParamSchema.hs+76−52 src/Data/Swagger/Internal/Schema.hs → src/Data/OpenApi/Internal/Schema.hs+383−140 src/Data/Swagger/Internal/Schema/Validation.hs → src/Data/OpenApi/Internal/Schema/Validation.hs+85−79 src/Data/Swagger/Internal/TypeShape.hs → src/Data/OpenApi/Internal/TypeShape.hs+1−1 src/Data/Swagger/Internal/Utils.hs → src/Data/OpenApi/Internal/Utils.hs+6−1 src/Data/Swagger/Lens.hs → src/Data/OpenApi/Lens.hs+48−58 src/Data/Swagger/Operation.hs → src/Data/OpenApi/Operation.hs+136−29 src/Data/Swagger/Optics.hs → src/Data/OpenApi/Optics.hs+90−153 src/Data/Swagger/ParamSchema.hs → src/Data/OpenApi/ParamSchema.hs+7−7 src/Data/Swagger/Schema.hs → src/Data/OpenApi/Schema.hs+4−9 src/Data/Swagger/Schema/Generator.hs → src/Data/OpenApi/Schema/Generator.hs+17−15 src/Data/Swagger/Schema/Validation.hs → src/Data/OpenApi/Schema/Validation.hs+7−7 src/Data/Swagger/SchemaOptions.hs → src/Data/OpenApi/SchemaOptions.hs+2−2 stack.yaml+1−1 test/Data/Swagger/CommonTestTypes.hs → test/Data/OpenApi/CommonTestTypes.hs+125−2 test/Data/Swagger/ParamSchemaSpec.hs → test/Data/OpenApi/ParamSchemaSpec.hs+4−4 test/Data/Swagger/Schema/GeneratorSpec.hs → test/Data/OpenApi/Schema/GeneratorSpec.hs+7−7 test/Data/Swagger/Schema/ValidationSpec.hs → test/Data/OpenApi/Schema/ValidationSpec.hs+27−10 test/Data/Swagger/SchemaSpec.hs → test/Data/OpenApi/SchemaSpec.hs+8−4 test/Data/SwaggerSpec.hs → test/Data/OpenApiSpec.hs+52−36 test/SpecCommon.hs−8
.github/workflows/haskell-ci.ymlnew file+243
@@ -0,0 +1,243 @@
1+# This GitHub workflow config has been generated by a script via
2+#
3+# haskell-ci 'github' 'cabal.project'
4+#
5+# To regenerate the script (for example after adjusting tested-with) run
6+#
7+# haskell-ci regenerate
8+#
9+# For more information, see https://github.com/haskell-CI/haskell-ci
10+#
11+# version: 0.14.3
12+#
13+# REGENDATA ("0.14.3",["github","cabal.project"])
14+#
15+name: Haskell-CI
16+on:
17+ push:
18+ branches:
19+ - master
20+ pull_request:
21+ branches:
22+ - master
23+jobs:
24+ linux:
25+ name: Haskell-CI - Linux - ${{ matrix.compiler }}
26+ runs-on: ubuntu-18.04
27+ timeout-minutes:
28+ 60
29+ container:
30+ image: buildpack-deps:focal
31+ continue-on-error: ${{ matrix.allow-failure }}
32+ strategy:
33+ matrix:
34+ include:
35+ - compiler: ghc-9.2.2
36+ compilerKind: ghc
37+ compilerVersion: 9.2.2
38+ setup-method: ghcup
39+ allow-failure: true
40+ - compiler: ghc-9.0.2
41+ compilerKind: ghc
42+ compilerVersion: 9.0.2
43+ setup-method: ghcup
44+ allow-failure: false
45+ - compiler: ghc-8.10.7
46+ compilerKind: ghc
47+ compilerVersion: 8.10.7
48+ setup-method: ghcup
49+ allow-failure: false
50+ - compiler: ghc-8.8.4
51+ compilerKind: ghc
52+ compilerVersion: 8.8.4
53+ setup-method: hvr-ppa
54+ allow-failure: false
55+ - compiler: ghc-8.6.5
56+ compilerKind: ghc
57+ compilerVersion: 8.6.5
58+ setup-method: hvr-ppa
59+ allow-failure: false
60+ - compiler: ghc-8.4.4
61+ compilerKind: ghc
62+ compilerVersion: 8.4.4
63+ setup-method: hvr-ppa
64+ allow-failure: false
65+ fail-fast: false
66+ steps:
67+ - name: apt
68+ run: |
69+ apt-get update
70+ apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
71+ if [ "${{ matrix.setup-method }}" = ghcup ]; then
72+ mkdir -p "$HOME/.ghcup/bin"
73+ curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
74+ chmod a+x "$HOME/.ghcup/bin/ghcup"
75+ "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER"
76+ "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
77+ else
78+ apt-add-repository -y 'ppa:hvr/ghc'
79+ apt-get update
80+ apt-get install -y "$HCNAME"
81+ mkdir -p "$HOME/.ghcup/bin"
82+ curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
83+ chmod a+x "$HOME/.ghcup/bin/ghcup"
84+ "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
85+ fi
86+ env:
87+ HCKIND: ${{ matrix.compilerKind }}
88+ HCNAME: ${{ matrix.compiler }}
89+ HCVER: ${{ matrix.compilerVersion }}
90+ - name: Set PATH and environment variables
91+ run: |
92+ echo "$HOME/.cabal/bin" >> $GITHUB_PATH
93+ echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
94+ echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
95+ echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
96+ HCDIR=/opt/$HCKIND/$HCVER
97+ if [ "${{ matrix.setup-method }}" = ghcup ]; then
98+ HC=$HOME/.ghcup/bin/$HCKIND-$HCVER
99+ echo "HC=$HC" >> "$GITHUB_ENV"
100+ echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"
101+ echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"
102+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
103+ else
104+ HC=$HCDIR/bin/$HCKIND
105+ echo "HC=$HC" >> "$GITHUB_ENV"
106+ echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
107+ echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
108+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
109+ fi
110+
111+ HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
112+ echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
113+ echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
114+ echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
115+ echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
116+ echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
117+ echo "GHCJSARITH=0" >> "$GITHUB_ENV"
118+ env:
119+ HCKIND: ${{ matrix.compilerKind }}
120+ HCNAME: ${{ matrix.compiler }}
121+ HCVER: ${{ matrix.compilerVersion }}
122+ - name: env
123+ run: |
124+ env
125+ - name: write cabal config
126+ run: |
127+ mkdir -p $CABAL_DIR
128+ cat >> $CABAL_CONFIG <<EOF
129+ remote-build-reporting: anonymous
130+ write-ghc-environment-files: never
131+ remote-repo-cache: $CABAL_DIR/packages
132+ logs-dir: $CABAL_DIR/logs
133+ world-file: $CABAL_DIR/world
134+ extra-prog-path: $CABAL_DIR/bin
135+ symlink-bindir: $CABAL_DIR/bin
136+ installdir: $CABAL_DIR/bin
137+ build-summary: $CABAL_DIR/logs/build.log
138+ store-dir: $CABAL_DIR/store
139+ install-dirs user
140+ prefix: $CABAL_DIR
141+ repository hackage.haskell.org
142+ url: http://hackage.haskell.org/
143+ EOF
144+ cat >> $CABAL_CONFIG <<EOF
145+ program-default-options
146+ ghc-options: $GHCJOBS +RTS -M3G -RTS
147+ EOF
148+ cat $CABAL_CONFIG
149+ - name: versions
150+ run: |
151+ $HC --version || true
152+ $HC --print-project-git-commit-id || true
153+ $CABAL --version || true
154+ - name: update cabal index
155+ run: |
156+ $CABAL v2-update -v
157+ - name: install cabal-plan
158+ run: |
159+ mkdir -p $HOME/.cabal/bin
160+ curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.6.2.0/cabal-plan-0.6.2.0-x86_64-linux.xz > cabal-plan.xz
161+ echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c -
162+ xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
163+ rm -f cabal-plan.xz
164+ chmod a+x $HOME/.cabal/bin/cabal-plan
165+ cabal-plan --version
166+ - name: checkout
167+ uses: actions/checkout@v2
168+ with:
169+ path: source
170+ - name: initial cabal.project for sdist
171+ run: |
172+ touch cabal.project
173+ echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project
174+ cat cabal.project
175+ - name: sdist
176+ run: |
177+ mkdir -p sdist
178+ $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
179+ - name: unpack
180+ run: |
181+ mkdir -p unpacked
182+ find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
183+ - name: generate cabal.project
184+ run: |
185+ PKGDIR_openapi3="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/openapi3-[0-9.]*')"
186+ echo "PKGDIR_openapi3=${PKGDIR_openapi3}" >> "$GITHUB_ENV"
187+ rm -f cabal.project cabal.project.local
188+ touch cabal.project
189+ touch cabal.project.local
190+ echo "packages: ${PKGDIR_openapi3}" >> cabal.project
191+ echo "package openapi3" >> cabal.project
192+ echo " ghc-options: -Werror=missing-methods" >> cabal.project
193+ cat >> cabal.project <<EOF
194+ allow-newer: http-media:base
195+ EOF
196+ $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(openapi3)$/; }' >> cabal.project.local
197+ cat cabal.project
198+ cat cabal.project.local
199+ - name: dump install plan
200+ run: |
201+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
202+ cabal-plan
203+ - name: cache
204+ uses: actions/cache@v2
205+ with:
206+ key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
207+ path: ~/.cabal/store
208+ restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
209+ - name: install dependencies
210+ run: |
211+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
212+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
213+ - name: build w/o tests
214+ run: |
215+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
216+ - name: build
217+ run: |
218+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
219+ - name: tests
220+ run: |
221+ $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
222+ - name: cabal check
223+ run: |
224+ cd ${PKGDIR_openapi3} || false
225+ ${CABAL} -vnormal check
226+ - name: haddock
227+ run: |
228+ $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
229+ - name: unconstrained build
230+ run: |
231+ rm -f cabal.project.local
232+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
233+ - name: prepare for constraint sets
234+ run: |
235+ rm -f cabal.project.local
236+ - name: constraint set aeson-2
237+ run: |
238+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson >=2.0' --dependencies-only -j2 all
239+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson >=2.0' all
240+ - name: constraint set aeson-1
241+ run: |
242+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson <2.0' --dependencies-only -j2 all ; fi
243+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson <2.0' all ; fi
.travis.ymldeleted−149
@@ -1,149 +0,0 @@
1−# This Travis job script has been generated by a script via
2−#
3−# haskell-ci '--branches' 'master' '--haddock-jobs=>=8.4' '--output' '.travis.yml' 'swagger2.cabal'
4−#
5−# To regenerate the script (for example after adjusting tested-with) run
6−#
7−# haskell-ci regenerate
8−#
9−# For more information, see https://github.com/haskell-CI/haskell-ci
10−#
11−# version: 0.10.1
12−#
13−version: ~> 1.0
14−language: c
15−os: linux
16−dist: xenial
17−git:
18− # whether to recursively clone submodules
19− submodules: false
20−branches:
21− only:
22− - master
23−cache:
24− directories:
25− - $HOME/.cabal/packages
26− - $HOME/.cabal/store
27− - $HOME/.hlint
28−before_cache:
29− - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
30− # remove files that are regenerated by 'cabal update'
31− - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
32− - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
33− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
34− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
35− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
36− - rm -rfv $CABALHOME/packages/head.hackage
37−jobs:
38− include:
39− - compiler: ghc-8.10.1
40− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.1","cabal-install-3.2"]}}
41− os: linux
42− - compiler: ghc-8.8.3
43− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.3","cabal-install-3.2"]}}
44− os: linux
45− - compiler: ghc-8.6.5
46− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.2"]}}
47− os: linux
48− - compiler: ghc-8.4.4
49− addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.2"]}}
50− os: linux
51−before_install:
52− - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
53− - WITHCOMPILER="-w $HC"
54− - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
55− - HCPKG="$HC-pkg"
56− - unset CC
57− - CABAL=/opt/ghc/bin/cabal
58− - CABALHOME=$HOME/.cabal
59− - export PATH="$CABALHOME/bin:$PATH"
60− - TOP=$(pwd)
61− - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
62− - echo $HCNUMVER
63− - CABAL="$CABAL -vnormal+nowrap"
64− - set -o pipefail
65− - TEST=--enable-tests
66− - BENCH=--enable-benchmarks
67− - HEADHACKAGE=false
68− - rm -f $CABALHOME/config
69− - |
70− echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
71− echo "remote-build-reporting: anonymous" >> $CABALHOME/config
72− echo "write-ghc-environment-files: always" >> $CABALHOME/config
73− echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
74− echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
75− echo "world-file: $CABALHOME/world" >> $CABALHOME/config
76− echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
77− echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
78− echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
79− echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
80− echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
81− echo "install-dirs user" >> $CABALHOME/config
82− echo " prefix: $CABALHOME" >> $CABALHOME/config
83− echo "repository hackage.haskell.org" >> $CABALHOME/config
84− echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
85−install:
86− - ${CABAL} --version
87− - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
88− - |
89− echo "program-default-options" >> $CABALHOME/config
90− echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
91− - cat $CABALHOME/config
92− - rm -fv cabal.project cabal.project.local cabal.project.freeze
93− - travis_retry ${CABAL} v2-update -v
94− # Generate cabal.project
95− - rm -rf cabal.project cabal.project.local cabal.project.freeze
96− - touch cabal.project
97− - |
98− echo "packages: ." >> cabal.project
99− - echo 'package swagger2' >> cabal.project
100− - "echo ' ghc-options: -Werror=missing-methods' >> cabal.project"
101− - |
102− - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(swagger2)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
103− - cat cabal.project || true
104− - cat cabal.project.local || true
105− - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
106− - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}
107− - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
108− - rm cabal.project.freeze
109− - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all
110− - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all
111−script:
112− - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
113− # Packaging...
114− - ${CABAL} v2-sdist all
115− # Unpacking...
116− - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
117− - cd ${DISTDIR} || false
118− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
119− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
120− - PKGDIR_swagger2="$(find . -maxdepth 1 -type d -regex '.*/swagger2-[0-9.]*')"
121− # Generate cabal.project
122− - rm -rf cabal.project cabal.project.local cabal.project.freeze
123− - touch cabal.project
124− - |
125− echo "packages: ${PKGDIR_swagger2}" >> cabal.project
126− - echo 'package swagger2' >> cabal.project
127− - "echo ' ghc-options: -Werror=missing-methods' >> cabal.project"
128− - |
129− - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(swagger2)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
130− - cat cabal.project || true
131− - cat cabal.project.local || true
132− # Building...
133− # this builds all libraries and executables (without tests/benchmarks)
134− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
135− # Building with tests and benchmarks...
136− # build & run tests, build benchmarks
137− - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all
138− # Testing...
139− - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all
140− # cabal check...
141− - (cd ${PKGDIR_swagger2} && ${CABAL} -vnormal check)
142− # haddock...
143− - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all
144− # Building without installed constraints for packages in global-db...
145− - rm -f cabal.project.local
146− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
147−
148−# REGENDATA ("0.10.1",["--branches","master","--haddock-jobs=>=8.4","--output",".travis.yml","swagger2.cabal"])
149−# EOF
CHANGELOG.md+47
@@ -1,3 +1,50 @@
1+Unreleased
2+----------
3+
4+3.2.2
5+-----
6+
7+- Fix bug with infinite recursion in GToSchema [#37](https://github.com/biocad/openapi3/pull/37).
8+
9+3.2.1
10+-----
11+
12+- Support aeson-2.0.3.
13+- Support GHC-9.2 (doctests still fail).
14+
15+3.2.0
16+-----
17+
18+- Support aeson-2 [#34](https://github.com/biocad/openapi3/pull/34).
19+- Use `SecurityDefinitions` type for `_componentsSecuritySchemes`
20+ [#32](https://github.com/biocad/openapi3/pull/32).
21+
22+3.1.0
23+-----
24+
25+- Use `format: date-time` for `ToParamSchema ZonedTime` instance (see
26+ [#20](https://github.com/biocad/openapi3/pull/20)).
27+- Support generating schema for any polymorphic types via `Typeable` (see
28+ [#19](https://github.com/biocad/openapi3/pull/19)).
29+- Allow `hashable-1.3.1`, prettify doctests (see [#18](https://github.com/biocad/openapi3/pull/18)).
30+
31+3.0.2.0
32+-------
33+
34+- Fix definition for HTTP security scheme (see [#10](https://github.com/biocad/openapi3/pull/10));
35+- Fix error message in `exclusiveMaximum` / `exclusiveMinimum` validation (see
36+ [#15](https://github.com/biocad/openapi3/pull/15));
37+
38+3.0.1.0
39+-------
40+
41+- Support polymorphic types in schema generator.
42+
43+3.0.0
44+-----
45+
46+- Switch to OpenAPI 3.0 specification.
47+
1482.6.1
249-----
350
README.md+13−11
@@ -1,21 +1,22 @@
1−# swagger2
1+# OpenApi 3
22
3−[![Join the chat at https://gitter.im/haskell-swagger2/Lobby](https://badges.gitter.im/haskell-swagger2/Lobby.svg)](https://gitter.im/haskell-swagger2/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
3+[![Hackage](https://img.shields.io/hackage/v/openapi3.svg)](http://hackage.haskell.org/package/openapi3)
4+[![Build Status](https://travis-ci.org/biocad/openapi3.svg?branch=master)](https://travis-ci.org/biocad/openapi3)
5+[![Stackage LTS](http://stackage.org/package/openapi3/badge/lts)](http://stackage.org/lts/package/opeopenapi3)
6+[![Stackage Nightly](http://stackage.org/package/openapi3/badge/nightly)](http://stackage.org/nightly/package/openapi3)
47
5−[![Hackage](https://img.shields.io/hackage/v/swagger2.svg)](http://hackage.haskell.org/package/swagger2)
6−[![Build Status](https://travis-ci.org/GetShopTV/swagger2.svg?branch=master)](https://travis-ci.org/GetShopTV/swagger2)
7−[![Stackage LTS](http://stackage.org/package/swagger2/badge/lts)](http://stackage.org/lts/package/swagger2)
8−[![Stackage Nightly](http://stackage.org/package/swagger2/badge/nightly)](http://stackage.org/nightly/package/swagger2)
8+OpenAPI 3.0 data model.
99
10−Swagger 2.0 data model.
10+The original OpenAPI 3.0 specification is available at http://swagger.io/specification/.
1111
12−The original Swagger 2.0 specification is available at http://swagger.io/specification/.
12+This package is heavily based on excellent work on Swagger 2.0 at
13+https://github.com/GetShopTV/swagger2.
1314
1415## Usage
1516
16−This library is intended to be used for decoding and encoding Swagger 2.0 API specifications as well as manipulating them.
17+This library is intended to be used for decoding and encoding OpenApi 3.0.3 specifications as well as manipulating them.
1718
18−Please refer to [haddock documentation](http://hackage.haskell.org/package/swagger2).
19+Please refer to [haddock documentation](http://hackage.haskell.org/package/openapi3).
1920
2021Some examples can be found in [`examples/` directory](/examples).
2122
@@ -33,7 +34,8 @@ Many Swagger tools, including server and client code generation for many languag
3334
3435We are happy to receive bug reports, fixes, documentation enhancements, and other improvements.
3536
36−Please report bugs via the [github issue tracker](https://github.com/GetShopTV/swagger2/issues).
37+Please report bugs via the [github issue tracker](https://github.com/biocad/openapi3/issues).
3738
3839*GetShopTV Team*
3940
41+*Biocad Team*
cabal.haskell-cinew file+11
@@ -0,0 +1,11 @@
1+branches: master
2+
3+distribution: focal
4+allow-failures: >=9.2
5+
6+constraint-set aeson-1
7+ constraints: aeson <2.0
8+ ghc: <9.2
9+
10+constraint-set aeson-2
11+ constraints: aeson >=2.0
cabal.project+2
@@ -1,2 +1,4 @@
11packages: .
22tests: true
3+
4+allow-newer: http-media:base
examples/hackage.hs+16−20
@@ -10,10 +10,10 @@ import Data.Proxy
1010import Data.Text (Text)
1111import GHC.Generics
1212
13−import Data.Swagger
14−import Data.Swagger.Declare
15−import Data.Swagger.Lens
16−import Data.Swagger.Operation
13+import Data.OpenApi
14+import Data.OpenApi.Declare
15+import Data.OpenApi.Lens
16+import Data.OpenApi.Operation
1717
1818type Username = Text
1919
@@ -27,7 +27,7 @@ instance ToSchema UserSummary where
2727 usernameSchema <- declareSchemaRef (Proxy :: Proxy Username)
2828 useridSchema <- declareSchemaRef (Proxy :: Proxy Int)
2929 return $ NamedSchema (Just "UserSummary") $ mempty
30− & type_ ?~ SwaggerObject
30+ & type_ ?~ OpenApiObject
3131 & properties .~
3232 [ ("summaryUsername", usernameSchema )
3333 , ("summaryUserid" , useridSchema )
@@ -47,40 +47,36 @@ data UserDetailed = UserDetailed
4747newtype Package = Package { packageName :: Text }
4848 deriving (Generic, ToSchema)
4949
50−hackageSwagger :: Swagger
51−hackageSwagger = spec & definitions .~ defs
50+hackageOpenApi :: OpenApi
51+hackageOpenApi = spec & components.schemas .~ defs
5252 where
53− (defs, spec) = runDeclare declareHackageSwagger mempty
53+ (defs, spec) = runDeclare declareHackageOpenApi mempty
5454
55−declareHackageSwagger :: Declare (Definitions Schema) Swagger
56−declareHackageSwagger = do
55+declareHackageOpenApi :: Declare (Definitions Schema) OpenApi
56+declareHackageOpenApi = do
5757 -- param schemas
5858 let usernameParamSchema = toParamSchema (Proxy :: Proxy Username)
5959
6060 -- responses
61− userSummaryResponse <- declareResponse (Proxy :: Proxy UserSummary)
62− userDetailedResponse <- declareResponse (Proxy :: Proxy UserDetailed)
63− packagesResponse <- declareResponse (Proxy :: Proxy [Package])
61+ userSummaryResponse <- declareResponse "application/json" (Proxy :: Proxy UserSummary)
62+ userDetailedResponse <- declareResponse "application/json" (Proxy :: Proxy UserDetailed)
63+ packagesResponse <- declareResponse "application/json" (Proxy :: Proxy [Package])
6464
6565 return $ mempty
6666 & paths .~
6767 [ ("/users", mempty & get ?~ (mempty
68− & produces ?~ MimeList ["application/json"]
6968 & at 200 ?~ Inline userSummaryResponse))
7069 , ("/user/{username}", mempty & get ?~ (mempty
71− & produces ?~ MimeList ["application/json"]
7270 & parameters .~ [ Inline $ mempty
7371 & name .~ "username"
7472 & required ?~ True
75− & schema .~ ParamOther (mempty
76− & in_ .~ ParamPath
77− & paramSchema .~ usernameParamSchema) ]
73+ & in_ .~ ParamPath
74+ & schema ?~ Inline usernameParamSchema ]
7875 & at 200 ?~ Inline userDetailedResponse))
7976 , ("/packages", mempty & get ?~ (mempty
80− & produces ?~ MimeList ["application/json"]
8177 & at 200 ?~ Inline packagesResponse))
8278 ]
8379
8480main :: IO ()
85−main = putStrLn . read . show . encode $ hackageSwagger
81+main = putStrLn . read . show . encode $ hackageOpenApi
8682
swagger2.cabal → openapi3.cabalrenamed+62−52
@@ -1,22 +1,22 @@
11cabal-version: >=1.10
2−name: swagger2
3−version: 2.6.1
2+name: openapi3
3+version: 3.2.2
44
5−synopsis: Swagger 2.0 data model
6−category: Web, Swagger
5+synopsis: OpenAPI 3.0 data model
6+category: Web, Swagger, OpenApi
77description:
8− This library is intended to be used for decoding and encoding Swagger 2.0 API
8+ This library is intended to be used for decoding and encoding OpenAPI 3.0 API
99 specifications as well as manipulating them.
1010 .
11− The original Swagger 2.0 specification is available at http://swagger.io/specification/.
11+ The original OpenAPI 3.0 specification is available at http://swagger.io/specification/.
1212
13−homepage: https://github.com/GetShopTV/swagger2
14−bug-reports: https://github.com/GetShopTV/swagger2/issues
13+homepage: https://github.com/biocad/openapi3
14+bug-reports: https://github.com/biocad/openapi3/issues
1515license: BSD3
1616license-file: LICENSE
17−author: Nickolay Kudasov
18−maintainer: nickolay@getshoptv.com
19−copyright: (c) 2015-2016, GetShopTV
17+author: Nickolay Kudasov, Maxim Koltsov
18+maintainer: nickolay@getshoptv.com, kolmax94@gmail.com
19+copyright: (c) 2015-2016, GetShopTV, (c) 2020, Biocad
2020build-type: Custom
2121extra-source-files:
2222 README.md
@@ -25,8 +25,10 @@ extra-source-files:
2525tested-with:
2626 GHC ==8.4.4
2727 || ==8.6.5
28− || ==8.8.3
29− || ==8.10.1
28+ || ==8.8.4
29+ || ==8.10.7
30+ || ==9.0.2
31+ || ==9.2.2
3032
3133custom-setup
3234 setup-depends:
@@ -35,54 +37,56 @@ custom-setup
3537library
3638 hs-source-dirs: src
3739 exposed-modules:
38− Data.Swagger
39− Data.Swagger.Declare
40− Data.Swagger.Lens
41− Data.Swagger.Operation
42− Data.Swagger.Optics
43− Data.Swagger.ParamSchema
44− Data.Swagger.Schema
45− Data.Swagger.Schema.Generator
46− Data.Swagger.Schema.Validation
47− Data.Swagger.SchemaOptions
40+ Data.OpenApi
41+ Data.OpenApi.Declare
42+ Data.OpenApi.Lens
43+ Data.OpenApi.Operation
44+ Data.OpenApi.Optics
45+ Data.OpenApi.ParamSchema
46+ Data.OpenApi.Schema
47+ Data.OpenApi.Schema.Generator
48+ Data.OpenApi.Schema.Validation
49+ Data.OpenApi.SchemaOptions
4850
4951 -- internal modules
50− Data.Swagger.Internal
51− Data.Swagger.Internal.Schema
52− Data.Swagger.Internal.Schema.Validation
53− Data.Swagger.Internal.ParamSchema
54− Data.Swagger.Internal.Utils
55− Data.Swagger.Internal.AesonUtils
56− Data.Swagger.Internal.TypeShape
52+ Data.OpenApi.Internal
53+ Data.OpenApi.Internal.Schema
54+ Data.OpenApi.Internal.Schema.Validation
55+ Data.OpenApi.Internal.ParamSchema
56+ Data.OpenApi.Internal.Utils
57+ Data.OpenApi.Internal.AesonUtils
58+ Data.OpenApi.Internal.TypeShape
59+
60+ Data.OpenApi.Aeson.Compat
5761
5862 -- GHC boot libraries
5963 build-depends:
60− base >=4.11.1.0 && <4.15
61− , bytestring >=0.10.8.2 && <0.11
64+ base >=4.11.1.0 && <4.17
65+ , bytestring >=0.10.8.2 && <0.12
6266 , containers >=0.5.11.0 && <0.7
63− , template-haskell >=2.13.0.0 && <2.17
64− , time >=1.8.0.2 && <1.10
67+ , template-haskell >=2.13.0.0 && <2.19
68+ , time >=1.8.0.2 && <1.14
6569 , transformers >=0.5.5.0 && <0.6
6670
6771 build-depends:
6872 mtl >=2.2.2 && <2.3
69− , text >=1.2.3.1 && <1.3
73+ , text >=1.2.3.1 && <2.1
7074
7175 -- other dependencies
7276 build-depends:
73− base-compat-batteries >=0.11.1 && <0.12
74− , aeson >=1.4.2.0 && <1.6
77+ base-compat-batteries >=0.11.1 && <0.13
78+ , aeson >=1.4.2.0 && <1.6 || >=2.0.1.0 && < 2.1
7579 , aeson-pretty >=0.8.7 && <0.9
7680 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
7781 , cookie >=0.4.3 && <0.5
7882 , generics-sop >=0.5.1.0 && <0.6
79− , hashable >=1.2.7.0 && <1.4
83+ , hashable >=1.2.7.0 && <1.5
8084 , http-media >=0.8.0.0 && <0.9
8185 , insert-ordered-containers >=0.2.3 && <0.3
82− , lens >=4.16.1 && <4.20
86+ , lens >=4.16.1 && <5.2
8387 , network >=2.6.3.5 && <3.2
84− , optics-core >=0.2 && <0.4
85− , optics-th >=0.2 && <0.4
88+ , optics-core >=0.2 && <0.5
89+ , optics-th >=0.2 && <0.5
8690 , scientific >=0.3.6.2 && <0.4
8791 , unordered-containers >=0.2.9.0 && <0.3
8892 , uuid-types >=1.0.3 && <1.1
@@ -100,7 +104,7 @@ test-suite spec
100104 -- We need aeson's toEncoding for doctests too
101105 build-depends:
102106 base
103− , swagger2
107+ , QuickCheck
104108 , aeson
105109 , base-compat-batteries
106110 , bytestring
@@ -109,32 +113,32 @@ test-suite spec
109113 , insert-ordered-containers
110114 , lens
111115 , mtl
116+ , openapi3
112117 , template-haskell
113118 , text
114119 , time
115120 , unordered-containers
116121 , vector
117− , QuickCheck
118122
119123 -- test-suite only dependencies
120124 build-depends:
121− hspec >=2.5.5 && <2.8
125+ hspec >=2.5.5 && <2.10
122126 , HUnit >=1.6.0.0 && <1.7
123127 , quickcheck-instances >=0.3.19 && <0.14
124128 , utf8-string >=1.0.1.1 && <1.1
125129
126130 -- https://github.com/haskell/cabal/issues/3708
127131 build-tool-depends:
128− hspec-discover:hspec-discover >=2.5.5 && <2.8
132+ hspec-discover:hspec-discover >=2.5.5 && <2.10
129133
130134 other-modules:
131135 SpecCommon
132− Data.SwaggerSpec
133− Data.Swagger.CommonTestTypes
134− Data.Swagger.ParamSchemaSpec
135− Data.Swagger.SchemaSpec
136− Data.Swagger.Schema.ValidationSpec
137− Data.Swagger.Schema.GeneratorSpec
136+ Data.OpenApiSpec
137+ Data.OpenApi.CommonTestTypes
138+ Data.OpenApi.ParamSchemaSpec
139+ Data.OpenApi.SchemaSpec
140+ Data.OpenApi.Schema.ValidationSpec
141+ Data.OpenApi.Schema.GeneratorSpec
138142 default-language: Haskell2010
139143
140144test-suite doctests
@@ -145,6 +149,12 @@ test-suite doctests
145149 main-is: doctests.hs
146150 type: exitcode-stdio-1.0
147151
152+executable example
153+ hs-source-dirs: examples
154+ main-is: hackage.hs
155+ default-language: Haskell2010
156+ build-depends: base, aeson, lens, openapi3, text
157+
148158source-repository head
149159 type: git
150− location: https://github.com/GetShopTV/swagger2.git
160+ location: https://github.com/biocad/openapi3.git
src/Data/Swagger.hs → src/Data/OpenApi.hsrenamed+178−49
@@ -1,5 +1,5 @@
11-- |
2−-- Module: Data.Swagger
2+-- Module: Data.OpenApi
33-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
44-- Stability: experimental
55--
@@ -9,7 +9,7 @@
99-- These files can then be used by the Swagger-UI project to display the API
1010-- and Swagger-Codegen to generate clients in various languages.
1111-- Additional utilities can also take advantage of the resulting files, such as testing tools.
12−module Data.Swagger (
12+module Data.OpenApi (
1313 -- * How to use this library
1414 -- $howto
1515
@@ -29,15 +29,15 @@ module Data.Swagger (
2929 -- $validation
3030
3131 -- * Re-exports
32− module Data.Swagger.Lens,
33− module Data.Swagger.Optics,
34− module Data.Swagger.Operation,
35− module Data.Swagger.ParamSchema,
36− module Data.Swagger.Schema,
37− module Data.Swagger.Schema.Validation,
32+ module Data.OpenApi.Lens,
33+ module Data.OpenApi.Optics,
34+ module Data.OpenApi.Operation,
35+ module Data.OpenApi.ParamSchema,
36+ module Data.OpenApi.Schema,
37+ module Data.OpenApi.Schema.Validation,
3838
3939 -- * Swagger specification
40− Swagger(..),
40+ OpenApi(..),
4141 Server(..),
4242 ServerVariable(..),
4343 Components(..),
@@ -56,7 +56,7 @@ module Data.Swagger (
5656 TagName,
5757
5858 -- ** Types and formats
59− SwaggerType(..),
59+ OpenApiType(..),
6060 Format,
6161 Definitions,
6262 Style(..),
@@ -73,10 +73,9 @@ module Data.Swagger (
7373 Encoding(..),
7474
7575 -- ** Schemas
76− ParamSchema(..),
7776 Schema(..),
7877 NamedSchema(..),
79− SwaggerItems(..),
78+ OpenApiItems(..),
8079 Xml(..),
8180 Pattern,
8281 AdditionalProperties(..),
@@ -92,6 +91,7 @@ module Data.Swagger (
9291 -- ** Security
9392 SecurityScheme(..),
9493 SecuritySchemeType(..),
94+ HttpSchemeType(..),
9595 SecurityDefinitions(..),
9696 SecurityRequirement(..),
9797
@@ -121,14 +121,14 @@ module Data.Swagger (
121121 URL(..),
122122) where
123123
124−import Data.Swagger.Lens
125−import Data.Swagger.Optics ()
126−import Data.Swagger.Operation
127−import Data.Swagger.ParamSchema
128−import Data.Swagger.Schema
129−import Data.Swagger.Schema.Validation
124+import Data.OpenApi.Lens
125+import Data.OpenApi.Optics ()
126+import Data.OpenApi.Operation
127+import Data.OpenApi.ParamSchema
128+import Data.OpenApi.Schema
129+import Data.OpenApi.Schema.Validation
130130
131−import Data.Swagger.Internal
131+import Data.OpenApi.Internal
132132
133133-- $setup
134134-- >>> import Control.Lens
@@ -137,6 +137,7 @@ import Data.Swagger.Internal
137137-- >>> import Data.Proxy
138138-- >>> import GHC.Generics
139139-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
140+-- >>> import Data.OpenApi.Internal.Utils
140141-- >>> :set -XDeriveGeneric
141142-- >>> :set -XOverloadedStrings
142143-- >>> :set -XOverloadedLists
@@ -153,8 +154,16 @@ import Data.Swagger.Internal
153154--
154155-- In this library you can use @'mempty'@ for a default/empty value. For instance:
155156--
156−-- >>> BSL.putStrLn $ encode (mempty :: Swagger)
157−-- {"openapi":"3.0.0","info":{"version":"","title":""},"components":{}}
157+-- >>> BSL.putStrLn $ encodePretty (mempty :: OpenApi)
158+-- {
159+-- "components": {},
160+-- "info": {
161+-- "title": "",
162+-- "version": ""
163+-- },
164+-- "openapi": "3.0.0",
165+-- "paths": {}
166+-- }
158167--
159168-- As you can see some spec properties (e.g. @"version"@) are there even when the spec is empty.
160169-- That is because these properties are actually required ones.
@@ -162,46 +171,87 @@ import Data.Swagger.Internal
162171-- You /should/ always override the default (empty) value for these properties,
163172-- although it is not strictly necessary:
164173--
165−-- >>> BSL.putStrLn $ encode mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
166−-- {"version":"1.0","title":"Todo API"}
174+-- >>> BSL.putStrLn $ encodePretty mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
175+-- {
176+-- "title": "Todo API",
177+-- "version": "1.0"
178+-- }
167179--
168180-- You can merge two values using @'mappend'@ or its infix version @('<>')@:
169181--
170−-- >>> BSL.putStrLn $ encode $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
171−-- {"version":"1.0","title":"Todo API"}
182+-- >>> BSL.putStrLn $ encodePretty $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
183+-- {
184+-- "title": "Todo API",
185+-- "version": "1.0"
186+-- }
187+
172188--
173189-- This can be useful for combining specifications of endpoints into a whole API specification:
174190--
175191-- @
176192-- \-\- /account subAPI specification
177−-- accountAPI :: Swagger
193+-- accountAPI :: OpenApi
178194--
179195-- \-\- /task subAPI specification
180−-- taskAPI :: Swagger
196+-- taskAPI :: OpenApi
181197--
182198-- \-\- while API specification is just a combination
183199-- \-\- of subAPIs' specifications
184−-- api :: Swagger
200+-- api :: OpenApi
185201-- api = accountAPI <> taskAPI
186202-- @
187203
188204-- $lens
189205--
190−-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.Swagger.Optics".
206+-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.OpenApi.Optics".
191207--
192208-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
193209-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses
194210-- make it fairly simple to construct/modify any part of the specification:
195211--
196212-- >>> :{
197−-- BSL.putStrLn $ encode $ (mempty :: Swagger)
198−-- & components . schemas .~ [ ("User", mempty & type_ ?~ SwaggerString) ]
213+-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
214+-- & components . schemas .~ [ ("User", mempty & type_ ?~ OpenApiString) ]
199215-- & paths .~
200216-- [ ("/user", mempty & get ?~ (mempty
201217-- & at 200 ?~ ("OK" & _Inline.content.at "application/json" ?~ (mempty & schema ?~ Ref (Reference "User")))
202218-- & at 404 ?~ "User info not found")) ]
203219-- :}
204−-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"404":{"description":"User info not found"},"200":{"content":{"application/json":{"schema":{"$ref":"#/components/schemas/User"}}},"description":"OK"}}}}},"components":{"schemas":{"User":{"type":"string"}}}}
220+-- {
221+-- "components": {
222+-- "schemas": {
223+-- "User": {
224+-- "type": "string"
225+-- }
226+-- }
227+-- },
228+-- "info": {
229+-- "title": "",
230+-- "version": ""
231+-- },
232+-- "openapi": "3.0.0",
233+-- "paths": {
234+-- "/user": {
235+-- "get": {
236+-- "responses": {
237+-- "200": {
238+-- "content": {
239+-- "application/json": {
240+-- "schema": {
241+-- "$ref": "#/components/schemas/User"
242+-- }
243+-- }
244+-- },
245+-- "description": "OK"
246+-- },
247+-- "404": {
248+-- "description": "User info not found"
249+-- }
250+-- }
251+-- }
252+-- }
253+-- }
254+-- }
205255--
206256-- In the snippet above we declare an API with a single path @/user@. This path provides method @GET@
207257-- which produces @application/json@ output. It should respond with code @200@ and body specified
@@ -213,23 +263,34 @@ import Data.Swagger.Internal
213263-- common field is @'description'@. Many components of a Swagger specification
214264-- can have descriptions, and you can use the same name for them:
215265--
216−-- >>> BSL.putStrLn $ encode $ (mempty :: Response) & description .~ "No content"
217−-- {"description":"No content"}
266+-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & description .~ "No content"
267+-- {
268+-- "description": "No content"
269+-- }
218270-- >>> :{
219−-- BSL.putStrLn $ encode $ (mempty :: Schema)
220−-- & type_ ?~ SwaggerBoolean
271+-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)
272+-- & type_ ?~ OpenApiBoolean
221273-- & description ?~ "To be or not to be"
222274-- :}
223−-- {"description":"To be or not to be","type":"boolean"}
275+-- {
276+-- "description": "To be or not to be",
277+-- "type": "boolean"
278+-- }
224279--
225280-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
226281-- have direct access to it via @'at' code@. Example:
227282--
228283-- >>> :{
229−-- BSL.putStrLn $ encode $ (mempty :: Operation)
284+-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)
230285-- & at 404 ?~ "Not found"
231286-- :}
232−-- {"responses":{"404":{"description":"Not found"}}}
287+-- {
288+-- "responses": {
289+-- "404": {
290+-- "description": "Not found"
291+-- }
292+-- }
293+-- }
233294--
234295-- You might've noticed that @'type_'@ has an extra underscore in its name
235296-- compared to, say, @'description'@ field accessor.
@@ -245,7 +306,7 @@ import Data.Swagger.Internal
245306-- @'ParamSchema'@ and @'Schema'@ are the two core types for data model specification.
246307--
247308-- @'ParamSchema' t@ specifies all the common properties, available for every data schema.
248−-- The @t@ parameter imposes some restrictions on @type@ and @items@ properties (see @'SwaggerType'@ and @'SwaggerItems'@).
309+-- The @t@ parameter imposes some restrictions on @type@ and @items@ properties (see @'OpenApiType'@ and @'OpenApiItems'@).
249310--
250311-- @'Schema'@ is used for request and response bodies and allows specifying objects
251312-- with properties in addition to what @'ParamSchema'@ provides.
@@ -276,13 +337,81 @@ import Data.Swagger.Internal
276337-- >>> data Person = Person { name :: String, age :: Integer } deriving Generic
277338-- >>> instance ToJSON Person
278339-- >>> instance ToSchema Person
279−-- >>> BSL.putStrLn $ encode (Person "David" 28)
280−-- {"age":28,"name":"David"}
281−-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Person)
282−-- {"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"type":"integer"}},"type":"object"}
283−--
284−-- TODO mention oneOf
285−--
340+-- >>> BSL.putStrLn $ encodePretty (Person "David" 28)
341+-- {
342+-- "age": 28,
343+-- "name": "David"
344+-- }
345+-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Person)
346+-- {
347+-- "properties": {
348+-- "age": {
349+-- "type": "integer"
350+-- },
351+-- "name": {
352+-- "type": "string"
353+-- }
354+-- },
355+-- "required": [
356+-- "name",
357+-- "age"
358+-- ],
359+-- "type": "object"
360+-- }
361+--
362+-- This package implements OpenAPI 3.0 spec, which supports @oneOf@ in schemas, allowing any sum types
363+-- to be faithfully represented. All sum encodings supported by @aeson@ are supported here as well, with
364+-- an exception of 'Data.Aeson.TwoElemArray', since OpenAPI spec does not support heterogeneous arrays.
365+--
366+-- An example with 'Data.Aeson.TaggedObject' encoding:
367+--
368+-- >>> data Error = ErrorNoUser { userId :: Int } | ErrorAccessDenied { requiredPermission :: String } deriving Generic
369+-- >>> instance ToJSON Error
370+-- >>> instance ToSchema Error
371+-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Error)
372+-- {
373+-- "oneOf": [
374+-- {
375+-- "properties": {
376+-- "tag": {
377+-- "enum": [
378+-- "ErrorNoUser"
379+-- ],
380+-- "type": "string"
381+-- },
382+-- "userId": {
383+-- "maximum": 9223372036854775807,
384+-- "minimum": -9223372036854775808,
385+-- "type": "integer"
386+-- }
387+-- },
388+-- "required": [
389+-- "userId",
390+-- "tag"
391+-- ],
392+-- "type": "object"
393+-- },
394+-- {
395+-- "properties": {
396+-- "requiredPermission": {
397+-- "type": "string"
398+-- },
399+-- "tag": {
400+-- "enum": [
401+-- "ErrorAccessDenied"
402+-- ],
403+-- "type": "string"
404+-- }
405+-- },
406+-- "required": [
407+-- "requiredPermission",
408+-- "tag"
409+-- ],
410+-- "type": "object"
411+-- }
412+-- ],
413+-- "type": "object"
414+-- }
286415
287416-- $manipulation
288417-- Sometimes you have to work with an imported or generated @'Swagger'@.
@@ -290,10 +419,10 @@ import Data.Swagger.Internal
290419-- for a type-level servant API.
291420--
292421-- Lenses and prisms can be used to manipulate such specification to add additional information, tags, extra responses, etc.
293−-- To facilitate common needs, @"Data.Swagger.Operation"@ module provides useful helpers.
422+-- To facilitate common needs, @"Data.OpenApi.Operation"@ module provides useful helpers.
294423
295424-- $validation
296425-- While @'ToParamSchema'@ and @'ToSchema'@ provide means to easily obtain schemas for Haskell types,
297426-- there is no static mechanism to ensure those instances correspond to the @'ToHttpApiData'@ or @'ToJSON'@ instances.
298427--
299−-- @"Data.Swagger.Schema.Validation"@ addresses @'ToJSON'@/@'ToSchema'@ validation.
428+-- @"Data.OpenApi.Schema.Validation"@ addresses @'ToJSON'@/@'ToSchema'@ validation.
src/Data/OpenApi/Aeson/Compat.hsnew file+76
@@ -0,0 +1,76 @@
1+{-# LANGUAGE CPP #-}
2+
3+module Data.OpenApi.Aeson.Compat where
4+
5+#if MIN_VERSION_aeson(2,0,0)
6+import Data.Aeson (Key)
7+import qualified Data.Aeson.Key as Key
8+import qualified Data.Aeson.KeyMap as KeyMap
9+#else
10+import qualified Data.HashMap.Strict as HM
11+#endif
12+import Data.Bifunctor (first)
13+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
14+import qualified Data.Text as T
15+
16+#if MIN_VERSION_aeson(2,0,0)
17+deleteKey :: Key -> KeyMap.KeyMap v -> KeyMap.KeyMap v
18+deleteKey = KeyMap.delete
19+
20+objectToList :: KeyMap.KeyMap v -> [(Key, v)]
21+objectToList = KeyMap.toList
22+
23+objectKeys :: KeyMap.KeyMap v -> [T.Text]
24+objectKeys = map Key.toText . KeyMap.keys
25+
26+stringToKey :: String -> Key
27+stringToKey = Key.fromString
28+
29+keyToString :: Key -> String
30+keyToString = Key.toString
31+
32+keyToText :: Key -> T.Text
33+keyToText = Key.toText
34+
35+toInsOrdHashMap :: KeyMap.KeyMap v -> InsOrdHashMap.InsOrdHashMap T.Text v
36+toInsOrdHashMap = InsOrdHashMap.fromList . fmap (first Key.toText) . KeyMap.toList
37+
38+fromInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap T.Text v -> KeyMap.KeyMap v
39+fromInsOrdHashMap = KeyMap.fromList . fmap (first Key.fromText) . InsOrdHashMap.toList
40+
41+lookupKey :: T.Text -> KeyMap.KeyMap v -> Maybe v
42+lookupKey = KeyMap.lookup . Key.fromText
43+
44+hasKey :: T.Text -> KeyMap.KeyMap a -> Bool
45+hasKey = KeyMap.member . Key.fromText
46+#else
47+deleteKey :: T.Text -> HM.HashMap T.Text v -> HM.HashMap T.Text v
48+deleteKey = HM.delete
49+
50+objectToList :: HM.HashMap T.Text v -> [(T.Text, v)]
51+objectToList = HM.toList
52+
53+objectKeys :: HM.HashMap T.Text v -> [T.Text]
54+objectKeys = HM.keys
55+
56+stringToKey :: String -> T.Text
57+stringToKey = T.pack
58+
59+keyToString :: T.Text -> String
60+keyToString = T.unpack
61+
62+keyToText :: T.Text -> T.Text
63+keyToText = id
64+
65+toInsOrdHashMap :: HM.HashMap T.Text v -> InsOrdHashMap.InsOrdHashMap T.Text v
66+toInsOrdHashMap = InsOrdHashMap.fromHashMap
67+
68+fromInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap T.Text v -> HM.HashMap T.Text v
69+fromInsOrdHashMap = InsOrdHashMap.toHashMap
70+
71+lookupKey :: T.Text -> HM.HashMap T.Text v -> Maybe v
72+lookupKey = HM.lookup
73+
74+hasKey :: T.Text -> HM.HashMap T.Text a -> Bool
75+hasKey = HM.member
76+#endif
src/Data/Swagger/Declare.hs → src/Data/OpenApi/Declare.hsrenamed+2−2
@@ -4,12 +4,12 @@
44{-# LANGUAGE MultiParamTypeClasses #-}
55{-# LANGUAGE UndecidableInstances #-}
66-- |
7−-- Module: Data.Swagger.Declare
7+-- Module: Data.OpenApi.Declare
88-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
99-- Stability: experimental
1010--
1111-- Declare monad transformer and associated functions.
12−module Data.Swagger.Declare where
12+module Data.OpenApi.Declare where
1313
1414import Prelude ()
1515import Prelude.Compat
src/Data/Swagger/Internal.hs → src/Data/OpenApi/Internal.hsrenamed+202−137
@@ -1,6 +1,6 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE DataKinds #-}
23{-# LANGUAGE DeriveDataTypeable #-}
3−{-# LANGUAGE DeriveFunctor #-}
44{-# LANGUAGE DeriveGeneric #-}
55{-# LANGUAGE DeriveTraversable #-}
66{-# LANGUAGE FlexibleContexts #-}
@@ -14,7 +14,7 @@
1414{-# LANGUAGE TemplateHaskell #-}
1515{-# LANGUAGE TypeFamilies #-}
1616{-# LANGUAGE UndecidableInstances #-}
17−module Data.Swagger.Internal where
17+module Data.OpenApi.Internal where
1818
1919import Prelude ()
2020import Prelude.Compat
@@ -22,6 +22,9 @@ import Prelude.Compat
2222import Control.Applicative
2323import Control.Lens ((&), (.~), (?~))
2424import Data.Aeson hiding (Encoding)
25+#if MIN_VERSION_aeson(2,0,0)
26+import qualified Data.Aeson.KeyMap as KeyMap
27+#endif
2528import qualified Data.Aeson.Types as JSON
2629import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable,
2730 constrIndex, mkConstr, mkDataType)
@@ -46,58 +49,56 @@ import Text.Read (readMaybe)
4649import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
4750import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
4851
52+import Data.OpenApi.Aeson.Compat (deleteKey)
53+import Data.OpenApi.Internal.AesonUtils (AesonDefaultValue (..), HasSwaggerAesonOptions (..),
54+ mkSwaggerAesonOptions, saoAdditionalPairs, saoSubObject,
55+ sopSwaggerGenericParseJSON, sopSwaggerGenericToEncoding,
56+ sopSwaggerGenericToJSON, sopSwaggerGenericToJSONWithOpts)
57+import Data.OpenApi.Internal.Utils
4958import Generics.SOP.TH (deriveGeneric)
50−import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
51− ,sopSwaggerGenericToJSONWithOpts
52− ,sopSwaggerGenericParseJSON
53− ,HasSwaggerAesonOptions(..)
54− ,AesonDefaultValue(..)
55− ,mkSwaggerAesonOptions
56− ,saoAdditionalPairs
57− ,saoSubObject)
58−import Data.Swagger.Internal.Utils
59−import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
6059
6160-- $setup
6261-- >>> :seti -XDataKinds
6362-- >>> import Data.Aeson
63+-- >>> import Data.ByteString.Lazy.Char8 as BSL
64+-- >>> import Data.OpenApi.Internal.Utils
6465
6566-- | A list of definitions that can be used in references.
6667type Definitions = InsOrdHashMap Text
6768
6869-- | This is the root document object for the API specification.
69−data Swagger = Swagger
70+data OpenApi = OpenApi
7071 { -- | Provides metadata about the API.
7172 -- The metadata can be used by the clients if needed.
72− _swaggerInfo :: Info
73+ _openApiInfo :: Info
7374
7475 -- | An array of Server Objects, which provide connectivity information
7576 -- to a target server. If the servers property is not provided, or is an empty array,
7677 -- the default value would be a 'Server' object with a url value of @/@.
77− , _swaggerServers :: [Server]
78+ , _openApiServers :: [Server]
7879
7980 -- | The available paths and operations for the API.
80− , _swaggerPaths :: InsOrdHashMap FilePath PathItem
81+ , _openApiPaths :: InsOrdHashMap FilePath PathItem
8182
8283 -- | An element to hold various schemas for the specification.
83− , _swaggerComponents :: Components
84+ , _openApiComponents :: Components
8485
8586 -- | A declaration of which security mechanisms can be used across the API.
8687 -- The list of values includes alternative security requirement objects that can be used.
8788 -- Only one of the security requirement objects need to be satisfied to authorize a request.
8889 -- Individual operations can override this definition.
8990 -- To make security optional, an empty security requirement can be included in the array.
90− , _swaggerSecurity :: [SecurityRequirement]
91+ , _openApiSecurity :: [SecurityRequirement]
9192
9293 -- | A list of tags used by the specification with additional metadata.
9394 -- The order of the tags can be used to reflect on their order by the parsing tools.
9495 -- Not all tags that are used by the 'Operation' Object must be declared.
9596 -- The tags that are not declared MAY be organized randomly or based on the tools' logic.
9697 -- Each tag name in the list MUST be unique.
97− , _swaggerTags :: InsOrdHashSet Tag
98+ , _openApiTags :: InsOrdHashSet Tag
9899
99100 -- | Additional external documentation.
100− , _swaggerExternalDocs :: Maybe ExternalDocs
101+ , _openApiExternalDocs :: Maybe ExternalDocs
101102 } deriving (Eq, Show, Generic, Data, Typeable)
102103
103104-- | The object provides metadata about the API.
@@ -194,8 +195,8 @@ data Components = Components
194195 , _componentsParameters :: Definitions Param
195196 , _componentsExamples :: Definitions Example
196197 , _componentsRequestBodies :: Definitions RequestBody
197− , _componentsHeader :: Definitions Header
198− , _componentsSecuritySchemes :: Definitions SecurityScheme
198+ , _componentsHeaders :: Definitions Header
199+ , _componentsSecuritySchemes :: SecurityDefinitions
199200 , _componentsLinks :: Definitions Link
200201 , _componentsCallbacks :: Definitions Callback
201202 } deriving (Eq, Show, Generic, Data, Typeable)
@@ -336,9 +337,11 @@ data RequestBody = RequestBody
336337 -- | The content of the request body.
337338 -- The key is a media type or media type range and the value describes it.
338339 -- For requests that match multiple keys, only the most specific key is applicable.
339− -- e.g. @text/plain@ overrides @text/*@
340+ -- e.g. @text/plain@ overrides @text/\*@
340341 , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject
341342
343+ -- | Determines if the request body is required in the request.
344+ -- Defaults to 'False'.
342345 , _requestBodyRequired :: Maybe Bool
343346 } deriving (Eq, Show, Generic, Data, Typeable)
344347
@@ -391,7 +394,7 @@ data Encoding = Encoding
391394 -- for other primitive types – @text/plain@; for object - @application/json@;
392395 -- for array – the default is defined based on the inner type.
393396 -- The value can be a specific media type (e.g. @application/json@),
394− -- a wildcard media type (e.g. @image/*@), or a comma-separated list of the two types.
397+ -- a wildcard media type (e.g. @image/\*@), or a comma-separated list of the two types.
395398 _encodingContentType :: Maybe MediaType
396399
397400 -- | A map allowing additional information to be provided as headers,
@@ -431,11 +434,11 @@ mimeListConstr :: Constr
431434mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
432435
433436mimeListDataType :: DataType
434−mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
437+mimeListDataType = mkDataType "Data.OpenApi.MimeList" [mimeListConstr]
435438
436439instance Data MimeList where
437440 gunfold k z c = case constrIndex c of
438− 1 -> k (z (\xs -> MimeList (map fromString xs)))
441+ 1 -> k (z (MimeList . map fromString))
439442 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
440443 toConstr (MimeList _) = mimeListConstr
441444 dataTypeOf _ = mimeListDataType
@@ -449,7 +452,7 @@ data Param = Param
449452
450453 -- | A brief description of the parameter.
451454 -- This could contain examples of use.
452− -- GFM syntax can be used for rich text representation.
455+ -- CommonMark syntax MAY be used for rich text representation.
453456 , _paramDescription :: Maybe Text
454457
455458 -- | Determines whether this parameter is mandatory.
@@ -469,6 +472,13 @@ data Param = Param
469472 -- a parameter with an empty value. Default value is @false@.
470473 , _paramAllowEmptyValue :: Maybe Bool
471474
475+ -- | Determines whether the parameter value SHOULD allow reserved characters,
476+ -- as defined by [RFC3986](https://tools.ietf.org/html/rfc3986#section-2.2)
477+ -- @:/?#[]@!$&'()*+,;=@ to be included without percent-encoding.
478+ -- This property only applies to parameters with an '_paramIn' value of 'ParamQuery'.
479+ -- The default value is 'False'.
480+ , _paramAllowReserved :: Maybe Bool
481+
472482 -- | Parameter schema.
473483 , _paramSchema :: Maybe (Referenced Schema)
474484
@@ -499,6 +509,10 @@ data Param = Param
499509 -- Furthermore, if referencing a schema that contains an example,
500510 -- the examples value SHALL override the example provided by the schema.
501511 , _paramExamples :: InsOrdHashMap Text (Referenced Example)
512+
513+ -- TODO
514+ -- _paramContent :: InsOrdHashMap MediaType MediaTypeObject
515+ -- should be singleton. mutually exclusive with _paramSchema.
502516 } deriving (Eq, Show, Generic, Data, Typeable)
503517
504518data Example = Example
@@ -559,27 +573,27 @@ data Link = Link
559573 , _linkServer :: Maybe Server
560574 } deriving (Eq, Show, Generic, Typeable, Data)
561575
562−-- | Items for @'SwaggerArray'@ schemas.
576+-- | Items for @'OpenApiArray'@ schemas.
563577--
564578-- __Warning__: OpenAPI 3.0 does not support tuple arrays. However, OpenAPI 3.1 will, as
565579-- it will incorporate Json Schema mostly verbatim.
566580--
567−-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
581+-- @'OpenApiItemsObject'@ should be used to specify homogenous array @'Schema'@s.
568582--
569−-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
570−data SwaggerItems where
571− SwaggerItemsObject :: Referenced Schema -> SwaggerItems
572− SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems
583+-- @'OpenApiItemsArray'@ should be used to specify tuple @'Schema'@s.
584+data OpenApiItems where
585+ OpenApiItemsObject :: Referenced Schema -> OpenApiItems
586+ OpenApiItemsArray :: [Referenced Schema] -> OpenApiItems
573587 deriving (Eq, Show, Typeable, Data)
574588
575−data SwaggerType where
576− SwaggerString :: SwaggerType
577− SwaggerNumber :: SwaggerType
578− SwaggerInteger :: SwaggerType
579− SwaggerBoolean :: SwaggerType
580− SwaggerArray :: SwaggerType
581− SwaggerNull :: SwaggerType
582− SwaggerObject :: SwaggerType
589+data OpenApiType where
590+ OpenApiString :: OpenApiType
591+ OpenApiNumber :: OpenApiType
592+ OpenApiInteger :: OpenApiType
593+ OpenApiBoolean :: OpenApiType
594+ OpenApiArray :: OpenApiType
595+ OpenApiNull :: OpenApiType
596+ OpenApiObject :: OpenApiType
583597 deriving (Eq, Show, Typeable, Generic, Data)
584598
585599data ParamLocation
@@ -624,9 +638,33 @@ data Schema = Schema
624638 , _schemaMaxProperties :: Maybe Integer
625639 , _schemaMinProperties :: Maybe Integer
626640
627− , _schemaParamSchema :: ParamSchema
641+ , -- | Declares the value of the parameter that the server will use if none is provided,
642+ -- for example a @"count"@ to control the number of results per page might default to @100@
643+ -- if not supplied by the client in the request.
644+ -- (Note: "default" has no meaning for required parameters.)
645+ -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
646+ _schemaDefault :: Maybe Value
647+
648+ , _schemaType :: Maybe OpenApiType
649+ , _schemaFormat :: Maybe Format
650+ , _schemaItems :: Maybe OpenApiItems
651+ , _schemaMaximum :: Maybe Scientific
652+ , _schemaExclusiveMaximum :: Maybe Bool
653+ , _schemaMinimum :: Maybe Scientific
654+ , _schemaExclusiveMinimum :: Maybe Bool
655+ , _schemaMaxLength :: Maybe Integer
656+ , _schemaMinLength :: Maybe Integer
657+ , _schemaPattern :: Maybe Pattern
658+ , _schemaMaxItems :: Maybe Integer
659+ , _schemaMinItems :: Maybe Integer
660+ , _schemaUniqueItems :: Maybe Bool
661+ , _schemaEnum :: Maybe [Value]
662+ , _schemaMultipleOf :: Maybe Scientific
628663 } deriving (Eq, Show, Generic, Data, Typeable)
629664
665+-- | Regex pattern for @string@ type.
666+type Pattern = Text
667+
630668data Discriminator = Discriminator
631669 { -- | The name of the property in the payload that will hold the discriminator value.
632670 _discriminatorPropertyName :: Text
@@ -642,37 +680,9 @@ data NamedSchema = NamedSchema
642680 , _namedSchemaSchema :: Schema
643681 } deriving (Eq, Show, Generic, Data, Typeable)
644682
645−-- | Regex pattern for @string@ type.
646−type Pattern = Text
647−
648−data ParamSchema = ParamSchema
649− { -- | Declares the value of the parameter that the server will use if none is provided,
650− -- for example a @"count"@ to control the number of results per page might default to @100@
651− -- if not supplied by the client in the request.
652− -- (Note: "default" has no meaning for required parameters.)
653− -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
654− _paramSchemaDefault :: Maybe Value
655−
656− , _paramSchemaType :: Maybe SwaggerType
657− , _paramSchemaFormat :: Maybe Format
658− , _paramSchemaItems :: Maybe SwaggerItems
659− , _paramSchemaMaximum :: Maybe Scientific
660− , _paramSchemaExclusiveMaximum :: Maybe Bool
661− , _paramSchemaMinimum :: Maybe Scientific
662− , _paramSchemaExclusiveMinimum :: Maybe Bool
663− , _paramSchemaMaxLength :: Maybe Integer
664− , _paramSchemaMinLength :: Maybe Integer
665− , _paramSchemaPattern :: Maybe Pattern
666− , _paramSchemaMaxItems :: Maybe Integer
667− , _paramSchemaMinItems :: Maybe Integer
668− , _paramSchemaUniqueItems :: Maybe Bool
669− , _paramSchemaEnum :: Maybe [Value]
670− , _paramSchemaMultipleOf :: Maybe Scientific
671− } deriving (Eq, Show, Generic, Typeable, Data)
672−
673683data Xml = Xml
674684 { -- | Replaces the name of the element/attribute used for the described schema property.
675− -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.
685+ -- When defined within the @'OpenApiItems'@ (items), it will affect the name of the individual XML elements within the list.
676686 -- When defined alongside type being array (outside the items),
677687 -- it will affect the wrapping element and only if wrapped is true.
678688 -- If wrapped is false, it will be ignored.
@@ -724,7 +734,7 @@ data Response = Response
724734 -- | A map containing descriptions of potential response payloads.
725735 -- The key is a media type or media type range and the value describes it.
726736 -- For responses that match multiple keys, only the most specific key is applicable.
727− -- e.g. @text/plain@ overrides @text/*@.
737+ -- e.g. @text/plain@ overrides @text/\*@.
728738 , _responseContent :: InsOrdHashMap MediaType MediaTypeObject
729739
730740 -- | Maps a header name to its definition.
@@ -749,11 +759,20 @@ newtype Callback = Callback (InsOrdHashMap Text PathItem)
749759
750760type HeaderName = Text
751761
752−-- TODO this is mostly a copy of 'Param'.
762+-- | Header fields have the same meaning as for 'Param'.
763+--
764+-- Style is always treated as 'StyleSimple', as it is the only value allowed for headers.
753765data Header = Header
754766 { -- | A short description of the header.
755767 _headerDescription :: Maybe HeaderName
756768
769+ , _headerRequired :: Maybe Bool
770+ , _headerDeprecated :: Maybe Bool
771+ , _headerAllowEmptyValue :: Maybe Bool
772+ , _headerExplode :: Maybe Bool
773+ , _headerExample :: Maybe Value
774+ , _headerExamples :: InsOrdHashMap Text (Referenced Example)
775+
757776 , _headerSchema :: Maybe (Referenced Schema)
758777 } deriving (Eq, Show, Generic, Data, Typeable)
759778
@@ -778,17 +797,17 @@ type AuthorizationURL = Text
778797-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
779798type TokenURL = Text
780799
781−data OAuth2ImplicitFlow = OAuth2ImplicitFlow
782− { _oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL
783− } deriving (Eq, Show, Generic, Data, Typeable)
800+newtype OAuth2ImplicitFlow
801+ = OAuth2ImplicitFlow {_oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL}
802+ deriving (Eq, Show, Generic, Data, Typeable)
784803
785−data OAuth2PasswordFlow = OAuth2PasswordFlow
786− { _oAuth2PasswordFlowTokenUrl :: TokenURL
787− } deriving (Eq, Show, Generic, Data, Typeable)
804+newtype OAuth2PasswordFlow
805+ = OAuth2PasswordFlow {_oAuth2PasswordFlowTokenUrl :: TokenURL}
806+ deriving (Eq, Show, Generic, Data, Typeable)
788807
789−data OAuth2ClientCredentialsFlow = OAuth2ClientCredentialsFlow
790− { _oAuth2ClientCredentialsFlowTokenUrl :: TokenURL
791− } deriving (Eq, Show, Generic, Data, Typeable)
808+newtype OAuth2ClientCredentialsFlow
809+ = OAuth2ClientCredentialsFlow {_oAuth2ClientCredentialsFlowTokenUrl :: TokenURL}
810+ deriving (Eq, Show, Generic, Data, Typeable)
792811
793812data OAuth2AuthorizationCodeFlow = OAuth2AuthorizationCodeFlow
794813 { _oAuth2AuthorizationCodeFlowAuthorizationUrl :: AuthorizationURL
@@ -821,8 +840,50 @@ data OAuth2Flows = OAuth2Flows
821840 , _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
822841 } deriving (Eq, Show, Generic, Data, Typeable)
823842
843+type BearerFormat = Text
844+
845+data HttpSchemeType
846+ = HttpSchemeBearer (Maybe BearerFormat)
847+ | HttpSchemeBasic
848+ | HttpSchemeCustom Text
849+ deriving (Eq, Show, Generic, Data, Typeable)
850+
851+-- |
852+--
853+-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp (HttpSchemeBearer Nothing))
854+-- {
855+-- "scheme": "bearer",
856+-- "type": "http"
857+-- }
858+--
859+-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp (HttpSchemeBearer (Just "jwt")))
860+-- {
861+-- "bearerFormat": "jwt",
862+-- "scheme": "bearer",
863+-- "type": "http"
864+-- }
865+--
866+-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp HttpSchemeBasic)
867+-- {
868+-- "scheme": "basic",
869+-- "type": "http"
870+-- }
871+--
872+-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp (HttpSchemeCustom "CANARY"))
873+-- {
874+-- "scheme": "CANARY",
875+-- "type": "http"
876+-- }
877+--
878+-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeApiKey (ApiKeyParams "id" ApiKeyCookie))
879+-- {
880+-- "in": "cookie",
881+-- "name": "id",
882+-- "type": "apiKey"
883+-- }
884+--
824885data SecuritySchemeType
825− = SecuritySchemeHttp
886+ = SecuritySchemeHttp HttpSchemeType
826887 | SecuritySchemeApiKey ApiKeyParams
827888 | SecuritySchemeOAuth2 OAuth2Flows
828889 | SecuritySchemeOpenIdConnect URL
@@ -857,7 +918,7 @@ data Tag = Tag
857918 _tagName :: TagName
858919
859920 -- | A short description for the tag.
860− -- GFM syntax can be used for rich text representation.
921+ -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
861922 , _tagDescription :: Maybe Text
862923
863924 -- | Additional external documentation for this tag.
@@ -872,7 +933,7 @@ instance IsString Tag where
872933-- | Allows referencing an external resource for extended documentation.
873934data ExternalDocs = ExternalDocs
874935 { -- | A short description of the target documentation.
875− -- GFM syntax can be used for rich text representation.
936+ -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
876937 _externalDocsDescription :: Maybe Text
877938
878939 -- | The URL for the target documentation.
@@ -919,8 +980,7 @@ deriveGeneric ''MediaTypeObject
919980deriveGeneric ''Responses
920981deriveGeneric ''SecurityScheme
921982deriveGeneric ''Schema
922−deriveGeneric ''ParamSchema
923−deriveGeneric ''Swagger
983+deriveGeneric ''OpenApi
924984deriveGeneric ''Example
925985deriveGeneric ''Encoding
926986deriveGeneric ''Link
@@ -929,9 +989,9 @@ deriveGeneric ''Link
929989-- Monoid instances
930990-- =======================================================================
931991
932−instance Semigroup Swagger where
992+instance Semigroup OpenApi where
933993 (<>) = genericMappend
934−instance Monoid Swagger where
994+instance Monoid OpenApi where
935995 mempty = genericMempty
936996 mappend = (<>)
937997
@@ -965,12 +1025,6 @@ instance Monoid Schema where
9651025 mempty = genericMempty
9661026 mappend = (<>)
9671027
968−instance Semigroup ParamSchema where
969− (<>) = genericMappend
970−instance Monoid ParamSchema where
971− mempty = genericMempty
972− mappend = (<>)
973−
9741028instance Semigroup Param where
9751029 (<>) = genericMappend
9761030instance Monoid Param where
@@ -1065,19 +1119,19 @@ instance SwaggerMonoid Info
10651119instance SwaggerMonoid Components
10661120instance SwaggerMonoid PathItem
10671121instance SwaggerMonoid Schema
1068−instance SwaggerMonoid ParamSchema
10691122instance SwaggerMonoid Param
10701123instance SwaggerMonoid Responses
10711124instance SwaggerMonoid Response
10721125instance SwaggerMonoid ExternalDocs
10731126instance SwaggerMonoid Operation
10741127instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
1128+instance SwaggerMonoid SecurityDefinitions
10751129
10761130instance SwaggerMonoid MimeList
10771131deriving instance SwaggerMonoid URL
10781132
1079−instance SwaggerMonoid SwaggerType where
1080− swaggerMempty = SwaggerString
1133+instance SwaggerMonoid OpenApiType where
1134+ swaggerMempty = OpenApiString
10811135 swaggerMappend _ y = y
10821136
10831137instance SwaggerMonoid ParamLocation where
@@ -1100,7 +1154,7 @@ instance Monoid a => SwaggerMonoid (Referenced a) where
11001154instance ToJSON Style where
11011155 toJSON = genericToJSON (jsonPrefix "Style")
11021156
1103−instance ToJSON SwaggerType where
1157+instance ToJSON OpenApiType where
11041158 toJSON = genericToJSON (jsonPrefix "Swagger")
11051159
11061160instance ToJSON ParamLocation where
@@ -1155,7 +1209,7 @@ instance ToJSON OAuth2AuthorizationCodeFlow where
11551209instance FromJSON Style where
11561210 parseJSON = genericParseJSON (jsonPrefix "Style")
11571211
1158−instance FromJSON SwaggerType where
1212+instance FromJSON OpenApiType where
11591213 parseJSON = genericParseJSON (jsonPrefix "Swagger")
11601214
11611215instance FromJSON ParamLocation where
@@ -1220,8 +1274,19 @@ instance ToJSON OAuth2Flows where
12201274 toEncoding = sopSwaggerGenericToEncoding
12211275
12221276instance ToJSON SecuritySchemeType where
1223− toJSON SecuritySchemeHttp
1224− = object [ "type" .= ("http" :: Text) ]
1277+ toJSON (SecuritySchemeHttp ty) = case ty of
1278+ HttpSchemeBearer mFmt ->
1279+ object $ [ "type" .= ("http" :: Text)
1280+ , "scheme" .= ("bearer" :: Text)
1281+ ] <> maybe [] (\t -> ["bearerFormat" .= t]) mFmt
1282+ HttpSchemeBasic ->
1283+ object [ "type" .= ("http" :: Text)
1284+ , "scheme" .= ("basic" :: Text)
1285+ ]
1286+ HttpSchemeCustom t ->
1287+ object [ "type" .= ("http" :: Text)
1288+ , "scheme" .= t
1289+ ]
12251290 toJSON (SecuritySchemeApiKey params)
12261291 = toJSON params
12271292 <+> object [ "type" .= ("apiKey" :: Text) ]
@@ -1234,9 +1299,9 @@ instance ToJSON SecuritySchemeType where
12341299 , "openIdConnectUrl" .= url
12351300 ]
12361301
1237−instance ToJSON Swagger where
1302+instance ToJSON OpenApi where
12381303 toJSON a = sopSwaggerGenericToJSON a &
1239− if InsOrdHashMap.null (_swaggerPaths a)
1304+ if InsOrdHashMap.null (_openApiPaths a)
12401305 then (<+> object ["paths" .= object []])
12411306 else id
12421307 toEncoding = sopSwaggerGenericToEncoding
@@ -1250,8 +1315,8 @@ instance ToJSON SecurityScheme where
12501315 toEncoding = sopSwaggerGenericToEncoding
12511316
12521317instance ToJSON Schema where
1253− toJSON = sopSwaggerGenericToJSON
1254− toEncoding = sopSwaggerGenericToEncoding
1318+ toJSON = sopSwaggerGenericToJSONWithOpts $
1319+ mkSwaggerAesonOptions "schema" & saoSubObject ?~ "items"
12551320
12561321instance ToJSON Header where
12571322 toJSON = sopSwaggerGenericToJSON
@@ -1260,17 +1325,21 @@ instance ToJSON Header where
12601325-- | As for nullary schema for 0-arity type constructors, see
12611326-- <https://github.com/GetShopTV/swagger2/issues/167>.
12621327--
1263−-- >>> encode (SwaggerItemsArray [])
1264−-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1328+-- >>> BSL.putStrLn $ encodePretty (OpenApiItemsArray [])
1329+-- {
1330+-- "example": [],
1331+-- "items": {},
1332+-- "maxItems": 0
1333+-- }
12651334--
1266−instance ToJSON SwaggerItems where
1267− toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1268− toJSON (SwaggerItemsArray []) = object
1335+instance ToJSON OpenApiItems where
1336+ toJSON (OpenApiItemsObject x) = object [ "items" .= x ]
1337+ toJSON (OpenApiItemsArray []) = object
12691338 [ "items" .= object []
12701339 , "maxItems" .= (0 :: Int)
12711340 , "example" .= Array mempty
12721341 ]
1273− toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1342+ toJSON (OpenApiItemsArray x) = object [ "items" .= x ]
12741343
12751344instance ToJSON Components where
12761345 toJSON = sopSwaggerGenericToJSON
@@ -1338,11 +1407,6 @@ instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/compone
13381407instance ToJSON (Referenced Link) where toJSON = referencedToJSON "#/components/links/"
13391408instance ToJSON (Referenced Callback) where toJSON = referencedToJSON "#/components/callbacks/"
13401409
1341−instance ToJSON ParamSchema where
1342− -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1343− toJSON = sopSwaggerGenericToJSONWithOpts $
1344− mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1345−
13461410instance ToJSON AdditionalProperties where
13471411 toJSON (AdditionalPropertiesAllowed b) = toJSON b
13481412 toJSON (AdditionalPropertiesSchema s) = toJSON s
@@ -1375,14 +1439,19 @@ instance FromJSON SecuritySchemeType where
13751439 parseJSON js@(Object o) = do
13761440 (t :: Text) <- o .: "type"
13771441 case t of
1378− "http" -> pure SecuritySchemeHttp
1442+ "http" -> do
1443+ scheme <- o .: "scheme"
1444+ SecuritySchemeHttp <$> case scheme of
1445+ "bearer" -> HttpSchemeBearer <$> (o .:! "bearerFormat")
1446+ "basic" -> pure HttpSchemeBasic
1447+ t -> pure $ HttpSchemeCustom t
13791448 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
13801449 "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")
13811450 "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")
13821451 _ -> empty
13831452 parseJSON _ = empty
13841453
1385−instance FromJSON Swagger where
1454+instance FromJSON OpenApi where
13861455 parseJSON = sopSwaggerGenericParseJSON
13871456
13881457instance FromJSON Server where
@@ -1394,27 +1463,28 @@ instance FromJSON SecurityScheme where
13941463instance FromJSON Schema where
13951464 parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
13961465 where nullaryCleanup :: Schema -> Schema
1397− nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1398− if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1466+ nullaryCleanup s =
1467+ if _schemaItems s == Just (OpenApiItemsArray [])
13991468 then s { _schemaExample = Nothing
1400− , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1469+ , _schemaMaxItems = Nothing
1470+ }
14011471 else s
14021472
14031473instance FromJSON Header where
14041474 parseJSON = sopSwaggerGenericParseJSON
14051475
1406−instance FromJSON SwaggerItems where
1476+instance FromJSON OpenApiItems where
14071477 parseJSON js@(Object obj)
1408− | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1409− | otherwise = SwaggerItemsObject <$> parseJSON js
1410− parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1478+ | null obj = pure $ OpenApiItemsArray [] -- Nullary schema.
1479+ | otherwise = OpenApiItemsObject <$> parseJSON js
1480+ parseJSON js@(Array _) = OpenApiItemsArray <$> parseJSON js
14111481 parseJSON _ = empty
14121482
14131483instance FromJSON Components where
14141484 parseJSON = sopSwaggerGenericParseJSON
14151485
14161486instance FromJSON MimeList where
1417− parseJSON js = (MimeList . map fromString) <$> parseJSON js
1487+ parseJSON js = MimeList . map fromString <$> parseJSON js
14181488
14191489instance FromJSON Param where
14201490 parseJSON = sopSwaggerGenericParseJSON
@@ -1422,7 +1492,7 @@ instance FromJSON Param where
14221492instance FromJSON Responses where
14231493 parseJSON (Object o) = Responses
14241494 <$> o .:? "default"
1425− <*> (parseJSON (Object (HashMap.delete "default" o)))
1495+ <*> parseJSON (Object (deleteKey "default" o))
14261496 parseJSON _ = empty
14271497
14281498instance FromJSON Example where
@@ -1481,9 +1551,6 @@ instance FromJSON (Referenced Callback) where parseJSON = referencedParseJSON "#
14811551instance FromJSON Xml where
14821552 parseJSON = genericParseJSON (jsonPrefix "xml")
14831553
1484−instance FromJSON ParamSchema where
1485− parseJSON = sopSwaggerGenericParseJSON
1486−
14871554instance FromJSON AdditionalProperties where
14881555 parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
14891556 parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
@@ -1524,7 +1591,7 @@ instance HasSwaggerAesonOptions SecurityScheme where
15241591 swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
15251592instance HasSwaggerAesonOptions Schema where
15261593 swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1527−instance HasSwaggerAesonOptions Swagger where
1594+instance HasSwaggerAesonOptions OpenApi where
15281595 swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")]
15291596instance HasSwaggerAesonOptions Example where
15301597 swaggerAesonOptions _ = mkSwaggerAesonOptions "example"
@@ -1534,12 +1601,8 @@ instance HasSwaggerAesonOptions Encoding where
15341601instance HasSwaggerAesonOptions Link where
15351602 swaggerAesonOptions _ = mkSwaggerAesonOptions "link"
15361603
1537−instance HasSwaggerAesonOptions ParamSchema where
1538− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
1539−
15401604instance AesonDefaultValue Server
15411605instance AesonDefaultValue Components
1542−instance AesonDefaultValue ParamSchema
15431606instance AesonDefaultValue OAuth2ImplicitFlow
15441607instance AesonDefaultValue OAuth2PasswordFlow
15451608instance AesonDefaultValue OAuth2ClientCredentialsFlow
@@ -1547,8 +1610,10 @@ instance AesonDefaultValue OAuth2AuthorizationCodeFlow
15471610instance AesonDefaultValue p => AesonDefaultValue (OAuth2Flow p)
15481611instance AesonDefaultValue Responses
15491612instance AesonDefaultValue SecuritySchemeType
1550−instance AesonDefaultValue SwaggerType
1613+instance AesonDefaultValue OpenApiType
15511614instance AesonDefaultValue MimeList where defaultValue = Just mempty
15521615instance AesonDefaultValue Info
15531616instance AesonDefaultValue ParamLocation
15541617instance AesonDefaultValue Link
1618+instance AesonDefaultValue SecurityDefinitions where
1619+ defaultValue = Just mempty
src/Data/Swagger/Internal/AesonUtils.hs → src/Data/OpenApi/Internal/AesonUtils.hsrenamed+12−13
@@ -5,7 +5,7 @@
55{-# LANGUAGE ExplicitForAll #-}
66{-# LANGUAGE TemplateHaskell #-}
77{-# LANGUAGE UndecidableSuperClasses #-}
8−module Data.Swagger.Internal.AesonUtils (
8+module Data.OpenApi.Internal.AesonUtils (
99 -- * Generic functions
1010 AesonDefaultValue(..),
1111 sopSwaggerGenericToJSON,
@@ -27,7 +27,7 @@ import Prelude.Compat
2727import Control.Applicative ((<|>))
2828import Control.Lens (makeLenses, (^.))
2929import Control.Monad (unless)
30−import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), Object, object, (.:), (.:?), (.!=), withObject)
30+import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), Object, object, (.:), (.:?), (.!=), withObject, Encoding, pairs, (.=), Series)
3131import Data.Aeson.Types (Parser, Pair)
3232import Data.Char (toLower, isUpper)
3333import Data.Foldable (traverse_)
@@ -36,12 +36,11 @@ import Data.Text (Text)
3636import Generics.SOP
3737
3838import qualified Data.Text as T
39−import qualified Data.HashMap.Strict as HM
4039import qualified Data.Set as Set
4140import qualified Data.HashMap.Strict.InsOrd as InsOrd
4241import qualified Data.HashSet.InsOrd as InsOrdHS
4342
44−import Data.Aeson (Encoding, pairs, (.=), Series)
43+import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)
4544
4645-------------------------------------------------------------------------------
4746-- SwaggerAesonOptions
@@ -49,7 +48,7 @@ import Data.Aeson (Encoding, pairs, (.=), Series)
4948
5049data SwaggerAesonOptions = SwaggerAesonOptions
5150 { _saoPrefix :: String
52− , _saoAdditionalPairs :: [(Text, Value)]
51+ , _saoAdditionalPairs :: [Pair]
5352 , _saoSubObject :: Maybe String
5453 }
5554
@@ -156,14 +155,14 @@ sopSwaggerGenericToJSON'' (SwaggerAesonOptions prefix _ sub) = go
156155 go Nil Nil Nil = []
157156 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
158157 | Just name' == sub = case json of
159− Object m -> HM.toList m ++ rest
158+ Object m -> objectToList m ++ rest
160159 Null -> rest
161160 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
162161 -- If default value: omit it.
163162 | Just x == def =
164163 rest
165164 | otherwise =
166− (T.pack name', json) : rest
165+ (stringToKey name', json) : rest
167166 where
168167 json = toJSON x
169168 name' = fieldNameModifier name
@@ -197,11 +196,11 @@ sopSwaggerGenericParseJSON = withObject "Swagger Record Object" $ \obj ->
197196 proxy = Proxy :: Proxy a
198197 opts = swaggerAesonOptions proxy
199198
200− parseAdditionalField :: Object -> (Text, Value) -> Parser ()
199+ parseAdditionalField :: Object -> Pair -> Parser ()
201200 parseAdditionalField obj (k, v) = do
202201 v' <- obj .: k
203202 unless (v == v') $ fail $
204− "Additonal field don't match for key " ++ T.unpack k
203+ "Additonal field don't match for key " ++ keyToString k
205204 ++ ": " ++ show v
206205 ++ " /= " ++ show v'
207206
@@ -232,8 +231,8 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
232231 -- Note: we might strip fields of outer structure.
233232 cons <$> (withDef $ parseJSON $ Object obj) <*> rest
234233 | otherwise = case def of
235− Just def' -> cons <$> obj .:? T.pack name' .!= def' <*> rest
236− Nothing -> cons <$> obj .: T.pack name' <*> rest
234+ Just def' -> cons <$> obj .:? stringToKey name' .!= def' <*> rest
235+ Nothing -> cons <$> obj .: stringToKey name' <*> rest
237236 where
238237 cons h t = I h :* t
239238 name' = fieldNameModifier name
@@ -296,14 +295,14 @@ sopSwaggerGenericToEncoding'' (SwaggerAesonOptions prefix _ sub) = go
296295 go Nil Nil Nil = mempty
297296 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
298297 | Just name' == sub = case toJSON x of
299− Object m -> pairsToSeries (HM.toList m) <> rest
298+ Object m -> pairsToSeries (objectToList m) <> rest
300299 Null -> rest
301300 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
302301 -- If default value: omit it.
303302 | Just x == def =
304303 rest
305304 | otherwise =
306− (T.pack name' .= x) <> rest
305+ (stringToKey name' .= x) <> rest
307306 where
308307 name' = fieldNameModifier name
309308 rest = go xs names defs
src/Data/Swagger/Internal/ParamSchema.hs → src/Data/OpenApi/Internal/ParamSchema.hsrenamed+76−52
@@ -15,7 +15,7 @@
1515{-# OPTIONS_GHC -Wno-redundant-constraints #-}
1616-- For TypeErrors
1717{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
18−module Data.Swagger.Internal.ParamSchema where
18+module Data.OpenApi.Internal.ParamSchema where
1919
2020import Control.Lens
2121import Data.Aeson (ToJSON (..))
@@ -41,34 +41,40 @@ import Data.Word
4141import Data.UUID.Types (UUID)
4242import Web.Cookie (SetCookie)
4343
44−import Data.Swagger.Internal
45−import Data.Swagger.Lens
46−import Data.Swagger.SchemaOptions
44+import Data.OpenApi.Internal
45+import Data.OpenApi.Lens
46+import Data.OpenApi.SchemaOptions
4747
4848import qualified Data.ByteString as BS
49−import qualified Data.ByteString.Lazy as BSL
49+import qualified Data.ByteString.Lazy.Char8 as BSL
5050import GHC.TypeLits (TypeError, ErrorMessage(..))
5151
5252-- | Default schema for binary data (any sequence of octets).
53−binaryParamSchema :: ParamSchema
54−binaryParamSchema = mempty
55− & type_ ?~ SwaggerString
53+binarySchema :: Schema
54+binarySchema = mempty
55+ & type_ ?~ OpenApiString
5656 & format ?~ "binary"
5757
5858-- | Default schema for binary data (base64 encoded).
59−byteParamSchema :: ParamSchema
60−byteParamSchema = mempty
61− & type_ ?~ SwaggerString
59+byteSchema :: Schema
60+byteSchema = mempty
61+ & type_ ?~ OpenApiString
6262 & format ?~ "byte"
6363
6464-- | Default schema for password string.
6565-- @"password"@ format is used to hint UIs the input needs to be obscured.
66−passwordParamSchema :: ParamSchema
67−passwordParamSchema = mempty
68− & type_ ?~ SwaggerString
66+passwordSchema :: Schema
67+passwordSchema = mempty
68+ & type_ ?~ OpenApiString
6969 & format ?~ "password"
7070
71−-- | Convert a type into a plain @'ParamSchema'@.
71+-- | Convert a type into a plain @'Schema'@.
72+--
73+-- In previous versions of the package there was a separate type called @ParamSchema@, which was
74+-- included in a greater 'Schema'. Now this is a single class, but distinction for schema generators
75+-- for "simple" types is preserved.
76+--
77+-- 'ToParamSchema' is suited only for primitive-like types without nested fields and such.
7278--
7379-- An example type and instance:
7480--
@@ -81,7 +87,7 @@ passwordParamSchema = mempty
8187--
8288-- instance ToParamSchema Direction where
8389-- toParamSchema _ = mempty
84−-- & type_ ?~ SwaggerString
90+-- & type_ ?~ OpenApiString
8591-- & enum_ ?~ [ \"Up\", \"Down\" ]
8692-- @
8793--
@@ -106,24 +112,26 @@ passwordParamSchema = mempty
106112class ToParamSchema a where
107113 -- | Convert a type into a plain parameter schema.
108114 --
109− -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)
110− -- "{\"type\":\"integer\"}"
111− toParamSchema :: Proxy a -> ParamSchema
112− default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema
115+ -- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy Integer)
116+ -- {
117+ -- "type": "integer"
118+ -- }
119+ toParamSchema :: Proxy a -> Schema
120+ default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> Schema
113121 toParamSchema = genericToParamSchema defaultSchemaOptions
114122
115123instance {-# OVERLAPPING #-} ToParamSchema String where
116− toParamSchema _ = mempty & type_ ?~ SwaggerString
124+ toParamSchema _ = mempty & type_ ?~ OpenApiString
117125
118126instance ToParamSchema Bool where
119− toParamSchema _ = mempty & type_ ?~ SwaggerBoolean
127+ toParamSchema _ = mempty & type_ ?~ OpenApiBoolean
120128
121129instance ToParamSchema Integer where
122− toParamSchema _ = mempty & type_ ?~ SwaggerInteger
130+ toParamSchema _ = mempty & type_ ?~ OpenApiInteger
123131
124132instance ToParamSchema Natural where
125133 toParamSchema _ = mempty
126− & type_ ?~ SwaggerInteger
134+ & type_ ?~ OpenApiInteger
127135 & minimum_ ?~ 0
128136 & exclusiveMinimum ?~ False
129137
@@ -149,41 +157,45 @@ instance ToParamSchema Word64 where
149157
150158-- | Default plain schema for @'Bounded'@, @'Integral'@ types.
151159--
152−-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
153−-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
154−toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema
160+-- >>> BSL.putStrLn $ encodePretty $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
161+-- {
162+-- "maximum": 127,
163+-- "minimum": -128,
164+-- "type": "integer"
165+-- }
166+toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> Schema
155167toParamSchemaBoundedIntegral _ = mempty
156− & type_ ?~ SwaggerInteger
168+ & type_ ?~ OpenApiInteger
157169 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
158170 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
159171
160172instance ToParamSchema Char where
161173 toParamSchema _ = mempty
162− & type_ ?~ SwaggerString
174+ & type_ ?~ OpenApiString
163175 & maxLength ?~ 1
164176 & minLength ?~ 1
165177
166178instance ToParamSchema Scientific where
167− toParamSchema _ = mempty & type_ ?~ SwaggerNumber
179+ toParamSchema _ = mempty & type_ ?~ OpenApiNumber
168180
169181instance HasResolution a => ToParamSchema (Fixed a) where
170182 toParamSchema _ = mempty
171− & type_ ?~ SwaggerNumber
183+ & type_ ?~ OpenApiNumber
172184 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
173185
174186instance ToParamSchema Double where
175187 toParamSchema _ = mempty
176− & type_ ?~ SwaggerNumber
188+ & type_ ?~ OpenApiNumber
177189 & format ?~ "double"
178190
179191instance ToParamSchema Float where
180192 toParamSchema _ = mempty
181− & type_ ?~ SwaggerNumber
193+ & type_ ?~ OpenApiNumber
182194 & format ?~ "float"
183195
184−timeParamSchema :: String -> ParamSchema
196+timeParamSchema :: String -> Schema
185197timeParamSchema fmt = mempty
186− & type_ ?~ SwaggerString
198+ & type_ ?~ OpenApiString
187199 & format ?~ T.pack fmt
188200
189201-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -204,9 +216,9 @@ instance ToParamSchema LocalTime where
204216
205217-- |
206218-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
207−-- Just "yyyy-mm-ddThh:MM:ss+hhMM"
219+-- Just "date-time"
208220instance ToParamSchema ZonedTime where
209− toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+hhMM"
221+ toParamSchema _ = timeParamSchema "date-time"
210222
211223-- |
212224-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format
@@ -225,12 +237,12 @@ instance ToParamSchema TL.Text where
225237
226238instance ToParamSchema Version where
227239 toParamSchema _ = mempty
228− & type_ ?~ SwaggerString
240+ & type_ ?~ OpenApiString
229241 & pattern ?~ "^\\d+(\\.\\d+)*$"
230242
231243instance ToParamSchema SetCookie where
232244 toParamSchema _ = mempty
233− & type_ ?~ SwaggerString
245+ & type_ ?~ OpenApiString
234246
235247type family ToParamSchemaByteStringError bs where
236248 ToParamSchemaByteStringError bs = TypeError
@@ -253,8 +265,8 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t
253265
254266instance ToParamSchema a => ToParamSchema [a] where
255267 toParamSchema _ = mempty
256− & type_ ?~ SwaggerArray
257− & items ?~ SwaggerItemsObject (Inline $ mempty & paramSchema .~ toParamSchema (Proxy :: Proxy a))
268+ & type_ ?~ OpenApiArray
269+ & items ?~ OpenApiItemsObject (Inline $ toParamSchema (Proxy :: Proxy a))
258270
259271instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
260272instance ToParamSchema a => ToParamSchema (VP.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
@@ -269,29 +281,40 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
269281 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
270282
271283-- |
272−-- >>> encode $ toParamSchema (Proxy :: Proxy ())
273−-- "{\"type\":\"string\",\"enum\":[\"_\"]}"
284+-- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy ())
285+-- {
286+-- "enum": [
287+-- "_"
288+-- ],
289+-- "type": "string"
290+-- }
274291instance ToParamSchema () where
275292 toParamSchema _ = mempty
276− & type_ ?~ SwaggerString
293+ & type_ ?~ OpenApiString
277294 & enum_ ?~ ["_"]
278295
279296instance ToParamSchema UUID where
280297 toParamSchema _ = mempty
281− & type_ ?~ SwaggerString
298+ & type_ ?~ OpenApiString
282299 & format ?~ "uuid"
283300
284−-- | A configurable generic @'ParamSchema'@ creator.
301+-- | A configurable generic @'Schema'@ creator.
285302--
286303-- >>> :set -XDeriveGeneric
287304-- >>> data Color = Red | Blue deriving Generic
288−-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
289−-- "{\"type\":\"string\",\"enum\":[\"Red\",\"Blue\"]}"
290−genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> ParamSchema
305+-- >>> BSL.putStrLn $ encodePretty $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
306+-- {
307+-- "enum": [
308+-- "Red",
309+-- "Blue"
310+-- ],
311+-- "type": "string"
312+-- }
313+genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> Schema
291314genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
292315
293316class GToParamSchema (f :: * -> *) where
294− gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema -> ParamSchema
317+ gtoParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
295318
296319instance GToParamSchema f => GToParamSchema (D1 d f) where
297320 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
@@ -309,14 +332,14 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) wh
309332 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
310333
311334class GEnumParamSchema (f :: * -> *) where
312− genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema -> ParamSchema
335+ genumParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
313336
314337instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
315338 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)
316339
317340instance Constructor c => GEnumParamSchema (C1 c U1) where
318341 genumParamSchema opts _ s = s
319− & type_ ?~ SwaggerString
342+ & type_ ?~ OpenApiString
320343 & enum_ %~ addEnumValue tag
321344 where
322345 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
@@ -328,3 +351,4 @@ data Proxy3 a b c = Proxy3
328351
329352-- $setup
330353-- >>> import Data.Aeson (encode)
354+-- >>> import Data.OpenApi.Internal.Utils
src/Data/Swagger/Internal/Schema.hs → src/Data/OpenApi/Internal/Schema.hsrenamed+383−140
@@ -1,15 +1,17 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE ConstraintKinds #-}
3+{-# LANGUAGE DataKinds #-}
24{-# LANGUAGE DefaultSignatures #-}
35{-# LANGUAGE FlexibleContexts #-}
46{-# LANGUAGE FlexibleInstances #-}
57{-# LANGUAGE KindSignatures #-}
6−{-# LANGUAGE DataKinds #-}
78{-# LANGUAGE OverloadedLists #-}
89{-# LANGUAGE OverloadedStrings #-}
910{-# LANGUAGE PackageImports #-}
1011{-# LANGUAGE PolyKinds #-}
1112{-# LANGUAGE ScopedTypeVariables #-}
1213{-# LANGUAGE TupleSections #-}
14+{-# LANGUAGE TypeApplications #-}
1315{-# LANGUAGE TypeFamilies #-}
1416{-# LANGUAGE TypeOperators #-}
1517{-# LANGUAGE TypeSynonymInstances #-}
@@ -17,7 +19,7 @@
1719{-# OPTIONS_GHC -Wno-redundant-constraints #-}
1820-- For TypeErrors
1921{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
20−module Data.Swagger.Internal.Schema where
22+module Data.OpenApi.Internal.Schema where
2123
2224import Prelude ()
2325import Prelude.Compat
@@ -40,6 +42,7 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
4042import Data.Int
4143import Data.IntSet (IntSet)
4244import Data.IntMap (IntMap)
45+import Data.List (sort)
4346import Data.List.NonEmpty.Compat (NonEmpty)
4447import Data.Map (Map)
4548import Data.Maybe (fromMaybe)
@@ -59,14 +62,16 @@ import Numeric.Natural.Compat (Natural)
5962import Data.Word
6063import GHC.Generics
6164import qualified Data.UUID.Types as UUID
65+import Type.Reflection (Typeable, typeRep)
6266
63−import Data.Swagger.Declare
64−import Data.Swagger.Internal
65−import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
66−import Data.Swagger.Lens hiding (name, schema)
67−import qualified Data.Swagger.Lens as Swagger
68−import Data.Swagger.SchemaOptions
69−import Data.Swagger.Internal.TypeShape
67+import Data.OpenApi.Aeson.Compat (keyToText, objectKeys, toInsOrdHashMap)
68+import Data.OpenApi.Declare
69+import Data.OpenApi.Internal
70+import Data.OpenApi.Internal.ParamSchema (ToParamSchema (..))
71+import Data.OpenApi.Internal.TypeShape
72+import Data.OpenApi.Lens hiding (name, schema)
73+import qualified Data.OpenApi.Lens as Swagger
74+import Data.OpenApi.SchemaOptions
7075
7176import qualified Data.ByteString as BS
7277import qualified Data.ByteString.Lazy.Char8 as BSL
@@ -97,7 +102,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
97102--
98103-- import Control.Lens
99104-- import Data.Proxy
100−-- import Data.Swagger
105+-- import Data.OpenApi
101106--
102107-- data Coord = Coord { x :: Double, y :: Double }
103108--
@@ -105,7 +110,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
105110-- declareNamedSchema _ = do
106111-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
107112-- return $ NamedSchema (Just \"Coord\") $ mempty
108−-- & type_ ?~ SwaggerObject
113+-- & type_ ?~ OpenApiObject
109114-- & properties .~
110115-- [ (\"x\", doubleSchema)
111116-- , (\"y\", doubleSchema)
@@ -131,7 +136,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
131136--
132137-- instance ToSchema Coord
133138-- @
134−class ToSchema a where
139+class Typeable a => ToSchema a where
135140 -- | Convert a type into an optionally named schema
136141 -- together with all used definitions.
137142 -- Note that the schema itself is included in definitions
@@ -153,13 +158,19 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
153158--
154159-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
155160-- Nothing
156−-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
157−-- {"type":"string"}
161+-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy String) ^. schema)
162+-- {
163+-- "type": "string"
164+-- }
158165--
159166-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
160167-- Just "Day"
161−-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
162−-- {"example":"2016-07-22","format":"date","type":"string"}
168+-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy Day) ^. schema)
169+-- {
170+-- "example": "2016-07-22",
171+-- "format": "date",
172+-- "type": "string"
173+-- }
163174toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
164175toNamedSchema = undeclare . declareNamedSchema
165176
@@ -175,22 +186,35 @@ schemaName = _namedSchemaName . toNamedSchema
175186
176187-- | Convert a type into a schema.
177188--
178−-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Int8)
179−-- {"maximum":127,"minimum":-128,"type":"integer"}
189+-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Int8)
190+-- {
191+-- "maximum": 127,
192+-- "minimum": -128,
193+-- "type": "integer"
194+-- }
180195--
181−-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy [Day])
182−-- {"items":{"$ref":"#/components/schemas/Day"},"type":"array"}
196+-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy [Day])
197+-- {
198+-- "items": {
199+-- "$ref": "#/components/schemas/Day"
200+-- },
201+-- "type": "array"
202+-- }
183203toSchema :: ToSchema a => Proxy a -> Schema
184204toSchema = _namedSchemaSchema . toNamedSchema
185205
186206-- | Convert a type into a referenced schema if possible.
187207-- Only named schemas can be referenced, nameless schemas are inlined.
188208--
189−-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Integer)
190−-- {"type":"integer"}
209+-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Integer)
210+-- {
211+-- "type": "integer"
212+-- }
191213--
192−-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Day)
193−-- {"$ref":"#/components/schemas/Day"}
214+-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Day)
215+-- {
216+-- "$ref": "#/components/schemas/Day"
217+-- }
194218toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
195219toSchemaRef = undeclare . declareSchemaRef
196220
@@ -258,8 +282,15 @@ inlineAllSchemas = inlineSchemasWhen (const True)
258282
259283-- | Convert a type into a schema without references.
260284--
261−-- >>> BSL.putStrLn $ encode $ toInlinedSchema (Proxy :: Proxy [Day])
262−-- {"items":{"example":"2016-07-22","format":"date","type":"string"},"type":"array"}
285+-- >>> BSL.putStrLn $ encodePretty $ toInlinedSchema (Proxy :: Proxy [Day])
286+-- {
287+-- "items": {
288+-- "example": "2016-07-22",
289+-- "format": "date",
290+-- "type": "string"
291+-- },
292+-- "type": "array"
293+-- }
263294--
264295-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
265296-- when inlining recursive schemas.
@@ -289,41 +320,67 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
289320 traverse_ usedNames (InsOrdHashMap.lookup name defs)
290321 Inline subschema -> usedNames subschema
291322
292−-- | Default schema for binary data (any sequence of octets).
293−binarySchema :: Schema
294−binarySchema = mempty
295− & type_ ?~ SwaggerString
296− & format ?~ "binary"
297−
298−-- | Default schema for binary data (base64 encoded).
299−byteSchema :: Schema
300−byteSchema = mempty
301− & type_ ?~ SwaggerString
302− & format ?~ "byte"
303−
304−-- | Default schema for password string.
305−-- @"password"@ format is used to hint UIs the input needs to be obscured.
306−passwordSchema :: Schema
307−passwordSchema = mempty
308− & type_ ?~ SwaggerString
309− & format ?~ "password"
310−
311323-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
312324-- Produced schema can be used for further refinement.
313325--
314−-- >>> BSL.putStrLn $ encode $ sketchSchema "hello"
315−-- {"example":"hello","type":"string"}
326+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema "hello"
327+-- {
328+-- "example": "hello",
329+-- "type": "string"
330+-- }
316331--
317−-- >>> BSL.putStrLn $ encode $ sketchSchema (1, 2, 3)
318−-- {"example":[1,2,3],"items":{"type":"number"},"type":"array"}
332+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (1, 2, 3)
333+-- {
334+-- "example": [
335+-- 1,
336+-- 2,
337+-- 3
338+-- ],
339+-- "items": {
340+-- "type": "number"
341+-- },
342+-- "type": "array"
343+-- }
319344--
320−-- >>> BSL.putStrLn $ encode $ sketchSchema ("Jack", 25)
321−-- {"example":["Jack",25],"items":[{"type":"string"},{"type":"number"}],"type":"array"}
345+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema ("Jack", 25)
346+-- {
347+-- "example": [
348+-- "Jack",
349+-- 25
350+-- ],
351+-- "items": [
352+-- {
353+-- "type": "string"
354+-- },
355+-- {
356+-- "type": "number"
357+-- }
358+-- ],
359+-- "type": "array"
360+-- }
322361--
323362-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
324363-- >>> instance ToJSON Person
325−-- >>> BSL.putStrLn $ encode $ sketchSchema (Person "Jack" 25)
326−-- {"required":["age","name"],"properties":{"age":{"type":"number"},"name":{"type":"string"}},"example":{"age":25,"name":"Jack"},"type":"object"}
364+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (Person "Jack" 25)
365+-- {
366+-- "example": {
367+-- "age": 25,
368+-- "name": "Jack"
369+-- },
370+-- "properties": {
371+-- "age": {
372+-- "type": "number"
373+-- },
374+-- "name": {
375+-- "type": "string"
376+-- }
377+-- },
378+-- "required": [
379+-- "age",
380+-- "name"
381+-- ],
382+-- "type": "object"
383+-- }
327384sketchSchema :: ToJSON a => a -> Schema
328385sketchSchema = sketch . toJSON
329386 where
@@ -331,15 +388,15 @@ sketchSchema = sketch . toJSON
331388 sketch js@(Bool _) = go js
332389 sketch js = go js & example ?~ js
333390
334− go Null = mempty & type_ ?~ SwaggerNull
335− go (Bool _) = mempty & type_ ?~ SwaggerBoolean
336− go (String _) = mempty & type_ ?~ SwaggerString
337− go (Number _) = mempty & type_ ?~ SwaggerNumber
391+ go Null = mempty & type_ ?~ OpenApiNull
392+ go (Bool _) = mempty & type_ ?~ OpenApiBoolean
393+ go (String _) = mempty & type_ ?~ OpenApiString
394+ go (Number _) = mempty & type_ ?~ OpenApiNumber
338395 go (Array xs) = mempty
339− & type_ ?~ SwaggerArray
396+ & type_ ?~ OpenApiArray
340397 & items ?~ case ischema of
341− Just s -> SwaggerItemsObject (Inline s)
342− _ -> SwaggerItemsArray (map Inline ys)
398+ Just s -> OpenApiItemsObject (Inline s)
399+ _ -> OpenApiItemsArray (map Inline ys)
343400 where
344401 ys = map go (V.toList xs)
345402 allSame = and ((zipWith (==)) ys (tail ys))
@@ -348,64 +405,178 @@ sketchSchema = sketch . toJSON
348405 (z:_) | allSame -> Just z
349406 _ -> Nothing
350407 go (Object o) = mempty
351− & type_ ?~ SwaggerObject
352− & required .~ HashMap.keys o
353− & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
408+ & type_ ?~ OpenApiObject
409+ & required .~ sort (objectKeys o)
410+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
354411
355412-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
356413-- Produced schema uses as much constraints as possible.
357414--
358−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema "hello"
359−-- {"maxLength":5,"pattern":"hello","minLength":5,"type":"string","enum":["hello"]}
415+-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema "hello"
416+-- {
417+-- "enum": [
418+-- "hello"
419+-- ],
420+-- "maxLength": 5,
421+-- "minLength": 5,
422+-- "pattern": "hello",
423+-- "type": "string"
424+-- }
360425--
361−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (1, 2, 3)
362−-- {"minItems":3,"uniqueItems":true,"items":[{"maximum":1,"minimum":1,"multipleOf":1,"type":"number","enum":[1]},{"maximum":2,"minimum":2,"multipleOf":2,"type":"number","enum":[2]},{"maximum":3,"minimum":3,"multipleOf":3,"type":"number","enum":[3]}],"maxItems":3,"type":"array","enum":[[1,2,3]]}
426+-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (1, 2, 3)
427+-- {
428+-- "enum": [
429+-- [
430+-- 1,
431+-- 2,
432+-- 3
433+-- ]
434+-- ],
435+-- "items": [
436+-- {
437+-- "enum": [
438+-- 1
439+-- ],
440+-- "maximum": 1,
441+-- "minimum": 1,
442+-- "multipleOf": 1,
443+-- "type": "number"
444+-- },
445+-- {
446+-- "enum": [
447+-- 2
448+-- ],
449+-- "maximum": 2,
450+-- "minimum": 2,
451+-- "multipleOf": 2,
452+-- "type": "number"
453+-- },
454+-- {
455+-- "enum": [
456+-- 3
457+-- ],
458+-- "maximum": 3,
459+-- "minimum": 3,
460+-- "multipleOf": 3,
461+-- "type": "number"
462+-- }
463+-- ],
464+-- "maxItems": 3,
465+-- "minItems": 3,
466+-- "type": "array",
467+-- "uniqueItems": true
468+-- }
363469--
364−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema ("Jack", 25)
365−-- {"minItems":2,"uniqueItems":true,"items":[{"maxLength":4,"pattern":"Jack","minLength":4,"type":"string","enum":["Jack"]},{"maximum":25,"minimum":25,"multipleOf":25,"type":"number","enum":[25]}],"maxItems":2,"type":"array","enum":[["Jack",25]]}
470+-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema ("Jack", 25)
471+-- {
472+-- "enum": [
473+-- [
474+-- "Jack",
475+-- 25
476+-- ]
477+-- ],
478+-- "items": [
479+-- {
480+-- "enum": [
481+-- "Jack"
482+-- ],
483+-- "maxLength": 4,
484+-- "minLength": 4,
485+-- "pattern": "Jack",
486+-- "type": "string"
487+-- },
488+-- {
489+-- "enum": [
490+-- 25
491+-- ],
492+-- "maximum": 25,
493+-- "minimum": 25,
494+-- "multipleOf": 25,
495+-- "type": "number"
496+-- }
497+-- ],
498+-- "maxItems": 2,
499+-- "minItems": 2,
500+-- "type": "array",
501+-- "uniqueItems": true
502+-- }
366503--
367504-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
368505-- >>> instance ToJSON Person
369−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (Person "Jack" 25)
370−-- {"required":["age","name"],"properties":{"age":{"maximum":25,"minimum":25,"multipleOf":25,"type":"number","enum":[25]},"name":{"maxLength":4,"pattern":"Jack","minLength":4,"type":"string","enum":["Jack"]}},"maxProperties":2,"minProperties":2,"type":"object","enum":[{"age":25,"name":"Jack"}]}
506+-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (Person "Jack" 25)
507+-- {
508+-- "enum": [
509+-- {
510+-- "age": 25,
511+-- "name": "Jack"
512+-- }
513+-- ],
514+-- "maxProperties": 2,
515+-- "minProperties": 2,
516+-- "properties": {
517+-- "age": {
518+-- "enum": [
519+-- 25
520+-- ],
521+-- "maximum": 25,
522+-- "minimum": 25,
523+-- "multipleOf": 25,
524+-- "type": "number"
525+-- },
526+-- "name": {
527+-- "enum": [
528+-- "Jack"
529+-- ],
530+-- "maxLength": 4,
531+-- "minLength": 4,
532+-- "pattern": "Jack",
533+-- "type": "string"
534+-- }
535+-- },
536+-- "required": [
537+-- "age",
538+-- "name"
539+-- ],
540+-- "type": "object"
541+-- }
371542sketchStrictSchema :: ToJSON a => a -> Schema
372543sketchStrictSchema = go . toJSON
373544 where
374− go Null = mempty & type_ ?~ SwaggerNull
545+ go Null = mempty & type_ ?~ OpenApiNull
375546 go js@(Bool _) = mempty
376− & type_ ?~ SwaggerBoolean
547+ & type_ ?~ OpenApiBoolean
377548 & enum_ ?~ [js]
378549 go js@(String s) = mempty
379− & type_ ?~ SwaggerString
550+ & type_ ?~ OpenApiString
380551 & maxLength ?~ fromIntegral (T.length s)
381552 & minLength ?~ fromIntegral (T.length s)
382553 & pattern ?~ s
383554 & enum_ ?~ [js]
384555 go js@(Number n) = mempty
385− & type_ ?~ SwaggerNumber
556+ & type_ ?~ OpenApiNumber
386557 & maximum_ ?~ n
387558 & minimum_ ?~ n
388559 & multipleOf ?~ n
389560 & enum_ ?~ [js]
390561 go js@(Array xs) = mempty
391− & type_ ?~ SwaggerArray
562+ & type_ ?~ OpenApiArray
392563 & maxItems ?~ fromIntegral sz
393564 & minItems ?~ fromIntegral sz
394− & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
565+ & items ?~ OpenApiItemsArray (map (Inline . go) (V.toList xs))
395566 & uniqueItems ?~ allUnique
396567 & enum_ ?~ [js]
397568 where
398569 sz = length xs
399570 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
400571 go js@(Object o) = mempty
401− & type_ ?~ SwaggerObject
402− & required .~ names
403− & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
572+ & type_ ?~ OpenApiObject
573+ & required .~ sort names
574+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
404575 & maxProperties ?~ fromIntegral (length names)
405576 & minProperties ?~ fromIntegral (length names)
406577 & enum_ ?~ [js]
407578 where
408− names = HashMap.keys o
579+ names = objectKeys o
409580
410581class GToSchema (f :: * -> *) where
411582 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
@@ -414,8 +585,8 @@ instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
414585 declareNamedSchema _ = do
415586 ref <- declareSchemaRef (Proxy :: Proxy a)
416587 return $ unnamed $ mempty
417− & type_ ?~ SwaggerArray
418− & items ?~ SwaggerItemsObject ref
588+ & type_ ?~ OpenApiArray
589+ & items ?~ OpenApiItemsObject ref
419590
420591instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
421592instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
@@ -440,7 +611,7 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
440611instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
441612instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
442613
443−instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
614+instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
444615
445616instance ToSchema a => ToSchema (Maybe a) where
446617 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
@@ -457,16 +628,22 @@ instance ToSchema UUID.UUID where
457628 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
458629 & example ?~ toJSON (UUID.toText UUID.nil)
459630
460−instance (ToSchema a, ToSchema b) => ToSchema (a, b)
461−instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
462−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
463−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e)
464−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
465−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
631+instance (ToSchema a, ToSchema b) => ToSchema (a, b) where
632+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
633+instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) where
634+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
635+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d) where
636+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
637+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e) where
638+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
639+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f) where
640+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
641+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g) where
642+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
466643
467644timeSchema :: T.Text -> Schema
468645timeSchema fmt = mempty
469− & type_ ?~ SwaggerString
646+ & type_ ?~ OpenApiString
470647 & format ?~ fmt
471648
472649-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -481,7 +658,7 @@ instance ToSchema LocalTime where
481658 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
482659 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
483660
484−-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
661+-- | Format @"date-time"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
485662instance ToSchema ZonedTime where
486663 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
487664 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
@@ -513,7 +690,7 @@ instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where
513690instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
514691
515692-- | NOTE: This schema does not account for the uniqueness of keys.
516−instance ToSchema a => ToSchema (IntMap a) where
693+instance (ToSchema a) => ToSchema (IntMap a) where
517694 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
518695
519696instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
@@ -524,7 +701,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
524701 declareObjectMapSchema = do
525702 schema <- declareSchemaRef (Proxy :: Proxy v)
526703 return $ unnamed $ mempty
527− & type_ ?~ SwaggerObject
704+ & type_ ?~ OpenApiObject
528705 & additionalProperties ?~ AdditionalPropertiesSchema schema
529706
530707instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
@@ -532,7 +709,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
532709
533710instance {-# OVERLAPPING #-} ToSchema Object where
534711 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
535− & type_ ?~ SwaggerObject
712+ & type_ ?~ OpenApiObject
536713 & description ?~ "Arbitrary JSON object."
537714 & additionalProperties ?~ AdditionalPropertiesAllowed True
538715
@@ -569,11 +746,15 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
569746
570747-- | Default schema for @'Bounded'@, @'Integral'@ types.
571748--
572−-- >>> BSL.putStrLn $ encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
573−-- {"maximum":32767,"minimum":-32768,"type":"integer"}
749+-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
750+-- {
751+-- "maximum": 32767,
752+-- "minimum": -32768,
753+-- "type": "integer"
754+-- }
574755toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
575756toSchemaBoundedIntegral _ = mempty
576− & type_ ?~ SwaggerInteger
757+ & type_ ?~ OpenApiInteger
577758 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
578759 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
579760
@@ -602,8 +783,27 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
602783-- >>> instance ToSchema ButtonState
603784-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
604785-- >>> type ImageUrl = T.Text
605−-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
606−-- {"properties":{"Neutral":{"type":"string"},"Focus":{"type":"string"},"Active":{"type":"string"},"Hover":{"type":"string"},"Disabled":{"type":"string"}},"type":"object"}
786+-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
787+-- {
788+-- "properties": {
789+-- "Active": {
790+-- "type": "string"
791+-- },
792+-- "Disabled": {
793+-- "type": "string"
794+-- },
795+-- "Focus": {
796+-- "type": "string"
797+-- },
798+-- "Hover": {
799+-- "type": "string"
800+-- },
801+-- "Neutral": {
802+-- "type": "string"
803+-- }
804+-- },
805+-- "type": "object"
806+-- }
607807--
608808-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
609809-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -611,15 +811,15 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.
611811 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
612812 => Proxy (map key value) -> Declare (Definitions Schema) Schema
613813declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
614− ToJSONKeyText keyToText _ -> objectSchema keyToText
814+ ToJSONKeyText getKey _ -> objectSchema getKey
615815 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
616816 where
617− objectSchema keyToText = do
817+ objectSchema getKey = do
618818 valueRef <- declareSchemaRef (Proxy :: Proxy value)
619819 let allKeys = [minBound..maxBound :: key]
620− mkPair k = (keyToText k, valueRef)
820+ mkPair k = (keyToText $ getKey k, valueRef)
621821 return $ mempty
622− & type_ ?~ SwaggerObject
822+ & type_ ?~ OpenApiObject
623823 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
624824
625825-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -630,8 +830,27 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
630830-- >>> instance ToSchema ButtonState
631831-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
632832-- >>> type ImageUrl = T.Text
633−-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
634−-- {"properties":{"Neutral":{"type":"string"},"Focus":{"type":"string"},"Active":{"type":"string"},"Hover":{"type":"string"},"Disabled":{"type":"string"}},"type":"object"}
833+-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
834+-- {
835+-- "properties": {
836+-- "Active": {
837+-- "type": "string"
838+-- },
839+-- "Disabled": {
840+-- "type": "string"
841+-- },
842+-- "Focus": {
843+-- "type": "string"
844+-- },
845+-- "Hover": {
846+-- "type": "string"
847+-- },
848+-- "Neutral": {
849+-- "type": "string"
850+-- }
851+-- },
852+-- "type": "object"
853+-- }
635854--
636855-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
637856-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -641,7 +860,7 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.
641860toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
642861
643862-- | A configurable generic @'Schema'@ creator.
644−genericDeclareSchema :: (Generic a, GToSchema (Rep a)) =>
863+genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
645864 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
646865genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
647866
@@ -649,9 +868,24 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche
649868-- This function applied to @'defaultSchemaOptions'@
650869-- is used as the default for @'declareNamedSchema'@
651870-- when the type is an instance of @'Generic'@.
652−genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a)) =>
871+--
872+-- Default implementation will use the name from 'Typeable' instance, including concrete
873+-- instantioations of type variables.
874+--
875+-- For example:
876+--
877+-- >>> _namedSchemaName $ undeclare $ genericDeclareNamedSchema defaultSchemaOptions (Proxy :: Proxy (Either Int Bool))
878+-- Just "Either_Int_Bool"
879+genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>
653880 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
654−genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
881+genericDeclareNamedSchema opts _ =
882+ rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
883+ where
884+ unspace ' ' = '_'
885+ unspace x = x
886+ orig = fmap unspace $ show $ typeRep @a
887+ name = datatypeNameModifier opts orig
888+
655889
656890-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
657891genericNameSchema :: forall a d f.
@@ -667,19 +901,19 @@ gdatatypeSchemaName opts _ = case orig of
667901 orig = datatypeName (Proxy3 :: Proxy3 d f a)
668902 name = datatypeNameModifier opts orig
669903
670−-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
904+-- | Construct 'NamedSchema' usinng 'ToParamSchema'.
671905paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
672906 SchemaOptions -> Proxy a -> NamedSchema
673907paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
674908
675−-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
909+-- | Construct 'Schema' usinng 'ToParamSchema'.
676910paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
677−paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
911+paramSchemaToSchema = toParamSchema
678912
679913nullarySchema :: Schema
680914nullarySchema = mempty
681− & type_ ?~ SwaggerArray
682− & items ?~ SwaggerItemsArray []
915+ & type_ ?~ OpenApiArray
916+ & items ?~ OpenApiItemsArray []
683917
684918gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
685919gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
@@ -709,12 +943,15 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
709943 | unwrapUnaryRecords opts = fieldSchema
710944 | otherwise =
711945 case schema ^. items of
712− Just (SwaggerItemsArray [_]) -> fieldSchema
946+ Just (OpenApiItemsArray [_]) -> fieldSchema
713947 _ -> do
714− declare defs
715− return (unnamed schema)
948+ -- We have to run recordSchema instead of just using its defs,
949+ -- since those can be recursive and will lead to infinite loop,
950+ -- see https://github.com/biocad/openapi3/pull/37
951+ NamedSchema _ schema' <- recordSchema
952+ return (unnamed schema')
716953 where
717− (defs, NamedSchema _ schema) = runDeclare recordSchema mempty
954+ (_, NamedSchema _ schema) = runDeclare recordSchema mempty
718955 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
719956 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
720957
@@ -737,10 +974,10 @@ gdeclareSchemaRef opts proxy = do
737974 return $ Ref (Reference name)
738975 _ -> Inline <$> gdeclareSchema opts proxy
739976
740−appendItem :: Referenced Schema -> Maybe SwaggerItems -> Maybe SwaggerItems
741−appendItem x Nothing = Just (SwaggerItemsArray [x])
742−appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
743−appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
977+appendItem :: Referenced Schema -> Maybe OpenApiItems -> Maybe OpenApiItems
978+appendItem x Nothing = Just (OpenApiItemsArray [x])
979+appendItem x (Just (OpenApiItemsArray xs)) = Just (OpenApiItemsArray (xs ++ [x]))
980+appendItem _ _ = error "GToSchema.appendItem: cannot append to OpenApiItemsObject"
744981
745982withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
746983 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
@@ -749,12 +986,12 @@ withFieldSchema opts _ isRequiredField schema = do
749986 return $
750987 if T.null fname
751988 then schema
752− & type_ ?~ SwaggerArray
989+ & type_ ?~ OpenApiArray
753990 & items %~ appendItem ref
754991 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
755992 & minItems %~ Just . maybe 1 (+1) -- increment minItems
756993 else schema
757− & type_ ?~ SwaggerObject
994+ & type_ ?~ OpenApiObject
758995 & properties . at fname ?~ ref
759996 & if isRequiredField
760997 then required %~ (++ [fname])
@@ -789,14 +1026,14 @@ gdeclareNamedSumSchema opts proxy _
7891026 | otherwise = do
7901027 (schemas, _) <- runWriterT declareSumSchema
7911028 return $ unnamed $ mempty
792− & type_ ?~ SwaggerObject
1029+ & type_ ?~ OpenApiObject
7931030 & oneOf ?~ (snd <$> schemas)
7941031 where
7951032 declareSumSchema = gsumToSchema opts proxy
7961033 (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
7971034
7981035 toStringTag schemas = mempty
799− & type_ ?~ SwaggerString
1036+ & type_ ?~ OpenApiString
8001037 & enum_ ?~ map (String . fst) sumSchemas
8011038
8021039type AllNullary = All
@@ -818,15 +1055,15 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
8181055 case ref of
8191056 -- If subschema is an object and constructor is a record, we add tag directly
8201057 -- to the record, as Aeson does it.
821− Just (Inline sub) | sub ^. type_ == Just SwaggerObject && isRecord -> Inline $ sub
1058+ Just (Inline sub) | sub ^. type_ == Just OpenApiObject && isRecord -> Inline $ sub
8221059 & required <>~ [T.pack tagField]
823− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])
1060+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
8241061
8251062 -- If it is not a record, we need to put subschema into "contents" field.
8261063 _ | not isRecord -> Inline $ mempty
827− & type_ ?~ SwaggerObject
1064+ & type_ ?~ OpenApiObject
8281065 & required .~ [T.pack tagField]
829− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])
1066+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
8301067 -- If constructor is nullary, there is no content.
8311068 & case ref of
8321069 Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField])
@@ -834,17 +1071,17 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
8341071
8351072 -- In the remaining cases we combine "tag" object and "contents" object using allOf.
8361073 _ -> Inline $ mempty
837− & type_ ?~ SwaggerObject
1074+ & type_ ?~ OpenApiObject
8381075 & allOf ?~ [Inline $ mempty
839− & type_ ?~ SwaggerObject
1076+ & type_ ?~ OpenApiObject
8401077 & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])
841− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])]
1078+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])]
8421079 & if isRecord
8431080 then allOf . _Just <>~ [refOrNullary]
844− else allOf . _Just <>~ [Inline $ mempty & type_ ?~ SwaggerObject & properties . at (T.pack contentsField) ?~ refOrNullary]
1081+ else allOf . _Just <>~ [Inline $ mempty & type_ ?~ OpenApiObject & properties . at (T.pack contentsField) ?~ refOrNullary]
8451082 UntaggedValue -> refOrEnum -- Aeson encodes nullary constructors as strings in this case.
8461083 ObjectWithSingleField -> Inline $ mempty
847− & type_ ?~ SwaggerObject
1084+ & type_ ?~ OpenApiObject
8481085 & required .~ [tag]
8491086 & properties . at tag ?~ refOrNullary
8501087 TwoElemArray -> error "unrepresentable in OpenAPI 3"
@@ -852,7 +1089,7 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
8521089 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
8531090 isRecord = conIsRecord (Proxy3 :: Proxy3 c f p)
8541091 refOrNullary = fromMaybe (Inline nullarySchema) ref
855− refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag]) ref
1092+ refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) ref
8561093
8571094gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
8581095 SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
@@ -877,7 +1114,13 @@ data Proxy2 a b = Proxy2
8771114
8781115data Proxy3 a b c = Proxy3
8791116
880−-- $setup
881−-- >>> import Data.Swagger
882−-- >>> import Data.Aeson (encode)
883−-- >>> import Data.Aeson.Types (toJSONKeyText)
1117+{- $setup
1118+>>> import Data.OpenApi
1119+>>> import Data.Aeson (encode)
1120+>>> import Data.Aeson.Types (toJSONKeyText)
1121+>>> import Data.OpenApi.Internal.Utils
1122+>>> :set -XScopedTypeVariables
1123+>>> :set -XDeriveAnyClass
1124+>>> :set -XStandaloneDeriving
1125+>>> :set -XTypeApplications
1126+-}
src/Data/Swagger/Internal/Schema/Validation.hs → src/Data/OpenApi/Internal/Schema/Validation.hsrenamed+85−79
@@ -1,4 +1,5 @@
11{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE CPP #-}
23{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE DeriveFunctor #-}
45{-# LANGUAGE FlexibleInstances #-}
@@ -14,14 +15,14 @@
1415{-# LANGUAGE UndecidableInstances #-}
1516{-# LANGUAGE ViewPatterns #-}
1617-- |
17−-- Module: Data.Swagger.Internal.Schema.Validation
18+-- Module: Data.OpenApi.Internal.Schema.Validation
1819-- Copyright: (c) 2015 GetShopTV
1920-- License: BSD3
2021-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
2122-- Stability: experimental
2223--
2324-- Validate JSON values with Swagger Schema.
24−module Data.Swagger.Internal.Schema.Validation where
25+module Data.OpenApi.Internal.Schema.Validation where
2526
2627import Prelude ()
2728import Prelude.Compat
@@ -31,11 +32,14 @@ import Control.Lens hiding (allOf)
3132import Control.Monad (forM, forM_, when)
3233
3334import Data.Aeson hiding (Result)
34−import Data.Aeson.Encode.Pretty (encodePretty)
35+#if MIN_VERSION_aeson(2,0,0)
36+import qualified Data.Aeson.KeyMap as KeyMap
37+#endif
3538import Data.Foldable (for_, sequenceA_,
3639 traverse_)
40+#if !MIN_VERSION_aeson(2,0,0)
3741import Data.HashMap.Strict (HashMap)
38−import qualified Data.HashMap.Strict as HashMap
42+#endif
3943import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
4044import qualified "unordered-containers" Data.HashSet as HashSet
4145import Data.Maybe (fromMaybe)
@@ -48,10 +52,12 @@ import qualified Data.Text.Lazy.Encoding as TL
4852import Data.Vector (Vector)
4953import qualified Data.Vector as Vector
5054
51−import Data.Swagger.Declare
52−import Data.Swagger.Internal
53−import Data.Swagger.Internal.Schema
54−import Data.Swagger.Lens
55+import Data.OpenApi.Aeson.Compat (hasKey, keyToText, lookupKey, objectToList)
56+import Data.OpenApi.Declare
57+import Data.OpenApi.Internal
58+import Data.OpenApi.Internal.Schema
59+import Data.OpenApi.Internal.Utils
60+import Data.OpenApi.Lens
5561
5662-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
5763-- This can be used with QuickCheck to ensure those instances are coherent:
@@ -103,33 +109,33 @@ validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checke
103109-- <BLANKLINE>
104110-- Swagger Schema:
105111-- {
106−-- "required": [
107−-- "name",
108−-- "phone"
109−-- ],
110−-- "type": "object",
111112-- "properties": {
112−-- "phone": {
113−-- "$ref": "#/components/schemas/Phone"
114−-- },
115113-- "name": {
116114-- "type": "string"
115+-- },
116+-- "phone": {
117+-- "$ref": "#/components/schemas/Phone"
117118-- }
118−-- }
119+-- },
120+-- "required": [
121+-- "name",
122+-- "phone"
123+-- ],
124+-- "type": "object"
119125-- }
120126-- <BLANKLINE>
121127-- Swagger Description Context:
122128-- {
123129-- "Phone": {
124−-- "required": [
125−-- "value"
126−-- ],
127−-- "type": "object",
128130-- "properties": {
129131-- "value": {
130132-- "type": "string"
131133-- }
132−-- }
134+-- },
135+-- "required": [
136+-- "value"
137+-- ],
138+-- "type": "object"
133139-- }
134140-- }
135141-- <BLANKLINE>
@@ -205,7 +211,7 @@ instance Monad Result where
205211
206212-- | Validation configuration.
207213data Config = Config
208− { -- | Pattern checker for @'_paramSchemaPattern'@ validation.
214+ { -- | Pattern checker for @'_schemaPattern'@ validation.
209215 configPatternChecker :: Pattern -> Text -> Bool
210216 -- | Schema definitions in scope to resolve references.
211217 , configDefinitions :: Definitions Schema
@@ -300,38 +306,32 @@ validateWithSchemaRef (Inline s) js = sub s (validateWithSchema js)
300306validateWithSchema :: Value -> Validation Schema ()
301307validateWithSchema val = do
302308 validateSchemaType val
303− sub_ paramSchema $ validateEnum val
304−
305−-- | Validate JSON @'Value'@ with Swagger @'ParamSchema'@.
306−validateWithParamSchema :: Value -> Validation ParamSchema ()
307−validateWithParamSchema val = do
308− validateParamSchemaType val
309309 validateEnum val
310310
311−validateInteger :: Scientific -> Validation ParamSchema ()
311+validateInteger :: Scientific -> Validation Schema ()
312312validateInteger n = do
313313 when (not (isInteger n)) $
314314 invalid ("not an integer")
315315 validateNumber n
316316
317−validateNumber :: Scientific -> Validation ParamSchema ()
317+validateNumber :: Scientific -> Validation Schema ()
318318validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do
319319 let exMax = Just True == sch ^. exclusiveMaximum
320320 exMin = Just True == sch ^. exclusiveMinimum
321321
322322 check maximum_ $ \m ->
323323 when (if exMax then (n >= m) else (n > m)) $
324− invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ if exMax then "<" else "<=" ++ show m ++ ")")
324+ invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ (if exMax then "<" else "<=") ++ show m ++ ")")
325325
326326 check minimum_ $ \m ->
327327 when (if exMin then (n <= m) else (n < m)) $
328− invalid ("value " ++ show n ++ " falls below minimum (should be " ++ if exMin then ">" else ">=" ++ show m ++ ")")
328+ invalid ("value " ++ show n ++ " falls below minimum (should be " ++ (if exMin then ">" else ">=") ++ show m ++ ")")
329329
330330 check multipleOf $ \k ->
331331 when (not (isInteger (n / k))) $
332332 invalid ("expected a multiple of " ++ show k ++ " but got " ++ show n)
333333
334−validateString :: Text -> Validation ParamSchema ()
334+validateString :: Text -> Validation Schema ()
335335validateString s = do
336336 check maxLength $ \n ->
337337 when (len > fromInteger n) $
@@ -348,7 +348,7 @@ validateString s = do
348348 where
349349 len = Text.length s
350350
351−validateArray :: Vector Value -> Validation ParamSchema ()
351+validateArray :: Vector Value -> Validation Schema ()
352352validateArray xs = do
353353 check maxItems $ \n ->
354354 when (len > fromInteger n) $
@@ -359,8 +359,8 @@ validateArray xs = do
359359 invalid ("array is too short (size should be >=" ++ show n ++ ")")
360360
361361 check items $ \case
362− SwaggerItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs
363− SwaggerItemsArray itemSchemas -> do
362+ OpenApiItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs
363+ OpenApiItemsArray itemSchemas -> do
364364 when (len /= length itemSchemas) $
365365 invalid ("array size is invalid (should be exactly " ++ show (length itemSchemas) ++ ")")
366366 sequenceA_ (zipWith validateWithSchemaRef itemSchemas (Vector.toList xs))
@@ -372,10 +372,16 @@ validateArray xs = do
372372 len = Vector.length xs
373373 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))
374374
375−validateObject :: HashMap Text Value -> Validation Schema ()
375+validateObject ::
376+#if MIN_VERSION_aeson(2,0,0)
377+ KeyMap.KeyMap Value
378+#else
379+ HashMap Text Value
380+#endif
381+ -> Validation Schema ()
376382validateObject o = withSchema $ \sch ->
377383 case sch ^. discriminator of
378− Just (Discriminator pname types) -> case fromJSON <$> HashMap.lookup pname o of
384+ Just (Discriminator pname types) -> case fromJSON <$> lookupKey pname o of
379385 Just (Success pvalue) ->
380386 let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types
381387 -- TODO ref may be name or reference
@@ -394,15 +400,15 @@ validateObject o = withSchema $ \sch ->
394400 validateRequired
395401 validateProps
396402 where
397− size = fromIntegral (HashMap.size o)
403+ size = fromIntegral (length o)
398404
399405 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)
400406 validateReq n =
401− when (not (HashMap.member n o)) $
407+ when (not (hasKey n o)) $
402408 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))
403409
404410 validateProps = withSchema $ \sch -> do
405− for_ (HashMap.toList o) $ \(k, v) ->
411+ for_ (objectToList o) $ \(keyToText -> k, v) ->
406412 case v of
407413 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property
408414 _ ->
@@ -418,7 +424,7 @@ validateObject o = withSchema $ \sch ->
418424 unknownProperty pname = invalid $
419425 "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"
420426
421−validateEnum :: Value -> Validation ParamSchema ()
427+validateEnum :: Value -> Validation Schema ()
422428validateEnum val = do
423429 check enum_ $ \xs ->
424430 when (val `notElem` xs) $
@@ -429,10 +435,10 @@ validateEnum val = do
429435-- This is like 'inferParamSchemaTypes', but also works for objects:
430436--
431437-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"
432−-- Just [SwaggerObject]
433−inferSchemaTypes :: Schema -> [SwaggerType]
434−inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++
435− [ SwaggerObject | any ($ sch)
438+-- Just [OpenApiObject]
439+inferSchemaTypes :: Schema -> [OpenApiType]
440+inferSchemaTypes sch = inferParamSchemaTypes sch ++
441+ [ OpenApiObject | any ($ sch)
436442 [ has (additionalProperties._Just)
437443 , has (maxProperties._Just)
438444 , has (minProperties._Just)
@@ -442,30 +448,30 @@ inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++
442448-- | Infer schema type based on used properties.
443449--
444450-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"
445−-- Just [SwaggerString]
451+-- Just [OpenApiString]
446452--
447453-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"
448−-- Just [SwaggerArray]
454+-- Just [OpenApiArray]
449455--
450−-- From numeric properties 'SwaggerInteger' type is inferred.
451−-- If you want 'SwaggerNumber' instead, you must specify it explicitly.
456+-- From numeric properties 'OpenApiInteger' type is inferred.
457+-- If you want 'OpenApiNumber' instead, you must specify it explicitly.
452458--
453459-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"
454−-- Just [SwaggerInteger]
455−inferParamSchemaTypes :: ParamSchema -> [SwaggerType]
460+-- Just [OpenApiInteger]
461+inferParamSchemaTypes :: Schema -> [OpenApiType]
456462inferParamSchemaTypes sch = concat
457− [ [ SwaggerArray | any ($ sch)
463+ [ [ OpenApiArray | any ($ sch)
458464 [ has (items._Just)
459465 , has (maxItems._Just)
460466 , has (minItems._Just)
461467 , has (uniqueItems._Just) ] ]
462− , [ SwaggerInteger | any ($ sch)
468+ , [ OpenApiInteger | any ($ sch)
463469 [ has (exclusiveMaximum._Just)
464470 , has (exclusiveMinimum._Just)
465471 , has (maximum_._Just)
466472 , has (minimum_._Just)
467473 , has (multipleOf._Just) ] ]
468− , [ SwaggerString | any ($ sch)
474+ , [ OpenApiString | any ($ sch)
469475 [ has (maxLength._Just)
470476 , has (minLength._Just)
471477 , has (pattern._Just) ] ]
@@ -489,30 +495,30 @@ validateSchemaType val = withSchema $ \sch ->
489495
490496 _ ->
491497 case (sch ^. type_, val) of
492− (Just SwaggerNull, Null) -> valid
493− (Just SwaggerBoolean, Bool _) -> valid
494− (Just SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)
495− (Just SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)
496− (Just SwaggerString, String s) -> sub_ paramSchema (validateString s)
497− (Just SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)
498− (Just SwaggerObject, Object o) -> validateObject o
498+ (Just OpenApiNull, Null) -> valid
499+ (Just OpenApiBoolean, Bool _) -> valid
500+ (Just OpenApiInteger, Number n) -> validateInteger n
501+ (Just OpenApiNumber, Number n) -> validateNumber n
502+ (Just OpenApiString, String s) -> validateString s
503+ (Just OpenApiArray, Array xs) -> validateArray xs
504+ (Just OpenApiObject, Object o) -> validateObject o
499505 (Nothing, Null) -> valid
500506 (Nothing, Bool _) -> valid
501507 -- Number by default
502− (Nothing, Number n) -> sub_ paramSchema (validateNumber n)
503− (Nothing, String s) -> sub_ paramSchema (validateString s)
504− (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)
508+ (Nothing, Number n) -> validateNumber n
509+ (Nothing, String s) -> validateString s
510+ (Nothing, Array xs) -> validateArray xs
505511 (Nothing, Object o) -> validateObject o
506512 bad -> invalid $ "expected JSON value of type " ++ showType bad
507513
508−validateParamSchemaType :: Value -> Validation ParamSchema ()
514+validateParamSchemaType :: Value -> Validation Schema ()
509515validateParamSchemaType val = withSchema $ \sch ->
510516 case (sch ^. type_, val) of
511− (Just SwaggerBoolean, Bool _) -> valid
512− (Just SwaggerInteger, Number n) -> validateInteger n
513− (Just SwaggerNumber, Number n) -> validateNumber n
514− (Just SwaggerString, String s) -> validateString s
515− (Just SwaggerArray, Array xs) -> validateArray xs
517+ (Just OpenApiBoolean, Bool _) -> valid
518+ (Just OpenApiInteger, Number n) -> validateInteger n
519+ (Just OpenApiNumber, Number n) -> validateNumber n
520+ (Just OpenApiString, String s) -> validateString s
521+ (Just OpenApiArray, Array xs) -> validateArray xs
516522 (Nothing, Bool _) -> valid
517523 -- Number by default
518524 (Nothing, Number n) -> validateNumber n
@@ -520,11 +526,11 @@ validateParamSchemaType val = withSchema $ \sch ->
520526 (Nothing, Array xs) -> validateArray xs
521527 bad -> invalid $ "expected JSON value of type " ++ showType bad
522528
523−showType :: (Maybe SwaggerType, Value) -> String
529+showType :: (Maybe OpenApiType, Value) -> String
524530showType (Just ty, _) = show ty
525−showType (Nothing, Null) = "SwaggerNull"
526−showType (Nothing, Bool _) = "SwaggerBoolean"
527−showType (Nothing, Number _) = "SwaggerNumber"
528−showType (Nothing, String _) = "SwaggerString"
529−showType (Nothing, Array _) = "SwaggerArray"
530−showType (Nothing, Object _) = "SwaggerObject"
531+showType (Nothing, Null) = "OpenApiNull"
532+showType (Nothing, Bool _) = "OpenApiBoolean"
533+showType (Nothing, Number _) = "OpenApiNumber"
534+showType (Nothing, String _) = "OpenApiString"
535+showType (Nothing, Array _) = "OpenApiArray"
536+showType (Nothing, Object _) = "OpenApiObject"
src/Data/Swagger/Internal/TypeShape.hs → src/Data/OpenApi/Internal/TypeShape.hsrenamed+1−1
@@ -4,7 +4,7 @@
44{-# LANGUAGE TypeOperators #-}
55{-# LANGUAGE UndecidableInstances #-}
66
7−module Data.Swagger.Internal.TypeShape where
7+module Data.OpenApi.Internal.TypeShape where
88
99import Data.Proxy
1010import GHC.Generics
src/Data/Swagger/Internal/Utils.hs → src/Data/OpenApi/Internal/Utils.hsrenamed+6−1
@@ -4,7 +4,7 @@
44{-# LANGUAGE OverloadedStrings #-}
55{-# LANGUAGE RankNTypes #-}
66{-# LANGUAGE TypeOperators #-}
7−module Data.Swagger.Internal.Utils where
7+module Data.OpenApi.Internal.Utils where
88
99import Prelude ()
1010import Prelude.Compat
@@ -13,6 +13,8 @@ import Control.Lens ((&), (%~))
1313import Control.Lens.TH
1414import Data.Aeson
1515import Data.Aeson.Types
16+import qualified Data.Aeson.Encode.Pretty as P
17+import qualified Data.ByteString.Lazy as BSL
1618import Data.Char
1719import Data.Data
1820import Data.Hashable (Hashable)
@@ -132,3 +134,6 @@ instance SwaggerMonoid (Maybe a) where
132134 swaggerMempty = Nothing
133135 swaggerMappend x Nothing = x
134136 swaggerMappend _ y = y
137+
138+encodePretty :: ToJSON a => a -> BSL.ByteString
139+encodePretty = P.encodePretty' $ P.defConfig { P.confCompare = P.compare }
src/Data/Swagger/Lens.hs → src/Data/OpenApi/Lens.hsrenamed+48−58
@@ -10,27 +10,25 @@
1010{-# LANGUAGE UndecidableInstances #-}
1111{-# OPTIONS_GHC -fno-warn-orphans #-}
1212-- |
13−-- Module: Data.Swagger.Lens
13+-- Module: Data.OpenApi.Lens
1414-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
1515-- Stability: experimental
1616--
1717-- Lenses and prisms for Swagger.
18−module Data.Swagger.Lens where
18+module Data.OpenApi.Lens where
1919
2020import Control.Lens
2121import Data.Aeson (Value)
2222import Data.Scientific (Scientific)
23−import Data.Swagger.Internal
24−import Data.Swagger.Internal.Utils
23+import Data.OpenApi.Internal
24+import Data.OpenApi.Internal.Utils
2525import Data.Text (Text)
2626
2727-- * Classy lenses
2828
29−makeFields ''Swagger
29+makeFields ''OpenApi
3030makeFields ''Components
3131makeFields ''Server
32−-- conflict with enum of ParamSchema
33−--makeLensesWith swaggerFieldRules ''ServerVariable
3432makeFields ''RequestBody
3533makeFields ''MediaTypeObject
3634makeFields ''Info
@@ -43,7 +41,6 @@ makeLensesWith swaggerFieldRules ''Param
4341makeFields ''Header
4442makeLensesWith swaggerFieldRules ''Schema
4543makeFields ''NamedSchema
46−makeLensesWith swaggerFieldRules ''ParamSchema
4744makeFields ''Xml
4845makeLensesWith swaggerFieldRules ''Responses
4946makeFields ''Response
@@ -67,24 +64,24 @@ makePrisms ''SecuritySchemeType
6764-- ** 'Referenced' prisms
6865makePrisms ''Referenced
6966
70−-- ** 'SwaggerItems' prisms
67+-- ** 'OpenApiItems' prisms
7168
72−_SwaggerItemsArray :: Review SwaggerItems [Referenced Schema]
73−_SwaggerItemsArray
74− = unto (\x -> SwaggerItemsArray x)
69+_OpenApiItemsArray :: Review OpenApiItems [Referenced Schema]
70+_OpenApiItemsArray
71+ = unto (\x -> OpenApiItemsArray x)
7572{- \x -> case x of
76− SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)
77− SwaggerItemsObject o -> Left (SwaggerItemsObject o)
78− SwaggerItemsArray a -> Right a
73+ OpenApiItemsPrimitive c p -> Left (OpenApiItemsPrimitive c p)
74+ OpenApiItemsObject o -> Left (OpenApiItemsObject o)
75+ OpenApiItemsArray a -> Right a
7976-}
8077
81−_SwaggerItemsObject :: Review SwaggerItems (Referenced Schema)
82−_SwaggerItemsObject
83− = unto (\x -> SwaggerItemsObject x)
78+_OpenApiItemsObject :: Review OpenApiItems (Referenced Schema)
79+_OpenApiItemsObject
80+ = unto (\x -> OpenApiItemsObject x)
8481{- \x -> case x of
85− SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)
86− SwaggerItemsObject o -> Right o
87− SwaggerItemsArray a -> Left (SwaggerItemsArray a)
82+ OpenApiItemsPrimitive c p -> Left (OpenApiItemsPrimitive c p)
83+ OpenApiItemsObject o -> Right o
84+ OpenApiItemsArray a -> Left (OpenApiItemsArray a)
8885-}
8986
9087-- =============================================================
@@ -102,75 +99,68 @@ instance At Responses where at n = responses . at n
10299instance Ixed Operation where ix n = responses . ix n
103100instance At Operation where at n = responses . at n
104101
105−instance HasParamSchema NamedSchema ParamSchema where paramSchema = schema.paramSchema
106−
107−-- HasType instances
108−instance HasType Schema (Maybe SwaggerType) where type_ = paramSchema.type_
109−instance HasType NamedSchema (Maybe SwaggerType) where type_ = paramSchema.type_
110−
111−-- HasDefault instances
112−instance HasDefault Schema (Maybe Value) where default_ = paramSchema.default_
102+instance HasType NamedSchema (Maybe OpenApiType) where type_ = schema.type_
113103
114104-- OVERLAPPABLE instances
115105
116106instance
117107 {-# OVERLAPPABLE #-}
118− HasParamSchema s ParamSchema
108+ HasSchema s Schema
119109 => HasFormat s (Maybe Format) where
120− format = paramSchema.format
110+ format = schema.format
121111
122112instance
123113 {-# OVERLAPPABLE #-}
124− HasParamSchema s ParamSchema
125− => HasItems s (Maybe SwaggerItems) where
126− items = paramSchema.items
114+ HasSchema s Schema
115+ => HasItems s (Maybe OpenApiItems) where
116+ items = schema.items
127117
128118instance
129119 {-# OVERLAPPABLE #-}
130− HasParamSchema s ParamSchema
120+ HasSchema s Schema
131121 => HasMaximum s (Maybe Scientific) where
132− maximum_ = paramSchema.maximum_
122+ maximum_ = schema.maximum_
133123
134−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
124+instance {-# OVERLAPPABLE #-} HasSchema s Schema
135125 => HasExclusiveMaximum s (Maybe Bool) where
136− exclusiveMaximum = paramSchema.exclusiveMaximum
126+ exclusiveMaximum = schema.exclusiveMaximum
137127
138−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
128+instance {-# OVERLAPPABLE #-} HasSchema s Schema
139129 => HasMinimum s (Maybe Scientific) where
140− minimum_ = paramSchema.minimum_
130+ minimum_ = schema.minimum_
141131
142−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
132+instance {-# OVERLAPPABLE #-} HasSchema s Schema
143133 => HasExclusiveMinimum s (Maybe Bool) where
144− exclusiveMinimum = paramSchema.exclusiveMinimum
134+ exclusiveMinimum = schema.exclusiveMinimum
145135
146−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
136+instance {-# OVERLAPPABLE #-} HasSchema s Schema
147137 => HasMaxLength s (Maybe Integer) where
148− maxLength = paramSchema.maxLength
138+ maxLength = schema.maxLength
149139
150−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
140+instance {-# OVERLAPPABLE #-} HasSchema s Schema
151141 => HasMinLength s (Maybe Integer) where
152− minLength = paramSchema.minLength
142+ minLength = schema.minLength
153143
154−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
144+instance {-# OVERLAPPABLE #-} HasSchema s Schema
155145 => HasPattern s (Maybe Text) where
156− pattern = paramSchema.pattern
146+ pattern = schema.pattern
157147
158−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
148+instance {-# OVERLAPPABLE #-} HasSchema s Schema
159149 => HasMaxItems s (Maybe Integer) where
160− maxItems = paramSchema.maxItems
150+ maxItems = schema.maxItems
161151
162−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
152+instance {-# OVERLAPPABLE #-} HasSchema s Schema
163153 => HasMinItems s (Maybe Integer) where
164− minItems = paramSchema.minItems
154+ minItems = schema.minItems
165155
166−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
156+instance {-# OVERLAPPABLE #-} HasSchema s Schema
167157 => HasUniqueItems s (Maybe Bool) where
168− uniqueItems = paramSchema.uniqueItems
158+ uniqueItems = schema.uniqueItems
169159
170−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
160+instance {-# OVERLAPPABLE #-} HasSchema s Schema
171161 => HasEnum s (Maybe [Value]) where
172− enum_ = paramSchema.enum_
162+ enum_ = schema.enum_
173163
174−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
164+instance {-# OVERLAPPABLE #-} HasSchema s Schema
175165 => HasMultipleOf s (Maybe Scientific) where
176− multipleOf = paramSchema.multipleOf
166+ multipleOf = schema.multipleOf
src/Data/Swagger/Operation.hs → src/Data/OpenApi/Operation.hsrenamed+136−29
@@ -1,13 +1,13 @@
11{-# LANGUAGE RankNTypes #-}
22-- |
3−-- Module: Data.Swagger.Operation
3+-- Module: Data.OpenApi.Operation
44-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
55-- Stability: experimental
66--
77-- Helper traversals and functions for Swagger operations manipulations.
88-- These might be useful when you already have Swagger specification
99-- generated by something else.
10−module Data.Swagger.Operation (
10+module Data.OpenApi.Operation (
1111 -- * Operation traversals
1212 allOperations,
1313 operationsOf,
@@ -42,10 +42,10 @@ import qualified Data.Set as Set
4242import Data.Text (Text)
4343import Network.HTTP.Media (MediaType)
4444
45−import Data.Swagger.Declare
46−import Data.Swagger.Internal
47−import Data.Swagger.Lens
48−import Data.Swagger.Schema
45+import Data.OpenApi.Declare
46+import Data.OpenApi.Internal
47+import Data.OpenApi.Lens
48+import Data.OpenApi.Schema
4949
5050import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
5151import qualified Data.HashSet.InsOrd as InsOrdHS
@@ -55,14 +55,17 @@ import qualified Data.HashSet.InsOrd as InsOrdHS
5555-- >>> import Data.Proxy
5656-- >>> import Data.Time
5757-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
58+-- >>> import Data.OpenApi.Internal.Utils
5859
5960-- | Prepend path piece to all operations of the spec.
6061-- Leading and trailing slashes are trimmed/added automatically.
6162--
62−-- >>> let api = (mempty :: Swagger) & paths .~ [("/info", mempty)]
63−-- >>> BSL.putStrLn $ encode $ prependPath "user/{user_id}" api ^. paths
64−-- {"/user/{user_id}/info":{}}
65−prependPath :: FilePath -> Swagger -> Swagger
63+-- >>> let api = (mempty :: OpenApi) & paths .~ [("/info", mempty)]
64+-- >>> BSL.putStrLn $ encodePretty $ prependPath "user/{user_id}" api ^. paths
65+-- {
66+-- "/user/{user_id}/info": {}
67+-- }
68+prependPath :: FilePath -> OpenApi -> OpenApi
6669prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
6770 where
6871 x </> y = case trim y of
@@ -72,7 +75,7 @@ prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
7275 trim = dropWhile (== '/') . dropWhileEnd (== '/')
7376
7477-- | All operations of a Swagger spec.
75−allOperations :: Traversal' Swagger Operation
78+allOperations :: Traversal' OpenApi Operation
7679allOperations = paths.traverse.template
7780
7881-- | @'operationsOf' sub@ will traverse only those operations
@@ -80,13 +83,66 @@ allOperations = paths.traverse.template
8083-- by both path and method.
8184--
8285-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
83−-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
84−-- >>> let sub = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
85−-- >>> BSL.putStrLn $ encode api
86−-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"200":{"description":"OK"}}},"post":{"responses":{"200":{"description":"OK"}}}}},"components":{}}
87−-- >>> BSL.putStrLn $ encode $ api & operationsOf sub . at 404 ?~ "Not found"
88−-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"404":{"description":"Not found"},"200":{"description":"OK"}}},"post":{"responses":{"200":{"description":"OK"}}}}},"components":{}}
89−operationsOf :: Swagger -> Traversal' Swagger Operation
86+-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
87+-- >>> let sub = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]
88+-- >>> BSL.putStrLn $ encodePretty api
89+-- {
90+-- "components": {},
91+-- "info": {
92+-- "title": "",
93+-- "version": ""
94+-- },
95+-- "openapi": "3.0.0",
96+-- "paths": {
97+-- "/user": {
98+-- "get": {
99+-- "responses": {
100+-- "200": {
101+-- "description": "OK"
102+-- }
103+-- }
104+-- },
105+-- "post": {
106+-- "responses": {
107+-- "200": {
108+-- "description": "OK"
109+-- }
110+-- }
111+-- }
112+-- }
113+-- }
114+-- }
115+-- >>> BSL.putStrLn $ encodePretty $ api & operationsOf sub . at 404 ?~ "Not found"
116+-- {
117+-- "components": {},
118+-- "info": {
119+-- "title": "",
120+-- "version": ""
121+-- },
122+-- "openapi": "3.0.0",
123+-- "paths": {
124+-- "/user": {
125+-- "get": {
126+-- "responses": {
127+-- "200": {
128+-- "description": "OK"
129+-- },
130+-- "404": {
131+-- "description": "Not found"
132+-- }
133+-- }
134+-- },
135+-- "post": {
136+-- "responses": {
137+-- "200": {
138+-- "description": "OK"
139+-- }
140+-- }
141+-- }
142+-- }
143+-- }
144+-- }
145+operationsOf :: OpenApi -> Traversal' OpenApi Operation
90146operationsOf sub = paths.itraversed.withIndex.subops
91147 where
92148 -- | Traverse operations that correspond to paths and methods of the sub API.
@@ -108,12 +164,12 @@ operationsOf sub = paths.itraversed.withIndex.subops
108164-- @
109165-- 'applyTags' = 'applyTagsFor' 'allOperations'
110166-- @
111−applyTags :: [Tag] -> Swagger -> Swagger
167+applyTags :: [Tag] -> OpenApi -> OpenApi
112168applyTags = applyTagsFor allOperations
113169
114170-- | Apply tags to a part of Swagger spec and update the global
115171-- list of tags.
116−applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
172+applyTagsFor :: Traversal' OpenApi Operation -> [Tag] -> OpenApi -> OpenApi
117173applyTagsFor ops ts swag = swag
118174 & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))
119175 & tags %~ (<> InsOrdHS.fromList ts)
@@ -123,8 +179,26 @@ applyTagsFor ops ts swag = swag
123179--
124180-- FIXME doc
125181--
126−-- >>> BSL.putStrLn $ encode $ runDeclare (declareResponse "application/json" (Proxy :: Proxy Day)) mempty
127−-- [{"Day":{"example":"2016-07-22","format":"date","type":"string"}},{"description":"","content":{"application/json":{"schema":{"$ref":"#/components/schemas/Day"}}}}]
182+-- >>> BSL.putStrLn $ encodePretty $ runDeclare (declareResponse "application/json" (Proxy :: Proxy Day)) mempty
183+-- [
184+-- {
185+-- "Day": {
186+-- "example": "2016-07-22",
187+-- "format": "date",
188+-- "type": "string"
189+-- }
190+-- },
191+-- {
192+-- "content": {
193+-- "application/json": {
194+-- "schema": {
195+-- "$ref": "#/components/schemas/Day"
196+-- }
197+-- }
198+-- },
199+-- "description": ""
200+-- }
201+-- ]
128202declareResponse :: ToSchema a => MediaType -> Proxy a -> Declare (Definitions Schema) Response
129203declareResponse cType proxy = do
130204 s <- declareSchemaRef proxy
@@ -141,13 +215,46 @@ declareResponse cType proxy = do
141215--
142216-- Example:
143217--
144−-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
218+-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]
145219-- >>> let res = declareResponse "application/json" (Proxy :: Proxy Day)
146−-- >>> BSL.putStrLn $ encode $ api & setResponse 200 res
147−-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"200":{"content":{"application/json":{"schema":{"$ref":"#/components/schemas/Day"}}},"description":""}}}}},"components":{"schemas":{"Day":{"example":"2016-07-22","format":"date","type":"string"}}}}
220+-- >>> BSL.putStrLn $ encodePretty $ api & setResponse 200 res
221+-- {
222+-- "components": {
223+-- "schemas": {
224+-- "Day": {
225+-- "example": "2016-07-22",
226+-- "format": "date",
227+-- "type": "string"
228+-- }
229+-- }
230+-- },
231+-- "info": {
232+-- "title": "",
233+-- "version": ""
234+-- },
235+-- "openapi": "3.0.0",
236+-- "paths": {
237+-- "/user": {
238+-- "get": {
239+-- "responses": {
240+-- "200": {
241+-- "content": {
242+-- "application/json": {
243+-- "schema": {
244+-- "$ref": "#/components/schemas/Day"
245+-- }
246+-- }
247+-- },
248+-- "description": ""
249+-- }
250+-- }
251+-- }
252+-- }
253+-- }
254+-- }
148255--
149256-- See also @'setResponseWith'@.
150−setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
257+setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
151258setResponse = setResponseFor allOperations
152259
153260-- | Set or update response for all operations.
@@ -161,7 +268,7 @@ setResponse = setResponseFor allOperations
161268-- @
162269--
163270-- See also @'setResponse'@.
164−setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
271+setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
165272setResponseWith = setResponseForWith allOperations
166273
167274-- | Set response for specified operations.
@@ -170,7 +277,7 @@ setResponseWith = setResponseForWith allOperations
170277-- If the response already exists it will be overwritten.
171278--
172279-- See also @'setResponseForWith'@.
173−setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
280+setResponseFor :: Traversal' OpenApi Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
174281setResponseFor ops code dres swag = swag
175282 & components.schemas %~ (<> defs)
176283 & ops . at code ?~ Inline res
@@ -184,7 +291,7 @@ setResponseFor ops code dres swag = swag
184291-- then just the new response is used.
185292--
186293-- See also @'setResponseFor'@.
187−setResponseForWith :: Traversal' Swagger Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
294+setResponseForWith :: Traversal' OpenApi Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
188295setResponseForWith ops f code dres swag = swag
189296 & components.schemas %~ (<> defs)
190297 & ops . at code %~ Just . Inline . combine
src/Data/Swagger/Optics.hs → src/Data/OpenApi/Optics.hsrenamed+90−153
@@ -7,7 +7,7 @@
77{-# LANGUAGE UndecidableInstances #-}
88{-# OPTIONS_GHC -fno-warn-orphans #-}
99-- |
10−-- Module: Data.Swagger.Optics
10+-- Module: Data.OpenApi.Optics
1111-- Maintainer: Andrzej Rybczak <andrzej@rybczak.net>
1212-- Stability: experimental
1313--
@@ -19,53 +19,98 @@
1919-- >>> :set -XOverloadedLabels
2020-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
2121--
22−-- Example from the "Data.Swagger" module using @optics@:
22+-- Example from the "Data.OpenApi" module using @optics@:
2323--
2424-- >>> :{
25−-- BSL.putStrLn $ encode $ (mempty :: Swagger)
26−-- & #components % #schemas .~ [ ("User", mempty & #type ?~ SwaggerString) ]
25+-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
26+-- & #components % #schemas .~ [ ("User", mempty & #type ?~ OpenApiString) ]
2727-- & #paths .~
2828-- [ ("/user", mempty & #get ?~ (mempty
2929-- & at 200 ?~ ("OK" & #_Inline % #content % at "application/json" ?~ (mempty & #schema ?~ Ref (Reference "User")))
3030-- & at 404 ?~ "User info not found")) ]
3131-- :}
32−-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"404":{"description":"User info not found"},"200":{"content":{"application/json":{"schema":{"$ref":"#/components/schemas/User"}}},"description":"OK"}}}}},"components":{"schemas":{"User":{"type":"string"}}}}
32+-- {
33+-- "components": {
34+-- "schemas": {
35+-- "User": {
36+-- "type": "string"
37+-- }
38+-- }
39+-- },
40+-- "info": {
41+-- "title": "",
42+-- "version": ""
43+-- },
44+-- "openapi": "3.0.0",
45+-- "paths": {
46+-- "/user": {
47+-- "get": {
48+-- "responses": {
49+-- "200": {
50+-- "content": {
51+-- "application/json": {
52+-- "schema": {
53+-- "$ref": "#/components/schemas/User"
54+-- }
55+-- }
56+-- },
57+-- "description": "OK"
58+-- },
59+-- "404": {
60+-- "description": "User info not found"
61+-- }
62+-- }
63+-- }
64+-- }
65+-- }
66+-- }
3367--
3468-- For convenience optics are defined as /labels/. It means that field accessor
3569-- names can be overloaded for different types. One such common field is
3670-- @#description@. Many components of a Swagger specification can have
3771-- descriptions, and you can use the same name for them:
3872--
39−-- >>> BSL.putStrLn $ encode $ (mempty :: Response) & #description .~ "No content"
40−-- {"description":"No content"}
73+-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & #description .~ "No content"
74+-- {
75+-- "description": "No content"
76+-- }
4177-- >>> :{
42−-- BSL.putStrLn $ encode $ (mempty :: Schema)
43−-- & #type ?~ SwaggerBoolean
78+-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)
79+-- & #type ?~ OpenApiBoolean
4480-- & #description ?~ "To be or not to be"
4581-- :}
46−-- {"description":"To be or not to be","type":"boolean"}
82+-- {
83+-- "description": "To be or not to be",
84+-- "type": "boolean"
85+-- }
4786--
4887-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and
4988-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:
5089--
5190-- >>> :{
52−-- BSL.putStrLn $ encode $ (mempty :: Operation)
91+-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)
5392-- & at 404 ?~ "Not found"
5493-- :}
55−-- {"responses":{"404":{"description":"Not found"}}}
56−--
57−module Data.Swagger.Optics () where
94+-- {
95+-- "responses": {
96+-- "404": {
97+-- "description": "Not found"
98+-- }
99+-- }
100+-- }
101+module Data.OpenApi.Optics () where
58102
59103import Data.Aeson (Value)
60104import Data.Scientific (Scientific)
61−import Data.Swagger.Internal
105+import Data.OpenApi.Internal
106+import Data.OpenApi.Internal.Utils
62107import Data.Text (Text)
63108import Optics.Core
64109import Optics.TH
65110
66111-- Lenses
67112
68−makeFieldLabels ''Swagger
113+makeFieldLabels ''OpenApi
69114makeFieldLabels ''Components
70115makeFieldLabels ''Server
71116makeFieldLabels ''ServerVariable
@@ -81,7 +126,6 @@ makeFieldLabels ''Param
81126makeFieldLabels ''Header
82127makeFieldLabels ''Schema
83128makeFieldLabels ''NamedSchema
84−makeFieldLabels ''ParamSchema
85129makeFieldLabels ''Xml
86130makeFieldLabels ''Responses
87131makeFieldLabels ''Response
@@ -104,30 +148,30 @@ makeFieldLabels ''Link
104148makePrismLabels ''SecuritySchemeType
105149makePrismLabels ''Referenced
106150
107−-- SwaggerItems prisms
151+-- OpenApiItems prisms
108152
109153instance
110154 ( a ~ [Referenced Schema]
111155 , b ~ [Referenced Schema]
112− ) => LabelOptic "_SwaggerItemsArray"
156+ ) => LabelOptic "_OpenApiItemsArray"
113157 A_Review
114− SwaggerItems
115− SwaggerItems
158+ OpenApiItems
159+ OpenApiItems
116160 a
117161 b where
118− labelOptic = unto (\x -> SwaggerItemsArray x)
162+ labelOptic = unto (\x -> OpenApiItemsArray x)
119163 {-# INLINE labelOptic #-}
120164
121165instance
122166 ( a ~ Referenced Schema
123167 , b ~ Referenced Schema
124− ) => LabelOptic "_SwaggerItemsObject"
168+ ) => LabelOptic "_OpenApiItemsObject"
125169 A_Review
126− SwaggerItems
127− SwaggerItems
170+ OpenApiItems
171+ OpenApiItems
128172 a
129173 b where
130− labelOptic = unto (\x -> SwaggerItemsObject x)
174+ labelOptic = unto (\x -> OpenApiItemsObject x)
131175 {-# INLINE labelOptic #-}
132176
133177-- =============================================================
@@ -153,239 +197,132 @@ instance At Operation where
153197 at n = #responses % at n
154198 {-# INLINE at #-}
155199
156−-- #paramSchema
157−
158−instance
159− ( a ~ ParamSchema
160− , b ~ ParamSchema
161− ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where
162− labelOptic = #schema % #paramSchema
163− {-# INLINE labelOptic #-}
164−
165200-- #type
166201
167202instance
168− ( a ~ Maybe SwaggerType
169− , b ~ Maybe SwaggerType
170− ) => LabelOptic "type" A_Lens Schema Schema a b where
171− labelOptic = #paramSchema % #type
172− {-# INLINE labelOptic #-}
173−
174−instance
175− ( a ~ Maybe SwaggerType
176− , b ~ Maybe SwaggerType
203+ ( a ~ Maybe OpenApiType
204+ , b ~ Maybe OpenApiType
177205 ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where
178− labelOptic = #paramSchema % #type
206+ labelOptic = #schema % #type
179207 {-# INLINE labelOptic #-}
180208
181209-- #default
182210
183−instance
184− ( a ~ Maybe Value, b ~ Maybe Value
185− ) => LabelOptic "default" A_Lens Schema Schema a b where
186− labelOptic = #paramSchema % #default
187− {-# INLINE labelOptic #-}
188−
189211instance
190212 ( a ~ Maybe Value, b ~ Maybe Value
191213 ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where
192− labelOptic = #paramSchema % #default
214+ labelOptic = #schema % #default
193215 {-# INLINE labelOptic #-}
194216
195217-- #format
196218
197−instance
198− ( a ~ Maybe Format, b ~ Maybe Format
199− ) => LabelOptic "format" A_Lens Schema Schema a b where
200− labelOptic = #paramSchema % #format
201− {-# INLINE labelOptic #-}
202−
203219instance
204220 ( a ~ Maybe Format, b ~ Maybe Format
205221 ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where
206− labelOptic = #paramSchema % #format
222+ labelOptic = #schema % #format
207223 {-# INLINE labelOptic #-}
208224
209225-- #items
210226
211227instance
212− ( a ~ Maybe SwaggerItems
213− , b ~ Maybe SwaggerItems
214− ) => LabelOptic "items" A_Lens Schema Schema a b where
215− labelOptic = #paramSchema % #items
216− {-# INLINE labelOptic #-}
217−
218−instance
219− ( a ~ Maybe SwaggerItems
220− , b ~ Maybe SwaggerItems
228+ ( a ~ Maybe OpenApiItems
229+ , b ~ Maybe OpenApiItems
221230 ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where
222− labelOptic = #paramSchema % #items
231+ labelOptic = #schema % #items
223232 {-# INLINE labelOptic #-}
224233
225234-- #maximum
226235
227−instance
228− ( a ~ Maybe Scientific, b ~ Maybe Scientific
229− ) => LabelOptic "maximum" A_Lens Schema Schema a b where
230− labelOptic = #paramSchema % #maximum
231− {-# INLINE labelOptic #-}
232−
233236instance
234237 ( a ~ Maybe Scientific, b ~ Maybe Scientific
235238 ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where
236− labelOptic = #paramSchema % #maximum
239+ labelOptic = #schema % #maximum
237240 {-# INLINE labelOptic #-}
238241
239242-- #exclusiveMaximum
240243
241−instance
242− ( a ~ Maybe Bool, b ~ Maybe Bool
243− ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where
244− labelOptic = #paramSchema % #exclusiveMaximum
245− {-# INLINE labelOptic #-}
246−
247244instance
248245 ( a ~ Maybe Bool, b ~ Maybe Bool
249246 ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where
250− labelOptic = #paramSchema % #exclusiveMaximum
247+ labelOptic = #schema % #exclusiveMaximum
251248 {-# INLINE labelOptic #-}
252249
253250-- #minimum
254251
255−instance
256− ( a ~ Maybe Scientific, b ~ Maybe Scientific
257− ) => LabelOptic "minimum" A_Lens Schema Schema a b where
258− labelOptic = #paramSchema % #minimum
259− {-# INLINE labelOptic #-}
260−
261252instance
262253 ( a ~ Maybe Scientific, b ~ Maybe Scientific
263254 ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where
264− labelOptic = #paramSchema % #minimum
255+ labelOptic = #schema % #minimum
265256 {-# INLINE labelOptic #-}
266257
267258-- #exclusiveMinimum
268259
269−instance
270− ( a ~ Maybe Bool, b ~ Maybe Bool
271− ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where
272− labelOptic = #paramSchema % #exclusiveMinimum
273− {-# INLINE labelOptic #-}
274−
275260instance
276261 ( a ~ Maybe Bool, b ~ Maybe Bool
277262 ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where
278− labelOptic = #paramSchema % #exclusiveMinimum
263+ labelOptic = #schema % #exclusiveMinimum
279264 {-# INLINE labelOptic #-}
280265
281266-- #maxLength
282267
283−instance
284− ( a ~ Maybe Integer, b ~ Maybe Integer
285− ) => LabelOptic "maxLength" A_Lens Schema Schema a b where
286− labelOptic = #paramSchema % #maxLength
287− {-# INLINE labelOptic #-}
288−
289268instance
290269 ( a ~ Maybe Integer, b ~ Maybe Integer
291270 ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where
292− labelOptic = #paramSchema % #maxLength
271+ labelOptic = #schema % #maxLength
293272 {-# INLINE labelOptic #-}
294273
295274-- #minLength
296275
297−instance
298− ( a ~ Maybe Integer, b ~ Maybe Integer
299− ) => LabelOptic "minLength" A_Lens Schema Schema a b where
300− labelOptic = #paramSchema % #minLength
301− {-# INLINE labelOptic #-}
302−
303276instance
304277 ( a ~ Maybe Integer, b ~ Maybe Integer
305278 ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where
306− labelOptic = #paramSchema % #minLength
279+ labelOptic = #schema % #minLength
307280 {-# INLINE labelOptic #-}
308281
309282-- #pattern
310283
311−instance
312− ( a ~ Maybe Text, b ~ Maybe Text
313− ) => LabelOptic "pattern" A_Lens Schema Schema a b where
314− labelOptic = #paramSchema % #pattern
315− {-# INLINE labelOptic #-}
316−
317284instance
318285 ( a ~ Maybe Text, b ~ Maybe Text
319286 ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where
320− labelOptic = #paramSchema % #pattern
287+ labelOptic = #schema % #pattern
321288 {-# INLINE labelOptic #-}
322289
323290-- #maxItems
324291
325−instance
326− ( a ~ Maybe Integer, b ~ Maybe Integer
327− ) => LabelOptic "maxItems" A_Lens Schema Schema a b where
328− labelOptic = #paramSchema % #maxItems
329− {-# INLINE labelOptic #-}
330−
331292instance
332293 ( a ~ Maybe Integer, b ~ Maybe Integer
333294 ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where
334− labelOptic = #paramSchema % #maxItems
295+ labelOptic = #schema % #maxItems
335296 {-# INLINE labelOptic #-}
336297
337298-- #minItems
338299
339−instance
340− ( a ~ Maybe Integer, b ~ Maybe Integer
341− ) => LabelOptic "minItems" A_Lens Schema Schema a b where
342− labelOptic = #paramSchema % #minItems
343− {-# INLINE labelOptic #-}
344−
345300instance
346301 ( a ~ Maybe Integer, b ~ Maybe Integer
347302 ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where
348− labelOptic = #paramSchema % #minItems
303+ labelOptic = #schema % #minItems
349304 {-# INLINE labelOptic #-}
350305
351306-- #uniqueItems
352307
353−instance
354− ( a ~ Maybe Bool, b ~ Maybe Bool
355− ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where
356− labelOptic = #paramSchema % #uniqueItems
357− {-# INLINE labelOptic #-}
358−
359308instance
360309 ( a ~ Maybe Bool, b ~ Maybe Bool
361310 ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where
362− labelOptic = #paramSchema % #uniqueItems
311+ labelOptic = #schema % #uniqueItems
363312 {-# INLINE labelOptic #-}
364313
365314-- #enum
366315
367−instance
368− ( a ~ Maybe [Value], b ~ Maybe [Value]
369− ) => LabelOptic "enum" A_Lens Schema Schema a b where
370− labelOptic = #paramSchema % #enum
371− {-# INLINE labelOptic #-}
372−
373316instance
374317 ( a ~ Maybe [Value], b ~ Maybe [Value]
375318 ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where
376− labelOptic = #paramSchema % #enum
319+ labelOptic = #schema % #enum
377320 {-# INLINE labelOptic #-}
378321
379322-- #multipleOf
380323
381−instance
382− ( a ~ Maybe Scientific, b ~ Maybe Scientific
383− ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where
384− labelOptic = #paramSchema % #multipleOf
385− {-# INLINE labelOptic #-}
386−
387324instance
388325 ( a ~ Maybe Scientific, b ~ Maybe Scientific
389326 ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where
390− labelOptic = #paramSchema % #multipleOf
327+ labelOptic = #schema % #multipleOf
391328 {-# INLINE labelOptic #-}
src/Data/Swagger/ParamSchema.hs → src/Data/OpenApi/ParamSchema.hsrenamed+7−7
@@ -1,10 +1,10 @@
11-- |
2−-- Module: Data.Swagger.ParamSchema
2+-- Module: Data.OpenApi.ParamSchema
33-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
44-- Stability: experimental
55--
66-- Types and functions for working with Swagger parameter schema.
7−module Data.Swagger.ParamSchema (
7+module Data.OpenApi.ParamSchema (
88 -- * Encoding
99 ToParamSchema(..),
1010
@@ -13,14 +13,14 @@ module Data.Swagger.ParamSchema (
1313 toParamSchemaBoundedIntegral,
1414
1515 -- * Schema templates
16− passwordParamSchema,
17− binaryParamSchema,
18− byteParamSchema,
16+ passwordSchema,
17+ binarySchema,
18+ byteSchema,
1919
2020 -- * Generic encoding configuration
2121 SchemaOptions(..),
2222 defaultSchemaOptions,
2323) where
2424
25−import Data.Swagger.Internal.ParamSchema
26−import Data.Swagger.SchemaOptions
25+import Data.OpenApi.Internal.ParamSchema
26+import Data.OpenApi.SchemaOptions
src/Data/Swagger/Schema.hs → src/Data/OpenApi/Schema.hsrenamed+4−9
@@ -1,10 +1,10 @@
11-- |
2−-- Module: Data.Swagger.Schema
2+-- Module: Data.OpenApi.Schema
33-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
44-- Stability: experimental
55--
66-- Types and functions for working with Swagger schema.
7−module Data.Swagger.Schema (
7+module Data.OpenApi.Schema (
88 -- * Encoding
99 ToSchema(..),
1010 declareSchema,
@@ -32,11 +32,6 @@ module Data.Swagger.Schema (
3232 paramSchemaToNamedSchema,
3333 paramSchemaToSchema,
3434
35− -- * Schema templates
36− passwordSchema,
37− binarySchema,
38− byteSchema,
39−
4035 -- * Sketching @'Schema'@s using @'ToJSON'@
4136 sketchSchema,
4237 sketchStrictSchema,
@@ -53,5 +48,5 @@ module Data.Swagger.Schema (
5348 fromAesonOptions,
5449) where
5550
56−import Data.Swagger.Internal.Schema
57−import Data.Swagger.SchemaOptions
51+import Data.OpenApi.Internal.Schema
52+import Data.OpenApi.SchemaOptions
src/Data/Swagger/Schema/Generator.hs → src/Data/OpenApi/Schema/Generator.hsrenamed+17−15
@@ -2,7 +2,7 @@
22{-# LANGUAGE OverloadedLists #-}
33{-# LANGUAGE ScopedTypeVariables #-}
44
5−module Data.Swagger.Schema.Generator where
5+module Data.OpenApi.Schema.Generator where
66
77import Prelude ()
88import Prelude.Compat
@@ -16,20 +16,22 @@ import Data.Maybe
1616import Data.Proxy
1717import Data.Scientific
1818import qualified Data.Set as S
19−import Data.Swagger
20−import Data.Swagger.Declare
21−import Data.Swagger.Internal.Schema.Validation (inferSchemaTypes)
19+import Data.OpenApi
20+import Data.OpenApi.Declare
21+import Data.OpenApi.Internal.Schema.Validation (inferSchemaTypes)
2222import qualified Data.Text as T
2323import qualified Data.Vector as V
2424import Test.QuickCheck (arbitrary)
2525import Test.QuickCheck.Gen
2626import Test.QuickCheck.Property
2727
28+import Data.OpenApi.Aeson.Compat (fromInsOrdHashMap)
29+
2830-- | Note: 'schemaGen' may 'error', if schema type is not specified,
2931-- and cannot be inferred.
3032schemaGen :: Definitions Schema -> Schema -> Gen Value
3133schemaGen _ schema
32− | Just cases <- schema ^. paramSchema . enum_ = elements cases
34+ | Just cases <- schema ^. enum_ = elements cases
3335schemaGen defns schema
3436 | Just variants <- schema ^. oneOf = schemaGen defns =<< elements (dereference defns <$> variants)
3537schemaGen defns schema =
@@ -39,25 +41,25 @@ schemaGen defns schema =
3941 [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)
4042 -- Gen is not MonadFail
4143 _ -> error "unable to infer schema type"
42− Just SwaggerBoolean -> Bool <$> elements [True, False]
43− Just SwaggerNull -> pure Null
44− Just SwaggerNumber
44+ Just OpenApiBoolean -> Bool <$> elements [True, False]
45+ Just OpenApiNull -> pure Null
46+ Just OpenApiNumber
4547 | Just min <- schema ^. minimum_
4648 , Just max <- schema ^. maximum_ ->
4749 Number . fromFloatDigits <$>
4850 choose (toRealFloat min, toRealFloat max :: Double)
4951 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)
50− Just SwaggerInteger
52+ Just OpenApiInteger
5153 | Just min <- schema ^. minimum_
5254 , Just max <- schema ^. maximum_ ->
5355 Number . fromInteger <$>
5456 choose (truncate min, truncate max)
5557 | otherwise -> Number . fromInteger <$> arbitrary
56− Just SwaggerArray
58+ Just OpenApiArray
5759 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
5860 | Just items <- schema ^. items ->
5961 case items of
60− SwaggerItemsObject ref -> do
62+ OpenApiItemsObject ref -> do
6163 size <- getSize
6264 let itemSchema = dereference defns ref
6365 minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems
@@ -65,17 +67,17 @@ schemaGen defns schema =
6567 arrayLength <- choose (minLength', max minLength' maxLength')
6668 generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema
6769 return . Array $ V.fromList generatedArray
68− SwaggerItemsArray refs ->
70+ OpenApiItemsArray refs ->
6971 let itemGens = schemaGen defns . dereference defns <$> refs
7072 in fmap (Array . V.fromList) $ sequence itemGens
71− Just SwaggerString -> do
73+ Just OpenApiString -> do
7274 size <- getSize
7375 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
7476 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
7577 length <- choose (minLength', max minLength' maxLength')
7678 str <- vectorOf length arbitrary
7779 return . String $ T.pack str
78− Just SwaggerObject -> do
80+ Just OpenApiObject -> do
7981 size <- getSize
8082 let props = dereference defns <$> schema ^. properties
8183 reqKeys = S.fromList $ schema ^. required
@@ -95,7 +97,7 @@ schemaGen defns schema =
9597 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
9698 _ -> return []
9799 x <- sequence $ gens <> additionalGens
98− return . Object $ M.toHashMap x
100+ return . Object $ fromInsOrdHashMap x
99101
100102dereference :: Definitions a -> Referenced a -> a
101103dereference _ (Inline a) = a
src/Data/Swagger/Schema/Validation.hs → src/Data/OpenApi/Schema/Validation.hsrenamed+7−7
@@ -1,10 +1,10 @@
11-- |
2−-- Module: Data.Swagger.Schema.Validation
2+-- Module: Data.OpenApi.Schema.Validation
33-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
44-- Stability: experimental
55--
66-- Validate JSON values with Swagger Schema.
7−module Data.Swagger.Schema.Validation (
7+module Data.OpenApi.Schema.Validation (
88 -- * How to use validation
99 -- $howto
1010
@@ -29,13 +29,13 @@ module Data.Swagger.Schema.Validation (
2929 validateJSONWithPatternChecker,
3030) where
3131
32−import Data.Swagger.Internal.Schema.Validation
32+import Data.OpenApi.Internal.Schema.Validation
3333
3434-- $setup
3535-- >>> import Control.Lens
3636-- >>> import Data.Aeson
3737-- >>> import Data.Proxy
38−-- >>> import Data.Swagger
38+-- >>> import Data.OpenApi
3939-- >>> import GHC.Generics
4040-- >>> :set -XDeriveGeneric
4141
@@ -71,11 +71,11 @@ import Data.Swagger.Internal.Schema.Validation
7171-- generally fails for @null@ JSON:
7272--
7373-- >>> validateToJSON (Nothing :: Maybe String)
74−-- ["expected JSON value of type SwaggerString"]
74+-- ["expected JSON value of type OpenApiString"]
7575-- >>> validateToJSON ([Just "hello", Nothing] :: [Maybe String])
76−-- ["expected JSON value of type SwaggerString"]
76+-- ["expected JSON value of type OpenApiString"]
7777-- >>> validateToJSON (123, Nothing :: Maybe String)
78−-- ["expected JSON value of type SwaggerString"]
78+-- ["expected JSON value of type OpenApiString"]
7979--
8080-- However, when @'Maybe' a@ is a type of a record field,
8181-- validation takes @'required'@ property of the @'Schema'@
src/Data/Swagger/SchemaOptions.hs → src/Data/OpenApi/SchemaOptions.hsrenamed+2−2
@@ -1,11 +1,11 @@
11{-# LANGUAGE RecordWildCards #-}
22-- |
3−-- Module: Data.Swagger.SchemaOptions
3+-- Module: Data.OpenApi.SchemaOptions
44-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
55-- Stability: experimental
66--
77-- Generic deriving options for @'ToParamSchema'@ and @'ToSchema'@.
8−module Data.Swagger.SchemaOptions where
8+module Data.OpenApi.SchemaOptions where
99
1010import qualified Data.Aeson.Types as Aeson
1111
stack.yaml+1−1
@@ -1,4 +1,4 @@
1−resolver: lts-15.1
1+resolver: lts-16.31
22packages:
33- '.'
44extra-deps:
test/Data/Swagger/CommonTestTypes.hs → test/Data/OpenApi/CommonTestTypes.hsrenamed+125−2
@@ -2,7 +2,7 @@
22{-# LANGUAGE QuasiQuotes #-}
33{-# LANGUAGE ScopedTypeVariables #-}
44
5−module Data.Swagger.CommonTestTypes where
5+module Data.OpenApi.CommonTestTypes where
66
77import Prelude ()
88import Prelude.Compat
@@ -18,7 +18,7 @@ import qualified Data.Text as Text
1818import Data.Word
1919import GHC.Generics
2020
21−import Data.Swagger
21+import Data.OpenApi
2222
2323-- ========================================================================
2424-- Unit type
@@ -863,6 +863,129 @@ singleMaybeFieldSchemaJSON = [aesonQQ|
863863}
864864|]
865865
866+-- ========================================================================
867+-- Natural Language (single field data with recursive fields)
868+-- ========================================================================
869+
870+data Predicate
871+ = PredicateNoun Noun
872+ | PredicateOmitted Omitted
873+ deriving (Eq, Ord, Read, Show, Generic)
874+instance ToJSON Predicate
875+instance ToSchema Predicate
876+
877+data Noun
878+ = Noun
879+ { nounSurf :: LangWord
880+ , nounModify :: [Modifier]
881+ }
882+ deriving (Eq, Ord, Read, Show, Generic)
883+instance ToJSON Noun
884+instance ToSchema Noun
885+
886+data LangWord
887+ = LangWord
888+ { langWordSurf :: String
889+ , langWordBase :: String
890+ }
891+ deriving (Eq, Ord, Read, Show, Generic)
892+instance ToJSON LangWord
893+instance ToSchema LangWord
894+
895+data Modifier
896+ = ModifierNoun Noun
897+ | ModifierOmitted Omitted
898+ deriving (Eq, Ord, Read, Show, Generic)
899+instance ToJSON Modifier
900+instance ToSchema Modifier
901+
902+newtype Omitted
903+ = Omitted
904+ { omittedModify :: [Modifier]
905+ }
906+ deriving (Eq, Ord, Read, Show, Generic)
907+instance ToJSON Omitted
908+instance ToSchema Omitted
909+
910+predicateSchemaDeclareJSON :: Value
911+predicateSchemaDeclareJSON = [aesonQQ|
912+[
913+ {
914+ "Predicate": {
915+ "oneOf": [
916+ {
917+ "properties": {
918+ "contents": { "$ref": "#/components/schemas/Noun" },
919+ "tag": { "enum": ["PredicateNoun"], "type": "string" }
920+ },
921+ "required": ["tag", "contents"],
922+ "type": "object"
923+ },
924+ {
925+ "properties": {
926+ "contents": { "$ref": "#/components/schemas/Omitted" },
927+ "tag": { "enum": ["PredicateOmitted"], "type": "string" }
928+ },
929+ "required": ["tag", "contents"],
930+ "type": "object"
931+ }
932+ ],
933+ "type": "object"
934+ },
935+ "Noun": {
936+ "properties": {
937+ "nounModify": {
938+ "items": { "$ref": "#/components/schemas/Modifier" },
939+ "type": "array"
940+ },
941+ "nounSurf": { "$ref": "#/components/schemas/LangWord" }
942+ },
943+ "required": ["nounSurf", "nounModify"],
944+ "type": "object"
945+ },
946+ "LangWord": {
947+ "properties": {
948+ "langWordBase": { "type": "string" },
949+ "langWordSurf": { "type": "string" }
950+ },
951+ "required": ["langWordSurf", "langWordBase"],
952+ "type": "object"
953+ },
954+ "Modifier": {
955+ "oneOf": [
956+ {
957+ "properties": {
958+ "contents": { "$ref": "#/components/schemas/Noun" },
959+ "tag": { "enum": ["ModifierNoun"], "type": "string" }
960+ },
961+ "required": ["tag", "contents"],
962+ "type": "object"
963+ },
964+ {
965+ "properties": {
966+ "contents": { "$ref": "#/components/schemas/Omitted" },
967+ "tag": { "enum": ["ModifierOmitted"], "type": "string" }
968+ },
969+ "required": ["tag", "contents"],
970+ "type": "object"
971+ }
972+ ],
973+ "type": "object"
974+ },
975+ "Omitted": {
976+ "properties": {
977+ "omittedModify": {
978+ "items": { "$ref": "#/components/schemas/Modifier" },
979+ "type": "array"
980+ }
981+ },
982+ "required": ["omittedModify"],
983+ "type": "object"
984+ }
985+ },
986+ { "$ref": "#/components/schemas/Predicate" }
987+]
988+|]
866989
867990-- ========================================================================
868991-- TimeOfDay
test/Data/Swagger/ParamSchemaSpec.hs → test/Data/OpenApi/ParamSchemaSpec.hsrenamed+4−4
@@ -4,7 +4,7 @@
44{-# LANGUAGE TemplateHaskell #-}
55{-# LANGUAGE QuasiQuotes #-}
66{-# LANGUAGE OverloadedStrings #-}
7−module Data.Swagger.ParamSchemaSpec where
7+module Data.OpenApi.ParamSchemaSpec where
88
99import Data.Aeson
1010import Data.Aeson.QQ.Simple
@@ -12,9 +12,9 @@ import Data.Char
1212import Data.Proxy
1313import GHC.Generics
1414
15−import Data.Swagger
15+import Data.OpenApi
1616
17−import Data.Swagger.CommonTestTypes
17+import Data.OpenApi.CommonTestTypes
1818import SpecCommon
1919import Test.Hspec
2020import Data.Time.LocalTime
@@ -22,7 +22,7 @@ import Data.Time.LocalTime
2222import qualified Data.HashMap.Strict as HM
2323
2424checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec
25−checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema) <=> js
25+checkToParamSchema proxy js = (toParamSchema proxy :: Schema) <=> js
2626
2727spec :: Spec
2828spec = do
test/Data/Swagger/Schema/GeneratorSpec.hs → test/Data/OpenApi/Schema/GeneratorSpec.hsrenamed+7−7
@@ -1,13 +1,13 @@
11{-# LANGUAGE OverloadedLists #-}
22{-# LANGUAGE OverloadedStrings #-}
33{-# LANGUAGE PackageImports #-}
4−module Data.Swagger.Schema.GeneratorSpec where
4+module Data.OpenApi.Schema.GeneratorSpec where
55
66import Prelude ()
77import Prelude.Compat
88
9−import Data.Swagger
10−import Data.Swagger.Schema.Generator
9+import Data.OpenApi
10+import Data.OpenApi.Schema.Generator
1111
1212import Control.Lens.Operators
1313import Data.Aeson
@@ -103,7 +103,7 @@ instance FromJSON WrongType where
103103instance ToSchema WrongType where
104104 declareNamedSchema _ = return . NamedSchema (Just "WrongType") $
105105 mempty
106− & type_ ?~ SwaggerObject
106+ & type_ ?~ OpenApiObject
107107
108108
109109data MissingRequired = MissingRequired
@@ -123,7 +123,7 @@ instance ToSchema MissingRequired where
123123 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)
124124 return . NamedSchema (Just "MissingRequired") $
125125 mempty
126− & type_ ?~ SwaggerObject
126+ & type_ ?~ OpenApiObject
127127 & properties .~ [("propA", stringSchema)
128128 ,("propB", boolSchema)
129129 ]
@@ -145,7 +145,7 @@ instance ToSchema MissingProperty where
145145 stringSchema <- declareSchemaRef (Proxy :: Proxy String)
146146 return . NamedSchema (Just "MissingProperty") $
147147 mempty
148− & type_ ?~ SwaggerObject
148+ & type_ ?~ OpenApiObject
149149 & properties .~ [("propC", stringSchema)]
150150 & required .~ ["propC"]
151151
@@ -163,6 +163,6 @@ instance ToSchema WrongPropType where
163163 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)
164164 return . NamedSchema (Just "WrongPropType") $
165165 mempty
166− & type_ ?~ SwaggerObject
166+ & type_ ?~ OpenApiObject
167167 & properties .~ [("propE", boolSchema)]
168168 & required .~ ["propE"]
test/Data/Swagger/Schema/ValidationSpec.hs → test/Data/OpenApi/Schema/ValidationSpec.hsrenamed+27−10
@@ -1,13 +1,18 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE DeriveGeneric #-}
23{-# LANGUAGE PackageImports #-}
34{-# LANGUAGE RecordWildCards #-}
45{-# LANGUAGE ScopedTypeVariables #-}
56{-# OPTIONS_GHC -fno-warn-orphans #-}
6−module Data.Swagger.Schema.ValidationSpec where
7+module Data.OpenApi.Schema.ValidationSpec where
78
89import Control.Applicative
910import Control.Lens ((&), (.~), (?~))
1011import Data.Aeson
12+#if MIN_VERSION_aeson(2,0,0)
13+import qualified Data.Aeson.Key as Key
14+import qualified Data.Aeson.KeyMap as KeyMap
15+#endif
1116import Data.Aeson.Types
1217import Data.Hashable (Hashable)
1318import Data.HashMap.Strict (HashMap)
@@ -28,8 +33,9 @@ import Data.Version (Version)
2833import Data.Word
2934import GHC.Generics
3035
31−import Data.Swagger
32−import Data.Swagger.Declare
36+import Data.OpenApi
37+import Data.OpenApi.Declare
38+import Data.OpenApi.Aeson.Compat (stringToKey)
3339
3440import Test.Hspec
3541import Test.Hspec.QuickCheck
@@ -124,9 +130,9 @@ instance Arbitrary Person where
124130
125131invalidPersonToJSON :: Person -> Value
126132invalidPersonToJSON Person{..} = object
127− [ T.pack "personName" .= toJSON name
128− , T.pack "personPhone" .= toJSON phone
129− , T.pack "personEmail" .= toJSON email
133+ [ stringToKey "personName" .= toJSON name
134+ , stringToKey "personPhone" .= toJSON phone
135+ , stringToKey "personEmail" .= toJSON email
130136 ]
131137
132138-- ========================================================================
@@ -190,7 +196,7 @@ instance Arbitrary MyRoseTree where
190196data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic)
191197
192198instance ToSchema Light where
193− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { Data.Swagger.sumEncoding = ObjectWithSingleField }
199+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = ObjectWithSingleField }
194200
195201instance ToJSON Light where
196202 toJSON = genericToJSON defaultOptions { Data.Aeson.Types.sumEncoding = ObjectWithSingleField }
@@ -215,7 +221,7 @@ instance ToJSON LightTaggedObject where
215221
216222instance ToSchema LightTaggedObject where
217223 declareNamedSchema _ =
218− genericDeclareNamedSchema defaultSchemaOptions { Data.Swagger.sumEncoding = defaultTaggedObject } (Proxy :: Proxy Light)
224+ genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = defaultTaggedObject } (Proxy :: Proxy Light)
219225
220226instance Arbitrary LightTaggedObject where
221227 arbitrary = LightTaggedObject <$> arbitrary
@@ -228,7 +234,7 @@ instance ToJSON LightUntaggedValue where
228234
229235instance ToSchema LightUntaggedValue where
230236 declareNamedSchema _ =
231− genericDeclareNamedSchema defaultSchemaOptions { Data.Swagger.sumEncoding = UntaggedValue } (Proxy :: Proxy Light)
237+ genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = UntaggedValue } (Proxy :: Proxy Light)
232238
233239instance Arbitrary LightUntaggedValue where
234240 arbitrary = LightUntaggedValue <$> arbitrary
@@ -277,7 +283,7 @@ instance ToJSON FreeForm where
277283
278284instance ToSchema FreeForm where
279285 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
280− & type_ ?~ SwaggerObject
286+ & type_ ?~ OpenApiObject
281287 & additionalProperties ?~ AdditionalPropertiesAllowed True
282288
283289instance Arbitrary FreeForm where
@@ -295,6 +301,8 @@ instance Eq ZonedTime where
295301-- Arbitrary instance for Data.Aeson.Value
296302-- ========================================================================
297303
304+-- These instances were introduces in aeson upstream in 2.0.3
305+#if !MIN_VERSION_aeson(2,0,3)
298306instance Arbitrary Value where
299307 -- Weights are almost random
300308 -- Uniform oneof tends not to build complex objects cause of recursive call.
@@ -305,3 +313,12 @@ instance Arbitrary Value where
305313 , (3, Number <$> arbitrary)
306314 , (3, Bool <$> arbitrary)
307315 , (1, return Null) ]
316+
317+#if MIN_VERSION_aeson(2,0,0)
318+instance Arbitrary v => Arbitrary (KeyMap.KeyMap v) where
319+ arbitrary = KeyMap.fromList <$> arbitrary
320+
321+instance Arbitrary Key.Key where
322+ arbitrary = Key.fromText <$> arbitrary
323+#endif
324+#endif
test/Data/Swagger/SchemaSpec.hs → test/Data/OpenApi/SchemaSpec.hsrenamed+8−4
@@ -2,7 +2,7 @@
22{-# LANGUAGE ScopedTypeVariables #-}
33{-# LANGUAGE TemplateHaskell #-}
44{-# LANGUAGE QuasiQuotes #-}
5−module Data.Swagger.SchemaSpec where
5+module Data.OpenApi.SchemaSpec where
66
77import Prelude ()
88import Prelude.Compat
@@ -14,10 +14,10 @@ import Data.Proxy
1414import Data.Set (Set)
1515import qualified Data.Text as Text
1616
17−import Data.Swagger
18−import Data.Swagger.Declare
17+import Data.OpenApi
18+import Data.OpenApi.Declare
1919
20−import Data.Swagger.CommonTestTypes
20+import Data.OpenApi.CommonTestTypes
2121import SpecCommon
2222import Test.Hspec
2323
@@ -59,6 +59,9 @@ checkInlinedRecSchema proxy js = inlineNonRecursiveSchemas defs s <=> js
5959 where
6060 (defs, s) = runDeclare (declareSchema proxy) mempty
6161
62+checkToSchemaDeclare :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
63+checkToSchemaDeclare proxy js = runDeclare (declareSchemaRef proxy) mempty <=> js
64+
6265spec :: Spec
6366spec = do
6467 describe "Generic ToSchema" $ do
@@ -78,6 +81,7 @@ spec = do
7881 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON
7982 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON
8083 context "SingleMaybeField (unary record with Maybe)" $ checkToSchema (Proxy :: Proxy SingleMaybeField) singleMaybeFieldSchemaJSON
84+ context "Natural Language (single field data with recursive fields)" $ checkToSchemaDeclare (Proxy :: Proxy Predicate) predicateSchemaDeclareJSON
8185 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON
8286 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
8387 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
test/Data/SwaggerSpec.hs → test/Data/OpenApiSpec.hsrenamed+52−36
@@ -2,7 +2,7 @@
22{-# LANGUAGE OverloadedStrings #-}
33{-# LANGUAGE ScopedTypeVariables #-}
44{-# LANGUAGE QuasiQuotes #-}
5−module Data.SwaggerSpec where
5+module Data.OpenApiSpec where
66
77import Prelude ()
88import Prelude.Compat
@@ -15,7 +15,7 @@ import Data.HashMap.Strict (HashMap)
1515import qualified Data.HashSet.InsOrd as InsOrdHS
1616import Data.Text (Text)
1717
18−import Data.Swagger
18+import Data.OpenApi
1919import SpecCommon
2020import Test.Hspec hiding (example)
2121
@@ -42,9 +42,13 @@ spec = do
4242 context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
4343 context "PetStore Example" $ do
4444 it "decodes successfully" $ do
45− fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: Swagger) -> True; _ -> False)
45+ fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)
4646 it "roundtrips: fmap toJSON . fromJSON" $ do
47− (toJSON :: Swagger -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON
47+ (toJSON :: OpenApi -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON
48+ context "Security schemes" $ do
49+ it "merged correctly" $ do
50+ let merged = oAuth2SecurityDefinitionsReadOpenApi <> oAuth2SecurityDefinitionsWriteOpenApi
51+ merged `shouldBe` oAuth2SecurityDefinitionsOpenApi
4852
4953main :: IO ()
5054main = hspec spec
@@ -132,15 +136,15 @@ operationExample = mempty
132136 & description ?~ "ID of pet that needs to be updated"
133137 & required ?~ True
134138 & in_ .~ ParamPath
135− & schema ?~ Inline (mempty & type_ ?~ SwaggerString))]
139+ & schema ?~ Inline (mempty & type_ ?~ OpenApiString))]
136140 & requestBody ?~ Inline (
137141 mempty & content . at "application/x-www-form-urlencoded" ?~ (mempty & schema ?~ (Inline (mempty
138142 & properties . at "petId" ?~ Inline (mempty
139143 & description ?~ "Updated name of the pet"
140− & type_ ?~ SwaggerString)
144+ & type_ ?~ OpenApiString)
141145 & properties . at "status" ?~ Inline (mempty
142146 & description ?~ "Updated status of the pet"
143− & type_ ?~ SwaggerString)))))
147+ & type_ ?~ OpenApiString)))))
144148 & at 200 ?~ "Pet updated."
145149 & at 405 ?~ "Invalid input"
146150 & security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]
@@ -208,7 +212,7 @@ operationExampleJSON = [aesonQQ|
208212
209213schemaPrimitiveExample :: Schema
210214schemaPrimitiveExample = mempty
211− & type_ ?~ SwaggerString
215+ & type_ ?~ OpenApiString
212216 & format ?~ "email"
213217
214218schemaPrimitiveExampleJSON :: Value
@@ -221,14 +225,14 @@ schemaPrimitiveExampleJSON = [aesonQQ|
221225
222226schemaSimpleModelExample :: Schema
223227schemaSimpleModelExample = mempty
224− & type_ ?~ SwaggerObject
228+ & type_ ?~ OpenApiObject
225229 & required .~ [ "name" ]
226230 & properties .~
227− [ ("name", Inline (mempty & type_ ?~ SwaggerString))
231+ [ ("name", Inline (mempty & type_ ?~ OpenApiString))
228232 , ("address", Ref (Reference "Address"))
229233 , ("age", Inline $ mempty
230234 & minimum_ ?~ 0
231− & type_ ?~ SwaggerInteger
235+ & type_ ?~ OpenApiInteger
232236 & format ?~ "int32" ) ]
233237
234238schemaSimpleModelExampleJSON :: Value
@@ -253,8 +257,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|
253257
254258schemaModelDictExample :: Schema
255259schemaModelDictExample = mempty
256− & type_ ?~ SwaggerObject
257− & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ SwaggerString))
260+ & type_ ?~ OpenApiObject
261+ & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ OpenApiString))
258262
259263schemaModelDictExampleJSON :: Value
260264schemaModelDictExampleJSON = [aesonQQ|
@@ -268,7 +272,7 @@ schemaModelDictExampleJSON = [aesonQQ|
268272
269273schemaAdditionalExample :: Schema
270274schemaAdditionalExample = mempty
271− & type_ ?~ SwaggerObject
275+ & type_ ?~ OpenApiObject
272276 & additionalProperties ?~ AdditionalPropertiesAllowed True
273277
274278schemaAdditionalExampleJSON :: Value
@@ -281,13 +285,13 @@ schemaAdditionalExampleJSON = [aesonQQ|
281285
282286schemaWithExampleExample :: Schema
283287schemaWithExampleExample = mempty
284− & type_ ?~ SwaggerObject
288+ & type_ ?~ OpenApiObject
285289 & properties .~
286290 [ ("id", Inline $ mempty
287− & type_ ?~ SwaggerInteger
291+ & type_ ?~ OpenApiInteger
288292 & format ?~ "int64" )
289293 , ("name", Inline $ mempty
290− & type_ ?~ SwaggerString) ]
294+ & type_ ?~ OpenApiString) ]
291295 & required .~ [ "name" ]
292296 & example ?~ [aesonQQ|
293297 {
@@ -326,19 +330,19 @@ schemaWithExampleExampleJSON = [aesonQQ|
326330definitionsExample :: HashMap Text Schema
327331definitionsExample =
328332 [ ("Category", mempty
329− & type_ ?~ SwaggerObject
333+ & type_ ?~ OpenApiObject
330334 & properties .~
331335 [ ("id", Inline $ mempty
332− & type_ ?~ SwaggerInteger
336+ & type_ ?~ OpenApiInteger
333337 & format ?~ "int64")
334− , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] )
338+ , ("name", Inline (mempty & type_ ?~ OpenApiString)) ] )
335339 , ("Tag", mempty
336− & type_ ?~ SwaggerObject
340+ & type_ ?~ OpenApiObject
337341 & properties .~
338342 [ ("id", Inline $ mempty
339− & type_ ?~ SwaggerInteger
343+ & type_ ?~ OpenApiInteger
340344 & format ?~ "int64")
341− , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] ) ]
345+ , ("name", Inline (mempty & type_ ?~ OpenApiString)) ] ) ]
342346
343347definitionsExampleJSON :: Value
344348definitionsExampleJSON = [aesonQQ|
@@ -382,7 +386,7 @@ paramsDefinitionExample =
382386 & required ?~ True
383387 & in_ .~ ParamQuery
384388 & schema ?~ Inline (mempty
385− & type_ ?~ SwaggerInteger
389+ & type_ ?~ OpenApiInteger
386390 & format ?~ "int32" ))
387391 , ("limitParam", mempty
388392 & name .~ "limit"
@@ -390,7 +394,7 @@ paramsDefinitionExample =
390394 & required ?~ True
391395 & in_ .~ ParamQuery
392396 & schema ?~ Inline (mempty
393− & type_ ?~ SwaggerInteger
397+ & type_ ?~ OpenApiInteger
394398 & format ?~ "int32" )) ]
395399
396400paramsDefinitionExampleJSON :: Value
@@ -441,7 +445,7 @@ responsesDefinitionExampleJSON = [aesonQQ|
441445|]
442446
443447-- =======================================================================
444−-- Responses Definition object
448+-- Security Definition object
445449-- =======================================================================
446450
447451securityDefinitionsExample :: SecurityDefinitions
@@ -527,11 +531,23 @@ oAuth2SecurityDefinitionsExampleJSON = [aesonQQ|
527531}
528532|]
529533
534+oAuth2SecurityDefinitionsReadOpenApi :: OpenApi
535+oAuth2SecurityDefinitionsReadOpenApi =
536+ mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsReadExample
537+
538+oAuth2SecurityDefinitionsWriteOpenApi :: OpenApi
539+oAuth2SecurityDefinitionsWriteOpenApi =
540+ mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsWriteExample
541+
542+oAuth2SecurityDefinitionsOpenApi :: OpenApi
543+oAuth2SecurityDefinitionsOpenApi =
544+ mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsExample
545+
530546-- =======================================================================
531547-- Swagger object
532548-- =======================================================================
533549
534−emptyPathsFieldExample :: Swagger
550+emptyPathsFieldExample :: OpenApi
535551emptyPathsFieldExample = mempty
536552
537553emptyPathsFieldExampleJSON :: Value
@@ -544,7 +560,7 @@ emptyPathsFieldExampleJSON = [aesonQQ|
544560}
545561|]
546562
547−swaggerExample :: Swagger
563+swaggerExample :: OpenApi
548564swaggerExample = mempty
549565 -- & basePath ?~ "/"
550566 -- & schemes ?~ [Http]
@@ -559,7 +575,7 @@ swaggerExample = mempty
559575 & description .~ "OK"
560576 & content . at "application/json" ?~ (mempty
561577 & schema ?~ Inline (mempty
562− & type_ ?~ SwaggerObject
578+ & type_ ?~ OpenApiObject
563579 & example ?~ [aesonQQ|
564580 {
565581 "created": 100,
@@ -568,9 +584,9 @@ swaggerExample = mempty
568584 & description ?~ "This is some real Todo right here"
569585 & properties .~
570586 [ ("created", Inline $ mempty
571− & type_ ?~ SwaggerInteger
587+ & type_ ?~ OpenApiInteger
572588 & format ?~ "int32")
573− , ("description", Inline (mempty & type_ ?~ SwaggerString))])))
589+ , ("description", Inline (mempty & type_ ?~ OpenApiString))])))
574590 & parameters .~
575591 [ Inline $ mempty
576592 & required ?~ True
@@ -578,7 +594,7 @@ swaggerExample = mempty
578594 & description ?~ "TodoId param"
579595 & in_ .~ ParamPath
580596 & schema ?~ Inline (mempty
581− & type_ ?~ SwaggerString ) ]
597+ & type_ ?~ OpenApiString ) ]
582598 & tags .~ InsOrdHS.fromList [ "todo" ] ))
583599
584600swaggerExampleJSON :: Value
@@ -917,14 +933,14 @@ petstoreExampleJSON = [aesonQQ|
917933
918934compositionSchemaExample :: Schema
919935compositionSchemaExample = mempty
920− & type_ ?~ SwaggerObject
921− & Data.Swagger.allOf ?~ [
936+ & type_ ?~ OpenApiObject
937+ & Data.OpenApi.allOf ?~ [
922938 Ref (Reference "Other")
923939 , Inline (mempty
924− & type_ ?~ SwaggerObject
940+ & type_ ?~ OpenApiObject
925941 & properties .~
926942 [ ("greet", Inline $ mempty
927− & type_ ?~ SwaggerString) ])
943+ & type_ ?~ OpenApiString) ])
928944 ]
929945
930946compositionSchemaExampleJSON :: Value
test/SpecCommon.hs−8
@@ -8,14 +8,6 @@ import qualified Data.Vector as Vector
88
99import Test.Hspec
1010
11−isSubJSON :: Value -> Value -> Bool
12−isSubJSON Null _ = True
13−isSubJSON (Object x) (Object y) = HashMap.keys x == HashMap.keys i && F.and i
14− where
15− i = HashMap.intersectionWith isSubJSON x y
16−isSubJSON (Array xs) (Array ys) = Vector.length xs == Vector.length ys && F.and (Vector.zipWith isSubJSON xs ys)
17−isSubJSON x y = x == y
18−
1911(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec
2012x <=> js = do
2113 it "encodes correctly" $ do