git.iko.soy/typeable/openapi3
on master help sign in
36 files changed+2974−1998
since splitsnapshots
unifiedsplit
.github/workflows/haskell-ci.yml+243 .travis.yml−155 CHANGELOG.md+47 README.md+13−11 cabal.haskell-ci+11 cabal.project+2 examples/hackage.hs+16−20 swagger2.cabal → openapi3.cabal+65−57 src/Data/Swagger.hs → src/Data/OpenApi.hs+183−91 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+415−391 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+77−53 src/Data/Swagger/Internal/Schema.hs → src/Data/OpenApi/Internal/Schema.hs+446−172 src/Data/Swagger/Internal/Schema/Validation.hs → src/Data/OpenApi/Internal/Schema/Validation.hs+119−98 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/OpenApi/Lens.hs+166 src/Data/Swagger/Operation.hs → src/Data/OpenApi/Operation.hs+140−31 src/Data/OpenApi/Optics.hs+328 src/Data/Swagger/ParamSchema.hs → src/Data/OpenApi/ParamSchema.hs+7−7 src/Data/Swagger/Schema.hs → src/Data/OpenApi/Schema.hs+4−13 src/Data/Swagger/Schema/Generator.hs → src/Data/OpenApi/Schema/Generator.hs+23−19 src/Data/Swagger/Schema/Validation.hs → src/Data/OpenApi/Schema/Validation.hs+7−7 src/Data/Swagger/SchemaOptions.hs → src/Data/OpenApi/SchemaOptions.hs+7−3 src/Data/Swagger/Lens.hs−180 src/Data/Swagger/Optics.hs−509 stack.yaml+1−1 test/Data/Swagger/CommonTestTypes.hs → test/Data/OpenApi/CommonTestTypes.hs+430−94 test/Data/Swagger/ParamSchemaSpec.hs → test/Data/OpenApi/ParamSchemaSpec.hs+4−5 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+56−9 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−155
@@ -1,155 +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
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.1
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.1","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− - compiler: ghc-8.2.2
52− 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.2.2","cabal-install-3.2"]}}
53− os: linux
54− - compiler: ghc-8.0.2
55− 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.0.2","cabal-install-3.2"]}}
56− os: linux
57−before_install:
58− - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
59− - WITHCOMPILER="-w $HC"
60− - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
61− - HCPKG="$HC-pkg"
62− - unset CC
63− - CABAL=/opt/ghc/bin/cabal
64− - CABALHOME=$HOME/.cabal
65− - export PATH="$CABALHOME/bin:$PATH"
66− - TOP=$(pwd)
67− - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
68− - echo $HCNUMVER
69− - CABAL="$CABAL -vnormal+nowrap"
70− - set -o pipefail
71− - TEST=--enable-tests
72− - BENCH=--enable-benchmarks
73− - HEADHACKAGE=false
74− - rm -f $CABALHOME/config
75− - |
76− echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
77− echo "remote-build-reporting: anonymous" >> $CABALHOME/config
78− echo "write-ghc-environment-files: always" >> $CABALHOME/config
79− echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
80− echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
81− echo "world-file: $CABALHOME/world" >> $CABALHOME/config
82− echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
83− echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
84− echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
85− echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
86− echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
87− echo "install-dirs user" >> $CABALHOME/config
88− echo " prefix: $CABALHOME" >> $CABALHOME/config
89− echo "repository hackage.haskell.org" >> $CABALHOME/config
90− echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
91−install:
92− - ${CABAL} --version
93− - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
94− - |
95− echo "program-default-options" >> $CABALHOME/config
96− echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
97− - cat $CABALHOME/config
98− - rm -fv cabal.project cabal.project.local cabal.project.freeze
99− - travis_retry ${CABAL} v2-update -v
100− # Generate cabal.project
101− - rm -rf cabal.project cabal.project.local cabal.project.freeze
102− - touch cabal.project
103− - |
104− echo "packages: ." >> cabal.project
105− - if [ $HCNUMVER -ge 80200 ] ; then echo 'package swagger2' >> cabal.project ; fi
106− - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
107− - |
108− - "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"
109− - cat cabal.project || true
110− - cat cabal.project.local || true
111− - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
112− - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}
113− - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
114− - rm cabal.project.freeze
115− - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all
116− - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all
117−script:
118− - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
119− # Packaging...
120− - ${CABAL} v2-sdist all
121− # Unpacking...
122− - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
123− - cd ${DISTDIR} || false
124− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
125− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
126− - PKGDIR_swagger2="$(find . -maxdepth 1 -type d -regex '.*/swagger2-[0-9.]*')"
127− # Generate cabal.project
128− - rm -rf cabal.project cabal.project.local cabal.project.freeze
129− - touch cabal.project
130− - |
131− echo "packages: ${PKGDIR_swagger2}" >> cabal.project
132− - if [ $HCNUMVER -ge 80200 ] ; then echo 'package swagger2' >> cabal.project ; fi
133− - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
134− - |
135− - "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"
136− - cat cabal.project || true
137− - cat cabal.project.local || true
138− # Building...
139− # this builds all libraries and executables (without tests/benchmarks)
140− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
141− # Building with tests and benchmarks...
142− # build & run tests, build benchmarks
143− - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all
144− # Testing...
145− - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all
146− # cabal check...
147− - (cd ${PKGDIR_swagger2} && ${CABAL} -vnormal check)
148− # haddock...
149− - if [ $HCNUMVER -ge 80400 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all ; fi
150− # Building without installed constraints for packages in global-db...
151− - rm -f cabal.project.local
152− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
153−
154−# REGENDATA ("0.10",["--branches","master","--haddock-jobs=>=8.4","--output",".travis.yml","swagger2.cabal"])
155−# 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+65−57
@@ -1,34 +1,34 @@
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
2323 , CHANGELOG.md
2424 , examples/*.hs
2525tested-with:
26− GHC ==8.0.2
27− || ==8.2.2
28− || ==8.4.4
26+ GHC ==8.4.4
2927 || ==8.6.5
30− || ==8.8.1
31− || ==8.10.1
28+ || ==8.8.4
29+ || ==8.10.7
30+ || ==9.0.2
31+ || ==9.2.2
3232
3333custom-setup
3434 setup-depends:
@@ -37,54 +37,56 @@ custom-setup
3737library
3838 hs-source-dirs: src
3939 exposed-modules:
40− Data.Swagger
41− Data.Swagger.Declare
42− Data.Swagger.Lens
43− Data.Swagger.Operation
44− Data.Swagger.Optics
45− Data.Swagger.ParamSchema
46− Data.Swagger.Schema
47− Data.Swagger.Schema.Generator
48− Data.Swagger.Schema.Validation
49− 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
5050
5151 -- internal modules
52− Data.Swagger.Internal
53− Data.Swagger.Internal.Schema
54− Data.Swagger.Internal.Schema.Validation
55− Data.Swagger.Internal.ParamSchema
56− Data.Swagger.Internal.Utils
57− Data.Swagger.Internal.AesonUtils
58− 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
5961
6062 -- GHC boot libraries
6163 build-depends:
62− base >=4.9 && <4.15
63− , bytestring >=0.10.8.1 && <0.11
64− , containers >=0.5.7.1 && <0.7
65− , template-haskell >=2.11.1.0 && <2.17
66− , time >=1.6.0.1 && <1.10
67− , transformers >=0.5.2.0 && <0.6
64+ base >=4.11.1.0 && <4.17
65+ , bytestring >=0.10.8.2 && <0.12
66+ , containers >=0.5.11.0 && <0.7
67+ , template-haskell >=2.13.0.0 && <2.19
68+ , time >=1.8.0.2 && <1.14
69+ , transformers >=0.5.5.0 && <0.6
6870
6971 build-depends:
7072 mtl >=2.2.2 && <2.3
71− , text >=1.2.3.0 && <1.3
73+ , text >=1.2.3.1 && <2.1
7274
7375 -- other dependencies
7476 build-depends:
75− base-compat-batteries >=0.11.1 && <0.12
76− , 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
7779 , aeson-pretty >=0.8.7 && <0.9
7880 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
7981 , cookie >=0.4.3 && <0.5
8082 , generics-sop >=0.5.1.0 && <0.6
81− , hashable >=1.2.7.0 && <1.4
83+ , hashable >=1.2.7.0 && <1.5
8284 , http-media >=0.8.0.0 && <0.9
8385 , insert-ordered-containers >=0.2.3 && <0.3
84− , lens >=4.16.1 && <4.20
86+ , lens >=4.16.1 && <5.2
8587 , network >=2.6.3.5 && <3.2
86− , optics-core >=0.2 && <0.4
87− , optics-th >=0.2 && <0.4
88+ , optics-core >=0.2 && <0.5
89+ , optics-th >=0.2 && <0.5
8890 , scientific >=0.3.6.2 && <0.4
8991 , unordered-containers >=0.2.9.0 && <0.3
9092 , uuid-types >=1.0.3 && <1.1
@@ -102,7 +104,7 @@ test-suite spec
102104 -- We need aeson's toEncoding for doctests too
103105 build-depends:
104106 base
105− , swagger2
107+ , QuickCheck
106108 , aeson
107109 , base-compat-batteries
108110 , bytestring
@@ -111,32 +113,32 @@ test-suite spec
111113 , insert-ordered-containers
112114 , lens
113115 , mtl
116+ , openapi3
114117 , template-haskell
115118 , text
116119 , time
117120 , unordered-containers
118121 , vector
119− , QuickCheck
120122
121123 -- test-suite only dependencies
122124 build-depends:
123− hspec >=2.5.5 && <2.8
125+ hspec >=2.5.5 && <2.10
124126 , HUnit >=1.6.0.0 && <1.7
125127 , quickcheck-instances >=0.3.19 && <0.14
126128 , utf8-string >=1.0.1.1 && <1.1
127129
128130 -- https://github.com/haskell/cabal/issues/3708
129131 build-tool-depends:
130− hspec-discover:hspec-discover >=2.5.5 && <2.8
132+ hspec-discover:hspec-discover >=2.5.5 && <2.10
131133
132134 other-modules:
133135 SpecCommon
134− Data.SwaggerSpec
135− Data.Swagger.CommonTestTypes
136− Data.Swagger.ParamSchemaSpec
137− Data.Swagger.SchemaSpec
138− Data.Swagger.Schema.ValidationSpec
139− 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
140142 default-language: Haskell2010
141143
142144test-suite doctests
@@ -147,6 +149,12 @@ test-suite doctests
147149 main-is: doctests.hs
148150 type: exitcode-stdio-1.0
149151
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+
150158source-repository head
151159 type: git
152− location: https://github.com/GetShopTV/swagger2.git
160+ location: https://github.com/biocad/openapi3.git
src/Data/Swagger.hs → src/Data/OpenApi.hsrenamed+183−91
@@ -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,10 +56,10 @@ module Data.Swagger (
5656 TagName,
5757
5858 -- ** Types and formats
59− SwaggerType(..),
59+ OpenApiType(..),
6060 Format,
6161 Definitions,
62− CollectionFormat(..),
62+ Style(..),
6363
6464 -- ** Parameters
6565 Param(..),
@@ -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(..),
@@ -86,10 +85,13 @@ module Data.Swagger (
8685 Responses(..),
8786 Response(..),
8887 HttpStatusCode,
88+ Link(..),
89+ Callback(..),
8990
9091 -- ** Security
9192 SecurityScheme(..),
9293 SecuritySchemeType(..),
94+ HttpSchemeType(..),
9395 SecurityDefinitions(..),
9496 SecurityRequirement(..),
9597
@@ -119,14 +121,14 @@ module Data.Swagger (
119121 URL(..),
120122) where
121123
122−import Data.Swagger.Lens
123−import Data.Swagger.Optics ()
124−import Data.Swagger.Operation
125−import Data.Swagger.ParamSchema
126−import Data.Swagger.Schema
127−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
128130
129−import Data.Swagger.Internal
131+import Data.OpenApi.Internal
130132
131133-- $setup
132134-- >>> import Control.Lens
@@ -134,6 +136,8 @@ import Data.Swagger.Internal
134136-- >>> import Data.Monoid
135137-- >>> import Data.Proxy
136138-- >>> import GHC.Generics
139+-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
140+-- >>> import Data.OpenApi.Internal.Utils
137141-- >>> :set -XDeriveGeneric
138142-- >>> :set -XOverloadedStrings
139143-- >>> :set -XOverloadedLists
@@ -150,8 +154,16 @@ import Data.Swagger.Internal
150154--
151155-- In this library you can use @'mempty'@ for a default/empty value. For instance:
152156--
153−-- >>> encode (mempty :: Swagger)
154−-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"}}"
157+-- >>> BSL.putStrLn $ encodePretty (mempty :: OpenApi)
158+-- {
159+-- "components": {},
160+-- "info": {
161+-- "title": "",
162+-- "version": ""
163+-- },
164+-- "openapi": "3.0.0",
165+-- "paths": {}
166+-- }
155167--
156168-- As you can see some spec properties (e.g. @"version"@) are there even when the spec is empty.
157169-- That is because these properties are actually required ones.
@@ -159,47 +171,87 @@ import Data.Swagger.Internal
159171-- You /should/ always override the default (empty) value for these properties,
160172-- although it is not strictly necessary:
161173--
162−-- >>> encode mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
163−-- "{\"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+-- }
164179--
165180-- You can merge two values using @'mappend'@ or its infix version @('<>')@:
166181--
167−-- >>> encode $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
168−-- "{\"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+
169188--
170189-- This can be useful for combining specifications of endpoints into a whole API specification:
171190--
172191-- @
173192-- \-\- /account subAPI specification
174−-- accountAPI :: Swagger
193+-- accountAPI :: OpenApi
175194--
176195-- \-\- /task subAPI specification
177−-- taskAPI :: Swagger
196+-- taskAPI :: OpenApi
178197--
179198-- \-\- while API specification is just a combination
180199-- \-\- of subAPIs' specifications
181−-- api :: Swagger
200+-- api :: OpenApi
182201-- api = accountAPI <> taskAPI
183202-- @
184203
185204-- $lens
186205--
187−-- 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".
188207--
189208-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
190209-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses
191210-- make it fairly simple to construct/modify any part of the specification:
192211--
193212-- >>> :{
194−-- encode $ (mempty :: Swagger)
195−-- & definitions .~ [ ("User", mempty & type_ ?~ SwaggerString) ]
213+-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
214+-- & components . schemas .~ [ ("User", mempty & type_ ?~ OpenApiString) ]
196215-- & paths .~
197216-- [ ("/user", mempty & get ?~ (mempty
198−-- & produces ?~ MimeList ["application/json"]
199−-- & at 200 ?~ ("OK" & _Inline.schema ?~ Ref (Reference "User"))
217+-- & at 200 ?~ ("OK" & _Inline.content.at "application/json" ?~ (mempty & schema ?~ Ref (Reference "User")))
200218-- & at 404 ?~ "User info not found")) ]
201219-- :}
202−-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"produces\":[\"application/json\"],\"responses\":{\"404\":{\"description\":\"User info not found\"},\"200\":{\"schema\":{\"$ref\":\"#/definitions/User\"},\"description\":\"OK\"}}}}},\"definitions\":{\"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+-- }
203255--
204256-- In the snippet above we declare an API with a single path @/user@. This path provides method @GET@
205257-- which produces @application/json@ output. It should respond with code @200@ and body specified
@@ -211,30 +263,34 @@ import Data.Swagger.Internal
211263-- common field is @'description'@. Many components of a Swagger specification
212264-- can have descriptions, and you can use the same name for them:
213265--
214−-- >>> encode $ (mempty :: Response) & description .~ "No content"
215−-- "{\"description\":\"No content\"}"
266+-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & description .~ "No content"
267+-- {
268+-- "description": "No content"
269+-- }
216270-- >>> :{
217−-- encode $ (mempty :: Schema)
218−-- & type_ ?~ SwaggerBoolean
271+-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)
272+-- & type_ ?~ OpenApiBoolean
219273-- & description ?~ "To be or not to be"
220274-- :}
221−-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"
222−--
223−-- @'ParamSchema'@ is basically the /base schema specification/ and many types contain it (see @'HasParamSchema'@).
224−-- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.
225−-- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:
226−--
227−-- >>> encode $ (mempty :: Header) & type_ ?~ SwaggerNumber
228−-- "{\"type\":\"number\"}"
275+-- {
276+-- "description": "To be or not to be",
277+-- "type": "boolean"
278+-- }
229279--
230280-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
231281-- have direct access to it via @'at' code@. Example:
232282--
233283-- >>> :{
234−-- encode $ (mempty :: Operation)
284+-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)
235285-- & at 404 ?~ "Not found"
236286-- :}
237−-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"
287+-- {
288+-- "responses": {
289+-- "404": {
290+-- "description": "Not found"
291+-- }
292+-- }
293+-- }
238294--
239295-- You might've noticed that @'type_'@ has an extra underscore in its name
240296-- compared to, say, @'description'@ field accessor.
@@ -250,7 +306,7 @@ import Data.Swagger.Internal
250306-- @'ParamSchema'@ and @'Schema'@ are the two core types for data model specification.
251307--
252308-- @'ParamSchema' t@ specifies all the common properties, available for every data schema.
253−-- 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'@).
254310--
255311-- @'Schema'@ is used for request and response bodies and allows specifying objects
256312-- with properties in addition to what @'ParamSchema'@ provides.
@@ -281,45 +337,81 @@ import Data.Swagger.Internal
281337-- >>> data Person = Person { name :: String, age :: Integer } deriving Generic
282338-- >>> instance ToJSON Person
283339-- >>> instance ToSchema Person
284−-- >>> encode (Person "David" 28)
285−-- "{\"age\":28,\"name\":\"David\"}"
286−-- >>> encode $ toSchema (Proxy :: Proxy Person)
287−-- "{\"required\":[\"name\",\"age\"],\"properties\":{\"name\":{\"type\":\"string\"},\"age\":{\"type\":\"integer\"}},\"type\":\"object\"}"
288−--
289−-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a
290−-- schema for basic enums like
291−--
292−-- >>> data SampleEnum = ChoiceOne | ChoiceTwo deriving Generic
293−-- >>> instance ToSchema SampleEnum
294−-- >>> instance ToJSON SampleEnum
295−--
296−-- and for sum types that have constructors with values
297−--
298−-- >>> data SampleSumType = ChoiceInt Int | ChoiceString String deriving Generic
299−-- >>> instance ToSchema SampleSumType
300−-- >>> instance ToJSON SampleSumType
301−--
302−-- we can not derive a valid schema for a mix of the above. The following will result in a type error
303−--
304−-- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic
305−-- >>> instance ToSchema BadMixedType
306−-- ...
307−-- ... error:
308−-- ... • Cannot derive Generic-based Swagger Schema for BadMixedType
309−-- ... BadMixedType is a mixed sum type (has both unit and non-unit constructors).
310−-- ... Swagger does not have a good representation for these types.
311−-- ... Use genericDeclareNamedSchemaUnrestricted if you want to derive schema
312−-- ... that matches aeson's Generic-based toJSON,
313−-- ... but that's not supported by some Swagger tools.
314−-- ...
315−-- ... In the instance declaration for ‘ToSchema BadMixedType’
316−--
317−-- We can use 'genericDeclareNamedSchemaUnrestricted' to try our best to represent this type as a Swagger Schema and match 'ToJSON':
318−--
319−-- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic
320−-- >>> instance ToSchema BadMixedType where declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
321−-- >>> instance ToJSON BadMixedType
322−--
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+-- }
323415
324416-- $manipulation
325417-- Sometimes you have to work with an imported or generated @'Swagger'@.
@@ -327,10 +419,10 @@ import Data.Swagger.Internal
327419-- for a type-level servant API.
328420--
329421-- Lenses and prisms can be used to manipulate such specification to add additional information, tags, extra responses, etc.
330−-- To facilitate common needs, @"Data.Swagger.Operation"@ module provides useful helpers.
422+-- To facilitate common needs, @"Data.OpenApi.Operation"@ module provides useful helpers.
331423
332424-- $validation
333425-- While @'ToParamSchema'@ and @'ToSchema'@ provide means to easily obtain schemas for Haskell types,
334426-- there is no static mechanism to ensure those instances correspond to the @'ToHttpApiData'@ or @'ToJSON'@ instances.
335427--
336−-- @"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+415−391
@@ -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,87 +14,91 @@
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
2121
22−import Control.Lens ((&), (.~), (?~))
2322import Control.Applicative
24−import Data.Aeson hiding (Encoding)
25−import qualified Data.Aeson.Types as JSON
26−import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
27−import Data.Hashable (Hashable)
28−import qualified Data.HashMap.Strict as HashMap
29−import Data.HashSet.InsOrd (InsOrdHashSet)
30−import Data.Map (Map)
31−import qualified Data.Map as Map
32−import Data.Monoid (Monoid (..))
33−import Data.Semigroup.Compat (Semigroup (..))
34−import Data.Scientific (Scientific)
35−import Data.String (IsString(..))
36−import Data.Text (Text)
37−import qualified Data.Text as Text
38−import GHC.Generics (Generic)
39−import Network.Socket (HostName, PortNumber)
40−import Network.HTTP.Media (MediaType)
41−import Text.Read (readMaybe)
23+import Control.Lens ((&), (.~), (?~))
24+import Data.Aeson hiding (Encoding)
25+#if MIN_VERSION_aeson(2,0,0)
26+import qualified Data.Aeson.KeyMap as KeyMap
27+#endif
28+import qualified Data.Aeson.Types as JSON
29+import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable,
30+ constrIndex, mkConstr, mkDataType)
31+import Data.Hashable (Hashable (..))
32+import qualified Data.HashMap.Strict as HashMap
33+import Data.HashSet.InsOrd (InsOrdHashSet)
34+import Data.Map (Map)
35+import qualified Data.Map as Map
36+import Data.Monoid (Monoid (..))
37+import Data.Scientific (Scientific)
38+import Data.Semigroup.Compat (Semigroup (..))
39+import Data.String (IsString (..))
40+import Data.Text (Text)
41+import qualified Data.Text as Text
42+import Data.Text.Encoding (encodeUtf8)
43+import GHC.Generics (Generic)
44+import Network.HTTP.Media (MediaType, mainType, parameters, parseAccept, subType, (//),
45+ (/:))
46+import Network.Socket (HostName, PortNumber)
47+import Text.Read (readMaybe)
4248
4349import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
4450import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
4551
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
4658import Generics.SOP.TH (deriveGeneric)
47−import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
48− ,sopSwaggerGenericToJSONWithOpts
49− ,sopSwaggerGenericParseJSON
50− ,HasSwaggerAesonOptions(..)
51− ,AesonDefaultValue(..)
52− ,mkSwaggerAesonOptions
53− ,saoAdditionalPairs
54− ,saoSubObject)
55−import Data.Swagger.Internal.Utils
56−import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
5759
5860-- $setup
5961-- >>> :seti -XDataKinds
6062-- >>> import Data.Aeson
63+-- >>> import Data.ByteString.Lazy.Char8 as BSL
64+-- >>> import Data.OpenApi.Internal.Utils
6165
6266-- | A list of definitions that can be used in references.
6367type Definitions = InsOrdHashMap Text
6468
6569-- | This is the root document object for the API specification.
66−data Swagger = Swagger
70+data OpenApi = OpenApi
6771 { -- | Provides metadata about the API.
6872 -- The metadata can be used by the clients if needed.
69− _swaggerInfo :: Info
73+ _openApiInfo :: Info
7074
7175 -- | An array of Server Objects, which provide connectivity information
7276 -- to a target server. If the servers property is not provided, or is an empty array,
7377 -- the default value would be a 'Server' object with a url value of @/@.
74− , _swaggerServers :: [Server]
78+ , _openApiServers :: [Server]
7579
7680 -- | The available paths and operations for the API.
77− , _swaggerPaths :: InsOrdHashMap FilePath PathItem
81+ , _openApiPaths :: InsOrdHashMap FilePath PathItem
7882
7983 -- | An element to hold various schemas for the specification.
80− , _swaggerComponents :: Components
84+ , _openApiComponents :: Components
8185
8286 -- | A declaration of which security mechanisms can be used across the API.
8387 -- The list of values includes alternative security requirement objects that can be used.
8488 -- Only one of the security requirement objects need to be satisfied to authorize a request.
8589 -- Individual operations can override this definition.
8690 -- To make security optional, an empty security requirement can be included in the array.
87− , _swaggerSecurity :: [SecurityRequirement]
91+ , _openApiSecurity :: [SecurityRequirement]
8892
8993 -- | A list of tags used by the specification with additional metadata.
9094 -- The order of the tags can be used to reflect on their order by the parsing tools.
9195 -- Not all tags that are used by the 'Operation' Object must be declared.
9296 -- The tags that are not declared MAY be organized randomly or based on the tools' logic.
9397 -- Each tag name in the list MUST be unique.
94− , _swaggerTags :: InsOrdHashSet Tag
98+ , _openApiTags :: InsOrdHashSet Tag
9599
96100 -- | Additional external documentation.
97− , _swaggerExternalDocs :: Maybe ExternalDocs
101+ , _openApiExternalDocs :: Maybe ExternalDocs
98102 } deriving (Eq, Show, Generic, Data, Typeable)
99103
100104-- | The object provides metadata about the API.
@@ -191,10 +195,10 @@ data Components = Components
191195 , _componentsParameters :: Definitions Param
192196 , _componentsExamples :: Definitions Example
193197 , _componentsRequestBodies :: Definitions RequestBody
194− , _componentsHeader :: Definitions Header
195− , _componentsSecuritySchemes :: Definitions SecurityScheme
196−-- , _componentsLinks
197−-- , _componentsCallbacks
198+ , _componentsHeaders :: Definitions Header
199+ , _componentsSecuritySchemes :: SecurityDefinitions
200+ , _componentsLinks :: Definitions Link
201+ , _componentsCallbacks :: Definitions Callback
198202 } deriving (Eq, Show, Generic, Data, Typeable)
199203
200204-- | Describes the operations available on a single path.
@@ -284,7 +288,11 @@ data Operation = Operation
284288 -- | The list of possible responses as they are returned from executing this operation.
285289 , _operationResponses :: Responses
286290
287− -- TODO callbacks
291+ -- | A map of possible out-of band callbacks related to the parent operation.
292+ -- The key is a unique identifier for the 'Callback' Object.
293+ -- Each value in the map is a 'Callback' Object that describes a request
294+ -- that may be initiated by the API provider and the expected responses.
295+ , _operationCallbacks :: InsOrdHashMap Text (Referenced Callback)
288296
289297 -- | Declares this operation to be deprecated.
290298 -- Usage of the declared operation should be refrained.
@@ -304,6 +312,22 @@ data Operation = Operation
304312 , _operationServers :: [Server]
305313 } deriving (Eq, Show, Generic, Data, Typeable)
306314
315+-- This instance should be in @http-media@.
316+instance Data MediaType where
317+ gunfold k z c = case constrIndex c of
318+ 1 -> k (k (k (z (\main sub params -> foldl (/:) (main // sub) (Map.toList params)))))
319+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MediaType."
320+
321+ toConstr _ = mediaTypeConstr
322+
323+ dataTypeOf _ = mediaTypeData
324+
325+mediaTypeConstr = mkConstr mediaTypeData "MediaType" [] Prefix
326+mediaTypeData = mkDataType "MediaType" [mediaTypeConstr]
327+
328+instance Hashable MediaType where
329+ hashWithSalt salt mt = salt `hashWithSalt` show mt
330+
307331-- | Describes a single request body.
308332data RequestBody = RequestBody
309333 { -- | A brief description of the request body. This could contain examples of use.
@@ -313,9 +337,11 @@ data RequestBody = RequestBody
313337 -- | The content of the request body.
314338 -- The key is a media type or media type range and the value describes it.
315339 -- For requests that match multiple keys, only the most specific key is applicable.
316− -- e.g. @text/plain@ overrides @text/*@
317− , _requestBodyContent :: InsOrdHashMap {-MediaType-} Text MediaTypeObject -- FIXME Data MediaType
340+ -- e.g. @text/plain@ overrides @text/\*@
341+ , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject
318342
343+ -- | Determines if the request body is required in the request.
344+ -- Defaults to 'False'.
319345 , _requestBodyRequired :: Maybe Bool
320346 } deriving (Eq, Show, Generic, Data, Typeable)
321347
@@ -338,6 +364,29 @@ data MediaTypeObject = MediaTypeObject
338364 , _mediaTypeObjectEncoding :: InsOrdHashMap Text Encoding
339365 } deriving (Eq, Show, Generic, Data, Typeable)
340366
367+-- | In order to support common ways of serializing simple parameters, a set of style values are defined.
368+data Style
369+ = StyleMatrix
370+ -- ^ Path-style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
371+ | StyleLabel
372+ -- ^ Label style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
373+ | StyleForm
374+ -- ^ Form style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
375+ -- This option replaces @collectionFormat@ with a @csv@ (when @explode@ is false) or @multi@
376+ -- (when explode is true) value from OpenAPI 2.0.
377+ | StyleSimple
378+ -- ^ Simple style parameters defined by [RFC6570](https://tools.ietf.org/html/rfc6570#section-3.2.7).
379+ -- This option replaces @collectionFormat@ with a @csv@ value from OpenAPI 2.0.
380+ | StyleSpaceDelimited
381+ -- ^ Space separated array values.
382+ -- This option replaces @collectionFormat@ equal to @ssv@ from OpenAPI 2.0.
383+ | StylePipeDelimited
384+ -- ^ Pipe separated array values.
385+ -- This option replaces @collectionFormat@ equal to @pipes@ from OpenAPI 2.0.
386+ | StyleDeepObject
387+ -- ^ Provides a simple way of rendering nested objects using form parameters.
388+ deriving (Eq, Show, Generic, Data, Typeable)
389+
341390data Encoding = Encoding
342391 { -- | The Content-Type for encoding a specific property.
343392 -- Default value depends on the property type: for @string@
@@ -345,8 +394,8 @@ data Encoding = Encoding
345394 -- for other primitive types – @text/plain@; for object - @application/json@;
346395 -- for array – the default is defined based on the inner type.
347396 -- The value can be a specific media type (e.g. @application/json@),
348− -- a wildcard media type (e.g. @image/*@), or a comma-separated list of the two types.
349− _encodingContentType :: Maybe Text
397+ -- a wildcard media type (e.g. @image/\*@), or a comma-separated list of the two types.
398+ _encodingContentType :: Maybe MediaType
350399
351400 -- | A map allowing additional information to be provided as headers,
352401 -- for example @Content-Disposition@. @Content-Type@ is described separately
@@ -355,11 +404,11 @@ data Encoding = Encoding
355404 , _encodingHeaders :: InsOrdHashMap Text (Referenced Header)
356405
357406 -- | Describes how a specific property value will be serialized depending on its type.
358− -- See Parameter Object for details on the style property.
407+ -- See 'Param' Object for details on the style property.
359408 -- The behavior follows the same values as query parameters, including default values.
360409 -- This property SHALL be ignored if the request body media type
361410 -- is not @application/x-www-form-urlencoded@.
362− , _encodingStyle :: Maybe Text -- TODO enum
411+ , _encodingStyle :: Maybe Style
363412
364413 -- | When this is true, property values of type @array@ or @object@ generate
365414 -- separate parameters for each value of the array,
@@ -385,18 +434,15 @@ mimeListConstr :: Constr
385434mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
386435
387436mimeListDataType :: DataType
388−mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
437+mimeListDataType = mkDataType "Data.OpenApi.MimeList" [mimeListConstr]
389438
390439instance Data MimeList where
391440 gunfold k z c = case constrIndex c of
392− 1 -> k (z (\xs -> MimeList (map fromString xs)))
441+ 1 -> k (z (MimeList . map fromString))
393442 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
394443 toConstr (MimeList _) = mimeListConstr
395444 dataTypeOf _ = mimeListDataType
396445
397−-- TODO style
398−-- TODO example
399−
400446-- | Describes a single operation parameter.
401447-- A unique parameter is defined by a combination of a name and location.
402448data Param = Param
@@ -406,7 +452,7 @@ data Param = Param
406452
407453 -- | A brief description of the parameter.
408454 -- This could contain examples of use.
409− -- GFM syntax can be used for rich text representation.
455+ -- CommonMark syntax MAY be used for rich text representation.
410456 , _paramDescription :: Maybe Text
411457
412458 -- | Determines whether this parameter is mandatory.
@@ -424,10 +470,49 @@ data Param = Param
424470 -- | Sets the ability to pass empty-valued parameters.
425471 -- This is valid only for 'ParamQuery' parameters and allows sending
426472 -- a parameter with an empty value. Default value is @false@.
427− , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
473+ , _paramAllowEmptyValue :: Maybe Bool
474+
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
428481
429482 -- | Parameter schema.
430483 , _paramSchema :: Maybe (Referenced Schema)
484+
485+ -- | Describes how the parameter value will be serialized depending
486+ -- on the type of the parameter value. Default values (based on value of '_paramIn'):
487+ -- for 'ParamQuery' - 'StyleForm'; for 'ParamPath' - 'StyleSimple'; for 'ParamHeader' - 'StyleSimple';
488+ -- for 'ParamCookie' - 'StyleForm'.
489+ , _paramStyle :: Maybe Style
490+
491+ -- | When this is true, parameter values of type @array@ or @object@
492+ -- generate separate parameters for each value of the array or key-value pair of the map.
493+ -- For other types of parameters this property has no effect.
494+ -- When style is @form@, the default value is true. For all other styles, the default value is false.
495+ , _paramExplode :: Maybe Bool
496+
497+ -- | Example of the parameter's potential value.
498+ -- The example SHOULD match the specified schema and encoding properties if present.
499+ -- The '_paramExample' field is mutually exclusive of the '_paramExamples' field.
500+ -- Furthermore, if referencing a schema that contains an example, the example value
501+ -- SHALL override the example provided by the schema. To represent examples of media types
502+ -- that cannot naturally be represented in JSON or YAML, a string value can contain
503+ -- the example with escaping where necessary.
504+ , _paramExample :: Maybe Value
505+
506+ -- | Examples of the parameter's potential value.
507+ -- Each example SHOULD contain a value in the correct format as specified
508+ -- in the parameter encoding. The '_paramExamples' field is mutually exclusive of the '_paramExample' field.
509+ -- Furthermore, if referencing a schema that contains an example,
510+ -- the examples value SHALL override the example provided by the schema.
511+ , _paramExamples :: InsOrdHashMap Text (Referenced Example)
512+
513+ -- TODO
514+ -- _paramContent :: InsOrdHashMap MediaType MediaTypeObject
515+ -- should be singleton. mutually exclusive with _paramSchema.
431516 } deriving (Eq, Show, Generic, Data, Typeable)
432517
433518data Example = Example
@@ -452,138 +537,64 @@ data Example = Example
452537 , _exampleExternalValue :: Maybe URL
453538 } deriving (Eq, Show, Generic, Typeable, Data)
454539
455−-- | Items for @'SwaggerArray'@ schemas.
540+data ExpressionOrValue
541+ = Expression Text
542+ | Value Value
543+ deriving (Eq, Show, Generic, Typeable, Data)
544+
545+-- | The Link object represents a possible design-time link for a response.
546+-- The presence of a link does not guarantee the caller's ability to successfully invoke it,
547+-- rather it provides a known relationship and traversal mechanism between responses and other operations.
548+data Link = Link
549+ { -- | A relative or absolute URI reference to an OAS operation.
550+ -- This field is mutually exclusive of the '_linkOperationId' field,
551+ -- and MUST point to an 'Operation' Object. Relative '_linkOperationRef'
552+ -- values MAY be used to locate an existing 'Operation' Object in the OpenAPI definition.
553+ _linkOperationRef :: Maybe Text
554+
555+ -- | The name of an /existing/, resolvable OAS operation, as defined with a unique
556+ -- '_operationOperationId'. This field is mutually exclusive of the '_linkOperationRef' field.
557+ , _linkOperationId :: Maybe Text
558+
559+ -- | A map representing parameters to pass to an operation as specified with '_linkOperationId'
560+ -- or identified via '_linkOperationRef'. The key is the parameter name to be used, whereas
561+ -- the value can be a constant or an expression to be evaluated and passed to the linked operation.
562+ -- The parameter name can be qualified using the parameter location @[{in}.]{name}@
563+ -- for operations that use the same parameter name in different locations (e.g. path.id).
564+ , _linkParameters :: InsOrdHashMap Text ExpressionOrValue
565+
566+ -- | A literal value or @{expression}@ to use as a request body when calling the target operation.
567+ , _linkRequestBody :: Maybe ExpressionOrValue
568+
569+ -- | A description of the link.
570+ , _linkDescription :: Maybe Text
571+
572+ -- | A server object to be used by the target operation.
573+ , _linkServer :: Maybe Server
574+ } deriving (Eq, Show, Generic, Typeable, Data)
575+
576+-- | Items for @'OpenApiArray'@ schemas.
456577--
457−-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.
458−-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.
459−-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.
460−-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.
578+-- __Warning__: OpenAPI 3.0 does not support tuple arrays. However, OpenAPI 3.1 will, as
579+-- it will incorporate Json Schema mostly verbatim.
461580--
462−-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
581+-- @'OpenApiItemsObject'@ should be used to specify homogenous array @'Schema'@s.
463582--
464−-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
465−data SwaggerItems t where
466− SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
467− SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
468− SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
469− deriving (Typeable)
470−
471−deriving instance Eq (SwaggerItems t)
472−deriving instance Show (SwaggerItems t)
473−--deriving instance Typeable (SwaggerItems t)
474−
475−swaggerItemsPrimitiveConstr :: Constr
476−swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
477−
478−swaggerItemsObjectConstr :: Constr
479−swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
480−
481−swaggerItemsArrayConstr :: Constr
482−swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
483−
484−swaggerItemsDataType :: DataType
485−swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
486−
487−-- Note: unfortunately we have to write these Data instances by hand,
488−-- to get better contexts / avoid duplicate name when using standalone deriving
489−
490−instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
491− -- TODO: define gfoldl
492− gunfold k z c = case constrIndex c of
493− 1 -> k (k (z SwaggerItemsPrimitive))
494− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
495− toConstr _ = swaggerItemsPrimitiveConstr
496− dataTypeOf _ = swaggerItemsDataType
497−
498−-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
499−instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
500− -- TODO: define gfoldl
501− gunfold k z c = case constrIndex c of
502− 1 -> k (k (z SwaggerItemsPrimitive))
503− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindParamOtherSchema)."
504− toConstr _ = swaggerItemsPrimitiveConstr
505− dataTypeOf _ = swaggerItemsDataType
506−
507−instance Data (SwaggerItems 'SwaggerKindSchema) where
508− gfoldl _ _ (SwaggerItemsPrimitive _ _) = error " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"
509− gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref
510− gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref
511−
512− gunfold k z c = case constrIndex c of
513− 2 -> k (z SwaggerItemsObject)
514− 3 -> k (z SwaggerItemsArray)
515− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindSchema)."
516−
517− toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
518− toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
519− toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
520−
521− dataTypeOf _ = swaggerItemsDataType
522−
523−-- | Type used as a kind to avoid overlapping instances.
524−data SwaggerKind t
525− = SwaggerKindNormal t
526− | SwaggerKindParamOtherSchema
527− | SwaggerKindSchema
528− deriving (Typeable)
529−
530−deriving instance Typeable 'SwaggerKindNormal
531−deriving instance Typeable 'SwaggerKindParamOtherSchema
532−deriving instance Typeable 'SwaggerKindSchema
533−
534−-- TODO remove
535−type family SwaggerKindType (k :: SwaggerKind *) :: *
536−type instance SwaggerKindType ('SwaggerKindNormal t) = t
537−type instance SwaggerKindType 'SwaggerKindSchema = Schema
538−--type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema
539−
540−data SwaggerType t where
541− SwaggerString :: SwaggerType t
542− SwaggerNumber :: SwaggerType t
543− SwaggerInteger :: SwaggerType t
544− SwaggerBoolean :: SwaggerType t
545− SwaggerArray :: SwaggerType t
546− SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
547− SwaggerNull :: SwaggerType 'SwaggerKindSchema
548− SwaggerObject :: SwaggerType 'SwaggerKindSchema
549− deriving (Typeable)
550−
551−deriving instance Eq (SwaggerType t)
552−deriving instance Show (SwaggerType t)
553−
554−swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
555−swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
556−
557−swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
558−swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
559−
560−swaggerCommonTypes :: [SwaggerType k]
561−swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
562−
563−swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
564−swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
565−
566−swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
567−swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
568−
569−swaggerTypeConstrs :: [Constr]
570−swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
571− ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
572−
573−instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
574− gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
575− toConstr = swaggerTypeConstr
576− dataTypeOf = swaggerTypeDataType
577−
578−instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
579− gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
580− toConstr = swaggerTypeConstr
581− dataTypeOf = swaggerTypeDataType
582−
583−instance Data (SwaggerType 'SwaggerKindSchema) where
584− gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
585− toConstr = swaggerTypeConstr
586− dataTypeOf = swaggerTypeDataType
583+-- @'OpenApiItemsArray'@ should be used to specify tuple @'Schema'@s.
584+data OpenApiItems where
585+ OpenApiItemsObject :: Referenced Schema -> OpenApiItems
586+ OpenApiItemsArray :: [Referenced Schema] -> OpenApiItems
587+ deriving (Eq, Show, Typeable, Data)
588+
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
597+ deriving (Eq, Show, Typeable, Generic, Data)
587598
588599data ParamLocation
589600 = -- | Parameters that are appended to the URL.
@@ -601,42 +612,6 @@ data ParamLocation
601612
602613type Format = Text
603614
604−-- | Determines the format of the array.
605−data CollectionFormat t where
606− -- Comma separated values: @foo,bar@.
607− CollectionCSV :: CollectionFormat t
608− -- Space separated values: @foo bar@.
609− CollectionSSV :: CollectionFormat t
610− -- Tab separated values: @foo\\tbar@.
611− CollectionTSV :: CollectionFormat t
612− -- Pipe separated values: @foo|bar@.
613− CollectionPipes :: CollectionFormat t
614− -- Corresponds to multiple parameter instances
615− -- instead of multiple values for a single instance @foo=bar&foo=baz@.
616− -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
617− CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
618− deriving (Typeable)
619−
620−deriving instance Eq (CollectionFormat t)
621−deriving instance Show (CollectionFormat t)
622−
623−collectionFormatConstr :: CollectionFormat t -> Constr
624−collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
625−
626−collectionFormatDataType :: DataType
627−collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
628− map collectionFormatConstr collectionCommonFormats
629−
630−collectionCommonFormats :: [CollectionFormat t]
631−collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
632−
633−instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
634− gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
635− toConstr = collectionFormatConstr
636− dataTypeOf _ = collectionFormatDataType
637−
638−deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
639−
640615type ParamName = Text
641616
642617data Schema = Schema
@@ -663,9 +638,33 @@ data Schema = Schema
663638 , _schemaMaxProperties :: Maybe Integer
664639 , _schemaMinProperties :: Maybe Integer
665640
666− , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
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
667663 } deriving (Eq, Show, Generic, Data, Typeable)
668664
665+-- | Regex pattern for @string@ type.
666+type Pattern = Text
667+
669668data Discriminator = Discriminator
670669 { -- | The name of the property in the payload that will hold the discriminator value.
671670 _discriminatorPropertyName :: Text
@@ -681,39 +680,9 @@ data NamedSchema = NamedSchema
681680 , _namedSchemaSchema :: Schema
682681 } deriving (Eq, Show, Generic, Data, Typeable)
683682
684−-- | Regex pattern for @string@ type.
685−type Pattern = Text
686−
687−data ParamSchema (t :: SwaggerKind *) = ParamSchema
688− { -- | Declares the value of the parameter that the server will use if none is provided,
689− -- for example a @"count"@ to control the number of results per page might default to @100@
690− -- if not supplied by the client in the request.
691− -- (Note: "default" has no meaning for required parameters.)
692− -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
693− _paramSchemaDefault :: Maybe Value
694−
695− , _paramSchemaType :: Maybe (SwaggerType t)
696− , _paramSchemaFormat :: Maybe Format
697− , _paramSchemaItems :: Maybe (SwaggerItems t)
698− , _paramSchemaMaximum :: Maybe Scientific
699− , _paramSchemaExclusiveMaximum :: Maybe Bool
700− , _paramSchemaMinimum :: Maybe Scientific
701− , _paramSchemaExclusiveMinimum :: Maybe Bool
702− , _paramSchemaMaxLength :: Maybe Integer
703− , _paramSchemaMinLength :: Maybe Integer
704− , _paramSchemaPattern :: Maybe Pattern
705− , _paramSchemaMaxItems :: Maybe Integer
706− , _paramSchemaMinItems :: Maybe Integer
707− , _paramSchemaUniqueItems :: Maybe Bool
708− , _paramSchemaEnum :: Maybe [Value]
709− , _paramSchemaMultipleOf :: Maybe Scientific
710− } deriving (Eq, Show, Generic, Typeable)
711−
712−deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
713−
714683data Xml = Xml
715684 { -- | Replaces the name of the element/attribute used for the described schema property.
716− -- 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.
717686 -- When defined alongside type being array (outside the items),
718687 -- it will affect the wrapping element and only if wrapped is true.
719688 -- If wrapped is false, it will be ignored.
@@ -765,25 +734,46 @@ data Response = Response
765734 -- | A map containing descriptions of potential response payloads.
766735 -- The key is a media type or media type range and the value describes it.
767736 -- For responses that match multiple keys, only the most specific key is applicable.
768− -- e.g. @text/plain@ overrides @text/*@.
769− , _responseContent :: InsOrdHashMap Text MediaTypeObject
737+ -- e.g. @text/plain@ overrides @text/\*@.
738+ , _responseContent :: InsOrdHashMap MediaType MediaTypeObject
770739
771740 -- | Maps a header name to its definition.
772741 , _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)
773742
774− -- TODO links
743+ -- | A map of operations links that can be followed from the response.
744+ -- The key of the map is a short name for the link, following the naming
745+ -- constraints of the names for 'Component' Objects.
746+ , _responseLinks :: InsOrdHashMap Text (Referenced Link)
775747 } deriving (Eq, Show, Generic, Data, Typeable)
776748
777749instance IsString Response where
778− fromString s = Response (fromString s) mempty mempty
750+ fromString s = Response (fromString s) mempty mempty mempty
751+
752+-- | A map of possible out-of band callbacks related to the parent operation.
753+-- Each value in the map is a 'PathItem' Object that describes a set of requests that
754+-- may be initiated by the API provider and the expected responses.
755+-- The key value used to identify the path item object is an expression, evaluated at runtime,
756+-- that identifies a URL to use for the callback operation.
757+newtype Callback = Callback (InsOrdHashMap Text PathItem)
758+ deriving (Eq, Show, Generic, Data, Typeable)
779759
780760type HeaderName = Text
781761
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.
782765data Header = Header
783766 { -- | A short description of the header.
784− _headerDescription :: Maybe Text
767+ _headerDescription :: Maybe HeaderName
768+
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)
785775
786− , _headerSchema :: ParamSchema ('SwaggerKindNormal Header)
776+ , _headerSchema :: Maybe (Referenced Schema)
787777 } deriving (Eq, Show, Generic, Data, Typeable)
788778
789779-- | The location of the API key.
@@ -807,17 +797,17 @@ type AuthorizationURL = Text
807797-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
808798type TokenURL = Text
809799
810−data OAuth2ImplicitFlow = OAuth2ImplicitFlow
811− { _oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL
812− } deriving (Eq, Show, Generic, Data, Typeable)
800+newtype OAuth2ImplicitFlow
801+ = OAuth2ImplicitFlow {_oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL}
802+ deriving (Eq, Show, Generic, Data, Typeable)
813803
814−data OAuth2PasswordFlow = OAuth2PasswordFlow
815− { _oAuth2PasswordFlowTokenUrl :: TokenURL
816− } deriving (Eq, Show, Generic, Data, Typeable)
804+newtype OAuth2PasswordFlow
805+ = OAuth2PasswordFlow {_oAuth2PasswordFlowTokenUrl :: TokenURL}
806+ deriving (Eq, Show, Generic, Data, Typeable)
817807
818−data OAuth2ClientCredentialsFlow = OAuth2ClientCredentialsFlow
819− { _oAuth2ClientCredentialsFlowTokenUrl :: TokenURL
820− } deriving (Eq, Show, Generic, Data, Typeable)
808+newtype OAuth2ClientCredentialsFlow
809+ = OAuth2ClientCredentialsFlow {_oAuth2ClientCredentialsFlowTokenUrl :: TokenURL}
810+ deriving (Eq, Show, Generic, Data, Typeable)
821811
822812data OAuth2AuthorizationCodeFlow = OAuth2AuthorizationCodeFlow
823813 { _oAuth2AuthorizationCodeFlowAuthorizationUrl :: AuthorizationURL
@@ -850,8 +840,50 @@ data OAuth2Flows = OAuth2Flows
850840 , _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
851841 } deriving (Eq, Show, Generic, Data, Typeable)
852842
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+--
853885data SecuritySchemeType
854− = SecuritySchemeHttp
886+ = SecuritySchemeHttp HttpSchemeType
855887 | SecuritySchemeApiKey ApiKeyParams
856888 | SecuritySchemeOAuth2 OAuth2Flows
857889 | SecuritySchemeOpenIdConnect URL
@@ -886,7 +918,7 @@ data Tag = Tag
886918 _tagName :: TagName
887919
888920 -- | A short description for the tag.
889− -- GFM syntax can be used for rich text representation.
921+ -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
890922 , _tagDescription :: Maybe Text
891923
892924 -- | Additional external documentation for this tag.
@@ -901,7 +933,7 @@ instance IsString Tag where
901933-- | Allows referencing an external resource for extended documentation.
902934data ExternalDocs = ExternalDocs
903935 { -- | A short description of the target documentation.
904− -- GFM syntax can be used for rich text representation.
936+ -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
905937 _externalDocsDescription :: Maybe Text
906938
907939 -- | The URL for the target documentation.
@@ -948,18 +980,18 @@ deriveGeneric ''MediaTypeObject
948980deriveGeneric ''Responses
949981deriveGeneric ''SecurityScheme
950982deriveGeneric ''Schema
951−deriveGeneric ''ParamSchema
952−deriveGeneric ''Swagger
983+deriveGeneric ''OpenApi
953984deriveGeneric ''Example
954985deriveGeneric ''Encoding
986+deriveGeneric ''Link
955987
956988-- =======================================================================
957989-- Monoid instances
958990-- =======================================================================
959991
960−instance Semigroup Swagger where
992+instance Semigroup OpenApi where
961993 (<>) = genericMappend
962−instance Monoid Swagger where
994+instance Monoid OpenApi where
963995 mempty = genericMempty
964996 mappend = (<>)
965997
@@ -993,12 +1025,6 @@ instance Monoid Schema where
9931025 mempty = genericMempty
9941026 mappend = (<>)
9951027
996−instance Semigroup (ParamSchema t) where
997− (<>) = genericMappend
998−instance Monoid (ParamSchema t) where
999− mempty = genericMempty
1000− mappend = (<>)
1001−
10021028instance Semigroup Param where
10031029 (<>) = genericMappend
10041030instance Monoid Param where
@@ -1093,19 +1119,19 @@ instance SwaggerMonoid Info
10931119instance SwaggerMonoid Components
10941120instance SwaggerMonoid PathItem
10951121instance SwaggerMonoid Schema
1096−instance SwaggerMonoid (ParamSchema t)
10971122instance SwaggerMonoid Param
10981123instance SwaggerMonoid Responses
10991124instance SwaggerMonoid Response
11001125instance SwaggerMonoid ExternalDocs
11011126instance SwaggerMonoid Operation
11021127instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
1128+instance SwaggerMonoid SecurityDefinitions
11031129
11041130instance SwaggerMonoid MimeList
11051131deriving instance SwaggerMonoid URL
11061132
1107−instance SwaggerMonoid (SwaggerType t) where
1108− swaggerMempty = SwaggerString
1133+instance SwaggerMonoid OpenApiType where
1134+ swaggerMempty = OpenApiString
11091135 swaggerMappend _ y = y
11101136
11111137instance SwaggerMonoid ParamLocation where
@@ -1125,6 +1151,12 @@ instance Monoid a => SwaggerMonoid (Referenced a) where
11251151-- Simple Generic-based ToJSON instances
11261152-- =======================================================================
11271153
1154+instance ToJSON Style where
1155+ toJSON = genericToJSON (jsonPrefix "Style")
1156+
1157+instance ToJSON OpenApiType where
1158+ toJSON = genericToJSON (jsonPrefix "Swagger")
1159+
11281160instance ToJSON ParamLocation where
11291161 toJSON = genericToJSON (jsonPrefix "Param")
11301162
@@ -1174,6 +1206,12 @@ instance ToJSON OAuth2AuthorizationCodeFlow where
11741206-- Simple Generic-based FromJSON instances
11751207-- =======================================================================
11761208
1209+instance FromJSON Style where
1210+ parseJSON = genericParseJSON (jsonPrefix "Style")
1211+
1212+instance FromJSON OpenApiType where
1213+ parseJSON = genericParseJSON (jsonPrefix "Swagger")
1214+
11771215instance FromJSON ParamLocation where
11781216 parseJSON = genericParseJSON (jsonPrefix "Param")
11791217
@@ -1220,7 +1258,14 @@ instance FromJSON OAuth2AuthorizationCodeFlow where
12201258-- Manual ToJSON instances
12211259-- =======================================================================
12221260
1223−instance (Eq p, ToJSON p, AesonDefaultValue p) =>ToJSON (OAuth2Flow p) where
1261+instance ToJSON MediaType where
1262+ toJSON = toJSON . show
1263+ toEncoding = toEncoding . show
1264+
1265+instance ToJSONKey MediaType where
1266+ toJSONKey = JSON.toJSONKeyText (Text.pack . show)
1267+
1268+instance (Eq p, ToJSON p, AesonDefaultValue p) => ToJSON (OAuth2Flow p) where
12241269 toJSON = sopSwaggerGenericToJSON
12251270 toEncoding = sopSwaggerGenericToEncoding
12261271
@@ -1229,8 +1274,19 @@ instance ToJSON OAuth2Flows where
12291274 toEncoding = sopSwaggerGenericToEncoding
12301275
12311276instance ToJSON SecuritySchemeType where
1232− toJSON SecuritySchemeHttp
1233− = 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+ ]
12341290 toJSON (SecuritySchemeApiKey params)
12351291 = toJSON params
12361292 <+> object [ "type" .= ("apiKey" :: Text) ]
@@ -1243,9 +1299,9 @@ instance ToJSON SecuritySchemeType where
12431299 , "openIdConnectUrl" .= url
12441300 ]
12451301
1246−instance ToJSON Swagger where
1302+instance ToJSON OpenApi where
12471303 toJSON a = sopSwaggerGenericToJSON a &
1248− if InsOrdHashMap.null (_swaggerPaths a)
1304+ if InsOrdHashMap.null (_openApiPaths a)
12491305 then (<+> object ["paths" .= object []])
12501306 else id
12511307 toEncoding = sopSwaggerGenericToEncoding
@@ -1259,8 +1315,8 @@ instance ToJSON SecurityScheme where
12591315 toEncoding = sopSwaggerGenericToEncoding
12601316
12611317instance ToJSON Schema where
1262− toJSON = sopSwaggerGenericToJSON
1263− toEncoding = sopSwaggerGenericToEncoding
1318+ toJSON = sopSwaggerGenericToJSONWithOpts $
1319+ mkSwaggerAesonOptions "schema" & saoSubObject ?~ "items"
12641320
12651321instance ToJSON Header where
12661322 toJSON = sopSwaggerGenericToJSON
@@ -1269,20 +1325,21 @@ instance ToJSON Header where
12691325-- | As for nullary schema for 0-arity type constructors, see
12701326-- <https://github.com/GetShopTV/swagger2/issues/167>.
12711327--
1272−-- >>> encode (SwaggerItemsArray [])
1273−-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1328+-- >>> BSL.putStrLn $ encodePretty (OpenApiItemsArray [])
1329+-- {
1330+-- "example": [],
1331+-- "items": {},
1332+-- "maxItems": 0
1333+-- }
12741334--
1275−instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
1276− toJSON (SwaggerItemsPrimitive fmt schema) = object
1277− [ "collectionFormat" .= fmt
1278− , "items" .= schema ]
1279− toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1280− toJSON (SwaggerItemsArray []) = object
1335+instance ToJSON OpenApiItems where
1336+ toJSON (OpenApiItemsObject x) = object [ "items" .= x ]
1337+ toJSON (OpenApiItemsArray []) = object
12811338 [ "items" .= object []
12821339 , "maxItems" .= (0 :: Int)
12831340 , "example" .= Array mempty
12841341 ]
1285− toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1342+ toJSON (OpenApiItemsArray x) = object [ "items" .= x ]
12861343
12871344instance ToJSON Components where
12881345 toJSON = sopSwaggerGenericToJSON
@@ -1327,6 +1384,10 @@ instance ToJSON Encoding where
13271384 toJSON = sopSwaggerGenericToJSON
13281385 toEncoding = sopSwaggerGenericToEncoding
13291386
1387+instance ToJSON Link where
1388+ toJSON = sopSwaggerGenericToJSON
1389+ toEncoding = sopSwaggerGenericToEncoding
1390+
13301391instance ToJSON SecurityDefinitions where
13311392 toJSON (SecurityDefinitions sd) = toJSON sd
13321393
@@ -1343,37 +1404,31 @@ instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/compone
13431404instance ToJSON (Referenced RequestBody) where toJSON = referencedToJSON "#/components/requestBodies/"
13441405instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/components/examples/"
13451406instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"
1346−
1347−instance ToJSON (SwaggerType t) where
1348− toJSON SwaggerArray = "array"
1349− toJSON SwaggerString = "string"
1350− toJSON SwaggerInteger = "integer"
1351− toJSON SwaggerNumber = "number"
1352− toJSON SwaggerBoolean = "boolean"
1353− toJSON SwaggerFile = "file"
1354− toJSON SwaggerNull = "null"
1355− toJSON SwaggerObject = "object"
1356−
1357−instance ToJSON (CollectionFormat t) where
1358− toJSON CollectionCSV = "csv"
1359− toJSON CollectionSSV = "ssv"
1360− toJSON CollectionTSV = "tsv"
1361− toJSON CollectionPipes = "pipes"
1362− toJSON CollectionMulti = "multi"
1363−
1364−instance ToJSON (ParamSchema k) where
1365− -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1366− toJSON = sopSwaggerGenericToJSONWithOpts $
1367− mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1407+instance ToJSON (Referenced Link) where toJSON = referencedToJSON "#/components/links/"
1408+instance ToJSON (Referenced Callback) where toJSON = referencedToJSON "#/components/callbacks/"
13681409
13691410instance ToJSON AdditionalProperties where
13701411 toJSON (AdditionalPropertiesAllowed b) = toJSON b
13711412 toJSON (AdditionalPropertiesSchema s) = toJSON s
13721413
1414+instance ToJSON ExpressionOrValue where
1415+ toJSON (Expression expr) = toJSON expr
1416+ toJSON (Value val) = toJSON val
1417+
1418+instance ToJSON Callback where
1419+ toJSON (Callback ps) = toJSON ps
1420+
13731421-- =======================================================================
13741422-- Manual FromJSON instances
13751423-- =======================================================================
13761424
1425+instance FromJSON MediaType where
1426+ parseJSON = withText "MediaType" $ \str ->
1427+ maybe (fail $ "Invalid media type literal " <> Text.unpack str) pure $ parseAccept $ encodeUtf8 str
1428+
1429+instance FromJSONKey MediaType where
1430+ fromJSONKey = FromJSONKeyTextParser (parseJSON . String)
1431+
13771432instance (Eq p, FromJSON p, AesonDefaultValue p) => FromJSON (OAuth2Flow p) where
13781433 parseJSON = sopSwaggerGenericParseJSON
13791434
@@ -1384,14 +1439,19 @@ instance FromJSON SecuritySchemeType where
13841439 parseJSON js@(Object o) = do
13851440 (t :: Text) <- o .: "type"
13861441 case t of
1387− "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
13881448 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
13891449 "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")
13901450 "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")
13911451 _ -> empty
13921452 parseJSON _ = empty
13931453
1394−instance FromJSON Swagger where
1454+instance FromJSON OpenApi where
13951455 parseJSON = sopSwaggerGenericParseJSON
13961456
13971457instance FromJSON Server where
@@ -1403,48 +1463,28 @@ instance FromJSON SecurityScheme where
14031463instance FromJSON Schema where
14041464 parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
14051465 where nullaryCleanup :: Schema -> Schema
1406− nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1407− if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1466+ nullaryCleanup s =
1467+ if _schemaItems s == Just (OpenApiItemsArray [])
14081468 then s { _schemaExample = Nothing
1409− , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1469+ , _schemaMaxItems = Nothing
1470+ }
14101471 else s
14111472
14121473instance FromJSON Header where
14131474 parseJSON = sopSwaggerGenericParseJSON
14141475
1415−instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1416− parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1417− <$> o .:? "collectionFormat"
1418− <*> (o .: "items" >>= parseJSON)
1419−
1420−instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1421− parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1422− <$> o .:? "collectionFormat"
1423− <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1424−
1425−-- |
1426−--
1427−-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1428−-- Just (SwaggerItemsArray [])
1429−--
1430−-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1431−-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1432−--
1433−-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1434−-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1435−--
1436−instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1476+instance FromJSON OpenApiItems where
14371477 parseJSON js@(Object obj)
1438− | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1439− | otherwise = SwaggerItemsObject <$> parseJSON js
1440− 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
14411481 parseJSON _ = empty
14421482
14431483instance FromJSON Components where
14441484 parseJSON = sopSwaggerGenericParseJSON
14451485
14461486instance FromJSON MimeList where
1447− parseJSON js = (MimeList . map fromString) <$> parseJSON js
1487+ parseJSON js = MimeList . map fromString <$> parseJSON js
14481488
14491489instance FromJSON Param where
14501490 parseJSON = sopSwaggerGenericParseJSON
@@ -1452,7 +1492,7 @@ instance FromJSON Param where
14521492instance FromJSON Responses where
14531493 parseJSON (Object o) = Responses
14541494 <$> o .:? "default"
1455− <*> (parseJSON (Object (HashMap.delete "default" o)))
1495+ <*> parseJSON (Object (deleteKey "default" o))
14561496 parseJSON _ = empty
14571497
14581498instance FromJSON Example where
@@ -1479,6 +1519,9 @@ instance FromJSON MediaTypeObject where
14791519instance FromJSON Encoding where
14801520 parseJSON = sopSwaggerGenericParseJSON
14811521
1522+instance FromJSON Link where
1523+ parseJSON = sopSwaggerGenericParseJSON
1524+
14821525instance FromJSON Reference where
14831526 parseJSON (Object o) = Reference <$> o .: "$ref"
14841527 parseJSON _ = empty
@@ -1502,40 +1545,24 @@ instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#
15021545instance FromJSON (Referenced RequestBody) where parseJSON = referencedParseJSON "#/components/requestBodies/"
15031546instance FromJSON (Referenced Example) where parseJSON = referencedParseJSON "#/components/examples/"
15041547instance FromJSON (Referenced Header) where parseJSON = referencedParseJSON "#/components/headers/"
1548+instance FromJSON (Referenced Link) where parseJSON = referencedParseJSON "#/components/links/"
1549+instance FromJSON (Referenced Callback) where parseJSON = referencedParseJSON "#/components/callbacks/"
15051550
15061551instance FromJSON Xml where
15071552 parseJSON = genericParseJSON (jsonPrefix "xml")
15081553
1509−instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1510− parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1511−
1512−instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1513− parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1514−
1515−instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1516− parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1517−
1518−instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1519− parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1520−
1521−-- NOTE: There aren't collections of 'Schema'
1522−--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1523−-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1524−
1525−instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1526− parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1527−
1528−instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1529− parseJSON = sopSwaggerGenericParseJSON
1530−instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1531− parseJSON = sopSwaggerGenericParseJSON
1532−instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1533− parseJSON = sopSwaggerGenericParseJSON
1534−
15351554instance FromJSON AdditionalProperties where
15361555 parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
15371556 parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
15381557
1558+-- | All strings are parsed as expressions
1559+instance FromJSON ExpressionOrValue where
1560+ parseJSON (String expr) = pure $ Expression expr
1561+ parseJSON v = pure $ Value v
1562+
1563+instance FromJSON Callback where
1564+ parseJSON = fmap Callback . parseJSON
1565+
15391566instance HasSwaggerAesonOptions Server where
15401567 swaggerAesonOptions _ = mkSwaggerAesonOptions "server"
15411568instance HasSwaggerAesonOptions Components where
@@ -1564,24 +1591,18 @@ instance HasSwaggerAesonOptions SecurityScheme where
15641591 swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
15651592instance HasSwaggerAesonOptions Schema where
15661593 swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1567−instance HasSwaggerAesonOptions Swagger where
1594+instance HasSwaggerAesonOptions OpenApi where
15681595 swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")]
15691596instance HasSwaggerAesonOptions Example where
15701597 swaggerAesonOptions _ = mkSwaggerAesonOptions "example"
15711598instance HasSwaggerAesonOptions Encoding where
15721599 swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding"
15731600
1574−instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
1575− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1576−instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
1577− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1578−-- NOTE: Schema doesn't have 'items' sub object!
1579−instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
1580− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
1601+instance HasSwaggerAesonOptions Link where
1602+ swaggerAesonOptions _ = mkSwaggerAesonOptions "link"
15811603
15821604instance AesonDefaultValue Server
15831605instance AesonDefaultValue Components
1584−instance AesonDefaultValue (ParamSchema s)
15851606instance AesonDefaultValue OAuth2ImplicitFlow
15861607instance AesonDefaultValue OAuth2PasswordFlow
15871608instance AesonDefaultValue OAuth2ClientCredentialsFlow
@@ -1589,7 +1610,10 @@ instance AesonDefaultValue OAuth2AuthorizationCodeFlow
15891610instance AesonDefaultValue p => AesonDefaultValue (OAuth2Flow p)
15901611instance AesonDefaultValue Responses
15911612instance AesonDefaultValue SecuritySchemeType
1592−instance AesonDefaultValue (SwaggerType a)
1613+instance AesonDefaultValue OpenApiType
15931614instance AesonDefaultValue MimeList where defaultValue = Just mempty
15941615instance AesonDefaultValue Info
15951616instance AesonDefaultValue ParamLocation
1617+instance 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+77−53
@@ -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 t
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 t
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 t
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 t
112− default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema t
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 t
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 t
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,18 +237,18 @@ 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
237249 ( 'Text "Impossible to have an instance " :<>: ShowType (ToParamSchema bs) :<>: Text "."
238250 :$$: 'Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
239− :$$: 'Text "Consider using byteParamSchema or binaryParamSchema templates." )
251+ :$$: 'Text "Consider using byteParamSchema or binaryParamSchemaemplates." )
240252
241253instance ToParamSchemaByteStringError BS.ByteString => ToParamSchema BS.ByteString where toParamSchema = error "impossible"
242254instance ToParamSchemaByteStringError BSL.ByteString => ToParamSchema BSL.ByteString where toParamSchema = error "impossible"
@@ -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 ?~ SwaggerItemsPrimitive Nothing (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 t
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 t -> ParamSchema t
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 t -> ParamSchema t
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+446−172
@@ -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,17 +19,18 @@
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
2426
25−import Control.Lens
27+import Control.Lens hiding (allOf)
2628import Data.Data.Lens (template)
2729
2830import Control.Monad
2931import Control.Monad.Writer
30−import Data.Aeson (ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..), Value (..), Object(..))
32+import Data.Aeson (Object (..), SumEncoding (..), ToJSON (..), ToJSONKey (..),
33+ ToJSONKeyFunction (..), Value (..))
3134import Data.Char
3235import Data.Data (Data)
3336import Data.Foldable (traverse_)
@@ -39,8 +42,10 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
3942import Data.Int
4043import Data.IntSet (IntSet)
4144import Data.IntMap (IntMap)
45+import Data.List (sort)
4246import Data.List.NonEmpty.Compat (NonEmpty)
4347import Data.Map (Map)
48+import Data.Maybe (fromMaybe)
4449import Data.Proxy
4550import Data.Scientific (Scientific)
4651import Data.Fixed (Fixed, HasResolution, Pico)
@@ -57,17 +62,19 @@ import Numeric.Natural.Compat (Natural)
5762import Data.Word
5863import GHC.Generics
5964import qualified Data.UUID.Types as UUID
65+import Type.Reflection (Typeable, typeRep)
6066
61−import Data.Swagger.Declare
62−import Data.Swagger.Internal
63−import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
64−import Data.Swagger.Lens hiding (name, schema)
65−import qualified Data.Swagger.Lens as Swagger
66−import Data.Swagger.SchemaOptions
67−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
6875
6976import qualified Data.ByteString as BS
70−import qualified Data.ByteString.Lazy as BSL
77+import qualified Data.ByteString.Lazy.Char8 as BSL
7178import GHC.TypeLits (TypeError, ErrorMessage(..))
7279
7380unnamed :: Schema -> NamedSchema
@@ -95,7 +102,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
95102--
96103-- import Control.Lens
97104-- import Data.Proxy
98−-- import Data.Swagger
105+-- import Data.OpenApi
99106--
100107-- data Coord = Coord { x :: Double, y :: Double }
101108--
@@ -103,7 +110,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
103110-- declareNamedSchema _ = do
104111-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
105112-- return $ NamedSchema (Just \"Coord\") $ mempty
106−-- & type_ ?~ SwaggerObject
113+-- & type_ ?~ OpenApiObject
107114-- & properties .~
108115-- [ (\"x\", doubleSchema)
109116-- , (\"y\", doubleSchema)
@@ -129,13 +136,13 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
129136--
130137-- instance ToSchema Coord
131138-- @
132−class ToSchema a where
139+class Typeable a => ToSchema a where
133140 -- | Convert a type into an optionally named schema
134141 -- together with all used definitions.
135142 -- Note that the schema itself is included in definitions
136143 -- only if it is recursive (and thus needs its definition in scope).
137144 declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
138− default declareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
145+ default declareNamedSchema :: (Generic a, GToSchema (Rep a)) =>
139146 Proxy a -> Declare (Definitions Schema) NamedSchema
140147 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
141148
@@ -151,13 +158,19 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
151158--
152159-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
153160-- Nothing
154−-- >>> encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
155−-- "{\"type\":\"string\"}"
161+-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy String) ^. schema)
162+-- {
163+-- "type": "string"
164+-- }
156165--
157166-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
158167-- Just "Day"
159−-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
160−-- "{\"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+-- }
161174toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
162175toNamedSchema = undeclare . declareNamedSchema
163176
@@ -173,22 +186,35 @@ schemaName = _namedSchemaName . toNamedSchema
173186
174187-- | Convert a type into a schema.
175188--
176−-- >>> encode $ toSchema (Proxy :: Proxy Int8)
177−-- "{\"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+-- }
178195--
179−-- >>> encode $ toSchema (Proxy :: Proxy [Day])
180−-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"
196+-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy [Day])
197+-- {
198+-- "items": {
199+-- "$ref": "#/components/schemas/Day"
200+-- },
201+-- "type": "array"
202+-- }
181203toSchema :: ToSchema a => Proxy a -> Schema
182204toSchema = _namedSchemaSchema . toNamedSchema
183205
184206-- | Convert a type into a referenced schema if possible.
185207-- Only named schemas can be referenced, nameless schemas are inlined.
186208--
187−-- >>> encode $ toSchemaRef (Proxy :: Proxy Integer)
188−-- "{\"type\":\"integer\"}"
209+-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Integer)
210+-- {
211+-- "type": "integer"
212+-- }
189213--
190−-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)
191−-- "{\"$ref\":\"#/definitions/Day\"}"
214+-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Day)
215+-- {
216+-- "$ref": "#/components/schemas/Day"
217+-- }
192218toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
193219toSchemaRef = undeclare . declareSchemaRef
194220
@@ -256,8 +282,15 @@ inlineAllSchemas = inlineSchemasWhen (const True)
256282
257283-- | Convert a type into a schema without references.
258284--
259−-- >>> encode $ toInlinedSchema (Proxy :: Proxy [Day])
260−-- "{\"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+-- }
261294--
262295-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
263296-- when inlining recursive schemas.
@@ -287,41 +320,67 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
287320 traverse_ usedNames (InsOrdHashMap.lookup name defs)
288321 Inline subschema -> usedNames subschema
289322
290−-- | Default schema for binary data (any sequence of octets).
291−binarySchema :: Schema
292−binarySchema = mempty
293− & type_ ?~ SwaggerString
294− & format ?~ "binary"
295−
296−-- | Default schema for binary data (base64 encoded).
297−byteSchema :: Schema
298−byteSchema = mempty
299− & type_ ?~ SwaggerString
300− & format ?~ "byte"
301−
302−-- | Default schema for password string.
303−-- @"password"@ format is used to hint UIs the input needs to be obscured.
304−passwordSchema :: Schema
305−passwordSchema = mempty
306− & type_ ?~ SwaggerString
307− & format ?~ "password"
308−
309323-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
310324-- Produced schema can be used for further refinement.
311325--
312−-- >>> encode $ sketchSchema "hello"
313−-- "{\"example\":\"hello\",\"type\":\"string\"}"
326+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema "hello"
327+-- {
328+-- "example": "hello",
329+-- "type": "string"
330+-- }
314331--
315−-- >>> encode $ sketchSchema (1, 2, 3)
316−-- "{\"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+-- }
317344--
318−-- >>> encode $ sketchSchema ("Jack", 25)
319−-- "{\"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+-- }
320361--
321362-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
322363-- >>> instance ToJSON Person
323−-- >>> encode $ sketchSchema (Person "Jack" 25)
324−-- "{\"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+-- }
325384sketchSchema :: ToJSON a => a -> Schema
326385sketchSchema = sketch . toJSON
327386 where
@@ -329,15 +388,15 @@ sketchSchema = sketch . toJSON
329388 sketch js@(Bool _) = go js
330389 sketch js = go js & example ?~ js
331390
332− go Null = mempty & type_ ?~ SwaggerNull
333− go (Bool _) = mempty & type_ ?~ SwaggerBoolean
334− go (String _) = mempty & type_ ?~ SwaggerString
335− 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
336395 go (Array xs) = mempty
337− & type_ ?~ SwaggerArray
396+ & type_ ?~ OpenApiArray
338397 & items ?~ case ischema of
339− Just s -> SwaggerItemsObject (Inline s)
340− _ -> SwaggerItemsArray (map Inline ys)
398+ Just s -> OpenApiItemsObject (Inline s)
399+ _ -> OpenApiItemsArray (map Inline ys)
341400 where
342401 ys = map go (V.toList xs)
343402 allSame = and ((zipWith (==)) ys (tail ys))
@@ -346,64 +405,178 @@ sketchSchema = sketch . toJSON
346405 (z:_) | allSame -> Just z
347406 _ -> Nothing
348407 go (Object o) = mempty
349− & type_ ?~ SwaggerObject
350− & required .~ HashMap.keys o
351− & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
408+ & type_ ?~ OpenApiObject
409+ & required .~ sort (objectKeys o)
410+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
352411
353412-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
354413-- Produced schema uses as much constraints as possible.
355414--
356−-- >>> encode $ sketchStrictSchema "hello"
357−-- "{\"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+-- }
358425--
359−-- >>> encode $ sketchStrictSchema (1, 2, 3)
360−-- "{\"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+-- }
361469--
362−-- >>> encode $ sketchStrictSchema ("Jack", 25)
363−-- "{\"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+-- }
364503--
365504-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
366505-- >>> instance ToJSON Person
367−-- >>> encode $ sketchStrictSchema (Person "Jack" 25)
368−-- "{\"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+-- }
369542sketchStrictSchema :: ToJSON a => a -> Schema
370543sketchStrictSchema = go . toJSON
371544 where
372− go Null = mempty & type_ ?~ SwaggerNull
545+ go Null = mempty & type_ ?~ OpenApiNull
373546 go js@(Bool _) = mempty
374− & type_ ?~ SwaggerBoolean
547+ & type_ ?~ OpenApiBoolean
375548 & enum_ ?~ [js]
376549 go js@(String s) = mempty
377− & type_ ?~ SwaggerString
550+ & type_ ?~ OpenApiString
378551 & maxLength ?~ fromIntegral (T.length s)
379552 & minLength ?~ fromIntegral (T.length s)
380553 & pattern ?~ s
381554 & enum_ ?~ [js]
382555 go js@(Number n) = mempty
383− & type_ ?~ SwaggerNumber
556+ & type_ ?~ OpenApiNumber
384557 & maximum_ ?~ n
385558 & minimum_ ?~ n
386559 & multipleOf ?~ n
387560 & enum_ ?~ [js]
388561 go js@(Array xs) = mempty
389− & type_ ?~ SwaggerArray
562+ & type_ ?~ OpenApiArray
390563 & maxItems ?~ fromIntegral sz
391564 & minItems ?~ fromIntegral sz
392− & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
565+ & items ?~ OpenApiItemsArray (map (Inline . go) (V.toList xs))
393566 & uniqueItems ?~ allUnique
394567 & enum_ ?~ [js]
395568 where
396569 sz = length xs
397570 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
398571 go js@(Object o) = mempty
399− & type_ ?~ SwaggerObject
400− & required .~ names
401− & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
572+ & type_ ?~ OpenApiObject
573+ & required .~ sort names
574+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
402575 & maxProperties ?~ fromIntegral (length names)
403576 & minProperties ?~ fromIntegral (length names)
404577 & enum_ ?~ [js]
405578 where
406− names = HashMap.keys o
579+ names = objectKeys o
407580
408581class GToSchema (f :: * -> *) where
409582 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
@@ -412,8 +585,8 @@ instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
412585 declareNamedSchema _ = do
413586 ref <- declareSchemaRef (Proxy :: Proxy a)
414587 return $ unnamed $ mempty
415− & type_ ?~ SwaggerArray
416− & items ?~ SwaggerItemsObject ref
588+ & type_ ?~ OpenApiArray
589+ & items ?~ OpenApiItemsObject ref
417590
418591instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
419592instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
@@ -438,12 +611,14 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
438611instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
439612instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
440613
441−instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
614+instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
442615
443616instance ToSchema a => ToSchema (Maybe a) where
444617 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
445618
446−instance (ToSchema a, ToSchema b) => ToSchema (Either a b)
619+instance (ToSchema a, ToSchema b) => ToSchema (Either a b) where
620+ -- To match Aeson instance
621+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { sumEncoding = ObjectWithSingleField }
447622
448623instance ToSchema () where
449624 declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
@@ -453,16 +628,22 @@ instance ToSchema UUID.UUID where
453628 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
454629 & example ?~ toJSON (UUID.toText UUID.nil)
455630
456−instance (ToSchema a, ToSchema b) => ToSchema (a, b)
457−instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
458−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
459−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e)
460−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
461−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
462643
463644timeSchema :: T.Text -> Schema
464645timeSchema fmt = mempty
465− & type_ ?~ SwaggerString
646+ & type_ ?~ OpenApiString
466647 & format ?~ fmt
467648
468649-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -477,7 +658,7 @@ instance ToSchema LocalTime where
477658 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
478659 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
479660
480−-- | 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.
481662instance ToSchema ZonedTime where
482663 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
483664 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
@@ -509,7 +690,7 @@ instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where
509690instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
510691
511692-- | NOTE: This schema does not account for the uniqueness of keys.
512−instance ToSchema a => ToSchema (IntMap a) where
693+instance (ToSchema a) => ToSchema (IntMap a) where
513694 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
514695
515696instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
@@ -520,7 +701,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
520701 declareObjectMapSchema = do
521702 schema <- declareSchemaRef (Proxy :: Proxy v)
522703 return $ unnamed $ mempty
523− & type_ ?~ SwaggerObject
704+ & type_ ?~ OpenApiObject
524705 & additionalProperties ?~ AdditionalPropertiesSchema schema
525706
526707instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
@@ -528,7 +709,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
528709
529710instance {-# OVERLAPPING #-} ToSchema Object where
530711 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
531− & type_ ?~ SwaggerObject
712+ & type_ ?~ OpenApiObject
532713 & description ?~ "Arbitrary JSON object."
533714 & additionalProperties ?~ AdditionalPropertiesAllowed True
534715
@@ -565,11 +746,15 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
565746
566747-- | Default schema for @'Bounded'@, @'Integral'@ types.
567748--
568−-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
569−-- "{\"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+-- }
570755toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
571756toSchemaBoundedIntegral _ = mempty
572− & type_ ?~ SwaggerInteger
757+ & type_ ?~ OpenApiInteger
573758 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
574759 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
575760
@@ -598,8 +783,27 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
598783-- >>> instance ToSchema ButtonState
599784-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
600785-- >>> type ImageUrl = T.Text
601−-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
602−-- "{\"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+-- }
603807--
604808-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
605809-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -607,15 +811,15 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.
607811 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
608812 => Proxy (map key value) -> Declare (Definitions Schema) Schema
609813declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
610− ToJSONKeyText keyToText _ -> objectSchema keyToText
814+ ToJSONKeyText getKey _ -> objectSchema getKey
611815 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
612816 where
613− objectSchema keyToText = do
817+ objectSchema getKey = do
614818 valueRef <- declareSchemaRef (Proxy :: Proxy value)
615819 let allKeys = [minBound..maxBound :: key]
616− mkPair k = (keyToText k, valueRef)
820+ mkPair k = (keyToText $ getKey k, valueRef)
617821 return $ mempty
618− & type_ ?~ SwaggerObject
822+ & type_ ?~ OpenApiObject
619823 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
620824
621825-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -626,8 +830,27 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
626830-- >>> instance ToSchema ButtonState
627831-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
628832-- >>> type ImageUrl = T.Text
629−-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
630−-- "{\"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+-- }
631854--
632855-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
633856-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -637,32 +860,32 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.
637860toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
638861
639862-- | A configurable generic @'Schema'@ creator.
640−genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>
863+genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
641864 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
642−genericDeclareSchema = genericDeclareSchemaUnrestricted
865+genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
643866
644867-- | A configurable generic @'NamedSchema'@ creator.
645868-- This function applied to @'defaultSchemaOptions'@
646869-- is used as the default for @'declareNamedSchema'@
647870-- when the type is an instance of @'Generic'@.
648−genericDeclareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
649− SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
650−genericDeclareNamedSchema = genericDeclareNamedSchemaUnrestricted
651−
652−-- | A configurable generic @'Schema'@ creator.
653871--
654−-- Unlike 'genericDeclareSchema' also works for mixed sum types.
655−-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
656−genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
657−genericDeclareSchemaUnrestricted opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchemaUnrestricted opts proxy
658−
659−-- | A configurable generic @'NamedSchema'@ creator.
872+-- Default implementation will use the name from 'Typeable' instance, including concrete
873+-- instantioations of type variables.
660874--
661−-- Unlike 'genericDeclareNamedSchema' also works for mixed sum types.
662−-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
663−genericDeclareNamedSchemaUnrestricted :: forall a. (Generic a, GToSchema (Rep a)) =>
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) =>
664880 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
665−genericDeclareNamedSchemaUnrestricted 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+
666889
667890-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
668891genericNameSchema :: forall a d f.
@@ -678,19 +901,19 @@ gdatatypeSchemaName opts _ = case orig of
678901 orig = datatypeName (Proxy3 :: Proxy3 d f a)
679902 name = datatypeNameModifier opts orig
680903
681−-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
904+-- | Construct 'NamedSchema' usinng 'ToParamSchema'.
682905paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
683906 SchemaOptions -> Proxy a -> NamedSchema
684907paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
685908
686−-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
909+-- | Construct 'Schema' usinng 'ToParamSchema'.
687910paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
688−paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
911+paramSchemaToSchema = toParamSchema
689912
690913nullarySchema :: Schema
691914nullarySchema = mempty
692− & type_ ?~ SwaggerArray
693− & items ?~ SwaggerItemsArray []
915+ & type_ ?~ OpenApiArray
916+ & items ?~ OpenApiItemsArray []
694917
695918gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
696919gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
@@ -720,12 +943,15 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
720943 | unwrapUnaryRecords opts = fieldSchema
721944 | otherwise =
722945 case schema ^. items of
723− Just (SwaggerItemsArray [_]) -> fieldSchema
946+ Just (OpenApiItemsArray [_]) -> fieldSchema
724947 _ -> do
725− declare defs
726− 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')
727953 where
728− (defs, NamedSchema _ schema) = runDeclare recordSchema mempty
954+ (_, NamedSchema _ schema) = runDeclare recordSchema mempty
729955 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
730956 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
731957
@@ -748,10 +974,10 @@ gdeclareSchemaRef opts proxy = do
748974 return $ Ref (Reference name)
749975 _ -> Inline <$> gdeclareSchema opts proxy
750976
751−appendItem :: Referenced Schema -> Maybe (SwaggerItems 'SwaggerKindSchema) -> Maybe (SwaggerItems 'SwaggerKindSchema)
752−appendItem x Nothing = Just (SwaggerItemsArray [x])
753−appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
754−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"
755981
756982withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
757983 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
@@ -760,12 +986,12 @@ withFieldSchema opts _ isRequiredField schema = do
760986 return $
761987 if T.null fname
762988 then schema
763− & type_ ?~ SwaggerArray
989+ & type_ ?~ OpenApiArray
764990 & items %~ appendItem ref
765991 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
766992 & minItems %~ Just . maybe 1 (+1) -- increment minItems
767993 else schema
768− & type_ ?~ SwaggerObject
994+ & type_ ?~ OpenApiObject
769995 & properties . at fname ?~ ref
770996 & if isRequiredField
771997 then required %~ (++ [fname])
@@ -791,62 +1017,110 @@ instance ( GSumToSchema f
7911017 , GSumToSchema g
7921018 ) => GToSchema (f :+: g)
7931019 where
794− gdeclareNamedSchema = gdeclareNamedSumSchema
1020+ -- Aeson does not unwrap unary record in sum types.
1021+ gdeclareNamedSchema opts p s = gdeclareNamedSumSchema (opts { unwrapUnaryRecords = False } )p s
7951022
7961023gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
797−gdeclareNamedSumSchema opts proxy s
798− | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
799− | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
1024+gdeclareNamedSumSchema opts proxy _
1025+ | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchemas)
1026+ | otherwise = do
1027+ (schemas, _) <- runWriterT declareSumSchema
1028+ return $ unnamed $ mempty
1029+ & type_ ?~ OpenApiObject
1030+ & oneOf ?~ (snd <$> schemas)
8001031 where
801− declareSumSchema = gsumToSchema opts proxy s
802− (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
1032+ declareSumSchema = gsumToSchema opts proxy
1033+ (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
8031034
804− toStringTag schema = mempty
805− & type_ ?~ SwaggerString
806− & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
1035+ toStringTag schemas = mempty
1036+ & type_ ?~ OpenApiString
1037+ & enum_ ?~ map (String . fst) sumSchemas
8071038
8081039type AllNullary = All
8091040
8101041class GSumToSchema (f :: * -> *) where
811− gsumToSchema :: SchemaOptions -> Proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
1042+ gsumToSchema :: SchemaOptions -> Proxy f -> WriterT AllNullary (Declare (Definitions Schema)) [(T.Text, Referenced Schema)]
8121043
8131044instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
814− gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)
1045+ gsumToSchema opts _ =
1046+ (<>) <$> gsumToSchema opts (Proxy :: Proxy f) <*> gsumToSchema opts (Proxy :: Proxy g)
8151047
1048+-- | Convert one component of the sum to schema, to be later combined with @oneOf@.
8161049gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
817− Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
818−gsumConToSchemaWith ref opts _ schema = schema
819− & type_ ?~ SwaggerObject
820− & properties . at tag ?~ ref
821− & maxProperties ?~ 1
822− & minProperties ?~ 1
1050+ Maybe (Referenced Schema) -> SchemaOptions -> Proxy (C1 c f) -> (T.Text, Referenced Schema)
1051+gsumConToSchemaWith ref opts _ = (tag, schema)
8231052 where
1053+ schema = case sumEncoding opts of
1054+ TaggedObject tagField contentsField ->
1055+ case ref of
1056+ -- If subschema is an object and constructor is a record, we add tag directly
1057+ -- to the record, as Aeson does it.
1058+ Just (Inline sub) | sub ^. type_ == Just OpenApiObject && isRecord -> Inline $ sub
1059+ & required <>~ [T.pack tagField]
1060+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
1061+
1062+ -- If it is not a record, we need to put subschema into "contents" field.
1063+ _ | not isRecord -> Inline $ mempty
1064+ & type_ ?~ OpenApiObject
1065+ & required .~ [T.pack tagField]
1066+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
1067+ -- If constructor is nullary, there is no content.
1068+ & case ref of
1069+ Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField])
1070+ Nothing -> id
1071+
1072+ -- In the remaining cases we combine "tag" object and "contents" object using allOf.
1073+ _ -> Inline $ mempty
1074+ & type_ ?~ OpenApiObject
1075+ & allOf ?~ [Inline $ mempty
1076+ & type_ ?~ OpenApiObject
1077+ & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])
1078+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])]
1079+ & if isRecord
1080+ then allOf . _Just <>~ [refOrNullary]
1081+ else allOf . _Just <>~ [Inline $ mempty & type_ ?~ OpenApiObject & properties . at (T.pack contentsField) ?~ refOrNullary]
1082+ UntaggedValue -> refOrEnum -- Aeson encodes nullary constructors as strings in this case.
1083+ ObjectWithSingleField -> Inline $ mempty
1084+ & type_ ?~ OpenApiObject
1085+ & required .~ [tag]
1086+ & properties . at tag ?~ refOrNullary
1087+ TwoElemArray -> error "unrepresentable in OpenAPI 3"
1088+
8241089 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
1090+ isRecord = conIsRecord (Proxy3 :: Proxy3 c f p)
1091+ refOrNullary = fromMaybe (Inline nullarySchema) ref
1092+ refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) ref
8251093
8261094gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
827− SchemaOptions -> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
828−gsumConToSchema opts proxy schema = do
1095+ SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
1096+gsumConToSchema opts proxy = do
8291097 ref <- gdeclareSchemaRef opts proxy
830− return $ gsumConToSchemaWith ref opts proxy schema
1098+ return [gsumConToSchemaWith (Just ref) opts proxy]
8311099
8321100instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
833− gsumToSchema opts proxy schema = do
1101+ gsumToSchema opts proxy = do
8341102 tell (All False)
835− lift $ gsumConToSchema opts proxy schema
1103+ lift $ gsumConToSchema opts proxy
8361104
8371105instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
838− gsumToSchema opts proxy schema = do
1106+ gsumToSchema opts proxy = do
8391107 tell (All False)
840− lift $ gsumConToSchema opts proxy schema
1108+ lift $ gsumConToSchema opts proxy
8411109
8421110instance Constructor c => GSumToSchema (C1 c U1) where
843− gsumToSchema opts proxy = pure . gsumConToSchemaWith (Inline nullarySchema) opts proxy
1111+ gsumToSchema opts proxy = pure $ (:[]) $ gsumConToSchemaWith Nothing opts proxy
8441112
8451113data Proxy2 a b = Proxy2
8461114
8471115data Proxy3 a b c = Proxy3
8481116
849−-- $setup
850−-- >>> import Data.Swagger
851−-- >>> import Data.Aeson (encode)
852−-- >>> 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+119−98
@@ -1,4 +1,5 @@
11{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE CPP #-}
23{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE DeriveFunctor #-}
45{-# LANGUAGE FlexibleInstances #-}
@@ -12,29 +13,33 @@
1213{-# LANGUAGE ScopedTypeVariables #-}
1314{-# LANGUAGE TemplateHaskell #-}
1415{-# LANGUAGE UndecidableInstances #-}
16+{-# LANGUAGE ViewPatterns #-}
1517-- |
16−-- Module: Data.Swagger.Internal.Schema.Validation
18+-- Module: Data.OpenApi.Internal.Schema.Validation
1719-- Copyright: (c) 2015 GetShopTV
1820-- License: BSD3
1921-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
2022-- Stability: experimental
2123--
2224-- Validate JSON values with Swagger Schema.
23−module Data.Swagger.Internal.Schema.Validation where
25+module Data.OpenApi.Internal.Schema.Validation where
2426
2527import Prelude ()
2628import Prelude.Compat
2729
2830import Control.Applicative
29−import Control.Lens
30−import Control.Monad (when)
31+import Control.Lens hiding (allOf)
32+import Control.Monad (forM, forM_, when)
3133
3234import Data.Aeson hiding (Result)
33−import Data.Aeson.Encode.Pretty (encodePretty)
35+#if MIN_VERSION_aeson(2,0,0)
36+import qualified Data.Aeson.KeyMap as KeyMap
37+#endif
3438import Data.Foldable (for_, sequenceA_,
3539 traverse_)
40+#if !MIN_VERSION_aeson(2,0,0)
3641import Data.HashMap.Strict (HashMap)
37−import qualified Data.HashMap.Strict as HashMap
42+#endif
3843import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
3944import qualified "unordered-containers" Data.HashSet as HashSet
4045import Data.Maybe (fromMaybe)
@@ -47,10 +52,12 @@ import qualified Data.Text.Lazy.Encoding as TL
4752import Data.Vector (Vector)
4853import qualified Data.Vector as Vector
4954
50−import Data.Swagger.Declare
51−import Data.Swagger.Internal
52−import Data.Swagger.Internal.Schema
53−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
5461
5562-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
5663-- This can be used with QuickCheck to ensure those instances are coherent:
@@ -102,33 +109,33 @@ validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checke
102109-- <BLANKLINE>
103110-- Swagger Schema:
104111-- {
105−-- "required": [
106−-- "name",
107−-- "phone"
108−-- ],
109−-- "type": "object",
110112-- "properties": {
111−-- "phone": {
112−-- "$ref": "#/definitions/Phone"
113−-- },
114113-- "name": {
115114-- "type": "string"
115+-- },
116+-- "phone": {
117+-- "$ref": "#/components/schemas/Phone"
116118-- }
117−-- }
119+-- },
120+-- "required": [
121+-- "name",
122+-- "phone"
123+-- ],
124+-- "type": "object"
118125-- }
119126-- <BLANKLINE>
120127-- Swagger Description Context:
121128-- {
122129-- "Phone": {
123−-- "required": [
124−-- "value"
125−-- ],
126−-- "type": "object",
127130-- "properties": {
128131-- "value": {
129132-- "type": "string"
130133-- }
131−-- }
134+-- },
135+-- "required": [
136+-- "value"
137+-- ],
138+-- "type": "object"
132139-- }
133140-- }
134141-- <BLANKLINE>
@@ -204,7 +211,7 @@ instance Monad Result where
204211
205212-- | Validation configuration.
206213data Config = Config
207− { -- | Pattern checker for @'_paramSchemaPattern'@ validation.
214+ { -- | Pattern checker for @'_schemaPattern'@ validation.
208215 configPatternChecker :: Pattern -> Text -> Bool
209216 -- | Schema definitions in scope to resolve references.
210217 , configDefinitions :: Definitions Schema
@@ -297,40 +304,34 @@ validateWithSchemaRef (Inline s) js = sub s (validateWithSchema js)
297304
298305-- | Validate JSON @'Value'@ with Swagger @'Schema'@.
299306validateWithSchema :: Value -> Validation Schema ()
300−validateWithSchema value = do
301− validateSchemaType value
302− sub_ paramSchema $ validateEnum value
303−
304−-- | Validate JSON @'Value'@ with Swagger @'ParamSchema'@.
305−validateWithParamSchema :: Value -> Validation (ParamSchema t) ()
306−validateWithParamSchema value = do
307− validateParamSchemaType value
308− validateEnum value
307+validateWithSchema val = do
308+ validateSchemaType val
309+ validateEnum val
309310
310−validateInteger :: Scientific -> Validation (ParamSchema t) ()
311+validateInteger :: Scientific -> Validation Schema ()
311312validateInteger n = do
312313 when (not (isInteger n)) $
313314 invalid ("not an integer")
314315 validateNumber n
315316
316−validateNumber :: Scientific -> Validation (ParamSchema t) ()
317+validateNumber :: Scientific -> Validation Schema ()
317318validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do
318319 let exMax = Just True == sch ^. exclusiveMaximum
319320 exMin = Just True == sch ^. exclusiveMinimum
320321
321322 check maximum_ $ \m ->
322323 when (if exMax then (n >= m) else (n > m)) $
323− 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 ++ ")")
324325
325326 check minimum_ $ \m ->
326327 when (if exMin then (n <= m) else (n < m)) $
327− 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 ++ ")")
328329
329330 check multipleOf $ \k ->
330331 when (not (isInteger (n / k))) $
331332 invalid ("expected a multiple of " ++ show k ++ " but got " ++ show n)
332333
333−validateString :: Text -> Validation (ParamSchema t) ()
334+validateString :: Text -> Validation Schema ()
334335validateString s = do
335336 check maxLength $ \n ->
336337 when (len > fromInteger n) $
@@ -347,7 +348,7 @@ validateString s = do
347348 where
348349 len = Text.length s
349350
350−validateArray :: Vector Value -> Validation (ParamSchema t) ()
351+validateArray :: Vector Value -> Validation Schema ()
351352validateArray xs = do
352353 check maxItems $ \n ->
353354 when (len > fromInteger n) $
@@ -358,9 +359,8 @@ validateArray xs = do
358359 invalid ("array is too short (size should be >=" ++ show n ++ ")")
359360
360361 check items $ \case
361− SwaggerItemsPrimitive _ itemSchema -> sub itemSchema $ traverse_ validateWithParamSchema xs
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,21 +424,21 @@ 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 t) ()
422−validateEnum value = do
427+validateEnum :: Value -> Validation Schema ()
428+validateEnum val = do
423429 check enum_ $ \xs ->
424− when (value `notElem` xs) $
425− invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)
430+ when (val `notElem` xs) $
431+ invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show val)
426432
427433-- | Infer schema type based on used properties.
428434--
429435-- This is like 'inferParamSchemaTypes', but also works for objects:
430436--
431437-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"
432−-- Just [SwaggerObject]
433−inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]
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,62 +448,77 @@ 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 t -> [SwaggerType t]
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) ] ]
472478 ]
473479
474480validateSchemaType :: Value -> Validation Schema ()
475−validateSchemaType value = withSchema $ \sch ->
476− case (sch ^. type_, value) of
477− (Just SwaggerNull, Null) -> valid
478− (Just SwaggerBoolean, Bool _) -> valid
479− (Just SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)
480− (Just SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)
481− (Just SwaggerString, String s) -> sub_ paramSchema (validateString s)
482− (Just SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)
483− (Just SwaggerObject, Object o) -> validateObject o
484− (Nothing, Null) -> valid
485− (Nothing, Bool _) -> valid
486− -- Number by default
487− (Nothing, Number n) -> sub_ paramSchema (validateNumber n)
488− (Nothing, String s) -> sub_ paramSchema (validateString s)
489− (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)
490− (Nothing, Object o) -> validateObject o
491− bad -> invalid $ "expected JSON value of type " ++ showType bad
492−
493−validateParamSchemaType :: Value -> Validation (ParamSchema t) ()
494−validateParamSchemaType value = withSchema $ \sch ->
495− case (sch ^. type_, value) of
496− (Just SwaggerBoolean, Bool _) -> valid
497− (Just SwaggerInteger, Number n) -> validateInteger n
498− (Just SwaggerNumber, Number n) -> validateNumber n
499− (Just SwaggerString, String s) -> validateString s
500− (Just SwaggerArray, Array xs) -> validateArray xs
481+validateSchemaType val = withSchema $ \sch ->
482+ case sch of
483+ (view oneOf -> Just variants) -> do
484+ res <- forM variants $ \var ->
485+ (True <$ validateWithSchemaRef var val) <|> (return False)
486+ case length $ filter id res of
487+ 0 -> invalid $ "Value not valid under any of 'oneOf' schemas: " ++ show val
488+ 1 -> valid
489+ _ -> invalid $ "Value matches more than one of 'oneOf' schemas: " ++ show val
490+ (view allOf -> Just variants) -> do
491+ -- Default semantics for Validation Monad will abort when at least one
492+ -- variant does not match.
493+ forM_ variants $ \var ->
494+ validateWithSchemaRef var val
495+
496+ _ ->
497+ case (sch ^. type_, val) of
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
505+ (Nothing, Null) -> valid
506+ (Nothing, Bool _) -> valid
507+ -- Number by default
508+ (Nothing, Number n) -> validateNumber n
509+ (Nothing, String s) -> validateString s
510+ (Nothing, Array xs) -> validateArray xs
511+ (Nothing, Object o) -> validateObject o
512+ bad -> invalid $ "expected JSON value of type " ++ showType bad
513+
514+validateParamSchemaType :: Value -> Validation Schema ()
515+validateParamSchemaType val = withSchema $ \sch ->
516+ case (sch ^. type_, val) of
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
501522 (Nothing, Bool _) -> valid
502523 -- Number by default
503524 (Nothing, Number n) -> validateNumber n
@@ -505,11 +526,11 @@ validateParamSchemaType value = withSchema $ \sch ->
505526 (Nothing, Array xs) -> validateArray xs
506527 bad -> invalid $ "expected JSON value of type " ++ showType bad
507528
508−showType :: (Maybe (SwaggerType t), Value) -> String
529+showType :: (Maybe OpenApiType, Value) -> String
509530showType (Just ty, _) = show ty
510−showType (Nothing, Null) = "SwaggerNull"
511−showType (Nothing, Bool _) = "SwaggerBoolean"
512−showType (Nothing, Number _) = "SwaggerNumber"
513−showType (Nothing, String _) = "SwaggerString"
514−showType (Nothing, Array _) = "SwaggerArray"
515−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/OpenApi/Lens.hsnew file+166
@@ -0,0 +1,166 @@
1+{-# LANGUAGE FlexibleContexts #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE FunctionalDependencies #-}
4+{-# LANGUAGE GADTs #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
6+{-# LANGUAGE RankNTypes #-}
7+{-# LANGUAGE TemplateHaskell #-}
8+{-# LANGUAGE TypeFamilies #-}
9+{-# LANGUAGE DataKinds #-}
10+{-# LANGUAGE UndecidableInstances #-}
11+{-# OPTIONS_GHC -fno-warn-orphans #-}
12+-- |
13+-- Module: Data.OpenApi.Lens
14+-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
15+-- Stability: experimental
16+--
17+-- Lenses and prisms for Swagger.
18+module Data.OpenApi.Lens where
19+
20+import Control.Lens
21+import Data.Aeson (Value)
22+import Data.Scientific (Scientific)
23+import Data.OpenApi.Internal
24+import Data.OpenApi.Internal.Utils
25+import Data.Text (Text)
26+
27+-- * Classy lenses
28+
29+makeFields ''OpenApi
30+makeFields ''Components
31+makeFields ''Server
32+makeFields ''RequestBody
33+makeFields ''MediaTypeObject
34+makeFields ''Info
35+makeFields ''Contact
36+makeFields ''License
37+makeLensesWith swaggerFieldRules ''PathItem
38+makeFields ''Tag
39+makeFields ''Operation
40+makeLensesWith swaggerFieldRules ''Param
41+makeFields ''Header
42+makeLensesWith swaggerFieldRules ''Schema
43+makeFields ''NamedSchema
44+makeFields ''Xml
45+makeLensesWith swaggerFieldRules ''Responses
46+makeFields ''Response
47+makeLensesWith swaggerFieldRules ''SecurityScheme
48+makeFields ''ApiKeyParams
49+makeFields ''OAuth2ImplicitFlow
50+makeFields ''OAuth2PasswordFlow
51+makeFields ''OAuth2ClientCredentialsFlow
52+makeFields ''OAuth2AuthorizationCodeFlow
53+makeFields ''OAuth2Flow
54+makeFields ''OAuth2Flows
55+makeFields ''ExternalDocs
56+makeFields ''Encoding
57+makeFields ''Example
58+makeFields ''Discriminator
59+makeFields ''Link
60+
61+-- * Prisms
62+-- ** 'SecuritySchemeType' prisms
63+makePrisms ''SecuritySchemeType
64+-- ** 'Referenced' prisms
65+makePrisms ''Referenced
66+
67+-- ** 'OpenApiItems' prisms
68+
69+_OpenApiItemsArray :: Review OpenApiItems [Referenced Schema]
70+_OpenApiItemsArray
71+ = unto (\x -> OpenApiItemsArray x)
72+{- \x -> case x of
73+ OpenApiItemsPrimitive c p -> Left (OpenApiItemsPrimitive c p)
74+ OpenApiItemsObject o -> Left (OpenApiItemsObject o)
75+ OpenApiItemsArray a -> Right a
76+-}
77+
78+_OpenApiItemsObject :: Review OpenApiItems (Referenced Schema)
79+_OpenApiItemsObject
80+ = unto (\x -> OpenApiItemsObject x)
81+{- \x -> case x of
82+ OpenApiItemsPrimitive c p -> Left (OpenApiItemsPrimitive c p)
83+ OpenApiItemsObject o -> Right o
84+ OpenApiItemsArray a -> Left (OpenApiItemsArray a)
85+-}
86+
87+-- =============================================================
88+-- More helpful instances for easier access to schema properties
89+
90+type instance Index Responses = HttpStatusCode
91+type instance Index Operation = HttpStatusCode
92+
93+type instance IxValue Responses = Referenced Response
94+type instance IxValue Operation = Referenced Response
95+
96+instance Ixed Responses where ix n = responses . ix n
97+instance At Responses where at n = responses . at n
98+
99+instance Ixed Operation where ix n = responses . ix n
100+instance At Operation where at n = responses . at n
101+
102+instance HasType NamedSchema (Maybe OpenApiType) where type_ = schema.type_
103+
104+-- OVERLAPPABLE instances
105+
106+instance
107+ {-# OVERLAPPABLE #-}
108+ HasSchema s Schema
109+ => HasFormat s (Maybe Format) where
110+ format = schema.format
111+
112+instance
113+ {-# OVERLAPPABLE #-}
114+ HasSchema s Schema
115+ => HasItems s (Maybe OpenApiItems) where
116+ items = schema.items
117+
118+instance
119+ {-# OVERLAPPABLE #-}
120+ HasSchema s Schema
121+ => HasMaximum s (Maybe Scientific) where
122+ maximum_ = schema.maximum_
123+
124+instance {-# OVERLAPPABLE #-} HasSchema s Schema
125+ => HasExclusiveMaximum s (Maybe Bool) where
126+ exclusiveMaximum = schema.exclusiveMaximum
127+
128+instance {-# OVERLAPPABLE #-} HasSchema s Schema
129+ => HasMinimum s (Maybe Scientific) where
130+ minimum_ = schema.minimum_
131+
132+instance {-# OVERLAPPABLE #-} HasSchema s Schema
133+ => HasExclusiveMinimum s (Maybe Bool) where
134+ exclusiveMinimum = schema.exclusiveMinimum
135+
136+instance {-# OVERLAPPABLE #-} HasSchema s Schema
137+ => HasMaxLength s (Maybe Integer) where
138+ maxLength = schema.maxLength
139+
140+instance {-# OVERLAPPABLE #-} HasSchema s Schema
141+ => HasMinLength s (Maybe Integer) where
142+ minLength = schema.minLength
143+
144+instance {-# OVERLAPPABLE #-} HasSchema s Schema
145+ => HasPattern s (Maybe Text) where
146+ pattern = schema.pattern
147+
148+instance {-# OVERLAPPABLE #-} HasSchema s Schema
149+ => HasMaxItems s (Maybe Integer) where
150+ maxItems = schema.maxItems
151+
152+instance {-# OVERLAPPABLE #-} HasSchema s Schema
153+ => HasMinItems s (Maybe Integer) where
154+ minItems = schema.minItems
155+
156+instance {-# OVERLAPPABLE #-} HasSchema s Schema
157+ => HasUniqueItems s (Maybe Bool) where
158+ uniqueItems = schema.uniqueItems
159+
160+instance {-# OVERLAPPABLE #-} HasSchema s Schema
161+ => HasEnum s (Maybe [Value]) where
162+ enum_ = schema.enum_
163+
164+instance {-# OVERLAPPABLE #-} HasSchema s Schema
165+ => HasMultipleOf s (Maybe Scientific) where
166+ multipleOf = schema.multipleOf
src/Data/Swagger/Operation.hs → src/Data/OpenApi/Operation.hsrenamed+140−31
@@ -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,
@@ -40,11 +40,12 @@ import Data.Maybe (mapMaybe)
4040import Data.Proxy
4141import qualified Data.Set as Set
4242import Data.Text (Text)
43+import Network.HTTP.Media (MediaType)
4344
44−import Data.Swagger.Declare
45−import Data.Swagger.Internal
46−import Data.Swagger.Lens
47−import Data.Swagger.Schema
45+import Data.OpenApi.Declare
46+import Data.OpenApi.Internal
47+import Data.OpenApi.Lens
48+import Data.OpenApi.Schema
4849
4950import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
5051import qualified Data.HashSet.InsOrd as InsOrdHS
@@ -53,14 +54,18 @@ import qualified Data.HashSet.InsOrd as InsOrdHS
5354-- >>> import Data.Aeson
5455-- >>> import Data.Proxy
5556-- >>> import Data.Time
57+-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
58+-- >>> import Data.OpenApi.Internal.Utils
5659
5760-- | Prepend path piece to all operations of the spec.
5861-- Leading and trailing slashes are trimmed/added automatically.
5962--
60−-- >>> let api = (mempty :: Swagger) & paths .~ [("/info", mempty)]
61−-- >>> encode $ prependPath "user/{user_id}" api ^. paths
62−-- "{\"/user/{user_id}/info\":{}}"
63−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
6469prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
6570 where
6671 x </> y = case trim y of
@@ -70,7 +75,7 @@ prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
7075 trim = dropWhile (== '/') . dropWhileEnd (== '/')
7176
7277-- | All operations of a Swagger spec.
73−allOperations :: Traversal' Swagger Operation
78+allOperations :: Traversal' OpenApi Operation
7479allOperations = paths.traverse.template
7580
7681-- | @'operationsOf' sub@ will traverse only those operations
@@ -78,13 +83,66 @@ allOperations = paths.traverse.template
7883-- by both path and method.
7984--
8085-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
81−-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
82−-- >>> let sub = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
83−-- >>> encode api
84−-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"description\":\"OK\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
85−-- >>> encode $ api & operationsOf sub . at 404 ?~ "Not found"
86−-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"404\":{\"description\":\"Not found\"},\"200\":{\"description\":\"OK\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
87−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
88146operationsOf sub = paths.itraversed.withIndex.subops
89147 where
90148 -- | Traverse operations that correspond to paths and methods of the sub API.
@@ -106,12 +164,12 @@ operationsOf sub = paths.itraversed.withIndex.subops
106164-- @
107165-- 'applyTags' = 'applyTagsFor' 'allOperations'
108166-- @
109−applyTags :: [Tag] -> Swagger -> Swagger
167+applyTags :: [Tag] -> OpenApi -> OpenApi
110168applyTags = applyTagsFor allOperations
111169
112170-- | Apply tags to a part of Swagger spec and update the global
113171-- list of tags.
114−applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
172+applyTagsFor :: Traversal' OpenApi Operation -> [Tag] -> OpenApi -> OpenApi
115173applyTagsFor ops ts swag = swag
116174 & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))
117175 & tags %~ (<> InsOrdHS.fromList ts)
@@ -121,9 +179,27 @@ applyTagsFor ops ts swag = swag
121179--
122180-- FIXME doc
123181--
124−-- >>> encode $ runDeclare (declareResponse (Proxy :: Proxy Day)) mempty
125−-- "[{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}},{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}]"
126−declareResponse :: ToSchema a => Text -> Proxy a -> Declare (Definitions Schema) Response
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+-- ]
202+declareResponse :: ToSchema a => MediaType -> Proxy a -> Declare (Definitions Schema) Response
127203declareResponse cType proxy = do
128204 s <- declareSchemaRef proxy
129205 return (mempty & content.at cType ?~ (mempty & schema ?~ s))
@@ -139,13 +215,46 @@ declareResponse cType proxy = do
139215--
140216-- Example:
141217--
142−-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
143−-- >>> let res = declareResponse (Proxy :: Proxy Day)
144−-- >>> encode $ api & setResponse 200 res
145−-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"schema\":{\"$ref\":\"#/definitions/Day\"},\"description\":\"\"}}}}},\"definitions\":{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}}}"
218+-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]
219+-- >>> let res = declareResponse "application/json" (Proxy :: Proxy Day)
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+-- }
146255--
147256-- See also @'setResponseWith'@.
148−setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
257+setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
149258setResponse = setResponseFor allOperations
150259
151260-- | Set or update response for all operations.
@@ -159,7 +268,7 @@ setResponse = setResponseFor allOperations
159268-- @
160269--
161270-- See also @'setResponse'@.
162−setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
271+setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
163272setResponseWith = setResponseForWith allOperations
164273
165274-- | Set response for specified operations.
@@ -168,7 +277,7 @@ setResponseWith = setResponseForWith allOperations
168277-- If the response already exists it will be overwritten.
169278--
170279-- See also @'setResponseForWith'@.
171−setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
280+setResponseFor :: Traversal' OpenApi Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
172281setResponseFor ops code dres swag = swag
173282 & components.schemas %~ (<> defs)
174283 & ops . at code ?~ Inline res
@@ -182,7 +291,7 @@ setResponseFor ops code dres swag = swag
182291-- then just the new response is used.
183292--
184293-- See also @'setResponseFor'@.
185−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
186295setResponseForWith ops f code dres swag = swag
187296 & components.schemas %~ (<> defs)
188297 & ops . at code %~ Just . Inline . combine
src/Data/OpenApi/Optics.hsnew file+328
@@ -0,0 +1,328 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE MultiParamTypeClasses #-}
4+{-# LANGUAGE OverloadedLabels #-}
5+{-# LANGUAGE TemplateHaskell #-}
6+{-# LANGUAGE TypeFamilies #-}
7+{-# LANGUAGE UndecidableInstances #-}
8+{-# OPTIONS_GHC -fno-warn-orphans #-}
9+-- |
10+-- Module: Data.OpenApi.Optics
11+-- Maintainer: Andrzej Rybczak <andrzej@rybczak.net>
12+-- Stability: experimental
13+--
14+-- Lenses and prisms for the <https://hackage.haskell.org/package/optics optics>
15+-- library.
16+--
17+-- >>> import Data.Aeson
18+-- >>> import Optics.Core
19+-- >>> :set -XOverloadedLabels
20+-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
21+--
22+-- Example from the "Data.OpenApi" module using @optics@:
23+--
24+-- >>> :{
25+-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
26+-- & #components % #schemas .~ [ ("User", mempty & #type ?~ OpenApiString) ]
27+-- & #paths .~
28+-- [ ("/user", mempty & #get ?~ (mempty
29+-- & at 200 ?~ ("OK" & #_Inline % #content % at "application/json" ?~ (mempty & #schema ?~ Ref (Reference "User")))
30+-- & at 404 ?~ "User info not found")) ]
31+-- :}
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+-- }
67+--
68+-- For convenience optics are defined as /labels/. It means that field accessor
69+-- names can be overloaded for different types. One such common field is
70+-- @#description@. Many components of a Swagger specification can have
71+-- descriptions, and you can use the same name for them:
72+--
73+-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & #description .~ "No content"
74+-- {
75+-- "description": "No content"
76+-- }
77+-- >>> :{
78+-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)
79+-- & #type ?~ OpenApiBoolean
80+-- & #description ?~ "To be or not to be"
81+-- :}
82+-- {
83+-- "description": "To be or not to be",
84+-- "type": "boolean"
85+-- }
86+--
87+-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and
88+-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:
89+--
90+-- >>> :{
91+-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)
92+-- & at 404 ?~ "Not found"
93+-- :}
94+-- {
95+-- "responses": {
96+-- "404": {
97+-- "description": "Not found"
98+-- }
99+-- }
100+-- }
101+module Data.OpenApi.Optics () where
102+
103+import Data.Aeson (Value)
104+import Data.Scientific (Scientific)
105+import Data.OpenApi.Internal
106+import Data.OpenApi.Internal.Utils
107+import Data.Text (Text)
108+import Optics.Core
109+import Optics.TH
110+
111+-- Lenses
112+
113+makeFieldLabels ''OpenApi
114+makeFieldLabels ''Components
115+makeFieldLabels ''Server
116+makeFieldLabels ''ServerVariable
117+makeFieldLabels ''RequestBody
118+makeFieldLabels ''MediaTypeObject
119+makeFieldLabels ''Info
120+makeFieldLabels ''Contact
121+makeFieldLabels ''License
122+makeFieldLabels ''PathItem
123+makeFieldLabels ''Tag
124+makeFieldLabels ''Operation
125+makeFieldLabels ''Param
126+makeFieldLabels ''Header
127+makeFieldLabels ''Schema
128+makeFieldLabels ''NamedSchema
129+makeFieldLabels ''Xml
130+makeFieldLabels ''Responses
131+makeFieldLabels ''Response
132+makeFieldLabels ''SecurityScheme
133+makeFieldLabels ''ApiKeyParams
134+makeFieldLabels ''OAuth2ImplicitFlow
135+makeFieldLabels ''OAuth2PasswordFlow
136+makeFieldLabels ''OAuth2ClientCredentialsFlow
137+makeFieldLabels ''OAuth2AuthorizationCodeFlow
138+makeFieldLabels ''OAuth2Flow
139+makeFieldLabels ''OAuth2Flows
140+makeFieldLabels ''ExternalDocs
141+makeFieldLabels ''Encoding
142+makeFieldLabels ''Example
143+makeFieldLabels ''Discriminator
144+makeFieldLabels ''Link
145+
146+-- Prisms
147+
148+makePrismLabels ''SecuritySchemeType
149+makePrismLabels ''Referenced
150+
151+-- OpenApiItems prisms
152+
153+instance
154+ ( a ~ [Referenced Schema]
155+ , b ~ [Referenced Schema]
156+ ) => LabelOptic "_OpenApiItemsArray"
157+ A_Review
158+ OpenApiItems
159+ OpenApiItems
160+ a
161+ b where
162+ labelOptic = unto (\x -> OpenApiItemsArray x)
163+ {-# INLINE labelOptic #-}
164+
165+instance
166+ ( a ~ Referenced Schema
167+ , b ~ Referenced Schema
168+ ) => LabelOptic "_OpenApiItemsObject"
169+ A_Review
170+ OpenApiItems
171+ OpenApiItems
172+ a
173+ b where
174+ labelOptic = unto (\x -> OpenApiItemsObject x)
175+ {-# INLINE labelOptic #-}
176+
177+-- =============================================================
178+-- More helpful instances for easier access to schema properties
179+
180+type instance Index Responses = HttpStatusCode
181+type instance Index Operation = HttpStatusCode
182+
183+type instance IxValue Responses = Referenced Response
184+type instance IxValue Operation = Referenced Response
185+
186+instance Ixed Responses where
187+ ix n = #responses % ix n
188+ {-# INLINE ix #-}
189+instance At Responses where
190+ at n = #responses % at n
191+ {-# INLINE at #-}
192+
193+instance Ixed Operation where
194+ ix n = #responses % ix n
195+ {-# INLINE ix #-}
196+instance At Operation where
197+ at n = #responses % at n
198+ {-# INLINE at #-}
199+
200+-- #type
201+
202+instance
203+ ( a ~ Maybe OpenApiType
204+ , b ~ Maybe OpenApiType
205+ ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where
206+ labelOptic = #schema % #type
207+ {-# INLINE labelOptic #-}
208+
209+-- #default
210+
211+instance
212+ ( a ~ Maybe Value, b ~ Maybe Value
213+ ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where
214+ labelOptic = #schema % #default
215+ {-# INLINE labelOptic #-}
216+
217+-- #format
218+
219+instance
220+ ( a ~ Maybe Format, b ~ Maybe Format
221+ ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where
222+ labelOptic = #schema % #format
223+ {-# INLINE labelOptic #-}
224+
225+-- #items
226+
227+instance
228+ ( a ~ Maybe OpenApiItems
229+ , b ~ Maybe OpenApiItems
230+ ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where
231+ labelOptic = #schema % #items
232+ {-# INLINE labelOptic #-}
233+
234+-- #maximum
235+
236+instance
237+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
238+ ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where
239+ labelOptic = #schema % #maximum
240+ {-# INLINE labelOptic #-}
241+
242+-- #exclusiveMaximum
243+
244+instance
245+ ( a ~ Maybe Bool, b ~ Maybe Bool
246+ ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where
247+ labelOptic = #schema % #exclusiveMaximum
248+ {-# INLINE labelOptic #-}
249+
250+-- #minimum
251+
252+instance
253+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
254+ ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where
255+ labelOptic = #schema % #minimum
256+ {-# INLINE labelOptic #-}
257+
258+-- #exclusiveMinimum
259+
260+instance
261+ ( a ~ Maybe Bool, b ~ Maybe Bool
262+ ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where
263+ labelOptic = #schema % #exclusiveMinimum
264+ {-# INLINE labelOptic #-}
265+
266+-- #maxLength
267+
268+instance
269+ ( a ~ Maybe Integer, b ~ Maybe Integer
270+ ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where
271+ labelOptic = #schema % #maxLength
272+ {-# INLINE labelOptic #-}
273+
274+-- #minLength
275+
276+instance
277+ ( a ~ Maybe Integer, b ~ Maybe Integer
278+ ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where
279+ labelOptic = #schema % #minLength
280+ {-# INLINE labelOptic #-}
281+
282+-- #pattern
283+
284+instance
285+ ( a ~ Maybe Text, b ~ Maybe Text
286+ ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where
287+ labelOptic = #schema % #pattern
288+ {-# INLINE labelOptic #-}
289+
290+-- #maxItems
291+
292+instance
293+ ( a ~ Maybe Integer, b ~ Maybe Integer
294+ ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where
295+ labelOptic = #schema % #maxItems
296+ {-# INLINE labelOptic #-}
297+
298+-- #minItems
299+
300+instance
301+ ( a ~ Maybe Integer, b ~ Maybe Integer
302+ ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where
303+ labelOptic = #schema % #minItems
304+ {-# INLINE labelOptic #-}
305+
306+-- #uniqueItems
307+
308+instance
309+ ( a ~ Maybe Bool, b ~ Maybe Bool
310+ ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where
311+ labelOptic = #schema % #uniqueItems
312+ {-# INLINE labelOptic #-}
313+
314+-- #enum
315+
316+instance
317+ ( a ~ Maybe [Value], b ~ Maybe [Value]
318+ ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where
319+ labelOptic = #schema % #enum
320+ {-# INLINE labelOptic #-}
321+
322+-- #multipleOf
323+
324+instance
325+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
326+ ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where
327+ labelOptic = #schema % #multipleOf
328+ {-# 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−13
@@ -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,15 +32,6 @@ module Data.Swagger.Schema (
3232 paramSchemaToNamedSchema,
3333 paramSchemaToSchema,
3434
35− -- ** Unrestricted versions
36− genericDeclareNamedSchemaUnrestricted,
37− genericDeclareSchemaUnrestricted,
38−
39− -- * Schema templates
40− passwordSchema,
41− binarySchema,
42− byteSchema,
43−
4435 -- * Sketching @'Schema'@s using @'ToJSON'@
4536 sketchSchema,
4637 sketchStrictSchema,
@@ -57,5 +48,5 @@ module Data.Swagger.Schema (
5748 fromAesonOptions,
5849) where
5950
60−import Data.Swagger.Internal.Schema
61−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+23−19
@@ -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,24 @@ 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
35+schemaGen defns schema
36+ | Just variants <- schema ^. oneOf = schemaGen defns =<< elements (dereference defns <$> variants)
3337schemaGen defns schema =
3438 case schema ^. type_ of
3539 Nothing ->
@@ -37,25 +41,25 @@ schemaGen defns schema =
3741 [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)
3842 -- Gen is not MonadFail
3943 _ -> error "unable to infer schema type"
40− Just SwaggerBoolean -> Bool <$> elements [True, False]
41− Just SwaggerNull -> pure Null
42− Just SwaggerNumber
44+ Just OpenApiBoolean -> Bool <$> elements [True, False]
45+ Just OpenApiNull -> pure Null
46+ Just OpenApiNumber
4347 | Just min <- schema ^. minimum_
4448 , Just max <- schema ^. maximum_ ->
4549 Number . fromFloatDigits <$>
4650 choose (toRealFloat min, toRealFloat max :: Double)
4751 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)
48− Just SwaggerInteger
52+ Just OpenApiInteger
4953 | Just min <- schema ^. minimum_
5054 , Just max <- schema ^. maximum_ ->
5155 Number . fromInteger <$>
5256 choose (truncate min, truncate max)
5357 | otherwise -> Number . fromInteger <$> arbitrary
54− Just SwaggerArray
58+ Just OpenApiArray
5559 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
5660 | Just items <- schema ^. items ->
5761 case items of
58− SwaggerItemsObject ref -> do
62+ OpenApiItemsObject ref -> do
5963 size <- getSize
6064 let itemSchema = dereference defns ref
6165 minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems
@@ -63,17 +67,17 @@ schemaGen defns schema =
6367 arrayLength <- choose (minLength', max minLength' maxLength')
6468 generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema
6569 return . Array $ V.fromList generatedArray
66− SwaggerItemsArray refs ->
70+ OpenApiItemsArray refs ->
6771 let itemGens = schemaGen defns . dereference defns <$> refs
6872 in fmap (Array . V.fromList) $ sequence itemGens
69− Just SwaggerString -> do
73+ Just OpenApiString -> do
7074 size <- getSize
7175 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
7276 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
7377 length <- choose (minLength', max minLength' maxLength')
7478 str <- vectorOf length arbitrary
7579 return . String $ T.pack str
76− Just SwaggerObject -> do
80+ Just OpenApiObject -> do
7781 size <- getSize
7882 let props = dereference defns <$> schema ^. properties
7983 reqKeys = S.fromList $ schema ^. required
@@ -93,11 +97,11 @@ schemaGen defns schema =
9397 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
9498 _ -> return []
9599 x <- sequence $ gens <> additionalGens
96− return . Object $ M.toHashMap x
97− where
98− dereference :: Definitions a -> Referenced a -> a
99− dereference _ (Inline a) = a
100− dereference defs (Ref (Reference ref)) = fromJust $ M.lookup ref defs
100+ return . Object $ fromInsOrdHashMap x
101+
102+dereference :: Definitions a -> Referenced a -> a
103+dereference _ (Inline a) = a
104+dereference defs (Ref (Reference ref)) = fromJust $ M.lookup ref defs
101105
102106genValue :: (ToSchema a) => Proxy a -> Gen Value
103107genValue p =
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+7−3
@@ -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
@@ -22,6 +22,8 @@ data SchemaOptions = SchemaOptions
2222 , allNullaryToStringTag :: Bool
2323 -- | Hide the field name when a record constructor has only one field, like a newtype.
2424 , unwrapUnaryRecords :: Bool
25+ -- | Specifies how to encode constructors of a sum datatype.
26+ , sumEncoding :: Aeson.SumEncoding
2527 }
2628
2729-- | Default encoding @'SchemaOptions'@.
@@ -33,6 +35,7 @@ data SchemaOptions = SchemaOptions
3335-- , 'datatypeNameModifier' = id
3436-- , 'allNullaryToStringTag' = True
3537-- , 'unwrapUnaryRecords' = False
38+-- , 'sumEncoding' = 'Aeson.defaultTaggedObject'
3639-- }
3740-- @
3841defaultSchemaOptions :: SchemaOptions
@@ -42,6 +45,7 @@ defaultSchemaOptions = SchemaOptions
4245 , datatypeNameModifier = id
4346 , allNullaryToStringTag = True
4447 , unwrapUnaryRecords = False
48+ , sumEncoding = Aeson.defaultTaggedObject
4549 }
4650
4751-- | Convert 'Aeson.Options' to 'SchemaOptions'.
@@ -56,7 +60,6 @@ defaultSchemaOptions = SchemaOptions
5660-- Note that these fields have no effect on `SchemaOptions`:
5761--
5862-- * 'Aeson.omitNothingFields'
59−-- * 'Aeson.sumEncoding'
6063-- * 'Aeson.tagSingleConstructors'
6164--
6265-- The rest is defined as in 'defaultSchemaOptions'.
@@ -69,4 +72,5 @@ fromAesonOptions opts = defaultSchemaOptions
6972 , constructorTagModifier = Aeson.constructorTagModifier opts
7073 , allNullaryToStringTag = Aeson.allNullaryToStringTag opts
7174 , unwrapUnaryRecords = Aeson.unwrapUnaryRecords opts
75+ , sumEncoding = Aeson.sumEncoding opts
7276 }
src/Data/Swagger/Lens.hsdeleted−180
@@ -1,180 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE FunctionalDependencies #-}
4−{-# LANGUAGE GADTs #-}
5−{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE RankNTypes #-}
7−{-# LANGUAGE TemplateHaskell #-}
8−{-# LANGUAGE TypeFamilies #-}
9−{-# LANGUAGE DataKinds #-}
10−{-# LANGUAGE UndecidableInstances #-}
11−{-# OPTIONS_GHC -fno-warn-orphans #-}
12−-- |
13−-- Module: Data.Swagger.Lens
14−-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
15−-- Stability: experimental
16−--
17−-- Lenses and prisms for Swagger.
18−module Data.Swagger.Lens where
19−
20−import Control.Lens
21−import Data.Aeson (Value)
22−import Data.Scientific (Scientific)
23−import Data.Swagger.Internal
24−import Data.Swagger.Internal.Utils
25−import Data.Text (Text)
26−
27−-- * Classy lenses
28−
29−makeFields ''Swagger
30−makeFields ''Components
31−makeFields ''Server
32−-- conflict with enum of ParamSchema
33−--makeLensesWith swaggerFieldRules ''ServerVariable
34−makeFields ''RequestBody
35−makeFields ''MediaTypeObject
36−makeFields ''Info
37−makeFields ''Contact
38−makeFields ''License
39−makeLensesWith swaggerFieldRules ''PathItem
40−makeFields ''Tag
41−makeFields ''Operation
42−makeLensesWith swaggerFieldRules ''Param
43−makeFields ''Header
44−makeLensesWith swaggerFieldRules ''Schema
45−makeFields ''NamedSchema
46−makeLensesWith swaggerFieldRules ''ParamSchema
47−makeFields ''Xml
48−makeLensesWith swaggerFieldRules ''Responses
49−makeFields ''Response
50−makeLensesWith swaggerFieldRules ''SecurityScheme
51−makeFields ''ApiKeyParams
52−makeFields ''OAuth2ImplicitFlow
53−makeFields ''OAuth2PasswordFlow
54−makeFields ''OAuth2ClientCredentialsFlow
55−makeFields ''OAuth2AuthorizationCodeFlow
56−makeFields ''OAuth2Flow
57−makeFields ''OAuth2Flows
58−makeFields ''ExternalDocs
59−makeFields ''Encoding
60−makeFields ''Example
61−makeFields ''Discriminator
62−
63−-- * Prisms
64−-- ** 'SecuritySchemeType' prisms
65−makePrisms ''SecuritySchemeType
66−-- ** 'Referenced' prisms
67−makePrisms ''Referenced
68−
69−-- ** 'SwaggerItems' prisms
70−
71−_SwaggerItemsArray :: Review (SwaggerItems 'SwaggerKindSchema) [Referenced Schema]
72−_SwaggerItemsArray
73− = unto (\x -> SwaggerItemsArray x)
74−{- \x -> case x of
75− SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)
76− SwaggerItemsObject o -> Left (SwaggerItemsObject o)
77− SwaggerItemsArray a -> Right a
78−-}
79−
80−_SwaggerItemsObject :: Review (SwaggerItems 'SwaggerKindSchema) (Referenced Schema)
81−_SwaggerItemsObject
82− = unto (\x -> SwaggerItemsObject x)
83−{- \x -> case x of
84− SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)
85− SwaggerItemsObject o -> Right o
86− SwaggerItemsArray a -> Left (SwaggerItemsArray a)
87−-}
88−
89−_SwaggerItemsPrimitive :: forall t p f. (Profunctor p, Bifunctor p, Functor f) => Optic' p f (SwaggerItems t) (Maybe (CollectionFormat t), ParamSchema t)
90−_SwaggerItemsPrimitive = unto (\(c, p) -> SwaggerItemsPrimitive c p)
91−
92−-- =============================================================
93−-- More helpful instances for easier access to schema properties
94−
95−type instance Index Responses = HttpStatusCode
96−type instance Index Operation = HttpStatusCode
97−
98−type instance IxValue Responses = Referenced Response
99−type instance IxValue Operation = Referenced Response
100−
101−instance Ixed Responses where ix n = responses . ix n
102−instance At Responses where at n = responses . at n
103−
104−instance Ixed Operation where ix n = responses . ix n
105−instance At Operation where at n = responses . at n
106−
107−instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema
108−
109−-- HasType instances
110−instance HasType Header (Maybe (SwaggerType ('SwaggerKindNormal Header))) where type_ = schema.type_
111−instance HasType Schema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_
112−instance HasType NamedSchema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_
113−
114−-- HasDefault instances
115−instance HasDefault Header (Maybe Value) where default_ = schema.default_
116−instance HasDefault Schema (Maybe Value) where default_ = paramSchema.default_
117−
118−-- OVERLAPPABLE instances
119−
120−instance
121− {-# OVERLAPPABLE #-}
122− HasParamSchema s (ParamSchema t)
123− => HasFormat s (Maybe Format) where
124− format = paramSchema.format
125−
126−instance
127− {-# OVERLAPPABLE #-}
128− HasParamSchema s (ParamSchema t)
129− => HasItems s (Maybe (SwaggerItems t)) where
130− items = paramSchema.items
131−
132−instance
133− {-# OVERLAPPABLE #-}
134− HasParamSchema s (ParamSchema t)
135− => HasMaximum s (Maybe Scientific) where
136− maximum_ = paramSchema.maximum_
137−
138−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
139− => HasExclusiveMaximum s (Maybe Bool) where
140− exclusiveMaximum = paramSchema.exclusiveMaximum
141−
142−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
143− => HasMinimum s (Maybe Scientific) where
144− minimum_ = paramSchema.minimum_
145−
146−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
147− => HasExclusiveMinimum s (Maybe Bool) where
148− exclusiveMinimum = paramSchema.exclusiveMinimum
149−
150−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
151− => HasMaxLength s (Maybe Integer) where
152− maxLength = paramSchema.maxLength
153−
154−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
155− => HasMinLength s (Maybe Integer) where
156− minLength = paramSchema.minLength
157−
158−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
159− => HasPattern s (Maybe Text) where
160− pattern = paramSchema.pattern
161−
162−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
163− => HasMaxItems s (Maybe Integer) where
164− maxItems = paramSchema.maxItems
165−
166−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
167− => HasMinItems s (Maybe Integer) where
168− minItems = paramSchema.minItems
169−
170−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
171− => HasUniqueItems s (Maybe Bool) where
172− uniqueItems = paramSchema.uniqueItems
173−
174−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
175− => HasEnum s (Maybe [Value]) where
176− enum_ = paramSchema.enum_
177−
178−instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
179− => HasMultipleOf s (Maybe Scientific) where
180− multipleOf = paramSchema.multipleOf
src/Data/Swagger/Optics.hsdeleted−509
@@ -1,509 +0,0 @@
1−{-# LANGUAGE DataKinds #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE MultiParamTypeClasses #-}
4−{-# LANGUAGE OverloadedLabels #-}
5−{-# LANGUAGE TemplateHaskell #-}
6−{-# LANGUAGE TypeFamilies #-}
7−{-# LANGUAGE UndecidableInstances #-}
8−{-# OPTIONS_GHC -fno-warn-orphans #-}
9−-- |
10−-- Module: Data.Swagger.Optics
11−-- Maintainer: Andrzej Rybczak <andrzej@rybczak.net>
12−-- Stability: experimental
13−--
14−-- Lenses and prisms for the <https://hackage.haskell.org/package/optics optics>
15−-- library.
16−--
17−-- >>> import Data.Aeson
18−-- >>> import Optics.Core
19−-- >>> :set -XOverloadedLabels
20−--
21−-- Example from the "Data.Swagger" module using @optics@:
22−--
23−-- >>> :{
24−-- encode $ (mempty :: Swagger)
25−-- & #definitions .~ [ ("User", mempty & #type ?~ SwaggerString) ]
26−-- & #paths .~
27−-- [ ("/user", mempty & #get ?~ (mempty
28−-- & #produces ?~ MimeList ["application/json"]
29−-- & at 200 ?~ ("OK" & #_Inline % #schema ?~ Ref (Reference "User"))
30−-- & at 404 ?~ "User info not found")) ]
31−-- :}
32−-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"produces\":[\"application/json\"],\"responses\":{\"404\":{\"description\":\"User info not found\"},\"200\":{\"schema\":{\"$ref\":\"#/definitions/User\"},\"description\":\"OK\"}}}}},\"definitions\":{\"User\":{\"type\":\"string\"}}}"
33−--
34−-- For convenience optics are defined as /labels/. It means that field accessor
35−-- names can be overloaded for different types. One such common field is
36−-- @#description@. Many components of a Swagger specification can have
37−-- descriptions, and you can use the same name for them:
38−--
39−-- >>> encode $ (mempty :: Response) & #description .~ "No content"
40−-- "{\"description\":\"No content\"}"
41−-- >>> :{
42−-- encode $ (mempty :: Schema)
43−-- & #type ?~ SwaggerBoolean
44−-- & #description ?~ "To be or not to be"
45−-- :}
46−-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"
47−--
48−-- @'ParamSchema'@ is basically the /base schema specification/ and many types
49−-- contain it. So for convenience, all @'ParamSchema'@ fields are transitively
50−-- made fields of the type that has it. For example, you can use @#type@ to
51−-- access @'SwaggerType'@ of @'Header'@ schema without having to use
52−-- @#paramSchema@:
53−--
54−-- >>> encode $ (mempty :: Header) & #type ?~ SwaggerNumber
55−-- "{\"type\":\"number\"}"
56−--
57−-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and
58−-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:
59−--
60−-- >>> :{
61−-- encode $ (mempty :: Operation)
62−-- & at 404 ?~ "Not found"
63−-- :}
64−-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"
65−--
66−module Data.Swagger.Optics () where
67−
68−import Data.Aeson (Value)
69−import Data.Scientific (Scientific)
70−import Data.Swagger.Internal
71−import Data.Text (Text)
72−import Optics.Core
73−import Optics.TH
74−
75−-- Lenses
76−
77−makeFieldLabels ''Swagger
78−makeFieldLabels ''Components
79−makeFieldLabels ''Server
80−makeFieldLabels ''ServerVariable
81−makeFieldLabels ''RequestBody
82−makeFieldLabels ''MediaTypeObject
83−makeFieldLabels ''Info
84−makeFieldLabels ''Contact
85−makeFieldLabels ''License
86−makeFieldLabels ''PathItem
87−makeFieldLabels ''Tag
88−makeFieldLabels ''Operation
89−makeFieldLabels ''Param
90−makeFieldLabels ''Header
91−makeFieldLabels ''Schema
92−makeFieldLabels ''NamedSchema
93−makeFieldLabels ''ParamSchema
94−makeFieldLabels ''Xml
95−makeFieldLabels ''Responses
96−makeFieldLabels ''Response
97−makeFieldLabels ''SecurityScheme
98−makeFieldLabels ''ApiKeyParams
99−makeFieldLabels ''OAuth2ImplicitFlow
100−makeFieldLabels ''OAuth2PasswordFlow
101−makeFieldLabels ''OAuth2ClientCredentialsFlow
102−makeFieldLabels ''OAuth2AuthorizationCodeFlow
103−makeFieldLabels ''OAuth2Flow
104−makeFieldLabels ''OAuth2Flows
105−makeFieldLabels ''ExternalDocs
106−makeFieldLabels ''Encoding
107−makeFieldLabels ''Example
108−makeFieldLabels ''Discriminator
109−
110−-- Prisms
111−
112−makePrismLabels ''SecuritySchemeType
113−makePrismLabels ''Referenced
114−
115−-- SwaggerItems prisms
116−
117−instance
118− ( a ~ [Referenced Schema]
119− , b ~ [Referenced Schema]
120− ) => LabelOptic "_SwaggerItemsArray"
121− A_Review
122− (SwaggerItems 'SwaggerKindSchema)
123− (SwaggerItems 'SwaggerKindSchema)
124− a
125− b where
126− labelOptic = unto (\x -> SwaggerItemsArray x)
127− {-# INLINE labelOptic #-}
128−
129−instance
130− ( a ~ Referenced Schema
131− , b ~ Referenced Schema
132− ) => LabelOptic "_SwaggerItemsObject"
133− A_Review
134− (SwaggerItems 'SwaggerKindSchema)
135− (SwaggerItems 'SwaggerKindSchema)
136− a
137− b where
138− labelOptic = unto (\x -> SwaggerItemsObject x)
139− {-# INLINE labelOptic #-}
140−
141−instance
142− ( a ~ (Maybe (CollectionFormat t), ParamSchema t)
143− , b ~ (Maybe (CollectionFormat t), ParamSchema t)
144− ) => LabelOptic "_SwaggerItemsPrimitive"
145− A_Review
146− (SwaggerItems t)
147− (SwaggerItems t)
148− a
149− b where
150− labelOptic = unto (\(c, p) -> SwaggerItemsPrimitive c p)
151− {-# INLINE labelOptic #-}
152−
153−-- =============================================================
154−-- More helpful instances for easier access to schema properties
155−
156−type instance Index Responses = HttpStatusCode
157−type instance Index Operation = HttpStatusCode
158−
159−type instance IxValue Responses = Referenced Response
160−type instance IxValue Operation = Referenced Response
161−
162−instance Ixed Responses where
163− ix n = #responses % ix n
164− {-# INLINE ix #-}
165−instance At Responses where
166− at n = #responses % at n
167− {-# INLINE at #-}
168−
169−instance Ixed Operation where
170− ix n = #responses % ix n
171− {-# INLINE ix #-}
172−instance At Operation where
173− at n = #responses % at n
174− {-# INLINE at #-}
175−
176−-- #paramSchema
177−
178−instance
179− ( a ~ ParamSchema 'SwaggerKindSchema
180− , b ~ ParamSchema 'SwaggerKindSchema
181− ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where
182− labelOptic = #schema % #paramSchema
183− {-# INLINE labelOptic #-}
184−
185−-- #type
186−
187−instance
188− ( a ~ Maybe (SwaggerType ('SwaggerKindNormal Header))
189− , b ~ Maybe (SwaggerType ('SwaggerKindNormal Header))
190− ) => LabelOptic "type" A_Lens Header Header a b where
191− labelOptic = #schema % #type
192− {-# INLINE labelOptic #-}
193−
194−instance
195− ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)
196− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)
197− ) => LabelOptic "type" A_Lens Schema Schema a b where
198− labelOptic = #paramSchema % #type
199− {-# INLINE labelOptic #-}
200−
201−instance
202− ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)
203− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)
204− ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where
205− labelOptic = #paramSchema % #type
206− {-# INLINE labelOptic #-}
207−
208−-- #default
209−
210−instance
211− ( a ~ Maybe Value, b ~ Maybe Value
212− ) => LabelOptic "default" A_Lens Header Header a b where
213− labelOptic = #schema % #default
214− {-# INLINE labelOptic #-}
215−
216−instance
217− ( a ~ Maybe Value, b ~ Maybe Value
218− ) => LabelOptic "default" A_Lens Schema Schema a b where
219− labelOptic = #paramSchema % #default
220− {-# INLINE labelOptic #-}
221−
222−instance
223− ( a ~ Maybe Value, b ~ Maybe Value
224− ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where
225− labelOptic = #paramSchema % #default
226− {-# INLINE labelOptic #-}
227−
228−-- #format
229−
230−instance
231− ( a ~ Maybe Format, b ~ Maybe Format
232− ) => LabelOptic "format" A_Lens Header Header a b where
233− labelOptic = #schema % #format
234− {-# INLINE labelOptic #-}
235−
236−instance
237− ( a ~ Maybe Format, b ~ Maybe Format
238− ) => LabelOptic "format" A_Lens Schema Schema a b where
239− labelOptic = #paramSchema % #format
240− {-# INLINE labelOptic #-}
241−
242−instance
243− ( a ~ Maybe Format, b ~ Maybe Format
244− ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where
245− labelOptic = #paramSchema % #format
246− {-# INLINE labelOptic #-}
247−
248−-- #items
249−
250−instance
251− ( a ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))
252− , b ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))
253− ) => LabelOptic "items" A_Lens Header Header a b where
254− labelOptic = #schema % #items
255− {-# INLINE labelOptic #-}
256−
257−instance
258− ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)
259− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)
260− ) => LabelOptic "items" A_Lens Schema Schema a b where
261− labelOptic = #paramSchema % #items
262− {-# INLINE labelOptic #-}
263−
264−instance
265− ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)
266− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)
267− ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where
268− labelOptic = #paramSchema % #items
269− {-# INLINE labelOptic #-}
270−
271−-- #maximum
272−
273−instance
274− ( a ~ Maybe Scientific, b ~ Maybe Scientific
275− ) => LabelOptic "maximum" A_Lens Header Header a b where
276− labelOptic = #schema % #maximum
277− {-# INLINE labelOptic #-}
278−
279−instance
280− ( a ~ Maybe Scientific, b ~ Maybe Scientific
281− ) => LabelOptic "maximum" A_Lens Schema Schema a b where
282− labelOptic = #paramSchema % #maximum
283− {-# INLINE labelOptic #-}
284−
285−instance
286− ( a ~ Maybe Scientific, b ~ Maybe Scientific
287− ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where
288− labelOptic = #paramSchema % #maximum
289− {-# INLINE labelOptic #-}
290−
291−-- #exclusiveMaximum
292−
293−instance
294− ( a ~ Maybe Bool, b ~ Maybe Bool
295− ) => LabelOptic "exclusiveMaximum" A_Lens Header Header a b where
296− labelOptic = #schema % #exclusiveMaximum
297− {-# INLINE labelOptic #-}
298−
299−instance
300− ( a ~ Maybe Bool, b ~ Maybe Bool
301− ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where
302− labelOptic = #paramSchema % #exclusiveMaximum
303− {-# INLINE labelOptic #-}
304−
305−instance
306− ( a ~ Maybe Bool, b ~ Maybe Bool
307− ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where
308− labelOptic = #paramSchema % #exclusiveMaximum
309− {-# INLINE labelOptic #-}
310−
311−-- #minimum
312−
313−instance
314− ( a ~ Maybe Scientific, b ~ Maybe Scientific
315− ) => LabelOptic "minimum" A_Lens Header Header a b where
316− labelOptic = #schema % #minimum
317− {-# INLINE labelOptic #-}
318−
319−instance
320− ( a ~ Maybe Scientific, b ~ Maybe Scientific
321− ) => LabelOptic "minimum" A_Lens Schema Schema a b where
322− labelOptic = #paramSchema % #minimum
323− {-# INLINE labelOptic #-}
324−
325−instance
326− ( a ~ Maybe Scientific, b ~ Maybe Scientific
327− ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where
328− labelOptic = #paramSchema % #minimum
329− {-# INLINE labelOptic #-}
330−
331−-- #exclusiveMinimum
332−
333−instance
334− ( a ~ Maybe Bool, b ~ Maybe Bool
335− ) => LabelOptic "exclusiveMinimum" A_Lens Header Header a b where
336− labelOptic = #schema % #exclusiveMinimum
337− {-# INLINE labelOptic #-}
338−
339−instance
340− ( a ~ Maybe Bool, b ~ Maybe Bool
341− ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where
342− labelOptic = #paramSchema % #exclusiveMinimum
343− {-# INLINE labelOptic #-}
344−
345−instance
346− ( a ~ Maybe Bool, b ~ Maybe Bool
347− ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where
348− labelOptic = #paramSchema % #exclusiveMinimum
349− {-# INLINE labelOptic #-}
350−
351−-- #maxLength
352−
353−instance
354− ( a ~ Maybe Integer, b ~ Maybe Integer
355− ) => LabelOptic "maxLength" A_Lens Header Header a b where
356− labelOptic = #schema % #maxLength
357− {-# INLINE labelOptic #-}
358−
359−instance
360− ( a ~ Maybe Integer, b ~ Maybe Integer
361− ) => LabelOptic "maxLength" A_Lens Schema Schema a b where
362− labelOptic = #paramSchema % #maxLength
363− {-# INLINE labelOptic #-}
364−
365−instance
366− ( a ~ Maybe Integer, b ~ Maybe Integer
367− ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where
368− labelOptic = #paramSchema % #maxLength
369− {-# INLINE labelOptic #-}
370−
371−-- #minLength
372−
373−instance
374− ( a ~ Maybe Integer, b ~ Maybe Integer
375− ) => LabelOptic "minLength" A_Lens Header Header a b where
376− labelOptic = #schema % #minLength
377− {-# INLINE labelOptic #-}
378−
379−instance
380− ( a ~ Maybe Integer, b ~ Maybe Integer
381− ) => LabelOptic "minLength" A_Lens Schema Schema a b where
382− labelOptic = #paramSchema % #minLength
383− {-# INLINE labelOptic #-}
384−
385−instance
386− ( a ~ Maybe Integer, b ~ Maybe Integer
387− ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where
388− labelOptic = #paramSchema % #minLength
389− {-# INLINE labelOptic #-}
390−
391−-- #pattern
392−
393−instance
394− ( a ~ Maybe Text, b ~ Maybe Text
395− ) => LabelOptic "pattern" A_Lens Header Header a b where
396− labelOptic = #schema % #pattern
397− {-# INLINE labelOptic #-}
398−
399−instance
400− ( a ~ Maybe Text, b ~ Maybe Text
401− ) => LabelOptic "pattern" A_Lens Schema Schema a b where
402− labelOptic = #paramSchema % #pattern
403− {-# INLINE labelOptic #-}
404−
405−instance
406− ( a ~ Maybe Text, b ~ Maybe Text
407− ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where
408− labelOptic = #paramSchema % #pattern
409− {-# INLINE labelOptic #-}
410−
411−-- #maxItems
412−
413−instance
414− ( a ~ Maybe Integer, b ~ Maybe Integer
415− ) => LabelOptic "maxItems" A_Lens Header Header a b where
416− labelOptic = #schema % #maxItems
417− {-# INLINE labelOptic #-}
418−
419−instance
420− ( a ~ Maybe Integer, b ~ Maybe Integer
421− ) => LabelOptic "maxItems" A_Lens Schema Schema a b where
422− labelOptic = #paramSchema % #maxItems
423− {-# INLINE labelOptic #-}
424−
425−instance
426− ( a ~ Maybe Integer, b ~ Maybe Integer
427− ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where
428− labelOptic = #paramSchema % #maxItems
429− {-# INLINE labelOptic #-}
430−
431−-- #minItems
432−
433−instance
434− ( a ~ Maybe Integer, b ~ Maybe Integer
435− ) => LabelOptic "minItems" A_Lens Header Header a b where
436− labelOptic = #schema % #minItems
437− {-# INLINE labelOptic #-}
438−
439−instance
440− ( a ~ Maybe Integer, b ~ Maybe Integer
441− ) => LabelOptic "minItems" A_Lens Schema Schema a b where
442− labelOptic = #paramSchema % #minItems
443− {-# INLINE labelOptic #-}
444−
445−instance
446− ( a ~ Maybe Integer, b ~ Maybe Integer
447− ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where
448− labelOptic = #paramSchema % #minItems
449− {-# INLINE labelOptic #-}
450−
451−-- #uniqueItems
452−
453−instance
454− ( a ~ Maybe Bool, b ~ Maybe Bool
455− ) => LabelOptic "uniqueItems" A_Lens Header Header a b where
456− labelOptic = #schema % #uniqueItems
457− {-# INLINE labelOptic #-}
458−
459−instance
460− ( a ~ Maybe Bool, b ~ Maybe Bool
461− ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where
462− labelOptic = #paramSchema % #uniqueItems
463− {-# INLINE labelOptic #-}
464−
465−instance
466− ( a ~ Maybe Bool, b ~ Maybe Bool
467− ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where
468− labelOptic = #paramSchema % #uniqueItems
469− {-# INLINE labelOptic #-}
470−
471−-- #enum
472−
473−instance
474− ( a ~ Maybe [Value], b ~ Maybe [Value]
475− ) => LabelOptic "enum" A_Lens Header Header a b where
476− labelOptic = #schema % #enum
477− {-# INLINE labelOptic #-}
478−
479−instance
480− ( a ~ Maybe [Value], b ~ Maybe [Value]
481− ) => LabelOptic "enum" A_Lens Schema Schema a b where
482− labelOptic = #paramSchema % #enum
483− {-# INLINE labelOptic #-}
484−
485−instance
486− ( a ~ Maybe [Value], b ~ Maybe [Value]
487− ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where
488− labelOptic = #paramSchema % #enum
489− {-# INLINE labelOptic #-}
490−
491−-- #multipleOf
492−
493−instance
494− ( a ~ Maybe Scientific, b ~ Maybe Scientific
495− ) => LabelOptic "multipleOf" A_Lens Header Header a b where
496− labelOptic = #schema % #multipleOf
497− {-# INLINE labelOptic #-}
498−
499−instance
500− ( a ~ Maybe Scientific, b ~ Maybe Scientific
501− ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where
502− labelOptic = #paramSchema % #multipleOf
503− {-# INLINE labelOptic #-}
504−
505−instance
506− ( a ~ Maybe Scientific, b ~ Maybe Scientific
507− ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where
508− labelOptic = #paramSchema % #multipleOf
509− {-# INLINE labelOptic #-}
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+430−94
@@ -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
@@ -271,106 +271,192 @@ instance ToSchema Character
271271characterSchemaJSON :: Value
272272characterSchemaJSON = [aesonQQ|
273273{
274− "type": "object",
275− "properties":
274+ "oneOf": [
276275 {
277− "PC": { "$ref": "#/components/schemas/Player" },
278− "NPC":
279− {
280− "type": "object",
281− "properties":
282− {
283− "npcName": { "type": "string" },
284− "npcPosition": { "$ref": "#/components/schemas/Point" }
285− },
286− "required": ["npcName", "npcPosition"]
276+ "required": [
277+ "tag",
278+ "contents"
279+ ],
280+ "type": "object",
281+ "properties": {
282+ "tag": {
283+ "type": "string",
284+ "enum": [
285+ "PC"
286+ ]
287+ },
288+ "contents": {
289+ "$ref": "#/components/schemas/Player"
287290 }
291+ }
288292 },
289− "maxProperties": 1,
290− "minProperties": 1
293+ {
294+ "required": [
295+ "npcName",
296+ "npcPosition",
297+ "tag"
298+ ],
299+ "type": "object",
300+ "properties": {
301+ "tag": {
302+ "type": "string",
303+ "enum": [
304+ "NPC"
305+ ]
306+ },
307+ "npcPosition": {
308+ "$ref": "#/components/schemas/Point"
309+ },
310+ "npcName": {
311+ "type": "string"
312+ }
313+ }
314+ }
315+ ],
316+ "type": "object"
291317}
318+
292319|]
293320
294321characterInlinedSchemaJSON :: Value
295322characterInlinedSchemaJSON = [aesonQQ|
296323{
297− "type": "object",
298− "properties":
324+ "oneOf": [
299325 {
300− "PC":
301− {
326+ "required": [
327+ "tag",
328+ "contents"
329+ ],
330+ "type": "object",
331+ "properties": {
332+ "tag": {
333+ "type": "string",
334+ "enum": [
335+ "PC"
336+ ]
337+ },
338+ "contents": {
339+ "required": [
340+ "position"
341+ ],
302342 "type": "object",
303− "properties":
304− {
305− "position":
306− {
307− "type": "object",
308− "properties":
309− {
310− "x": { "type": "number", "format": "double" },
311− "y": { "type": "number", "format": "double" }
312− },
313− "required": ["x", "y"]
343+ "properties": {
344+ "position": {
345+ "required": [
346+ "x",
347+ "y"
348+ ],
349+ "type": "object",
350+ "properties": {
351+ "x": {
352+ "format": "double",
353+ "type": "number"
354+ },
355+ "y": {
356+ "format": "double",
357+ "type": "number"
314358 }
315− },
316− "required": ["position"]
359+ }
360+ }
361+ }
362+ }
363+ }
364+ },
365+ {
366+ "required": [
367+ "npcName",
368+ "npcPosition",
369+ "tag"
370+ ],
371+ "type": "object",
372+ "properties": {
373+ "tag": {
374+ "type": "string",
375+ "enum": [
376+ "NPC"
377+ ]
317378 },
318− "NPC":
319− {
379+ "npcPosition": {
380+ "required": [
381+ "x",
382+ "y"
383+ ],
320384 "type": "object",
321− "properties":
322− {
323− "npcName": { "type": "string" },
324− "npcPosition":
325− {
326− "type": "object",
327− "properties":
328− {
329− "x": { "type": "number", "format": "double" },
330− "y": { "type": "number", "format": "double" }
331− },
332− "required": ["x", "y"]
333− }
385+ "properties": {
386+ "x": {
387+ "format": "double",
388+ "type": "number"
334389 },
335− "required": ["npcName", "npcPosition"]
390+ "y": {
391+ "format": "double",
392+ "type": "number"
393+ }
394+ }
395+ },
396+ "npcName": {
397+ "type": "string"
336398 }
337− },
338− "maxProperties": 1,
339− "minProperties": 1
399+ }
400+ }
401+ ],
402+ "type": "object"
340403}
341404|]
342405
343406characterInlinedPlayerSchemaJSON :: Value
344407characterInlinedPlayerSchemaJSON = [aesonQQ|
345408{
346− "type": "object",
347− "properties":
409+ "oneOf": [
348410 {
349− "PC":
350− {
351− "type": "object",
352− "properties":
353− {
354− "position":
355− {
356− "$ref": "#/components/schemas/Point"
357− }
358− },
359− "required": ["position"]
411+ "required": [
412+ "tag",
413+ "contents"
414+ ],
415+ "type": "object",
416+ "properties": {
417+ "tag": {
418+ "type": "string",
419+ "enum": [
420+ "PC"
421+ ]
360422 },
361− "NPC":
362− {
423+ "contents": {
424+ "required": [
425+ "position"
426+ ],
363427 "type": "object",
364− "properties":
365− {
366− "npcName": { "type": "string" },
367− "npcPosition": { "$ref": "#/components/schemas/Point" }
368− },
369− "required": ["npcName", "npcPosition"]
428+ "properties": {
429+ "position": {
430+ "$ref": "#/components/schemas/Point"
431+ }
432+ }
370433 }
434+ }
371435 },
372− "maxProperties": 1,
373− "minProperties": 1
436+ {
437+ "required": [
438+ "npcName",
439+ "npcPosition",
440+ "tag"
441+ ],
442+ "type": "object",
443+ "properties": {
444+ "tag": {
445+ "type": "string",
446+ "enum": [
447+ "NPC"
448+ ]
449+ },
450+ "npcPosition": {
451+ "$ref": "#/components/schemas/Point"
452+ },
453+ "npcName": {
454+ "type": "string"
455+ }
456+ }
457+ }
458+ ],
459+ "type": "object"
374460}
375461|]
376462
@@ -542,42 +628,169 @@ data Light
542628 deriving (Generic)
543629
544630instance ToSchema Light where
545− declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
631+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
546632 { unwrapUnaryRecords = True }
547633
548634lightSchemaJSON :: Value
549635lightSchemaJSON = [aesonQQ|
550636{
551− "type": "object",
552− "properties":
637+ "oneOf": [
553638 {
554− "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },
555− "LightFreq": { "type": "number", "format": "double" },
556− "LightColor": { "$ref": "#/components/schemas/Color" },
557− "LightWaveLength": { "type": "number", "format": "double" }
639+ "required": [
640+ "tag"
641+ ],
642+ "type": "object",
643+ "properties": {
644+ "tag": {
645+ "type": "string",
646+ "enum": [
647+ "NoLight"
648+ ]
649+ }
650+ }
651+ },
652+ {
653+ "required": [
654+ "tag",
655+ "contents"
656+ ],
657+ "type": "object",
658+ "properties": {
659+ "tag": {
660+ "type": "string",
661+ "enum": [
662+ "LightFreq"
663+ ]
664+ },
665+ "contents": {
666+ "format": "double",
667+ "type": "number"
668+ }
669+ }
558670 },
559− "maxProperties": 1,
560− "minProperties": 1
671+ {
672+ "required": [
673+ "tag",
674+ "contents"
675+ ],
676+ "type": "object",
677+ "properties": {
678+ "tag": {
679+ "type": "string",
680+ "enum": [
681+ "LightColor"
682+ ]
683+ },
684+ "contents": {
685+ "$ref": "#/components/schemas/Color"
686+ }
687+ }
688+ },
689+ {
690+ "required": [
691+ "waveLength",
692+ "tag"
693+ ],
694+ "type": "object",
695+ "properties": {
696+ "tag": {
697+ "type": "string",
698+ "enum": [
699+ "LightWaveLength"
700+ ]
701+ },
702+ "waveLength": {
703+ "format": "double",
704+ "type": "number"
705+ }
706+ }
707+ }
708+ ],
709+ "type": "object"
561710}
562711|]
563712
564713lightInlinedSchemaJSON :: Value
565714lightInlinedSchemaJSON = [aesonQQ|
566715{
567− "type": "object",
568− "properties":
716+ "oneOf": [
569717 {
570− "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },
571− "LightFreq": { "type": "number", "format": "double" },
572− "LightColor":
573− {
718+ "required": [
719+ "tag"
720+ ],
721+ "type": "object",
722+ "properties": {
723+ "tag": {
574724 "type": "string",
575− "enum": ["Red", "Green", "Blue"]
725+ "enum": [
726+ "NoLight"
727+ ]
728+ }
729+ }
730+ },
731+ {
732+ "required": [
733+ "tag",
734+ "contents"
735+ ],
736+ "type": "object",
737+ "properties": {
738+ "tag": {
739+ "type": "string",
740+ "enum": [
741+ "LightFreq"
742+ ]
743+ },
744+ "contents": {
745+ "format": "double",
746+ "type": "number"
747+ }
748+ }
749+ },
750+ {
751+ "required": [
752+ "tag",
753+ "contents"
754+ ],
755+ "type": "object",
756+ "properties": {
757+ "tag": {
758+ "type": "string",
759+ "enum": [
760+ "LightColor"
761+ ]
576762 },
577− "LightWaveLength": { "type": "number", "format": "double" }
763+ "contents": {
764+ "type": "string",
765+ "enum": [
766+ "Red",
767+ "Green",
768+ "Blue"
769+ ]
770+ }
771+ }
578772 },
579− "maxProperties": 1,
580− "minProperties": 1
773+ {
774+ "required": [
775+ "waveLength",
776+ "tag"
777+ ],
778+ "type": "object",
779+ "properties": {
780+ "tag": {
781+ "type": "string",
782+ "enum": [
783+ "LightWaveLength"
784+ ]
785+ },
786+ "waveLength": {
787+ "format": "double",
788+ "type": "number"
789+ }
790+ }
791+ }
792+ ],
793+ "type": "object"
581794}
582795|]
583796
@@ -650,6 +863,129 @@ singleMaybeFieldSchemaJSON = [aesonQQ|
650863}
651864|]
652865
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+|]
653989
654990-- ========================================================================
655991-- TimeOfDay
test/Data/Swagger/ParamSchemaSpec.hs → test/Data/OpenApi/ParamSchemaSpec.hsrenamed+4−5
@@ -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,10 +12,9 @@ import Data.Char
1212import Data.Proxy
1313import GHC.Generics
1414
15−import Data.Swagger
16−import Data.Swagger.Internal (SwaggerKind(..))
15+import Data.OpenApi
1716
18−import Data.Swagger.CommonTestTypes
17+import Data.OpenApi.CommonTestTypes
1918import SpecCommon
2019import Test.Hspec
2120import Data.Time.LocalTime
@@ -23,7 +22,7 @@ import Data.Time.LocalTime
2322import qualified Data.HashMap.Strict as HM
2423
2524checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec
26−checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js
25+checkToParamSchema proxy js = (toParamSchema proxy :: Schema) <=> js
2726
2827spec :: Spec
2928spec = 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+56−9
@@ -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
@@ -91,6 +97,8 @@ spec = do
9197 prop "Paint" $ shouldValidate (Proxy :: Proxy Paint)
9298 prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
9399 prop "Light" $ shouldValidate (Proxy :: Proxy Light)
100+ prop "Light TaggedObject" $ shouldValidate (Proxy :: Proxy LightTaggedObject)
101+ prop "Light UntaggedValue" $ shouldValidate (Proxy :: Proxy LightUntaggedValue)
94102 prop "ButtonImages" $ shouldValidate (Proxy :: Proxy ButtonImages)
95103 prop "Version" $ shouldValidate (Proxy :: Proxy Version)
96104 prop "FreeForm" $ shouldValidate (Proxy :: Proxy FreeForm)
@@ -122,9 +130,9 @@ instance Arbitrary Person where
122130
123131invalidPersonToJSON :: Person -> Value
124132invalidPersonToJSON Person{..} = object
125− [ T.pack "personName" .= toJSON name
126− , T.pack "personPhone" .= toJSON phone
127− , T.pack "personEmail" .= toJSON email
133+ [ stringToKey "personName" .= toJSON name
134+ , stringToKey "personPhone" .= toJSON phone
135+ , stringToKey "personEmail" .= toJSON email
128136 ]
129137
130138-- ========================================================================
@@ -188,10 +196,10 @@ instance Arbitrary MyRoseTree where
188196data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic)
189197
190198instance ToSchema Light where
191− declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
199+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = ObjectWithSingleField }
192200
193201instance ToJSON Light where
194− toJSON = genericToJSON defaultOptions { sumEncoding = ObjectWithSingleField }
202+ toJSON = genericToJSON defaultOptions { Data.Aeson.Types.sumEncoding = ObjectWithSingleField }
195203
196204instance Arbitrary Light where
197205 arbitrary = oneof
@@ -203,6 +211,34 @@ instance Arbitrary Light where
203211invalidLightToJSON :: Light -> Value
204212invalidLightToJSON = genericToJSON defaultOptions
205213
214+-- Check all SumEncoding flavors.
215+
216+newtype LightTaggedObject = LightTaggedObject Light
217+ deriving (Show)
218+
219+instance ToJSON LightTaggedObject where
220+ toJSON (LightTaggedObject light) = genericToJSON defaultOptions { Data.Aeson.Types.sumEncoding = defaultTaggedObject } light
221+
222+instance ToSchema LightTaggedObject where
223+ declareNamedSchema _ =
224+ genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = defaultTaggedObject } (Proxy :: Proxy Light)
225+
226+instance Arbitrary LightTaggedObject where
227+ arbitrary = LightTaggedObject <$> arbitrary
228+
229+newtype LightUntaggedValue = LightUntaggedValue Light
230+ deriving (Show)
231+
232+instance ToJSON LightUntaggedValue where
233+ toJSON (LightUntaggedValue light) = genericToJSON defaultOptions { Data.Aeson.Types.sumEncoding = UntaggedValue } light
234+
235+instance ToSchema LightUntaggedValue where
236+ declareNamedSchema _ =
237+ genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = UntaggedValue } (Proxy :: Proxy Light)
238+
239+instance Arbitrary LightUntaggedValue where
240+ arbitrary = LightUntaggedValue <$> arbitrary
241+
206242-- ========================================================================
207243-- ButtonImages (bounded enum key mapping)
208244-- ========================================================================
@@ -247,7 +283,7 @@ instance ToJSON FreeForm where
247283
248284instance ToSchema FreeForm where
249285 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
250− & type_ ?~ SwaggerObject
286+ & type_ ?~ OpenApiObject
251287 & additionalProperties ?~ AdditionalPropertiesAllowed True
252288
253289instance Arbitrary FreeForm where
@@ -265,6 +301,8 @@ instance Eq ZonedTime where
265301-- Arbitrary instance for Data.Aeson.Value
266302-- ========================================================================
267303
304+-- These instances were introduces in aeson upstream in 2.0.3
305+#if !MIN_VERSION_aeson(2,0,3)
268306instance Arbitrary Value where
269307 -- Weights are almost random
270308 -- Uniform oneof tends not to build complex objects cause of recursive call.
@@ -275,3 +313,12 @@ instance Arbitrary Value where
275313 , (3, Number <$> arbitrary)
276314 , (3, Bool <$> arbitrary)
277315 , (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