git.iko.soy/typeable/openapi3
on master help sign in
41 files changed+5292−5065
since splitsnapshots
unifiedsplit
.ghci−2 .github/workflows/haskell-ci.yml+243 .travis.yml−162 CHANGELOG.md+62 README.md+13−11 cabal.haskell-ci+11 cabal.project+2 examples/hackage.hs+16−20 include/overlapping-compat.h−8 openapi3.cabal+160 src/Data/Swagger.hs → src/Data/OpenApi.hs+196−118 src/Data/OpenApi/Aeson/Compat.hs+76 src/Data/Swagger/Declare.hs → src/Data/OpenApi/Declare.hs+5−9 src/Data/OpenApi/Internal.hs+1619 src/Data/Swagger/Internal/AesonUtils.hs → src/Data/OpenApi/Internal/AesonUtils.hs+12−45 src/Data/Swagger/Internal/ParamSchema.hs → src/Data/OpenApi/Internal/ParamSchema.hs+84−67 src/Data/Swagger/Internal/Schema.hs → src/Data/OpenApi/Internal/Schema.hs+455−211 src/Data/Swagger/Internal/Schema/Validation.hs → src/Data/OpenApi/Internal/Schema/Validation.hs+126−101 src/Data/Swagger/Internal/TypeShape.hs → src/Data/OpenApi/Internal/TypeShape.hs+1−11 src/Data/Swagger/Internal/Utils.hs → src/Data/OpenApi/Internal/Utils.hs+7−1 src/Data/OpenApi/Lens.hs+166 src/Data/Swagger/Operation.hs → src/Data/OpenApi/Operation.hs+148−36 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−20 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/Internal.hs−1427 src/Data/Swagger/Lens.hs−186 src/Data/Swagger/Optics.hs−597 stack.yaml+5−5 swagger2.cabal−154 test/Data/Swagger/CommonTestTypes.hs → test/Data/OpenApi/CommonTestTypes.hs+464−101 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+55−9 test/Data/Swagger/SchemaSpec.hs → test/Data/OpenApi/SchemaSpec.hs+16−11 test/Data/OpenApiSpec.hs+962 test/Data/SwaggerSpec.hs−1702 test/SpecCommon.hs+1−9
.ghcideleted−2
@@ -1,2 +0,0 @@
1−:set -itest -isrc -optP-include -optP.stack-work/dist/x86_64-linux/Cabal-1.24.2.0/build/autogen/cabal_macros.h -optP-I -optPinclude
2−:set -hide-package base-compat-0.10.4
.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−162
@@ -1,162 +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−# For more information, see https://github.com/haskell-CI/haskell-ci
6−#
7−# version: 0.5.20191020
8−#
9−language: c
10−dist: xenial
11−git:
12− # whether to recursively clone submodules
13− submodules: false
14−branches:
15− only:
16− - master
17−cache:
18− directories:
19− - $HOME/.cabal/packages
20− - $HOME/.cabal/store
21−before_cache:
22− - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
23− # remove files that are regenerated by 'cabal update'
24− - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
25− - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
26− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
27− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
28− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
29− - rm -rfv $CABALHOME/packages/head.hackage
30−matrix:
31− include:
32− - compiler: ghc-8.8.1
33− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}}
34− - compiler: ghc-8.6.5
35− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0"]}}
36− - compiler: ghc-8.4.4
37− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}}
38− - compiler: ghc-8.2.2
39− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}}
40− - compiler: ghc-8.0.2
41− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}}
42−before_install:
43− - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
44− - WITHCOMPILER="-w $HC"
45− - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
46− - HCPKG="$HC-pkg"
47− - unset CC
48− - CABAL=/opt/ghc/bin/cabal
49− - CABALHOME=$HOME/.cabal
50− - export PATH="$CABALHOME/bin:$PATH"
51− - TOP=$(pwd)
52− - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
53− - echo $HCNUMVER
54− - CABAL="$CABAL -vnormal+nowrap+markoutput"
55− - set -o pipefail
56− - |
57− echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk
58− echo 'BEGIN { state = "output"; }' >> .colorful.awk
59− echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk
60− echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk
61− echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk
62− echo ' if (state == "cabal") {' >> .colorful.awk
63− echo ' print blue($0)' >> .colorful.awk
64− echo ' } else {' >> .colorful.awk
65− echo ' print $0' >> .colorful.awk
66− echo ' }' >> .colorful.awk
67− echo '}' >> .colorful.awk
68− - cat .colorful.awk
69− - |
70− color_cabal_output () {
71− awk -f $TOP/.colorful.awk
72− }
73− - echo text | color_cabal_output
74−install:
75− - ${CABAL} --version
76− - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
77− - TEST=--enable-tests
78− - BENCH=--enable-benchmarks
79− - HEADHACKAGE=false
80− - rm -f $CABALHOME/config
81− - |
82− echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
83− echo "remote-build-reporting: anonymous" >> $CABALHOME/config
84− echo "write-ghc-environment-files: always" >> $CABALHOME/config
85− echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
86− echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
87− echo "world-file: $CABALHOME/world" >> $CABALHOME/config
88− echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
89− echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
90− echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
91− echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
92− echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
93− echo "install-dirs user" >> $CABALHOME/config
94− echo " prefix: $CABALHOME" >> $CABALHOME/config
95− echo "repository hackage.haskell.org" >> $CABALHOME/config
96− echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
97− echo " secure: True" >> $CABALHOME/config
98− echo " key-threshold: 3" >> $CABALHOME/config
99− echo " root-keys:" >> $CABALHOME/config
100− echo " fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0" >> $CABALHOME/config
101− echo " 1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42" >> $CABALHOME/config
102− echo " 2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3" >> $CABALHOME/config
103− echo " 0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d" >> $CABALHOME/config
104− echo " 51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921" >> $CABALHOME/config
105− - |
106− echo "program-default-options" >> $CABALHOME/config
107− echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
108− - cat $CABALHOME/config
109− - rm -fv cabal.project cabal.project.local cabal.project.freeze
110− - travis_retry ${CABAL} v2-update -v
111− # Generate cabal.project
112− - rm -rf cabal.project cabal.project.local cabal.project.freeze
113− - touch cabal.project
114− - |
115− echo "packages: ." >> cabal.project
116− - |
117− - "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"
118− - cat cabal.project || true
119− - cat cabal.project.local || true
120− - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
121− - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output
122− - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
123− - rm cabal.project.freeze
124− - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output
125− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output
126−script:
127− - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
128− # Packaging...
129− - ${CABAL} v2-sdist all | color_cabal_output
130− # Unpacking...
131− - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
132− - cd ${DISTDIR} || false
133− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
134− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
135− - PKGDIR_swagger2="$(find . -maxdepth 1 -type d -regex '.*/swagger2-[0-9.]*')"
136− # Generate cabal.project
137− - rm -rf cabal.project cabal.project.local cabal.project.freeze
138− - touch cabal.project
139− - |
140− echo "packages: ${PKGDIR_swagger2}" >> cabal.project
141− - |
142− - "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"
143− - cat cabal.project || true
144− - cat cabal.project.local || true
145− # Building...
146− # this builds all libraries and executables (without tests/benchmarks)
147− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
148− # Building with tests and benchmarks...
149− # build & run tests, build benchmarks
150− - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output
151− # Testing...
152− - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output
153− # cabal check...
154− - (cd ${PKGDIR_swagger2} && ${CABAL} -vnormal check)
155− # haddock...
156− - if [ $HCNUMVER -ge 80400 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output ; fi
157− # Building without installed constraints for packages in global-db...
158− - rm -f cabal.project.local
159− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output
160−
161−# REGENDATA ("0.5.20191020",["--branches","master","--haddock-jobs=>=8.4","--output",".travis.yml","swagger2.cabal"])
162−# EOF
CHANGELOG.md+62
@@ -1,3 +1,65 @@
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+
48+2.6.1
49+-----
50+
51+- More GHC-8.10 related cleanup, tighten lower bound on some dependencies.
52+ (see [#216]( https://github.com/GetShopTV/swagger2/pull/216 ));
53+- Add "format" field for uint32 and uint64
54+ (see [#215]( https://github.com/GetShopTV/swagger2/pull/215 ));
55+
56+2.6
57+---
58+
59+- GHC 8.10 support (see [#210]( https://github.com/GetShopTV/swagger2/pull/210 ));
60+- Move `aeson-pretty` to other dependencies (see [#206]( https://github.com/GetShopTV/swagger2/pull/206 ));
61+- Merge OAuth2 scopes (see [#151]( https://github.com/GetShopTV/swagger2/pull/151 ));
62+
1632.5
264---
365
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
include/overlapping-compat.hdeleted−8
@@ -1,8 +0,0 @@
1−#if __GLASGOW_HASKELL__ >= 710
2−#define OVERLAPPABLE_ {-# OVERLAPPABLE #-}
3−#define OVERLAPPING_ {-# OVERLAPPING #-}
4−#else
5−{-# LANGUAGE OverlappingInstances #-}
6−#define OVERLAPPABLE_
7−#define OVERLAPPING_
8−#endif
openapi3.cabalnew file+160
@@ -0,0 +1,160 @@
1+cabal-version: >=1.10
2+name: openapi3
3+version: 3.2.2
4+
5+synopsis: OpenAPI 3.0 data model
6+category: Web, Swagger, OpenApi
7+description:
8+ This library is intended to be used for decoding and encoding OpenAPI 3.0 API
9+ specifications as well as manipulating them.
10+ .
11+ The original OpenAPI 3.0 specification is available at http://swagger.io/specification/.
12+
13+homepage: https://github.com/biocad/openapi3
14+bug-reports: https://github.com/biocad/openapi3/issues
15+license: BSD3
16+license-file: LICENSE
17+author: Nickolay Kudasov, Maxim Koltsov
18+maintainer: nickolay@getshoptv.com, kolmax94@gmail.com
19+copyright: (c) 2015-2016, GetShopTV, (c) 2020, Biocad
20+build-type: Custom
21+extra-source-files:
22+ README.md
23+ , CHANGELOG.md
24+ , examples/*.hs
25+tested-with:
26+ GHC ==8.4.4
27+ || ==8.6.5
28+ || ==8.8.4
29+ || ==8.10.7
30+ || ==9.0.2
31+ || ==9.2.2
32+
33+custom-setup
34+ setup-depends:
35+ base, Cabal, cabal-doctest >=1.0.6 && <1.1
36+
37+library
38+ hs-source-dirs: src
39+ exposed-modules:
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
50+
51+ -- internal modules
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
61+
62+ -- GHC boot libraries
63+ build-depends:
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
70+
71+ build-depends:
72+ mtl >=2.2.2 && <2.3
73+ , text >=1.2.3.1 && <2.1
74+
75+ -- other dependencies
76+ build-depends:
77+ base-compat-batteries >=0.11.1 && <0.13
78+ , aeson >=1.4.2.0 && <1.6 || >=2.0.1.0 && < 2.1
79+ , aeson-pretty >=0.8.7 && <0.9
80+ -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
81+ , cookie >=0.4.3 && <0.5
82+ , generics-sop >=0.5.1.0 && <0.6
83+ , hashable >=1.2.7.0 && <1.5
84+ , http-media >=0.8.0.0 && <0.9
85+ , insert-ordered-containers >=0.2.3 && <0.3
86+ , lens >=4.16.1 && <5.2
87+ , network >=2.6.3.5 && <3.2
88+ , optics-core >=0.2 && <0.5
89+ , optics-th >=0.2 && <0.5
90+ , scientific >=0.3.6.2 && <0.4
91+ , unordered-containers >=0.2.9.0 && <0.3
92+ , uuid-types >=1.0.3 && <1.1
93+ , vector >=0.12.0.1 && <0.13
94+ , QuickCheck >=2.10.1 && <2.15
95+
96+ default-language: Haskell2010
97+
98+test-suite spec
99+ type: exitcode-stdio-1.0
100+ hs-source-dirs: test
101+ main-is: Spec.hs
102+
103+ -- From library parat
104+ -- We need aeson's toEncoding for doctests too
105+ build-depends:
106+ base
107+ , QuickCheck
108+ , aeson
109+ , base-compat-batteries
110+ , bytestring
111+ , containers
112+ , hashable
113+ , insert-ordered-containers
114+ , lens
115+ , mtl
116+ , openapi3
117+ , template-haskell
118+ , text
119+ , time
120+ , unordered-containers
121+ , vector
122+
123+ -- test-suite only dependencies
124+ build-depends:
125+ hspec >=2.5.5 && <2.10
126+ , HUnit >=1.6.0.0 && <1.7
127+ , quickcheck-instances >=0.3.19 && <0.14
128+ , utf8-string >=1.0.1.1 && <1.1
129+
130+ -- https://github.com/haskell/cabal/issues/3708
131+ build-tool-depends:
132+ hspec-discover:hspec-discover >=2.5.5 && <2.10
133+
134+ other-modules:
135+ SpecCommon
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
142+ default-language: Haskell2010
143+
144+test-suite doctests
145+ -- See QuickCheck note in https://github.com/phadej/cabal-doctest#notes
146+ build-depends: base, doctest, Glob, QuickCheck
147+ default-language: Haskell2010
148+ hs-source-dirs: test
149+ main-is: doctests.hs
150+ type: exitcode-stdio-1.0
151+
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+
158+source-repository head
159+ type: git
160+ location: https://github.com/biocad/openapi3.git
src/Data/Swagger.hs → src/Data/OpenApi.hsrenamed+196−118
@@ -1,6 +1,5 @@
1−{-# LANGUAGE CPP #-}
21-- |
3−-- Module: Data.Swagger
2+-- Module: Data.OpenApi
43-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
54-- Stability: experimental
65--
@@ -10,7 +9,7 @@
109-- These files can then be used by the Swagger-UI project to display the API
1110-- and Swagger-Codegen to generate clients in various languages.
1211-- Additional utilities can also take advantage of the resulting files, such as testing tools.
13−module Data.Swagger (
12+module Data.OpenApi (
1413 -- * How to use this library
1514 -- $howto
1615
@@ -30,17 +29,18 @@ module Data.Swagger (
3029 -- $validation
3130
3231 -- * Re-exports
33− module Data.Swagger.Lens,
34− module Data.Swagger.Optics,
35− module Data.Swagger.Operation,
36− module Data.Swagger.ParamSchema,
37− module Data.Swagger.Schema,
38− 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,
3938
4039 -- * Swagger specification
41− Swagger(..),
42− Host(..),
43− Scheme(..),
40+ OpenApi(..),
41+ Server(..),
42+ ServerVariable(..),
43+ Components(..),
4444
4545 -- ** Info types
4646 Info(..),
@@ -56,48 +56,56 @@ 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(..),
66− ParamAnySchema(..),
67− ParamOtherSchema(..),
6866 ParamLocation(..),
6967 ParamName,
7068 Header(..),
7169 HeaderName,
7270 Example(..),
71+ RequestBody(..),
72+ MediaTypeObject(..),
73+ Encoding(..),
7374
7475 -- ** Schemas
75− ParamSchema(..),
7676 Schema(..),
7777 NamedSchema(..),
78− SwaggerItems(..),
78+ OpenApiItems(..),
7979 Xml(..),
8080 Pattern,
8181 AdditionalProperties(..),
82+ Discriminator(..),
8283
8384 -- ** Responses
8485 Responses(..),
8586 Response(..),
8687 HttpStatusCode,
88+ Link(..),
89+ Callback(..),
8790
8891 -- ** Security
8992 SecurityScheme(..),
9093 SecuritySchemeType(..),
91− SecurityRequirement(..),
94+ HttpSchemeType(..),
9295 SecurityDefinitions(..),
96+ SecurityRequirement(..),
9397
9498 -- *** API key
9599 ApiKeyParams(..),
96100 ApiKeyLocation(..),
97101
98102 -- *** OAuth2
99− OAuth2Params(..),
103+ OAuth2Flows(..),
100104 OAuth2Flow(..),
105+ OAuth2ImplicitFlow(..),
106+ OAuth2PasswordFlow(..),
107+ OAuth2ClientCredentialsFlow(..),
108+ OAuth2AuthorizationCodeFlow(..),
101109 AuthorizationURL,
102110 TokenURL,
103111
@@ -113,14 +121,14 @@ module Data.Swagger (
113121 URL(..),
114122) where
115123
116−import Data.Swagger.Lens
117−import Data.Swagger.Optics ()
118−import Data.Swagger.Operation
119−import Data.Swagger.ParamSchema
120−import Data.Swagger.Schema
121−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
122130
123−import Data.Swagger.Internal
131+import Data.OpenApi.Internal
124132
125133-- $setup
126134-- >>> import Control.Lens
@@ -128,6 +136,8 @@ import Data.Swagger.Internal
128136-- >>> import Data.Monoid
129137-- >>> import Data.Proxy
130138-- >>> import GHC.Generics
139+-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
140+-- >>> import Data.OpenApi.Internal.Utils
131141-- >>> :set -XDeriveGeneric
132142-- >>> :set -XOverloadedStrings
133143-- >>> :set -XOverloadedLists
@@ -144,8 +154,16 @@ import Data.Swagger.Internal
144154--
145155-- In this library you can use @'mempty'@ for a default/empty value. For instance:
146156--
147−-- >>> encode (mempty :: Swagger)
148−-- "{\"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+-- }
149167--
150168-- As you can see some spec properties (e.g. @"version"@) are there even when the spec is empty.
151169-- That is because these properties are actually required ones.
@@ -153,47 +171,87 @@ import Data.Swagger.Internal
153171-- You /should/ always override the default (empty) value for these properties,
154172-- although it is not strictly necessary:
155173--
156−-- >>> encode mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
157−-- "{\"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+-- }
158179--
159180-- You can merge two values using @'mappend'@ or its infix version @('<>')@:
160181--
161−-- >>> encode $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
162−-- "{\"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+
163188--
164189-- This can be useful for combining specifications of endpoints into a whole API specification:
165190--
166191-- @
167192-- \-\- /account subAPI specification
168−-- accountAPI :: Swagger
193+-- accountAPI :: OpenApi
169194--
170195-- \-\- /task subAPI specification
171−-- taskAPI :: Swagger
196+-- taskAPI :: OpenApi
172197--
173198-- \-\- while API specification is just a combination
174199-- \-\- of subAPIs' specifications
175−-- api :: Swagger
200+-- api :: OpenApi
176201-- api = accountAPI <> taskAPI
177202-- @
178203
179204-- $lens
180205--
181−-- 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".
182207--
183208-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
184209-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses
185210-- make it fairly simple to construct/modify any part of the specification:
186211--
187212-- >>> :{
188−-- encode $ (mempty :: Swagger)
189−-- & definitions .~ [ ("User", mempty & type_ ?~ SwaggerString) ]
213+-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
214+-- & components . schemas .~ [ ("User", mempty & type_ ?~ OpenApiString) ]
190215-- & paths .~
191216-- [ ("/user", mempty & get ?~ (mempty
192−-- & produces ?~ MimeList ["application/json"]
193−-- & at 200 ?~ ("OK" & _Inline.schema ?~ Ref (Reference "User"))
217+-- & at 200 ?~ ("OK" & _Inline.content.at "application/json" ?~ (mempty & schema ?~ Ref (Reference "User")))
194218-- & at 404 ?~ "User info not found")) ]
195219-- :}
196−-- "{\"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+-- }
197255--
198256-- In the snippet above we declare an API with a single path @/user@. This path provides method @GET@
199257-- which produces @application/json@ output. It should respond with code @200@ and body specified
@@ -205,30 +263,34 @@ import Data.Swagger.Internal
205263-- common field is @'description'@. Many components of a Swagger specification
206264-- can have descriptions, and you can use the same name for them:
207265--
208−-- >>> encode $ (mempty :: Response) & description .~ "No content"
209−-- "{\"description\":\"No content\"}"
266+-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & description .~ "No content"
267+-- {
268+-- "description": "No content"
269+-- }
210270-- >>> :{
211−-- encode $ (mempty :: Schema)
212−-- & type_ ?~ SwaggerBoolean
271+-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)
272+-- & type_ ?~ OpenApiBoolean
213273-- & description ?~ "To be or not to be"
214274-- :}
215−-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"
216−--
217−-- @'ParamSchema'@ is basically the /base schema specification/ and many types contain it (see @'HasParamSchema'@).
218−-- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.
219−-- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:
220−--
221−-- >>> encode $ (mempty :: Header) & type_ ?~ SwaggerNumber
222−-- "{\"type\":\"number\"}"
275+-- {
276+-- "description": "To be or not to be",
277+-- "type": "boolean"
278+-- }
223279--
224280-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
225281-- have direct access to it via @'at' code@. Example:
226282--
227283-- >>> :{
228−-- encode $ (mempty :: Operation)
284+-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)
229285-- & at 404 ?~ "Not found"
230286-- :}
231−-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"
287+-- {
288+-- "responses": {
289+-- "404": {
290+-- "description": "Not found"
291+-- }
292+-- }
293+-- }
232294--
233295-- You might've noticed that @'type_'@ has an extra underscore in its name
234296-- compared to, say, @'description'@ field accessor.
@@ -244,7 +306,7 @@ import Data.Swagger.Internal
244306-- @'ParamSchema'@ and @'Schema'@ are the two core types for data model specification.
245307--
246308-- @'ParamSchema' t@ specifies all the common properties, available for every data schema.
247−-- 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'@).
248310--
249311-- @'Schema'@ is used for request and response bodies and allows specifying objects
250312-- with properties in addition to what @'ParamSchema'@ provides.
@@ -275,65 +337,81 @@ import Data.Swagger.Internal
275337-- >>> data Person = Person { name :: String, age :: Integer } deriving Generic
276338-- >>> instance ToJSON Person
277339-- >>> instance ToSchema Person
278−-- >>> encode (Person "David" 28)
279−-- "{\"age\":28,\"name\":\"David\"}"
280−-- >>> encode $ toSchema (Proxy :: Proxy Person)
281−-- "{\"required\":[\"name\",\"age\"],\"properties\":{\"name\":{\"type\":\"string\"},\"age\":{\"type\":\"integer\"}},\"type\":\"object\"}"
282−--
283−-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a
284−-- schema for basic enums like
285−--
286−-- >>> data SampleEnum = ChoiceOne | ChoiceTwo deriving Generic
287−-- >>> instance ToSchema SampleEnum
288−-- >>> instance ToJSON SampleEnum
289−--
290−-- and for sum types that have constructors with values
291−--
292−-- >>> data SampleSumType = ChoiceInt Int | ChoiceString String deriving Generic
293−-- >>> instance ToSchema SampleSumType
294−-- >>> instance ToJSON SampleSumType
295−--
296−-- we can not derive a valid schema for a mix of the above. The following will result in a type error
297−--
298−#if __GLASGOW_HASKELL__ < 800
299−-- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic
300−-- >>> instance ToSchema BadMixedType
301−-- ...
302−-- ... error:
303−-- ... • No instance for (Data.Swagger.Internal.TypeShape.CannotDeriveSchemaForMixedSumType
304−-- ... BadMixedType)
305−-- ... arising from a use of ‘Data.Swagger.Internal.Schema.$dmdeclareNamedSchema’
306−-- ... • In the expression:
307−-- ... Data.Swagger.Internal.Schema.$dmdeclareNamedSchema @BadMixedType
308−-- ... In an equation for ‘declareNamedSchema’:
309−-- ... declareNamedSchema
310−-- ... = Data.Swagger.Internal.Schema.$dmdeclareNamedSchema @BadMixedType
311−-- ... In the instance declaration for ‘ToSchema BadMixedType’
312−#else
313−-- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic
314−-- >>> instance ToSchema BadMixedType
315−-- ...
316−-- ... error:
317−-- ... • Cannot derive Generic-based Swagger Schema for BadMixedType
318−-- ... BadMixedType is a mixed sum type (has both unit and non-unit constructors).
319−-- ... Swagger does not have a good representation for these types.
320−-- ... Use genericDeclareNamedSchemaUnrestricted if you want to derive schema
321−-- ... that matches aeson's Generic-based toJSON,
322−-- ... but that's not supported by some Swagger tools.
323−-- ... • In the expression:
324−-- ... Data.Swagger.Internal.Schema.$dmdeclareNamedSchema @BadMixedType
325−-- ... In an equation for ‘declareNamedSchema’:
326−-- ... declareNamedSchema
327−-- ... = Data.Swagger.Internal.Schema.$dmdeclareNamedSchema @BadMixedType
328−-- ... In the instance declaration for ‘ToSchema BadMixedType’
329−#endif
330−--
331−-- We can use 'genericDeclareNamedSchemaUnrestricted' to try our best to represent this type as a Swagger Schema and match 'ToJSON':
332−--
333−-- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic
334−-- >>> instance ToSchema BadMixedType where declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
335−-- >>> instance ToJSON BadMixedType
336−--
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+-- }
337415
338416-- $manipulation
339417-- Sometimes you have to work with an imported or generated @'Swagger'@.
@@ -341,10 +419,10 @@ import Data.Swagger.Internal
341419-- for a type-level servant API.
342420--
343421-- Lenses and prisms can be used to manipulate such specification to add additional information, tags, extra responses, etc.
344−-- To facilitate common needs, @"Data.Swagger.Operation"@ module provides useful helpers.
422+-- To facilitate common needs, @"Data.OpenApi.Operation"@ module provides useful helpers.
345423
346424-- $validation
347425-- While @'ToParamSchema'@ and @'ToSchema'@ provide means to easily obtain schemas for Haskell types,
348426-- there is no static mechanism to ensure those instances correspond to the @'ToHttpApiData'@ or @'ToJSON'@ instances.
349427--
350−-- @"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+5−9
@@ -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
@@ -60,7 +60,7 @@ instance (Applicative m, Monad m, Monoid d) => Monad (DeclareT d m) where
6060 return (mappend d' d'', y)
6161
6262instance Monoid d => MonadTrans (DeclareT d) where
63− lift m = DeclareT (\_ -> (,) mempty `liftM` m)
63+ lift m = DeclareT (\_ -> (,) mempty <$> m)
6464
6565-- |
6666-- Definitions of @declare@ and @look@ must satisfy the following laws:
@@ -103,12 +103,12 @@ looks f = f <$> look
103103-- | Evaluate @'DeclareT' d m a@ computation,
104104-- ignoring new output @d@.
105105evalDeclareT :: Monad m => DeclareT d m a -> d -> m a
106−evalDeclareT (DeclareT f) d = snd `liftM` f d
106+evalDeclareT (DeclareT f) d = snd <$> f d
107107
108108-- | Execute @'DeclateT' d m a@ computation,
109109-- ignoring result and only producing new output @d@.
110110execDeclareT :: Monad m => DeclareT d m a -> d -> m d
111−execDeclareT (DeclareT f) d = fst `liftM` f d
111+execDeclareT (DeclareT f) d = fst <$> f d
112112
113113-- | Evaluate @'DeclareT' d m a@ computation,
114114-- starting with empty output history.
@@ -162,10 +162,6 @@ instance MonadDeclare d m => MonadDeclare d (IdentityT m) where
162162 declare = lift . declare
163163 look = lift look
164164
165−instance MonadDeclare d m => MonadDeclare d (ListT m) where
166− declare = lift . declare
167− look = lift look
168−
169165instance MonadDeclare d m => MonadDeclare d (MaybeT m) where
170166 declare = lift . declare
171167 look = lift look
src/Data/OpenApi/Internal.hsnew file+1619
@@ -0,0 +1,1619 @@
1+{-# LANGUAGE CPP #-}
2+{-# LANGUAGE DataKinds #-}
3+{-# LANGUAGE DeriveDataTypeable #-}
4+{-# LANGUAGE DeriveGeneric #-}
5+{-# LANGUAGE DeriveTraversable #-}
6+{-# LANGUAGE FlexibleContexts #-}
7+{-# LANGUAGE FlexibleInstances #-}
8+{-# LANGUAGE GADTs #-}
9+{-# LANGUAGE GeneralizedNewtypeDeriving #-}
10+{-# LANGUAGE OverloadedStrings #-}
11+{-# LANGUAGE RecordWildCards #-}
12+{-# LANGUAGE ScopedTypeVariables #-}
13+{-# LANGUAGE StandaloneDeriving #-}
14+{-# LANGUAGE TemplateHaskell #-}
15+{-# LANGUAGE TypeFamilies #-}
16+{-# LANGUAGE UndecidableInstances #-}
17+module Data.OpenApi.Internal where
18+
19+import Prelude ()
20+import Prelude.Compat
21+
22+import Control.Applicative
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)
48+
49+import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
50+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
51+
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
58+import Generics.SOP.TH (deriveGeneric)
59+
60+-- $setup
61+-- >>> :seti -XDataKinds
62+-- >>> import Data.Aeson
63+-- >>> import Data.ByteString.Lazy.Char8 as BSL
64+-- >>> import Data.OpenApi.Internal.Utils
65+
66+-- | A list of definitions that can be used in references.
67+type Definitions = InsOrdHashMap Text
68+
69+-- | This is the root document object for the API specification.
70+data OpenApi = OpenApi
71+ { -- | Provides metadata about the API.
72+ -- The metadata can be used by the clients if needed.
73+ _openApiInfo :: Info
74+
75+ -- | An array of Server Objects, which provide connectivity information
76+ -- to a target server. If the servers property is not provided, or is an empty array,
77+ -- the default value would be a 'Server' object with a url value of @/@.
78+ , _openApiServers :: [Server]
79+
80+ -- | The available paths and operations for the API.
81+ , _openApiPaths :: InsOrdHashMap FilePath PathItem
82+
83+ -- | An element to hold various schemas for the specification.
84+ , _openApiComponents :: Components
85+
86+ -- | A declaration of which security mechanisms can be used across the API.
87+ -- The list of values includes alternative security requirement objects that can be used.
88+ -- Only one of the security requirement objects need to be satisfied to authorize a request.
89+ -- Individual operations can override this definition.
90+ -- To make security optional, an empty security requirement can be included in the array.
91+ , _openApiSecurity :: [SecurityRequirement]
92+
93+ -- | A list of tags used by the specification with additional metadata.
94+ -- The order of the tags can be used to reflect on their order by the parsing tools.
95+ -- Not all tags that are used by the 'Operation' Object must be declared.
96+ -- The tags that are not declared MAY be organized randomly or based on the tools' logic.
97+ -- Each tag name in the list MUST be unique.
98+ , _openApiTags :: InsOrdHashSet Tag
99+
100+ -- | Additional external documentation.
101+ , _openApiExternalDocs :: Maybe ExternalDocs
102+ } deriving (Eq, Show, Generic, Data, Typeable)
103+
104+-- | The object provides metadata about the API.
105+-- The metadata MAY be used by the clients if needed,
106+-- and MAY be presented in editing or documentation generation tools for convenience.
107+data Info = Info
108+ { -- | The title of the API.
109+ _infoTitle :: Text
110+
111+ -- | A short description of the API.
112+ -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
113+ , _infoDescription :: Maybe Text
114+
115+ -- | A URL to the Terms of Service for the API. MUST be in the format of a URL.
116+ , _infoTermsOfService :: Maybe Text
117+
118+ -- | The contact information for the exposed API.
119+ , _infoContact :: Maybe Contact
120+
121+ -- | The license information for the exposed API.
122+ , _infoLicense :: Maybe License
123+
124+ -- | The version of the OpenAPI document (which is distinct from the
125+ -- OpenAPI Specification version or the API implementation version).
126+ , _infoVersion :: Text
127+ } deriving (Eq, Show, Generic, Data, Typeable)
128+
129+-- | Contact information for the exposed API.
130+data Contact = Contact
131+ { -- | The identifying name of the contact person/organization.
132+ _contactName :: Maybe Text
133+
134+ -- | The URL pointing to the contact information.
135+ , _contactUrl :: Maybe URL
136+
137+ -- | The email address of the contact person/organization.
138+ , _contactEmail :: Maybe Text
139+ } deriving (Eq, Show, Generic, Data, Typeable)
140+
141+-- | License information for the exposed API.
142+data License = License
143+ { -- | The license name used for the API.
144+ _licenseName :: Text
145+
146+ -- | A URL to the license used for the API.
147+ , _licenseUrl :: Maybe URL
148+ } deriving (Eq, Show, Generic, Data, Typeable)
149+
150+instance IsString License where
151+ fromString s = License (fromString s) Nothing
152+
153+-- | An object representing a Server.
154+data Server = Server
155+ { -- | A URL to the target host. This URL supports Server Variables and MAY be relative,
156+ -- to indicate that the host location is relative to the location where
157+ -- the OpenAPI document is being served. Variable substitutions will be made when
158+ -- a variable is named in @{brackets}@.
159+ _serverUrl :: Text
160+
161+ -- | An optional string describing the host designated by the URL.
162+ -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
163+ , _serverDescription :: Maybe Text
164+
165+ -- | A map between a variable name and its value.
166+ -- The value is used for substitution in the server's URL template.
167+ , _serverVariables :: InsOrdHashMap Text ServerVariable
168+ } deriving (Eq, Show, Generic, Data, Typeable)
169+
170+data ServerVariable = ServerVariable
171+ { -- | An enumeration of string values to be used if the substitution options
172+ -- are from a limited set. The array SHOULD NOT be empty.
173+ _serverVariableEnum :: Maybe (InsOrdHashSet Text) -- TODO NonEmpty
174+
175+ -- | The default value to use for substitution, which SHALL be sent if an alternate value
176+ -- is not supplied. Note this behavior is different than the 'Schema\ Object's treatment
177+ -- of default values, because in those cases parameter values are optional.
178+ -- If the '_serverVariableEnum' is defined, the value SHOULD exist in the enum's values.
179+ , _serverVariableDefault :: Text
180+
181+ -- | An optional description for the server variable.
182+ -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
183+ , _serverVariableDescription :: Maybe Text
184+ } deriving (Eq, Show, Generic, Data, Typeable)
185+
186+instance IsString Server where
187+ fromString s = Server (fromString s) Nothing mempty
188+
189+-- | Holds a set of reusable objects for different aspects of the OAS.
190+-- All objects defined within the components object will have no effect on the API
191+-- unless they are explicitly referenced from properties outside the components object.
192+data Components = Components
193+ { _componentsSchemas :: Definitions Schema
194+ , _componentsResponses :: Definitions Response
195+ , _componentsParameters :: Definitions Param
196+ , _componentsExamples :: Definitions Example
197+ , _componentsRequestBodies :: Definitions RequestBody
198+ , _componentsHeaders :: Definitions Header
199+ , _componentsSecuritySchemes :: SecurityDefinitions
200+ , _componentsLinks :: Definitions Link
201+ , _componentsCallbacks :: Definitions Callback
202+ } deriving (Eq, Show, Generic, Data, Typeable)
203+
204+-- | Describes the operations available on a single path.
205+-- A @'PathItem'@ may be empty, due to ACL constraints.
206+-- The path itself is still exposed to the documentation viewer
207+-- but they will not know which operations and parameters are available.
208+data PathItem = PathItem
209+ { -- | An optional, string summary, intended to apply to all operations in this path.
210+ _pathItemSummary :: Maybe Text
211+
212+ -- | An optional, string description, intended to apply to all operations in this path.
213+ -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
214+ , _pathItemDescription :: Maybe Text
215+
216+ -- | A definition of a GET operation on this path.
217+ , _pathItemGet :: Maybe Operation
218+
219+ -- | A definition of a PUT operation on this path.
220+ , _pathItemPut :: Maybe Operation
221+
222+ -- | A definition of a POST operation on this path.
223+ , _pathItemPost :: Maybe Operation
224+
225+ -- | A definition of a DELETE operation on this path.
226+ , _pathItemDelete :: Maybe Operation
227+
228+ -- | A definition of a OPTIONS operation on this path.
229+ , _pathItemOptions :: Maybe Operation
230+
231+ -- | A definition of a HEAD operation on this path.
232+ , _pathItemHead :: Maybe Operation
233+
234+ -- | A definition of a PATCH operation on this path.
235+ , _pathItemPatch :: Maybe Operation
236+
237+ -- | A definition of a TRACE operation on this path.
238+ , _pathItemTrace :: Maybe Operation
239+
240+ -- | An alternative server array to service all operations in this path.
241+ , _pathItemServers :: [Server]
242+
243+ -- | A list of parameters that are applicable for all the operations described under this path.
244+ -- These parameters can be overridden at the operation level, but cannot be removed there.
245+ -- The list MUST NOT include duplicated parameters.
246+ -- A unique parameter is defined by a combination of a name and location.
247+ , _pathItemParameters :: [Referenced Param]
248+ } deriving (Eq, Show, Generic, Data, Typeable)
249+
250+-- | Describes a single API operation on a path.
251+data Operation = Operation
252+ { -- | A list of tags for API documentation control.
253+ -- Tags can be used for logical grouping of operations by resources or any other qualifier.
254+ _operationTags :: InsOrdHashSet TagName
255+
256+ -- | A short summary of what the operation does.
257+ -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
258+ , _operationSummary :: Maybe Text
259+
260+ -- | A verbose explanation of the operation behavior.
261+ -- [CommonMark syntax](https://spec.commonmark.org/) can be used for rich text representation.
262+ , _operationDescription :: Maybe Text
263+
264+ -- | Additional external documentation for this operation.
265+ , _operationExternalDocs :: Maybe ExternalDocs
266+
267+ -- | Unique string used to identify the operation.
268+ -- The id MUST be unique among all operations described in the API.
269+ -- The operationId value is **case-sensitive**.
270+ -- Tools and libraries MAY use the operationId to uniquely identify an operation, therefore,
271+ -- it is RECOMMENDED to follow common programming naming conventions.
272+ , _operationOperationId :: Maybe Text
273+
274+ -- | A list of parameters that are applicable for this operation.
275+ -- If a parameter is already defined at the @'PathItem'@,
276+ -- the new definition will override it, but can never remove it.
277+ -- The list MUST NOT include duplicated parameters.
278+ -- A unique parameter is defined by a combination of a name and location.
279+ , _operationParameters :: [Referenced Param]
280+
281+ -- | The request body applicable for this operation.
282+ -- The requestBody is only supported in HTTP methods where the HTTP 1.1
283+ -- specification [RFC7231](https://tools.ietf.org/html/rfc7231#section-4.3.1)
284+ -- has explicitly defined semantics for request bodies.
285+ -- In other cases where the HTTP spec is vague, requestBody SHALL be ignored by consumers.
286+ , _operationRequestBody :: Maybe (Referenced RequestBody)
287+
288+ -- | The list of possible responses as they are returned from executing this operation.
289+ , _operationResponses :: Responses
290+
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)
296+
297+ -- | Declares this operation to be deprecated.
298+ -- Usage of the declared operation should be refrained.
299+ -- Default value is @False@.
300+ , _operationDeprecated :: Maybe Bool
301+
302+ -- | A declaration of which security schemes are applied for this operation.
303+ -- The list of values describes alternative security schemes that can be used
304+ -- (that is, there is a logical OR between the security requirements).
305+ -- This definition overrides any declared top-level security.
306+ -- To remove a top-level security declaration, @Just []@ can be used.
307+ , _operationSecurity :: [SecurityRequirement]
308+
309+ -- | An alternative server array to service this operation.
310+ -- If an alternative server object is specified at the 'PathItem' Object or Root level,
311+ -- it will be overridden by this value.
312+ , _operationServers :: [Server]
313+ } deriving (Eq, Show, Generic, Data, Typeable)
314+
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+
331+-- | Describes a single request body.
332+data RequestBody = RequestBody
333+ { -- | A brief description of the request body. This could contain examples of use.
334+ -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
335+ _requestBodyDescription :: Maybe Text
336+
337+ -- | The content of the request body.
338+ -- The key is a media type or media type range and the value describes it.
339+ -- For requests that match multiple keys, only the most specific key is applicable.
340+ -- e.g. @text/plain@ overrides @text/\*@
341+ , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject
342+
343+ -- | Determines if the request body is required in the request.
344+ -- Defaults to 'False'.
345+ , _requestBodyRequired :: Maybe Bool
346+ } deriving (Eq, Show, Generic, Data, Typeable)
347+
348+-- | Each Media Type Object provides schema and examples for the media type identified by its key.
349+data MediaTypeObject = MediaTypeObject
350+ { _mediaTypeObjectSchema :: Maybe (Referenced Schema)
351+
352+ -- | Example of the media type.
353+ -- The example object SHOULD be in the correct format as specified by the media type.
354+ , _mediaTypeObjectExample :: Maybe Value
355+
356+ -- | Examples of the media type.
357+ -- Each example object SHOULD match the media type and specified schema if present.
358+ , _mediaTypeObjectExamples :: InsOrdHashMap Text (Referenced Example)
359+
360+ -- | A map between a property name and its encoding information.
361+ -- The key, being the property name, MUST exist in the schema as a property.
362+ -- The encoding object SHALL only apply to 'RequestBody' objects when the media type
363+ -- is @multipart@ or @application/x-www-form-urlencoded@.
364+ , _mediaTypeObjectEncoding :: InsOrdHashMap Text Encoding
365+ } deriving (Eq, Show, Generic, Data, Typeable)
366+
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+
390+data Encoding = Encoding
391+ { -- | The Content-Type for encoding a specific property.
392+ -- Default value depends on the property type: for @string@
393+ -- with format being @binary@ – @application/octet-stream@;
394+ -- for other primitive types – @text/plain@; for object - @application/json@;
395+ -- for array – the default is defined based on the inner type.
396+ -- The value can be a specific media type (e.g. @application/json@),
397+ -- a wildcard media type (e.g. @image/\*@), or a comma-separated list of the two types.
398+ _encodingContentType :: Maybe MediaType
399+
400+ -- | A map allowing additional information to be provided as headers,
401+ -- for example @Content-Disposition@. @Content-Type@ is described separately
402+ -- and SHALL be ignored in this section.
403+ -- This property SHALL be ignored if the request body media type is not a @multipart@.
404+ , _encodingHeaders :: InsOrdHashMap Text (Referenced Header)
405+
406+ -- | Describes how a specific property value will be serialized depending on its type.
407+ -- See 'Param' Object for details on the style property.
408+ -- The behavior follows the same values as query parameters, including default values.
409+ -- This property SHALL be ignored if the request body media type
410+ -- is not @application/x-www-form-urlencoded@.
411+ , _encodingStyle :: Maybe Style
412+
413+ -- | When this is true, property values of type @array@ or @object@ generate
414+ -- separate parameters for each value of the array,
415+ -- or key-value-pair of the map.
416+ -- For other types of properties this property has no effect.
417+ -- When style is form, the default value is @true@. For all other styles,
418+ -- the default value is @false@. This property SHALL be ignored
419+ -- if the request body media type is not @application/x-www-form-urlencoded@.
420+ , _encodingExplode :: Maybe Bool
421+
422+ -- | Determines whether the parameter value SHOULD allow reserved characters,
423+ -- as defined by [RFC3986](https://tools.ietf.org/html/rfc3986#section-2.2)
424+ -- @:/?#[]@!$&'()*+,;=@ to be included without percent-encoding.
425+ -- The default value is @false@. This property SHALL be ignored if the request body media type
426+ -- is not @application/x-www-form-urlencoded@.
427+ , _encodingAllowReserved :: Maybe Bool
428+ } deriving (Eq, Show, Generic, Data, Typeable)
429+
430+newtype MimeList = MimeList { getMimeList :: [MediaType] }
431+ deriving (Eq, Show, Semigroup, Monoid, Typeable)
432+
433+mimeListConstr :: Constr
434+mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
435+
436+mimeListDataType :: DataType
437+mimeListDataType = mkDataType "Data.OpenApi.MimeList" [mimeListConstr]
438+
439+instance Data MimeList where
440+ gunfold k z c = case constrIndex c of
441+ 1 -> k (z (MimeList . map fromString))
442+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
443+ toConstr (MimeList _) = mimeListConstr
444+ dataTypeOf _ = mimeListDataType
445+
446+-- | Describes a single operation parameter.
447+-- A unique parameter is defined by a combination of a name and location.
448+data Param = Param
449+ { -- | The name of the parameter.
450+ -- Parameter names are case sensitive.
451+ _paramName :: Text
452+
453+ -- | A brief description of the parameter.
454+ -- This could contain examples of use.
455+ -- CommonMark syntax MAY be used for rich text representation.
456+ , _paramDescription :: Maybe Text
457+
458+ -- | Determines whether this parameter is mandatory.
459+ -- If the parameter is in "path", this property is required and its value MUST be true.
460+ -- Otherwise, the property MAY be included and its default value is @False@.
461+ , _paramRequired :: Maybe Bool
462+
463+ -- | Specifies that a parameter is deprecated and SHOULD be transitioned out of usage.
464+ -- Default value is @false@.
465+ , _paramDeprecated :: Maybe Bool
466+
467+ -- | The location of the parameter.
468+ , _paramIn :: ParamLocation
469+
470+ -- | Sets the ability to pass empty-valued parameters.
471+ -- This is valid only for 'ParamQuery' parameters and allows sending
472+ -- a parameter with an empty value. Default value is @false@.
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
481+
482+ -- | Parameter schema.
483+ , _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.
516+ } deriving (Eq, Show, Generic, Data, Typeable)
517+
518+data Example = Example
519+ { -- | Short description for the example.
520+ _exampleSummary :: Maybe Text
521+
522+ -- | Long description for the example.
523+ -- CommonMark syntax MAY be used for rich text representation.
524+ , _exampleDescription :: Maybe Text
525+
526+ -- | Embedded literal example.
527+ -- The '_exampleValue' field and '_exampleExternalValue' field are mutually exclusive.
528+ --
529+ -- To represent examples of media types that cannot naturally represented in JSON or YAML,
530+ -- use a string value to contain the example, escaping where necessary.
531+ , _exampleValue :: Maybe Value
532+
533+ -- | A URL that points to the literal example.
534+ -- This provides the capability to reference examples that cannot easily be included
535+ -- in JSON or YAML documents. The '_exampleValue' field
536+ -- and '_exampleExternalValue' field are mutually exclusive.
537+ , _exampleExternalValue :: Maybe URL
538+ } deriving (Eq, Show, Generic, Typeable, Data)
539+
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.
577+--
578+-- __Warning__: OpenAPI 3.0 does not support tuple arrays. However, OpenAPI 3.1 will, as
579+-- it will incorporate Json Schema mostly verbatim.
580+--
581+-- @'OpenApiItemsObject'@ should be used to specify homogenous array @'Schema'@s.
582+--
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)
598+
599+data ParamLocation
600+ = -- | Parameters that are appended to the URL.
601+ -- For example, in @/items?id=###@, the query parameter is @id@.
602+ ParamQuery
603+ -- | Custom headers that are expected as part of the request.
604+ | ParamHeader
605+ -- | Used together with Path Templating, where the parameter value is actually part of the operation's URL.
606+ -- This does not include the host or base path of the API.
607+ -- For example, in @/items/{itemId}@, the path parameter is @itemId@.
608+ | ParamPath
609+ -- | Used to pass a specific cookie value to the API.
610+ | ParamCookie
611+ deriving (Eq, Show, Generic, Data, Typeable)
612+
613+type Format = Text
614+
615+type ParamName = Text
616+
617+data Schema = Schema
618+ { _schemaTitle :: Maybe Text
619+ , _schemaDescription :: Maybe Text
620+ , _schemaRequired :: [ParamName]
621+
622+ , _schemaNullable :: Maybe Bool
623+ , _schemaAllOf :: Maybe [Referenced Schema]
624+ , _schemaOneOf :: Maybe [Referenced Schema]
625+ , _schemaNot :: Maybe (Referenced Schema)
626+ , _schemaAnyOf :: Maybe [Referenced Schema]
627+ , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
628+ , _schemaAdditionalProperties :: Maybe AdditionalProperties
629+
630+ , _schemaDiscriminator :: Maybe Discriminator
631+ , _schemaReadOnly :: Maybe Bool
632+ , _schemaWriteOnly :: Maybe Bool
633+ , _schemaXml :: Maybe Xml
634+ , _schemaExternalDocs :: Maybe ExternalDocs
635+ , _schemaExample :: Maybe Value
636+ , _schemaDeprecated :: Maybe Bool
637+
638+ , _schemaMaxProperties :: Maybe Integer
639+ , _schemaMinProperties :: Maybe Integer
640+
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
663+ } deriving (Eq, Show, Generic, Data, Typeable)
664+
665+-- | Regex pattern for @string@ type.
666+type Pattern = Text
667+
668+data Discriminator = Discriminator
669+ { -- | The name of the property in the payload that will hold the discriminator value.
670+ _discriminatorPropertyName :: Text
671+
672+ -- | An object to hold mappings between payload values and schema names or references.
673+ , _discriminatorMapping :: InsOrdHashMap Text Text
674+ } deriving (Eq, Show, Generic, Data, Typeable)
675+
676+-- | A @'Schema'@ with an optional name.
677+-- This name can be used in references.
678+data NamedSchema = NamedSchema
679+ { _namedSchemaName :: Maybe Text
680+ , _namedSchemaSchema :: Schema
681+ } deriving (Eq, Show, Generic, Data, Typeable)
682+
683+data Xml = Xml
684+ { -- | Replaces the name of the element/attribute used for the described schema property.
685+ -- When defined within the @'OpenApiItems'@ (items), it will affect the name of the individual XML elements within the list.
686+ -- When defined alongside type being array (outside the items),
687+ -- it will affect the wrapping element and only if wrapped is true.
688+ -- If wrapped is false, it will be ignored.
689+ _xmlName :: Maybe Text
690+
691+ -- | The URL of the namespace definition.
692+ -- Value SHOULD be in the form of a URL.
693+ , _xmlNamespace :: Maybe Text
694+
695+ -- | The prefix to be used for the name.
696+ , _xmlPrefix :: Maybe Text
697+
698+ -- | Declares whether the property definition translates to an attribute instead of an element.
699+ -- Default value is @False@.
700+ , _xmlAttribute :: Maybe Bool
701+
702+ -- | MAY be used only for an array definition.
703+ -- Signifies whether the array is wrapped
704+ -- (for example, @\<books\>\<book/\>\<book/\>\</books\>@)
705+ -- or unwrapped (@\<book/\>\<book/\>@).
706+ -- Default value is @False@.
707+ -- The definition takes effect only when defined alongside type being array (outside the items).
708+ , _xmlWrapped :: Maybe Bool
709+ } deriving (Eq, Show, Generic, Data, Typeable)
710+
711+-- | A container for the expected responses of an operation.
712+-- The container maps a HTTP response code to the expected response.
713+-- It is not expected from the documentation to necessarily cover all possible HTTP response codes,
714+-- since they may not be known in advance.
715+-- However, it is expected from the documentation to cover a successful operation response and any known errors.
716+data Responses = Responses
717+ { -- | The documentation of responses other than the ones declared for specific HTTP response codes.
718+ -- It can be used to cover undeclared responses.
719+ _responsesDefault :: Maybe (Referenced Response)
720+
721+ -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
722+ -- Describes the expected response for those HTTP status codes.
723+ , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
724+ } deriving (Eq, Show, Generic, Data, Typeable)
725+
726+type HttpStatusCode = Int
727+
728+-- | Describes a single response from an API Operation.
729+data Response = Response
730+ { -- | A short description of the response.
731+ -- [CommonMark syntax](https://spec.commonmark.org/) can be used for rich text representation.
732+ _responseDescription :: Text
733+
734+ -- | A map containing descriptions of potential response payloads.
735+ -- The key is a media type or media type range and the value describes it.
736+ -- For responses that match multiple keys, only the most specific key is applicable.
737+ -- e.g. @text/plain@ overrides @text/\*@.
738+ , _responseContent :: InsOrdHashMap MediaType MediaTypeObject
739+
740+ -- | Maps a header name to its definition.
741+ , _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)
742+
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)
747+ } deriving (Eq, Show, Generic, Data, Typeable)
748+
749+instance IsString Response where
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)
759+
760+type HeaderName = Text
761+
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.
765+data Header = Header
766+ { -- | A short description of the header.
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)
775+
776+ , _headerSchema :: Maybe (Referenced Schema)
777+ } deriving (Eq, Show, Generic, Data, Typeable)
778+
779+-- | The location of the API key.
780+data ApiKeyLocation
781+ = ApiKeyQuery
782+ | ApiKeyHeader
783+ | ApiKeyCookie
784+ deriving (Eq, Show, Generic, Data, Typeable)
785+
786+data ApiKeyParams = ApiKeyParams
787+ { -- | The name of the header or query parameter to be used.
788+ _apiKeyName :: Text
789+
790+ -- | The location of the API key.
791+ , _apiKeyIn :: ApiKeyLocation
792+ } deriving (Eq, Show, Generic, Data, Typeable)
793+
794+-- | The authorization URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
795+type AuthorizationURL = Text
796+
797+-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
798+type TokenURL = Text
799+
800+newtype OAuth2ImplicitFlow
801+ = OAuth2ImplicitFlow {_oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL}
802+ deriving (Eq, Show, Generic, Data, Typeable)
803+
804+newtype OAuth2PasswordFlow
805+ = OAuth2PasswordFlow {_oAuth2PasswordFlowTokenUrl :: TokenURL}
806+ deriving (Eq, Show, Generic, Data, Typeable)
807+
808+newtype OAuth2ClientCredentialsFlow
809+ = OAuth2ClientCredentialsFlow {_oAuth2ClientCredentialsFlowTokenUrl :: TokenURL}
810+ deriving (Eq, Show, Generic, Data, Typeable)
811+
812+data OAuth2AuthorizationCodeFlow = OAuth2AuthorizationCodeFlow
813+ { _oAuth2AuthorizationCodeFlowAuthorizationUrl :: AuthorizationURL
814+ , _oAuth2AuthorizationCodeFlowTokenUrl :: TokenURL
815+ } deriving (Eq, Show, Generic, Data, Typeable)
816+
817+data OAuth2Flow p = OAuth2Flow
818+ { _oAuth2Params :: p
819+
820+ -- | The URL to be used for obtaining refresh tokens.
821+ , _oAath2RefreshUrl :: Maybe URL
822+
823+ -- | The available scopes for the OAuth2 security scheme.
824+ -- A map between the scope name and a short description for it.
825+ -- The map MAY be empty.
826+ , _oAuth2Scopes :: InsOrdHashMap Text Text
827+ } deriving (Eq, Show, Generic, Data, Typeable)
828+
829+data OAuth2Flows = OAuth2Flows
830+ { -- | Configuration for the OAuth Implicit flow
831+ _oAuth2FlowsImplicit :: Maybe (OAuth2Flow OAuth2ImplicitFlow)
832+
833+ -- | Configuration for the OAuth Resource Owner Password flow
834+ , _oAuth2FlowsPassword :: Maybe (OAuth2Flow OAuth2PasswordFlow)
835+
836+ -- | Configuration for the OAuth Client Credentials flow
837+ , _oAuth2FlowsClientCredentials :: Maybe (OAuth2Flow OAuth2ClientCredentialsFlow)
838+
839+ -- | Configuration for the OAuth Authorization Code flow
840+ , _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
841+ } deriving (Eq, Show, Generic, Data, Typeable)
842+
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+--
885+data SecuritySchemeType
886+ = SecuritySchemeHttp HttpSchemeType
887+ | SecuritySchemeApiKey ApiKeyParams
888+ | SecuritySchemeOAuth2 OAuth2Flows
889+ | SecuritySchemeOpenIdConnect URL
890+ deriving (Eq, Show, Generic, Data, Typeable)
891+
892+data SecurityScheme = SecurityScheme
893+ { -- | The type of the security scheme.
894+ _securitySchemeType :: SecuritySchemeType
895+
896+ -- | A short description for security scheme.
897+ , _securitySchemeDescription :: Maybe Text
898+ } deriving (Eq, Show, Generic, Data, Typeable)
899+
900+newtype SecurityDefinitions
901+ = SecurityDefinitions (Definitions SecurityScheme)
902+ deriving (Eq, Show, Generic, Data, Typeable)
903+
904+-- | Lists the required security schemes to execute this operation.
905+-- The object can have multiple security schemes declared in it which are all required
906+-- (that is, there is a logical AND between the schemes).
907+newtype SecurityRequirement = SecurityRequirement
908+ { getSecurityRequirement :: InsOrdHashMap Text [Text]
909+ } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
910+
911+-- | Tag name.
912+type TagName = Text
913+
914+-- | Allows adding meta data to a single tag that is used by @Operation@.
915+-- It is not mandatory to have a @Tag@ per tag used there.
916+data Tag = Tag
917+ { -- | The name of the tag.
918+ _tagName :: TagName
919+
920+ -- | A short description for the tag.
921+ -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
922+ , _tagDescription :: Maybe Text
923+
924+ -- | Additional external documentation for this tag.
925+ , _tagExternalDocs :: Maybe ExternalDocs
926+ } deriving (Eq, Ord, Show, Generic, Data, Typeable)
927+
928+instance Hashable Tag
929+
930+instance IsString Tag where
931+ fromString s = Tag (fromString s) Nothing Nothing
932+
933+-- | Allows referencing an external resource for extended documentation.
934+data ExternalDocs = ExternalDocs
935+ { -- | A short description of the target documentation.
936+ -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
937+ _externalDocsDescription :: Maybe Text
938+
939+ -- | The URL for the target documentation.
940+ , _externalDocsUrl :: URL
941+ } deriving (Eq, Ord, Show, Generic, Data, Typeable)
942+
943+instance Hashable ExternalDocs
944+
945+-- | A simple object to allow referencing other definitions in the specification.
946+-- It can be used to reference parameters and responses that are defined at the top level for reuse.
947+newtype Reference = Reference { getReference :: Text }
948+ deriving (Eq, Show, Data, Typeable)
949+
950+data Referenced a
951+ = Ref Reference
952+ | Inline a
953+ deriving (Eq, Show, Functor, Data, Typeable)
954+
955+instance IsString a => IsString (Referenced a) where
956+ fromString = Inline . fromString
957+
958+newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
959+
960+data AdditionalProperties
961+ = AdditionalPropertiesAllowed Bool
962+ | AdditionalPropertiesSchema (Referenced Schema)
963+ deriving (Eq, Show, Data, Typeable)
964+
965+-------------------------------------------------------------------------------
966+-- Generic instances
967+-------------------------------------------------------------------------------
968+
969+deriveGeneric ''Server
970+deriveGeneric ''Components
971+deriveGeneric ''Header
972+deriveGeneric ''OAuth2Flow
973+deriveGeneric ''OAuth2Flows
974+deriveGeneric ''Operation
975+deriveGeneric ''Param
976+deriveGeneric ''PathItem
977+deriveGeneric ''Response
978+deriveGeneric ''RequestBody
979+deriveGeneric ''MediaTypeObject
980+deriveGeneric ''Responses
981+deriveGeneric ''SecurityScheme
982+deriveGeneric ''Schema
983+deriveGeneric ''OpenApi
984+deriveGeneric ''Example
985+deriveGeneric ''Encoding
986+deriveGeneric ''Link
987+
988+-- =======================================================================
989+-- Monoid instances
990+-- =======================================================================
991+
992+instance Semigroup OpenApi where
993+ (<>) = genericMappend
994+instance Monoid OpenApi where
995+ mempty = genericMempty
996+ mappend = (<>)
997+
998+instance Semigroup Info where
999+ (<>) = genericMappend
1000+instance Monoid Info where
1001+ mempty = genericMempty
1002+ mappend = (<>)
1003+
1004+instance Semigroup Contact where
1005+ (<>) = genericMappend
1006+instance Monoid Contact where
1007+ mempty = genericMempty
1008+ mappend = (<>)
1009+
1010+instance Semigroup Components where
1011+ (<>) = genericMappend
1012+instance Monoid Components where
1013+ mempty = genericMempty
1014+ mappend = (<>)
1015+
1016+instance Semigroup PathItem where
1017+ (<>) = genericMappend
1018+instance Monoid PathItem where
1019+ mempty = genericMempty
1020+ mappend = (<>)
1021+
1022+instance Semigroup Schema where
1023+ (<>) = genericMappend
1024+instance Monoid Schema where
1025+ mempty = genericMempty
1026+ mappend = (<>)
1027+
1028+instance Semigroup Param where
1029+ (<>) = genericMappend
1030+instance Monoid Param where
1031+ mempty = genericMempty
1032+ mappend = (<>)
1033+
1034+instance Semigroup Header where
1035+ (<>) = genericMappend
1036+instance Monoid Header where
1037+ mempty = genericMempty
1038+ mappend = (<>)
1039+
1040+instance Semigroup Responses where
1041+ (<>) = genericMappend
1042+instance Monoid Responses where
1043+ mempty = genericMempty
1044+ mappend = (<>)
1045+
1046+instance Semigroup Response where
1047+ (<>) = genericMappend
1048+instance Monoid Response where
1049+ mempty = genericMempty
1050+ mappend = (<>)
1051+
1052+instance Semigroup MediaTypeObject where
1053+ (<>) = genericMappend
1054+instance Monoid MediaTypeObject where
1055+ mempty = genericMempty
1056+ mappend = (<>)
1057+
1058+instance Semigroup Encoding where
1059+ (<>) = genericMappend
1060+instance Monoid Encoding where
1061+ mempty = genericMempty
1062+ mappend = (<>)
1063+
1064+instance Semigroup ExternalDocs where
1065+ (<>) = genericMappend
1066+instance Monoid ExternalDocs where
1067+ mempty = genericMempty
1068+ mappend = (<>)
1069+
1070+instance Semigroup Operation where
1071+ (<>) = genericMappend
1072+instance Monoid Operation where
1073+ mempty = genericMempty
1074+ mappend = (<>)
1075+
1076+instance Semigroup (OAuth2Flow p) where
1077+ l@OAuth2Flow{ _oAath2RefreshUrl = lUrl, _oAuth2Scopes = lScopes }
1078+ <> OAuth2Flow { _oAath2RefreshUrl = rUrl, _oAuth2Scopes = rScopes } =
1079+ l { _oAath2RefreshUrl = swaggerMappend lUrl rUrl, _oAuth2Scopes = lScopes <> rScopes }
1080+
1081+-- swaggerMappend has First-like semantics, and here we need mappend'ing under Maybes.
1082+instance Semigroup OAuth2Flows where
1083+ l <> r = OAuth2Flows
1084+ { _oAuth2FlowsImplicit = _oAuth2FlowsImplicit l <> _oAuth2FlowsImplicit r
1085+ , _oAuth2FlowsPassword = _oAuth2FlowsPassword l <> _oAuth2FlowsPassword r
1086+ , _oAuth2FlowsClientCredentials = _oAuth2FlowsClientCredentials l <> _oAuth2FlowsClientCredentials r
1087+ , _oAuth2FlowsAuthorizationCode = _oAuth2FlowsAuthorizationCode l <> _oAuth2FlowsAuthorizationCode r
1088+ }
1089+
1090+instance Monoid OAuth2Flows where
1091+ mempty = genericMempty
1092+ mappend = (<>)
1093+
1094+instance Semigroup SecurityScheme where
1095+ SecurityScheme (SecuritySchemeOAuth2 lFlows) lDesc
1096+ <> SecurityScheme (SecuritySchemeOAuth2 rFlows) rDesc =
1097+ SecurityScheme (SecuritySchemeOAuth2 $ lFlows <> rFlows) (swaggerMappend lDesc rDesc)
1098+ l <> _ = l
1099+
1100+instance Semigroup SecurityDefinitions where
1101+ (SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =
1102+ SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2
1103+
1104+instance Monoid SecurityDefinitions where
1105+ mempty = SecurityDefinitions InsOrdHashMap.empty
1106+ mappend = (<>)
1107+
1108+instance Semigroup RequestBody where
1109+ (<>) = genericMappend
1110+instance Monoid RequestBody where
1111+ mempty = genericMempty
1112+ mappend = (<>)
1113+
1114+-- =======================================================================
1115+-- SwaggerMonoid helper instances
1116+-- =======================================================================
1117+
1118+instance SwaggerMonoid Info
1119+instance SwaggerMonoid Components
1120+instance SwaggerMonoid PathItem
1121+instance SwaggerMonoid Schema
1122+instance SwaggerMonoid Param
1123+instance SwaggerMonoid Responses
1124+instance SwaggerMonoid Response
1125+instance SwaggerMonoid ExternalDocs
1126+instance SwaggerMonoid Operation
1127+instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
1128+instance SwaggerMonoid SecurityDefinitions
1129+
1130+instance SwaggerMonoid MimeList
1131+deriving instance SwaggerMonoid URL
1132+
1133+instance SwaggerMonoid OpenApiType where
1134+ swaggerMempty = OpenApiString
1135+ swaggerMappend _ y = y
1136+
1137+instance SwaggerMonoid ParamLocation where
1138+ swaggerMempty = ParamQuery
1139+ swaggerMappend _ y = y
1140+
1141+instance {-# OVERLAPPING #-} SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
1142+ swaggerMempty = InsOrdHashMap.empty
1143+ swaggerMappend = InsOrdHashMap.unionWith mappend
1144+
1145+instance Monoid a => SwaggerMonoid (Referenced a) where
1146+ swaggerMempty = Inline mempty
1147+ swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
1148+ swaggerMappend _ y = y
1149+
1150+-- =======================================================================
1151+-- Simple Generic-based ToJSON instances
1152+-- =======================================================================
1153+
1154+instance ToJSON Style where
1155+ toJSON = genericToJSON (jsonPrefix "Style")
1156+
1157+instance ToJSON OpenApiType where
1158+ toJSON = genericToJSON (jsonPrefix "Swagger")
1159+
1160+instance ToJSON ParamLocation where
1161+ toJSON = genericToJSON (jsonPrefix "Param")
1162+
1163+instance ToJSON Info where
1164+ toJSON = genericToJSON (jsonPrefix "Info")
1165+
1166+instance ToJSON Contact where
1167+ toJSON = genericToJSON (jsonPrefix "Contact")
1168+
1169+instance ToJSON License where
1170+ toJSON = genericToJSON (jsonPrefix "License")
1171+
1172+instance ToJSON ServerVariable where
1173+ toJSON = genericToJSON (jsonPrefix "ServerVariable")
1174+
1175+instance ToJSON ApiKeyLocation where
1176+ toJSON = genericToJSON (jsonPrefix "ApiKey")
1177+
1178+instance ToJSON ApiKeyParams where
1179+ toJSON = genericToJSON (jsonPrefix "apiKey")
1180+
1181+instance ToJSON Tag where
1182+ toJSON = genericToJSON (jsonPrefix "Tag")
1183+
1184+instance ToJSON ExternalDocs where
1185+ toJSON = genericToJSON (jsonPrefix "ExternalDocs")
1186+
1187+instance ToJSON Xml where
1188+ toJSON = genericToJSON (jsonPrefix "Xml")
1189+
1190+instance ToJSON Discriminator where
1191+ toJSON = genericToJSON (jsonPrefix "Discriminator")
1192+
1193+instance ToJSON OAuth2ImplicitFlow where
1194+ toJSON = genericToJSON (jsonPrefix "OAuth2ImplicitFlow")
1195+
1196+instance ToJSON OAuth2PasswordFlow where
1197+ toJSON = genericToJSON (jsonPrefix "OAuth2PasswordFlow")
1198+
1199+instance ToJSON OAuth2ClientCredentialsFlow where
1200+ toJSON = genericToJSON (jsonPrefix "OAuth2ClientCredentialsFlow")
1201+
1202+instance ToJSON OAuth2AuthorizationCodeFlow where
1203+ toJSON = genericToJSON (jsonPrefix "OAuth2AuthorizationCodeFlow")
1204+
1205+-- =======================================================================
1206+-- Simple Generic-based FromJSON instances
1207+-- =======================================================================
1208+
1209+instance FromJSON Style where
1210+ parseJSON = genericParseJSON (jsonPrefix "Style")
1211+
1212+instance FromJSON OpenApiType where
1213+ parseJSON = genericParseJSON (jsonPrefix "Swagger")
1214+
1215+instance FromJSON ParamLocation where
1216+ parseJSON = genericParseJSON (jsonPrefix "Param")
1217+
1218+instance FromJSON Info where
1219+ parseJSON = genericParseJSON (jsonPrefix "Info")
1220+
1221+instance FromJSON Contact where
1222+ parseJSON = genericParseJSON (jsonPrefix "Contact")
1223+
1224+instance FromJSON License where
1225+ parseJSON = genericParseJSON (jsonPrefix "License")
1226+
1227+instance FromJSON ServerVariable where
1228+ parseJSON = genericParseJSON (jsonPrefix "ServerVariable")
1229+
1230+instance FromJSON ApiKeyLocation where
1231+ parseJSON = genericParseJSON (jsonPrefix "ApiKey")
1232+
1233+instance FromJSON ApiKeyParams where
1234+ parseJSON = genericParseJSON (jsonPrefix "apiKey")
1235+
1236+instance FromJSON Tag where
1237+ parseJSON = genericParseJSON (jsonPrefix "Tag")
1238+
1239+instance FromJSON ExternalDocs where
1240+ parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
1241+
1242+instance FromJSON Discriminator where
1243+ parseJSON = genericParseJSON (jsonPrefix "Discriminator")
1244+
1245+instance FromJSON OAuth2ImplicitFlow where
1246+ parseJSON = genericParseJSON (jsonPrefix "OAuth2ImplicitFlow")
1247+
1248+instance FromJSON OAuth2PasswordFlow where
1249+ parseJSON = genericParseJSON (jsonPrefix "OAuth2PasswordFlow")
1250+
1251+instance FromJSON OAuth2ClientCredentialsFlow where
1252+ parseJSON = genericParseJSON (jsonPrefix "OAuth2ClientCredentialsFlow")
1253+
1254+instance FromJSON OAuth2AuthorizationCodeFlow where
1255+ parseJSON = genericParseJSON (jsonPrefix "OAuth2AuthorizationCodeFlow")
1256+
1257+-- =======================================================================
1258+-- Manual ToJSON instances
1259+-- =======================================================================
1260+
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
1269+ toJSON = sopSwaggerGenericToJSON
1270+ toEncoding = sopSwaggerGenericToEncoding
1271+
1272+instance ToJSON OAuth2Flows where
1273+ toJSON = sopSwaggerGenericToJSON
1274+ toEncoding = sopSwaggerGenericToEncoding
1275+
1276+instance ToJSON SecuritySchemeType where
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+ ]
1290+ toJSON (SecuritySchemeApiKey params)
1291+ = toJSON params
1292+ <+> object [ "type" .= ("apiKey" :: Text) ]
1293+ toJSON (SecuritySchemeOAuth2 params) = object
1294+ [ "type" .= ("oauth2" :: Text)
1295+ , "flows" .= toJSON params
1296+ ]
1297+ toJSON (SecuritySchemeOpenIdConnect url) = object
1298+ [ "type" .= ("openIdConnect" :: Text)
1299+ , "openIdConnectUrl" .= url
1300+ ]
1301+
1302+instance ToJSON OpenApi where
1303+ toJSON a = sopSwaggerGenericToJSON a &
1304+ if InsOrdHashMap.null (_openApiPaths a)
1305+ then (<+> object ["paths" .= object []])
1306+ else id
1307+ toEncoding = sopSwaggerGenericToEncoding
1308+
1309+instance ToJSON Server where
1310+ toJSON = sopSwaggerGenericToJSON
1311+ toEncoding = sopSwaggerGenericToEncoding
1312+
1313+instance ToJSON SecurityScheme where
1314+ toJSON = sopSwaggerGenericToJSON
1315+ toEncoding = sopSwaggerGenericToEncoding
1316+
1317+instance ToJSON Schema where
1318+ toJSON = sopSwaggerGenericToJSONWithOpts $
1319+ mkSwaggerAesonOptions "schema" & saoSubObject ?~ "items"
1320+
1321+instance ToJSON Header where
1322+ toJSON = sopSwaggerGenericToJSON
1323+ toEncoding = sopSwaggerGenericToEncoding
1324+
1325+-- | As for nullary schema for 0-arity type constructors, see
1326+-- <https://github.com/GetShopTV/swagger2/issues/167>.
1327+--
1328+-- >>> BSL.putStrLn $ encodePretty (OpenApiItemsArray [])
1329+-- {
1330+-- "example": [],
1331+-- "items": {},
1332+-- "maxItems": 0
1333+-- }
1334+--
1335+instance ToJSON OpenApiItems where
1336+ toJSON (OpenApiItemsObject x) = object [ "items" .= x ]
1337+ toJSON (OpenApiItemsArray []) = object
1338+ [ "items" .= object []
1339+ , "maxItems" .= (0 :: Int)
1340+ , "example" .= Array mempty
1341+ ]
1342+ toJSON (OpenApiItemsArray x) = object [ "items" .= x ]
1343+
1344+instance ToJSON Components where
1345+ toJSON = sopSwaggerGenericToJSON
1346+ toEncoding = sopSwaggerGenericToEncoding
1347+
1348+instance ToJSON MimeList where
1349+ toJSON (MimeList xs) = toJSON (map show xs)
1350+
1351+instance ToJSON Param where
1352+ toJSON = sopSwaggerGenericToJSON
1353+ toEncoding = sopSwaggerGenericToEncoding
1354+
1355+instance ToJSON Responses where
1356+ toJSON = sopSwaggerGenericToJSON
1357+ toEncoding = sopSwaggerGenericToEncoding
1358+
1359+instance ToJSON Response where
1360+ toJSON = sopSwaggerGenericToJSON
1361+ toEncoding = sopSwaggerGenericToEncoding
1362+
1363+instance ToJSON Operation where
1364+ toJSON = sopSwaggerGenericToJSON
1365+ toEncoding = sopSwaggerGenericToEncoding
1366+
1367+instance ToJSON PathItem where
1368+ toJSON = sopSwaggerGenericToJSON
1369+ toEncoding = sopSwaggerGenericToEncoding
1370+
1371+instance ToJSON RequestBody where
1372+ toJSON = sopSwaggerGenericToJSON
1373+ toEncoding = sopSwaggerGenericToEncoding
1374+
1375+instance ToJSON MediaTypeObject where
1376+ toJSON = sopSwaggerGenericToJSON
1377+ toEncoding = sopSwaggerGenericToEncoding
1378+
1379+instance ToJSON Example where
1380+ toJSON = sopSwaggerGenericToJSON
1381+ toEncoding = sopSwaggerGenericToEncoding
1382+
1383+instance ToJSON Encoding where
1384+ toJSON = sopSwaggerGenericToJSON
1385+ toEncoding = sopSwaggerGenericToEncoding
1386+
1387+instance ToJSON Link where
1388+ toJSON = sopSwaggerGenericToJSON
1389+ toEncoding = sopSwaggerGenericToEncoding
1390+
1391+instance ToJSON SecurityDefinitions where
1392+ toJSON (SecurityDefinitions sd) = toJSON sd
1393+
1394+instance ToJSON Reference where
1395+ toJSON (Reference ref) = object [ "$ref" .= ref ]
1396+
1397+referencedToJSON :: ToJSON a => Text -> Referenced a -> Value
1398+referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ]
1399+referencedToJSON _ (Inline x) = toJSON x
1400+
1401+instance ToJSON (Referenced Schema) where toJSON = referencedToJSON "#/components/schemas/"
1402+instance ToJSON (Referenced Param) where toJSON = referencedToJSON "#/components/parameters/"
1403+instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/components/responses/"
1404+instance ToJSON (Referenced RequestBody) where toJSON = referencedToJSON "#/components/requestBodies/"
1405+instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/components/examples/"
1406+instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"
1407+instance ToJSON (Referenced Link) where toJSON = referencedToJSON "#/components/links/"
1408+instance ToJSON (Referenced Callback) where toJSON = referencedToJSON "#/components/callbacks/"
1409+
1410+instance ToJSON AdditionalProperties where
1411+ toJSON (AdditionalPropertiesAllowed b) = toJSON b
1412+ toJSON (AdditionalPropertiesSchema s) = toJSON s
1413+
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+
1421+-- =======================================================================
1422+-- Manual FromJSON instances
1423+-- =======================================================================
1424+
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+
1432+instance (Eq p, FromJSON p, AesonDefaultValue p) => FromJSON (OAuth2Flow p) where
1433+ parseJSON = sopSwaggerGenericParseJSON
1434+
1435+instance FromJSON OAuth2Flows where
1436+ parseJSON = sopSwaggerGenericParseJSON
1437+
1438+instance FromJSON SecuritySchemeType where
1439+ parseJSON js@(Object o) = do
1440+ (t :: Text) <- o .: "type"
1441+ case t of
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
1448+ "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1449+ "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")
1450+ "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")
1451+ _ -> empty
1452+ parseJSON _ = empty
1453+
1454+instance FromJSON OpenApi where
1455+ parseJSON = sopSwaggerGenericParseJSON
1456+
1457+instance FromJSON Server where
1458+ parseJSON = sopSwaggerGenericParseJSON
1459+
1460+instance FromJSON SecurityScheme where
1461+ parseJSON = sopSwaggerGenericParseJSON
1462+
1463+instance FromJSON Schema where
1464+ parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1465+ where nullaryCleanup :: Schema -> Schema
1466+ nullaryCleanup s =
1467+ if _schemaItems s == Just (OpenApiItemsArray [])
1468+ then s { _schemaExample = Nothing
1469+ , _schemaMaxItems = Nothing
1470+ }
1471+ else s
1472+
1473+instance FromJSON Header where
1474+ parseJSON = sopSwaggerGenericParseJSON
1475+
1476+instance FromJSON OpenApiItems where
1477+ parseJSON js@(Object obj)
1478+ | null obj = pure $ OpenApiItemsArray [] -- Nullary schema.
1479+ | otherwise = OpenApiItemsObject <$> parseJSON js
1480+ parseJSON js@(Array _) = OpenApiItemsArray <$> parseJSON js
1481+ parseJSON _ = empty
1482+
1483+instance FromJSON Components where
1484+ parseJSON = sopSwaggerGenericParseJSON
1485+
1486+instance FromJSON MimeList where
1487+ parseJSON js = MimeList . map fromString <$> parseJSON js
1488+
1489+instance FromJSON Param where
1490+ parseJSON = sopSwaggerGenericParseJSON
1491+
1492+instance FromJSON Responses where
1493+ parseJSON (Object o) = Responses
1494+ <$> o .:? "default"
1495+ <*> parseJSON (Object (deleteKey "default" o))
1496+ parseJSON _ = empty
1497+
1498+instance FromJSON Example where
1499+ parseJSON = sopSwaggerGenericParseJSON
1500+
1501+instance FromJSON Response where
1502+ parseJSON = sopSwaggerGenericParseJSON
1503+
1504+instance FromJSON Operation where
1505+ parseJSON = sopSwaggerGenericParseJSON
1506+
1507+instance FromJSON PathItem where
1508+ parseJSON = sopSwaggerGenericParseJSON
1509+
1510+instance FromJSON SecurityDefinitions where
1511+ parseJSON js = SecurityDefinitions <$> parseJSON js
1512+
1513+instance FromJSON RequestBody where
1514+ parseJSON = sopSwaggerGenericParseJSON
1515+
1516+instance FromJSON MediaTypeObject where
1517+ parseJSON = sopSwaggerGenericParseJSON
1518+
1519+instance FromJSON Encoding where
1520+ parseJSON = sopSwaggerGenericParseJSON
1521+
1522+instance FromJSON Link where
1523+ parseJSON = sopSwaggerGenericParseJSON
1524+
1525+instance FromJSON Reference where
1526+ parseJSON (Object o) = Reference <$> o .: "$ref"
1527+ parseJSON _ = empty
1528+
1529+referencedParseJSON :: FromJSON a => Text -> Value -> JSON.Parser (Referenced a)
1530+referencedParseJSON prefix js@(Object o) = do
1531+ ms <- o .:? "$ref"
1532+ case ms of
1533+ Nothing -> Inline <$> parseJSON js
1534+ Just s -> Ref <$> parseRef s
1535+ where
1536+ parseRef s = do
1537+ case Text.stripPrefix prefix s of
1538+ Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1539+ Just suffix -> pure (Reference suffix)
1540+referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
1541+
1542+instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/components/schemas/"
1543+instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/components/parameters/"
1544+instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#/components/responses/"
1545+instance FromJSON (Referenced RequestBody) where parseJSON = referencedParseJSON "#/components/requestBodies/"
1546+instance FromJSON (Referenced Example) where parseJSON = referencedParseJSON "#/components/examples/"
1547+instance 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/"
1550+
1551+instance FromJSON Xml where
1552+ parseJSON = genericParseJSON (jsonPrefix "xml")
1553+
1554+instance FromJSON AdditionalProperties where
1555+ parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1556+ parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1557+
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+
1566+instance HasSwaggerAesonOptions Server where
1567+ swaggerAesonOptions _ = mkSwaggerAesonOptions "server"
1568+instance HasSwaggerAesonOptions Components where
1569+ swaggerAesonOptions _ = mkSwaggerAesonOptions "components"
1570+instance HasSwaggerAesonOptions Header where
1571+ swaggerAesonOptions _ = mkSwaggerAesonOptions "header"
1572+instance AesonDefaultValue p => HasSwaggerAesonOptions (OAuth2Flow p) where
1573+ swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "params"
1574+instance HasSwaggerAesonOptions OAuth2Flows where
1575+ swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2Flows"
1576+instance HasSwaggerAesonOptions Operation where
1577+ swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
1578+instance HasSwaggerAesonOptions Param where
1579+ swaggerAesonOptions _ = mkSwaggerAesonOptions "param"
1580+instance HasSwaggerAesonOptions PathItem where
1581+ swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
1582+instance HasSwaggerAesonOptions Response where
1583+ swaggerAesonOptions _ = mkSwaggerAesonOptions "response"
1584+instance HasSwaggerAesonOptions RequestBody where
1585+ swaggerAesonOptions _ = mkSwaggerAesonOptions "requestBody"
1586+instance HasSwaggerAesonOptions MediaTypeObject where
1587+ swaggerAesonOptions _ = mkSwaggerAesonOptions "mediaTypeObject"
1588+instance HasSwaggerAesonOptions Responses where
1589+ swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject ?~ "responses"
1590+instance HasSwaggerAesonOptions SecurityScheme where
1591+ swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1592+instance HasSwaggerAesonOptions Schema where
1593+ swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1594+instance HasSwaggerAesonOptions OpenApi where
1595+ swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")]
1596+instance HasSwaggerAesonOptions Example where
1597+ swaggerAesonOptions _ = mkSwaggerAesonOptions "example"
1598+instance HasSwaggerAesonOptions Encoding where
1599+ swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding"
1600+
1601+instance HasSwaggerAesonOptions Link where
1602+ swaggerAesonOptions _ = mkSwaggerAesonOptions "link"
1603+
1604+instance AesonDefaultValue Server
1605+instance AesonDefaultValue Components
1606+instance AesonDefaultValue OAuth2ImplicitFlow
1607+instance AesonDefaultValue OAuth2PasswordFlow
1608+instance AesonDefaultValue OAuth2ClientCredentialsFlow
1609+instance AesonDefaultValue OAuth2AuthorizationCodeFlow
1610+instance AesonDefaultValue p => AesonDefaultValue (OAuth2Flow p)
1611+instance AesonDefaultValue Responses
1612+instance AesonDefaultValue SecuritySchemeType
1613+instance AesonDefaultValue OpenApiType
1614+instance AesonDefaultValue MimeList where defaultValue = Just mempty
1615+instance AesonDefaultValue Info
1616+instance 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−45
@@ -1,20 +1,15 @@
1−{-# LANGUAGE CPP #-}
21{-# LANGUAGE DataKinds #-}
32{-# LANGUAGE FlexibleContexts #-}
43{-# LANGUAGE GADTs #-}
54{-# LANGUAGE ScopedTypeVariables #-}
65{-# LANGUAGE ExplicitForAll #-}
76{-# LANGUAGE TemplateHaskell #-}
8−#if __GLASGOW_HASKELL__ >= 800
97{-# LANGUAGE UndecidableSuperClasses #-}
10−#endif
11−module Data.Swagger.Internal.AesonUtils (
8+module Data.OpenApi.Internal.AesonUtils (
129 -- * Generic functions
1310 AesonDefaultValue(..),
1411 sopSwaggerGenericToJSON,
15−#if MIN_VERSION_aeson(0,10,0)
1612 sopSwaggerGenericToEncoding,
17−#endif
1813 sopSwaggerGenericToJSONWithOpts,
1914 sopSwaggerGenericParseJSON,
2015 -- * Options
@@ -32,7 +27,7 @@ import Prelude.Compat
3227import Control.Applicative ((<|>))
3328import Control.Lens (makeLenses, (^.))
3429import Control.Monad (unless)
35−import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), Object, object, (.:), (.:?), (.!=), withObject)
30+import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), Object, object, (.:), (.:?), (.!=), withObject, Encoding, pairs, (.=), Series)
3631import Data.Aeson.Types (Parser, Pair)
3732import Data.Char (toLower, isUpper)
3833import Data.Foldable (traverse_)
@@ -41,14 +36,11 @@ import Data.Text (Text)
4136import Generics.SOP
4237
4338import qualified Data.Text as T
44−import qualified Data.HashMap.Strict as HM
4539import qualified Data.Set as Set
4640import qualified Data.HashMap.Strict.InsOrd as InsOrd
4741import qualified Data.HashSet.InsOrd as InsOrdHS
4842
49−#if MIN_VERSION_aeson(0,10,0)
50−import Data.Aeson (Encoding, pairs, (.=), Series)
51−#endif
43+import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)
5244
5345-------------------------------------------------------------------------------
5446-- SwaggerAesonOptions
@@ -56,7 +48,7 @@ import Data.Aeson (Encoding, pairs, (.=), Series)
5648
5749data SwaggerAesonOptions = SwaggerAesonOptions
5850 { _saoPrefix :: String
59− , _saoAdditionalPairs :: [(Text, Value)]
51+ , _saoAdditionalPairs :: [Pair]
6052 , _saoSubObject :: Maybe String
6153 }
6254
@@ -146,11 +138,7 @@ sopSwaggerGenericToJSON'
146138 -> DatatypeInfo '[xs]
147139 -> POP Maybe '[xs]
148140 -> [Pair]
149−#if MIN_VERSION_generics_sop(0,5,0)
150141sopSwaggerGenericToJSON' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =
151−#else
152−sopSwaggerGenericToJSON' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =
153−#endif
154142 sopSwaggerGenericToJSON'' opts fields fieldsInfo defs
155143sopSwaggerGenericToJSON' _ _ _ _ = error "sopSwaggerGenericToJSON: unsupported type"
156144
@@ -167,21 +155,18 @@ sopSwaggerGenericToJSON'' (SwaggerAesonOptions prefix _ sub) = go
167155 go Nil Nil Nil = []
168156 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
169157 | Just name' == sub = case json of
170− Object m -> HM.toList m ++ rest
158+ Object m -> objectToList m ++ rest
171159 Null -> rest
172160 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
173161 -- If default value: omit it.
174162 | Just x == def =
175163 rest
176164 | otherwise =
177− (T.pack name', json) : rest
165+ (stringToKey name', json) : rest
178166 where
179167 json = toJSON x
180168 name' = fieldNameModifier name
181169 rest = go xs names defs
182−#if __GLASGOW_HASKELL__ < 800
183− go _ _ _ = error "not empty"
184−#endif
185170
186171 fieldNameModifier = modifier . drop 1
187172 modifier = lowerFirstUppers . drop (length prefix)
@@ -211,11 +196,11 @@ sopSwaggerGenericParseJSON = withObject "Swagger Record Object" $ \obj ->
211196 proxy = Proxy :: Proxy a
212197 opts = swaggerAesonOptions proxy
213198
214− parseAdditionalField :: Object -> (Text, Value) -> Parser ()
199+ parseAdditionalField :: Object -> Pair -> Parser ()
215200 parseAdditionalField obj (k, v) = do
216201 v' <- obj .: k
217202 unless (v == v') $ fail $
218− "Additonal field don't match for key " ++ T.unpack k
203+ "Additonal field don't match for key " ++ keyToString k
219204 ++ ": " ++ show v
220205 ++ " /= " ++ show v'
221206
@@ -226,11 +211,7 @@ sopSwaggerGenericParseJSON'
226211 -> DatatypeInfo '[xs]
227212 -> POP Maybe '[xs]
228213 -> Parser (SOP I '[xs])
229−#if MIN_VERSION_generics_sop(0,5,0)
230214sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =
231−#else
232−sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =
233−#endif
234215 SOP . Z <$> sopSwaggerGenericParseJSON'' opts obj fieldsInfo defs
235216sopSwaggerGenericParseJSON' _ _ _ _ = error "sopSwaggerGenericParseJSON: unsupported type"
236217
@@ -250,8 +231,8 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
250231 -- Note: we might strip fields of outer structure.
251232 cons <$> (withDef $ parseJSON $ Object obj) <*> rest
252233 | otherwise = case def of
253− Just def' -> cons <$> obj .:? T.pack name' .!= def' <*> rest
254− Nothing -> cons <$> obj .: T.pack name' <*> rest
234+ Just def' -> cons <$> obj .:? stringToKey name' .!= def' <*> rest
235+ Nothing -> cons <$> obj .: stringToKey name' <*> rest
255236 where
256237 cons h t = I h :* t
257238 name' = fieldNameModifier name
@@ -260,9 +241,6 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
260241 withDef = case def of
261242 Just def' -> (<|> pure def')
262243 Nothing -> id
263−#if __GLASGOW_HASKELL__ < 800
264− go _ _ = error "not empty"
265−#endif
266244
267245 fieldNameModifier = modifier . drop 1
268246 modifier = lowerFirstUppers . drop (length prefix)
@@ -273,8 +251,6 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
273251-- ToEncoding
274252-------------------------------------------------------------------------------
275253
276−#if MIN_VERSION_aeson(0,10,0)
277−
278254sopSwaggerGenericToEncoding
279255 :: forall a xs.
280256 ( HasDatatypeInfo a
@@ -302,11 +278,7 @@ sopSwaggerGenericToEncoding'
302278 -> DatatypeInfo '[xs]
303279 -> POP Maybe '[xs]
304280 -> Series
305−#if MIN_VERSION_generics_sop(0,5,0)
306281sopSwaggerGenericToEncoding' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =
307−#else
308−sopSwaggerGenericToEncoding' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =
309−#endif
310282 sopSwaggerGenericToEncoding'' opts fields fieldsInfo defs
311283sopSwaggerGenericToEncoding' _ _ _ _ = error "sopSwaggerGenericToEncoding: unsupported type"
312284
@@ -323,24 +295,19 @@ sopSwaggerGenericToEncoding'' (SwaggerAesonOptions prefix _ sub) = go
323295 go Nil Nil Nil = mempty
324296 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
325297 | Just name' == sub = case toJSON x of
326− Object m -> pairsToSeries (HM.toList m) <> rest
298+ Object m -> pairsToSeries (objectToList m) <> rest
327299 Null -> rest
328300 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
329301 -- If default value: omit it.
330302 | Just x == def =
331303 rest
332304 | otherwise =
333− (T.pack name' .= x) <> rest
305+ (stringToKey name' .= x) <> rest
334306 where
335307 name' = fieldNameModifier name
336308 rest = go xs names defs
337−#if __GLASGOW_HASKELL__ < 800
338− go _ _ _ = error "not empty"
339−#endif
340309
341310 fieldNameModifier = modifier . drop 1
342311 modifier = lowerFirstUppers . drop (length prefix)
343312 lowerFirstUppers s = map toLower x ++ y
344313 where (x, y) = span isUpper s
345−
346−#endif
src/Data/Swagger/Internal/ParamSchema.hs → src/Data/OpenApi/Internal/ParamSchema.hsrenamed+84−67
@@ -1,4 +1,3 @@
1−{-# LANGUAGE CPP #-}
21{-# LANGUAGE DataKinds #-}
32{-# LANGUAGE DefaultSignatures #-}
43{-# LANGUAGE FlexibleContexts #-}
@@ -12,14 +11,11 @@
1211{-# LANGUAGE TypeOperators #-}
1312{-# LANGUAGE TypeSynonymInstances #-}
1413{-# LANGUAGE UndecidableInstances #-}
15−#if __GLASGOW_HASKELL__ >= 800
1614-- Generic a is redundant in ToParamSchema a default imple
1715{-# OPTIONS_GHC -Wno-redundant-constraints #-}
1816-- For TypeErrors
1917{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
20−#endif
21−#include "overlapping-compat.h"
22−module Data.Swagger.Internal.ParamSchema where
18+module Data.OpenApi.Internal.ParamSchema where
2319
2420import Control.Lens
2521import Data.Aeson (ToJSON (..))
@@ -45,37 +41,40 @@ import Data.Word
4541import Data.UUID.Types (UUID)
4642import Web.Cookie (SetCookie)
4743
48−import Data.Swagger.Internal
49−import Data.Swagger.Lens
50−import Data.Swagger.SchemaOptions
44+import Data.OpenApi.Internal
45+import Data.OpenApi.Lens
46+import Data.OpenApi.SchemaOptions
5147
52−#if __GLASGOW_HASKELL__ < 800
53−#else
5448import qualified Data.ByteString as BS
55−import qualified Data.ByteString.Lazy as BSL
49+import qualified Data.ByteString.Lazy.Char8 as BSL
5650import GHC.TypeLits (TypeError, ErrorMessage(..))
57−#endif
5851
5952-- | Default schema for binary data (any sequence of octets).
60−binaryParamSchema :: ParamSchema t
61−binaryParamSchema = mempty
62− & type_ ?~ SwaggerString
53+binarySchema :: Schema
54+binarySchema = mempty
55+ & type_ ?~ OpenApiString
6356 & format ?~ "binary"
6457
6558-- | Default schema for binary data (base64 encoded).
66−byteParamSchema :: ParamSchema t
67−byteParamSchema = mempty
68− & type_ ?~ SwaggerString
59+byteSchema :: Schema
60+byteSchema = mempty
61+ & type_ ?~ OpenApiString
6962 & format ?~ "byte"
7063
7164-- | Default schema for password string.
7265-- @"password"@ format is used to hint UIs the input needs to be obscured.
73−passwordParamSchema :: ParamSchema t
74−passwordParamSchema = mempty
75− & type_ ?~ SwaggerString
66+passwordSchema :: Schema
67+passwordSchema = mempty
68+ & type_ ?~ OpenApiString
7669 & format ?~ "password"
7770
78−-- | 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.
7978--
8079-- An example type and instance:
8180--
@@ -88,7 +87,7 @@ passwordParamSchema = mempty
8887--
8988-- instance ToParamSchema Direction where
9089-- toParamSchema _ = mempty
91−-- & type_ ?~ SwaggerString
90+-- & type_ ?~ OpenApiString
9291-- & enum_ ?~ [ \"Up\", \"Down\" ]
9392-- @
9493--
@@ -113,24 +112,26 @@ passwordParamSchema = mempty
113112class ToParamSchema a where
114113 -- | Convert a type into a plain parameter schema.
115114 --
116− -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)
117− -- "{\"type\":\"integer\"}"
118− toParamSchema :: Proxy a -> ParamSchema t
119− 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
120121 toParamSchema = genericToParamSchema defaultSchemaOptions
121122
122−instance OVERLAPPING_ ToParamSchema String where
123− toParamSchema _ = mempty & type_ ?~ SwaggerString
123+instance {-# OVERLAPPING #-} ToParamSchema String where
124+ toParamSchema _ = mempty & type_ ?~ OpenApiString
124125
125126instance ToParamSchema Bool where
126− toParamSchema _ = mempty & type_ ?~ SwaggerBoolean
127+ toParamSchema _ = mempty & type_ ?~ OpenApiBoolean
127128
128129instance ToParamSchema Integer where
129− toParamSchema _ = mempty & type_ ?~ SwaggerInteger
130+ toParamSchema _ = mempty & type_ ?~ OpenApiInteger
130131
131132instance ToParamSchema Natural where
132133 toParamSchema _ = mempty
133− & type_ ?~ SwaggerInteger
134+ & type_ ?~ OpenApiInteger
134135 & minimum_ ?~ 0
135136 & exclusiveMinimum ?~ False
136137
@@ -147,46 +148,54 @@ instance ToParamSchema Int64 where
147148instance ToParamSchema Word where toParamSchema = toParamSchemaBoundedIntegral
148149instance ToParamSchema Word8 where toParamSchema = toParamSchemaBoundedIntegral
149150instance ToParamSchema Word16 where toParamSchema = toParamSchemaBoundedIntegral
150−instance ToParamSchema Word32 where toParamSchema = toParamSchemaBoundedIntegral
151−instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral
151+
152+instance ToParamSchema Word32 where
153+ toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int32"
154+
155+instance ToParamSchema Word64 where
156+ toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int64"
152157
153158-- | Default plain schema for @'Bounded'@, @'Integral'@ types.
154159--
155−-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
156−-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
157−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
158167toParamSchemaBoundedIntegral _ = mempty
159− & type_ ?~ SwaggerInteger
168+ & type_ ?~ OpenApiInteger
160169 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
161170 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
162171
163172instance ToParamSchema Char where
164173 toParamSchema _ = mempty
165− & type_ ?~ SwaggerString
174+ & type_ ?~ OpenApiString
166175 & maxLength ?~ 1
167176 & minLength ?~ 1
168177
169178instance ToParamSchema Scientific where
170− toParamSchema _ = mempty & type_ ?~ SwaggerNumber
179+ toParamSchema _ = mempty & type_ ?~ OpenApiNumber
171180
172181instance HasResolution a => ToParamSchema (Fixed a) where
173182 toParamSchema _ = mempty
174− & type_ ?~ SwaggerNumber
183+ & type_ ?~ OpenApiNumber
175184 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
176185
177186instance ToParamSchema Double where
178187 toParamSchema _ = mempty
179− & type_ ?~ SwaggerNumber
188+ & type_ ?~ OpenApiNumber
180189 & format ?~ "double"
181190
182191instance ToParamSchema Float where
183192 toParamSchema _ = mempty
184− & type_ ?~ SwaggerNumber
193+ & type_ ?~ OpenApiNumber
185194 & format ?~ "float"
186195
187−timeParamSchema :: String -> ParamSchema t
196+timeParamSchema :: String -> Schema
188197timeParamSchema fmt = mempty
189− & type_ ?~ SwaggerString
198+ & type_ ?~ OpenApiString
190199 & format ?~ T.pack fmt
191200
192201-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -207,9 +216,9 @@ instance ToParamSchema LocalTime where
207216
208217-- |
209218-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
210−-- Just "yyyy-mm-ddThh:MM:ss+hhMM"
219+-- Just "date-time"
211220instance ToParamSchema ZonedTime where
212− toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+hhMM"
221+ toParamSchema _ = timeParamSchema "date-time"
213222
214223-- |
215224-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format
@@ -228,25 +237,21 @@ instance ToParamSchema TL.Text where
228237
229238instance ToParamSchema Version where
230239 toParamSchema _ = mempty
231− & type_ ?~ SwaggerString
240+ & type_ ?~ OpenApiString
232241 & pattern ?~ "^\\d+(\\.\\d+)*$"
233242
234243instance ToParamSchema SetCookie where
235244 toParamSchema _ = mempty
236− & type_ ?~ SwaggerString
237−
245+ & type_ ?~ OpenApiString
238246
239−#if __GLASGOW_HASKELL__ < 800
240−#else
241247type family ToParamSchemaByteStringError bs where
242248 ToParamSchemaByteStringError bs = TypeError
243249 ( 'Text "Impossible to have an instance " :<>: ShowType (ToParamSchema bs) :<>: Text "."
244250 :$$: 'Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
245− :$$: 'Text "Consider using byteParamSchema or binaryParamSchema templates." )
251+ :$$: 'Text "Consider using byteParamSchema or binaryParamSchemaemplates." )
246252
247253instance ToParamSchemaByteStringError BS.ByteString => ToParamSchema BS.ByteString where toParamSchema = error "impossible"
248254instance ToParamSchemaByteStringError BSL.ByteString => ToParamSchema BSL.ByteString where toParamSchema = error "impossible"
249−#endif
250255
251256instance ToParamSchema All where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool)
252257instance ToParamSchema Any where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool)
@@ -260,8 +265,8 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t
260265
261266instance ToParamSchema a => ToParamSchema [a] where
262267 toParamSchema _ = mempty
263− & type_ ?~ SwaggerArray
264− & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))
268+ & type_ ?~ OpenApiArray
269+ & items ?~ OpenApiItemsObject (Inline $ toParamSchema (Proxy :: Proxy a))
265270
266271instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
267272instance ToParamSchema a => ToParamSchema (VP.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
@@ -276,29 +281,40 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
276281 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
277282
278283-- |
279−-- >>> encode $ toParamSchema (Proxy :: Proxy ())
280−-- "{\"type\":\"string\",\"enum\":[\"_\"]}"
284+-- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy ())
285+-- {
286+-- "enum": [
287+-- "_"
288+-- ],
289+-- "type": "string"
290+-- }
281291instance ToParamSchema () where
282292 toParamSchema _ = mempty
283− & type_ ?~ SwaggerString
293+ & type_ ?~ OpenApiString
284294 & enum_ ?~ ["_"]
285295
286296instance ToParamSchema UUID where
287297 toParamSchema _ = mempty
288− & type_ ?~ SwaggerString
298+ & type_ ?~ OpenApiString
289299 & format ?~ "uuid"
290300
291−-- | A configurable generic @'ParamSchema'@ creator.
301+-- | A configurable generic @'Schema'@ creator.
292302--
293303-- >>> :set -XDeriveGeneric
294304-- >>> data Color = Red | Blue deriving Generic
295−-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
296−-- "{\"type\":\"string\",\"enum\":[\"Red\",\"Blue\"]}"
297−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
298314genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
299315
300316class GToParamSchema (f :: * -> *) where
301− gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
317+ gtoParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
302318
303319instance GToParamSchema f => GToParamSchema (D1 d f) where
304320 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
@@ -316,14 +332,14 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) wh
316332 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
317333
318334class GEnumParamSchema (f :: * -> *) where
319− genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
335+ genumParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
320336
321337instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
322338 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)
323339
324340instance Constructor c => GEnumParamSchema (C1 c U1) where
325341 genumParamSchema opts _ s = s
326− & type_ ?~ SwaggerString
342+ & type_ ?~ OpenApiString
327343 & enum_ %~ addEnumValue tag
328344 where
329345 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
@@ -335,3 +351,4 @@ data Proxy3 a b c = Proxy3
335351
336352-- $setup
337353-- >>> import Data.Aeson (encode)
354+-- >>> import Data.OpenApi.Internal.Utils
src/Data/Swagger/Internal/Schema.hs → src/Data/OpenApi/Internal/Schema.hsrenamed+455−211
@@ -1,38 +1,36 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE ConstraintKinds #-}
3+{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE DefaultSignatures #-}
45{-# LANGUAGE FlexibleContexts #-}
56{-# LANGUAGE FlexibleInstances #-}
67{-# LANGUAGE KindSignatures #-}
7−{-# LANGUAGE DataKinds #-}
88{-# LANGUAGE OverloadedLists #-}
99{-# LANGUAGE OverloadedStrings #-}
1010{-# LANGUAGE PackageImports #-}
1111{-# LANGUAGE PolyKinds #-}
1212{-# LANGUAGE ScopedTypeVariables #-}
1313{-# LANGUAGE TupleSections #-}
14+{-# LANGUAGE TypeApplications #-}
1415{-# LANGUAGE TypeFamilies #-}
1516{-# LANGUAGE TypeOperators #-}
1617{-# LANGUAGE TypeSynonymInstances #-}
1718{-# LANGUAGE UndecidableInstances #-}
18−#if __GLASGOW_HASKELL__ >= 800
19−-- Few generics related redundant constraints
2019{-# OPTIONS_GHC -Wno-redundant-constraints #-}
2120-- For TypeErrors
2221{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
23−#endif
24−#include "overlapping-compat.h"
25−module Data.Swagger.Internal.Schema where
22+module Data.OpenApi.Internal.Schema where
2623
2724import Prelude ()
2825import Prelude.Compat
2926
30−import Control.Lens
27+import Control.Lens hiding (allOf)
3128import Data.Data.Lens (template)
3229
3330import Control.Monad
3431import Control.Monad.Writer
35−import Data.Aeson (ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..), Value (..), Object(..))
32+import Data.Aeson (Object (..), SumEncoding (..), ToJSON (..), ToJSONKey (..),
33+ ToJSONKeyFunction (..), Value (..))
3634import Data.Char
3735import Data.Data (Data)
3836import Data.Foldable (traverse_)
@@ -44,8 +42,10 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
4442import Data.Int
4543import Data.IntSet (IntSet)
4644import Data.IntMap (IntMap)
45+import Data.List (sort)
4746import Data.List.NonEmpty.Compat (NonEmpty)
4847import Data.Map (Map)
48+import Data.Maybe (fromMaybe)
4949import Data.Proxy
5050import Data.Scientific (Scientific)
5151import Data.Fixed (Fixed, HasResolution, Pico)
@@ -62,21 +62,20 @@ import Numeric.Natural.Compat (Natural)
6262import Data.Word
6363import GHC.Generics
6464import qualified Data.UUID.Types as UUID
65+import Type.Reflection (Typeable, typeRep)
6566
66−import Data.Swagger.Declare
67−import Data.Swagger.Internal
68−import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
69−import Data.Swagger.Lens hiding (name, schema)
70−import qualified Data.Swagger.Lens as Swagger
71−import Data.Swagger.SchemaOptions
72−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
7375
74−#if __GLASGOW_HASKELL__ < 800
75−#else
7676import qualified Data.ByteString as BS
77−import qualified Data.ByteString.Lazy as BSL
77+import qualified Data.ByteString.Lazy.Char8 as BSL
7878import GHC.TypeLits (TypeError, ErrorMessage(..))
79−#endif
8079
8180unnamed :: Schema -> NamedSchema
8281unnamed schema = NamedSchema Nothing schema
@@ -103,7 +102,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
103102--
104103-- import Control.Lens
105104-- import Data.Proxy
106−-- import Data.Swagger
105+-- import Data.OpenApi
107106--
108107-- data Coord = Coord { x :: Double, y :: Double }
109108--
@@ -111,7 +110,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
111110-- declareNamedSchema _ = do
112111-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
113112-- return $ NamedSchema (Just \"Coord\") $ mempty
114−-- & type_ ?~ SwaggerObject
113+-- & type_ ?~ OpenApiObject
115114-- & properties .~
116115-- [ (\"x\", doubleSchema)
117116-- , (\"y\", doubleSchema)
@@ -137,13 +136,13 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
137136--
138137-- instance ToSchema Coord
139138-- @
140−class ToSchema a where
139+class Typeable a => ToSchema a where
141140 -- | Convert a type into an optionally named schema
142141 -- together with all used definitions.
143142 -- Note that the schema itself is included in definitions
144143 -- only if it is recursive (and thus needs its definition in scope).
145144 declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
146− default declareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
145+ default declareNamedSchema :: (Generic a, GToSchema (Rep a)) =>
147146 Proxy a -> Declare (Definitions Schema) NamedSchema
148147 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
149148
@@ -159,13 +158,19 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
159158--
160159-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
161160-- Nothing
162−-- >>> encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
163−-- "{\"type\":\"string\"}"
161+-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy String) ^. schema)
162+-- {
163+-- "type": "string"
164+-- }
164165--
165166-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
166167-- Just "Day"
167−-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
168−-- "{\"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+-- }
169174toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
170175toNamedSchema = undeclare . declareNamedSchema
171176
@@ -181,22 +186,35 @@ schemaName = _namedSchemaName . toNamedSchema
181186
182187-- | Convert a type into a schema.
183188--
184−-- >>> encode $ toSchema (Proxy :: Proxy Int8)
185−-- "{\"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+-- }
186195--
187−-- >>> encode $ toSchema (Proxy :: Proxy [Day])
188−-- "{\"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+-- }
189203toSchema :: ToSchema a => Proxy a -> Schema
190204toSchema = _namedSchemaSchema . toNamedSchema
191205
192206-- | Convert a type into a referenced schema if possible.
193207-- Only named schemas can be referenced, nameless schemas are inlined.
194208--
195−-- >>> encode $ toSchemaRef (Proxy :: Proxy Integer)
196−-- "{\"type\":\"integer\"}"
209+-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Integer)
210+-- {
211+-- "type": "integer"
212+-- }
197213--
198−-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)
199−-- "{\"$ref\":\"#/definitions/Day\"}"
214+-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Day)
215+-- {
216+-- "$ref": "#/components/schemas/Day"
217+-- }
200218toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
201219toSchemaRef = undeclare . declareSchemaRef
202220
@@ -264,8 +282,15 @@ inlineAllSchemas = inlineSchemasWhen (const True)
264282
265283-- | Convert a type into a schema without references.
266284--
267−-- >>> encode $ toInlinedSchema (Proxy :: Proxy [Day])
268−-- "{\"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+-- }
269294--
270295-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
271296-- when inlining recursive schemas.
@@ -295,41 +320,67 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
295320 traverse_ usedNames (InsOrdHashMap.lookup name defs)
296321 Inline subschema -> usedNames subschema
297322
298−-- | Default schema for binary data (any sequence of octets).
299−binarySchema :: Schema
300−binarySchema = mempty
301− & type_ ?~ SwaggerString
302− & format ?~ "binary"
303−
304−-- | Default schema for binary data (base64 encoded).
305−byteSchema :: Schema
306−byteSchema = mempty
307− & type_ ?~ SwaggerString
308− & format ?~ "byte"
309−
310−-- | Default schema for password string.
311−-- @"password"@ format is used to hint UIs the input needs to be obscured.
312−passwordSchema :: Schema
313−passwordSchema = mempty
314− & type_ ?~ SwaggerString
315− & format ?~ "password"
316−
317323-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
318324-- Produced schema can be used for further refinement.
319325--
320−-- >>> encode $ sketchSchema "hello"
321−-- "{\"example\":\"hello\",\"type\":\"string\"}"
326+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema "hello"
327+-- {
328+-- "example": "hello",
329+-- "type": "string"
330+-- }
322331--
323−-- >>> encode $ sketchSchema (1, 2, 3)
324−-- "{\"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+-- }
325344--
326−-- >>> encode $ sketchSchema ("Jack", 25)
327−-- "{\"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+-- }
328361--
329362-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
330363-- >>> instance ToJSON Person
331−-- >>> encode $ sketchSchema (Person "Jack" 25)
332−-- "{\"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+-- }
333384sketchSchema :: ToJSON a => a -> Schema
334385sketchSchema = sketch . toJSON
335386 where
@@ -337,15 +388,15 @@ sketchSchema = sketch . toJSON
337388 sketch js@(Bool _) = go js
338389 sketch js = go js & example ?~ js
339390
340− go Null = mempty & type_ ?~ SwaggerNull
341− go (Bool _) = mempty & type_ ?~ SwaggerBoolean
342− go (String _) = mempty & type_ ?~ SwaggerString
343− 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
344395 go (Array xs) = mempty
345− & type_ ?~ SwaggerArray
396+ & type_ ?~ OpenApiArray
346397 & items ?~ case ischema of
347− Just s -> SwaggerItemsObject (Inline s)
348− _ -> SwaggerItemsArray (map Inline ys)
398+ Just s -> OpenApiItemsObject (Inline s)
399+ _ -> OpenApiItemsArray (map Inline ys)
349400 where
350401 ys = map go (V.toList xs)
351402 allSame = and ((zipWith (==)) ys (tail ys))
@@ -354,76 +405,190 @@ sketchSchema = sketch . toJSON
354405 (z:_) | allSame -> Just z
355406 _ -> Nothing
356407 go (Object o) = mempty
357− & type_ ?~ SwaggerObject
358− & required .~ HashMap.keys o
359− & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
408+ & type_ ?~ OpenApiObject
409+ & required .~ sort (objectKeys o)
410+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
360411
361412-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
362413-- Produced schema uses as much constraints as possible.
363414--
364−-- >>> encode $ sketchStrictSchema "hello"
365−-- "{\"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+-- }
366425--
367−-- >>> encode $ sketchStrictSchema (1, 2, 3)
368−-- "{\"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+-- }
369469--
370−-- >>> encode $ sketchStrictSchema ("Jack", 25)
371−-- "{\"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+-- }
372503--
373504-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
374505-- >>> instance ToJSON Person
375−-- >>> encode $ sketchStrictSchema (Person "Jack" 25)
376−-- "{\"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+-- }
377542sketchStrictSchema :: ToJSON a => a -> Schema
378543sketchStrictSchema = go . toJSON
379544 where
380− go Null = mempty & type_ ?~ SwaggerNull
545+ go Null = mempty & type_ ?~ OpenApiNull
381546 go js@(Bool _) = mempty
382− & type_ ?~ SwaggerBoolean
547+ & type_ ?~ OpenApiBoolean
383548 & enum_ ?~ [js]
384549 go js@(String s) = mempty
385− & type_ ?~ SwaggerString
550+ & type_ ?~ OpenApiString
386551 & maxLength ?~ fromIntegral (T.length s)
387552 & minLength ?~ fromIntegral (T.length s)
388553 & pattern ?~ s
389554 & enum_ ?~ [js]
390555 go js@(Number n) = mempty
391− & type_ ?~ SwaggerNumber
556+ & type_ ?~ OpenApiNumber
392557 & maximum_ ?~ n
393558 & minimum_ ?~ n
394559 & multipleOf ?~ n
395560 & enum_ ?~ [js]
396561 go js@(Array xs) = mempty
397− & type_ ?~ SwaggerArray
562+ & type_ ?~ OpenApiArray
398563 & maxItems ?~ fromIntegral sz
399564 & minItems ?~ fromIntegral sz
400− & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
565+ & items ?~ OpenApiItemsArray (map (Inline . go) (V.toList xs))
401566 & uniqueItems ?~ allUnique
402567 & enum_ ?~ [js]
403568 where
404569 sz = length xs
405570 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
406571 go js@(Object o) = mempty
407− & type_ ?~ SwaggerObject
408− & required .~ names
409− & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
572+ & type_ ?~ OpenApiObject
573+ & required .~ sort names
574+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
410575 & maxProperties ?~ fromIntegral (length names)
411576 & minProperties ?~ fromIntegral (length names)
412577 & enum_ ?~ [js]
413578 where
414− names = HashMap.keys o
579+ names = objectKeys o
415580
416581class GToSchema (f :: * -> *) where
417582 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
418583
419−instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
584+instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
420585 declareNamedSchema _ = do
421586 ref <- declareSchemaRef (Proxy :: Proxy a)
422587 return $ unnamed $ mempty
423− & type_ ?~ SwaggerArray
424− & items ?~ SwaggerItemsObject ref
588+ & type_ ?~ OpenApiArray
589+ & items ?~ OpenApiItemsObject ref
425590
426−instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
591+instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
427592instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
428593instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
429594instance ToSchema Natural where declareNamedSchema = plain . paramSchemaToSchema
@@ -446,12 +611,14 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
446611instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
447612instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
448613
449−instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
614+instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
450615
451616instance ToSchema a => ToSchema (Maybe a) where
452617 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
453618
454−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 }
455622
456623instance ToSchema () where
457624 declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
@@ -461,16 +628,22 @@ instance ToSchema UUID.UUID where
461628 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
462629 & example ?~ toJSON (UUID.toText UUID.nil)
463630
464−instance (ToSchema a, ToSchema b) => ToSchema (a, b)
465−instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
466−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
467−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e)
468−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
469−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
470643
471644timeSchema :: T.Text -> Schema
472645timeSchema fmt = mempty
473− & type_ ?~ SwaggerString
646+ & type_ ?~ OpenApiString
474647 & format ?~ fmt
475648
476649-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -485,7 +658,7 @@ instance ToSchema LocalTime where
485658 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
486659 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
487660
488−-- | 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.
489662instance ToSchema ZonedTime where
490663 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
491664 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
@@ -505,8 +678,6 @@ instance ToSchema TL.Text where declareNamedSchema = plain . paramSchemaToSchema
505678
506679instance ToSchema Version where declareNamedSchema = plain . paramSchemaToSchema
507680
508−#if __GLASGOW_HASKELL__ < 800
509−#else
510681type family ToSchemaByteStringError bs where
511682 ToSchemaByteStringError bs = TypeError
512683 ( Text "Impossible to have an instance " :<>: ShowType (ToSchema bs) :<>: Text "."
@@ -515,15 +686,13 @@ type family ToSchemaByteStringError bs where
515686
516687instance ToSchemaByteStringError BS.ByteString => ToSchema BS.ByteString where declareNamedSchema = error "impossible"
517688instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where declareNamedSchema = error "impossible"
518−#endif
519689
520690instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
521691
522692-- | NOTE: This schema does not account for the uniqueness of keys.
523−instance ToSchema a => ToSchema (IntMap a) where
693+instance (ToSchema a) => ToSchema (IntMap a) where
524694 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
525695
526−#if MIN_VERSION_aeson(1,0,0)
527696instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
528697 declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction k of
529698 ToJSONKeyText _ _ -> declareObjectMapSchema
@@ -532,33 +701,15 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
532701 declareObjectMapSchema = do
533702 schema <- declareSchemaRef (Proxy :: Proxy v)
534703 return $ unnamed $ mempty
535− & type_ ?~ SwaggerObject
704+ & type_ ?~ OpenApiObject
536705 & additionalProperties ?~ AdditionalPropertiesSchema schema
537706
538707instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
539708 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))
540709
541−#else
542−
543−instance ToSchema a => ToSchema (Map String a) where
544− declareNamedSchema _ = do
545− schema <- declareSchemaRef (Proxy :: Proxy a)
546− return $ unnamed $ mempty
547− & type_ ?~ SwaggerObject
548− & additionalProperties ?~ schema
549−
550−instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
551−instance ToSchema a => ToSchema (Map TL.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
552−
553−instance ToSchema a => ToSchema (HashMap String a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
554−instance ToSchema a => ToSchema (HashMap T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
555−instance ToSchema a => ToSchema (HashMap TL.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
556−
557−#endif
558−
559−instance OVERLAPPING_ ToSchema Object where
710+instance {-# OVERLAPPING #-} ToSchema Object where
560711 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
561− & type_ ?~ SwaggerObject
712+ & type_ ?~ OpenApiObject
562713 & description ?~ "Arbitrary JSON object."
563714 & additionalProperties ?~ AdditionalPropertiesAllowed True
564715
@@ -595,11 +746,15 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
595746
596747-- | Default schema for @'Bounded'@, @'Integral'@ types.
597748--
598−-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
599−-- "{\"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+-- }
600755toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
601756toSchemaBoundedIntegral _ = mempty
602− & type_ ?~ SwaggerInteger
757+ & type_ ?~ OpenApiInteger
603758 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
604759 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
605760
@@ -628,8 +783,27 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
628783-- >>> instance ToSchema ButtonState
629784-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
630785-- >>> type ImageUrl = T.Text
631−-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
632−-- "{\"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+-- }
633807--
634808-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
635809-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -637,15 +811,15 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.
637811 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
638812 => Proxy (map key value) -> Declare (Definitions Schema) Schema
639813declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
640− ToJSONKeyText keyToText _ -> objectSchema keyToText
814+ ToJSONKeyText getKey _ -> objectSchema getKey
641815 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
642816 where
643− objectSchema keyToText = do
817+ objectSchema getKey = do
644818 valueRef <- declareSchemaRef (Proxy :: Proxy value)
645819 let allKeys = [minBound..maxBound :: key]
646− mkPair k = (keyToText k, valueRef)
820+ mkPair k = (keyToText $ getKey k, valueRef)
647821 return $ mempty
648− & type_ ?~ SwaggerObject
822+ & type_ ?~ OpenApiObject
649823 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
650824
651825-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -656,8 +830,27 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
656830-- >>> instance ToSchema ButtonState
657831-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
658832-- >>> type ImageUrl = T.Text
659−-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
660−-- "{\"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+-- }
661854--
662855-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
663856-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -667,32 +860,32 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.
667860toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
668861
669862-- | A configurable generic @'Schema'@ creator.
670−genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>
863+genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
671864 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
672−genericDeclareSchema = genericDeclareSchemaUnrestricted
865+genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
673866
674867-- | A configurable generic @'NamedSchema'@ creator.
675868-- This function applied to @'defaultSchemaOptions'@
676869-- is used as the default for @'declareNamedSchema'@
677870-- when the type is an instance of @'Generic'@.
678−genericDeclareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
679− SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
680−genericDeclareNamedSchema = genericDeclareNamedSchemaUnrestricted
681−
682−-- | A configurable generic @'Schema'@ creator.
683871--
684−-- Unlike 'genericDeclareSchema' also works for mixed sum types.
685−-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
686−genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
687−genericDeclareSchemaUnrestricted opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchemaUnrestricted opts proxy
688−
689−-- | A configurable generic @'NamedSchema'@ creator.
872+-- Default implementation will use the name from 'Typeable' instance, including concrete
873+-- instantioations of type variables.
874+--
875+-- For example:
690876--
691−-- Unlike 'genericDeclareNamedSchema' also works for mixed sum types.
692−-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
693−genericDeclareNamedSchemaUnrestricted :: forall a. (Generic a, GToSchema (Rep a)) =>
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) =>
694880 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
695−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+
696889
697890-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
698891genericNameSchema :: forall a d f.
@@ -708,19 +901,19 @@ gdatatypeSchemaName opts _ = case orig of
708901 orig = datatypeName (Proxy3 :: Proxy3 d f a)
709902 name = datatypeNameModifier opts orig
710903
711−-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
904+-- | Construct 'NamedSchema' usinng 'ToParamSchema'.
712905paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
713906 SchemaOptions -> Proxy a -> NamedSchema
714907paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
715908
716−-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
909+-- | Construct 'Schema' usinng 'ToParamSchema'.
717910paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
718−paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
911+paramSchemaToSchema = toParamSchema
719912
720913nullarySchema :: Schema
721914nullarySchema = mempty
722− & type_ ?~ SwaggerArray
723− & items ?~ SwaggerItemsArray []
915+ & type_ ?~ OpenApiArray
916+ & items ?~ OpenApiItemsArray []
724917
725918gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
726919gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
@@ -738,10 +931,10 @@ instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
738931 where
739932 name = gdatatypeSchemaName opts (Proxy :: Proxy d)
740933
741−instance OVERLAPPABLE_ GToSchema f => GToSchema (C1 c f) where
934+instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where
742935 gdeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy f)
743936
744−instance OVERLAPPING_ Constructor c => GToSchema (C1 c U1) where
937+instance {-# OVERLAPPING #-} Constructor c => GToSchema (C1 c U1) where
745938 gdeclareNamedSchema = gdeclareNamedSumSchema
746939
747940-- | Single field constructor.
@@ -750,12 +943,15 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
750943 | unwrapUnaryRecords opts = fieldSchema
751944 | otherwise =
752945 case schema ^. items of
753− Just (SwaggerItemsArray [_]) -> fieldSchema
946+ Just (OpenApiItemsArray [_]) -> fieldSchema
754947 _ -> do
755− declare defs
756− 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')
757953 where
758− (defs, NamedSchema _ schema) = runDeclare recordSchema mempty
954+ (_, NamedSchema _ schema) = runDeclare recordSchema mempty
759955 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
760956 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
761957
@@ -778,10 +974,10 @@ gdeclareSchemaRef opts proxy = do
778974 return $ Ref (Reference name)
779975 _ -> Inline <$> gdeclareSchema opts proxy
780976
781−appendItem :: Referenced Schema -> Maybe (SwaggerItems 'SwaggerKindSchema) -> Maybe (SwaggerItems 'SwaggerKindSchema)
782−appendItem x Nothing = Just (SwaggerItemsArray [x])
783−appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
784−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"
785981
786982withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
787983 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
@@ -790,12 +986,12 @@ withFieldSchema opts _ isRequiredField schema = do
790986 return $
791987 if T.null fname
792988 then schema
793− & type_ ?~ SwaggerArray
989+ & type_ ?~ OpenApiArray
794990 & items %~ appendItem ref
795991 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
796992 & minItems %~ Just . maybe 1 (+1) -- increment minItems
797993 else schema
798− & type_ ?~ SwaggerObject
994+ & type_ ?~ OpenApiObject
799995 & properties . at fname ?~ ref
800996 & if isRequiredField
801997 then required %~ (++ [fname])
@@ -804,79 +1000,127 @@ withFieldSchema opts _ isRequiredField schema = do
8041000 fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
8051001
8061002-- | Optional record fields.
807−instance OVERLAPPING_ (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
1003+instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
8081004 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
8091005
8101006-- | Record fields.
811−instance OVERLAPPABLE_ (Selector s, GToSchema f) => GToSchema (S1 s f) where
1007+instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
8121008 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True
8131009
814−instance OVERLAPPING_ ToSchema c => GToSchema (K1 i (Maybe c)) where
1010+instance {-# OVERLAPPING #-} ToSchema c => GToSchema (K1 i (Maybe c)) where
8151011 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
8161012
817−instance OVERLAPPABLE_ ToSchema c => GToSchema (K1 i c) where
1013+instance {-# OVERLAPPABLE #-} ToSchema c => GToSchema (K1 i c) where
8181014 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
8191015
8201016instance ( GSumToSchema f
8211017 , GSumToSchema g
8221018 ) => GToSchema (f :+: g)
8231019 where
824− gdeclareNamedSchema = gdeclareNamedSumSchema
1020+ -- Aeson does not unwrap unary record in sum types.
1021+ gdeclareNamedSchema opts p s = gdeclareNamedSumSchema (opts { unwrapUnaryRecords = False } )p s
8251022
8261023gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
827−gdeclareNamedSumSchema opts proxy s
828− | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
829− | 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)
8301031 where
831− declareSumSchema = gsumToSchema opts proxy s
832− (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
1032+ declareSumSchema = gsumToSchema opts proxy
1033+ (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
8331034
834− toStringTag schema = mempty
835− & type_ ?~ SwaggerString
836− & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
1035+ toStringTag schemas = mempty
1036+ & type_ ?~ OpenApiString
1037+ & enum_ ?~ map (String . fst) sumSchemas
8371038
8381039type AllNullary = All
8391040
8401041class GSumToSchema (f :: * -> *) where
841− 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)]
8421043
8431044instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
844− 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)
8451047
1048+-- | Convert one component of the sum to schema, to be later combined with @oneOf@.
8461049gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
847− Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
848−gsumConToSchemaWith ref opts _ schema = schema
849− & type_ ?~ SwaggerObject
850− & properties . at tag ?~ ref
851− & maxProperties ?~ 1
852− & minProperties ?~ 1
1050+ Maybe (Referenced Schema) -> SchemaOptions -> Proxy (C1 c f) -> (T.Text, Referenced Schema)
1051+gsumConToSchemaWith ref opts _ = (tag, schema)
8531052 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+
8541089 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
8551093
8561094gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
857− SchemaOptions -> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
858−gsumConToSchema opts proxy schema = do
1095+ SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
1096+gsumConToSchema opts proxy = do
8591097 ref <- gdeclareSchemaRef opts proxy
860− return $ gsumConToSchemaWith ref opts proxy schema
1098+ return [gsumConToSchemaWith (Just ref) opts proxy]
8611099
862−instance OVERLAPPABLE_ (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
863− gsumToSchema opts proxy schema = do
1100+instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
1101+ gsumToSchema opts proxy = do
8641102 tell (All False)
865− lift $ gsumConToSchema opts proxy schema
1103+ lift $ gsumConToSchema opts proxy
8661104
8671105instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
868− gsumToSchema opts proxy schema = do
1106+ gsumToSchema opts proxy = do
8691107 tell (All False)
870− lift $ gsumConToSchema opts proxy schema
1108+ lift $ gsumConToSchema opts proxy
8711109
8721110instance Constructor c => GSumToSchema (C1 c U1) where
873− gsumToSchema opts proxy = pure . gsumConToSchemaWith (Inline nullarySchema) opts proxy
1111+ gsumToSchema opts proxy = pure $ (:[]) $ gsumConToSchemaWith Nothing opts proxy
8741112
8751113data Proxy2 a b = Proxy2
8761114
8771115data Proxy3 a b c = Proxy3
8781116
879−-- $setup
880−-- >>> import Data.Swagger
881−-- >>> import Data.Aeson (encode)
882−-- >>> 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+126−101
@@ -1,4 +1,5 @@
11{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE CPP #-}
23{-# LANGUAGE DataKinds #-}
34{-# LANGUAGE DeriveFunctor #-}
45{-# LANGUAGE FlexibleInstances #-}
@@ -12,31 +13,36 @@
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
25−import Prelude ()
27+import 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
45+import Data.Maybe (fromMaybe)
4046import Data.Proxy
4147import Data.Scientific (Scientific, isInteger)
4248import Data.Text (Text)
@@ -46,10 +52,12 @@ import qualified Data.Text.Lazy.Encoding as TL
4652import Data.Vector (Vector)
4753import qualified Data.Vector as Vector
4854
49−import Data.Swagger.Declare
50−import Data.Swagger.Internal
51−import Data.Swagger.Internal.Schema
52−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
5361
5462-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
5563-- This can be used with QuickCheck to ensure those instances are coherent:
@@ -101,33 +109,33 @@ validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checke
101109-- <BLANKLINE>
102110-- Swagger Schema:
103111-- {
104−-- "required": [
105−-- "name",
106−-- "phone"
107−-- ],
108−-- "type": "object",
109112-- "properties": {
110−-- "phone": {
111−-- "$ref": "#/definitions/Phone"
112−-- },
113113-- "name": {
114114-- "type": "string"
115+-- },
116+-- "phone": {
117+-- "$ref": "#/components/schemas/Phone"
115118-- }
116−-- }
119+-- },
120+-- "required": [
121+-- "name",
122+-- "phone"
123+-- ],
124+-- "type": "object"
117125-- }
118126-- <BLANKLINE>
119127-- Swagger Description Context:
120128-- {
121129-- "Phone": {
122−-- "required": [
123−-- "value"
124−-- ],
125−-- "type": "object",
126130-- "properties": {
127131-- "value": {
128132-- "type": "string"
129133-- }
130−-- }
134+-- },
135+-- "required": [
136+-- "value"
137+-- ],
138+-- "type": "object"
131139-- }
132140-- }
133141-- <BLANKLINE>
@@ -203,7 +211,7 @@ instance Monad Result where
203211
204212-- | Validation configuration.
205213data Config = Config
206− { -- | Pattern checker for @'_paramSchemaPattern'@ validation.
214+ { -- | Pattern checker for @'_schemaPattern'@ validation.
207215 configPatternChecker :: Pattern -> Text -> Bool
208216 -- | Schema definitions in scope to resolve references.
209217 , configDefinitions :: Definitions Schema
@@ -296,40 +304,34 @@ validateWithSchemaRef (Inline s) js = sub s (validateWithSchema js)
296304
297305-- | Validate JSON @'Value'@ with Swagger @'Schema'@.
298306validateWithSchema :: Value -> Validation Schema ()
299−validateWithSchema value = do
300− validateSchemaType value
301− sub_ paramSchema $ validateEnum value
302−
303−-- | Validate JSON @'Value'@ with Swagger @'ParamSchema'@.
304−validateWithParamSchema :: Value -> Validation (ParamSchema t) ()
305−validateWithParamSchema value = do
306− validateParamSchemaType value
307− validateEnum value
307+validateWithSchema val = do
308+ validateSchemaType val
309+ validateEnum val
308310
309−validateInteger :: Scientific -> Validation (ParamSchema t) ()
311+validateInteger :: Scientific -> Validation Schema ()
310312validateInteger n = do
311313 when (not (isInteger n)) $
312314 invalid ("not an integer")
313315 validateNumber n
314316
315−validateNumber :: Scientific -> Validation (ParamSchema t) ()
317+validateNumber :: Scientific -> Validation Schema ()
316318validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do
317319 let exMax = Just True == sch ^. exclusiveMaximum
318320 exMin = Just True == sch ^. exclusiveMinimum
319321
320322 check maximum_ $ \m ->
321323 when (if exMax then (n >= m) else (n > m)) $
322− 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 ++ ")")
323325
324326 check minimum_ $ \m ->
325327 when (if exMin then (n <= m) else (n < m)) $
326− 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 ++ ")")
327329
328330 check multipleOf $ \k ->
329331 when (not (isInteger (n / k))) $
330332 invalid ("expected a multiple of " ++ show k ++ " but got " ++ show n)
331333
332−validateString :: Text -> Validation (ParamSchema t) ()
334+validateString :: Text -> Validation Schema ()
333335validateString s = do
334336 check maxLength $ \n ->
335337 when (len > fromInteger n) $
@@ -346,7 +348,7 @@ validateString s = do
346348 where
347349 len = Text.length s
348350
349−validateArray :: Vector Value -> Validation (ParamSchema t) ()
351+validateArray :: Vector Value -> Validation Schema ()
350352validateArray xs = do
351353 check maxItems $ \n ->
352354 when (len > fromInteger n) $
@@ -357,9 +359,8 @@ validateArray xs = do
357359 invalid ("array is too short (size should be >=" ++ show n ++ ")")
358360
359361 check items $ \case
360− SwaggerItemsPrimitive _ itemSchema -> sub itemSchema $ traverse_ validateWithParamSchema xs
361− SwaggerItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs
362− SwaggerItemsArray itemSchemas -> do
362+ OpenApiItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs
363+ OpenApiItemsArray itemSchemas -> do
363364 when (len /= length itemSchemas) $
364365 invalid ("array size is invalid (should be exactly " ++ show (length itemSchemas) ++ ")")
365366 sequenceA_ (zipWith validateWithSchemaRef itemSchemas (Vector.toList xs))
@@ -371,11 +372,20 @@ validateArray xs = do
371372 len = Vector.length xs
372373 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))
373374
374−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 ()
375382validateObject o = withSchema $ \sch ->
376383 case sch ^. discriminator of
377− Just pname -> case fromJSON <$> HashMap.lookup pname o of
378− Just (Success ref) -> validateWithSchemaRef ref (Object o)
384+ Just (Discriminator pname types) -> case fromJSON <$> lookupKey pname o of
385+ Just (Success pvalue) ->
386+ let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types
387+ -- TODO ref may be name or reference
388+ in validateWithSchemaRef (Ref (Reference ref)) (Object o)
379389 Just (Error msg) -> invalid ("failed to parse discriminator property " ++ show pname ++ ": " ++ show msg)
380390 Nothing -> invalid ("discriminator property " ++ show pname ++ "is missing")
381391 Nothing -> do
@@ -390,15 +400,15 @@ validateObject o = withSchema $ \sch ->
390400 validateRequired
391401 validateProps
392402 where
393− size = fromIntegral (HashMap.size o)
403+ size = fromIntegral (length o)
394404
395405 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)
396406 validateReq n =
397− when (not (HashMap.member n o)) $
407+ when (not (hasKey n o)) $
398408 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))
399409
400410 validateProps = withSchema $ \sch -> do
401− for_ (HashMap.toList o) $ \(k, v) ->
411+ for_ (objectToList o) $ \(keyToText -> k, v) ->
402412 case v of
403413 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property
404414 _ ->
@@ -414,21 +424,21 @@ validateObject o = withSchema $ \sch ->
414424 unknownProperty pname = invalid $
415425 "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"
416426
417−validateEnum :: Value -> Validation (ParamSchema t) ()
418−validateEnum value = do
427+validateEnum :: Value -> Validation Schema ()
428+validateEnum val = do
419429 check enum_ $ \xs ->
420− when (value `notElem` xs) $
421− 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)
422432
423433-- | Infer schema type based on used properties.
424434--
425435-- This is like 'inferParamSchemaTypes', but also works for objects:
426436--
427437-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"
428−-- Just [SwaggerObject]
429−inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]
430−inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++
431− [ SwaggerObject | any ($ sch)
438+-- Just [OpenApiObject]
439+inferSchemaTypes :: Schema -> [OpenApiType]
440+inferSchemaTypes sch = inferParamSchemaTypes sch ++
441+ [ OpenApiObject | any ($ sch)
432442 [ has (additionalProperties._Just)
433443 , has (maxProperties._Just)
434444 , has (minProperties._Just)
@@ -438,62 +448,77 @@ inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++
438448-- | Infer schema type based on used properties.
439449--
440450-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"
441−-- Just [SwaggerString]
451+-- Just [OpenApiString]
442452--
443453-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"
444−-- Just [SwaggerArray]
454+-- Just [OpenApiArray]
445455--
446−-- From numeric properties 'SwaggerInteger' type is inferred.
447−-- 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.
448458--
449459-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"
450−-- Just [SwaggerInteger]
451−inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]
460+-- Just [OpenApiInteger]
461+inferParamSchemaTypes :: Schema -> [OpenApiType]
452462inferParamSchemaTypes sch = concat
453− [ [ SwaggerArray | any ($ sch)
463+ [ [ OpenApiArray | any ($ sch)
454464 [ has (items._Just)
455465 , has (maxItems._Just)
456466 , has (minItems._Just)
457467 , has (uniqueItems._Just) ] ]
458− , [ SwaggerInteger | any ($ sch)
468+ , [ OpenApiInteger | any ($ sch)
459469 [ has (exclusiveMaximum._Just)
460470 , has (exclusiveMinimum._Just)
461471 , has (maximum_._Just)
462472 , has (minimum_._Just)
463473 , has (multipleOf._Just) ] ]
464− , [ SwaggerString | any ($ sch)
474+ , [ OpenApiString | any ($ sch)
465475 [ has (maxLength._Just)
466476 , has (minLength._Just)
467477 , has (pattern._Just) ] ]
468478 ]
469479
470480validateSchemaType :: Value -> Validation Schema ()
471−validateSchemaType value = withSchema $ \sch ->
472− case (sch ^. type_, value) of
473− (Just SwaggerNull, Null) -> valid
474− (Just SwaggerBoolean, Bool _) -> valid
475− (Just SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)
476− (Just SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)
477− (Just SwaggerString, String s) -> sub_ paramSchema (validateString s)
478− (Just SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)
479− (Just SwaggerObject, Object o) -> validateObject o
480− (Nothing, Null) -> valid
481− (Nothing, Bool _) -> valid
482− -- Number by default
483− (Nothing, Number n) -> sub_ paramSchema (validateNumber n)
484− (Nothing, String s) -> sub_ paramSchema (validateString s)
485− (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)
486− (Nothing, Object o) -> validateObject o
487− bad -> invalid $ "expected JSON value of type " ++ showType bad
488−
489−validateParamSchemaType :: Value -> Validation (ParamSchema t) ()
490−validateParamSchemaType value = withSchema $ \sch ->
491− case (sch ^. type_, value) of
492− (Just SwaggerBoolean, Bool _) -> valid
493− (Just SwaggerInteger, Number n) -> validateInteger n
494− (Just SwaggerNumber, Number n) -> validateNumber n
495− (Just SwaggerString, String s) -> validateString s
496− (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
497522 (Nothing, Bool _) -> valid
498523 -- Number by default
499524 (Nothing, Number n) -> validateNumber n
@@ -501,11 +526,11 @@ validateParamSchemaType value = withSchema $ \sch ->
501526 (Nothing, Array xs) -> validateArray xs
502527 bad -> invalid $ "expected JSON value of type " ++ showType bad
503528
504−showType :: (Maybe (SwaggerType t), Value) -> String
505−showType (Just type_, _) = show type_
506−showType (Nothing, Null) = "SwaggerNull"
507−showType (Nothing, Bool _) = "SwaggerBoolean"
508−showType (Nothing, Number _) = "SwaggerNumber"
509−showType (Nothing, String _) = "SwaggerString"
510−showType (Nothing, Array _) = "SwaggerArray"
511−showType (Nothing, Object _) = "SwaggerObject"
529+showType :: (Maybe OpenApiType, Value) -> String
530+showType (Just ty, _) = show ty
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−11
@@ -1,12 +1,10 @@
1−{-# LANGUAGE CPP #-}
21{-# LANGUAGE ConstraintKinds #-}
32{-# LANGUAGE DataKinds #-}
4−{-# LANGUAGE KindSignatures #-}
53{-# LANGUAGE TypeFamilies #-}
64{-# LANGUAGE TypeOperators #-}
75{-# LANGUAGE UndecidableInstances #-}
86
9−module Data.Swagger.Internal.TypeShape where
7+module Data.OpenApi.Internal.TypeShape where
108
119import Data.Proxy
1210import GHC.Generics
@@ -37,11 +35,6 @@ type family TypeHasSimpleShape t (f :: Symbol) :: Constraint where
3735type family GenericHasSimpleShape t (f :: Symbol) (s :: TypeShape) :: Constraint where
3836 GenericHasSimpleShape t f Enumeration = ()
3937 GenericHasSimpleShape t f SumOfProducts = ()
40−#if __GLASGOW_HASKELL__ < 800
41− GenericHasSimpleShape t f Mixed = CannotDeriveSchemaForMixedSumType t
42−
43−class CannotDeriveSchemaForMixedSumType t where
44−#else
4538 GenericHasSimpleShape t f Mixed =
4639 TypeError
4740 ( Text "Cannot derive Generic-based Swagger Schema for " :<>: ShowType t
@@ -51,7 +44,6 @@ class CannotDeriveSchemaForMixedSumType t where
5144 :$$: Text "that matches aeson's Generic-based toJSON,"
5245 :$$: Text "but that's not supported by some Swagger tools."
5346 )
54−#endif
5547
5648-- | Infer a 'TypeShape' for a generic representation of a type.
5749type family GenericShape (g :: * -> *) :: TypeShape
@@ -62,5 +54,3 @@ type instance GenericShape (D1 d f) = GenericShape f
6254type instance GenericShape (C1 c U1) = Enumeration
6355type instance GenericShape (C1 c (S1 s f)) = SumOfProducts
6456type instance GenericShape (C1 c (f :*: g)) = SumOfProducts
65−
66−
src/Data/Swagger/Internal/Utils.hs → src/Data/OpenApi/Internal/Utils.hsrenamed+7−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)
@@ -44,6 +46,7 @@ swaggerFieldRules = defaultFieldRules & lensField %~ swaggerFieldNamer
4446 fixName' "maximum" = "maximum_" -- Prelude conflict
4547 fixName' "enum" = "enum_" -- Control.Lens conflict
4648 fixName' "head" = "head_" -- Prelude conflict
49+ fixName' "not" = "not_" -- Prelude conflict
4750 fixName' n = n
4851
4952gunfoldEnum :: String -> [a] -> (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a
@@ -131,3 +134,6 @@ instance SwaggerMonoid (Maybe a) where
131134 swaggerMempty = Nothing
132135 swaggerMappend x Nothing = x
133136 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+148−36
@@ -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,
@@ -39,11 +39,13 @@ import Data.List.Compat
3939import Data.Maybe (mapMaybe)
4040import Data.Proxy
4141import qualified Data.Set as Set
42+import Data.Text (Text)
43+import Network.HTTP.Media (MediaType)
4244
43−import Data.Swagger.Declare
44−import Data.Swagger.Internal
45−import Data.Swagger.Lens
46−import Data.Swagger.Schema
45+import Data.OpenApi.Declare
46+import Data.OpenApi.Internal
47+import Data.OpenApi.Lens
48+import Data.OpenApi.Schema
4749
4850import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
4951import qualified Data.HashSet.InsOrd as InsOrdHS
@@ -52,14 +54,18 @@ import qualified Data.HashSet.InsOrd as InsOrdHS
5254-- >>> import Data.Aeson
5355-- >>> import Data.Proxy
5456-- >>> import Data.Time
57+-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
58+-- >>> import Data.OpenApi.Internal.Utils
5559
5660-- | Prepend path piece to all operations of the spec.
5761-- Leading and trailing slashes are trimmed/added automatically.
5862--
59−-- >>> let api = (mempty :: Swagger) & paths .~ [("/info", mempty)]
60−-- >>> encode $ prependPath "user/{user_id}" api ^. paths
61−-- "{\"/user/{user_id}/info\":{}}"
62−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
6369prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
6470 where
6571 x </> y = case trim y of
@@ -69,7 +75,7 @@ prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
6975 trim = dropWhile (== '/') . dropWhileEnd (== '/')
7076
7177-- | All operations of a Swagger spec.
72−allOperations :: Traversal' Swagger Operation
78+allOperations :: Traversal' OpenApi Operation
7379allOperations = paths.traverse.template
7480
7581-- | @'operationsOf' sub@ will traverse only those operations
@@ -77,13 +83,66 @@ allOperations = paths.traverse.template
7783-- by both path and method.
7884--
7985-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
80−-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
81−-- >>> let sub = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
82−-- >>> encode api
83−-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"description\":\"OK\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
84−-- >>> encode $ api & operationsOf sub . at 404 ?~ "Not found"
85−-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"404\":{\"description\":\"Not found\"},\"200\":{\"description\":\"OK\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
86−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
87146operationsOf sub = paths.itraversed.withIndex.subops
88147 where
89148 -- | Traverse operations that correspond to paths and methods of the sub API.
@@ -105,12 +164,12 @@ operationsOf sub = paths.itraversed.withIndex.subops
105164-- @
106165-- 'applyTags' = 'applyTagsFor' 'allOperations'
107166-- @
108−applyTags :: [Tag] -> Swagger -> Swagger
167+applyTags :: [Tag] -> OpenApi -> OpenApi
109168applyTags = applyTagsFor allOperations
110169
111170-- | Apply tags to a part of Swagger spec and update the global
112171-- list of tags.
113−applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
172+applyTagsFor :: Traversal' OpenApi Operation -> [Tag] -> OpenApi -> OpenApi
114173applyTagsFor ops ts swag = swag
115174 & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))
116175 & tags %~ (<> InsOrdHS.fromList ts)
@@ -118,12 +177,32 @@ applyTagsFor ops ts swag = swag
118177-- | Construct a response with @'Schema'@ while declaring all
119178-- necessary schema definitions.
120179--
121−-- >>> encode $ runDeclare (declareResponse (Proxy :: Proxy Day)) mempty
122−-- "[{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}},{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}]"
123−declareResponse :: ToSchema a => Proxy a -> Declare (Definitions Schema) Response
124−declareResponse proxy = do
180+-- FIXME doc
181+--
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
203+declareResponse cType proxy = do
125204 s <- declareSchemaRef proxy
126− return (mempty & schema ?~ s)
205+ return (mempty & content.at cType ?~ (mempty & schema ?~ s))
127206
128207-- | Set response for all operations.
129208-- This will also update global schema definitions.
@@ -136,13 +215,46 @@ declareResponse proxy = do
136215--
137216-- Example:
138217--
139−-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
140−-- >>> let res = declareResponse (Proxy :: Proxy Day)
141−-- >>> encode $ api & setResponse 200 res
142−-- "{\"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+-- }
143255--
144256-- See also @'setResponseWith'@.
145−setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
257+setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
146258setResponse = setResponseFor allOperations
147259
148260-- | Set or update response for all operations.
@@ -156,7 +268,7 @@ setResponse = setResponseFor allOperations
156268-- @
157269--
158270-- See also @'setResponse'@.
159−setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
271+setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
160272setResponseWith = setResponseForWith allOperations
161273
162274-- | Set response for specified operations.
@@ -165,9 +277,9 @@ setResponseWith = setResponseForWith allOperations
165277-- If the response already exists it will be overwritten.
166278--
167279-- See also @'setResponseForWith'@.
168−setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
280+setResponseFor :: Traversal' OpenApi Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
169281setResponseFor ops code dres swag = swag
170− & definitions %~ (<> defs)
282+ & components.schemas %~ (<> defs)
171283 & ops . at code ?~ Inline res
172284 where
173285 (defs, res) = runDeclare dres mempty
@@ -179,14 +291,14 @@ setResponseFor ops code dres swag = swag
179291-- then just the new response is used.
180292--
181293-- See also @'setResponseFor'@.
182−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
183295setResponseForWith ops f code dres swag = swag
184− & definitions %~ (<> defs)
296+ & components.schemas %~ (<> defs)
185297 & ops . at code %~ Just . Inline . combine
186298 where
187299 (defs, new) = runDeclare dres mempty
188300
189− combine (Just (Ref (Reference n))) = case swag ^. responses.at n of
301+ combine (Just (Ref (Reference n))) = case swag ^. components.responses.at n of
190302 Just old -> f old new
191303 Nothing -> new -- response name can't be dereferenced, replacing with new response
192304 combine (Just (Inline old)) = f old new
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−20
@@ -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
@@ -13,24 +13,27 @@ import Data.Aeson
1313import Data.Aeson.Types
1414import qualified Data.HashMap.Strict.InsOrd as M
1515import Data.Maybe
16−import Data.Maybe
1716import Data.Proxy
1817import Data.Scientific
1918import qualified Data.Set as S
20−import Data.Swagger
21−import Data.Swagger.Declare
22−import Data.Swagger.Internal.Schema.Validation (inferSchemaTypes)
19+import Data.OpenApi
20+import Data.OpenApi.Declare
21+import Data.OpenApi.Internal.Schema.Validation (inferSchemaTypes)
2322import qualified Data.Text as T
2423import qualified Data.Vector as V
2524import Test.QuickCheck (arbitrary)
2625import Test.QuickCheck.Gen
2726import Test.QuickCheck.Property
2827
28+import Data.OpenApi.Aeson.Compat (fromInsOrdHashMap)
29+
2930-- | Note: 'schemaGen' may 'error', if schema type is not specified,
3031-- and cannot be inferred.
3132schemaGen :: Definitions Schema -> Schema -> Gen Value
3233schemaGen _ schema
33− | 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)
3437schemaGen defns schema =
3538 case schema ^. type_ of
3639 Nothing ->
@@ -38,25 +41,25 @@ schemaGen defns schema =
3841 [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)
3942 -- Gen is not MonadFail
4043 _ -> error "unable to infer schema type"
41− Just SwaggerBoolean -> Bool <$> elements [True, False]
42− Just SwaggerNull -> pure Null
43− Just SwaggerNumber
44+ Just OpenApiBoolean -> Bool <$> elements [True, False]
45+ Just OpenApiNull -> pure Null
46+ Just OpenApiNumber
4447 | Just min <- schema ^. minimum_
4548 , Just max <- schema ^. maximum_ ->
4649 Number . fromFloatDigits <$>
4750 choose (toRealFloat min, toRealFloat max :: Double)
4851 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)
49− Just SwaggerInteger
52+ Just OpenApiInteger
5053 | Just min <- schema ^. minimum_
5154 , Just max <- schema ^. maximum_ ->
5255 Number . fromInteger <$>
5356 choose (truncate min, truncate max)
5457 | otherwise -> Number . fromInteger <$> arbitrary
55− Just SwaggerArray
58+ Just OpenApiArray
5659 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
5760 | Just items <- schema ^. items ->
5861 case items of
59− SwaggerItemsObject ref -> do
62+ OpenApiItemsObject ref -> do
6063 size <- getSize
6164 let itemSchema = dereference defns ref
6265 minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems
@@ -64,17 +67,17 @@ schemaGen defns schema =
6467 arrayLength <- choose (minLength', max minLength' maxLength')
6568 generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema
6669 return . Array $ V.fromList generatedArray
67− SwaggerItemsArray refs ->
70+ OpenApiItemsArray refs ->
6871 let itemGens = schemaGen defns . dereference defns <$> refs
6972 in fmap (Array . V.fromList) $ sequence itemGens
70− Just SwaggerString -> do
73+ Just OpenApiString -> do
7174 size <- getSize
7275 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
7376 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
7477 length <- choose (minLength', max minLength' maxLength')
7578 str <- vectorOf length arbitrary
7679 return . String $ T.pack str
77− Just SwaggerObject -> do
80+ Just OpenApiObject -> do
7881 size <- getSize
7982 let props = dereference defns <$> schema ^. properties
8083 reqKeys = S.fromList $ schema ^. required
@@ -94,11 +97,11 @@ schemaGen defns schema =
9497 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
9598 _ -> return []
9699 x <- sequence $ gens <> additionalGens
97− return . Object $ M.toHashMap x
98− where
99− dereference :: Definitions a -> Referenced a -> a
100− dereference _ (Inline a) = a
101− 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
102105
103106genValue :: (ToSchema a) => Proxy a -> Gen Value
104107genValue 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/Internal.hsdeleted−1427
@@ -1,1427 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE DataKinds #-}
3−{-# LANGUAGE DeriveDataTypeable #-}
4−{-# LANGUAGE DeriveFunctor #-}
5−{-# LANGUAGE DeriveGeneric #-}
6−{-# LANGUAGE DeriveTraversable #-}
7−{-# LANGUAGE FlexibleContexts #-}
8−{-# LANGUAGE FlexibleInstances #-}
9−{-# LANGUAGE GADTs #-}
10−{-# LANGUAGE GeneralizedNewtypeDeriving #-}
11−{-# LANGUAGE OverloadedStrings #-}
12−{-# LANGUAGE RecordWildCards #-}
13−{-# LANGUAGE ScopedTypeVariables #-}
14−{-# LANGUAGE StandaloneDeriving #-}
15−{-# LANGUAGE TemplateHaskell #-}
16−{-# LANGUAGE TypeFamilies #-}
17−{-# LANGUAGE UndecidableInstances #-}
18−#if __GLASGOW_HASKELL__ <710
19−{-# LANGUAGE PolyKinds #-}
20−#endif
21−#include "overlapping-compat.h"
22−module Data.Swagger.Internal where
23−
24−import Prelude ()
25−import Prelude.Compat
26−
27−import Control.Lens ((&), (.~), (?~))
28−import Control.Applicative
29−import Data.Aeson
30−import qualified Data.Aeson.Types as JSON
31−import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
32−import Data.Hashable (Hashable)
33−import qualified Data.HashMap.Strict as HashMap
34−import Data.HashSet.InsOrd (InsOrdHashSet)
35−import Data.Map (Map)
36−import qualified Data.Map as Map
37−import Data.Monoid (Monoid (..))
38−import Data.Semigroup.Compat (Semigroup (..))
39−import Data.Scientific (Scientific)
40−import Data.String (IsString(..))
41−import Data.Text (Text)
42−import qualified Data.Text as Text
43−import GHC.Generics (Generic)
44−import Network.Socket (HostName, PortNumber)
45−import Network.HTTP.Media (MediaType)
46−import Text.Read (readMaybe)
47−
48−import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
49−import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
50−
51−import Generics.SOP.TH (deriveGeneric)
52−import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
53− ,sopSwaggerGenericToJSONWithOpts
54− ,sopSwaggerGenericParseJSON
55− ,HasSwaggerAesonOptions(..)
56− ,AesonDefaultValue(..)
57− ,mkSwaggerAesonOptions
58− ,saoAdditionalPairs
59− ,saoSubObject)
60−import Data.Swagger.Internal.Utils
61−
62−#if MIN_VERSION_aeson(0,10,0)
63−import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
64−#define DEFINE_TOENCODING toEncoding = sopSwaggerGenericToEncoding
65−#else
66−#define DEFINE_TOENCODING
67−#endif
68−
69−-- $setup
70−-- >>> :seti -XDataKinds
71−-- >>> import Data.Aeson
72−
73−-- | A list of definitions that can be used in references.
74−type Definitions = InsOrdHashMap Text
75−
76−-- | This is the root document object for the API specification.
77−data Swagger = Swagger
78− { -- | Provides metadata about the API.
79− -- The metadata can be used by the clients if needed.
80− _swaggerInfo :: Info
81−
82− -- | The host (name or ip) serving the API. It MAY include a port.
83− -- If the host is not included, the host serving the documentation is to be used (including the port).
84− , _swaggerHost :: Maybe Host
85−
86− -- | The base path on which the API is served, which is relative to the host.
87− -- If it is not included, the API is served directly under the host.
88− -- The value MUST start with a leading slash (/).
89− , _swaggerBasePath :: Maybe FilePath
90−
91− -- | The transfer protocol of the API.
92− -- If the schemes is not included, the default scheme to be used is the one used to access the Swagger definition itself.
93− , _swaggerSchemes :: Maybe [Scheme]
94−
95− -- | A list of MIME types the APIs can consume.
96− -- This is global to all APIs but can be overridden on specific API calls.
97− , _swaggerConsumes :: MimeList
98−
99− -- | A list of MIME types the APIs can produce.
100− -- This is global to all APIs but can be overridden on specific API calls.
101− , _swaggerProduces :: MimeList
102−
103− -- | The available paths and operations for the API.
104− -- Holds the relative paths to the individual endpoints.
105− -- The path is appended to the @'basePath'@ in order to construct the full URL.
106− , _swaggerPaths :: InsOrdHashMap FilePath PathItem
107−
108− -- | An object to hold data types produced and consumed by operations.
109− , _swaggerDefinitions :: Definitions Schema
110−
111− -- | An object to hold parameters that can be used across operations.
112− -- This property does not define global parameters for all operations.
113− , _swaggerParameters :: Definitions Param
114−
115− -- | An object to hold responses that can be used across operations.
116− -- This property does not define global responses for all operations.
117− , _swaggerResponses :: Definitions Response
118−
119− -- | Security scheme definitions that can be used across the specification.
120− , _swaggerSecurityDefinitions :: SecurityDefinitions
121−
122− -- | A declaration of which security schemes are applied for the API as a whole.
123− -- The list of values describes alternative security schemes that can be used
124− -- (that is, there is a logical OR between the security requirements).
125− -- Individual operations can override this definition.
126− , _swaggerSecurity :: [SecurityRequirement]
127−
128− -- | A list of tags used by the specification with additional metadata.
129− -- The order of the tags can be used to reflect on their order by the parsing tools.
130− -- Not all tags that are used by the Operation Object must be declared.
131− -- The tags that are not declared may be organized randomly or based on the tools' logic.
132− -- Each tag name in the list MUST be unique.
133− , _swaggerTags :: InsOrdHashSet Tag
134−
135− -- | Additional external documentation.
136− , _swaggerExternalDocs :: Maybe ExternalDocs
137− } deriving (Eq, Show, Generic, Data, Typeable)
138−
139−-- | The object provides metadata about the API.
140−-- The metadata can be used by the clients if needed,
141−-- and can be presented in the Swagger-UI for convenience.
142−data Info = Info
143− { -- | The title of the application.
144− _infoTitle :: Text
145−
146− -- | A short description of the application.
147− -- GFM syntax can be used for rich text representation.
148− , _infoDescription :: Maybe Text
149−
150− -- | The Terms of Service for the API.
151− , _infoTermsOfService :: Maybe Text
152−
153− -- | The contact information for the exposed API.
154− , _infoContact :: Maybe Contact
155−
156− -- | The license information for the exposed API.
157− , _infoLicense :: Maybe License
158−
159− -- | Provides the version of the application API
160− -- (not to be confused with the specification version).
161− , _infoVersion :: Text
162− } deriving (Eq, Show, Generic, Data, Typeable)
163−
164−-- | Contact information for the exposed API.
165−data Contact = Contact
166− { -- | The identifying name of the contact person/organization.
167− _contactName :: Maybe Text
168−
169− -- | The URL pointing to the contact information.
170− , _contactUrl :: Maybe URL
171−
172− -- | The email address of the contact person/organization.
173− , _contactEmail :: Maybe Text
174− } deriving (Eq, Show, Generic, Data, Typeable)
175−
176−-- | License information for the exposed API.
177−data License = License
178− { -- | The license name used for the API.
179− _licenseName :: Text
180−
181− -- | A URL to the license used for the API.
182− , _licenseUrl :: Maybe URL
183− } deriving (Eq, Show, Generic, Data, Typeable)
184−
185−instance IsString License where
186− fromString s = License (fromString s) Nothing
187−
188−-- | The host (name or ip) serving the API. It MAY include a port.
189−data Host = Host
190− { _hostName :: HostName -- ^ Host name.
191− , _hostPort :: Maybe PortNumber -- ^ Optional port.
192− } deriving (Eq, Show, Generic, Typeable)
193−
194−instance IsString Host where
195− fromString s = Host s Nothing
196−
197−hostConstr :: Constr
198−hostConstr = mkConstr hostDataType "Host" [] Prefix
199−
200−hostDataType :: DataType
201−hostDataType = mkDataType "Data.Swagger.Host" [hostConstr]
202−
203−instance Data Host where
204− gunfold k z c = case constrIndex c of
205− 1 -> k (k (z (\name mport -> Host name (fromInteger <$> mport))))
206− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Host."
207− toConstr (Host _ _) = hostConstr
208− dataTypeOf _ = hostDataType
209−
210−-- | The transfer protocol of the API.
211−data Scheme
212− = Http
213− | Https
214− | Ws
215− | Wss
216− deriving (Eq, Show, Generic, Data, Typeable)
217−
218−-- | Describes the operations available on a single path.
219−-- A @'PathItem'@ may be empty, due to ACL constraints.
220−-- The path itself is still exposed to the documentation viewer
221−-- but they will not know which operations and parameters are available.
222−data PathItem = PathItem
223− { -- | A definition of a GET operation on this path.
224− _pathItemGet :: Maybe Operation
225−
226− -- | A definition of a PUT operation on this path.
227− , _pathItemPut :: Maybe Operation
228−
229− -- | A definition of a POST operation on this path.
230− , _pathItemPost :: Maybe Operation
231−
232− -- | A definition of a DELETE operation on this path.
233− , _pathItemDelete :: Maybe Operation
234−
235− -- | A definition of a OPTIONS operation on this path.
236− , _pathItemOptions :: Maybe Operation
237−
238− -- | A definition of a HEAD operation on this path.
239− , _pathItemHead :: Maybe Operation
240−
241− -- | A definition of a PATCH operation on this path.
242− , _pathItemPatch :: Maybe Operation
243−
244− -- | A list of parameters that are applicable for all the operations described under this path.
245− -- These parameters can be overridden at the operation level, but cannot be removed there.
246− -- The list MUST NOT include duplicated parameters.
247− -- A unique parameter is defined by a combination of a name and location.
248− , _pathItemParameters :: [Referenced Param]
249− } deriving (Eq, Show, Generic, Data, Typeable)
250−
251−-- | Describes a single API operation on a path.
252−data Operation = Operation
253− { -- | A list of tags for API documentation control.
254− -- Tags can be used for logical grouping of operations by resources or any other qualifier.
255− _operationTags :: InsOrdHashSet TagName
256−
257− -- | A short summary of what the operation does.
258− -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
259− , _operationSummary :: Maybe Text
260−
261− -- | A verbose explanation of the operation behavior.
262− -- GFM syntax can be used for rich text representation.
263− , _operationDescription :: Maybe Text
264−
265− -- | Additional external documentation for this operation.
266− , _operationExternalDocs :: Maybe ExternalDocs
267−
268− -- | Unique string used to identify the operation.
269− -- The id MUST be unique among all operations described in the API.
270− -- Tools and libraries MAY use the it to uniquely identify an operation,
271− -- therefore, it is recommended to follow common programming naming conventions.
272− , _operationOperationId :: Maybe Text
273−
274− -- | A list of MIME types the operation can consume.
275− -- This overrides the @'consumes'@.
276− -- @Just []@ MAY be used to clear the global definition.
277− , _operationConsumes :: Maybe MimeList
278−
279− -- | A list of MIME types the operation can produce.
280− -- This overrides the @'produces'@.
281− -- @Just []@ MAY be used to clear the global definition.
282− , _operationProduces :: Maybe MimeList
283−
284− -- | A list of parameters that are applicable for this operation.
285− -- If a parameter is already defined at the @'PathItem'@,
286− -- the new definition will override it, but can never remove it.
287− -- The list MUST NOT include duplicated parameters.
288− -- A unique parameter is defined by a combination of a name and location.
289− , _operationParameters :: [Referenced Param]
290−
291− -- | The list of possible responses as they are returned from executing this operation.
292− , _operationResponses :: Responses
293−
294− -- | The transfer protocol for the operation.
295− -- The value overrides @'schemes'@.
296− , _operationSchemes :: Maybe [Scheme]
297−
298− -- | Declares this operation to be deprecated.
299− -- Usage of the declared operation should be refrained.
300− -- Default value is @False@.
301− , _operationDeprecated :: Maybe Bool
302−
303− -- | A declaration of which security schemes are applied for this operation.
304− -- The list of values describes alternative security schemes that can be used
305− -- (that is, there is a logical OR between the security requirements).
306− -- This definition overrides any declared top-level security.
307− -- To remove a top-level security declaration, @Just []@ can be used.
308− , _operationSecurity :: [SecurityRequirement]
309− } deriving (Eq, Show, Generic, Data, Typeable)
310−
311−newtype MimeList = MimeList { getMimeList :: [MediaType] }
312− deriving (Eq, Show, Semigroup, Monoid, Typeable)
313−
314−mimeListConstr :: Constr
315−mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
316−
317−mimeListDataType :: DataType
318−mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
319−
320−instance Data MimeList where
321− gunfold k z c = case constrIndex c of
322− 1 -> k (z (\xs -> MimeList (map fromString xs)))
323− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
324− toConstr (MimeList _) = mimeListConstr
325− dataTypeOf _ = mimeListDataType
326−
327−-- | Describes a single operation parameter.
328−-- A unique parameter is defined by a combination of a name and location.
329−data Param = Param
330− { -- | The name of the parameter.
331− -- Parameter names are case sensitive.
332− _paramName :: Text
333−
334− -- | A brief description of the parameter.
335− -- This could contain examples of use.
336− -- GFM syntax can be used for rich text representation.
337− , _paramDescription :: Maybe Text
338−
339− -- | Determines whether this parameter is mandatory.
340− -- If the parameter is in "path", this property is required and its value MUST be true.
341− -- Otherwise, the property MAY be included and its default value is @False@.
342− , _paramRequired :: Maybe Bool
343−
344− -- | Parameter schema.
345− , _paramSchema :: ParamAnySchema
346− } deriving (Eq, Show, Generic, Data, Typeable)
347−
348−data ParamAnySchema
349− = ParamBody (Referenced Schema)
350− | ParamOther ParamOtherSchema
351− deriving (Eq, Show, Generic, Data, Typeable)
352−
353−data ParamOtherSchema = ParamOtherSchema
354− { -- | The location of the parameter.
355− _paramOtherSchemaIn :: ParamLocation
356−
357− -- | Sets the ability to pass empty-valued parameters.
358− -- This is valid only for either @'ParamQuery'@ or @'ParamFormData'@
359− -- and allows you to send a parameter with a name only or an empty value.
360− -- Default value is @False@.
361− , _paramOtherSchemaAllowEmptyValue :: Maybe Bool
362−
363− , _paramOtherSchemaParamSchema :: ParamSchema 'SwaggerKindParamOtherSchema
364− } deriving (Eq, Show, Generic, Typeable, Data)
365−
366−-- | Items for @'SwaggerArray'@ schemas.
367−--
368−-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.
369−-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.
370−-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.
371−-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.
372−--
373−-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
374−--
375−-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
376−data SwaggerItems t where
377− SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
378− SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
379− SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
380− deriving (Typeable)
381−
382−deriving instance Eq (SwaggerItems t)
383−deriving instance Show (SwaggerItems t)
384−--deriving instance Typeable (SwaggerItems t)
385−
386−swaggerItemsPrimitiveConstr :: Constr
387−swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
388−
389−swaggerItemsObjectConstr :: Constr
390−swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
391−
392−swaggerItemsArrayConstr :: Constr
393−swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
394−
395−swaggerItemsDataType :: DataType
396−swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
397−
398−-- Note: unfortunately we have to write these Data instances by hand,
399−-- to get better contexts / avoid duplicate name when using standalone deriving
400−
401−instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
402− -- TODO: define gfoldl
403− gunfold k z c = case constrIndex c of
404− 1 -> k (k (z SwaggerItemsPrimitive))
405− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
406− toConstr _ = swaggerItemsPrimitiveConstr
407− dataTypeOf _ = swaggerItemsDataType
408−
409−-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
410−instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
411− -- TODO: define gfoldl
412− gunfold k z c = case constrIndex c of
413− 1 -> k (k (z SwaggerItemsPrimitive))
414− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindParamOtherSchema)."
415− toConstr _ = swaggerItemsPrimitiveConstr
416− dataTypeOf _ = swaggerItemsDataType
417−
418−instance Data (SwaggerItems 'SwaggerKindSchema) where
419− gfoldl _ _ (SwaggerItemsPrimitive _ _) = error $ " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"
420− gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref
421− gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref
422−
423− gunfold k z c = case constrIndex c of
424− 2 -> k (z SwaggerItemsObject)
425− 3 -> k (z SwaggerItemsArray)
426− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindSchema)."
427−
428− toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
429− toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
430− toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
431−
432− dataTypeOf _ = swaggerItemsDataType
433−
434−-- | Type used as a kind to avoid overlapping instances.
435−data SwaggerKind t
436− = SwaggerKindNormal t
437− | SwaggerKindParamOtherSchema
438− | SwaggerKindSchema
439− deriving (Typeable)
440−
441−deriving instance Typeable 'SwaggerKindNormal
442−deriving instance Typeable 'SwaggerKindParamOtherSchema
443−deriving instance Typeable 'SwaggerKindSchema
444−
445−type family SwaggerKindType (k :: SwaggerKind *) :: *
446−type instance SwaggerKindType ('SwaggerKindNormal t) = t
447−type instance SwaggerKindType 'SwaggerKindSchema = Schema
448−type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema
449−
450−data SwaggerType t where
451− SwaggerString :: SwaggerType t
452− SwaggerNumber :: SwaggerType t
453− SwaggerInteger :: SwaggerType t
454− SwaggerBoolean :: SwaggerType t
455− SwaggerArray :: SwaggerType t
456− SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
457− SwaggerNull :: SwaggerType 'SwaggerKindSchema
458− SwaggerObject :: SwaggerType 'SwaggerKindSchema
459− deriving (Typeable)
460−
461−deriving instance Eq (SwaggerType t)
462−deriving instance Show (SwaggerType t)
463−
464−swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
465−swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
466−
467−swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
468−swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
469−
470−swaggerCommonTypes :: [SwaggerType k]
471−swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
472−
473−swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
474−swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
475−
476−swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
477−swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
478−
479−swaggerTypeConstrs :: [Constr]
480−swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
481− ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
482−
483−instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
484− gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
485− toConstr = swaggerTypeConstr
486− dataTypeOf = swaggerTypeDataType
487−
488−instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
489− gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
490− toConstr = swaggerTypeConstr
491− dataTypeOf = swaggerTypeDataType
492−
493−instance Data (SwaggerType 'SwaggerKindSchema) where
494− gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
495− toConstr = swaggerTypeConstr
496− dataTypeOf = swaggerTypeDataType
497−
498−data ParamLocation
499− = -- | Parameters that are appended to the URL.
500− -- For example, in @/items?id=###@, the query parameter is @id@.
501− ParamQuery
502− -- | Custom headers that are expected as part of the request.
503− | ParamHeader
504− -- | Used together with Path Templating, where the parameter value is actually part of the operation's URL.
505− -- This does not include the host or base path of the API.
506− -- For example, in @/items/{itemId}@, the path parameter is @itemId@.
507− | ParamPath
508− -- | Used to describe the payload of an HTTP request when either @application/x-www-form-urlencoded@
509− -- or @multipart/form-data@ are used as the content type of the request
510− -- (in Swagger's definition, the @consumes@ property of an operation).
511− -- This is the only parameter type that can be used to send files, thus supporting the @'ParamFile'@ type.
512− -- Since form parameters are sent in the payload, they cannot be declared together with a body parameter for the same operation.
513− -- Form parameters have a different format based on the content-type used
514− -- (for further details, consult <http://www.w3.org/TR/html401/interact/forms.html#h-17.13.4>).
515− | ParamFormData
516− deriving (Eq, Show, Generic, Data, Typeable)
517−
518−type Format = Text
519−
520−-- | Determines the format of the array.
521−data CollectionFormat t where
522− -- Comma separated values: @foo,bar@.
523− CollectionCSV :: CollectionFormat t
524− -- Space separated values: @foo bar@.
525− CollectionSSV :: CollectionFormat t
526− -- Tab separated values: @foo\\tbar@.
527− CollectionTSV :: CollectionFormat t
528− -- Pipe separated values: @foo|bar@.
529− CollectionPipes :: CollectionFormat t
530− -- Corresponds to multiple parameter instances
531− -- instead of multiple values for a single instance @foo=bar&foo=baz@.
532− -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
533− CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
534− deriving (Typeable)
535−
536−deriving instance Eq (CollectionFormat t)
537−deriving instance Show (CollectionFormat t)
538−
539−collectionFormatConstr :: CollectionFormat t -> Constr
540−collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
541−
542−collectionFormatDataType :: DataType
543−collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
544− map collectionFormatConstr collectionCommonFormats
545−
546−collectionCommonFormats :: [CollectionFormat t]
547−collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
548−
549−instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
550− gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
551− toConstr = collectionFormatConstr
552− dataTypeOf _ = collectionFormatDataType
553−
554−deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
555−
556−type ParamName = Text
557−
558−data Schema = Schema
559− { _schemaTitle :: Maybe Text
560− , _schemaDescription :: Maybe Text
561− , _schemaRequired :: [ParamName]
562−
563− , _schemaAllOf :: Maybe [Referenced Schema]
564− , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)
565− , _schemaAdditionalProperties :: Maybe AdditionalProperties
566−
567− , _schemaDiscriminator :: Maybe Text
568− , _schemaReadOnly :: Maybe Bool
569− , _schemaXml :: Maybe Xml
570− , _schemaExternalDocs :: Maybe ExternalDocs
571− , _schemaExample :: Maybe Value
572−
573− , _schemaMaxProperties :: Maybe Integer
574− , _schemaMinProperties :: Maybe Integer
575−
576− , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
577− } deriving (Eq, Show, Generic, Data, Typeable)
578−
579−-- | A @'Schema'@ with an optional name.
580−-- This name can be used in references.
581−data NamedSchema = NamedSchema
582− { _namedSchemaName :: Maybe Text
583− , _namedSchemaSchema :: Schema
584− } deriving (Eq, Show, Generic, Data, Typeable)
585−
586−-- | Regex pattern for @string@ type.
587−type Pattern = Text
588−
589−data ParamSchema (t :: SwaggerKind *) = ParamSchema
590− { -- | Declares the value of the parameter that the server will use if none is provided,
591− -- for example a @"count"@ to control the number of results per page might default to @100@
592− -- if not supplied by the client in the request.
593− -- (Note: "default" has no meaning for required parameters.)
594− -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
595− _paramSchemaDefault :: Maybe Value
596−
597− , _paramSchemaType :: Maybe (SwaggerType t)
598− , _paramSchemaFormat :: Maybe Format
599− , _paramSchemaItems :: Maybe (SwaggerItems t)
600− , _paramSchemaMaximum :: Maybe Scientific
601− , _paramSchemaExclusiveMaximum :: Maybe Bool
602− , _paramSchemaMinimum :: Maybe Scientific
603− , _paramSchemaExclusiveMinimum :: Maybe Bool
604− , _paramSchemaMaxLength :: Maybe Integer
605− , _paramSchemaMinLength :: Maybe Integer
606− , _paramSchemaPattern :: Maybe Pattern
607− , _paramSchemaMaxItems :: Maybe Integer
608− , _paramSchemaMinItems :: Maybe Integer
609− , _paramSchemaUniqueItems :: Maybe Bool
610− , _paramSchemaEnum :: Maybe [Value]
611− , _paramSchemaMultipleOf :: Maybe Scientific
612− } deriving (Eq, Show, Generic, Typeable)
613−
614−deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
615−
616−data Xml = Xml
617− { -- | Replaces the name of the element/attribute used for the described schema property.
618− -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.
619− -- When defined alongside type being array (outside the items),
620− -- it will affect the wrapping element and only if wrapped is true.
621− -- If wrapped is false, it will be ignored.
622− _xmlName :: Maybe Text
623−
624− -- | The URL of the namespace definition.
625− -- Value SHOULD be in the form of a URL.
626− , _xmlNamespace :: Maybe Text
627−
628− -- | The prefix to be used for the name.
629− , _xmlPrefix :: Maybe Text
630−
631− -- | Declares whether the property definition translates to an attribute instead of an element.
632− -- Default value is @False@.
633− , _xmlAttribute :: Maybe Bool
634−
635− -- | MAY be used only for an array definition.
636− -- Signifies whether the array is wrapped
637− -- (for example, @\<books\>\<book/\>\<book/\>\</books\>@)
638− -- or unwrapped (@\<book/\>\<book/\>@).
639− -- Default value is @False@.
640− -- The definition takes effect only when defined alongside type being array (outside the items).
641− , _xmlWrapped :: Maybe Bool
642− } deriving (Eq, Show, Generic, Data, Typeable)
643−
644−-- | A container for the expected responses of an operation.
645−-- The container maps a HTTP response code to the expected response.
646−-- It is not expected from the documentation to necessarily cover all possible HTTP response codes,
647−-- since they may not be known in advance.
648−-- However, it is expected from the documentation to cover a successful operation response and any known errors.
649−data Responses = Responses
650− { -- | The documentation of responses other than the ones declared for specific HTTP response codes.
651− -- It can be used to cover undeclared responses.
652− _responsesDefault :: Maybe (Referenced Response)
653−
654− -- | Any HTTP status code can be used as the property name (one property per HTTP status code).
655− -- Describes the expected response for those HTTP status codes.
656− , _responsesResponses :: InsOrdHashMap HttpStatusCode (Referenced Response)
657− } deriving (Eq, Show, Generic, Data, Typeable)
658−
659−type HttpStatusCode = Int
660−
661−-- | Describes a single response from an API Operation.
662−data Response = Response
663− { -- | A short description of the response.
664− -- GFM syntax can be used for rich text representation.
665− _responseDescription :: Text
666−
667− -- | A definition of the response structure.
668− -- It can be a primitive, an array or an object.
669− -- If this field does not exist, it means no content is returned as part of the response.
670− -- As an extension to the Schema Object, its root type value may also be "file".
671− -- This SHOULD be accompanied by a relevant produces mime-type.
672− , _responseSchema :: Maybe (Referenced Schema)
673−
674− -- | A list of headers that are sent with the response.
675− , _responseHeaders :: InsOrdHashMap HeaderName Header
676−
677− -- | An example of the response message.
678− , _responseExamples :: Maybe Example
679− } deriving (Eq, Show, Generic, Data, Typeable)
680−
681−instance IsString Response where
682− fromString s = Response (fromString s) Nothing mempty Nothing
683−
684−type HeaderName = Text
685−
686−data Header = Header
687− { -- | A short description of the header.
688− _headerDescription :: Maybe Text
689−
690− , _headerParamSchema :: ParamSchema ('SwaggerKindNormal Header)
691− } deriving (Eq, Show, Generic, Data, Typeable)
692−
693−data Example = Example { getExample :: Map MediaType Value }
694− deriving (Eq, Show, Generic, Typeable)
695−
696−exampleConstr :: Constr
697−exampleConstr = mkConstr exampleDataType "Example" ["getExample"] Prefix
698−
699−exampleDataType :: DataType
700−exampleDataType = mkDataType "Data.Swagger.Example" [exampleConstr]
701−
702−instance Data Example where
703− gunfold k z c = case constrIndex c of
704− 1 -> k (z (\m -> Example (Map.mapKeys fromString m)))
705− _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type Example."
706− toConstr (Example _) = exampleConstr
707− dataTypeOf _ = exampleDataType
708−
709−-- | The location of the API key.
710−data ApiKeyLocation
711− = ApiKeyQuery
712− | ApiKeyHeader
713− deriving (Eq, Show, Generic, Data, Typeable)
714−
715−data ApiKeyParams = ApiKeyParams
716− { -- | The name of the header or query parameter to be used.
717− _apiKeyName :: Text
718−
719− -- | The location of the API key.
720− , _apiKeyIn :: ApiKeyLocation
721− } deriving (Eq, Show, Generic, Data, Typeable)
722−
723−-- | The authorization URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
724−type AuthorizationURL = Text
725−
726−-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
727−type TokenURL = Text
728−
729−data OAuth2Flow
730− = OAuth2Implicit AuthorizationURL
731− | OAuth2Password TokenURL
732− | OAuth2Application TokenURL
733− | OAuth2AccessCode AuthorizationURL TokenURL
734− deriving (Eq, Show, Generic, Data, Typeable)
735−
736−data OAuth2Params = OAuth2Params
737− { -- | The flow used by the OAuth2 security scheme.
738− _oauth2Flow :: OAuth2Flow
739−
740− -- | The available scopes for the OAuth2 security scheme.
741− , _oauth2Scopes :: InsOrdHashMap Text Text
742− } deriving (Eq, Show, Generic, Data, Typeable)
743−
744−data SecuritySchemeType
745− = SecuritySchemeBasic
746− | SecuritySchemeApiKey ApiKeyParams
747− | SecuritySchemeOAuth2 OAuth2Params
748− deriving (Eq, Show, Generic, Data, Typeable)
749−
750−data SecurityScheme = SecurityScheme
751− { -- | The type of the security scheme.
752− _securitySchemeType :: SecuritySchemeType
753−
754− -- | A short description for security scheme.
755− , _securitySchemeDescription :: Maybe Text
756− } deriving (Eq, Show, Generic, Data, Typeable)
757−
758−
759−-- | merge scopes of two OAuth2 security schemes when their flows are identical.
760−-- In other case returns first security scheme
761−mergeSecurityScheme :: SecurityScheme -> SecurityScheme -> SecurityScheme
762−mergeSecurityScheme s1@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 scopes1)) desc)
763− s2@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow2 scopes2)) _)
764− = if flow1 == flow2 then
765− SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 (scopes1 <> scopes2))) desc
766− else
767− s1
768−mergeSecurityScheme s1 _ = s1
769−
770−newtype SecurityDefinitions
771− = SecurityDefinitions (Definitions SecurityScheme)
772− deriving (Eq, Show, Generic, Data, Typeable)
773−
774−-- | Lists the required security schemes to execute this operation.
775−-- The object can have multiple security schemes declared in it which are all required
776−-- (that is, there is a logical AND between the schemes).
777−newtype SecurityRequirement = SecurityRequirement
778− { getSecurityRequirement :: InsOrdHashMap Text [Text]
779− } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
780−
781−-- | Tag name.
782−type TagName = Text
783−
784−-- | Allows adding meta data to a single tag that is used by @Operation@.
785−-- It is not mandatory to have a @Tag@ per tag used there.
786−data Tag = Tag
787− { -- | The name of the tag.
788− _tagName :: TagName
789−
790− -- | A short description for the tag.
791− -- GFM syntax can be used for rich text representation.
792− , _tagDescription :: Maybe Text
793−
794− -- | Additional external documentation for this tag.
795− , _tagExternalDocs :: Maybe ExternalDocs
796− } deriving (Eq, Ord, Show, Generic, Data, Typeable)
797−
798−instance Hashable Tag
799−
800−instance IsString Tag where
801− fromString s = Tag (fromString s) Nothing Nothing
802−
803−-- | Allows referencing an external resource for extended documentation.
804−data ExternalDocs = ExternalDocs
805− { -- | A short description of the target documentation.
806− -- GFM syntax can be used for rich text representation.
807− _externalDocsDescription :: Maybe Text
808−
809− -- | The URL for the target documentation.
810− , _externalDocsUrl :: URL
811− } deriving (Eq, Ord, Show, Generic, Data, Typeable)
812−
813−instance Hashable ExternalDocs
814−
815−-- | A simple object to allow referencing other definitions in the specification.
816−-- It can be used to reference parameters and responses that are defined at the top level for reuse.
817−newtype Reference = Reference { getReference :: Text }
818− deriving (Eq, Show, Data, Typeable)
819−
820−data Referenced a
821− = Ref Reference
822− | Inline a
823− deriving (Eq, Show, Functor, Data, Typeable)
824−
825−instance IsString a => IsString (Referenced a) where
826− fromString = Inline . fromString
827−
828−newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
829−
830−data AdditionalProperties
831− = AdditionalPropertiesAllowed Bool
832− | AdditionalPropertiesSchema (Referenced Schema)
833− deriving (Eq, Show, Data, Typeable)
834−
835−-- =======================================================================
836−-- Monoid instances
837−-- =======================================================================
838−
839−instance Semigroup Swagger where
840− (<>) = genericMappend
841−instance Monoid Swagger where
842− mempty = genericMempty
843− mappend = (<>)
844−
845−instance Semigroup Info where
846− (<>) = genericMappend
847−instance Monoid Info where
848− mempty = genericMempty
849− mappend = (<>)
850−
851−instance Semigroup Contact where
852− (<>) = genericMappend
853−instance Monoid Contact where
854− mempty = genericMempty
855− mappend = (<>)
856−
857−instance Semigroup PathItem where
858− (<>) = genericMappend
859−instance Monoid PathItem where
860− mempty = genericMempty
861− mappend = (<>)
862−
863−instance Semigroup Schema where
864− (<>) = genericMappend
865−instance Monoid Schema where
866− mempty = genericMempty
867− mappend = (<>)
868−
869−instance Semigroup (ParamSchema t) where
870− (<>) = genericMappend
871−instance Monoid (ParamSchema t) where
872− mempty = genericMempty
873− mappend = (<>)
874−
875−instance Semigroup Param where
876− (<>) = genericMappend
877−instance Monoid Param where
878− mempty = genericMempty
879− mappend = (<>)
880−
881−instance Semigroup ParamOtherSchema where
882− (<>) = genericMappend
883−instance Monoid ParamOtherSchema where
884− mempty = genericMempty
885− mappend = (<>)
886−
887−instance Semigroup Header where
888− (<>) = genericMappend
889−instance Monoid Header where
890− mempty = genericMempty
891− mappend = (<>)
892−
893−instance Semigroup Responses where
894− (<>) = genericMappend
895−instance Monoid Responses where
896− mempty = genericMempty
897− mappend = (<>)
898−
899−instance Semigroup Response where
900− (<>) = genericMappend
901−instance Monoid Response where
902− mempty = genericMempty
903− mappend = (<>)
904−
905−instance Semigroup ExternalDocs where
906− (<>) = genericMappend
907−instance Monoid ExternalDocs where
908− mempty = genericMempty
909− mappend = (<>)
910−
911−instance Semigroup Operation where
912− (<>) = genericMappend
913−instance Monoid Operation where
914− mempty = genericMempty
915− mappend = (<>)
916−
917−instance Semigroup Example where
918− (<>) = genericMappend
919−instance Monoid Example where
920− mempty = genericMempty
921− mappend = (<>)
922−
923−instance Semigroup SecurityScheme where
924− (<>) = mergeSecurityScheme
925−
926−instance Semigroup SecurityDefinitions where
927− (SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =
928− SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2
929−
930−instance Monoid SecurityDefinitions where
931− mempty = SecurityDefinitions $ InsOrdHashMap.empty
932− mappend = (<>)
933−
934−-- =======================================================================
935−-- SwaggerMonoid helper instances
936−-- =======================================================================
937−
938−instance SwaggerMonoid Info
939−instance SwaggerMonoid PathItem
940−instance SwaggerMonoid Schema
941−instance SwaggerMonoid (ParamSchema t)
942−instance SwaggerMonoid Param
943−instance SwaggerMonoid ParamOtherSchema
944−instance SwaggerMonoid Responses
945−instance SwaggerMonoid Response
946−instance SwaggerMonoid ExternalDocs
947−instance SwaggerMonoid Operation
948−instance SwaggerMonoid SecurityDefinitions
949−instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
950−
951−instance SwaggerMonoid MimeList
952−deriving instance SwaggerMonoid URL
953−
954−instance SwaggerMonoid (SwaggerType t) where
955− swaggerMempty = SwaggerString
956− swaggerMappend _ y = y
957−
958−instance SwaggerMonoid ParamLocation where
959− swaggerMempty = ParamQuery
960− swaggerMappend _ y = y
961−
962−instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
963− swaggerMempty = InsOrdHashMap.empty
964− swaggerMappend = InsOrdHashMap.unionWith mappend
965−
966−instance Monoid a => SwaggerMonoid (Referenced a) where
967− swaggerMempty = Inline mempty
968− swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
969− swaggerMappend _ y = y
970−
971−instance SwaggerMonoid ParamAnySchema where
972− swaggerMempty = ParamOther swaggerMempty
973− swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
974− swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
975− swaggerMappend _ y = y
976−
977−-- =======================================================================
978−-- Simple Generic-based ToJSON instances
979−-- =======================================================================
980−
981−instance ToJSON ParamLocation where
982− toJSON = genericToJSON (jsonPrefix "Param")
983−
984−instance ToJSON Info where
985− toJSON = genericToJSON (jsonPrefix "Info")
986−
987−instance ToJSON Contact where
988− toJSON = genericToJSON (jsonPrefix "Contact")
989−
990−instance ToJSON License where
991− toJSON = genericToJSON (jsonPrefix "License")
992−
993−instance ToJSON ApiKeyLocation where
994− toJSON = genericToJSON (jsonPrefix "ApiKey")
995−
996−instance ToJSON ApiKeyParams where
997− toJSON = genericToJSON (jsonPrefix "apiKey")
998−
999−instance ToJSON Scheme where
1000− toJSON = genericToJSON (jsonPrefix "")
1001−
1002−instance ToJSON Tag where
1003− toJSON = genericToJSON (jsonPrefix "Tag")
1004−
1005−instance ToJSON ExternalDocs where
1006− toJSON = genericToJSON (jsonPrefix "ExternalDocs")
1007−
1008−instance ToJSON Xml where
1009− toJSON = genericToJSON (jsonPrefix "Xml")
1010−
1011−-- =======================================================================
1012−-- Simple Generic-based FromJSON instances
1013−-- =======================================================================
1014−
1015−instance FromJSON ParamLocation where
1016− parseJSON = genericParseJSON (jsonPrefix "Param")
1017−
1018−instance FromJSON Info where
1019− parseJSON = genericParseJSON (jsonPrefix "Info")
1020−
1021−instance FromJSON Contact where
1022− parseJSON = genericParseJSON (jsonPrefix "Contact")
1023−
1024−instance FromJSON License where
1025− parseJSON = genericParseJSON (jsonPrefix "License")
1026−
1027−instance FromJSON ApiKeyLocation where
1028− parseJSON = genericParseJSON (jsonPrefix "ApiKey")
1029−
1030−instance FromJSON ApiKeyParams where
1031− parseJSON = genericParseJSON (jsonPrefix "apiKey")
1032−
1033−instance FromJSON Scheme where
1034− parseJSON = genericParseJSON (jsonPrefix "")
1035−
1036−instance FromJSON Tag where
1037− parseJSON = genericParseJSON (jsonPrefix "Tag")
1038−
1039−instance FromJSON ExternalDocs where
1040− parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
1041−
1042−-- =======================================================================
1043−-- Manual ToJSON instances
1044−-- =======================================================================
1045−
1046−instance ToJSON OAuth2Flow where
1047− toJSON (OAuth2Implicit authUrl) = object
1048− [ "flow" .= ("implicit" :: Text)
1049− , "authorizationUrl" .= authUrl ]
1050− toJSON (OAuth2Password tokenUrl) = object
1051− [ "flow" .= ("password" :: Text)
1052− , "tokenUrl" .= tokenUrl ]
1053− toJSON (OAuth2Application tokenUrl) = object
1054− [ "flow" .= ("application" :: Text)
1055− , "tokenUrl" .= tokenUrl ]
1056− toJSON (OAuth2AccessCode authUrl tokenUrl) = object
1057− [ "flow" .= ("accessCode" :: Text)
1058− , "authorizationUrl" .= authUrl
1059− , "tokenUrl" .= tokenUrl ]
1060−
1061−instance ToJSON OAuth2Params where
1062− toJSON = sopSwaggerGenericToJSON
1063− DEFINE_TOENCODING
1064−
1065−instance ToJSON SecuritySchemeType where
1066− toJSON SecuritySchemeBasic
1067− = object [ "type" .= ("basic" :: Text) ]
1068− toJSON (SecuritySchemeApiKey params)
1069− = toJSON params
1070− <+> object [ "type" .= ("apiKey" :: Text) ]
1071− toJSON (SecuritySchemeOAuth2 params)
1072− = toJSON params
1073− <+> object [ "type" .= ("oauth2" :: Text) ]
1074−
1075−instance ToJSON Swagger where
1076− toJSON = sopSwaggerGenericToJSON
1077− DEFINE_TOENCODING
1078−
1079−instance ToJSON SecurityScheme where
1080− toJSON = sopSwaggerGenericToJSON
1081− DEFINE_TOENCODING
1082−
1083−instance ToJSON Schema where
1084− toJSON = sopSwaggerGenericToJSON
1085− DEFINE_TOENCODING
1086−
1087−instance ToJSON Header where
1088− toJSON = sopSwaggerGenericToJSON
1089− DEFINE_TOENCODING
1090−
1091−-- | As for nullary schema for 0-arity type constructors, see
1092−-- <https://github.com/GetShopTV/swagger2/issues/167>.
1093−--
1094−-- >>> encode (SwaggerItemsArray [])
1095−-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1096−--
1097−instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
1098− toJSON (SwaggerItemsPrimitive fmt schema) = object
1099− [ "collectionFormat" .= fmt
1100− , "items" .= schema ]
1101− toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1102− toJSON (SwaggerItemsArray []) = object
1103− [ "items" .= object []
1104− , "maxItems" .= (0 :: Int)
1105− , "example" .= Array mempty
1106− ]
1107− toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1108−
1109−instance ToJSON Host where
1110− toJSON (Host host mport) = toJSON $
1111− case mport of
1112− Nothing -> host
1113− Just port -> host ++ ":" ++ show port
1114−
1115−instance ToJSON MimeList where
1116− toJSON (MimeList xs) = toJSON (map show xs)
1117−
1118−instance ToJSON Param where
1119− toJSON = sopSwaggerGenericToJSON
1120− DEFINE_TOENCODING
1121−
1122−instance ToJSON ParamAnySchema where
1123− toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1124− toJSON (ParamOther s) = toJSON s
1125−
1126−instance ToJSON ParamOtherSchema where
1127− toJSON = sopSwaggerGenericToJSON
1128− DEFINE_TOENCODING
1129−
1130−instance ToJSON Responses where
1131− toJSON = sopSwaggerGenericToJSON
1132− DEFINE_TOENCODING
1133−
1134−instance ToJSON Response where
1135− toJSON = sopSwaggerGenericToJSON
1136− DEFINE_TOENCODING
1137−
1138−instance ToJSON Operation where
1139− toJSON = sopSwaggerGenericToJSON
1140− DEFINE_TOENCODING
1141−
1142−instance ToJSON PathItem where
1143− toJSON = sopSwaggerGenericToJSON
1144− DEFINE_TOENCODING
1145−
1146−instance ToJSON Example where
1147− toJSON = toJSON . Map.mapKeys show . getExample
1148−
1149−instance ToJSON SecurityDefinitions where
1150− toJSON (SecurityDefinitions sd) = toJSON sd
1151−
1152−instance ToJSON Reference where
1153− toJSON (Reference ref) = object [ "$ref" .= ref ]
1154−
1155−referencedToJSON :: ToJSON a => Text -> Referenced a -> Value
1156−referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ]
1157−referencedToJSON _ (Inline x) = toJSON x
1158−
1159−instance ToJSON (Referenced Schema) where toJSON = referencedToJSON "#/definitions/"
1160−instance ToJSON (Referenced Param) where toJSON = referencedToJSON "#/parameters/"
1161−instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/responses/"
1162−
1163−instance ToJSON (SwaggerType t) where
1164− toJSON SwaggerArray = "array"
1165− toJSON SwaggerString = "string"
1166− toJSON SwaggerInteger = "integer"
1167− toJSON SwaggerNumber = "number"
1168− toJSON SwaggerBoolean = "boolean"
1169− toJSON SwaggerFile = "file"
1170− toJSON SwaggerNull = "null"
1171− toJSON SwaggerObject = "object"
1172−
1173−instance ToJSON (CollectionFormat t) where
1174− toJSON CollectionCSV = "csv"
1175− toJSON CollectionSSV = "ssv"
1176− toJSON CollectionTSV = "tsv"
1177− toJSON CollectionPipes = "pipes"
1178− toJSON CollectionMulti = "multi"
1179−
1180−instance ToJSON (ParamSchema k) where
1181− -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1182− toJSON = sopSwaggerGenericToJSONWithOpts $
1183− mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1184−
1185−instance ToJSON AdditionalProperties where
1186− toJSON (AdditionalPropertiesAllowed b) = toJSON b
1187− toJSON (AdditionalPropertiesSchema s) = toJSON s
1188−
1189−-- =======================================================================
1190−-- Manual FromJSON instances
1191−-- =======================================================================
1192−
1193−instance FromJSON OAuth2Flow where
1194− parseJSON (Object o) = do
1195− (flow :: Text) <- o .: "flow"
1196− case flow of
1197− "implicit" -> OAuth2Implicit <$> o .: "authorizationUrl"
1198− "password" -> OAuth2Password <$> o .: "tokenUrl"
1199− "application" -> OAuth2Application <$> o .: "tokenUrl"
1200− "accessCode" -> OAuth2AccessCode
1201− <$> o .: "authorizationUrl"
1202− <*> o .: "tokenUrl"
1203− _ -> empty
1204− parseJSON _ = empty
1205−
1206−instance FromJSON OAuth2Params where
1207− parseJSON = sopSwaggerGenericParseJSON
1208−
1209−instance FromJSON SecuritySchemeType where
1210− parseJSON js@(Object o) = do
1211− (t :: Text) <- o .: "type"
1212− case t of
1213− "basic" -> pure SecuritySchemeBasic
1214− "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1215− "oauth2" -> SecuritySchemeOAuth2 <$> parseJSON js
1216− _ -> empty
1217− parseJSON _ = empty
1218−
1219−instance FromJSON Swagger where
1220− parseJSON = sopSwaggerGenericParseJSON
1221−
1222−instance FromJSON SecurityScheme where
1223− parseJSON = sopSwaggerGenericParseJSON
1224−
1225−instance FromJSON Schema where
1226− parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1227− where nullaryCleanup :: Schema -> Schema
1228− nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1229− if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1230− then s { _schemaExample = Nothing
1231− , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1232− else s
1233−
1234−instance FromJSON Header where
1235− parseJSON = sopSwaggerGenericParseJSON
1236−
1237−instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1238− parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1239− <$> o .:? "collectionFormat"
1240− <*> (o .: "items" >>= parseJSON)
1241−
1242−instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1243− parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1244− <$> o .:? "collectionFormat"
1245− <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1246−
1247−-- |
1248−--
1249−-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1250−-- Just (SwaggerItemsArray [])
1251−--
1252−-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1253−-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1254−--
1255−-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1256−-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1257−--
1258−instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1259− parseJSON js@(Object obj)
1260− | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1261− | otherwise = SwaggerItemsObject <$> parseJSON js
1262− parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1263− parseJSON _ = empty
1264−
1265−instance FromJSON Host where
1266− parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
1267− [host] -> return $ Host host Nothing
1268− [host, port] -> case readMaybe port of
1269− Nothing -> fail $ "Invalid port `" ++ port ++ "'"
1270− Just p -> return $ Host host (Just (fromInteger p))
1271− _ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
1272− parseJSON _ = empty
1273−
1274−instance FromJSON MimeList where
1275− parseJSON js = (MimeList . map fromString) <$> parseJSON js
1276−
1277−instance FromJSON Param where
1278− parseJSON = sopSwaggerGenericParseJSON
1279−
1280−instance FromJSON ParamAnySchema where
1281− parseJSON js@(Object o) = do
1282− (i :: Text) <- o .: "in"
1283− case i of
1284− "body" -> do
1285− schema <- o .: "schema"
1286− ParamBody <$> parseJSON schema
1287− _ -> ParamOther <$> parseJSON js
1288− parseJSON _ = empty
1289−
1290−instance FromJSON ParamOtherSchema where
1291− parseJSON = sopSwaggerGenericParseJSON
1292−
1293−instance FromJSON Responses where
1294− parseJSON (Object o) = Responses
1295− <$> o .:? "default"
1296− <*> (parseJSON (Object (HashMap.delete "default" o)))
1297− parseJSON _ = empty
1298−
1299−instance FromJSON Example where
1300− parseJSON js = do
1301− m <- parseJSON js
1302− pure $ Example (Map.mapKeys fromString m)
1303−
1304−instance FromJSON Response where
1305− parseJSON = sopSwaggerGenericParseJSON
1306−
1307−instance FromJSON Operation where
1308− parseJSON = sopSwaggerGenericParseJSON
1309−
1310−instance FromJSON PathItem where
1311− parseJSON = sopSwaggerGenericParseJSON
1312−
1313−instance FromJSON SecurityDefinitions where
1314− parseJSON js = SecurityDefinitions <$> parseJSON js
1315−
1316−instance FromJSON Reference where
1317− parseJSON (Object o) = Reference <$> o .: "$ref"
1318− parseJSON _ = empty
1319−
1320−referencedParseJSON :: FromJSON a => Text -> Value -> JSON.Parser (Referenced a)
1321−referencedParseJSON prefix js@(Object o) = do
1322− ms <- o .:? "$ref"
1323− case ms of
1324− Nothing -> Inline <$> parseJSON js
1325− Just s -> Ref <$> parseRef s
1326− where
1327− parseRef s = do
1328− case Text.stripPrefix prefix s of
1329− Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1330− Just suffix -> pure (Reference suffix)
1331−referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
1332−
1333−instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1334−instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
1335−instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#/responses/"
1336−
1337−instance FromJSON Xml where
1338− parseJSON = genericParseJSON (jsonPrefix "xml")
1339−
1340−instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1341− parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1342−
1343−instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1344− parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1345−
1346−instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1347− parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1348−
1349−instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1350− parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1351−
1352−-- NOTE: There aren't collections of 'Schema'
1353−--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1354−-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1355−
1356−instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1357− parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1358−
1359−instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1360− parseJSON = sopSwaggerGenericParseJSON
1361−instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1362− parseJSON = sopSwaggerGenericParseJSON
1363−instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1364− parseJSON = sopSwaggerGenericParseJSON
1365−
1366−instance FromJSON AdditionalProperties where
1367− parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1368− parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1369−
1370−-------------------------------------------------------------------------------
1371−-- TH splices
1372−-------------------------------------------------------------------------------
1373−
1374−deriveGeneric ''Header
1375−deriveGeneric ''OAuth2Params
1376−deriveGeneric ''Operation
1377−deriveGeneric ''Param
1378−deriveGeneric ''ParamOtherSchema
1379−deriveGeneric ''PathItem
1380−deriveGeneric ''Response
1381−deriveGeneric ''Responses
1382−deriveGeneric ''SecurityScheme
1383−deriveGeneric ''Schema
1384−deriveGeneric ''ParamSchema
1385−deriveGeneric ''Swagger
1386−
1387−instance HasSwaggerAesonOptions Header where
1388− swaggerAesonOptions _ = mkSwaggerAesonOptions "header" & saoSubObject ?~ "paramSchema"
1389−instance HasSwaggerAesonOptions OAuth2Params where
1390− swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "flow"
1391−instance HasSwaggerAesonOptions Operation where
1392− swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
1393−instance HasSwaggerAesonOptions Param where
1394− swaggerAesonOptions _ = mkSwaggerAesonOptions "param" & saoSubObject ?~ "schema"
1395−instance HasSwaggerAesonOptions ParamOtherSchema where
1396− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramOtherSchema" & saoSubObject ?~ "paramSchema"
1397−instance HasSwaggerAesonOptions PathItem where
1398− swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
1399−instance HasSwaggerAesonOptions Response where
1400− swaggerAesonOptions _ = mkSwaggerAesonOptions "response"
1401−instance HasSwaggerAesonOptions Responses where
1402− swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject ?~ "responses"
1403−instance HasSwaggerAesonOptions SecurityScheme where
1404− swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1405−instance HasSwaggerAesonOptions Schema where
1406− swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1407−instance HasSwaggerAesonOptions Swagger where
1408− swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("swagger", "2.0")]
1409−
1410−instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
1411− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1412−instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
1413− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1414−-- NOTE: Schema doesn't have 'items' sub object!
1415−instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
1416− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
1417−
1418−instance AesonDefaultValue (ParamSchema s)
1419−instance AesonDefaultValue OAuth2Flow
1420−instance AesonDefaultValue Responses
1421−instance AesonDefaultValue ParamAnySchema
1422−instance AesonDefaultValue SecuritySchemeType
1423−instance AesonDefaultValue (SwaggerType a)
1424−instance AesonDefaultValue MimeList where defaultValue = Just mempty
1425−instance AesonDefaultValue Info
1426−instance AesonDefaultValue ParamLocation
1427−instance AesonDefaultValue SecurityDefinitions where defaultValue = Just $ SecurityDefinitions mempty
src/Data/Swagger/Lens.hsdeleted−186
@@ -1,186 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−{-# LANGUAGE FlexibleContexts #-}
3−{-# LANGUAGE FlexibleInstances #-}
4−{-# LANGUAGE FunctionalDependencies #-}
5−{-# LANGUAGE GADTs #-}
6−{-# LANGUAGE MultiParamTypeClasses #-}
7−{-# LANGUAGE RankNTypes #-}
8−{-# LANGUAGE TemplateHaskell #-}
9−{-# LANGUAGE TypeFamilies #-}
10−{-# LANGUAGE DataKinds #-}
11−{-# LANGUAGE UndecidableInstances #-}
12−{-# OPTIONS_GHC -fno-warn-orphans #-}
13−#include "overlapping-compat.h"
14−-- |
15−-- Module: Data.Swagger.Lens
16−-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
17−-- Stability: experimental
18−--
19−-- Lenses and prisms for Swagger.
20−module Data.Swagger.Lens where
21−
22−import Control.Lens
23−import Data.Aeson (Value)
24−import Data.Scientific (Scientific)
25−import Data.Swagger.Internal
26−import Data.Swagger.Internal.Utils
27−import Data.Text (Text)
28−
29−-- * Classy lenses
30−
31−makeFields ''Swagger
32−makeFields ''Host
33−makeFields ''Info
34−makeFields ''Contact
35−makeFields ''License
36−makeLensesWith swaggerFieldRules ''PathItem
37−makeFields ''Tag
38−makeFields ''Operation
39−makeFields ''Param
40−makeLensesWith swaggerFieldRules ''ParamOtherSchema
41−makeFields ''Header
42−makeFields ''Schema
43−makeFields ''NamedSchema
44−makeLensesWith swaggerFieldRules ''ParamSchema
45−makeFields ''Xml
46−makeLensesWith swaggerFieldRules ''Responses
47−makeFields ''Response
48−makeLensesWith swaggerFieldRules ''SecurityScheme
49−makeFields ''ApiKeyParams
50−makeFields ''OAuth2Params
51−makeFields ''ExternalDocs
52−
53−-- * Prisms
54−-- ** 'ParamAnySchema' prisms
55−makePrisms ''ParamAnySchema
56−-- ** 'SecuritySchemeType' prisms
57−makePrisms ''SecuritySchemeType
58−-- ** 'Referenced' prisms
59−makePrisms ''Referenced
60−
61−-- ** 'SwaggerItems' prisms
62−
63−_SwaggerItemsArray :: Review (SwaggerItems 'SwaggerKindSchema) [Referenced Schema]
64−_SwaggerItemsArray
65− = unto (\x -> SwaggerItemsArray x)
66−{- \x -> case x of
67− SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)
68− SwaggerItemsObject o -> Left (SwaggerItemsObject o)
69− SwaggerItemsArray a -> Right a
70−-}
71−
72−_SwaggerItemsObject :: Review (SwaggerItems 'SwaggerKindSchema) (Referenced Schema)
73−_SwaggerItemsObject
74− = unto (\x -> SwaggerItemsObject x)
75−{- \x -> case x of
76− SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)
77− SwaggerItemsObject o -> Right o
78− SwaggerItemsArray a -> Left (SwaggerItemsArray a)
79−-}
80−
81−_SwaggerItemsPrimitive :: forall t p f. (Profunctor p, Bifunctor p, Functor f) => Optic' p f (SwaggerItems t) (Maybe (CollectionFormat t), ParamSchema t)
82−_SwaggerItemsPrimitive = unto (\(c, p) -> SwaggerItemsPrimitive c p)
83−
84−-- =============================================================
85−-- More helpful instances for easier access to schema properties
86−
87−type instance Index Responses = HttpStatusCode
88−type instance Index Operation = HttpStatusCode
89−
90−type instance IxValue Responses = Referenced Response
91−type instance IxValue Operation = Referenced Response
92−
93−instance Ixed Responses where ix n = responses . ix n
94−instance At Responses where at n = responses . at n
95−
96−instance Ixed Operation where ix n = responses . ix n
97−instance At Operation where at n = responses . at n
98−
99−type instance Index SecurityDefinitions = Text
100−type instance IxValue SecurityDefinitions = SecurityScheme
101−
102−instance Ixed SecurityDefinitions where ix n = (coerced :: Lens' SecurityDefinitions (Definitions SecurityScheme)). ix n
103−instance At SecurityDefinitions where at n = (coerced :: Lens' SecurityDefinitions (Definitions SecurityScheme)). at n
104−
105−instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema
106−
107−-- HasType instances
108−instance HasType Header (Maybe (SwaggerType ('SwaggerKindNormal Header))) where type_ = paramSchema.type_
109−instance HasType Schema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_
110−instance HasType NamedSchema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_
111−instance HasType ParamOtherSchema (Maybe (SwaggerType 'SwaggerKindParamOtherSchema)) where type_ = paramSchema.type_
112−
113−-- HasDefault instances
114−instance HasDefault Header (Maybe Value) where default_ = paramSchema.default_
115−instance HasDefault Schema (Maybe Value) where default_ = paramSchema.default_
116−instance HasDefault ParamOtherSchema (Maybe Value) where default_ = paramSchema.default_
117−
118−-- OVERLAPPABLE instances
119−
120−instance
121−#if __GLASGOW_HASKELL__ >= 710
122− OVERLAPPABLE_
123−#endif
124− HasParamSchema s (ParamSchema t)
125− => HasFormat s (Maybe Format) where
126− format = paramSchema.format
127−
128−instance
129−#if __GLASGOW_HASKELL__ >= 710
130− OVERLAPPABLE_
131−#endif
132− HasParamSchema s (ParamSchema t)
133− => HasItems s (Maybe (SwaggerItems t)) where
134− items = paramSchema.items
135−
136−instance
137−#if __GLASGOW_HASKELL__ >= 710
138− OVERLAPPABLE_
139−#endif
140− HasParamSchema s (ParamSchema t)
141− => HasMaximum s (Maybe Scientific) where
142− maximum_ = paramSchema.maximum_
143−
144−instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
145− => HasExclusiveMaximum s (Maybe Bool) where
146− exclusiveMaximum = paramSchema.exclusiveMaximum
147−
148−instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
149− => HasMinimum s (Maybe Scientific) where
150− minimum_ = paramSchema.minimum_
151−
152−instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
153− => HasExclusiveMinimum s (Maybe Bool) where
154− exclusiveMinimum = paramSchema.exclusiveMinimum
155−
156−instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
157− => HasMaxLength s (Maybe Integer) where
158− maxLength = paramSchema.maxLength
159−
160−instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
161− => HasMinLength s (Maybe Integer) where
162− minLength = paramSchema.minLength
163−
164−instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
165− => HasPattern s (Maybe Text) where
166− pattern = paramSchema.pattern
167−
168−instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
169− => HasMaxItems s (Maybe Integer) where
170− maxItems = paramSchema.maxItems
171−
172−instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
173− => HasMinItems s (Maybe Integer) where
174− minItems = paramSchema.minItems
175−
176−instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
177− => HasUniqueItems s (Maybe Bool) where
178− uniqueItems = paramSchema.uniqueItems
179−
180−instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
181− => HasEnum s (Maybe [Value]) where
182− enum_ = paramSchema.enum_
183−
184−instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
185− => HasMultipleOf s (Maybe Scientific) where
186− multipleOf = paramSchema.multipleOf
src/Data/Swagger/Optics.hsdeleted−597
@@ -1,597 +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 ''Host
79−makeFieldLabels ''Info
80−makeFieldLabels ''Contact
81−makeFieldLabels ''License
82−makeFieldLabels ''PathItem
83−makeFieldLabels ''Tag
84−makeFieldLabels ''Operation
85−makeFieldLabels ''Param
86−makeFieldLabels ''ParamOtherSchema
87−makeFieldLabels ''Header
88−makeFieldLabels ''Schema
89−makeFieldLabels ''NamedSchema
90−makeFieldLabels ''ParamSchema
91−makeFieldLabels ''Xml
92−makeFieldLabels ''Responses
93−makeFieldLabels ''Response
94−makeFieldLabels ''SecurityScheme
95−makeFieldLabels ''ApiKeyParams
96−makeFieldLabels ''OAuth2Params
97−makeFieldLabels ''ExternalDocs
98−
99−-- Prisms
100−
101−makePrismLabels ''ParamAnySchema
102−makePrismLabels ''SecuritySchemeType
103−makePrismLabels ''Referenced
104−
105−-- SwaggerItems prisms
106−
107−instance
108− ( a ~ [Referenced Schema]
109− , b ~ [Referenced Schema]
110− ) => LabelOptic "_SwaggerItemsArray"
111− A_Review
112− (SwaggerItems 'SwaggerKindSchema)
113− (SwaggerItems 'SwaggerKindSchema)
114− a
115− b where
116− labelOptic = unto (\x -> SwaggerItemsArray x)
117− {-# INLINE labelOptic #-}
118−
119−instance
120− ( a ~ Referenced Schema
121− , b ~ Referenced Schema
122− ) => LabelOptic "_SwaggerItemsObject"
123− A_Review
124− (SwaggerItems 'SwaggerKindSchema)
125− (SwaggerItems 'SwaggerKindSchema)
126− a
127− b where
128− labelOptic = unto (\x -> SwaggerItemsObject x)
129− {-# INLINE labelOptic #-}
130−
131−instance
132− ( a ~ (Maybe (CollectionFormat t), ParamSchema t)
133− , b ~ (Maybe (CollectionFormat t), ParamSchema t)
134− ) => LabelOptic "_SwaggerItemsPrimitive"
135− A_Review
136− (SwaggerItems t)
137− (SwaggerItems t)
138− a
139− b where
140− labelOptic = unto (\(c, p) -> SwaggerItemsPrimitive c p)
141− {-# INLINE labelOptic #-}
142−
143−-- =============================================================
144−-- More helpful instances for easier access to schema properties
145−
146−type instance Index Responses = HttpStatusCode
147−type instance Index Operation = HttpStatusCode
148−
149−type instance IxValue Responses = Referenced Response
150−type instance IxValue Operation = Referenced Response
151−
152−instance Ixed Responses where
153− ix n = #responses % ix n
154− {-# INLINE ix #-}
155−instance At Responses where
156− at n = #responses % at n
157− {-# INLINE at #-}
158−
159−instance Ixed Operation where
160− ix n = #responses % ix n
161− {-# INLINE ix #-}
162−instance At Operation where
163− at n = #responses % at n
164− {-# INLINE at #-}
165−
166−-- #paramSchema
167−
168−instance
169− ( a ~ ParamSchema 'SwaggerKindSchema
170− , b ~ ParamSchema 'SwaggerKindSchema
171− ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where
172− labelOptic = #schema % #paramSchema
173− {-# INLINE labelOptic #-}
174−
175−-- #type
176−
177−instance
178− ( a ~ Maybe (SwaggerType ('SwaggerKindNormal Header))
179− , b ~ Maybe (SwaggerType ('SwaggerKindNormal Header))
180− ) => LabelOptic "type" A_Lens Header Header a b where
181− labelOptic = #paramSchema % #type
182− {-# INLINE labelOptic #-}
183−
184−instance
185− ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)
186− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)
187− ) => LabelOptic "type" A_Lens Schema Schema a b where
188− labelOptic = #paramSchema % #type
189− {-# INLINE labelOptic #-}
190−
191−instance
192− ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)
193− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)
194− ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where
195− labelOptic = #paramSchema % #type
196− {-# INLINE labelOptic #-}
197−
198−instance
199− ( a ~ Maybe (SwaggerType 'SwaggerKindParamOtherSchema)
200− , b ~ Maybe (SwaggerType 'SwaggerKindParamOtherSchema)
201− ) => LabelOptic "type" A_Lens ParamOtherSchema ParamOtherSchema a b where
202− labelOptic = #paramSchema % #type
203− {-# INLINE labelOptic #-}
204−
205−-- #default
206−
207−instance
208− ( a ~ Maybe Value, b ~ Maybe Value
209− ) => LabelOptic "default" A_Lens Header Header a b where
210− labelOptic = #paramSchema % #default
211− {-# INLINE labelOptic #-}
212−
213−instance
214− ( a ~ Maybe Value, b ~ Maybe Value
215− ) => LabelOptic "default" A_Lens Schema Schema a b where
216− labelOptic = #paramSchema % #default
217− {-# INLINE labelOptic #-}
218−
219−instance
220− ( a ~ Maybe Value, b ~ Maybe Value
221− ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where
222− labelOptic = #paramSchema % #default
223− {-# INLINE labelOptic #-}
224−
225−instance
226− ( a ~ Maybe Value, b ~ Maybe Value
227− ) => LabelOptic "default" A_Lens ParamOtherSchema ParamOtherSchema a b where
228− labelOptic = #paramSchema % #default
229− {-# INLINE labelOptic #-}
230−
231−-- #format
232−
233−instance
234− ( a ~ Maybe Format, b ~ Maybe Format
235− ) => LabelOptic "format" A_Lens Header Header a b where
236− labelOptic = #paramSchema % #format
237− {-# INLINE labelOptic #-}
238−
239−instance
240− ( a ~ Maybe Format, b ~ Maybe Format
241− ) => LabelOptic "format" A_Lens Schema Schema a b where
242− labelOptic = #paramSchema % #format
243− {-# INLINE labelOptic #-}
244−
245−instance
246− ( a ~ Maybe Format, b ~ Maybe Format
247− ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where
248− labelOptic = #paramSchema % #format
249− {-# INLINE labelOptic #-}
250−
251−instance
252− ( a ~ Maybe Format, b ~ Maybe Format
253− ) => LabelOptic "format" A_Lens ParamOtherSchema ParamOtherSchema a b where
254− labelOptic = #paramSchema % #format
255− {-# INLINE labelOptic #-}
256−
257−-- #items
258−
259−instance
260− ( a ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))
261− , b ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))
262− ) => LabelOptic "items" A_Lens Header Header a b where
263− labelOptic = #paramSchema % #items
264− {-# INLINE labelOptic #-}
265−
266−instance
267− ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)
268− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)
269− ) => LabelOptic "items" A_Lens Schema Schema a b where
270− labelOptic = #paramSchema % #items
271− {-# INLINE labelOptic #-}
272−
273−instance
274− ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)
275− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)
276− ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where
277− labelOptic = #paramSchema % #items
278− {-# INLINE labelOptic #-}
279−
280−instance
281− ( a ~ Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)
282− , b ~ Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)
283− ) => LabelOptic "items" A_Lens ParamOtherSchema ParamOtherSchema a b where
284− labelOptic = #paramSchema % #items
285− {-# INLINE labelOptic #-}
286−
287−-- #maximum
288−
289−instance
290− ( a ~ Maybe Scientific, b ~ Maybe Scientific
291− ) => LabelOptic "maximum" A_Lens Header Header a b where
292− labelOptic = #paramSchema % #maximum
293− {-# INLINE labelOptic #-}
294−
295−instance
296− ( a ~ Maybe Scientific, b ~ Maybe Scientific
297− ) => LabelOptic "maximum" A_Lens Schema Schema a b where
298− labelOptic = #paramSchema % #maximum
299− {-# INLINE labelOptic #-}
300−
301−instance
302− ( a ~ Maybe Scientific, b ~ Maybe Scientific
303− ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where
304− labelOptic = #paramSchema % #maximum
305− {-# INLINE labelOptic #-}
306−
307−instance
308− ( a ~ Maybe Scientific, b ~ Maybe Scientific
309− ) => LabelOptic "maximum" A_Lens ParamOtherSchema ParamOtherSchema a b where
310− labelOptic = #paramSchema % #maximum
311− {-# INLINE labelOptic #-}
312−
313−-- #exclusiveMaximum
314−
315−instance
316− ( a ~ Maybe Bool, b ~ Maybe Bool
317− ) => LabelOptic "exclusiveMaximum" A_Lens Header Header a b where
318− labelOptic = #paramSchema % #exclusiveMaximum
319− {-# INLINE labelOptic #-}
320−
321−instance
322− ( a ~ Maybe Bool, b ~ Maybe Bool
323− ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where
324− labelOptic = #paramSchema % #exclusiveMaximum
325− {-# INLINE labelOptic #-}
326−
327−instance
328− ( a ~ Maybe Bool, b ~ Maybe Bool
329− ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where
330− labelOptic = #paramSchema % #exclusiveMaximum
331− {-# INLINE labelOptic #-}
332−
333−instance
334− ( a ~ Maybe Bool, b ~ Maybe Bool
335− ) => LabelOptic "exclusiveMaximum" A_Lens ParamOtherSchema ParamOtherSchema a b where
336− labelOptic = #paramSchema % #exclusiveMaximum
337− {-# INLINE labelOptic #-}
338−
339−-- #minimum
340−
341−instance
342− ( a ~ Maybe Scientific, b ~ Maybe Scientific
343− ) => LabelOptic "minimum" A_Lens Header Header a b where
344− labelOptic = #paramSchema % #minimum
345− {-# INLINE labelOptic #-}
346−
347−instance
348− ( a ~ Maybe Scientific, b ~ Maybe Scientific
349− ) => LabelOptic "minimum" A_Lens Schema Schema a b where
350− labelOptic = #paramSchema % #minimum
351− {-# INLINE labelOptic #-}
352−
353−instance
354− ( a ~ Maybe Scientific, b ~ Maybe Scientific
355− ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where
356− labelOptic = #paramSchema % #minimum
357− {-# INLINE labelOptic #-}
358−
359−instance
360− ( a ~ Maybe Scientific, b ~ Maybe Scientific
361− ) => LabelOptic "minimum" A_Lens ParamOtherSchema ParamOtherSchema a b where
362− labelOptic = #paramSchema % #minimum
363− {-# INLINE labelOptic #-}
364−
365−-- #exclusiveMinimum
366−
367−instance
368− ( a ~ Maybe Bool, b ~ Maybe Bool
369− ) => LabelOptic "exclusiveMinimum" A_Lens Header Header a b where
370− labelOptic = #paramSchema % #exclusiveMinimum
371− {-# INLINE labelOptic #-}
372−
373−instance
374− ( a ~ Maybe Bool, b ~ Maybe Bool
375− ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where
376− labelOptic = #paramSchema % #exclusiveMinimum
377− {-# INLINE labelOptic #-}
378−
379−instance
380− ( a ~ Maybe Bool, b ~ Maybe Bool
381− ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where
382− labelOptic = #paramSchema % #exclusiveMinimum
383− {-# INLINE labelOptic #-}
384−
385−instance
386− ( a ~ Maybe Bool, b ~ Maybe Bool
387− ) => LabelOptic "exclusiveMinimum" A_Lens ParamOtherSchema ParamOtherSchema a b where
388− labelOptic = #paramSchema % #exclusiveMinimum
389− {-# INLINE labelOptic #-}
390−
391−-- #maxLength
392−
393−instance
394− ( a ~ Maybe Integer, b ~ Maybe Integer
395− ) => LabelOptic "maxLength" A_Lens Header Header a b where
396− labelOptic = #paramSchema % #maxLength
397− {-# INLINE labelOptic #-}
398−
399−instance
400− ( a ~ Maybe Integer, b ~ Maybe Integer
401− ) => LabelOptic "maxLength" A_Lens Schema Schema a b where
402− labelOptic = #paramSchema % #maxLength
403− {-# INLINE labelOptic #-}
404−
405−instance
406− ( a ~ Maybe Integer, b ~ Maybe Integer
407− ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where
408− labelOptic = #paramSchema % #maxLength
409− {-# INLINE labelOptic #-}
410−
411−instance
412− ( a ~ Maybe Integer, b ~ Maybe Integer
413− ) => LabelOptic "maxLength" A_Lens ParamOtherSchema ParamOtherSchema a b where
414− labelOptic = #paramSchema % #maxLength
415− {-# INLINE labelOptic #-}
416−
417−-- #minLength
418−
419−instance
420− ( a ~ Maybe Integer, b ~ Maybe Integer
421− ) => LabelOptic "minLength" A_Lens Header Header a b where
422− labelOptic = #paramSchema % #minLength
423− {-# INLINE labelOptic #-}
424−
425−instance
426− ( a ~ Maybe Integer, b ~ Maybe Integer
427− ) => LabelOptic "minLength" A_Lens Schema Schema a b where
428− labelOptic = #paramSchema % #minLength
429− {-# INLINE labelOptic #-}
430−
431−instance
432− ( a ~ Maybe Integer, b ~ Maybe Integer
433− ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where
434− labelOptic = #paramSchema % #minLength
435− {-# INLINE labelOptic #-}
436−
437−instance
438− ( a ~ Maybe Integer, b ~ Maybe Integer
439− ) => LabelOptic "minLength" A_Lens ParamOtherSchema ParamOtherSchema a b where
440− labelOptic = #paramSchema % #minLength
441− {-# INLINE labelOptic #-}
442−
443−-- #pattern
444−
445−instance
446− ( a ~ Maybe Text, b ~ Maybe Text
447− ) => LabelOptic "pattern" A_Lens Header Header a b where
448− labelOptic = #paramSchema % #pattern
449− {-# INLINE labelOptic #-}
450−
451−instance
452− ( a ~ Maybe Text, b ~ Maybe Text
453− ) => LabelOptic "pattern" A_Lens Schema Schema a b where
454− labelOptic = #paramSchema % #pattern
455− {-# INLINE labelOptic #-}
456−
457−instance
458− ( a ~ Maybe Text, b ~ Maybe Text
459− ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where
460− labelOptic = #paramSchema % #pattern
461− {-# INLINE labelOptic #-}
462−
463−instance
464− ( a ~ Maybe Text, b ~ Maybe Text
465− ) => LabelOptic "pattern" A_Lens ParamOtherSchema ParamOtherSchema a b where
466− labelOptic = #paramSchema % #pattern
467− {-# INLINE labelOptic #-}
468−
469−-- #maxItems
470−
471−instance
472− ( a ~ Maybe Integer, b ~ Maybe Integer
473− ) => LabelOptic "maxItems" A_Lens Header Header a b where
474− labelOptic = #paramSchema % #maxItems
475− {-# INLINE labelOptic #-}
476−
477−instance
478− ( a ~ Maybe Integer, b ~ Maybe Integer
479− ) => LabelOptic "maxItems" A_Lens Schema Schema a b where
480− labelOptic = #paramSchema % #maxItems
481− {-# INLINE labelOptic #-}
482−
483−instance
484− ( a ~ Maybe Integer, b ~ Maybe Integer
485− ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where
486− labelOptic = #paramSchema % #maxItems
487− {-# INLINE labelOptic #-}
488−
489−instance
490− ( a ~ Maybe Integer, b ~ Maybe Integer
491− ) => LabelOptic "maxItems" A_Lens ParamOtherSchema ParamOtherSchema a b where
492− labelOptic = #paramSchema % #maxItems
493− {-# INLINE labelOptic #-}
494−
495−-- #minItems
496−
497−instance
498− ( a ~ Maybe Integer, b ~ Maybe Integer
499− ) => LabelOptic "minItems" A_Lens Header Header a b where
500− labelOptic = #paramSchema % #minItems
501− {-# INLINE labelOptic #-}
502−
503−instance
504− ( a ~ Maybe Integer, b ~ Maybe Integer
505− ) => LabelOptic "minItems" A_Lens Schema Schema a b where
506− labelOptic = #paramSchema % #minItems
507− {-# INLINE labelOptic #-}
508−
509−instance
510− ( a ~ Maybe Integer, b ~ Maybe Integer
511− ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where
512− labelOptic = #paramSchema % #minItems
513− {-# INLINE labelOptic #-}
514−
515−instance
516− ( a ~ Maybe Integer, b ~ Maybe Integer
517− ) => LabelOptic "minItems" A_Lens ParamOtherSchema ParamOtherSchema a b where
518− labelOptic = #paramSchema % #minItems
519− {-# INLINE labelOptic #-}
520−
521−-- #uniqueItems
522−
523−instance
524− ( a ~ Maybe Bool, b ~ Maybe Bool
525− ) => LabelOptic "uniqueItems" A_Lens Header Header a b where
526− labelOptic = #paramSchema % #uniqueItems
527− {-# INLINE labelOptic #-}
528−
529−instance
530− ( a ~ Maybe Bool, b ~ Maybe Bool
531− ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where
532− labelOptic = #paramSchema % #uniqueItems
533− {-# INLINE labelOptic #-}
534−
535−instance
536− ( a ~ Maybe Bool, b ~ Maybe Bool
537− ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where
538− labelOptic = #paramSchema % #uniqueItems
539− {-# INLINE labelOptic #-}
540−
541−instance
542− ( a ~ Maybe Bool, b ~ Maybe Bool
543− ) => LabelOptic "uniqueItems" A_Lens ParamOtherSchema ParamOtherSchema a b where
544− labelOptic = #paramSchema % #uniqueItems
545− {-# INLINE labelOptic #-}
546−
547−-- #enum
548−
549−instance
550− ( a ~ Maybe [Value], b ~ Maybe [Value]
551− ) => LabelOptic "enum" A_Lens Header Header a b where
552− labelOptic = #paramSchema % #enum
553− {-# INLINE labelOptic #-}
554−
555−instance
556− ( a ~ Maybe [Value], b ~ Maybe [Value]
557− ) => LabelOptic "enum" A_Lens Schema Schema a b where
558− labelOptic = #paramSchema % #enum
559− {-# INLINE labelOptic #-}
560−
561−instance
562− ( a ~ Maybe [Value], b ~ Maybe [Value]
563− ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where
564− labelOptic = #paramSchema % #enum
565− {-# INLINE labelOptic #-}
566−
567−instance
568− ( a ~ Maybe [Value], b ~ Maybe [Value]
569− ) => LabelOptic "enum" A_Lens ParamOtherSchema ParamOtherSchema a b where
570− labelOptic = #paramSchema % #enum
571− {-# INLINE labelOptic #-}
572−
573−-- #multipleOf
574−
575−instance
576− ( a ~ Maybe Scientific, b ~ Maybe Scientific
577− ) => LabelOptic "multipleOf" A_Lens Header Header a b where
578− labelOptic = #paramSchema % #multipleOf
579− {-# INLINE labelOptic #-}
580−
581−instance
582− ( a ~ Maybe Scientific, b ~ Maybe Scientific
583− ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where
584− labelOptic = #paramSchema % #multipleOf
585− {-# INLINE labelOptic #-}
586−
587−instance
588− ( a ~ Maybe Scientific, b ~ Maybe Scientific
589− ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where
590− labelOptic = #paramSchema % #multipleOf
591− {-# INLINE labelOptic #-}
592−
593−instance
594− ( a ~ Maybe Scientific, b ~ Maybe Scientific
595− ) => LabelOptic "multipleOf" A_Lens ParamOtherSchema ParamOtherSchema a b where
596− labelOptic = #paramSchema % #multipleOf
597− {-# INLINE labelOptic #-}
stack.yaml+5−5
@@ -1,9 +1,9 @@
1−resolver: lts-14.3
1+resolver: lts-16.31
22packages:
33- '.'
44extra-deps:
5−- optics-core-0.2
6−- optics-th-0.2
7−- optics-extra-0.2
5+- optics-core-0.3
6+- optics-th-0.3
7+- optics-extra-0.3
88- indexed-profunctors-0.1
9−- insert-ordered-containers-0.2.3
9+- insert-ordered-containers-0.2.3.1
swagger2.cabaldeleted−154
@@ -1,154 +0,0 @@
1−cabal-version: >=1.10
2−name: swagger2
3−version: 2.5
4−
5−synopsis: Swagger 2.0 data model
6−category: Web, Swagger
7−description:
8− This library is intended to be used for decoding and encoding Swagger 2.0 API
9− specifications as well as manipulating them.
10− .
11− The original Swagger 2.0 specification is available at http://swagger.io/specification/.
12−
13−homepage: https://github.com/GetShopTV/swagger2
14−bug-reports: https://github.com/GetShopTV/swagger2/issues
15−license: BSD3
16−license-file: LICENSE
17−author: Nickolay Kudasov
18−maintainer: nickolay@getshoptv.com
19−copyright: (c) 2015-2016, GetShopTV
20−build-type: Custom
21−extra-source-files:
22− README.md
23− , CHANGELOG.md
24− , examples/*.hs
25− , include/overlapping-compat.h
26−tested-with:
27− GHC ==8.0.2
28− || ==8.2.2
29− || ==8.4.4
30− || ==8.6.5
31− || ==8.8.1
32−
33−custom-setup
34− setup-depends:
35− base, Cabal, cabal-doctest >=1.0.6 && <1.1
36−
37−library
38− hs-source-dirs: src
39− include-dirs: include
40− exposed-modules:
41− Data.Swagger
42− Data.Swagger.Declare
43− Data.Swagger.Lens
44− Data.Swagger.Operation
45− Data.Swagger.Optics
46− Data.Swagger.ParamSchema
47− Data.Swagger.Schema
48− Data.Swagger.Schema.Generator
49− Data.Swagger.Schema.Validation
50− Data.Swagger.SchemaOptions
51−
52− -- internal modules
53− Data.Swagger.Internal
54− Data.Swagger.Internal.Schema
55− Data.Swagger.Internal.Schema.Validation
56− Data.Swagger.Internal.ParamSchema
57− Data.Swagger.Internal.Utils
58− Data.Swagger.Internal.AesonUtils
59− Data.Swagger.Internal.TypeShape
60−
61− -- GHC boot libraries
62− build-depends:
63− base >=4.9 && <4.14
64− , bytestring >=0.10.4.0 && <0.11
65− , containers >=0.5.5.1 && <0.7
66− , template-haskell >=2.9.0.0 && <2.16
67− , time >=1.4.2 && <1.10
68− , transformers >=0.3.0.0 && <0.6
69−
70− build-depends:
71− mtl >=2.1 && <2.3
72− , text >=1.2.3.0 && <1.3
73−
74− -- other dependencies
75− build-depends:
76− base-compat-batteries >=0.10.4 && <0.12
77− , aeson >=1.4.2.0 && <1.5
78− , aeson-pretty >=0.8.7 && <0.9
79− -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
80− , cookie >=0.4.3 && <0.5
81− , generics-sop >=0.3.2.0 && <0.6
82− , hashable >=1.2.7.0 && <1.4
83− , http-media >=0.7.1.2 && <0.9
84− , insert-ordered-containers >=0.2.3 && <0.3
85− , lens >=4.16.1 && <4.19
86− , network >=2.6.3.5 && <3.2
87− , optics-core >=0.2 && <0.3
88− , optics-th >=0.2 && <0.3
89− , scientific >=0.3.6.2 && <0.4
90− , transformers-compat >=0.3 && <0.7
91− , unordered-containers >=0.2.9.0 && <0.3
92− , uuid-types >=1.0.3 && <1.1
93− , vector >=0.12.0.1 && <0.13
94− , QuickCheck >=2.10.1 && <2.14
95−
96− default-language: Haskell2010
97−
98−test-suite spec
99− type: exitcode-stdio-1.0
100− hs-source-dirs: test
101− main-is: Spec.hs
102−
103− -- From library parat
104− -- We need aeson's toEncoding for doctests too
105− build-depends:
106− base
107− , swagger2
108− , aeson
109− , base-compat-batteries
110− , bytestring
111− , containers
112− , hashable
113− , insert-ordered-containers
114− , lens
115− , mtl
116− , template-haskell
117− , text
118− , time
119− , unordered-containers
120− , vector
121− , QuickCheck
122−
123− -- test-suite only dependencies
124− build-depends:
125− hspec >=2.5.5 && <2.8
126− , HUnit >=1.6.0.0 && <1.7
127− , quickcheck-instances >=0.3.19 && <0.14
128− , utf8-string >=1.0.1.1 && <1.1
129−
130− -- https://github.com/haskell/cabal/issues/3708
131− build-tool-depends:
132− hspec-discover:hspec-discover >=2.5.5 && <2.8
133−
134− other-modules:
135− SpecCommon
136− Data.SwaggerSpec
137− Data.Swagger.CommonTestTypes
138− Data.Swagger.ParamSchemaSpec
139− Data.Swagger.SchemaSpec
140− Data.Swagger.Schema.ValidationSpec
141− Data.Swagger.Schema.GeneratorSpec
142− default-language: Haskell2010
143−
144−test-suite doctests
145− -- See QuickCheck note in https://github.com/phadej/cabal-doctest#notes
146− build-depends: base, doctest, Glob, QuickCheck
147− default-language: Haskell2010
148− hs-source-dirs: test
149− main-is: doctests.hs
150− type: exitcode-stdio-1.0
151−
152−source-repository head
153− type: git
154− location: https://github.com/GetShopTV/swagger2.git
test/Data/Swagger/CommonTestTypes.hs → test/Data/OpenApi/CommonTestTypes.hsrenamed+464−101
@@ -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
@@ -15,9 +15,10 @@ import Data.Map (Map)
1515import Data.Proxy
1616import Data.Set (Set)
1717import qualified Data.Text as Text
18+import Data.Word
1819import GHC.Generics
1920
20−import Data.Swagger
21+import Data.OpenApi
2122
2223-- ========================================================================
2324-- Unit type
@@ -87,7 +88,7 @@ paintSchemaJSON = [aesonQQ|
8788 {
8889 "color":
8990 {
90− "$ref": "#/definitions/Color"
91+ "$ref": "#/components/schemas/Color"
9192 }
9293 },
9394 "required": ["color"]
@@ -180,7 +181,7 @@ userGroupSchemaJSON :: Value
180181userGroupSchemaJSON = [aesonQQ|
181182{
182183 "type": "array",
183− "items": { "$ref": "#/definitions/UserId" },
184+ "items": { "$ref": "#/components/schemas/UserId" },
184185 "uniqueItems": true
185186}
186187|]
@@ -227,7 +228,7 @@ playerSchemaJSON = [aesonQQ|
227228 {
228229 "position":
229230 {
230− "$ref": "#/definitions/Point"
231+ "$ref": "#/components/schemas/Point"
231232 }
232233 },
233234 "required": ["position"]
@@ -249,7 +250,7 @@ playersSchemaJSON = [aesonQQ|
249250 {
250251 "position":
251252 {
252− "$ref": "#/definitions/Point"
253+ "$ref": "#/components/schemas/Point"
253254 }
254255 },
255256 "required": ["position"]
@@ -270,106 +271,192 @@ instance ToSchema Character
270271characterSchemaJSON :: Value
271272characterSchemaJSON = [aesonQQ|
272273{
273− "type": "object",
274− "properties":
274+ "oneOf": [
275275 {
276− "PC": { "$ref": "#/definitions/Player" },
277− "NPC":
278− {
279− "type": "object",
280− "properties":
281− {
282− "npcName": { "type": "string" },
283− "npcPosition": { "$ref": "#/definitions/Point" }
284− },
285− "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"
286290 }
291+ }
287292 },
288− "maxProperties": 1,
289− "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"
290317}
318+
291319|]
292320
293321characterInlinedSchemaJSON :: Value
294322characterInlinedSchemaJSON = [aesonQQ|
295323{
296− "type": "object",
297− "properties":
324+ "oneOf": [
298325 {
299− "PC":
300− {
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+ ],
301342 "type": "object",
302− "properties":
303− {
304− "position":
305− {
306− "type": "object",
307− "properties":
308− {
309− "x": { "type": "number", "format": "double" },
310− "y": { "type": "number", "format": "double" }
311− },
312− "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"
313358 }
314− },
315− "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+ ]
316378 },
317− "NPC":
318− {
379+ "npcPosition": {
380+ "required": [
381+ "x",
382+ "y"
383+ ],
319384 "type": "object",
320− "properties":
321− {
322− "npcName": { "type": "string" },
323− "npcPosition":
324− {
325− "type": "object",
326− "properties":
327− {
328− "x": { "type": "number", "format": "double" },
329− "y": { "type": "number", "format": "double" }
330− },
331− "required": ["x", "y"]
332− }
385+ "properties": {
386+ "x": {
387+ "format": "double",
388+ "type": "number"
333389 },
334− "required": ["npcName", "npcPosition"]
390+ "y": {
391+ "format": "double",
392+ "type": "number"
393+ }
394+ }
395+ },
396+ "npcName": {
397+ "type": "string"
335398 }
336− },
337− "maxProperties": 1,
338− "minProperties": 1
399+ }
400+ }
401+ ],
402+ "type": "object"
339403}
340404|]
341405
342406characterInlinedPlayerSchemaJSON :: Value
343407characterInlinedPlayerSchemaJSON = [aesonQQ|
344408{
345− "type": "object",
346− "properties":
409+ "oneOf": [
347410 {
348− "PC":
349− {
350− "type": "object",
351− "properties":
352− {
353− "position":
354− {
355− "$ref": "#/definitions/Point"
356− }
357− },
358− "required": ["position"]
411+ "required": [
412+ "tag",
413+ "contents"
414+ ],
415+ "type": "object",
416+ "properties": {
417+ "tag": {
418+ "type": "string",
419+ "enum": [
420+ "PC"
421+ ]
359422 },
360− "NPC":
361− {
423+ "contents": {
424+ "required": [
425+ "position"
426+ ],
362427 "type": "object",
363− "properties":
364− {
365− "npcName": { "type": "string" },
366− "npcPosition": { "$ref": "#/definitions/Point" }
367− },
368− "required": ["npcName", "npcPosition"]
428+ "properties": {
429+ "position": {
430+ "$ref": "#/components/schemas/Point"
431+ }
432+ }
369433 }
434+ }
370435 },
371− "maxProperties": 1,
372− "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"
373460}
374461|]
375462
@@ -481,7 +568,7 @@ myRoseTreeSchemaJSON = [aesonQQ|
481568 "type": "array",
482569 "items":
483570 {
484− "$ref": "#/definitions/RoseTree"
571+ "$ref": "#/components/schemas/RoseTree"
485572 }
486573 }
487574 },
@@ -510,7 +597,7 @@ myRoseTreeSchemaJSON' = [aesonQQ|
510597 "type": "array",
511598 "items":
512599 {
513− "$ref": "#/definitions/myrosetree'"
600+ "$ref": "#/components/schemas/myrosetree'"
514601 }
515602 }
516603 },
@@ -541,42 +628,169 @@ data Light
541628 deriving (Generic)
542629
543630instance ToSchema Light where
544− declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
631+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
545632 { unwrapUnaryRecords = True }
546633
547634lightSchemaJSON :: Value
548635lightSchemaJSON = [aesonQQ|
549636{
550− "type": "object",
551− "properties":
637+ "oneOf": [
552638 {
553− "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },
554− "LightFreq": { "type": "number", "format": "double" },
555− "LightColor": { "$ref": "#/definitions/Color" },
556− "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+ }
557670 },
558− "maxProperties": 1,
559− "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"
560710}
561711|]
562712
563713lightInlinedSchemaJSON :: Value
564714lightInlinedSchemaJSON = [aesonQQ|
565715{
566− "type": "object",
567− "properties":
716+ "oneOf": [
568717 {
569− "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },
570− "LightFreq": { "type": "number", "format": "double" },
571− "LightColor":
572− {
718+ "required": [
719+ "tag"
720+ ],
721+ "type": "object",
722+ "properties": {
723+ "tag": {
573724 "type": "string",
574− "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+ ]
575743 },
576− "LightWaveLength": { "type": "number", "format": "double" }
744+ "contents": {
745+ "format": "double",
746+ "type": "number"
747+ }
748+ }
577749 },
578− "maxProperties": 1,
579− "minProperties": 1
750+ {
751+ "required": [
752+ "tag",
753+ "contents"
754+ ],
755+ "type": "object",
756+ "properties": {
757+ "tag": {
758+ "type": "string",
759+ "enum": [
760+ "LightColor"
761+ ]
762+ },
763+ "contents": {
764+ "type": "string",
765+ "enum": [
766+ "Red",
767+ "Green",
768+ "Blue"
769+ ]
770+ }
771+ }
772+ },
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"
580794}
581795|]
582796
@@ -649,6 +863,129 @@ singleMaybeFieldSchemaJSON = [aesonQQ|
649863}
650864|]
651865
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+|]
652989
653990-- ========================================================================
654991-- TimeOfDay
@@ -676,4 +1013,30 @@ timeOfDayParamSchemaJSON = [aesonQQ|
6761013 "type": "string",
6771014 "format": "hh:MM:ss"
6781015}
679−|]
1016+|]
1017+
1018+
1019+-- ========================================================================
1020+-- UnsignedInts
1021+-- ========================================================================
1022+data UnsignedInts = UnsignedInts
1023+ { unsignedIntsUint32 :: Word32
1024+ , unsignedIntsUint64 :: Word64
1025+ } deriving (Generic)
1026+
1027+instance ToSchema UnsignedInts where
1028+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
1029+ { fieldLabelModifier = map toLower . drop (length "unsignedInts") }
1030+
1031+unsignedIntsSchemaJSON :: Value
1032+unsignedIntsSchemaJSON = [aesonQQ|
1033+{
1034+ "type": "object",
1035+ "properties":
1036+ {
1037+ "uint32": { "type": "integer", "format": "int32", "minimum": 0, "maximum": 4294967295 },
1038+ "uint64": { "type": "integer", "format": "int64", "minimum": 0, "maximum": 18446744073709551615 }
1039+ },
1040+ "required": ["uint32", "uint64"]
1041+}
1042+|]
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+55−9
@@ -4,11 +4,15 @@
44{-# LANGUAGE RecordWildCards #-}
55{-# LANGUAGE ScopedTypeVariables #-}
66{-# OPTIONS_GHC -fno-warn-orphans #-}
7−module Data.Swagger.Schema.ValidationSpec where
7+module Data.OpenApi.Schema.ValidationSpec where
88
99import Control.Applicative
1010import Control.Lens ((&), (.~), (?~))
1111import 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
1216import Data.Aeson.Types
1317import Data.Hashable (Hashable)
1418import Data.HashMap.Strict (HashMap)
@@ -29,8 +33,9 @@ import Data.Version (Version)
2933import Data.Word
3034import GHC.Generics
3135
32−import Data.Swagger
33−import Data.Swagger.Declare
36+import Data.OpenApi
37+import Data.OpenApi.Declare
38+import Data.OpenApi.Aeson.Compat (stringToKey)
3439
3540import Test.Hspec
3641import Test.Hspec.QuickCheck
@@ -92,6 +97,8 @@ spec = do
9297 prop "Paint" $ shouldValidate (Proxy :: Proxy Paint)
9398 prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
9499 prop "Light" $ shouldValidate (Proxy :: Proxy Light)
100+ prop "Light TaggedObject" $ shouldValidate (Proxy :: Proxy LightTaggedObject)
101+ prop "Light UntaggedValue" $ shouldValidate (Proxy :: Proxy LightUntaggedValue)
95102 prop "ButtonImages" $ shouldValidate (Proxy :: Proxy ButtonImages)
96103 prop "Version" $ shouldValidate (Proxy :: Proxy Version)
97104 prop "FreeForm" $ shouldValidate (Proxy :: Proxy FreeForm)
@@ -123,9 +130,9 @@ instance Arbitrary Person where
123130
124131invalidPersonToJSON :: Person -> Value
125132invalidPersonToJSON Person{..} = object
126− [ T.pack "personName" .= toJSON name
127− , T.pack "personPhone" .= toJSON phone
128− , T.pack "personEmail" .= toJSON email
133+ [ stringToKey "personName" .= toJSON name
134+ , stringToKey "personPhone" .= toJSON phone
135+ , stringToKey "personEmail" .= toJSON email
129136 ]
130137
131138-- ========================================================================
@@ -189,10 +196,10 @@ instance Arbitrary MyRoseTree where
189196data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic)
190197
191198instance ToSchema Light where
192− declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
199+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = ObjectWithSingleField }
193200
194201instance ToJSON Light where
195− toJSON = genericToJSON defaultOptions { sumEncoding = ObjectWithSingleField }
202+ toJSON = genericToJSON defaultOptions { Data.Aeson.Types.sumEncoding = ObjectWithSingleField }
196203
197204instance Arbitrary Light where
198205 arbitrary = oneof
@@ -204,6 +211,34 @@ instance Arbitrary Light where
204211invalidLightToJSON :: Light -> Value
205212invalidLightToJSON = genericToJSON defaultOptions
206213
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+
207242-- ========================================================================
208243-- ButtonImages (bounded enum key mapping)
209244-- ========================================================================
@@ -248,7 +283,7 @@ instance ToJSON FreeForm where
248283
249284instance ToSchema FreeForm where
250285 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
251− & type_ ?~ SwaggerObject
286+ & type_ ?~ OpenApiObject
252287 & additionalProperties ?~ AdditionalPropertiesAllowed True
253288
254289instance Arbitrary FreeForm where
@@ -266,6 +301,8 @@ instance Eq ZonedTime where
266301-- Arbitrary instance for Data.Aeson.Value
267302-- ========================================================================
268303
304+-- These instances were introduces in aeson upstream in 2.0.3
305+#if !MIN_VERSION_aeson(2,0,3)
269306instance Arbitrary Value where
270307 -- Weights are almost random
271308 -- Uniform oneof tends not to build complex objects cause of recursive call.
@@ -276,3 +313,12 @@ instance Arbitrary Value where
276313 , (3, Number <$> arbitrary)
277314 , (3, Bool <$> arbitrary)
278315 , (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+16−11
@@ -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,51 +14,54 @@ 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
2424import qualified Data.HashMap.Strict as HM
2525import Data.Time.LocalTime
2626
27−checkToSchema :: ToSchema a => Proxy a -> Value -> Spec
27+checkToSchema :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
2828checkToSchema proxy js = toSchema proxy <=> js
2929
30−checkSchemaName :: ToSchema a => Maybe String -> Proxy a -> Spec
30+checkSchemaName :: (HasCallStack, ToSchema a) => Maybe String -> Proxy a -> Spec
3131checkSchemaName sname proxy =
3232 it ("schema name is " ++ show sname) $
3333 schemaName proxy `shouldBe` fmap Text.pack sname
3434
35−checkDefs :: ToSchema a => Proxy a -> [String] -> Spec
35+checkDefs :: (HasCallStack, ToSchema a) => Proxy a -> [String] -> Spec
3636checkDefs proxy names =
3737 it ("uses these definitions " ++ show names) $
3838 InsOrdHashMap.keys defs `shouldBe` map Text.pack names
3939 where
4040 defs = execDeclare (declareNamedSchema proxy) mempty
4141
42−checkProperties :: ToSchema a => Proxy a -> [String] -> Spec
42+checkProperties :: (HasCallStack, ToSchema a) => Proxy a -> [String] -> Spec
4343checkProperties proxy names =
4444 it ("has these fields in order " ++ show names) $
4545 InsOrdHashMap.keys fields `shouldBe` map Text.pack names
4646 where
4747 fields = toSchema proxy ^. properties
4848
49−checkInlinedSchema :: ToSchema a => Proxy a -> Value -> Spec
49+checkInlinedSchema :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
5050checkInlinedSchema proxy js = toInlinedSchema proxy <=> js
5151
52−checkInlinedSchemas :: ToSchema a => [String] -> Proxy a -> Value -> Spec
52+checkInlinedSchemas :: (HasCallStack, ToSchema a) => [String] -> Proxy a -> Value -> Spec
5353checkInlinedSchemas names proxy js = inlineSchemas (map Text.pack names) defs s <=> js
5454 where
5555 (defs, s) = runDeclare (declareSchema proxy) mempty
5656
57−checkInlinedRecSchema :: ToSchema a => Proxy a -> Value -> Spec
57+checkInlinedRecSchema :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
5858checkInlinedRecSchema 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'
@@ -85,6 +89,7 @@ spec = do
8589 context "Status (sum of unary constructors)" $ checkToSchema (Proxy :: Proxy Status) statusSchemaJSON
8690 context "Character (ref and record sum)" $ checkToSchema (Proxy :: Proxy Character) characterSchemaJSON
8791 context "Light (sum with unwrapUnaryRecords)" $ checkToSchema (Proxy :: Proxy Light) lightSchemaJSON
92+ context "UnsignedInts" $ checkToSchema (Proxy :: Proxy UnsignedInts) unsignedIntsSchemaJSON
8893 context "Schema name" $ do
8994 context "String" $ checkSchemaName Nothing (Proxy :: Proxy String)
9095 context "(Int, Float)" $ checkSchemaName Nothing (Proxy :: Proxy (Int, Float))
test/Data/OpenApiSpec.hsnew file+962
@@ -0,0 +1,962 @@
1+{-# LANGUAGE OverloadedLists #-}
2+{-# LANGUAGE OverloadedStrings #-}
3+{-# LANGUAGE ScopedTypeVariables #-}
4+{-# LANGUAGE QuasiQuotes #-}
5+module Data.OpenApiSpec where
6+
7+import Prelude ()
8+import Prelude.Compat
9+
10+import Control.Lens
11+
12+import Data.Aeson
13+import Data.Aeson.QQ.Simple
14+import Data.HashMap.Strict (HashMap)
15+import qualified Data.HashSet.InsOrd as InsOrdHS
16+import Data.Text (Text)
17+
18+import Data.OpenApi
19+import SpecCommon
20+import Test.Hspec hiding (example)
21+
22+spec :: Spec
23+spec = do
24+ describe "License Object" $ licenseExample <=> licenseExampleJSON
25+ describe "Contact Object" $ contactExample <=> contactExampleJSON
26+ describe "Info Object" $ infoExample <=> infoExampleJSON
27+ describe "Operation Object" $ operationExample <=> operationExampleJSON
28+ describe "Schema Object" $ do
29+ context "Primitive Sample" $ schemaPrimitiveExample <=> schemaPrimitiveExampleJSON
30+ context "Simple Model" $ schemaSimpleModelExample <=> schemaSimpleModelExampleJSON
31+ context "Model with Map/Dictionary Properties" $ schemaModelDictExample <=> schemaModelDictExampleJSON
32+ context "Model with Arbitrary Properties" $ schemaAdditionalExample <=> schemaAdditionalExampleJSON
33+ context "Model with Example" $ schemaWithExampleExample <=> schemaWithExampleExampleJSON
34+ describe "Definitions Object" $ definitionsExample <=> definitionsExampleJSON
35+ describe "Parameters Definition Object" $ paramsDefinitionExample <=> paramsDefinitionExampleJSON
36+ describe "Responses Definition Object" $ responsesDefinitionExample <=> responsesDefinitionExampleJSON
37+ describe "Security Definitions Object" $ securityDefinitionsExample <=> securityDefinitionsExampleJSON
38+ describe "OAuth2 Security Definitions with merged Scope" $ oAuth2SecurityDefinitionsExample <=> oAuth2SecurityDefinitionsExampleJSON
39+ describe "Composition Schema Example" $ compositionSchemaExample <=> compositionSchemaExampleJSON
40+ describe "Swagger Object" $ do
41+ context "Example with no paths" $ emptyPathsFieldExample <=> emptyPathsFieldExampleJSON
42+ context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
43+ context "PetStore Example" $ do
44+ it "decodes successfully" $ do
45+ fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)
46+ it "roundtrips: fmap toJSON . fromJSON" $ do
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
52+
53+main :: IO ()
54+main = hspec spec
55+
56+-- =======================================================================
57+-- Info object
58+-- =======================================================================
59+
60+infoExample :: Info
61+infoExample = mempty
62+ & title .~ "Swagger Sample App"
63+ & description ?~ "This is a sample server Petstore server."
64+ & termsOfService ?~ "http://swagger.io/terms/"
65+ & contact ?~ contactExample
66+ & license ?~ licenseExample
67+ & version .~ "1.0.1"
68+
69+infoExampleJSON :: Value
70+infoExampleJSON = [aesonQQ|
71+{
72+ "title": "Swagger Sample App",
73+ "description": "This is a sample server Petstore server.",
74+ "termsOfService": "http://swagger.io/terms/",
75+ "contact": {
76+ "name": "API Support",
77+ "url": "http://www.swagger.io/support",
78+ "email": "support@swagger.io"
79+ },
80+ "license": {
81+ "name": "Apache 2.0",
82+ "url": "http://www.apache.org/licenses/LICENSE-2.0.html"
83+ },
84+ "version": "1.0.1"
85+}
86+|]
87+
88+-- =======================================================================
89+-- Contact object
90+-- =======================================================================
91+
92+contactExample :: Contact
93+contactExample = mempty
94+ & name ?~ "API Support"
95+ & url ?~ URL "http://www.swagger.io/support"
96+ & email ?~ "support@swagger.io"
97+
98+contactExampleJSON :: Value
99+contactExampleJSON = [aesonQQ|
100+{
101+ "name": "API Support",
102+ "url": "http://www.swagger.io/support",
103+ "email": "support@swagger.io"
104+}
105+|]
106+
107+-- =======================================================================
108+-- License object
109+-- =======================================================================
110+
111+licenseExample :: License
112+licenseExample = "Apache 2.0"
113+ & url ?~ URL "http://www.apache.org/licenses/LICENSE-2.0.html"
114+
115+licenseExampleJSON :: Value
116+licenseExampleJSON = [aesonQQ|
117+{
118+ "name": "Apache 2.0",
119+ "url": "http://www.apache.org/licenses/LICENSE-2.0.html"
120+}
121+|]
122+
123+
124+-- =======================================================================
125+-- Operation object
126+-- =======================================================================
127+
128+operationExample :: Operation
129+operationExample = mempty
130+ & tags .~ InsOrdHS.fromList ["pet"]
131+ & summary ?~ "Updates a pet in the store with form data"
132+ & description ?~ ""
133+ & operationId ?~ "updatePetWithForm"
134+ & parameters .~ [Inline (mempty
135+ & name .~ "petId"
136+ & description ?~ "ID of pet that needs to be updated"
137+ & required ?~ True
138+ & in_ .~ ParamPath
139+ & schema ?~ Inline (mempty & type_ ?~ OpenApiString))]
140+ & requestBody ?~ Inline (
141+ mempty & content . at "application/x-www-form-urlencoded" ?~ (mempty & schema ?~ (Inline (mempty
142+ & properties . at "petId" ?~ Inline (mempty
143+ & description ?~ "Updated name of the pet"
144+ & type_ ?~ OpenApiString)
145+ & properties . at "status" ?~ Inline (mempty
146+ & description ?~ "Updated status of the pet"
147+ & type_ ?~ OpenApiString)))))
148+ & at 200 ?~ "Pet updated."
149+ & at 405 ?~ "Invalid input"
150+ & security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]
151+
152+operationExampleJSON :: Value
153+operationExampleJSON = [aesonQQ|
154+{
155+ "tags": [
156+ "pet"
157+ ],
158+ "summary": "Updates a pet in the store with form data",
159+ "description": "",
160+ "operationId": "updatePetWithForm",
161+ "parameters": [
162+ {
163+ "required": true,
164+ "schema": {
165+ "type": "string"
166+ },
167+ "in": "path",
168+ "name": "petId",
169+ "description": "ID of pet that needs to be updated"
170+ }
171+ ],
172+ "requestBody": {
173+ "content": {
174+ "application/x-www-form-urlencoded": {
175+ "schema": {
176+ "properties": {
177+ "petId": {
178+ "type": "string",
179+ "description": "Updated name of the pet"
180+ },
181+ "status": {
182+ "type": "string",
183+ "description": "Updated status of the pet"
184+ }
185+ }
186+ }
187+ }
188+ }
189+ },
190+ "responses": {
191+ "200": {
192+ "description": "Pet updated."
193+ },
194+ "405": {
195+ "description": "Invalid input"
196+ }
197+ },
198+ "security": [
199+ {
200+ "petstore_auth": [
201+ "write:pets",
202+ "read:pets"
203+ ]
204+ }
205+ ]
206+}
207+|]
208+
209+-- =======================================================================
210+-- Schema object
211+-- =======================================================================
212+
213+schemaPrimitiveExample :: Schema
214+schemaPrimitiveExample = mempty
215+ & type_ ?~ OpenApiString
216+ & format ?~ "email"
217+
218+schemaPrimitiveExampleJSON :: Value
219+schemaPrimitiveExampleJSON = [aesonQQ|
220+{
221+ "type": "string",
222+ "format": "email"
223+}
224+|]
225+
226+schemaSimpleModelExample :: Schema
227+schemaSimpleModelExample = mempty
228+ & type_ ?~ OpenApiObject
229+ & required .~ [ "name" ]
230+ & properties .~
231+ [ ("name", Inline (mempty & type_ ?~ OpenApiString))
232+ , ("address", Ref (Reference "Address"))
233+ , ("age", Inline $ mempty
234+ & minimum_ ?~ 0
235+ & type_ ?~ OpenApiInteger
236+ & format ?~ "int32" ) ]
237+
238+schemaSimpleModelExampleJSON :: Value
239+schemaSimpleModelExampleJSON = [aesonQQ|
240+{ "required": [ "name" ],
241+ "properties": {
242+ "name": {
243+ "type": "string"
244+ },
245+ "address": {
246+ "$ref": "#/components/schemas/Address"
247+ },
248+ "age": {
249+ "format": "int32",
250+ "minimum": 0,
251+ "type": "integer"
252+ }
253+ },
254+ "type": "object"
255+}
256+|]
257+
258+schemaModelDictExample :: Schema
259+schemaModelDictExample = mempty
260+ & type_ ?~ OpenApiObject
261+ & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ OpenApiString))
262+
263+schemaModelDictExampleJSON :: Value
264+schemaModelDictExampleJSON = [aesonQQ|
265+{
266+ "type": "object",
267+ "additionalProperties": {
268+ "type": "string"
269+ }
270+}
271+|]
272+
273+schemaAdditionalExample :: Schema
274+schemaAdditionalExample = mempty
275+ & type_ ?~ OpenApiObject
276+ & additionalProperties ?~ AdditionalPropertiesAllowed True
277+
278+schemaAdditionalExampleJSON :: Value
279+schemaAdditionalExampleJSON = [aesonQQ|
280+{
281+ "type": "object",
282+ "additionalProperties": true
283+}
284+|]
285+
286+schemaWithExampleExample :: Schema
287+schemaWithExampleExample = mempty
288+ & type_ ?~ OpenApiObject
289+ & properties .~
290+ [ ("id", Inline $ mempty
291+ & type_ ?~ OpenApiInteger
292+ & format ?~ "int64" )
293+ , ("name", Inline $ mempty
294+ & type_ ?~ OpenApiString) ]
295+ & required .~ [ "name" ]
296+ & example ?~ [aesonQQ|
297+ {
298+ "name": "Puma",
299+ "id": 1
300+ }
301+ |]
302+
303+schemaWithExampleExampleJSON :: Value
304+schemaWithExampleExampleJSON = [aesonQQ|
305+{
306+ "type": "object",
307+ "properties": {
308+ "id": {
309+ "type": "integer",
310+ "format": "int64"
311+ },
312+ "name": {
313+ "type": "string"
314+ }
315+ },
316+ "required": [
317+ "name"
318+ ],
319+ "example": {
320+ "name": "Puma",
321+ "id": 1
322+ }
323+}
324+|]
325+
326+-- =======================================================================
327+-- Definitions object
328+-- =======================================================================
329+
330+definitionsExample :: HashMap Text Schema
331+definitionsExample =
332+ [ ("Category", mempty
333+ & type_ ?~ OpenApiObject
334+ & properties .~
335+ [ ("id", Inline $ mempty
336+ & type_ ?~ OpenApiInteger
337+ & format ?~ "int64")
338+ , ("name", Inline (mempty & type_ ?~ OpenApiString)) ] )
339+ , ("Tag", mempty
340+ & type_ ?~ OpenApiObject
341+ & properties .~
342+ [ ("id", Inline $ mempty
343+ & type_ ?~ OpenApiInteger
344+ & format ?~ "int64")
345+ , ("name", Inline (mempty & type_ ?~ OpenApiString)) ] ) ]
346+
347+definitionsExampleJSON :: Value
348+definitionsExampleJSON = [aesonQQ|
349+{
350+ "Category": {
351+ "type": "object",
352+ "properties": {
353+ "id": {
354+ "type": "integer",
355+ "format": "int64"
356+ },
357+ "name": {
358+ "type": "string"
359+ }
360+ }
361+ },
362+ "Tag": {
363+ "type": "object",
364+ "properties": {
365+ "id": {
366+ "type": "integer",
367+ "format": "int64"
368+ },
369+ "name": {
370+ "type": "string"
371+ }
372+ }
373+ }
374+}
375+|]
376+
377+-- =======================================================================
378+-- Parameters Definition object
379+-- =======================================================================
380+
381+paramsDefinitionExample :: HashMap Text Param
382+paramsDefinitionExample =
383+ [ ("skipParam", mempty
384+ & name .~ "skip"
385+ & description ?~ "number of items to skip"
386+ & required ?~ True
387+ & in_ .~ ParamQuery
388+ & schema ?~ Inline (mempty
389+ & type_ ?~ OpenApiInteger
390+ & format ?~ "int32" ))
391+ , ("limitParam", mempty
392+ & name .~ "limit"
393+ & description ?~ "max records to return"
394+ & required ?~ True
395+ & in_ .~ ParamQuery
396+ & schema ?~ Inline (mempty
397+ & type_ ?~ OpenApiInteger
398+ & format ?~ "int32" )) ]
399+
400+paramsDefinitionExampleJSON :: Value
401+paramsDefinitionExampleJSON = [aesonQQ|
402+{
403+ "skipParam": {
404+ "name": "skip",
405+ "in": "query",
406+ "description": "number of items to skip",
407+ "required": true,
408+ "schema": {
409+ "type": "integer",
410+ "format": "int32"
411+ }
412+ },
413+ "limitParam": {
414+ "name": "limit",
415+ "in": "query",
416+ "description": "max records to return",
417+ "required": true,
418+ "schema": {
419+ "type": "integer",
420+ "format": "int32"
421+ }
422+ }
423+}
424+|]
425+
426+-- =======================================================================
427+-- Responses Definition object
428+-- =======================================================================
429+
430+responsesDefinitionExample :: HashMap Text Response
431+responsesDefinitionExample =
432+ [ ("NotFound", mempty & description .~ "Entity not found.")
433+ , ("IllegalInput", mempty & description .~ "Illegal input for operation.") ]
434+
435+responsesDefinitionExampleJSON :: Value
436+responsesDefinitionExampleJSON = [aesonQQ|
437+{
438+ "NotFound": {
439+ "description": "Entity not found."
440+ },
441+ "IllegalInput": {
442+ "description": "Illegal input for operation."
443+ }
444+}
445+|]
446+
447+-- =======================================================================
448+-- Security Definition object
449+-- =======================================================================
450+
451+securityDefinitionsExample :: SecurityDefinitions
452+securityDefinitionsExample = SecurityDefinitions
453+ [ ("api_key", SecurityScheme
454+ { _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "api_key" ApiKeyHeader)
455+ , _securitySchemeDescription = Nothing })
456+ , ("petstore_auth", SecurityScheme
457+ { _securitySchemeType = SecuritySchemeOAuth2 (mempty & implicit ?~ OAuth2Flow
458+ { _oAuth2Params = OAuth2ImplicitFlow "http://swagger.io/api/oauth/dialog"
459+ , _oAath2RefreshUrl = Nothing
460+ , _oAuth2Scopes =
461+ [ ("write:pets", "modify pets in your account")
462+ , ("read:pets", "read your pets") ] } )
463+ , _securitySchemeDescription = Nothing }) ]
464+
465+securityDefinitionsExampleJSON :: Value
466+securityDefinitionsExampleJSON = [aesonQQ|
467+{
468+ "api_key": {
469+ "in": "header",
470+ "name": "api_key",
471+ "type": "apiKey"
472+ },
473+ "petstore_auth": {
474+ "type": "oauth2",
475+ "flows": {
476+ "implicit": {
477+ "scopes": {
478+ "write:pets": "modify pets in your account",
479+ "read:pets": "read your pets"
480+ },
481+ "authorizationUrl": "http://swagger.io/api/oauth/dialog"
482+ }
483+ }
484+ }
485+}
486+
487+|]
488+
489+oAuth2SecurityDefinitionsReadExample :: SecurityDefinitions
490+oAuth2SecurityDefinitionsReadExample = SecurityDefinitions
491+ [ ("petstore_auth", SecurityScheme
492+ { _securitySchemeType = SecuritySchemeOAuth2 (mempty & implicit ?~ OAuth2Flow
493+ { _oAuth2Params = OAuth2ImplicitFlow "http://swagger.io/api/oauth/dialog"
494+ , _oAath2RefreshUrl = Nothing
495+ , _oAuth2Scopes =
496+ [ ("read:pets", "read your pets") ] } )
497+ , _securitySchemeDescription = Nothing })
498+ ]
499+
500+oAuth2SecurityDefinitionsWriteExample :: SecurityDefinitions
501+oAuth2SecurityDefinitionsWriteExample = SecurityDefinitions
502+ [ ("petstore_auth", SecurityScheme
503+ { _securitySchemeType = SecuritySchemeOAuth2 (mempty & implicit ?~ OAuth2Flow
504+ { _oAuth2Params = OAuth2ImplicitFlow "http://swagger.io/api/oauth/dialog"
505+ , _oAath2RefreshUrl = Nothing
506+ , _oAuth2Scopes =
507+ [ ("write:pets", "modify pets in your account") ] } )
508+ , _securitySchemeDescription = Nothing })
509+ ]
510+
511+oAuth2SecurityDefinitionsExample :: SecurityDefinitions
512+oAuth2SecurityDefinitionsExample =
513+ oAuth2SecurityDefinitionsWriteExample <>
514+ oAuth2SecurityDefinitionsReadExample
515+
516+oAuth2SecurityDefinitionsExampleJSON :: Value
517+oAuth2SecurityDefinitionsExampleJSON = [aesonQQ|
518+{
519+ "petstore_auth": {
520+ "type": "oauth2",
521+ "flows": {
522+ "implicit": {
523+ "scopes": {
524+ "write:pets": "modify pets in your account",
525+ "read:pets": "read your pets"
526+ },
527+ "authorizationUrl": "http://swagger.io/api/oauth/dialog"
528+ }
529+ }
530+ }
531+}
532+|]
533+
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+
546+-- =======================================================================
547+-- Swagger object
548+-- =======================================================================
549+
550+emptyPathsFieldExample :: OpenApi
551+emptyPathsFieldExample = mempty
552+
553+emptyPathsFieldExampleJSON :: Value
554+emptyPathsFieldExampleJSON = [aesonQQ|
555+{
556+ "openapi": "3.0.0",
557+ "info": {"version": "", "title": ""},
558+ "paths": {},
559+ "components": {}
560+}
561+|]
562+
563+swaggerExample :: OpenApi
564+swaggerExample = mempty
565+ -- & basePath ?~ "/"
566+ -- & schemes ?~ [Http]
567+ & info .~ (mempty
568+ & version .~ "1.0"
569+ & title .~ "Todo API"
570+ & license ?~ "MIT"
571+ & license._Just.url ?~ URL "http://mit.com"
572+ & description ?~ "This is an API that tests servant-swagger support for a Todo API")
573+ & paths.at "/todo/{id}" ?~ (mempty & get ?~ ((mempty :: Operation)
574+ & responses . at 200 ?~ Inline (mempty
575+ & description .~ "OK"
576+ & content . at "application/json" ?~ (mempty
577+ & schema ?~ Inline (mempty
578+ & type_ ?~ OpenApiObject
579+ & example ?~ [aesonQQ|
580+ {
581+ "created": 100,
582+ "description": "get milk"
583+ } |]
584+ & description ?~ "This is some real Todo right here"
585+ & properties .~
586+ [ ("created", Inline $ mempty
587+ & type_ ?~ OpenApiInteger
588+ & format ?~ "int32")
589+ , ("description", Inline (mempty & type_ ?~ OpenApiString))])))
590+ & parameters .~
591+ [ Inline $ mempty
592+ & required ?~ True
593+ & name .~ "id"
594+ & description ?~ "TodoId param"
595+ & in_ .~ ParamPath
596+ & schema ?~ Inline (mempty
597+ & type_ ?~ OpenApiString ) ]
598+ & tags .~ InsOrdHS.fromList [ "todo" ] ))
599+
600+swaggerExampleJSON :: Value
601+swaggerExampleJSON = [aesonQQ|
602+{
603+ "openapi": "3.0.0",
604+ "info": {
605+ "version": "1.0",
606+ "title": "Todo API",
607+ "license": {
608+ "url": "http://mit.com",
609+ "name": "MIT"
610+ },
611+ "description": "This is an API that tests servant-swagger support for a Todo API"
612+ },
613+ "paths": {
614+ "/todo/{id}": {
615+ "get": {
616+ "tags": [
617+ "todo"
618+ ],
619+ "parameters": [
620+ {
621+ "required": true,
622+ "schema": {
623+ "type": "string"
624+ },
625+ "in": "path",
626+ "name": "id",
627+ "description": "TodoId param"
628+ }
629+ ],
630+ "responses": {
631+ "200": {
632+ "content": {
633+ "application/json": {
634+ "schema": {
635+ "example": {
636+ "created": 100,
637+ "description": "get milk"
638+ },
639+ "type": "object",
640+ "description": "This is some real Todo right here",
641+ "properties": {
642+ "created": {
643+ "format": "int32",
644+ "type": "integer"
645+ },
646+ "description": {
647+ "type": "string"
648+ }
649+ }
650+ }
651+ }
652+ },
653+ "description": "OK"
654+ }
655+ }
656+ }
657+ }
658+ },
659+ "components": {}
660+}
661+|]
662+
663+petstoreExampleJSON :: Value
664+petstoreExampleJSON = [aesonQQ|
665+{
666+ "openapi": "3.0.0",
667+ "info": {
668+ "version": "1.0.0",
669+ "title": "Swagger Petstore",
670+ "license": {
671+ "name": "MIT"
672+ }
673+ },
674+ "servers": [
675+ {
676+ "url": "http://petstore.swagger.io/v1"
677+ }
678+ ],
679+ "paths": {
680+ "/pets": {
681+ "get": {
682+ "summary": "List all pets",
683+ "operationId": "listPets",
684+ "tags": [
685+ "pets"
686+ ],
687+ "parameters": [
688+ {
689+ "name": "limit",
690+ "in": "query",
691+ "description": "How many items to return at one time (max 100)",
692+ "required": false,
693+ "schema": {
694+ "type": "integer",
695+ "format": "int32"
696+ }
697+ }
698+ ],
699+ "responses": {
700+ "200": {
701+ "description": "A paged array of pets",
702+ "headers": {
703+ "x-next": {
704+ "description": "A link to the next page of responses",
705+ "schema": {
706+ "type": "string"
707+ }
708+ }
709+ },
710+ "content": {
711+ "application/json": {
712+ "schema": {
713+ "type": "array",
714+ "items": {
715+ "type": "object",
716+ "required": [
717+ "id",
718+ "name"
719+ ],
720+ "properties": {
721+ "id": {
722+ "type": "integer",
723+ "format": "int64"
724+ },
725+ "name": {
726+ "type": "string"
727+ },
728+ "tag": {
729+ "type": "string"
730+ }
731+ }
732+ }
733+ }
734+ }
735+ }
736+ },
737+ "default": {
738+ "description": "unexpected error",
739+ "content": {
740+ "application/json": {
741+ "schema": {
742+ "type": "object",
743+ "required": [
744+ "code",
745+ "message"
746+ ],
747+ "properties": {
748+ "code": {
749+ "type": "integer",
750+ "format": "int32"
751+ },
752+ "message": {
753+ "type": "string"
754+ }
755+ }
756+ }
757+ }
758+ }
759+ }
760+ }
761+ },
762+ "post": {
763+ "summary": "Create a pet",
764+ "operationId": "createPets",
765+ "tags": [
766+ "pets"
767+ ],
768+ "responses": {
769+ "201": {
770+ "description": "Null response"
771+ },
772+ "default": {
773+ "description": "unexpected error",
774+ "content": {
775+ "application/json": {
776+ "schema": {
777+ "type": "object",
778+ "required": [
779+ "code",
780+ "message"
781+ ],
782+ "properties": {
783+ "code": {
784+ "type": "integer",
785+ "format": "int32"
786+ },
787+ "message": {
788+ "type": "string"
789+ }
790+ }
791+ }
792+ }
793+ }
794+ }
795+ }
796+ }
797+ },
798+ "/pets/{petId}": {
799+ "get": {
800+ "summary": "Info for a specific pet",
801+ "operationId": "showPetById",
802+ "tags": [
803+ "pets"
804+ ],
805+ "parameters": [
806+ {
807+ "name": "petId",
808+ "in": "path",
809+ "required": true,
810+ "description": "The id of the pet to retrieve",
811+ "schema": {
812+ "type": "string"
813+ }
814+ }
815+ ],
816+ "responses": {
817+ "200": {
818+ "description": "Expected response to a valid request",
819+ "content": {
820+ "application/json": {
821+ "schema": {
822+ "type": "object",
823+ "required": [
824+ "id",
825+ "name"
826+ ],
827+ "properties": {
828+ "id": {
829+ "type": "integer",
830+ "format": "int64"
831+ },
832+ "name": {
833+ "type": "string"
834+ },
835+ "tag": {
836+ "type": "string"
837+ }
838+ }
839+ }
840+ }
841+ }
842+ },
843+ "default": {
844+ "description": "unexpected error",
845+ "content": {
846+ "application/json": {
847+ "schema": {
848+ "type": "object",
849+ "required": [
850+ "code",
851+ "message"
852+ ],
853+ "properties": {
854+ "code": {
855+ "type": "integer",
856+ "format": "int32"
857+ },
858+ "message": {
859+ "type": "string"
860+ }
861+ }
862+ }
863+ }
864+ }
865+ }
866+ }
867+ }
868+ }
869+ },
870+ "components": {
871+ "schemas": {
872+ "Pet": {
873+ "type": "object",
874+ "required": [
875+ "id",
876+ "name"
877+ ],
878+ "properties": {
879+ "id": {
880+ "type": "integer",
881+ "format": "int64"
882+ },
883+ "name": {
884+ "type": "string"
885+ },
886+ "tag": {
887+ "type": "string"
888+ }
889+ }
890+ },
891+ "Pets": {
892+ "type": "array",
893+ "items": {
894+ "type": "object",
895+ "required": [
896+ "id",
897+ "name"
898+ ],
899+ "properties": {
900+ "id": {
901+ "type": "integer",
902+ "format": "int64"
903+ },
904+ "name": {
905+ "type": "string"
906+ },
907+ "tag": {
908+ "type": "string"
909+ }
910+ }
911+ }
912+ },
913+ "Error": {
914+ "type": "object",
915+ "required": [
916+ "code",
917+ "message"
918+ ],
919+ "properties": {
920+ "code": {
921+ "type": "integer",
922+ "format": "int32"
923+ },
924+ "message": {
925+ "type": "string"
926+ }
927+ }
928+ }
929+ }
930+ }
931+}
932+|]
933+
934+compositionSchemaExample :: Schema
935+compositionSchemaExample = mempty
936+ & type_ ?~ OpenApiObject
937+ & Data.OpenApi.allOf ?~ [
938+ Ref (Reference "Other")
939+ , Inline (mempty
940+ & type_ ?~ OpenApiObject
941+ & properties .~
942+ [ ("greet", Inline $ mempty
943+ & type_ ?~ OpenApiString) ])
944+ ]
945+
946+compositionSchemaExampleJSON :: Value
947+compositionSchemaExampleJSON = [aesonQQ|
948+{
949+ "type": "object",
950+ "allOf": [
951+ {
952+ "$ref": "#/components/schemas/Other"
953+ },
954+ {
955+ "type": "object",
956+ "properties": {
957+ "greet": { "type": "string" }
958+ }
959+ }
960+ ]
961+}
962+|]
test/Data/SwaggerSpec.hsdeleted−1702
@@ -1,1702 +0,0 @@
1−{-# LANGUAGE OverloadedLists #-}
2−{-# LANGUAGE OverloadedStrings #-}
3−{-# LANGUAGE ScopedTypeVariables #-}
4−{-# LANGUAGE QuasiQuotes #-}
5−module Data.SwaggerSpec where
6−
7−import Prelude ()
8−import Prelude.Compat
9−
10−import Control.Lens
11−
12−import Data.Aeson
13−import Data.Aeson.QQ.Simple
14−import Data.HashMap.Strict (HashMap)
15−import qualified Data.HashSet.InsOrd as InsOrdHS
16−import Data.Text (Text)
17−
18−import Data.Swagger
19−import SpecCommon
20−import Test.Hspec hiding (example)
21−
22−spec :: Spec
23−spec = do
24− describe "host" $ do
25− it "can decode the host port" $ do
26− let h = Just $ Host "localhost" (Just (fromInteger 8000))
27− swagger :: Swagger
28− swagger = swaggerExample
29− & host .~ h
30− parsed :: Swagger = either error id $ eitherDecode' $ encode swagger
31− parsed ^. host `shouldBe` h
32− describe "License Object" $ licenseExample <=> licenseExampleJSON
33− describe "Contact Object" $ contactExample <=> contactExampleJSON
34− describe "Info Object" $ infoExample <=> infoExampleJSON
35− describe "Operation Object" $ operationExample <=> operationExampleJSON
36− describe "Schema Object" $ do
37− context "Primitive Sample" $ schemaPrimitiveExample <=> schemaPrimitiveExampleJSON
38− context "Simple Model" $ schemaSimpleModelExample <=> schemaSimpleModelExampleJSON
39− context "Model with Map/Dictionary Properties" $ schemaModelDictExample <=> schemaModelDictExampleJSON
40− context "Model with Arbitrary Properties" $ schemaAdditionalExample <=> schemaAdditionalExampleJSON
41− context "Model with Example" $ schemaWithExampleExample <=> schemaWithExampleExampleJSON
42− describe "Definitions Object" $ definitionsExample <=> definitionsExampleJSON
43− describe "Parameters Definition Object" $ paramsDefinitionExample <=> paramsDefinitionExampleJSON
44− describe "Responses Definition Object" $ responsesDefinitionExample <=> responsesDefinitionExampleJSON
45− describe "Security Definitions Object" $ securityDefinitionsExample <=> securityDefinitionsExampleJSON
46− describe "OAuth2 Security Definitions with merged Scope" $ oAuth2SecurityDefinitionsExample <=> oAuth2SecurityDefinitionsExampleJSON
47− describe "Composition Schema Example" $ compositionSchemaExample <=> compositionSchemaExampleJSON
48− describe "Swagger Object" $ do
49− context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
50− context "PetStore Example" $
51− it "decodes successfully" $ do
52− fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: Swagger) -> True; _ -> False)
53−
54−main :: IO ()
55−main = hspec spec
56−
57−-- =======================================================================
58−-- Info object
59−-- =======================================================================
60−
61−infoExample :: Info
62−infoExample = mempty
63− & title .~ "Swagger Sample App"
64− & description ?~ "This is a sample server Petstore server."
65− & termsOfService ?~ "http://swagger.io/terms/"
66− & contact ?~ contactExample
67− & license ?~ licenseExample
68− & version .~ "1.0.1"
69−
70−infoExampleJSON :: Value
71−infoExampleJSON = [aesonQQ|
72−{
73− "title": "Swagger Sample App",
74− "description": "This is a sample server Petstore server.",
75− "termsOfService": "http://swagger.io/terms/",
76− "contact": {
77− "name": "API Support",
78− "url": "http://www.swagger.io/support",
79− "email": "support@swagger.io"
80− },
81− "license": {
82− "name": "Apache 2.0",
83− "url": "http://www.apache.org/licenses/LICENSE-2.0.html"
84− },
85− "version": "1.0.1"
86−}
87−|]
88−
89−-- =======================================================================
90−-- Contact object
91−-- =======================================================================
92−
93−contactExample :: Contact
94−contactExample = mempty
95− & name ?~ "API Support"
96− & url ?~ URL "http://www.swagger.io/support"
97− & email ?~ "support@swagger.io"
98−
99−contactExampleJSON :: Value
100−contactExampleJSON = [aesonQQ|
101−{
102− "name": "API Support",
103− "url": "http://www.swagger.io/support",
104− "email": "support@swagger.io"
105−}
106−|]
107−
108−-- =======================================================================
109−-- License object
110−-- =======================================================================
111−
112−licenseExample :: License
113−licenseExample = "Apache 2.0"
114− & url ?~ URL "http://www.apache.org/licenses/LICENSE-2.0.html"
115−
116−licenseExampleJSON :: Value
117−licenseExampleJSON = [aesonQQ|
118−{
119− "name": "Apache 2.0",
120− "url": "http://www.apache.org/licenses/LICENSE-2.0.html"
121−}
122−|]
123−
124−
125−-- =======================================================================
126−-- Operation object
127−-- =======================================================================
128−
129−operationExample :: Operation
130−operationExample = mempty
131− & tags .~ InsOrdHS.fromList ["pet"]
132− & summary ?~ "Updates a pet in the store with form data"
133− & description ?~ ""
134− & operationId ?~ "updatePetWithForm"
135− & consumes ?~ MimeList ["application/x-www-form-urlencoded"]
136− & produces ?~ MimeList ["application/json", "application/xml"]
137− & parameters .~ map Inline
138− [ mempty
139− & name .~ "petId"
140− & description ?~ "ID of pet that needs to be updated"
141− & required ?~ True
142− & schema .~ ParamOther (stringSchema ParamPath)
143− , mempty
144− & name .~ "name"
145− & description ?~ "Updated name of the pet"
146− & required ?~ False
147− & schema .~ ParamOther (stringSchema ParamFormData)
148− , mempty
149− & name .~ "status"
150− & description ?~ "Updated status of the pet"
151− & required ?~ False
152− & schema .~ ParamOther (stringSchema ParamFormData)
153− ]
154−
155− & at 200 ?~ "Pet updated."
156− & at 405 ?~ "Invalid input"
157− & security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]
158− where
159− stringSchema :: ParamLocation -> ParamOtherSchema
160− stringSchema loc = mempty
161− & in_ .~ loc
162− & type_ ?~ SwaggerString
163−
164−operationExampleJSON :: Value
165−operationExampleJSON = [aesonQQ|
166−{
167− "tags": [
168− "pet"
169− ],
170− "summary": "Updates a pet in the store with form data",
171− "description": "",
172− "operationId": "updatePetWithForm",
173− "consumes": [
174− "application/x-www-form-urlencoded"
175− ],
176− "produces": [
177− "application/json",
178− "application/xml"
179− ],
180− "parameters": [
181− {
182− "name": "petId",
183− "in": "path",
184− "description": "ID of pet that needs to be updated",
185− "required": true,
186− "type": "string"
187− },
188− {
189− "name": "name",
190− "in": "formData",
191− "description": "Updated name of the pet",
192− "required": false,
193− "type": "string"
194− },
195− {
196− "name": "status",
197− "in": "formData",
198− "description": "Updated status of the pet",
199− "required": false,
200− "type": "string"
201− }
202− ],
203− "responses": {
204− "200": {
205− "description": "Pet updated."
206− },
207− "405": {
208− "description": "Invalid input"
209− }
210− },
211− "security": [
212− {
213− "petstore_auth": [
214− "write:pets",
215− "read:pets"
216− ]
217− }
218− ]
219−}
220−|]
221−
222−-- =======================================================================
223−-- Schema object
224−-- =======================================================================
225−
226−schemaPrimitiveExample :: Schema
227−schemaPrimitiveExample = mempty
228− & type_ ?~ SwaggerString
229− & format ?~ "email"
230−
231−schemaPrimitiveExampleJSON :: Value
232−schemaPrimitiveExampleJSON = [aesonQQ|
233−{
234− "type": "string",
235− "format": "email"
236−}
237−|]
238−
239−schemaSimpleModelExample :: Schema
240−schemaSimpleModelExample = mempty
241− & type_ ?~ SwaggerObject
242− & required .~ [ "name" ]
243− & properties .~
244− [ ("name", Inline (mempty & type_ ?~ SwaggerString))
245− , ("address", Ref (Reference "Address"))
246− , ("age", Inline $ mempty
247− & minimum_ ?~ 0
248− & type_ ?~ SwaggerInteger
249− & format ?~ "int32" ) ]
250−
251−schemaSimpleModelExampleJSON :: Value
252−schemaSimpleModelExampleJSON = [aesonQQ|
253−{
254− "type": "object",
255− "required": [
256− "name"
257− ],
258− "properties": {
259− "name": {
260− "type": "string"
261− },
262− "address": {
263− "$ref": "#/definitions/Address"
264− },
265− "age": {
266− "type": "integer",
267− "format": "int32",
268− "minimum": 0
269− }
270− }
271−}
272−|]
273−
274−schemaModelDictExample :: Schema
275−schemaModelDictExample = mempty
276− & type_ ?~ SwaggerObject
277− & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ SwaggerString))
278−
279−schemaModelDictExampleJSON :: Value
280−schemaModelDictExampleJSON = [aesonQQ|
281−{
282− "type": "object",
283− "additionalProperties": {
284− "type": "string"
285− }
286−}
287−|]
288−
289−schemaAdditionalExample :: Schema
290−schemaAdditionalExample = mempty
291− & type_ ?~ SwaggerObject
292− & additionalProperties ?~ AdditionalPropertiesAllowed True
293−
294−schemaAdditionalExampleJSON :: Value
295−schemaAdditionalExampleJSON = [aesonQQ|
296−{
297− "type": "object",
298− "additionalProperties": true
299−}
300−|]
301−
302−schemaWithExampleExample :: Schema
303−schemaWithExampleExample = mempty
304− & type_ ?~ SwaggerObject
305− & properties .~
306− [ ("id", Inline $ mempty
307− & type_ ?~ SwaggerInteger
308− & format ?~ "int64" )
309− , ("name", Inline $ mempty
310− & type_ ?~ SwaggerString) ]
311− & required .~ [ "name" ]
312− & example ?~ [aesonQQ|
313− {
314− "name": "Puma",
315− "id": 1
316− }
317− |]
318−
319−schemaWithExampleExampleJSON :: Value
320−schemaWithExampleExampleJSON = [aesonQQ|
321−{
322− "type": "object",
323− "properties": {
324− "id": {
325− "type": "integer",
326− "format": "int64"
327− },
328− "name": {
329− "type": "string"
330− }
331− },
332− "required": [
333− "name"
334− ],
335− "example": {
336− "name": "Puma",
337− "id": 1
338− }
339−}
340−|]
341−
342−-- =======================================================================
343−-- Definitions object
344−-- =======================================================================
345−
346−definitionsExample :: HashMap Text Schema
347−definitionsExample =
348− [ ("Category", mempty
349− & type_ ?~ SwaggerObject
350− & properties .~
351− [ ("id", Inline $ mempty
352− & type_ ?~ SwaggerInteger
353− & format ?~ "int64")
354− , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] )
355− , ("Tag", mempty
356− & type_ ?~ SwaggerObject
357− & properties .~
358− [ ("id", Inline $ mempty
359− & type_ ?~ SwaggerInteger
360− & format ?~ "int64")
361− , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] ) ]
362−
363−definitionsExampleJSON :: Value
364−definitionsExampleJSON = [aesonQQ|
365−{
366− "Category": {
367− "type": "object",
368− "properties": {
369− "id": {
370− "type": "integer",
371− "format": "int64"
372− },
373− "name": {
374− "type": "string"
375− }
376− }
377− },
378− "Tag": {
379− "type": "object",
380− "properties": {
381− "id": {
382− "type": "integer",
383− "format": "int64"
384− },
385− "name": {
386− "type": "string"
387− }
388− }
389− }
390−}
391−|]
392−
393−-- =======================================================================
394−-- Parameters Definition object
395−-- =======================================================================
396−
397−paramsDefinitionExample :: HashMap Text Param
398−paramsDefinitionExample =
399− [ ("skipParam", mempty
400− & name .~ "skip"
401− & description ?~ "number of items to skip"
402− & required ?~ True
403− & schema .~ ParamOther (mempty
404− & in_ .~ ParamQuery
405− & type_ ?~ SwaggerInteger
406− & format ?~ "int32" ))
407− , ("limitParam", mempty
408− & name .~ "limit"
409− & description ?~ "max records to return"
410− & required ?~ True
411− & schema .~ ParamOther (mempty
412− & in_ .~ ParamQuery
413− & type_ ?~ SwaggerInteger
414− & format ?~ "int32" )) ]
415−
416−paramsDefinitionExampleJSON :: Value
417−paramsDefinitionExampleJSON = [aesonQQ|
418−{
419− "skipParam": {
420− "name": "skip",
421− "in": "query",
422− "description": "number of items to skip",
423− "required": true,
424− "type": "integer",
425− "format": "int32"
426− },
427− "limitParam": {
428− "name": "limit",
429− "in": "query",
430− "description": "max records to return",
431− "required": true,
432− "type": "integer",
433− "format": "int32"
434− }
435−}
436−|]
437−
438−-- =======================================================================
439−-- Responses Definition object
440−-- =======================================================================
441−
442−responsesDefinitionExample :: HashMap Text Response
443−responsesDefinitionExample =
444− [ ("NotFound", mempty & description .~ "Entity not found.")
445− , ("IllegalInput", mempty & description .~ "Illegal input for operation.") ]
446−
447−responsesDefinitionExampleJSON :: Value
448−responsesDefinitionExampleJSON = [aesonQQ|
449−{
450− "NotFound": {
451− "description": "Entity not found."
452− },
453− "IllegalInput": {
454− "description": "Illegal input for operation."
455− }
456−}
457−|]
458−
459−-- =======================================================================
460−-- Responses Definition object
461−-- =======================================================================
462−
463−securityDefinitionsExample :: SecurityDefinitions
464−securityDefinitionsExample = SecurityDefinitions
465− [ ("api_key", SecurityScheme
466− { _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "api_key" ApiKeyHeader)
467− , _securitySchemeDescription = Nothing })
468− , ("petstore_auth", SecurityScheme
469− { _securitySchemeType = SecuritySchemeOAuth2 (OAuth2Params
470− { _oauth2Flow = OAuth2Implicit "http://swagger.io/api/oauth/dialog"
471− , _oauth2Scopes =
472− [ ("write:pets", "modify pets in your account")
473− , ("read:pets", "read your pets") ] } )
474− , _securitySchemeDescription = Nothing }) ]
475−
476−securityDefinitionsExampleJSON :: Value
477−securityDefinitionsExampleJSON = [aesonQQ|
478−{
479− "api_key": {
480− "type": "apiKey",
481− "name": "api_key",
482− "in": "header"
483− },
484− "petstore_auth": {
485− "type": "oauth2",
486− "authorizationUrl": "http://swagger.io/api/oauth/dialog",
487− "flow": "implicit",
488− "scopes": {
489− "write:pets": "modify pets in your account",
490− "read:pets": "read your pets"
491− }
492− }
493−}
494−|]
495−
496−oAuth2SecurityDefinitionsReadExample :: SecurityDefinitions
497−oAuth2SecurityDefinitionsReadExample = SecurityDefinitions
498− [ ("petstore_auth", SecurityScheme
499− { _securitySchemeType = SecuritySchemeOAuth2 (OAuth2Params
500− { _oauth2Flow = OAuth2Implicit "http://swagger.io/api/oauth/dialog"
501− , _oauth2Scopes =
502− [ ("read:pets", "read your pets") ] } )
503− , _securitySchemeDescription = Nothing })
504− ]
505−
506−oAuth2SecurityDefinitionsWriteExample :: SecurityDefinitions
507−oAuth2SecurityDefinitionsWriteExample = SecurityDefinitions
508− [ ("petstore_auth", SecurityScheme
509− { _securitySchemeType = SecuritySchemeOAuth2 (OAuth2Params
510− { _oauth2Flow = OAuth2Implicit "http://swagger.io/api/oauth/dialog"
511− , _oauth2Scopes =
512− [ ("write:pets", "modify pets in your account") ] } )
513− , _securitySchemeDescription = Nothing })
514− ]
515−
516−oAuth2SecurityDefinitionsExample :: SecurityDefinitions
517−oAuth2SecurityDefinitionsExample =
518− oAuth2SecurityDefinitionsWriteExample <>
519− oAuth2SecurityDefinitionsReadExample
520−
521−oAuth2SecurityDefinitionsExampleJSON :: Value
522−oAuth2SecurityDefinitionsExampleJSON = [aesonQQ|
523−{
524− "petstore_auth": {
525− "type": "oauth2",
526− "authorizationUrl": "http://swagger.io/api/oauth/dialog",
527− "flow": "implicit",
528− "scopes": {
529− "write:pets": "modify pets in your account",
530− "read:pets": "read your pets"
531− }
532− }
533−}
534−|]
535−
536−-- =======================================================================
537−-- Swagger object
538−-- =======================================================================
539−
540−swaggerExample :: Swagger
541−swaggerExample = mempty
542− & basePath ?~ "/"
543− & schemes ?~ [Http]
544− & info .~ (mempty
545− & version .~ "1.0"
546− & title .~ "Todo API"
547− & license ?~ "MIT"
548− & license._Just.url ?~ URL "http://mit.com"
549− & description ?~ "This is a an API that tests servant-swagger support for a Todo API")
550− & paths.at "/todo/{id}" ?~ (mempty & get ?~ ((mempty :: Operation)
551− & at 200 ?~ Inline (mempty
552− & description .~ "OK"
553− & schema ?~ Inline (mempty
554− & type_ ?~ SwaggerObject
555− & example ?~ [aesonQQ|
556− {
557− "created": 100,
558− "description": "get milk"
559− } |]
560− & description ?~ "This is some real Todo right here"
561− & properties .~
562− [ ("created", Inline $ mempty
563− & type_ ?~ SwaggerInteger
564− & format ?~ "int32")
565− , ("description", Inline (mempty & type_ ?~ SwaggerString))]))
566− & produces ?~ MimeList [ "application/json" ]
567− & parameters .~
568− [ Inline $ mempty
569− & required ?~ True
570− & name .~ "id"
571− & description ?~ "TodoId param"
572− & schema .~ ParamOther (mempty
573− & in_ .~ ParamPath
574− & type_ ?~ SwaggerString ) ]
575− & tags .~ InsOrdHS.fromList [ "todo" ] ))
576−
577−swaggerExampleJSON :: Value
578−swaggerExampleJSON = [aesonQQ|
579−{
580− "swagger": "2.0",
581− "basePath": "/",
582− "schemes": [
583− "http"
584− ],
585− "info": {
586− "version": "1.0",
587− "title": "Todo API",
588− "license": {
589− "url": "http://mit.com",
590− "name": "MIT"
591− },
592− "description": "This is a an API that tests servant-swagger support for a Todo API"
593− },
594− "paths": {
595− "/todo/{id}": {
596− "get": {
597− "responses": {
598− "200": {
599− "schema": {
600− "example": {
601− "created": 100,
602− "description": "get milk"
603− },
604− "type": "object",
605− "description": "This is some real Todo right here",
606− "properties": {
607− "created": {
608− "format": "int32",
609− "type": "integer"
610− },
611− "description": {
612− "type": "string"
613− }
614− }
615− },
616− "description": "OK"
617− }
618− },
619− "produces": [
620− "application/json"
621− ],
622− "parameters": [
623− {
624− "required": true,
625− "in": "path",
626− "name": "id",
627− "type": "string",
628− "description": "TodoId param"
629− }
630− ],
631− "tags": [
632− "todo"
633− ]
634− }
635− }
636− }
637−}
638−|]
639−
640−petstoreExampleJSON :: Value
641−petstoreExampleJSON = [aesonQQ|
642−{
643− "swagger":"2.0",
644− "info":{
645− "description":"This is a sample server Petstore server. You can find out more about Swagger at [http://swagger.io](http://swagger.io) or on [irc.freenode.net, #swagger](http://swagger.io/irc/). For this sample, you can use the api key `special-key` to test the authorization filters.",
646− "version":"1.0.0",
647− "title":"Swagger Petstore",
648− "termsOfService":"http://swagger.io/terms/",
649− "contact":{
650− "email":"apiteam@swagger.io"
651− },
652− "license":{
653− "name":"Apache 2.0",
654− "url":"http://www.apache.org/licenses/LICENSE-2.0.html"
655− }
656− },
657− "host":"petstore.swagger.io",
658− "basePath":"/v2",
659− "tags":[
660− {
661− "name":"pet",
662− "description":"Everything about your Pets",
663− "externalDocs":{
664− "description":"Find out more",
665− "url":"http://swagger.io"
666− }
667− },
668− {
669− "name":"store",
670− "description":"Access to Petstore orders"
671− },
672− {
673− "name":"user",
674− "description":"Operations about user",
675− "externalDocs":{
676− "description":"Find out more about our store",
677− "url":"http://swagger.io"
678− }
679− }
680− ],
681− "schemes":[
682− "http"
683− ],
684− "paths":{
685− "/pet":{
686− "post":{
687− "tags":[
688− "pet"
689− ],
690− "summary":"Add a new pet to the store",
691− "description":"",
692− "operationId":"addPet",
693− "consumes":[
694− "application/json",
695− "application/xml"
696− ],
697− "produces":[
698− "application/xml",
699− "application/json"
700− ],
701− "parameters":[
702− {
703− "in":"body",
704− "name":"body",
705− "description":"Pet object that needs to be added to the store",
706− "required":true,
707− "schema":{
708− "$ref":"#/definitions/Pet"
709− }
710− }
711− ],
712− "responses":{
713− "405":{
714− "description":"Invalid input"
715− }
716− },
717− "security":[
718− {
719− "petstore_auth":[
720− "write:pets",
721− "read:pets"
722− ]
723− }
724− ]
725− },
726− "put":{
727− "tags":[
728− "pet"
729− ],
730− "summary":"Update an existing pet",
731− "description":"",
732− "operationId":"updatePet",
733− "consumes":[
734− "application/json",
735− "application/xml"
736− ],
737− "produces":[
738− "application/xml",
739− "application/json"
740− ],
741− "parameters":[
742− {
743− "in":"body",
744− "name":"body",
745− "description":"Pet object that needs to be added to the store",
746− "required":true,
747− "schema":{
748− "$ref":"#/definitions/Pet"
749− }
750− }
751− ],
752− "responses":{
753− "400":{
754− "description":"Invalid ID supplied"
755− },
756− "404":{
757− "description":"Pet not found"
758− },
759− "405":{
760− "description":"Validation exception"
761− }
762− },
763− "security":[
764− {
765− "petstore_auth":[
766− "write:pets",
767− "read:pets"
768− ]
769− }
770− ]
771− }
772− },
773− "/pet/findByStatus":{
774− "get":{
775− "tags":[
776− "pet"
777− ],
778− "summary":"Finds Pets by status",
779− "description":"Multiple status values can be provided with comma seperated strings",
780− "operationId":"findPetsByStatus",
781− "produces":[
782− "application/xml",
783− "application/json"
784− ],
785− "parameters":[
786− {
787− "name":"status",
788− "in":"query",
789− "description":"Status values that need to be considered for filter",
790− "required":true,
791− "type":"array",
792− "items":{
793− "type":"string",
794− "enum":[
795− "available",
796− "pending",
797− "sold"
798− ],
799− "default":"available"
800− },
801− "collectionFormat":"csv"
802− }
803− ],
804− "responses":{
805− "200":{
806− "description":"successful operation",
807− "schema":{
808− "type":"array",
809− "items":{
810− "$ref":"#/definitions/Pet"
811− }
812− }
813− },
814− "400":{
815− "description":"Invalid status value"
816− }
817− },
818− "security":[
819− {
820− "petstore_auth":[
821− "write:pets",
822− "read:pets"
823− ]
824− }
825− ]
826− }
827− },
828− "/pet/findByTags":{
829− "get":{
830− "tags":[
831− "pet"
832− ],
833− "summary":"Finds Pets by tags",
834− "description":"Muliple tags can be provided with comma seperated strings. Use tag1, tag2, tag3 for testing.",
835− "operationId":"findPetsByTags",
836− "produces":[
837− "application/xml",
838− "application/json"
839− ],
840− "parameters":[
841− {
842− "name":"tags",
843− "in":"query",
844− "description":"Tags to filter by",
845− "required":true,
846− "type":"array",
847− "items":{
848− "type":"string"
849− },
850− "collectionFormat":"csv"
851− }
852− ],
853− "responses":{
854− "200":{
855− "description":"successful operation",
856− "schema":{
857− "type":"array",
858− "items":{
859− "$ref":"#/definitions/Pet"
860− }
861− }
862− },
863− "400":{
864− "description":"Invalid tag value"
865− }
866− },
867− "security":[
868− {
869− "petstore_auth":[
870− "write:pets",
871− "read:pets"
872− ]
873− }
874− ]
875− }
876− },
877− "/pet/{petId}":{
878− "get":{
879− "tags":[
880− "pet"
881− ],
882− "summary":"Find pet by ID",
883− "description":"Returns a single pet",
884− "operationId":"getPetById",
885− "produces":[
886− "application/xml",
887− "application/json"
888− ],
889− "parameters":[
890− {
891− "name":"petId",
892− "in":"path",
893− "description":"ID of pet to return",
894− "required":true,
895− "type":"integer",
896− "format":"int64"
897− }
898− ],
899− "responses":{
900− "200":{
901− "description":"successful operation",
902− "schema":{
903− "$ref":"#/definitions/Pet"
904− }
905− },
906− "400":{
907− "description":"Invalid ID supplied"
908− },
909− "404":{
910− "description":"Pet not found"
911− }
912− },
913− "security":[
914− {
915− "api_key": []
916− }
917− ]
918− },
919− "post":{
920− "tags":[
921− "pet"
922− ],
923− "summary":"Updates a pet in the store with form data",
924− "description":"",
925− "operationId":"updatePetWithForm",
926− "consumes":[
927− "application/x-www-form-urlencoded"
928− ],
929− "produces":[
930− "application/xml",
931− "application/json"
932− ],
933− "parameters":[
934− {
935− "name":"petId",
936− "in":"path",
937− "description":"ID of pet that needs to be updated",
938− "required":true,
939− "type":"integer",
940− "format":"int64"
941− },
942− {
943− "name":"name",
944− "in":"formData",
945− "description":"Updated name of the pet",
946− "required":false,
947− "type":"string"
948− },
949− {
950− "name":"status",
951− "in":"formData",
952− "description":"Updated status of the pet",
953− "required":false,
954− "type":"string"
955− }
956− ],
957− "responses":{
958− "405":{
959− "description":"Invalid input"
960− }
961− },
962− "security":[
963− {
964− "petstore_auth":[
965− "write:pets",
966− "read:pets"
967− ]
968− }
969− ]
970− },
971− "delete":{
972− "tags":[
973− "pet"
974− ],
975− "summary":"Deletes a pet",
976− "description":"",
977− "operationId":"deletePet",
978− "produces":[
979− "application/xml",
980− "application/json"
981− ],
982− "parameters":[
983− {
984− "name":"api_key",
985− "in":"header",
986− "required":false,
987− "type":"string"
988− },
989− {
990− "name":"petId",
991− "in":"path",
992− "description":"Pet id to delete",
993− "required":true,
994− "type":"integer",
995− "format":"int64"
996− }
997− ],
998− "responses":{
999− "400":{
1000− "description":"Invalid pet value"
1001− }
1002− },
1003− "security":[
1004− {
1005− "petstore_auth":[
1006− "write:pets",
1007− "read:pets"
1008− ]
1009− }
1010− ]
1011− }
1012− },
1013− "/pet/{petId}/uploadImage":{
1014− "post":{
1015− "tags":[
1016− "pet"
1017− ],
1018− "summary":"uploads an image",
1019− "description":"",
1020− "operationId":"uploadFile",
1021− "consumes":[
1022− "multipart/form-data"
1023− ],
1024− "produces":[
1025− "application/json"
1026− ],
1027− "parameters":[
1028− {
1029− "name":"petId",
1030− "in":"path",
1031− "description":"ID of pet to update",
1032− "required":true,
1033− "type":"integer",
1034− "format":"int64"
1035− },
1036− {
1037− "name":"additionalMetadata",
1038− "in":"formData",
1039− "description":"Additional data to pass to server",
1040− "required":false,
1041− "type":"string"
1042− },
1043− {
1044− "name":"file",
1045− "in":"formData",
1046− "description":"file to upload",
1047− "required":false,
1048− "type":"file"
1049− }
1050− ],
1051− "responses":{
1052− "200":{
1053− "description":"successful operation",
1054− "schema":{
1055− "$ref":"#/definitions/ApiResponse"
1056− }
1057− }
1058− },
1059− "security":[
1060− {
1061− "petstore_auth":[
1062− "write:pets",
1063− "read:pets"
1064− ]
1065− }
1066− ]
1067− }
1068− },
1069− "/store/inventory":{
1070− "get":{
1071− "tags":[
1072− "store"
1073− ],
1074− "summary":"Returns pet inventories by status",
1075− "description":"Returns a map of status codes to quantities",
1076− "operationId":"getInventory",
1077− "produces":[
1078− "application/json"
1079− ],
1080− "parameters": [],
1081− "responses":{
1082− "200":{
1083− "description":"successful operation",
1084− "schema":{
1085− "type":"object",
1086− "additionalProperties":{
1087− "type":"integer",
1088− "format":"int32"
1089− }
1090− }
1091− }
1092− },
1093− "security":[
1094− {
1095− "api_key": []
1096− }
1097− ]
1098− }
1099− },
1100− "/store/order":{
1101− "post":{
1102− "tags":[
1103− "store"
1104− ],
1105− "summary":"Place an order for a pet",
1106− "description":"",
1107− "operationId":"placeOrder",
1108− "produces":[
1109− "application/xml",
1110− "application/json"
1111− ],
1112− "parameters":[
1113− {
1114− "in":"body",
1115− "name":"body",
1116− "description":"order placed for purchasing the pet",
1117− "required":true,
1118− "schema":{
1119− "$ref":"#/definitions/Order"
1120− }
1121− }
1122− ],
1123− "responses":{
1124− "200":{
1125− "description":"successful operation",
1126− "schema":{
1127− "$ref":"#/definitions/Order"
1128− }
1129− },
1130− "400":{
1131− "description":"Invalid Order"
1132− }
1133− }
1134− }
1135− },
1136− "/store/order/{orderId}":{
1137− "get":{
1138− "tags":[
1139− "store"
1140− ],
1141− "summary":"Find purchase order by ID",
1142− "description":"For valid response try integer IDs with value <= 5 or > 10. Other values will generated exceptions",
1143− "operationId":"getOrderById",
1144− "produces":[
1145− "application/xml",
1146− "application/json"
1147− ],
1148− "parameters":[
1149− {
1150− "name":"orderId",
1151− "in":"path",
1152− "description":"ID of pet that needs to be fetched",
1153− "required":true,
1154− "type":"integer",
1155− "maximum":5.0,
1156− "minimum":1.0,
1157− "format":"int64"
1158− }
1159− ],
1160− "responses":{
1161− "200":{
1162− "description":"successful operation",
1163− "schema":{
1164− "$ref":"#/definitions/Order"
1165− }
1166− },
1167− "400":{
1168− "description":"Invalid ID supplied"
1169− },
1170− "404":{
1171− "description":"Order not found"
1172− }
1173− }
1174− },
1175− "delete":{
1176− "tags":[
1177− "store"
1178− ],
1179− "summary":"Delete purchase order by ID",
1180− "description":"For valid response try integer IDs with value < 1000. Anything above 1000 or nonintegers will generate API errors",
1181− "operationId":"deleteOrder",
1182− "produces":[
1183− "application/xml",
1184− "application/json"
1185− ],
1186− "parameters":[
1187− {
1188− "name":"orderId",
1189− "in":"path",
1190− "description":"ID of the order that needs to be deleted",
1191− "required":true,
1192− "type":"string",
1193− "minimum":1.0
1194− }
1195− ],
1196− "responses":{
1197− "400":{
1198− "description":"Invalid ID supplied"
1199− },
1200− "404":{
1201− "description":"Order not found"
1202− }
1203− }
1204− }
1205− },
1206− "/user":{
1207− "post":{
1208− "tags":[
1209− "user"
1210− ],
1211− "summary":"Create user",
1212− "description":"This can only be done by the logged in user.",
1213− "operationId":"createUser",
1214− "produces":[
1215− "application/xml",
1216− "application/json"
1217− ],
1218− "parameters":[
1219− {
1220− "in":"body",
1221− "name":"body",
1222− "description":"Created user object",
1223− "required":true,
1224− "schema":{
1225− "$ref":"#/definitions/User"
1226− }
1227− }
1228− ],
1229− "responses":{
1230− "default":{
1231− "description":"successful operation"
1232− }
1233− }
1234− }
1235− },
1236− "/user/createWithArray":{
1237− "post":{
1238− "tags":[
1239− "user"
1240− ],
1241− "summary":"Creates list of users with given input array",
1242− "description":"",
1243− "operationId":"createUsersWithArrayInput",
1244− "produces":[
1245− "application/xml",
1246− "application/json"
1247− ],
1248− "parameters":[
1249− {
1250− "in":"body",
1251− "name":"body",
1252− "description":"List of user object",
1253− "required":true,
1254− "schema":{
1255− "type":"array",
1256− "items":{
1257− "$ref":"#/definitions/User"
1258− }
1259− }
1260− }
1261− ],
1262− "responses":{
1263− "default":{
1264− "description":"successful operation"
1265− }
1266− }
1267− }
1268− },
1269− "/user/createWithList":{
1270− "post":{
1271− "tags":[
1272− "user"
1273− ],
1274− "summary":"Creates list of users with given input array",
1275− "description":"",
1276− "operationId":"createUsersWithListInput",
1277− "produces":[
1278− "application/xml",
1279− "application/json"
1280− ],
1281− "parameters":[
1282− {
1283− "in":"body",
1284− "name":"body",
1285− "description":"List of user object",
1286− "required":true,
1287− "schema":{
1288− "type":"array",
1289− "items":{
1290− "$ref":"#/definitions/User"
1291− }
1292− }
1293− }
1294− ],
1295− "responses":{
1296− "default":{
1297− "description":"successful operation"
1298− }
1299− }
1300− }
1301− },
1302− "/user/login":{
1303− "get":{
1304− "tags":[
1305− "user"
1306− ],
1307− "summary":"Logs user into the system",
1308− "description":"",
1309− "operationId":"loginUser",
1310− "produces":[
1311− "application/xml",
1312− "application/json"
1313− ],
1314− "parameters":[
1315− {
1316− "name":"username",
1317− "in":"query",
1318− "description":"The user name for login",
1319− "required":true,
1320− "type":"string"
1321− },
1322− {
1323− "name":"password",
1324− "in":"query",
1325− "description":"The password for login in clear text",
1326− "required":true,
1327− "type":"string"
1328− }
1329− ],
1330− "responses":{
1331− "200":{
1332− "description":"successful operation",
1333− "schema":{
1334− "type":"string"
1335− },
1336− "headers":{
1337− "X-Rate-Limit":{
1338− "type":"integer",
1339− "format":"int32",
1340− "description":"calls per hour allowed by the user"
1341− },
1342− "X-Expires-After":{
1343− "type":"string",
1344− "format":"date-time",
1345− "description":"date in UTC when toekn expires"
1346− }
1347− }
1348− },
1349− "400":{
1350− "description":"Invalid username/password supplied"
1351− }
1352− }
1353− }
1354− },
1355− "/user/logout":{
1356− "get":{
1357− "tags":[
1358− "user"
1359− ],
1360− "summary":"Logs out current logged in user session",
1361− "description":"",
1362− "operationId":"logoutUser",
1363− "produces":[
1364− "application/xml",
1365− "application/json"
1366− ],
1367− "parameters": [],
1368− "responses":{
1369− "default":{
1370− "description":"successful operation"
1371− }
1372− }
1373− }
1374− },
1375− "/user/{username}":{
1376− "get":{
1377− "tags":[
1378− "user"
1379− ],
1380− "summary":"Get user by user name",
1381− "description":"",
1382− "operationId":"getUserByName",
1383− "produces":[
1384− "application/xml",
1385− "application/json"
1386− ],
1387− "parameters":[
1388− {
1389− "name":"username",
1390− "in":"path",
1391− "description":"The name that needs to be fetched. Use user1 for testing. ",
1392− "required":true,
1393− "type":"string"
1394− }
1395− ],
1396− "responses":{
1397− "200":{
1398− "description":"successful operation",
1399− "schema":{
1400− "$ref":"#/definitions/User"
1401− }
1402− },
1403− "400":{
1404− "description":"Invalid username supplied"
1405− },
1406− "404":{
1407− "description":"User not found"
1408− }
1409− }
1410− },
1411− "put":{
1412− "tags":[
1413− "user"
1414− ],
1415− "summary":"Updated user",
1416− "description":"This can only be done by the logged in user.",
1417− "operationId":"updateUser",
1418− "produces":[
1419− "application/xml",
1420− "application/json"
1421− ],
1422− "parameters":[
1423− {
1424− "name":"username",
1425− "in":"path",
1426− "description":"name that need to be deleted",
1427− "required":true,
1428− "type":"string"
1429− },
1430− {
1431− "in":"body",
1432− "name":"body",
1433− "description":"Updated user object",
1434− "required":true,
1435− "schema":{
1436− "$ref":"#/definitions/User"
1437− }
1438− }
1439− ],
1440− "responses":{
1441− "400":{
1442− "description":"Invalid user supplied"
1443− },
1444− "404":{
1445− "description":"User not found"
1446− }
1447− }
1448− },
1449− "delete":{
1450− "tags":[
1451− "user"
1452− ],
1453− "summary":"Delete user",
1454− "description":"This can only be done by the logged in user.",
1455− "operationId":"deleteUser",
1456− "produces":[
1457− "application/xml",
1458− "application/json"
1459− ],
1460− "parameters":[
1461− {
1462− "name":"username",
1463− "in":"path",
1464− "description":"The name that needs to be deleted",
1465− "required":true,
1466− "type":"string"
1467− }
1468− ],
1469− "responses":{
1470− "400":{
1471− "description":"Invalid username supplied"
1472− },
1473− "404":{
1474− "description":"User not found"
1475− }
1476− }
1477− }
1478− }
1479− },
1480− "securityDefinitions":{
1481− "petstore_auth":{
1482− "type":"oauth2",
1483− "authorizationUrl":"http://petstore.swagger.io/api/oauth/dialog",
1484− "flow":"implicit",
1485− "scopes":{
1486− "write:pets":"modify pets in your account",
1487− "read:pets":"read your pets"
1488− }
1489− },
1490− "api_key":{
1491− "type":"apiKey",
1492− "name":"api_key",
1493− "in":"header"
1494− }
1495− },
1496− "definitions":{
1497− "Order":{
1498− "type":"object",
1499− "properties":{
1500− "id":{
1501− "type":"integer",
1502− "format":"int64"
1503− },
1504− "petId":{
1505− "type":"integer",
1506− "format":"int64"
1507− },
1508− "quantity":{
1509− "type":"integer",
1510− "format":"int32"
1511− },
1512− "shipDate":{
1513− "type":"string",
1514− "format":"date-time"
1515− },
1516− "status":{
1517− "type":"string",
1518− "description":"Order Status",
1519− "enum":[
1520− "placed",
1521− "approved",
1522− "delivered"
1523− ]
1524− },
1525− "complete":{
1526− "type":"boolean",
1527− "default":false
1528− }
1529− },
1530− "xml":{
1531− "name":"Order"
1532− }
1533− },
1534− "Category":{
1535− "type":"object",
1536− "properties":{
1537− "id":{
1538− "type":"integer",
1539− "format":"int64"
1540− },
1541− "name":{
1542− "type":"string"
1543− }
1544− },
1545− "xml":{
1546− "name":"Category"
1547− }
1548− },
1549− "User":{
1550− "type":"object",
1551− "properties":{
1552− "id":{
1553− "type":"integer",
1554− "format":"int64"
1555− },
1556− "username":{
1557− "type":"string"
1558− },
1559− "firstName":{
1560− "type":"string"
1561− },
1562− "lastName":{
1563− "type":"string"
1564− },
1565− "email":{
1566− "type":"string"
1567− },
1568− "password":{
1569− "type":"string"
1570− },
1571− "phone":{
1572− "type":"string"
1573− },
1574− "userStatus":{
1575− "type":"integer",
1576− "format":"int32",
1577− "description":"User Status"
1578− }
1579− },
1580− "xml":{
1581− "name":"User"
1582− }
1583− },
1584− "Tag":{
1585− "type":"object",
1586− "properties":{
1587− "id":{
1588− "type":"integer",
1589− "format":"int64"
1590− },
1591− "name":{
1592− "type":"string"
1593− }
1594− },
1595− "xml":{
1596− "name":"Tag"
1597− }
1598− },
1599− "Pet":{
1600− "type":"object",
1601− "required":[
1602− "name",
1603− "photoUrls"
1604− ],
1605− "properties":{
1606− "id":{
1607− "type":"integer",
1608− "format":"int64"
1609− },
1610− "category":{
1611− "$ref":"#/definitions/Category"
1612− },
1613− "name":{
1614− "type":"string",
1615− "example":"doggie"
1616− },
1617− "photoUrls":{
1618− "type":"array",
1619− "xml":{
1620− "name":"photoUrl",
1621− "wrapped":true
1622− },
1623− "items":{
1624− "type":"string"
1625− }
1626− },
1627− "tags":{
1628− "type":"array",
1629− "xml":{
1630− "name":"tag",
1631− "wrapped":true
1632− },
1633− "items":{
1634− "$ref":"#/definitions/Tag"
1635− }
1636− },
1637− "status":{
1638− "type":"string",
1639− "description":"pet status in the store",
1640− "enum":[
1641− "available",
1642− "pending",
1643− "sold"
1644− ]
1645− }
1646− },
1647− "xml":{
1648− "name":"Pet"
1649− }
1650− },
1651− "ApiResponse":{
1652− "type":"object",
1653− "properties":{
1654− "code":{
1655− "type":"integer",
1656− "format":"int32"
1657− },
1658− "type":{
1659− "type":"string"
1660− },
1661− "message":{
1662− "type":"string"
1663− }
1664− }
1665− }
1666− },
1667− "externalDocs":{
1668− "description":"Find out more about Swagger",
1669− "url":"http://swagger.io"
1670− }
1671−}
1672−|]
1673−
1674−compositionSchemaExample :: Schema
1675−compositionSchemaExample = mempty
1676− & type_ ?~ SwaggerObject
1677− & Data.Swagger.allOf ?~ [
1678− Ref (Reference "Other")
1679− , Inline (mempty
1680− & type_ ?~ SwaggerObject
1681− & properties .~
1682− [ ("greet", Inline $ mempty
1683− & type_ ?~ SwaggerString) ])
1684− ]
1685−
1686−compositionSchemaExampleJSON :: Value
1687−compositionSchemaExampleJSON = [aesonQQ|
1688−{
1689− "type": "object",
1690− "allOf": [
1691− {
1692− "$ref": "#/definitions/Other"
1693− },
1694− {
1695− "type": "object",
1696− "properties": {
1697− "greet": { "type": "string" }
1698− }
1699− }
1700− ]
1701−}
1702−|]
test/SpecCommon.hs+1−9
@@ -8,15 +8,7 @@ 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−
19−(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a) => a -> Value -> Spec
11+(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec
2012x <=> js = do
2113 it "encodes correctly" $ do
2214 toJSON x `shouldBe` js