git.iko.soy/typeable/openapi3
on 1081581 help sign in
41 files changed+5065−5292
since splitsnapshots
unifiedsplit
.ghci+2 .github/workflows/haskell-ci.yml−243 .travis.yml+162 CHANGELOG.md−62 README.md+11−13 cabal.haskell-ci−11 cabal.project−2 examples/hackage.hs+20−16 include/overlapping-compat.h+8 openapi3.cabal−160 src/Data/OpenApi/Aeson/Compat.hs−76 src/Data/OpenApi/Internal.hs−1619 src/Data/OpenApi/Lens.hs−166 src/Data/OpenApi/Optics.hs−328 src/Data/OpenApi.hs → src/Data/Swagger.hs+118−196 src/Data/OpenApi/Declare.hs → src/Data/Swagger/Declare.hs+9−5 src/Data/Swagger/Internal.hs+1427 src/Data/OpenApi/Internal/AesonUtils.hs → src/Data/Swagger/Internal/AesonUtils.hs+45−12 src/Data/OpenApi/Internal/ParamSchema.hs → src/Data/Swagger/Internal/ParamSchema.hs+67−84 src/Data/OpenApi/Internal/Schema.hs → src/Data/Swagger/Internal/Schema.hs+211−455 src/Data/OpenApi/Internal/Schema/Validation.hs → src/Data/Swagger/Internal/Schema/Validation.hs+101−126 src/Data/OpenApi/Internal/TypeShape.hs → src/Data/Swagger/Internal/TypeShape.hs+11−1 src/Data/OpenApi/Internal/Utils.hs → src/Data/Swagger/Internal/Utils.hs+1−7 src/Data/Swagger/Lens.hs+186 src/Data/OpenApi/Operation.hs → src/Data/Swagger/Operation.hs+36−148 src/Data/Swagger/Optics.hs+597 src/Data/OpenApi/ParamSchema.hs → src/Data/Swagger/ParamSchema.hs+7−7 src/Data/OpenApi/Schema.hs → src/Data/Swagger/Schema.hs+13−4 src/Data/OpenApi/Schema/Generator.hs → src/Data/Swagger/Schema/Generator.hs+20−23 src/Data/OpenApi/Schema/Validation.hs → src/Data/Swagger/Schema/Validation.hs+7−7 src/Data/OpenApi/SchemaOptions.hs → src/Data/Swagger/SchemaOptions.hs+3−7 stack.yaml+5−5 swagger2.cabal+154 test/Data/OpenApiSpec.hs−962 test/Data/OpenApi/CommonTestTypes.hs → test/Data/Swagger/CommonTestTypes.hs+101−464 test/Data/OpenApi/ParamSchemaSpec.hs → test/Data/Swagger/ParamSchemaSpec.hs+5−4 test/Data/OpenApi/Schema/GeneratorSpec.hs → test/Data/Swagger/Schema/GeneratorSpec.hs+7−7 test/Data/OpenApi/Schema/ValidationSpec.hs → test/Data/Swagger/Schema/ValidationSpec.hs+9−55 test/Data/OpenApi/SchemaSpec.hs → test/Data/Swagger/SchemaSpec.hs+11−16 test/Data/SwaggerSpec.hs+1702 test/SpecCommon.hs+9−1
.ghcinew file+2
@@ -0,0 +1,2 @@
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.ymldeleted−243
@@ -1,243 +0,0 @@
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.ymlnew file+162
@@ -0,0 +1,162 @@
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,65 +1,3 @@
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−
6312.5
642---
653
README.md+11−13
@@ -1,22 +1,21 @@
1−# OpenApi 3
1+# swagger2
22
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)
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)
74
8−OpenAPI 3.0 data model.
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)
99
10−The original OpenAPI 3.0 specification is available at http://swagger.io/specification/.
10+Swagger 2.0 data model.
1111
12−This package is heavily based on excellent work on Swagger 2.0 at
13−https://github.com/GetShopTV/swagger2.
12+The original Swagger 2.0 specification is available at http://swagger.io/specification/.
1413
1514## Usage
1615
17−This library is intended to be used for decoding and encoding OpenApi 3.0.3 specifications as well as manipulating them.
16+This library is intended to be used for decoding and encoding Swagger 2.0 API specifications as well as manipulating them.
1817
19−Please refer to [haddock documentation](http://hackage.haskell.org/package/openapi3).
18+Please refer to [haddock documentation](http://hackage.haskell.org/package/swagger2).
2019
2120Some examples can be found in [`examples/` directory](/examples).
2221
@@ -34,8 +33,7 @@ Many Swagger tools, including server and client code generation for many languag
3433
3534We are happy to receive bug reports, fixes, documentation enhancements, and other improvements.
3635
37−Please report bugs via the [github issue tracker](https://github.com/biocad/openapi3/issues).
36+Please report bugs via the [github issue tracker](https://github.com/GetShopTV/swagger2/issues).
3837
3938*GetShopTV Team*
4039
41−*Biocad Team*
cabal.haskell-cideleted−11
@@ -1,11 +0,0 @@
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,4 +1,2 @@
11packages: .
22tests: true
3−
4−allow-newer: http-media:base
examples/hackage.hs+20−16
@@ -10,10 +10,10 @@ import Data.Proxy
1010import Data.Text (Text)
1111import GHC.Generics
1212
13−import Data.OpenApi
14−import Data.OpenApi.Declare
15−import Data.OpenApi.Lens
16−import Data.OpenApi.Operation
13+import Data.Swagger
14+import Data.Swagger.Declare
15+import Data.Swagger.Lens
16+import Data.Swagger.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_ ?~ OpenApiObject
30+ & type_ ?~ SwaggerObject
3131 & properties .~
3232 [ ("summaryUsername", usernameSchema )
3333 , ("summaryUserid" , useridSchema )
@@ -47,36 +47,40 @@ data UserDetailed = UserDetailed
4747newtype Package = Package { packageName :: Text }
4848 deriving (Generic, ToSchema)
4949
50−hackageOpenApi :: OpenApi
51−hackageOpenApi = spec & components.schemas .~ defs
50+hackageSwagger :: Swagger
51+hackageSwagger = spec & definitions .~ defs
5252 where
53− (defs, spec) = runDeclare declareHackageOpenApi mempty
53+ (defs, spec) = runDeclare declareHackageSwagger mempty
5454
55−declareHackageOpenApi :: Declare (Definitions Schema) OpenApi
56−declareHackageOpenApi = do
55+declareHackageSwagger :: Declare (Definitions Schema) Swagger
56+declareHackageSwagger = do
5757 -- param schemas
5858 let usernameParamSchema = toParamSchema (Proxy :: Proxy Username)
5959
6060 -- responses
61− userSummaryResponse <- declareResponse "application/json" (Proxy :: Proxy UserSummary)
62− userDetailedResponse <- declareResponse "application/json" (Proxy :: Proxy UserDetailed)
63− packagesResponse <- declareResponse "application/json" (Proxy :: Proxy [Package])
61+ userSummaryResponse <- declareResponse (Proxy :: Proxy UserSummary)
62+ userDetailedResponse <- declareResponse (Proxy :: Proxy UserDetailed)
63+ packagesResponse <- declareResponse (Proxy :: Proxy [Package])
6464
6565 return $ mempty
6666 & paths .~
6767 [ ("/users", mempty & get ?~ (mempty
68+ & produces ?~ MimeList ["application/json"]
6869 & at 200 ?~ Inline userSummaryResponse))
6970 , ("/user/{username}", mempty & get ?~ (mempty
71+ & produces ?~ MimeList ["application/json"]
7072 & parameters .~ [ Inline $ mempty
7173 & name .~ "username"
7274 & required ?~ True
73− & in_ .~ ParamPath
74− & schema ?~ Inline usernameParamSchema ]
75+ & schema .~ ParamOther (mempty
76+ & in_ .~ ParamPath
77+ & paramSchema .~ usernameParamSchema) ]
7578 & at 200 ?~ Inline userDetailedResponse))
7679 , ("/packages", mempty & get ?~ (mempty
80+ & produces ?~ MimeList ["application/json"]
7781 & at 200 ?~ Inline packagesResponse))
7882 ]
7983
8084main :: IO ()
81−main = putStrLn . read . show . encode $ hackageOpenApi
85+main = putStrLn . read . show . encode $ hackageSwagger
8286
include/overlapping-compat.hnew file+8
@@ -0,0 +1,8 @@
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.cabaldeleted−160
@@ -1,160 +0,0 @@
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/OpenApi/Aeson/Compat.hsdeleted−76
@@ -1,76 +0,0 @@
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/OpenApi/Internal.hsdeleted−1619
@@ -1,1619 +0,0 @@
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/OpenApi/Lens.hsdeleted−166
@@ -1,166 +0,0 @@
1−{-# LANGUAGE FlexibleContexts #-}
2−{-# LANGUAGE FlexibleInstances #-}
3−{-# LANGUAGE FunctionalDependencies #-}
4−{-# LANGUAGE GADTs #-}
5−{-# LANGUAGE MultiParamTypeClasses #-}
6−{-# LANGUAGE RankNTypes #-}
7−{-# LANGUAGE TemplateHaskell #-}
8−{-# LANGUAGE TypeFamilies #-}
9−{-# LANGUAGE DataKinds #-}
10−{-# LANGUAGE UndecidableInstances #-}
11−{-# OPTIONS_GHC -fno-warn-orphans #-}
12−-- |
13−-- Module: Data.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/OpenApi/Optics.hsdeleted−328
@@ -1,328 +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.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/OpenApi.hs → src/Data/Swagger.hsrenamed+118−196
@@ -1,5 +1,6 @@
1+{-# LANGUAGE CPP #-}
12-- |
2−-- Module: Data.OpenApi
3+-- Module: Data.Swagger
34-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
45-- Stability: experimental
56--
@@ -9,7 +10,7 @@
910-- These files can then be used by the Swagger-UI project to display the API
1011-- and Swagger-Codegen to generate clients in various languages.
1112-- Additional utilities can also take advantage of the resulting files, such as testing tools.
12−module Data.OpenApi (
13+module Data.Swagger (
1314 -- * How to use this library
1415 -- $howto
1516
@@ -29,18 +30,17 @@ module Data.OpenApi (
2930 -- $validation
3031
3132 -- * Re-exports
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,
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,
3839
3940 -- * Swagger specification
40− OpenApi(..),
41− Server(..),
42− ServerVariable(..),
43− Components(..),
41+ Swagger(..),
42+ Host(..),
43+ Scheme(..),
4444
4545 -- ** Info types
4646 Info(..),
@@ -56,56 +56,48 @@ module Data.OpenApi (
5656 TagName,
5757
5858 -- ** Types and formats
59− OpenApiType(..),
59+ SwaggerType(..),
6060 Format,
6161 Definitions,
62− Style(..),
62+ CollectionFormat(..),
6363
6464 -- ** Parameters
6565 Param(..),
66+ ParamAnySchema(..),
67+ ParamOtherSchema(..),
6668 ParamLocation(..),
6769 ParamName,
6870 Header(..),
6971 HeaderName,
7072 Example(..),
71− RequestBody(..),
72− MediaTypeObject(..),
73− Encoding(..),
7473
7574 -- ** Schemas
75+ ParamSchema(..),
7676 Schema(..),
7777 NamedSchema(..),
78− OpenApiItems(..),
78+ SwaggerItems(..),
7979 Xml(..),
8080 Pattern,
8181 AdditionalProperties(..),
82− Discriminator(..),
8382
8483 -- ** Responses
8584 Responses(..),
8685 Response(..),
8786 HttpStatusCode,
88− Link(..),
89− Callback(..),
9087
9188 -- ** Security
9289 SecurityScheme(..),
9390 SecuritySchemeType(..),
94− HttpSchemeType(..),
95− SecurityDefinitions(..),
9691 SecurityRequirement(..),
92+ SecurityDefinitions(..),
9793
9894 -- *** API key
9995 ApiKeyParams(..),
10096 ApiKeyLocation(..),
10197
10298 -- *** OAuth2
103− OAuth2Flows(..),
99+ OAuth2Params(..),
104100 OAuth2Flow(..),
105− OAuth2ImplicitFlow(..),
106− OAuth2PasswordFlow(..),
107− OAuth2ClientCredentialsFlow(..),
108− OAuth2AuthorizationCodeFlow(..),
109101 AuthorizationURL,
110102 TokenURL,
111103
@@ -121,14 +113,14 @@ module Data.OpenApi (
121113 URL(..),
122114) where
123115
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
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
130122
131−import Data.OpenApi.Internal
123+import Data.Swagger.Internal
132124
133125-- $setup
134126-- >>> import Control.Lens
@@ -136,8 +128,6 @@ import Data.OpenApi.Internal
136128-- >>> import Data.Monoid
137129-- >>> import Data.Proxy
138130-- >>> import GHC.Generics
139−-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
140−-- >>> import Data.OpenApi.Internal.Utils
141131-- >>> :set -XDeriveGeneric
142132-- >>> :set -XOverloadedStrings
143133-- >>> :set -XOverloadedLists
@@ -154,16 +144,8 @@ import Data.OpenApi.Internal
154144--
155145-- In this library you can use @'mempty'@ for a default/empty value. For instance:
156146--
157−-- >>> BSL.putStrLn $ encodePretty (mempty :: OpenApi)
158−-- {
159−-- "components": {},
160−-- "info": {
161−-- "title": "",
162−-- "version": ""
163−-- },
164−-- "openapi": "3.0.0",
165−-- "paths": {}
166−-- }
147+-- >>> encode (mempty :: Swagger)
148+-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"}}"
167149--
168150-- As you can see some spec properties (e.g. @"version"@) are there even when the spec is empty.
169151-- That is because these properties are actually required ones.
@@ -171,87 +153,47 @@ import Data.OpenApi.Internal
171153-- You /should/ always override the default (empty) value for these properties,
172154-- although it is not strictly necessary:
173155--
174−-- >>> BSL.putStrLn $ encodePretty mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
175−-- {
176−-- "title": "Todo API",
177−-- "version": "1.0"
178−-- }
156+-- >>> encode mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
157+-- "{\"version\":\"1.0\",\"title\":\"Todo API\"}"
179158--
180159-- You can merge two values using @'mappend'@ or its infix version @('<>')@:
181160--
182−-- >>> BSL.putStrLn $ encodePretty $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
183−-- {
184−-- "title": "Todo API",
185−-- "version": "1.0"
186−-- }
187−
161+-- >>> encode $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
162+-- "{\"version\":\"1.0\",\"title\":\"Todo API\"}"
188163--
189164-- This can be useful for combining specifications of endpoints into a whole API specification:
190165--
191166-- @
192167-- \-\- /account subAPI specification
193−-- accountAPI :: OpenApi
168+-- accountAPI :: Swagger
194169--
195170-- \-\- /task subAPI specification
196−-- taskAPI :: OpenApi
171+-- taskAPI :: Swagger
197172--
198173-- \-\- while API specification is just a combination
199174-- \-\- of subAPIs' specifications
200−-- api :: OpenApi
175+-- api :: Swagger
201176-- api = accountAPI <> taskAPI
202177-- @
203178
204179-- $lens
205180--
206−-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.OpenApi.Optics".
181+-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.Swagger.Optics".
207182--
208183-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
209184-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses
210185-- make it fairly simple to construct/modify any part of the specification:
211186--
212187-- >>> :{
213−-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
214−-- & components . schemas .~ [ ("User", mempty & type_ ?~ OpenApiString) ]
188+-- encode $ (mempty :: Swagger)
189+-- & definitions .~ [ ("User", mempty & type_ ?~ SwaggerString) ]
215190-- & paths .~
216191-- [ ("/user", mempty & get ?~ (mempty
217−-- & at 200 ?~ ("OK" & _Inline.content.at "application/json" ?~ (mempty & schema ?~ Ref (Reference "User")))
192+-- & produces ?~ MimeList ["application/json"]
193+-- & at 200 ?~ ("OK" & _Inline.schema ?~ Ref (Reference "User"))
218194-- & at 404 ?~ "User info not found")) ]
219195-- :}
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−-- }
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\"}}}"
255197--
256198-- In the snippet above we declare an API with a single path @/user@. This path provides method @GET@
257199-- which produces @application/json@ output. It should respond with code @200@ and body specified
@@ -263,34 +205,30 @@ import Data.OpenApi.Internal
263205-- common field is @'description'@. Many components of a Swagger specification
264206-- can have descriptions, and you can use the same name for them:
265207--
266−-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & description .~ "No content"
267−-- {
268−-- "description": "No content"
269−-- }
208+-- >>> encode $ (mempty :: Response) & description .~ "No content"
209+-- "{\"description\":\"No content\"}"
270210-- >>> :{
271−-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)
272−-- & type_ ?~ OpenApiBoolean
211+-- encode $ (mempty :: Schema)
212+-- & type_ ?~ SwaggerBoolean
273213-- & description ?~ "To be or not to be"
274214-- :}
275−-- {
276−-- "description": "To be or not to be",
277−-- "type": "boolean"
278−-- }
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\"}"
279223--
280224-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
281225-- have direct access to it via @'at' code@. Example:
282226--
283227-- >>> :{
284−-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)
228+-- encode $ (mempty :: Operation)
285229-- & at 404 ?~ "Not found"
286230-- :}
287−-- {
288−-- "responses": {
289−-- "404": {
290−-- "description": "Not found"
291−-- }
292−-- }
293−-- }
231+-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"
294232--
295233-- You might've noticed that @'type_'@ has an extra underscore in its name
296234-- compared to, say, @'description'@ field accessor.
@@ -306,7 +244,7 @@ import Data.OpenApi.Internal
306244-- @'ParamSchema'@ and @'Schema'@ are the two core types for data model specification.
307245--
308246-- @'ParamSchema' t@ specifies all the common properties, available for every data schema.
309−-- The @t@ parameter imposes some restrictions on @type@ and @items@ properties (see @'OpenApiType'@ and @'OpenApiItems'@).
247+-- The @t@ parameter imposes some restrictions on @type@ and @items@ properties (see @'SwaggerType'@ and @'SwaggerItems'@).
310248--
311249-- @'Schema'@ is used for request and response bodies and allows specifying objects
312250-- with properties in addition to what @'ParamSchema'@ provides.
@@ -337,81 +275,65 @@ import Data.OpenApi.Internal
337275-- >>> data Person = Person { name :: String, age :: Integer } deriving Generic
338276-- >>> instance ToJSON Person
339277-- >>> instance ToSchema Person
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−-- }
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+--
415337
416338-- $manipulation
417339-- Sometimes you have to work with an imported or generated @'Swagger'@.
@@ -419,10 +341,10 @@ import Data.OpenApi.Internal
419341-- for a type-level servant API.
420342--
421343-- Lenses and prisms can be used to manipulate such specification to add additional information, tags, extra responses, etc.
422−-- To facilitate common needs, @"Data.OpenApi.Operation"@ module provides useful helpers.
344+-- To facilitate common needs, @"Data.Swagger.Operation"@ module provides useful helpers.
423345
424346-- $validation
425347-- While @'ToParamSchema'@ and @'ToSchema'@ provide means to easily obtain schemas for Haskell types,
426348-- there is no static mechanism to ensure those instances correspond to the @'ToHttpApiData'@ or @'ToJSON'@ instances.
427349--
428−-- @"Data.OpenApi.Schema.Validation"@ addresses @'ToJSON'@/@'ToSchema'@ validation.
350+-- @"Data.Swagger.Schema.Validation"@ addresses @'ToJSON'@/@'ToSchema'@ validation.
src/Data/OpenApi/Declare.hs → src/Data/Swagger/Declare.hsrenamed+9−5
@@ -4,12 +4,12 @@
44{-# LANGUAGE MultiParamTypeClasses #-}
55{-# LANGUAGE UndecidableInstances #-}
66-- |
7−-- Module: Data.OpenApi.Declare
7+-- Module: Data.Swagger.Declare
88-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
99-- Stability: experimental
1010--
1111-- Declare monad transformer and associated functions.
12−module Data.OpenApi.Declare where
12+module Data.Swagger.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 <$> m)
63+ lift m = DeclareT (\_ -> (,) mempty `liftM` 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 <$> f d
106+evalDeclareT (DeclareT f) d = snd `liftM` 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 <$> f d
111+execDeclareT (DeclareT f) d = fst `liftM` f d
112112
113113-- | Evaluate @'DeclareT' d m a@ computation,
114114-- starting with empty output history.
@@ -162,6 +162,10 @@ 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+
165169instance MonadDeclare d m => MonadDeclare d (MaybeT m) where
166170 declare = lift . declare
167171 look = lift look
src/Data/Swagger/Internal.hsnew file+1427
@@ -0,0 +1,1427 @@
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/OpenApi/Internal/AesonUtils.hs → src/Data/Swagger/Internal/AesonUtils.hsrenamed+45−12
@@ -1,15 +1,20 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE DataKinds #-}
23{-# LANGUAGE FlexibleContexts #-}
34{-# LANGUAGE GADTs #-}
45{-# LANGUAGE ScopedTypeVariables #-}
56{-# LANGUAGE ExplicitForAll #-}
67{-# LANGUAGE TemplateHaskell #-}
8+#if __GLASGOW_HASKELL__ >= 800
79{-# LANGUAGE UndecidableSuperClasses #-}
8−module Data.OpenApi.Internal.AesonUtils (
10+#endif
11+module Data.Swagger.Internal.AesonUtils (
912 -- * Generic functions
1013 AesonDefaultValue(..),
1114 sopSwaggerGenericToJSON,
15+#if MIN_VERSION_aeson(0,10,0)
1216 sopSwaggerGenericToEncoding,
17+#endif
1318 sopSwaggerGenericToJSONWithOpts,
1419 sopSwaggerGenericParseJSON,
1520 -- * Options
@@ -27,7 +32,7 @@ import Prelude.Compat
2732import Control.Applicative ((<|>))
2833import Control.Lens (makeLenses, (^.))
2934import Control.Monad (unless)
30−import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), Object, object, (.:), (.:?), (.!=), withObject, Encoding, pairs, (.=), Series)
35+import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), Object, object, (.:), (.:?), (.!=), withObject)
3136import Data.Aeson.Types (Parser, Pair)
3237import Data.Char (toLower, isUpper)
3338import Data.Foldable (traverse_)
@@ -36,11 +41,14 @@ import Data.Text (Text)
3641import Generics.SOP
3742
3843import qualified Data.Text as T
44+import qualified Data.HashMap.Strict as HM
3945import qualified Data.Set as Set
4046import qualified Data.HashMap.Strict.InsOrd as InsOrd
4147import qualified Data.HashSet.InsOrd as InsOrdHS
4248
43−import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)
49+#if MIN_VERSION_aeson(0,10,0)
50+import Data.Aeson (Encoding, pairs, (.=), Series)
51+#endif
4452
4553-------------------------------------------------------------------------------
4654-- SwaggerAesonOptions
@@ -48,7 +56,7 @@ import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)
4856
4957data SwaggerAesonOptions = SwaggerAesonOptions
5058 { _saoPrefix :: String
51− , _saoAdditionalPairs :: [Pair]
59+ , _saoAdditionalPairs :: [(Text, Value)]
5260 , _saoSubObject :: Maybe String
5361 }
5462
@@ -138,7 +146,11 @@ sopSwaggerGenericToJSON'
138146 -> DatatypeInfo '[xs]
139147 -> POP Maybe '[xs]
140148 -> [Pair]
149+#if MIN_VERSION_generics_sop(0,5,0)
141150sopSwaggerGenericToJSON' 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
142154 sopSwaggerGenericToJSON'' opts fields fieldsInfo defs
143155sopSwaggerGenericToJSON' _ _ _ _ = error "sopSwaggerGenericToJSON: unsupported type"
144156
@@ -155,18 +167,21 @@ sopSwaggerGenericToJSON'' (SwaggerAesonOptions prefix _ sub) = go
155167 go Nil Nil Nil = []
156168 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
157169 | Just name' == sub = case json of
158− Object m -> objectToList m ++ rest
170+ Object m -> HM.toList m ++ rest
159171 Null -> rest
160172 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
161173 -- If default value: omit it.
162174 | Just x == def =
163175 rest
164176 | otherwise =
165− (stringToKey name', json) : rest
177+ (T.pack name', json) : rest
166178 where
167179 json = toJSON x
168180 name' = fieldNameModifier name
169181 rest = go xs names defs
182+#if __GLASGOW_HASKELL__ < 800
183+ go _ _ _ = error "not empty"
184+#endif
170185
171186 fieldNameModifier = modifier . drop 1
172187 modifier = lowerFirstUppers . drop (length prefix)
@@ -196,11 +211,11 @@ sopSwaggerGenericParseJSON = withObject "Swagger Record Object" $ \obj ->
196211 proxy = Proxy :: Proxy a
197212 opts = swaggerAesonOptions proxy
198213
199− parseAdditionalField :: Object -> Pair -> Parser ()
214+ parseAdditionalField :: Object -> (Text, Value) -> Parser ()
200215 parseAdditionalField obj (k, v) = do
201216 v' <- obj .: k
202217 unless (v == v') $ fail $
203− "Additonal field don't match for key " ++ keyToString k
218+ "Additonal field don't match for key " ++ T.unpack k
204219 ++ ": " ++ show v
205220 ++ " /= " ++ show v'
206221
@@ -211,7 +226,11 @@ sopSwaggerGenericParseJSON'
211226 -> DatatypeInfo '[xs]
212227 -> POP Maybe '[xs]
213228 -> Parser (SOP I '[xs])
229+#if MIN_VERSION_generics_sop(0,5,0)
214230sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =
231+#else
232+sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =
233+#endif
215234 SOP . Z <$> sopSwaggerGenericParseJSON'' opts obj fieldsInfo defs
216235sopSwaggerGenericParseJSON' _ _ _ _ = error "sopSwaggerGenericParseJSON: unsupported type"
217236
@@ -231,8 +250,8 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
231250 -- Note: we might strip fields of outer structure.
232251 cons <$> (withDef $ parseJSON $ Object obj) <*> rest
233252 | otherwise = case def of
234− Just def' -> cons <$> obj .:? stringToKey name' .!= def' <*> rest
235− Nothing -> cons <$> obj .: stringToKey name' <*> rest
253+ Just def' -> cons <$> obj .:? T.pack name' .!= def' <*> rest
254+ Nothing -> cons <$> obj .: T.pack name' <*> rest
236255 where
237256 cons h t = I h :* t
238257 name' = fieldNameModifier name
@@ -241,6 +260,9 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
241260 withDef = case def of
242261 Just def' -> (<|> pure def')
243262 Nothing -> id
263+#if __GLASGOW_HASKELL__ < 800
264+ go _ _ = error "not empty"
265+#endif
244266
245267 fieldNameModifier = modifier . drop 1
246268 modifier = lowerFirstUppers . drop (length prefix)
@@ -251,6 +273,8 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
251273-- ToEncoding
252274-------------------------------------------------------------------------------
253275
276+#if MIN_VERSION_aeson(0,10,0)
277+
254278sopSwaggerGenericToEncoding
255279 :: forall a xs.
256280 ( HasDatatypeInfo a
@@ -278,7 +302,11 @@ sopSwaggerGenericToEncoding'
278302 -> DatatypeInfo '[xs]
279303 -> POP Maybe '[xs]
280304 -> Series
305+#if MIN_VERSION_generics_sop(0,5,0)
281306sopSwaggerGenericToEncoding' 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
282310 sopSwaggerGenericToEncoding'' opts fields fieldsInfo defs
283311sopSwaggerGenericToEncoding' _ _ _ _ = error "sopSwaggerGenericToEncoding: unsupported type"
284312
@@ -295,19 +323,24 @@ sopSwaggerGenericToEncoding'' (SwaggerAesonOptions prefix _ sub) = go
295323 go Nil Nil Nil = mempty
296324 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
297325 | Just name' == sub = case toJSON x of
298− Object m -> pairsToSeries (objectToList m) <> rest
326+ Object m -> pairsToSeries (HM.toList m) <> rest
299327 Null -> rest
300328 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
301329 -- If default value: omit it.
302330 | Just x == def =
303331 rest
304332 | otherwise =
305− (stringToKey name' .= x) <> rest
333+ (T.pack name' .= x) <> rest
306334 where
307335 name' = fieldNameModifier name
308336 rest = go xs names defs
337+#if __GLASGOW_HASKELL__ < 800
338+ go _ _ _ = error "not empty"
339+#endif
309340
310341 fieldNameModifier = modifier . drop 1
311342 modifier = lowerFirstUppers . drop (length prefix)
312343 lowerFirstUppers s = map toLower x ++ y
313344 where (x, y) = span isUpper s
345+
346+#endif
src/Data/OpenApi/Internal/ParamSchema.hs → src/Data/Swagger/Internal/ParamSchema.hsrenamed+67−84
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE DataKinds #-}
23{-# LANGUAGE DefaultSignatures #-}
34{-# LANGUAGE FlexibleContexts #-}
@@ -11,11 +12,14 @@
1112{-# LANGUAGE TypeOperators #-}
1213{-# LANGUAGE TypeSynonymInstances #-}
1314{-# LANGUAGE UndecidableInstances #-}
15+#if __GLASGOW_HASKELL__ >= 800
1416-- Generic a is redundant in ToParamSchema a default imple
1517{-# OPTIONS_GHC -Wno-redundant-constraints #-}
1618-- For TypeErrors
1719{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
18−module Data.OpenApi.Internal.ParamSchema where
20+#endif
21+#include "overlapping-compat.h"
22+module Data.Swagger.Internal.ParamSchema where
1923
2024import Control.Lens
2125import Data.Aeson (ToJSON (..))
@@ -41,40 +45,37 @@ import Data.Word
4145import Data.UUID.Types (UUID)
4246import Web.Cookie (SetCookie)
4347
44−import Data.OpenApi.Internal
45−import Data.OpenApi.Lens
46−import Data.OpenApi.SchemaOptions
48+import Data.Swagger.Internal
49+import Data.Swagger.Lens
50+import Data.Swagger.SchemaOptions
4751
52+#if __GLASGOW_HASKELL__ < 800
53+#else
4854import qualified Data.ByteString as BS
49−import qualified Data.ByteString.Lazy.Char8 as BSL
55+import qualified Data.ByteString.Lazy as BSL
5056import GHC.TypeLits (TypeError, ErrorMessage(..))
57+#endif
5158
5259-- | Default schema for binary data (any sequence of octets).
53−binarySchema :: Schema
54−binarySchema = mempty
55− & type_ ?~ OpenApiString
60+binaryParamSchema :: ParamSchema t
61+binaryParamSchema = mempty
62+ & type_ ?~ SwaggerString
5663 & format ?~ "binary"
5764
5865-- | Default schema for binary data (base64 encoded).
59−byteSchema :: Schema
60−byteSchema = mempty
61− & type_ ?~ OpenApiString
66+byteParamSchema :: ParamSchema t
67+byteParamSchema = mempty
68+ & type_ ?~ SwaggerString
6269 & format ?~ "byte"
6370
6471-- | Default schema for password string.
6572-- @"password"@ format is used to hint UIs the input needs to be obscured.
66−passwordSchema :: Schema
67−passwordSchema = mempty
68− & type_ ?~ OpenApiString
73+passwordParamSchema :: ParamSchema t
74+passwordParamSchema = mempty
75+ & type_ ?~ SwaggerString
6976 & format ?~ "password"
7077
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.
78+-- | Convert a type into a plain @'ParamSchema'@.
7879--
7980-- An example type and instance:
8081--
@@ -87,7 +88,7 @@ passwordSchema = mempty
8788--
8889-- instance ToParamSchema Direction where
8990-- toParamSchema _ = mempty
90−-- & type_ ?~ OpenApiString
91+-- & type_ ?~ SwaggerString
9192-- & enum_ ?~ [ \"Up\", \"Down\" ]
9293-- @
9394--
@@ -112,26 +113,24 @@ passwordSchema = mempty
112113class ToParamSchema a where
113114 -- | Convert a type into a plain parameter schema.
114115 --
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
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
121120 toParamSchema = genericToParamSchema defaultSchemaOptions
122121
123−instance {-# OVERLAPPING #-} ToParamSchema String where
124− toParamSchema _ = mempty & type_ ?~ OpenApiString
122+instance OVERLAPPING_ ToParamSchema String where
123+ toParamSchema _ = mempty & type_ ?~ SwaggerString
125124
126125instance ToParamSchema Bool where
127− toParamSchema _ = mempty & type_ ?~ OpenApiBoolean
126+ toParamSchema _ = mempty & type_ ?~ SwaggerBoolean
128127
129128instance ToParamSchema Integer where
130− toParamSchema _ = mempty & type_ ?~ OpenApiInteger
129+ toParamSchema _ = mempty & type_ ?~ SwaggerInteger
131130
132131instance ToParamSchema Natural where
133132 toParamSchema _ = mempty
134− & type_ ?~ OpenApiInteger
133+ & type_ ?~ SwaggerInteger
135134 & minimum_ ?~ 0
136135 & exclusiveMinimum ?~ False
137136
@@ -148,54 +147,46 @@ instance ToParamSchema Int64 where
148147instance ToParamSchema Word where toParamSchema = toParamSchemaBoundedIntegral
149148instance ToParamSchema Word8 where toParamSchema = toParamSchemaBoundedIntegral
150149instance ToParamSchema Word16 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"
150+instance ToParamSchema Word32 where toParamSchema = toParamSchemaBoundedIntegral
151+instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral
157152
158153-- | Default plain schema for @'Bounded'@, @'Integral'@ types.
159154--
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
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
167158toParamSchemaBoundedIntegral _ = mempty
168− & type_ ?~ OpenApiInteger
159+ & type_ ?~ SwaggerInteger
169160 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
170161 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
171162
172163instance ToParamSchema Char where
173164 toParamSchema _ = mempty
174− & type_ ?~ OpenApiString
165+ & type_ ?~ SwaggerString
175166 & maxLength ?~ 1
176167 & minLength ?~ 1
177168
178169instance ToParamSchema Scientific where
179− toParamSchema _ = mempty & type_ ?~ OpenApiNumber
170+ toParamSchema _ = mempty & type_ ?~ SwaggerNumber
180171
181172instance HasResolution a => ToParamSchema (Fixed a) where
182173 toParamSchema _ = mempty
183− & type_ ?~ OpenApiNumber
174+ & type_ ?~ SwaggerNumber
184175 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
185176
186177instance ToParamSchema Double where
187178 toParamSchema _ = mempty
188− & type_ ?~ OpenApiNumber
179+ & type_ ?~ SwaggerNumber
189180 & format ?~ "double"
190181
191182instance ToParamSchema Float where
192183 toParamSchema _ = mempty
193− & type_ ?~ OpenApiNumber
184+ & type_ ?~ SwaggerNumber
194185 & format ?~ "float"
195186
196−timeParamSchema :: String -> Schema
187+timeParamSchema :: String -> ParamSchema t
197188timeParamSchema fmt = mempty
198− & type_ ?~ OpenApiString
189+ & type_ ?~ SwaggerString
199190 & format ?~ T.pack fmt
200191
201192-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -216,9 +207,9 @@ instance ToParamSchema LocalTime where
216207
217208-- |
218209-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
219−-- Just "date-time"
210+-- Just "yyyy-mm-ddThh:MM:ss+hhMM"
220211instance ToParamSchema ZonedTime where
221− toParamSchema _ = timeParamSchema "date-time"
212+ toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+hhMM"
222213
223214-- |
224215-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format
@@ -237,21 +228,25 @@ instance ToParamSchema TL.Text where
237228
238229instance ToParamSchema Version where
239230 toParamSchema _ = mempty
240− & type_ ?~ OpenApiString
231+ & type_ ?~ SwaggerString
241232 & pattern ?~ "^\\d+(\\.\\d+)*$"
242233
243234instance ToParamSchema SetCookie where
244235 toParamSchema _ = mempty
245− & type_ ?~ OpenApiString
236+ & type_ ?~ SwaggerString
237+
246238
239+#if __GLASGOW_HASKELL__ < 800
240+#else
247241type family ToParamSchemaByteStringError bs where
248242 ToParamSchemaByteStringError bs = TypeError
249243 ( 'Text "Impossible to have an instance " :<>: ShowType (ToParamSchema bs) :<>: Text "."
250244 :$$: 'Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
251− :$$: 'Text "Consider using byteParamSchema or binaryParamSchemaemplates." )
245+ :$$: 'Text "Consider using byteParamSchema or binaryParamSchema templates." )
252246
253247instance ToParamSchemaByteStringError BS.ByteString => ToParamSchema BS.ByteString where toParamSchema = error "impossible"
254248instance ToParamSchemaByteStringError BSL.ByteString => ToParamSchema BSL.ByteString where toParamSchema = error "impossible"
249+#endif
255250
256251instance ToParamSchema All where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool)
257252instance ToParamSchema Any where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool)
@@ -265,8 +260,8 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t
265260
266261instance ToParamSchema a => ToParamSchema [a] where
267262 toParamSchema _ = mempty
268− & type_ ?~ OpenApiArray
269− & items ?~ OpenApiItemsObject (Inline $ toParamSchema (Proxy :: Proxy a))
263+ & type_ ?~ SwaggerArray
264+ & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))
270265
271266instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
272267instance ToParamSchema a => ToParamSchema (VP.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
@@ -281,40 +276,29 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
281276 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
282277
283278-- |
284−-- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy ())
285−-- {
286−-- "enum": [
287−-- "_"
288−-- ],
289−-- "type": "string"
290−-- }
279+-- >>> encode $ toParamSchema (Proxy :: Proxy ())
280+-- "{\"type\":\"string\",\"enum\":[\"_\"]}"
291281instance ToParamSchema () where
292282 toParamSchema _ = mempty
293− & type_ ?~ OpenApiString
283+ & type_ ?~ SwaggerString
294284 & enum_ ?~ ["_"]
295285
296286instance ToParamSchema UUID where
297287 toParamSchema _ = mempty
298− & type_ ?~ OpenApiString
288+ & type_ ?~ SwaggerString
299289 & format ?~ "uuid"
300290
301−-- | A configurable generic @'Schema'@ creator.
291+-- | A configurable generic @'ParamSchema'@ creator.
302292--
303293-- >>> :set -XDeriveGeneric
304294-- >>> data Color = Red | Blue deriving Generic
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
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
314298genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
315299
316300class GToParamSchema (f :: * -> *) where
317− gtoParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
301+ gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
318302
319303instance GToParamSchema f => GToParamSchema (D1 d f) where
320304 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
@@ -332,14 +316,14 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) wh
332316 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
333317
334318class GEnumParamSchema (f :: * -> *) where
335− genumParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
319+ genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
336320
337321instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
338322 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)
339323
340324instance Constructor c => GEnumParamSchema (C1 c U1) where
341325 genumParamSchema opts _ s = s
342− & type_ ?~ OpenApiString
326+ & type_ ?~ SwaggerString
343327 & enum_ %~ addEnumValue tag
344328 where
345329 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
@@ -351,4 +335,3 @@ data Proxy3 a b c = Proxy3
351335
352336-- $setup
353337-- >>> import Data.Aeson (encode)
354−-- >>> import Data.OpenApi.Internal.Utils
src/Data/OpenApi/Internal/Schema.hs → src/Data/Swagger/Internal/Schema.hsrenamed+211−455
@@ -1,36 +1,38 @@
11{-# LANGUAGE CPP #-}
22{-# LANGUAGE ConstraintKinds #-}
3−{-# LANGUAGE DataKinds #-}
43{-# LANGUAGE DefaultSignatures #-}
54{-# LANGUAGE FlexibleContexts #-}
65{-# LANGUAGE FlexibleInstances #-}
76{-# 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 #-}
1514{-# LANGUAGE TypeFamilies #-}
1615{-# LANGUAGE TypeOperators #-}
1716{-# LANGUAGE TypeSynonymInstances #-}
1817{-# LANGUAGE UndecidableInstances #-}
18+#if __GLASGOW_HASKELL__ >= 800
19+-- Few generics related redundant constraints
1920{-# OPTIONS_GHC -Wno-redundant-constraints #-}
2021-- For TypeErrors
2122{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
22−module Data.OpenApi.Internal.Schema where
23+#endif
24+#include "overlapping-compat.h"
25+module Data.Swagger.Internal.Schema where
2326
2427import Prelude ()
2528import Prelude.Compat
2629
27−import Control.Lens hiding (allOf)
30+import Control.Lens
2831import Data.Data.Lens (template)
2932
3033import Control.Monad
3134import Control.Monad.Writer
32−import Data.Aeson (Object (..), SumEncoding (..), ToJSON (..), ToJSONKey (..),
33− ToJSONKeyFunction (..), Value (..))
35+import Data.Aeson (ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..), Value (..), Object(..))
3436import Data.Char
3537import Data.Data (Data)
3638import Data.Foldable (traverse_)
@@ -42,10 +44,8 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
4244import Data.Int
4345import Data.IntSet (IntSet)
4446import Data.IntMap (IntMap)
45−import Data.List (sort)
4647import Data.List.NonEmpty.Compat (NonEmpty)
4748import Data.Map (Map)
48−import Data.Maybe (fromMaybe)
4949import Data.Proxy
5050import Data.Scientific (Scientific)
5151import Data.Fixed (Fixed, HasResolution, Pico)
@@ -62,20 +62,21 @@ import Numeric.Natural.Compat (Natural)
6262import Data.Word
6363import GHC.Generics
6464import qualified Data.UUID.Types as UUID
65−import Type.Reflection (Typeable, typeRep)
6665
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
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
7573
74+#if __GLASGOW_HASKELL__ < 800
75+#else
7676import qualified Data.ByteString as BS
77−import qualified Data.ByteString.Lazy.Char8 as BSL
77+import qualified Data.ByteString.Lazy as BSL
7878import GHC.TypeLits (TypeError, ErrorMessage(..))
79+#endif
7980
8081unnamed :: Schema -> NamedSchema
8182unnamed schema = NamedSchema Nothing schema
@@ -102,7 +103,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
102103--
103104-- import Control.Lens
104105-- import Data.Proxy
105−-- import Data.OpenApi
106+-- import Data.Swagger
106107--
107108-- data Coord = Coord { x :: Double, y :: Double }
108109--
@@ -110,7 +111,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
110111-- declareNamedSchema _ = do
111112-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
112113-- return $ NamedSchema (Just \"Coord\") $ mempty
113−-- & type_ ?~ OpenApiObject
114+-- & type_ ?~ SwaggerObject
114115-- & properties .~
115116-- [ (\"x\", doubleSchema)
116117-- , (\"y\", doubleSchema)
@@ -136,13 +137,13 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
136137--
137138-- instance ToSchema Coord
138139-- @
139−class Typeable a => ToSchema a where
140+class ToSchema a where
140141 -- | Convert a type into an optionally named schema
141142 -- together with all used definitions.
142143 -- Note that the schema itself is included in definitions
143144 -- only if it is recursive (and thus needs its definition in scope).
144145 declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
145− default declareNamedSchema :: (Generic a, GToSchema (Rep a)) =>
146+ default declareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
146147 Proxy a -> Declare (Definitions Schema) NamedSchema
147148 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
148149
@@ -158,19 +159,13 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
158159--
159160-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
160161-- Nothing
161−-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy String) ^. schema)
162−-- {
163−-- "type": "string"
164−-- }
162+-- >>> encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
163+-- "{\"type\":\"string\"}"
165164--
166165-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
167166-- Just "Day"
168−-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy Day) ^. schema)
169−-- {
170−-- "example": "2016-07-22",
171−-- "format": "date",
172−-- "type": "string"
173−-- }
167+-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
168+-- "{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"
174169toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
175170toNamedSchema = undeclare . declareNamedSchema
176171
@@ -186,35 +181,22 @@ schemaName = _namedSchemaName . toNamedSchema
186181
187182-- | Convert a type into a schema.
188183--
189−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Int8)
190−-- {
191−-- "maximum": 127,
192−-- "minimum": -128,
193−-- "type": "integer"
194−-- }
184+-- >>> encode $ toSchema (Proxy :: Proxy Int8)
185+-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
195186--
196−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy [Day])
197−-- {
198−-- "items": {
199−-- "$ref": "#/components/schemas/Day"
200−-- },
201−-- "type": "array"
202−-- }
187+-- >>> encode $ toSchema (Proxy :: Proxy [Day])
188+-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"
203189toSchema :: ToSchema a => Proxy a -> Schema
204190toSchema = _namedSchemaSchema . toNamedSchema
205191
206192-- | Convert a type into a referenced schema if possible.
207193-- Only named schemas can be referenced, nameless schemas are inlined.
208194--
209−-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Integer)
210−-- {
211−-- "type": "integer"
212−-- }
195+-- >>> encode $ toSchemaRef (Proxy :: Proxy Integer)
196+-- "{\"type\":\"integer\"}"
213197--
214−-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Day)
215−-- {
216−-- "$ref": "#/components/schemas/Day"
217−-- }
198+-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)
199+-- "{\"$ref\":\"#/definitions/Day\"}"
218200toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
219201toSchemaRef = undeclare . declareSchemaRef
220202
@@ -282,15 +264,8 @@ inlineAllSchemas = inlineSchemasWhen (const True)
282264
283265-- | Convert a type into a schema without references.
284266--
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−-- }
267+-- >>> encode $ toInlinedSchema (Proxy :: Proxy [Day])
268+-- "{\"items\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"},\"type\":\"array\"}"
294269--
295270-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
296271-- when inlining recursive schemas.
@@ -320,67 +295,41 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
320295 traverse_ usedNames (InsOrdHashMap.lookup name defs)
321296 Inline subschema -> usedNames subschema
322297
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+
323317-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
324318-- Produced schema can be used for further refinement.
325319--
326−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema "hello"
327−-- {
328−-- "example": "hello",
329−-- "type": "string"
330−-- }
320+-- >>> encode $ sketchSchema "hello"
321+-- "{\"example\":\"hello\",\"type\":\"string\"}"
331322--
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−-- }
323+-- >>> encode $ sketchSchema (1, 2, 3)
324+-- "{\"example\":[1,2,3],\"items\":{\"type\":\"number\"},\"type\":\"array\"}"
344325--
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−-- }
326+-- >>> encode $ sketchSchema ("Jack", 25)
327+-- "{\"example\":[\"Jack\",25],\"items\":[{\"type\":\"string\"},{\"type\":\"number\"}],\"type\":\"array\"}"
361328--
362329-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
363330-- >>> instance ToJSON Person
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−-- }
331+-- >>> encode $ sketchSchema (Person "Jack" 25)
332+-- "{\"required\":[\"age\",\"name\"],\"properties\":{\"age\":{\"type\":\"number\"},\"name\":{\"type\":\"string\"}},\"example\":{\"age\":25,\"name\":\"Jack\"},\"type\":\"object\"}"
384333sketchSchema :: ToJSON a => a -> Schema
385334sketchSchema = sketch . toJSON
386335 where
@@ -388,15 +337,15 @@ sketchSchema = sketch . toJSON
388337 sketch js@(Bool _) = go js
389338 sketch js = go js & example ?~ js
390339
391− go Null = mempty & type_ ?~ OpenApiNull
392− go (Bool _) = mempty & type_ ?~ OpenApiBoolean
393− go (String _) = mempty & type_ ?~ OpenApiString
394− go (Number _) = mempty & type_ ?~ OpenApiNumber
340+ go Null = mempty & type_ ?~ SwaggerNull
341+ go (Bool _) = mempty & type_ ?~ SwaggerBoolean
342+ go (String _) = mempty & type_ ?~ SwaggerString
343+ go (Number _) = mempty & type_ ?~ SwaggerNumber
395344 go (Array xs) = mempty
396− & type_ ?~ OpenApiArray
345+ & type_ ?~ SwaggerArray
397346 & items ?~ case ischema of
398− Just s -> OpenApiItemsObject (Inline s)
399− _ -> OpenApiItemsArray (map Inline ys)
347+ Just s -> SwaggerItemsObject (Inline s)
348+ _ -> SwaggerItemsArray (map Inline ys)
400349 where
401350 ys = map go (V.toList xs)
402351 allSame = and ((zipWith (==)) ys (tail ys))
@@ -405,190 +354,76 @@ sketchSchema = sketch . toJSON
405354 (z:_) | allSame -> Just z
406355 _ -> Nothing
407356 go (Object o) = mempty
408− & type_ ?~ OpenApiObject
409− & required .~ sort (objectKeys o)
410− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
357+ & type_ ?~ SwaggerObject
358+ & required .~ HashMap.keys o
359+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
411360
412361-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
413362-- Produced schema uses as much constraints as possible.
414363--
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−-- }
364+-- >>> encode $ sketchStrictSchema "hello"
365+-- "{\"maxLength\":5,\"pattern\":\"hello\",\"minLength\":5,\"type\":\"string\",\"enum\":[\"hello\"]}"
425366--
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−-- }
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]]}"
469369--
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−-- }
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]]}"
503372--
504373-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
505374-- >>> instance ToJSON Person
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−-- }
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\"}]}"
542377sketchStrictSchema :: ToJSON a => a -> Schema
543378sketchStrictSchema = go . toJSON
544379 where
545− go Null = mempty & type_ ?~ OpenApiNull
380+ go Null = mempty & type_ ?~ SwaggerNull
546381 go js@(Bool _) = mempty
547− & type_ ?~ OpenApiBoolean
382+ & type_ ?~ SwaggerBoolean
548383 & enum_ ?~ [js]
549384 go js@(String s) = mempty
550− & type_ ?~ OpenApiString
385+ & type_ ?~ SwaggerString
551386 & maxLength ?~ fromIntegral (T.length s)
552387 & minLength ?~ fromIntegral (T.length s)
553388 & pattern ?~ s
554389 & enum_ ?~ [js]
555390 go js@(Number n) = mempty
556− & type_ ?~ OpenApiNumber
391+ & type_ ?~ SwaggerNumber
557392 & maximum_ ?~ n
558393 & minimum_ ?~ n
559394 & multipleOf ?~ n
560395 & enum_ ?~ [js]
561396 go js@(Array xs) = mempty
562− & type_ ?~ OpenApiArray
397+ & type_ ?~ SwaggerArray
563398 & maxItems ?~ fromIntegral sz
564399 & minItems ?~ fromIntegral sz
565− & items ?~ OpenApiItemsArray (map (Inline . go) (V.toList xs))
400+ & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
566401 & uniqueItems ?~ allUnique
567402 & enum_ ?~ [js]
568403 where
569404 sz = length xs
570405 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
571406 go js@(Object o) = mempty
572− & type_ ?~ OpenApiObject
573− & required .~ sort names
574− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
407+ & type_ ?~ SwaggerObject
408+ & required .~ names
409+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
575410 & maxProperties ?~ fromIntegral (length names)
576411 & minProperties ?~ fromIntegral (length names)
577412 & enum_ ?~ [js]
578413 where
579− names = objectKeys o
414+ names = HashMap.keys o
580415
581416class GToSchema (f :: * -> *) where
582417 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
583418
584−instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
419+instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
585420 declareNamedSchema _ = do
586421 ref <- declareSchemaRef (Proxy :: Proxy a)
587422 return $ unnamed $ mempty
588− & type_ ?~ OpenApiArray
589− & items ?~ OpenApiItemsObject ref
423+ & type_ ?~ SwaggerArray
424+ & items ?~ SwaggerItemsObject ref
590425
591−instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
426+instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
592427instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
593428instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
594429instance ToSchema Natural where declareNamedSchema = plain . paramSchemaToSchema
@@ -611,14 +446,12 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
611446instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
612447instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
613448
614−instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
449+instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
615450
616451instance ToSchema a => ToSchema (Maybe a) where
617452 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
618453
619−instance (ToSchema a, ToSchema b) => ToSchema (Either a b) where
620− -- To match Aeson instance
621− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { sumEncoding = ObjectWithSingleField }
454+instance (ToSchema a, ToSchema b) => ToSchema (Either a b)
622455
623456instance ToSchema () where
624457 declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
@@ -628,22 +461,16 @@ instance ToSchema UUID.UUID where
628461 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
629462 & example ?~ toJSON (UUID.toText UUID.nil)
630463
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
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)
643470
644471timeSchema :: T.Text -> Schema
645472timeSchema fmt = mempty
646− & type_ ?~ OpenApiString
473+ & type_ ?~ SwaggerString
647474 & format ?~ fmt
648475
649476-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -658,7 +485,7 @@ instance ToSchema LocalTime where
658485 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
659486 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
660487
661−-- | Format @"date-time"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
488+-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
662489instance ToSchema ZonedTime where
663490 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
664491 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
@@ -678,6 +505,8 @@ instance ToSchema TL.Text where declareNamedSchema = plain . paramSchemaToSchema
678505
679506instance ToSchema Version where declareNamedSchema = plain . paramSchemaToSchema
680507
508+#if __GLASGOW_HASKELL__ < 800
509+#else
681510type family ToSchemaByteStringError bs where
682511 ToSchemaByteStringError bs = TypeError
683512 ( Text "Impossible to have an instance " :<>: ShowType (ToSchema bs) :<>: Text "."
@@ -686,13 +515,15 @@ type family ToSchemaByteStringError bs where
686515
687516instance ToSchemaByteStringError BS.ByteString => ToSchema BS.ByteString where declareNamedSchema = error "impossible"
688517instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where declareNamedSchema = error "impossible"
518+#endif
689519
690520instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
691521
692522-- | NOTE: This schema does not account for the uniqueness of keys.
693−instance (ToSchema a) => ToSchema (IntMap a) where
523+instance ToSchema a => ToSchema (IntMap a) where
694524 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
695525
526+#if MIN_VERSION_aeson(1,0,0)
696527instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
697528 declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction k of
698529 ToJSONKeyText _ _ -> declareObjectMapSchema
@@ -701,15 +532,33 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
701532 declareObjectMapSchema = do
702533 schema <- declareSchemaRef (Proxy :: Proxy v)
703534 return $ unnamed $ mempty
704− & type_ ?~ OpenApiObject
535+ & type_ ?~ SwaggerObject
705536 & additionalProperties ?~ AdditionalPropertiesSchema schema
706537
707538instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
708539 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))
709540
710−instance {-# OVERLAPPING #-} ToSchema Object where
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
711560 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
712− & type_ ?~ OpenApiObject
561+ & type_ ?~ SwaggerObject
713562 & description ?~ "Arbitrary JSON object."
714563 & additionalProperties ?~ AdditionalPropertiesAllowed True
715564
@@ -746,15 +595,11 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
746595
747596-- | Default schema for @'Bounded'@, @'Integral'@ types.
748597--
749−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
750−-- {
751−-- "maximum": 32767,
752−-- "minimum": -32768,
753−-- "type": "integer"
754−-- }
598+-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
599+-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
755600toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
756601toSchemaBoundedIntegral _ = mempty
757− & type_ ?~ OpenApiInteger
602+ & type_ ?~ SwaggerInteger
758603 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
759604 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
760605
@@ -783,27 +628,8 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
783628-- >>> instance ToSchema ButtonState
784629-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
785630-- >>> type ImageUrl = T.Text
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−-- }
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\"}"
807633--
808634-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
809635-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -811,15 +637,15 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.
811637 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
812638 => Proxy (map key value) -> Declare (Definitions Schema) Schema
813639declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
814− ToJSONKeyText getKey _ -> objectSchema getKey
640+ ToJSONKeyText keyToText _ -> objectSchema keyToText
815641 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
816642 where
817− objectSchema getKey = do
643+ objectSchema keyToText = do
818644 valueRef <- declareSchemaRef (Proxy :: Proxy value)
819645 let allKeys = [minBound..maxBound :: key]
820− mkPair k = (keyToText $ getKey k, valueRef)
646+ mkPair k = (keyToText k, valueRef)
821647 return $ mempty
822− & type_ ?~ OpenApiObject
648+ & type_ ?~ SwaggerObject
823649 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
824650
825651-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -830,27 +656,8 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
830656-- >>> instance ToSchema ButtonState
831657-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
832658-- >>> type ImageUrl = T.Text
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−-- }
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\"}"
854661--
855662-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
856663-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -860,32 +667,32 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.
860667toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
861668
862669-- | A configurable generic @'Schema'@ creator.
863−genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
670+genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>
864671 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
865−genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
672+genericDeclareSchema = genericDeclareSchemaUnrestricted
866673
867674-- | A configurable generic @'NamedSchema'@ creator.
868675-- This function applied to @'defaultSchemaOptions'@
869676-- is used as the default for @'declareNamedSchema'@
870677-- 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.
871683--
872−-- Default implementation will use the name from 'Typeable' instance, including concrete
873−-- instantioations of type variables.
874−--
875−-- For example:
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.
876690--
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) =>
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)) =>
880694 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
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−
695+genericDeclareNamedSchemaUnrestricted opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
889696
890697-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
891698genericNameSchema :: forall a d f.
@@ -901,19 +708,19 @@ gdatatypeSchemaName opts _ = case orig of
901708 orig = datatypeName (Proxy3 :: Proxy3 d f a)
902709 name = datatypeNameModifier opts orig
903710
904−-- | Construct 'NamedSchema' usinng 'ToParamSchema'.
711+-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
905712paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
906713 SchemaOptions -> Proxy a -> NamedSchema
907714paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
908715
909−-- | Construct 'Schema' usinng 'ToParamSchema'.
716+-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
910717paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
911−paramSchemaToSchema = toParamSchema
718+paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
912719
913720nullarySchema :: Schema
914721nullarySchema = mempty
915− & type_ ?~ OpenApiArray
916− & items ?~ OpenApiItemsArray []
722+ & type_ ?~ SwaggerArray
723+ & items ?~ SwaggerItemsArray []
917724
918725gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
919726gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
@@ -931,10 +738,10 @@ instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
931738 where
932739 name = gdatatypeSchemaName opts (Proxy :: Proxy d)
933740
934−instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where
741+instance OVERLAPPABLE_ GToSchema f => GToSchema (C1 c f) where
935742 gdeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy f)
936743
937−instance {-# OVERLAPPING #-} Constructor c => GToSchema (C1 c U1) where
744+instance OVERLAPPING_ Constructor c => GToSchema (C1 c U1) where
938745 gdeclareNamedSchema = gdeclareNamedSumSchema
939746
940747-- | Single field constructor.
@@ -943,15 +750,12 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
943750 | unwrapUnaryRecords opts = fieldSchema
944751 | otherwise =
945752 case schema ^. items of
946− Just (OpenApiItemsArray [_]) -> fieldSchema
753+ Just (SwaggerItemsArray [_]) -> fieldSchema
947754 _ -> do
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')
755+ declare defs
756+ return (unnamed schema)
953757 where
954− (_, NamedSchema _ schema) = runDeclare recordSchema mempty
758+ (defs, NamedSchema _ schema) = runDeclare recordSchema mempty
955759 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
956760 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
957761
@@ -974,10 +778,10 @@ gdeclareSchemaRef opts proxy = do
974778 return $ Ref (Reference name)
975779 _ -> Inline <$> gdeclareSchema opts proxy
976780
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"
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"
981785
982786withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
983787 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
@@ -986,12 +790,12 @@ withFieldSchema opts _ isRequiredField schema = do
986790 return $
987791 if T.null fname
988792 then schema
989− & type_ ?~ OpenApiArray
793+ & type_ ?~ SwaggerArray
990794 & items %~ appendItem ref
991795 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
992796 & minItems %~ Just . maybe 1 (+1) -- increment minItems
993797 else schema
994− & type_ ?~ OpenApiObject
798+ & type_ ?~ SwaggerObject
995799 & properties . at fname ?~ ref
996800 & if isRequiredField
997801 then required %~ (++ [fname])
@@ -1000,127 +804,79 @@ withFieldSchema opts _ isRequiredField schema = do
1000804 fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
1001805
1002806-- | Optional record fields.
1003−instance {-# OVERLAPPING #-} (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
807+instance OVERLAPPING_ (Selector s, ToSchema c) => GToSchema (S1 s (K1 i (Maybe c))) where
1004808 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
1005809
1006810-- | Record fields.
1007−instance {-# OVERLAPPABLE #-} (Selector s, GToSchema f) => GToSchema (S1 s f) where
811+instance OVERLAPPABLE_ (Selector s, GToSchema f) => GToSchema (S1 s f) where
1008812 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True
1009813
1010−instance {-# OVERLAPPING #-} ToSchema c => GToSchema (K1 i (Maybe c)) where
814+instance OVERLAPPING_ ToSchema c => GToSchema (K1 i (Maybe c)) where
1011815 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
1012816
1013−instance {-# OVERLAPPABLE #-} ToSchema c => GToSchema (K1 i c) where
817+instance OVERLAPPABLE_ ToSchema c => GToSchema (K1 i c) where
1014818 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
1015819
1016820instance ( GSumToSchema f
1017821 , GSumToSchema g
1018822 ) => GToSchema (f :+: g)
1019823 where
1020− -- Aeson does not unwrap unary record in sum types.
1021− gdeclareNamedSchema opts p s = gdeclareNamedSumSchema (opts { unwrapUnaryRecords = False } )p s
824+ gdeclareNamedSchema = gdeclareNamedSumSchema
1022825
1023826gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
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)
827+gdeclareNamedSumSchema opts proxy s
828+ | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
829+ | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
1031830 where
1032− declareSumSchema = gsumToSchema opts proxy
1033− (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
831+ declareSumSchema = gsumToSchema opts proxy s
832+ (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
1034833
1035− toStringTag schemas = mempty
1036− & type_ ?~ OpenApiString
1037− & enum_ ?~ map (String . fst) sumSchemas
834+ toStringTag schema = mempty
835+ & type_ ?~ SwaggerString
836+ & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
1038837
1039838type AllNullary = All
1040839
1041840class GSumToSchema (f :: * -> *) where
1042− gsumToSchema :: SchemaOptions -> Proxy f -> WriterT AllNullary (Declare (Definitions Schema)) [(T.Text, Referenced Schema)]
841+ gsumToSchema :: SchemaOptions -> Proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
1043842
1044843instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
1045− gsumToSchema opts _ =
1046− (<>) <$> gsumToSchema opts (Proxy :: Proxy f) <*> gsumToSchema opts (Proxy :: Proxy g)
844+ gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)
1047845
1048−-- | Convert one component of the sum to schema, to be later combined with @oneOf@.
1049846gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
1050− Maybe (Referenced Schema) -> SchemaOptions -> Proxy (C1 c f) -> (T.Text, Referenced Schema)
1051−gsumConToSchemaWith ref opts _ = (tag, schema)
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
1052853 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−
1089854 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
1093855
1094856gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
1095− SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
1096−gsumConToSchema opts proxy = do
857+ SchemaOptions -> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
858+gsumConToSchema opts proxy schema = do
1097859 ref <- gdeclareSchemaRef opts proxy
1098− return [gsumConToSchemaWith (Just ref) opts proxy]
860+ return $ gsumConToSchemaWith ref opts proxy schema
1099861
1100−instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
1101− gsumToSchema opts proxy = do
862+instance OVERLAPPABLE_ (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
863+ gsumToSchema opts proxy schema = do
1102864 tell (All False)
1103− lift $ gsumConToSchema opts proxy
865+ lift $ gsumConToSchema opts proxy schema
1104866
1105867instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
1106− gsumToSchema opts proxy = do
868+ gsumToSchema opts proxy schema = do
1107869 tell (All False)
1108− lift $ gsumConToSchema opts proxy
870+ lift $ gsumConToSchema opts proxy schema
1109871
1110872instance Constructor c => GSumToSchema (C1 c U1) where
1111− gsumToSchema opts proxy = pure $ (:[]) $ gsumConToSchemaWith Nothing opts proxy
873+ gsumToSchema opts proxy = pure . gsumConToSchemaWith (Inline nullarySchema) opts proxy
1112874
1113875data Proxy2 a b = Proxy2
1114876
1115877data Proxy3 a b c = Proxy3
1116878
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−-}
879+-- $setup
880+-- >>> import Data.Swagger
881+-- >>> import Data.Aeson (encode)
882+-- >>> import Data.Aeson.Types (toJSONKeyText)
src/Data/OpenApi/Internal/Schema/Validation.hs → src/Data/Swagger/Internal/Schema/Validation.hsrenamed+101−126
@@ -1,5 +1,4 @@
11{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE CPP #-}
32{-# LANGUAGE DataKinds #-}
43{-# LANGUAGE DeriveFunctor #-}
54{-# LANGUAGE FlexibleInstances #-}
@@ -13,36 +12,31 @@
1312{-# LANGUAGE ScopedTypeVariables #-}
1413{-# LANGUAGE TemplateHaskell #-}
1514{-# LANGUAGE UndecidableInstances #-}
16−{-# LANGUAGE ViewPatterns #-}
1715-- |
18−-- Module: Data.OpenApi.Internal.Schema.Validation
16+-- Module: Data.Swagger.Internal.Schema.Validation
1917-- Copyright: (c) 2015 GetShopTV
2018-- License: BSD3
2119-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
2220-- Stability: experimental
2321--
2422-- Validate JSON values with Swagger Schema.
25−module Data.OpenApi.Internal.Schema.Validation where
23+module Data.Swagger.Internal.Schema.Validation where
2624
27−import Prelude ()
25+import Prelude ()
2826import Prelude.Compat
2927
3028import Control.Applicative
31−import Control.Lens hiding (allOf)
32−import Control.Monad (forM, forM_, when)
29+import Control.Lens
30+import Control.Monad (when)
3331
3432import Data.Aeson hiding (Result)
35−#if MIN_VERSION_aeson(2,0,0)
36−import qualified Data.Aeson.KeyMap as KeyMap
37−#endif
33+import Data.Aeson.Encode.Pretty (encodePretty)
3834import Data.Foldable (for_, sequenceA_,
3935 traverse_)
40−#if !MIN_VERSION_aeson(2,0,0)
4136import Data.HashMap.Strict (HashMap)
42−#endif
37+import qualified Data.HashMap.Strict as HashMap
4338import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
4439import qualified "unordered-containers" Data.HashSet as HashSet
45−import Data.Maybe (fromMaybe)
4640import Data.Proxy
4741import Data.Scientific (Scientific, isInteger)
4842import Data.Text (Text)
@@ -52,12 +46,10 @@ import qualified Data.Text.Lazy.Encoding as TL
5246import Data.Vector (Vector)
5347import qualified Data.Vector as Vector
5448
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
49+import Data.Swagger.Declare
50+import Data.Swagger.Internal
51+import Data.Swagger.Internal.Schema
52+import Data.Swagger.Lens
6153
6254-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
6355-- This can be used with QuickCheck to ensure those instances are coherent:
@@ -109,33 +101,33 @@ validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checke
109101-- <BLANKLINE>
110102-- Swagger Schema:
111103-- {
112−-- "properties": {
113−-- "name": {
114−-- "type": "string"
115−-- },
116−-- "phone": {
117−-- "$ref": "#/components/schemas/Phone"
118−-- }
119−-- },
120104-- "required": [
121105-- "name",
122106-- "phone"
123107-- ],
124−-- "type": "object"
108+-- "type": "object",
109+-- "properties": {
110+-- "phone": {
111+-- "$ref": "#/definitions/Phone"
112+-- },
113+-- "name": {
114+-- "type": "string"
115+-- }
116+-- }
125117-- }
126118-- <BLANKLINE>
127119-- Swagger Description Context:
128120-- {
129121-- "Phone": {
122+-- "required": [
123+-- "value"
124+-- ],
125+-- "type": "object",
130126-- "properties": {
131127-- "value": {
132128-- "type": "string"
133129-- }
134−-- },
135−-- "required": [
136−-- "value"
137−-- ],
138−-- "type": "object"
130+-- }
139131-- }
140132-- }
141133-- <BLANKLINE>
@@ -211,7 +203,7 @@ instance Monad Result where
211203
212204-- | Validation configuration.
213205data Config = Config
214− { -- | Pattern checker for @'_schemaPattern'@ validation.
206+ { -- | Pattern checker for @'_paramSchemaPattern'@ validation.
215207 configPatternChecker :: Pattern -> Text -> Bool
216208 -- | Schema definitions in scope to resolve references.
217209 , configDefinitions :: Definitions Schema
@@ -304,34 +296,40 @@ validateWithSchemaRef (Inline s) js = sub s (validateWithSchema js)
304296
305297-- | Validate JSON @'Value'@ with Swagger @'Schema'@.
306298validateWithSchema :: Value -> Validation Schema ()
307−validateWithSchema val = do
308− validateSchemaType val
309− validateEnum val
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
310308
311−validateInteger :: Scientific -> Validation Schema ()
309+validateInteger :: Scientific -> Validation (ParamSchema t) ()
312310validateInteger n = do
313311 when (not (isInteger n)) $
314312 invalid ("not an integer")
315313 validateNumber n
316314
317−validateNumber :: Scientific -> Validation Schema ()
315+validateNumber :: Scientific -> Validation (ParamSchema t) ()
318316validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do
319317 let exMax = Just True == sch ^. exclusiveMaximum
320318 exMin = Just True == sch ^. exclusiveMinimum
321319
322320 check maximum_ $ \m ->
323321 when (if exMax then (n >= m) else (n > m)) $
324− invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ (if exMax then "<" else "<=") ++ show m ++ ")")
322+ invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ if exMax then "<" else "<=" ++ show m ++ ")")
325323
326324 check minimum_ $ \m ->
327325 when (if exMin then (n <= m) else (n < m)) $
328− invalid ("value " ++ show n ++ " falls below minimum (should be " ++ (if exMin then ">" else ">=") ++ show m ++ ")")
326+ invalid ("value " ++ show n ++ " falls below minimum (should be " ++ if exMin then ">" else ">=" ++ show m ++ ")")
329327
330328 check multipleOf $ \k ->
331329 when (not (isInteger (n / k))) $
332330 invalid ("expected a multiple of " ++ show k ++ " but got " ++ show n)
333331
334−validateString :: Text -> Validation Schema ()
332+validateString :: Text -> Validation (ParamSchema t) ()
335333validateString s = do
336334 check maxLength $ \n ->
337335 when (len > fromInteger n) $
@@ -348,7 +346,7 @@ validateString s = do
348346 where
349347 len = Text.length s
350348
351−validateArray :: Vector Value -> Validation Schema ()
349+validateArray :: Vector Value -> Validation (ParamSchema t) ()
352350validateArray xs = do
353351 check maxItems $ \n ->
354352 when (len > fromInteger n) $
@@ -359,8 +357,9 @@ validateArray xs = do
359357 invalid ("array is too short (size should be >=" ++ show n ++ ")")
360358
361359 check items $ \case
362− OpenApiItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs
363− OpenApiItemsArray itemSchemas -> do
360+ SwaggerItemsPrimitive _ itemSchema -> sub itemSchema $ traverse_ validateWithParamSchema xs
361+ SwaggerItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs
362+ SwaggerItemsArray itemSchemas -> do
364363 when (len /= length itemSchemas) $
365364 invalid ("array size is invalid (should be exactly " ++ show (length itemSchemas) ++ ")")
366365 sequenceA_ (zipWith validateWithSchemaRef itemSchemas (Vector.toList xs))
@@ -372,20 +371,11 @@ validateArray xs = do
372371 len = Vector.length xs
373372 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))
374373
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 ()
374+validateObject :: HashMap Text Value -> Validation Schema ()
382375validateObject o = withSchema $ \sch ->
383376 case sch ^. discriminator of
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)
377+ Just pname -> case fromJSON <$> HashMap.lookup pname o of
378+ Just (Success ref) -> validateWithSchemaRef ref (Object o)
389379 Just (Error msg) -> invalid ("failed to parse discriminator property " ++ show pname ++ ": " ++ show msg)
390380 Nothing -> invalid ("discriminator property " ++ show pname ++ "is missing")
391381 Nothing -> do
@@ -400,15 +390,15 @@ validateObject o = withSchema $ \sch ->
400390 validateRequired
401391 validateProps
402392 where
403− size = fromIntegral (length o)
393+ size = fromIntegral (HashMap.size o)
404394
405395 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)
406396 validateReq n =
407− when (not (hasKey n o)) $
397+ when (not (HashMap.member n o)) $
408398 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))
409399
410400 validateProps = withSchema $ \sch -> do
411− for_ (objectToList o) $ \(keyToText -> k, v) ->
401+ for_ (HashMap.toList o) $ \(k, v) ->
412402 case v of
413403 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property
414404 _ ->
@@ -424,21 +414,21 @@ validateObject o = withSchema $ \sch ->
424414 unknownProperty pname = invalid $
425415 "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"
426416
427−validateEnum :: Value -> Validation Schema ()
428−validateEnum val = do
417+validateEnum :: Value -> Validation (ParamSchema t) ()
418+validateEnum value = do
429419 check enum_ $ \xs ->
430− when (val `notElem` xs) $
431− invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show val)
420+ when (value `notElem` xs) $
421+ invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)
432422
433423-- | Infer schema type based on used properties.
434424--
435425-- This is like 'inferParamSchemaTypes', but also works for objects:
436426--
437427-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"
438−-- Just [OpenApiObject]
439−inferSchemaTypes :: Schema -> [OpenApiType]
440−inferSchemaTypes sch = inferParamSchemaTypes sch ++
441− [ OpenApiObject | any ($ sch)
428+-- Just [SwaggerObject]
429+inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]
430+inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++
431+ [ SwaggerObject | any ($ sch)
442432 [ has (additionalProperties._Just)
443433 , has (maxProperties._Just)
444434 , has (minProperties._Just)
@@ -448,77 +438,62 @@ inferSchemaTypes sch = inferParamSchemaTypes sch ++
448438-- | Infer schema type based on used properties.
449439--
450440-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"
451−-- Just [OpenApiString]
441+-- Just [SwaggerString]
452442--
453443-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"
454−-- Just [OpenApiArray]
444+-- Just [SwaggerArray]
455445--
456−-- From numeric properties 'OpenApiInteger' type is inferred.
457−-- If you want 'OpenApiNumber' instead, you must specify it explicitly.
446+-- From numeric properties 'SwaggerInteger' type is inferred.
447+-- If you want 'SwaggerNumber' instead, you must specify it explicitly.
458448--
459449-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"
460−-- Just [OpenApiInteger]
461−inferParamSchemaTypes :: Schema -> [OpenApiType]
450+-- Just [SwaggerInteger]
451+inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]
462452inferParamSchemaTypes sch = concat
463− [ [ OpenApiArray | any ($ sch)
453+ [ [ SwaggerArray | any ($ sch)
464454 [ has (items._Just)
465455 , has (maxItems._Just)
466456 , has (minItems._Just)
467457 , has (uniqueItems._Just) ] ]
468− , [ OpenApiInteger | any ($ sch)
458+ , [ SwaggerInteger | any ($ sch)
469459 [ has (exclusiveMaximum._Just)
470460 , has (exclusiveMinimum._Just)
471461 , has (maximum_._Just)
472462 , has (minimum_._Just)
473463 , has (multipleOf._Just) ] ]
474− , [ OpenApiString | any ($ sch)
464+ , [ SwaggerString | any ($ sch)
475465 [ has (maxLength._Just)
476466 , has (minLength._Just)
477467 , has (pattern._Just) ] ]
478468 ]
479469
480470validateSchemaType :: Value -> Validation Schema ()
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
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
522497 (Nothing, Bool _) -> valid
523498 -- Number by default
524499 (Nothing, Number n) -> validateNumber n
@@ -526,11 +501,11 @@ validateParamSchemaType val = withSchema $ \sch ->
526501 (Nothing, Array xs) -> validateArray xs
527502 bad -> invalid $ "expected JSON value of type " ++ showType bad
528503
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"
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"
src/Data/OpenApi/Internal/TypeShape.hs → src/Data/Swagger/Internal/TypeShape.hsrenamed+11−1
@@ -1,10 +1,12 @@
1+{-# LANGUAGE CPP #-}
12{-# LANGUAGE ConstraintKinds #-}
23{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE KindSignatures #-}
35{-# LANGUAGE TypeFamilies #-}
46{-# LANGUAGE TypeOperators #-}
57{-# LANGUAGE UndecidableInstances #-}
68
7−module Data.OpenApi.Internal.TypeShape where
9+module Data.Swagger.Internal.TypeShape where
810
911import Data.Proxy
1012import GHC.Generics
@@ -35,6 +37,11 @@ type family TypeHasSimpleShape t (f :: Symbol) :: Constraint where
3537type family GenericHasSimpleShape t (f :: Symbol) (s :: TypeShape) :: Constraint where
3638 GenericHasSimpleShape t f Enumeration = ()
3739 GenericHasSimpleShape t f SumOfProducts = ()
40+#if __GLASGOW_HASKELL__ < 800
41+ GenericHasSimpleShape t f Mixed = CannotDeriveSchemaForMixedSumType t
42+
43+class CannotDeriveSchemaForMixedSumType t where
44+#else
3845 GenericHasSimpleShape t f Mixed =
3946 TypeError
4047 ( Text "Cannot derive Generic-based Swagger Schema for " :<>: ShowType t
@@ -44,6 +51,7 @@ type family GenericHasSimpleShape t (f :: Symbol) (s :: TypeShape) :: Constraint
4451 :$$: Text "that matches aeson's Generic-based toJSON,"
4552 :$$: Text "but that's not supported by some Swagger tools."
4653 )
54+#endif
4755
4856-- | Infer a 'TypeShape' for a generic representation of a type.
4957type family GenericShape (g :: * -> *) :: TypeShape
@@ -54,3 +62,5 @@ type instance GenericShape (D1 d f) = GenericShape f
5462type instance GenericShape (C1 c U1) = Enumeration
5563type instance GenericShape (C1 c (S1 s f)) = SumOfProducts
5664type instance GenericShape (C1 c (f :*: g)) = SumOfProducts
65+
66+
src/Data/OpenApi/Internal/Utils.hs → src/Data/Swagger/Internal/Utils.hsrenamed+1−7
@@ -4,7 +4,7 @@
44{-# LANGUAGE OverloadedStrings #-}
55{-# LANGUAGE RankNTypes #-}
66{-# LANGUAGE TypeOperators #-}
7−module Data.OpenApi.Internal.Utils where
7+module Data.Swagger.Internal.Utils where
88
99import Prelude ()
1010import Prelude.Compat
@@ -13,8 +13,6 @@ 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
1816import Data.Char
1917import Data.Data
2018import Data.Hashable (Hashable)
@@ -46,7 +44,6 @@ swaggerFieldRules = defaultFieldRules & lensField %~ swaggerFieldNamer
4644 fixName' "maximum" = "maximum_" -- Prelude conflict
4745 fixName' "enum" = "enum_" -- Control.Lens conflict
4846 fixName' "head" = "head_" -- Prelude conflict
49− fixName' "not" = "not_" -- Prelude conflict
5047 fixName' n = n
5148
5249gunfoldEnum :: String -> [a] -> (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a
@@ -134,6 +131,3 @@ instance SwaggerMonoid (Maybe a) where
134131 swaggerMempty = Nothing
135132 swaggerMappend x Nothing = x
136133 swaggerMappend _ y = y
137−
138−encodePretty :: ToJSON a => a -> BSL.ByteString
139−encodePretty = P.encodePretty' $ P.defConfig { P.confCompare = P.compare }
src/Data/Swagger/Lens.hsnew file+186
@@ -0,0 +1,186 @@
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/OpenApi/Operation.hs → src/Data/Swagger/Operation.hsrenamed+36−148
@@ -1,13 +1,13 @@
11{-# LANGUAGE RankNTypes #-}
22-- |
3−-- Module: Data.OpenApi.Operation
3+-- Module: Data.Swagger.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.OpenApi.Operation (
10+module Data.Swagger.Operation (
1111 -- * Operation traversals
1212 allOperations,
1313 operationsOf,
@@ -39,13 +39,11 @@ 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)
4442
45−import Data.OpenApi.Declare
46−import Data.OpenApi.Internal
47−import Data.OpenApi.Lens
48−import Data.OpenApi.Schema
43+import Data.Swagger.Declare
44+import Data.Swagger.Internal
45+import Data.Swagger.Lens
46+import Data.Swagger.Schema
4947
5048import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
5149import qualified Data.HashSet.InsOrd as InsOrdHS
@@ -54,18 +52,14 @@ import qualified Data.HashSet.InsOrd as InsOrdHS
5452-- >>> import Data.Aeson
5553-- >>> import Data.Proxy
5654-- >>> import Data.Time
57−-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
58−-- >>> import Data.OpenApi.Internal.Utils
5955
6056-- | Prepend path piece to all operations of the spec.
6157-- Leading and trailing slashes are trimmed/added automatically.
6258--
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
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
6963prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
7064 where
7165 x </> y = case trim y of
@@ -75,7 +69,7 @@ prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
7569 trim = dropWhile (== '/') . dropWhileEnd (== '/')
7670
7771-- | All operations of a Swagger spec.
78−allOperations :: Traversal' OpenApi Operation
72+allOperations :: Traversal' Swagger Operation
7973allOperations = paths.traverse.template
8074
8175-- | @'operationsOf' sub@ will traverse only those operations
@@ -83,66 +77,13 @@ allOperations = paths.traverse.template
8377-- by both path and method.
8478--
8579-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
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
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
14687operationsOf sub = paths.itraversed.withIndex.subops
14788 where
14889 -- | Traverse operations that correspond to paths and methods of the sub API.
@@ -164,12 +105,12 @@ operationsOf sub = paths.itraversed.withIndex.subops
164105-- @
165106-- 'applyTags' = 'applyTagsFor' 'allOperations'
166107-- @
167−applyTags :: [Tag] -> OpenApi -> OpenApi
108+applyTags :: [Tag] -> Swagger -> Swagger
168109applyTags = applyTagsFor allOperations
169110
170111-- | Apply tags to a part of Swagger spec and update the global
171112-- list of tags.
172−applyTagsFor :: Traversal' OpenApi Operation -> [Tag] -> OpenApi -> OpenApi
113+applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
173114applyTagsFor ops ts swag = swag
174115 & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))
175116 & tags %~ (<> InsOrdHS.fromList ts)
@@ -177,32 +118,12 @@ applyTagsFor ops ts swag = swag
177118-- | Construct a response with @'Schema'@ while declaring all
178119-- necessary schema definitions.
179120--
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
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
204125 s <- declareSchemaRef proxy
205− return (mempty & content.at cType ?~ (mempty & schema ?~ s))
126+ return (mempty & schema ?~ s)
206127
207128-- | Set response for all operations.
208129-- This will also update global schema definitions.
@@ -215,46 +136,13 @@ declareResponse cType proxy = do
215136--
216137-- Example:
217138--
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−-- }
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\"}}}"
255143--
256144-- See also @'setResponseWith'@.
257−setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
145+setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
258146setResponse = setResponseFor allOperations
259147
260148-- | Set or update response for all operations.
@@ -268,7 +156,7 @@ setResponse = setResponseFor allOperations
268156-- @
269157--
270158-- See also @'setResponse'@.
271−setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
159+setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
272160setResponseWith = setResponseForWith allOperations
273161
274162-- | Set response for specified operations.
@@ -277,9 +165,9 @@ setResponseWith = setResponseForWith allOperations
277165-- If the response already exists it will be overwritten.
278166--
279167-- See also @'setResponseForWith'@.
280−setResponseFor :: Traversal' OpenApi Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
168+setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
281169setResponseFor ops code dres swag = swag
282− & components.schemas %~ (<> defs)
170+ & definitions %~ (<> defs)
283171 & ops . at code ?~ Inline res
284172 where
285173 (defs, res) = runDeclare dres mempty
@@ -291,14 +179,14 @@ setResponseFor ops code dres swag = swag
291179-- then just the new response is used.
292180--
293181-- See also @'setResponseFor'@.
294−setResponseForWith :: Traversal' OpenApi Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
182+setResponseForWith :: Traversal' Swagger Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
295183setResponseForWith ops f code dres swag = swag
296− & components.schemas %~ (<> defs)
184+ & definitions %~ (<> defs)
297185 & ops . at code %~ Just . Inline . combine
298186 where
299187 (defs, new) = runDeclare dres mempty
300188
301− combine (Just (Ref (Reference n))) = case swag ^. components.responses.at n of
189+ combine (Just (Ref (Reference n))) = case swag ^. responses.at n of
302190 Just old -> f old new
303191 Nothing -> new -- response name can't be dereferenced, replacing with new response
304192 combine (Just (Inline old)) = f old new
src/Data/Swagger/Optics.hsnew file+597
@@ -0,0 +1,597 @@
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 #-}
src/Data/OpenApi/ParamSchema.hs → src/Data/Swagger/ParamSchema.hsrenamed+7−7
@@ -1,10 +1,10 @@
11-- |
2−-- Module: Data.OpenApi.ParamSchema
2+-- Module: Data.Swagger.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.OpenApi.ParamSchema (
7+module Data.Swagger.ParamSchema (
88 -- * Encoding
99 ToParamSchema(..),
1010
@@ -13,14 +13,14 @@ module Data.OpenApi.ParamSchema (
1313 toParamSchemaBoundedIntegral,
1414
1515 -- * Schema templates
16− passwordSchema,
17− binarySchema,
18− byteSchema,
16+ passwordParamSchema,
17+ binaryParamSchema,
18+ byteParamSchema,
1919
2020 -- * Generic encoding configuration
2121 SchemaOptions(..),
2222 defaultSchemaOptions,
2323) where
2424
25−import Data.OpenApi.Internal.ParamSchema
26−import Data.OpenApi.SchemaOptions
25+import Data.Swagger.Internal.ParamSchema
26+import Data.Swagger.SchemaOptions
src/Data/OpenApi/Schema.hs → src/Data/Swagger/Schema.hsrenamed+13−4
@@ -1,10 +1,10 @@
11-- |
2−-- Module: Data.OpenApi.Schema
2+-- Module: Data.Swagger.Schema
33-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
44-- Stability: experimental
55--
66-- Types and functions for working with Swagger schema.
7−module Data.OpenApi.Schema (
7+module Data.Swagger.Schema (
88 -- * Encoding
99 ToSchema(..),
1010 declareSchema,
@@ -32,6 +32,15 @@ module Data.OpenApi.Schema (
3232 paramSchemaToNamedSchema,
3333 paramSchemaToSchema,
3434
35+ -- ** Unrestricted versions
36+ genericDeclareNamedSchemaUnrestricted,
37+ genericDeclareSchemaUnrestricted,
38+
39+ -- * Schema templates
40+ passwordSchema,
41+ binarySchema,
42+ byteSchema,
43+
3544 -- * Sketching @'Schema'@s using @'ToJSON'@
3645 sketchSchema,
3746 sketchStrictSchema,
@@ -48,5 +57,5 @@ module Data.OpenApi.Schema (
4857 fromAesonOptions,
4958) where
5059
51−import Data.OpenApi.Internal.Schema
52−import Data.OpenApi.SchemaOptions
60+import Data.Swagger.Internal.Schema
61+import Data.Swagger.SchemaOptions
src/Data/OpenApi/Schema/Generator.hs → src/Data/Swagger/Schema/Generator.hsrenamed+20−23
@@ -2,7 +2,7 @@
22{-# LANGUAGE OverloadedLists #-}
33{-# LANGUAGE ScopedTypeVariables #-}
44
5−module Data.OpenApi.Schema.Generator where
5+module Data.Swagger.Schema.Generator where
66
77import Prelude ()
88import Prelude.Compat
@@ -13,27 +13,24 @@ import Data.Aeson
1313import Data.Aeson.Types
1414import qualified Data.HashMap.Strict.InsOrd as M
1515import Data.Maybe
16+import Data.Maybe
1617import Data.Proxy
1718import Data.Scientific
1819import qualified Data.Set as S
19−import Data.OpenApi
20−import Data.OpenApi.Declare
21−import Data.OpenApi.Internal.Schema.Validation (inferSchemaTypes)
20+import Data.Swagger
21+import Data.Swagger.Declare
22+import Data.Swagger.Internal.Schema.Validation (inferSchemaTypes)
2223import qualified Data.Text as T
2324import qualified Data.Vector as V
2425import Test.QuickCheck (arbitrary)
2526import Test.QuickCheck.Gen
2627import Test.QuickCheck.Property
2728
28−import Data.OpenApi.Aeson.Compat (fromInsOrdHashMap)
29−
3029-- | Note: 'schemaGen' may 'error', if schema type is not specified,
3130-- and cannot be inferred.
3231schemaGen :: Definitions Schema -> Schema -> Gen Value
3332schemaGen _ schema
34− | Just cases <- schema ^. enum_ = elements cases
35−schemaGen defns schema
36− | Just variants <- schema ^. oneOf = schemaGen defns =<< elements (dereference defns <$> variants)
33+ | Just cases <- schema ^. paramSchema . enum_ = elements cases
3734schemaGen defns schema =
3835 case schema ^. type_ of
3936 Nothing ->
@@ -41,25 +38,25 @@ schemaGen defns schema =
4138 [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)
4239 -- Gen is not MonadFail
4340 _ -> error "unable to infer schema type"
44− Just OpenApiBoolean -> Bool <$> elements [True, False]
45− Just OpenApiNull -> pure Null
46− Just OpenApiNumber
41+ Just SwaggerBoolean -> Bool <$> elements [True, False]
42+ Just SwaggerNull -> pure Null
43+ Just SwaggerNumber
4744 | Just min <- schema ^. minimum_
4845 , Just max <- schema ^. maximum_ ->
4946 Number . fromFloatDigits <$>
5047 choose (toRealFloat min, toRealFloat max :: Double)
5148 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)
52− Just OpenApiInteger
49+ Just SwaggerInteger
5350 | Just min <- schema ^. minimum_
5451 , Just max <- schema ^. maximum_ ->
5552 Number . fromInteger <$>
5653 choose (truncate min, truncate max)
5754 | otherwise -> Number . fromInteger <$> arbitrary
58− Just OpenApiArray
55+ Just SwaggerArray
5956 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
6057 | Just items <- schema ^. items ->
6158 case items of
62− OpenApiItemsObject ref -> do
59+ SwaggerItemsObject ref -> do
6360 size <- getSize
6461 let itemSchema = dereference defns ref
6562 minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems
@@ -67,17 +64,17 @@ schemaGen defns schema =
6764 arrayLength <- choose (minLength', max minLength' maxLength')
6865 generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema
6966 return . Array $ V.fromList generatedArray
70− OpenApiItemsArray refs ->
67+ SwaggerItemsArray refs ->
7168 let itemGens = schemaGen defns . dereference defns <$> refs
7269 in fmap (Array . V.fromList) $ sequence itemGens
73− Just OpenApiString -> do
70+ Just SwaggerString -> do
7471 size <- getSize
7572 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
7673 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
7774 length <- choose (minLength', max minLength' maxLength')
7875 str <- vectorOf length arbitrary
7976 return . String $ T.pack str
80− Just OpenApiObject -> do
77+ Just SwaggerObject -> do
8178 size <- getSize
8279 let props = dereference defns <$> schema ^. properties
8380 reqKeys = S.fromList $ schema ^. required
@@ -97,11 +94,11 @@ schemaGen defns schema =
9794 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
9895 _ -> return []
9996 x <- sequence $ gens <> additionalGens
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
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
105102
106103genValue :: (ToSchema a) => Proxy a -> Gen Value
107104genValue p =
src/Data/OpenApi/Schema/Validation.hs → src/Data/Swagger/Schema/Validation.hsrenamed+7−7
@@ -1,10 +1,10 @@
11-- |
2−-- Module: Data.OpenApi.Schema.Validation
2+-- Module: Data.Swagger.Schema.Validation
33-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
44-- Stability: experimental
55--
66-- Validate JSON values with Swagger Schema.
7−module Data.OpenApi.Schema.Validation (
7+module Data.Swagger.Schema.Validation (
88 -- * How to use validation
99 -- $howto
1010
@@ -29,13 +29,13 @@ module Data.OpenApi.Schema.Validation (
2929 validateJSONWithPatternChecker,
3030) where
3131
32−import Data.OpenApi.Internal.Schema.Validation
32+import Data.Swagger.Internal.Schema.Validation
3333
3434-- $setup
3535-- >>> import Control.Lens
3636-- >>> import Data.Aeson
3737-- >>> import Data.Proxy
38−-- >>> import Data.OpenApi
38+-- >>> import Data.Swagger
3939-- >>> import GHC.Generics
4040-- >>> :set -XDeriveGeneric
4141
@@ -71,11 +71,11 @@ import Data.OpenApi.Internal.Schema.Validation
7171-- generally fails for @null@ JSON:
7272--
7373-- >>> validateToJSON (Nothing :: Maybe String)
74−-- ["expected JSON value of type OpenApiString"]
74+-- ["expected JSON value of type SwaggerString"]
7575-- >>> validateToJSON ([Just "hello", Nothing] :: [Maybe String])
76−-- ["expected JSON value of type OpenApiString"]
76+-- ["expected JSON value of type SwaggerString"]
7777-- >>> validateToJSON (123, Nothing :: Maybe String)
78−-- ["expected JSON value of type OpenApiString"]
78+-- ["expected JSON value of type SwaggerString"]
7979--
8080-- However, when @'Maybe' a@ is a type of a record field,
8181-- validation takes @'required'@ property of the @'Schema'@
src/Data/OpenApi/SchemaOptions.hs → src/Data/Swagger/SchemaOptions.hsrenamed+3−7
@@ -1,11 +1,11 @@
11{-# LANGUAGE RecordWildCards #-}
22-- |
3−-- Module: Data.OpenApi.SchemaOptions
3+-- Module: Data.Swagger.SchemaOptions
44-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
55-- Stability: experimental
66--
77-- Generic deriving options for @'ToParamSchema'@ and @'ToSchema'@.
8−module Data.OpenApi.SchemaOptions where
8+module Data.Swagger.SchemaOptions where
99
1010import qualified Data.Aeson.Types as Aeson
1111
@@ -22,8 +22,6 @@ 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
2725 }
2826
2927-- | Default encoding @'SchemaOptions'@.
@@ -35,7 +33,6 @@ data SchemaOptions = SchemaOptions
3533-- , 'datatypeNameModifier' = id
3634-- , 'allNullaryToStringTag' = True
3735-- , 'unwrapUnaryRecords' = False
38−-- , 'sumEncoding' = 'Aeson.defaultTaggedObject'
3936-- }
4037-- @
4138defaultSchemaOptions :: SchemaOptions
@@ -45,7 +42,6 @@ defaultSchemaOptions = SchemaOptions
4542 , datatypeNameModifier = id
4643 , allNullaryToStringTag = True
4744 , unwrapUnaryRecords = False
48− , sumEncoding = Aeson.defaultTaggedObject
4945 }
5046
5147-- | Convert 'Aeson.Options' to 'SchemaOptions'.
@@ -60,6 +56,7 @@ defaultSchemaOptions = SchemaOptions
6056-- Note that these fields have no effect on `SchemaOptions`:
6157--
6258-- * 'Aeson.omitNothingFields'
59+-- * 'Aeson.sumEncoding'
6360-- * 'Aeson.tagSingleConstructors'
6461--
6562-- The rest is defined as in 'defaultSchemaOptions'.
@@ -72,5 +69,4 @@ fromAesonOptions opts = defaultSchemaOptions
7269 , constructorTagModifier = Aeson.constructorTagModifier opts
7370 , allNullaryToStringTag = Aeson.allNullaryToStringTag opts
7471 , unwrapUnaryRecords = Aeson.unwrapUnaryRecords opts
75− , sumEncoding = Aeson.sumEncoding opts
7672 }
stack.yaml+5−5
@@ -1,9 +1,9 @@
1−resolver: lts-16.31
1+resolver: lts-14.3
22packages:
33- '.'
44extra-deps:
5−- optics-core-0.3
6−- optics-th-0.3
7−- optics-extra-0.3
5+- optics-core-0.2
6+- optics-th-0.2
7+- optics-extra-0.2
88- indexed-profunctors-0.1
9−- insert-ordered-containers-0.2.3.1
9+- insert-ordered-containers-0.2.3
swagger2.cabalnew file+154
@@ -0,0 +1,154 @@
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+ , aeson-pretty >=0.8.7 && <0.9
65+ , bytestring >=0.10.4.0 && <0.11
66+ , containers >=0.5.5.1 && <0.7
67+ , template-haskell >=2.9.0.0 && <2.16
68+ , time >=1.4.2 && <1.10
69+ , transformers >=0.3.0.0 && <0.6
70+
71+ build-depends:
72+ mtl >=2.1 && <2.3
73+ , text >=1.2.3.0 && <1.3
74+
75+ -- other dependencies
76+ build-depends:
77+ base-compat-batteries >=0.10.4 && <0.12
78+ , aeson >=1.4.2.0 && <1.5
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/OpenApiSpec.hsdeleted−962
@@ -1,962 +0,0 @@
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/OpenApi/CommonTestTypes.hs → test/Data/Swagger/CommonTestTypes.hsrenamed+101−464
@@ -2,7 +2,7 @@
22{-# LANGUAGE QuasiQuotes #-}
33{-# LANGUAGE ScopedTypeVariables #-}
44
5−module Data.OpenApi.CommonTestTypes where
5+module Data.Swagger.CommonTestTypes where
66
77import Prelude ()
88import Prelude.Compat
@@ -15,10 +15,9 @@ import Data.Map (Map)
1515import Data.Proxy
1616import Data.Set (Set)
1717import qualified Data.Text as Text
18−import Data.Word
1918import GHC.Generics
2019
21−import Data.OpenApi
20+import Data.Swagger
2221
2322-- ========================================================================
2423-- Unit type
@@ -88,7 +87,7 @@ paintSchemaJSON = [aesonQQ|
8887 {
8988 "color":
9089 {
91− "$ref": "#/components/schemas/Color"
90+ "$ref": "#/definitions/Color"
9291 }
9392 },
9493 "required": ["color"]
@@ -181,7 +180,7 @@ userGroupSchemaJSON :: Value
181180userGroupSchemaJSON = [aesonQQ|
182181{
183182 "type": "array",
184− "items": { "$ref": "#/components/schemas/UserId" },
183+ "items": { "$ref": "#/definitions/UserId" },
185184 "uniqueItems": true
186185}
187186|]
@@ -228,7 +227,7 @@ playerSchemaJSON = [aesonQQ|
228227 {
229228 "position":
230229 {
231− "$ref": "#/components/schemas/Point"
230+ "$ref": "#/definitions/Point"
232231 }
233232 },
234233 "required": ["position"]
@@ -250,7 +249,7 @@ playersSchemaJSON = [aesonQQ|
250249 {
251250 "position":
252251 {
253− "$ref": "#/components/schemas/Point"
252+ "$ref": "#/definitions/Point"
254253 }
255254 },
256255 "required": ["position"]
@@ -271,192 +270,106 @@ instance ToSchema Character
271270characterSchemaJSON :: Value
272271characterSchemaJSON = [aesonQQ|
273272{
274− "oneOf": [
273+ "type": "object",
274+ "properties":
275275 {
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"
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"]
290286 }
291− }
292287 },
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"
288+ "maxProperties": 1,
289+ "minProperties": 1
317290}
318−
319291|]
320292
321293characterInlinedSchemaJSON :: Value
322294characterInlinedSchemaJSON = [aesonQQ|
323295{
324− "oneOf": [
296+ "type": "object",
297+ "properties":
325298 {
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− ],
299+ "PC":
300+ {
342301 "type": "object",
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"
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"]
358313 }
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− ]
314+ },
315+ "required": ["position"]
378316 },
379− "npcPosition": {
380− "required": [
381− "x",
382− "y"
383− ],
317+ "NPC":
318+ {
384319 "type": "object",
385− "properties": {
386− "x": {
387− "format": "double",
388− "type": "number"
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+ }
389333 },
390− "y": {
391− "format": "double",
392− "type": "number"
393− }
394− }
395− },
396− "npcName": {
397− "type": "string"
334+ "required": ["npcName", "npcPosition"]
398335 }
399− }
400− }
401− ],
402− "type": "object"
336+ },
337+ "maxProperties": 1,
338+ "minProperties": 1
403339}
404340|]
405341
406342characterInlinedPlayerSchemaJSON :: Value
407343characterInlinedPlayerSchemaJSON = [aesonQQ|
408344{
409− "oneOf": [
345+ "type": "object",
346+ "properties":
410347 {
411− "required": [
412− "tag",
413− "contents"
414− ],
415− "type": "object",
416− "properties": {
417− "tag": {
418− "type": "string",
419− "enum": [
420− "PC"
421− ]
348+ "PC":
349+ {
350+ "type": "object",
351+ "properties":
352+ {
353+ "position":
354+ {
355+ "$ref": "#/definitions/Point"
356+ }
357+ },
358+ "required": ["position"]
422359 },
423− "contents": {
424− "required": [
425− "position"
426− ],
360+ "NPC":
361+ {
427362 "type": "object",
428− "properties": {
429− "position": {
430− "$ref": "#/components/schemas/Point"
431− }
432− }
363+ "properties":
364+ {
365+ "npcName": { "type": "string" },
366+ "npcPosition": { "$ref": "#/definitions/Point" }
367+ },
368+ "required": ["npcName", "npcPosition"]
433369 }
434− }
435370 },
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"
371+ "maxProperties": 1,
372+ "minProperties": 1
460373}
461374|]
462375
@@ -568,7 +481,7 @@ myRoseTreeSchemaJSON = [aesonQQ|
568481 "type": "array",
569482 "items":
570483 {
571− "$ref": "#/components/schemas/RoseTree"
484+ "$ref": "#/definitions/RoseTree"
572485 }
573486 }
574487 },
@@ -597,7 +510,7 @@ myRoseTreeSchemaJSON' = [aesonQQ|
597510 "type": "array",
598511 "items":
599512 {
600− "$ref": "#/components/schemas/myrosetree'"
513+ "$ref": "#/definitions/myrosetree'"
601514 }
602515 }
603516 },
@@ -628,169 +541,42 @@ data Light
628541 deriving (Generic)
629542
630543instance ToSchema Light where
631− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
544+ declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
632545 { unwrapUnaryRecords = True }
633546
634547lightSchemaJSON :: Value
635548lightSchemaJSON = [aesonQQ|
636549{
637− "oneOf": [
638− {
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− }
670− },
550+ "type": "object",
551+ "properties":
671552 {
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− }
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" }
688557 },
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"
558+ "maxProperties": 1,
559+ "minProperties": 1
710560}
711561|]
712562
713563lightInlinedSchemaJSON :: Value
714564lightInlinedSchemaJSON = [aesonQQ|
715565{
716− "oneOf": [
717− {
718− "required": [
719− "tag"
720− ],
721− "type": "object",
722− "properties": {
723− "tag": {
724− "type": "string",
725− "enum": [
726− "NoLight"
727− ]
728− }
729− }
730− },
731− {
732− "required": [
733− "tag",
734− "contents"
735− ],
736− "type": "object",
737− "properties": {
738− "tag": {
739− "type": "string",
740− "enum": [
741− "LightFreq"
742− ]
743− },
744− "contents": {
745− "format": "double",
746− "type": "number"
747− }
748− }
749− },
566+ "type": "object",
567+ "properties":
750568 {
751− "required": [
752− "tag",
753− "contents"
754− ],
755− "type": "object",
756− "properties": {
757− "tag": {
569+ "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },
570+ "LightFreq": { "type": "number", "format": "double" },
571+ "LightColor":
572+ {
758573 "type": "string",
759− "enum": [
760− "LightColor"
761− ]
574+ "enum": ["Red", "Green", "Blue"]
762575 },
763− "contents": {
764− "type": "string",
765− "enum": [
766− "Red",
767− "Green",
768− "Blue"
769− ]
770− }
771− }
576+ "LightWaveLength": { "type": "number", "format": "double" }
772577 },
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"
578+ "maxProperties": 1,
579+ "minProperties": 1
794580}
795581|]
796582
@@ -863,129 +649,6 @@ singleMaybeFieldSchemaJSON = [aesonQQ|
863649}
864650|]
865651
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−|]
989652
990653-- ========================================================================
991654-- TimeOfDay
@@ -1013,30 +676,4 @@ timeOfDayParamSchemaJSON = [aesonQQ|
1013676 "type": "string",
1014677 "format": "hh:MM:ss"
1015678}
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−|]
679+|]
test/Data/OpenApi/ParamSchemaSpec.hs → test/Data/Swagger/ParamSchemaSpec.hsrenamed+5−4
@@ -4,7 +4,7 @@
44{-# LANGUAGE TemplateHaskell #-}
55{-# LANGUAGE QuasiQuotes #-}
66{-# LANGUAGE OverloadedStrings #-}
7−module Data.OpenApi.ParamSchemaSpec where
7+module Data.Swagger.ParamSchemaSpec where
88
99import Data.Aeson
1010import Data.Aeson.QQ.Simple
@@ -12,9 +12,10 @@ import Data.Char
1212import Data.Proxy
1313import GHC.Generics
1414
15−import Data.OpenApi
15+import Data.Swagger
16+import Data.Swagger.Internal (SwaggerKind(..))
1617
17−import Data.OpenApi.CommonTestTypes
18+import Data.Swagger.CommonTestTypes
1819import SpecCommon
1920import Test.Hspec
2021import Data.Time.LocalTime
@@ -22,7 +23,7 @@ import Data.Time.LocalTime
2223import qualified Data.HashMap.Strict as HM
2324
2425checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec
25−checkToParamSchema proxy js = (toParamSchema proxy :: Schema) <=> js
26+checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js
2627
2728spec :: Spec
2829spec = do
test/Data/OpenApi/Schema/GeneratorSpec.hs → test/Data/Swagger/Schema/GeneratorSpec.hsrenamed+7−7
@@ -1,13 +1,13 @@
11{-# LANGUAGE OverloadedLists #-}
22{-# LANGUAGE OverloadedStrings #-}
33{-# LANGUAGE PackageImports #-}
4−module Data.OpenApi.Schema.GeneratorSpec where
4+module Data.Swagger.Schema.GeneratorSpec where
55
66import Prelude ()
77import Prelude.Compat
88
9−import Data.OpenApi
10−import Data.OpenApi.Schema.Generator
9+import Data.Swagger
10+import Data.Swagger.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_ ?~ OpenApiObject
106+ & type_ ?~ SwaggerObject
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_ ?~ OpenApiObject
126+ & type_ ?~ SwaggerObject
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_ ?~ OpenApiObject
148+ & type_ ?~ SwaggerObject
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_ ?~ OpenApiObject
166+ & type_ ?~ SwaggerObject
167167 & properties .~ [("propE", boolSchema)]
168168 & required .~ ["propE"]
test/Data/OpenApi/Schema/ValidationSpec.hs → test/Data/Swagger/Schema/ValidationSpec.hsrenamed+9−55
@@ -4,15 +4,11 @@
44{-# LANGUAGE RecordWildCards #-}
55{-# LANGUAGE ScopedTypeVariables #-}
66{-# OPTIONS_GHC -fno-warn-orphans #-}
7−module Data.OpenApi.Schema.ValidationSpec where
7+module Data.Swagger.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
1612import Data.Aeson.Types
1713import Data.Hashable (Hashable)
1814import Data.HashMap.Strict (HashMap)
@@ -33,9 +29,8 @@ import Data.Version (Version)
3329import Data.Word
3430import GHC.Generics
3531
36−import Data.OpenApi
37−import Data.OpenApi.Declare
38−import Data.OpenApi.Aeson.Compat (stringToKey)
32+import Data.Swagger
33+import Data.Swagger.Declare
3934
4035import Test.Hspec
4136import Test.Hspec.QuickCheck
@@ -97,8 +92,6 @@ spec = do
9792 prop "Paint" $ shouldValidate (Proxy :: Proxy Paint)
9893 prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
9994 prop "Light" $ shouldValidate (Proxy :: Proxy Light)
100− prop "Light TaggedObject" $ shouldValidate (Proxy :: Proxy LightTaggedObject)
101− prop "Light UntaggedValue" $ shouldValidate (Proxy :: Proxy LightUntaggedValue)
10295 prop "ButtonImages" $ shouldValidate (Proxy :: Proxy ButtonImages)
10396 prop "Version" $ shouldValidate (Proxy :: Proxy Version)
10497 prop "FreeForm" $ shouldValidate (Proxy :: Proxy FreeForm)
@@ -130,9 +123,9 @@ instance Arbitrary Person where
130123
131124invalidPersonToJSON :: Person -> Value
132125invalidPersonToJSON Person{..} = object
133− [ stringToKey "personName" .= toJSON name
134− , stringToKey "personPhone" .= toJSON phone
135− , stringToKey "personEmail" .= toJSON email
126+ [ T.pack "personName" .= toJSON name
127+ , T.pack "personPhone" .= toJSON phone
128+ , T.pack "personEmail" .= toJSON email
136129 ]
137130
138131-- ========================================================================
@@ -196,10 +189,10 @@ instance Arbitrary MyRoseTree where
196189data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic)
197190
198191instance ToSchema Light where
199− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = ObjectWithSingleField }
192+ declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
200193
201194instance ToJSON Light where
202− toJSON = genericToJSON defaultOptions { Data.Aeson.Types.sumEncoding = ObjectWithSingleField }
195+ toJSON = genericToJSON defaultOptions { sumEncoding = ObjectWithSingleField }
203196
204197instance Arbitrary Light where
205198 arbitrary = oneof
@@ -211,34 +204,6 @@ instance Arbitrary Light where
211204invalidLightToJSON :: Light -> Value
212205invalidLightToJSON = genericToJSON defaultOptions
213206
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−
242207-- ========================================================================
243208-- ButtonImages (bounded enum key mapping)
244209-- ========================================================================
@@ -283,7 +248,7 @@ instance ToJSON FreeForm where
283248
284249instance ToSchema FreeForm where
285250 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
286− & type_ ?~ OpenApiObject
251+ & type_ ?~ SwaggerObject
287252 & additionalProperties ?~ AdditionalPropertiesAllowed True
288253
289254instance Arbitrary FreeForm where
@@ -301,8 +266,6 @@ instance Eq ZonedTime where
301266-- Arbitrary instance for Data.Aeson.Value
302267-- ========================================================================
303268
304−-- These instances were introduces in aeson upstream in 2.0.3
305−#if !MIN_VERSION_aeson(2,0,3)
306269instance Arbitrary Value where
307270 -- Weights are almost random
308271 -- Uniform oneof tends not to build complex objects cause of recursive call.
@@ -313,12 +276,3 @@ instance Arbitrary Value where
313276 , (3, Number <$> arbitrary)
314277 , (3, Bool <$> arbitrary)
315278 , (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/OpenApi/SchemaSpec.hs → test/Data/Swagger/SchemaSpec.hsrenamed+11−16
@@ -2,7 +2,7 @@
22{-# LANGUAGE ScopedTypeVariables #-}
33{-# LANGUAGE TemplateHaskell #-}
44{-# LANGUAGE QuasiQuotes #-}
5−module Data.OpenApi.SchemaSpec where
5+module Data.Swagger.SchemaSpec where
66
77import Prelude ()
88import Prelude.Compat
@@ -14,54 +14,51 @@ import Data.Proxy
1414import Data.Set (Set)
1515import qualified Data.Text as Text
1616
17−import Data.OpenApi
18−import Data.OpenApi.Declare
17+import Data.Swagger
18+import Data.Swagger.Declare
1919
20−import Data.OpenApi.CommonTestTypes
20+import Data.Swagger.CommonTestTypes
2121import SpecCommon
2222import Test.Hspec
2323
2424import qualified Data.HashMap.Strict as HM
2525import Data.Time.LocalTime
2626
27−checkToSchema :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
27+checkToSchema :: ToSchema a => Proxy a -> Value -> Spec
2828checkToSchema proxy js = toSchema proxy <=> js
2929
30−checkSchemaName :: (HasCallStack, ToSchema a) => Maybe String -> Proxy a -> Spec
30+checkSchemaName :: 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 :: (HasCallStack, ToSchema a) => Proxy a -> [String] -> Spec
35+checkDefs :: 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 :: (HasCallStack, ToSchema a) => Proxy a -> [String] -> Spec
42+checkProperties :: 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 :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
49+checkInlinedSchema :: ToSchema a => Proxy a -> Value -> Spec
5050checkInlinedSchema proxy js = toInlinedSchema proxy <=> js
5151
52−checkInlinedSchemas :: (HasCallStack, ToSchema a) => [String] -> Proxy a -> Value -> Spec
52+checkInlinedSchemas :: 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 :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
57+checkInlinedRecSchema :: 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−
6562spec :: Spec
6663spec = do
6764 describe "Generic ToSchema" $ do
@@ -81,7 +78,6 @@ spec = do
8178 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON
8279 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON
8380 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
8581 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON
8682 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
8783 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
@@ -89,7 +85,6 @@ spec = do
8985 context "Status (sum of unary constructors)" $ checkToSchema (Proxy :: Proxy Status) statusSchemaJSON
9086 context "Character (ref and record sum)" $ checkToSchema (Proxy :: Proxy Character) characterSchemaJSON
9187 context "Light (sum with unwrapUnaryRecords)" $ checkToSchema (Proxy :: Proxy Light) lightSchemaJSON
92− context "UnsignedInts" $ checkToSchema (Proxy :: Proxy UnsignedInts) unsignedIntsSchemaJSON
9388 context "Schema name" $ do
9489 context "String" $ checkSchemaName Nothing (Proxy :: Proxy String)
9590 context "(Int, Float)" $ checkSchemaName Nothing (Proxy :: Proxy (Int, Float))
test/Data/SwaggerSpec.hsnew file+1702
@@ -0,0 +1,1702 @@
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+9−1
@@ -8,7 +8,15 @@ import qualified Data.Vector as Vector
88
99import Test.Hspec
1010
11−(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec
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
1220x <=> js = do
1321 it "encodes correctly" $ do
1422 toJSON x `shouldBe` js