git.iko.soy/typeable/openapi3
on feaeb64 help sign in
.ghcinew file+1
since splitsnapshots
unifiedsplit
@@ -0,0 +1 @@
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
.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+167
@@ -0,0 +1,167 @@
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.3.20190429
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+ env: GHCHEAD=true
35+ - compiler: ghc-8.6.5
36+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-2.4"]}}
37+ - compiler: ghc-8.4.4
38+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-2.4"]}}
39+ - compiler: ghc-8.2.2
40+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-2.4"]}}
41+ - compiler: ghc-8.0.2
42+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-2.4"]}}
43+ - compiler: ghc-7.10.3
44+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4"]}}
45+ - compiler: ghc-7.8.4
46+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4"]}}
47+ allow_failures:
48+ - compiler: ghc-8.8.1
49+before_install:
50+ - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
51+ - HCPKG="$HC-pkg"
52+ - unset CC
53+ - CABAL=/opt/ghc/bin/cabal
54+ - CABALHOME=$HOME/.cabal
55+ - export PATH="$CABALHOME/bin:$PATH"
56+ - TOP=$(pwd)
57+ - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))
58+ - echo $HCNUMVER
59+ - CABAL="$CABAL -vnormal+nowrap+markoutput"
60+ - set -o pipefail
61+ - |
62+ echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk
63+ echo 'BEGIN { state = "output"; }' >> .colorful.awk
64+ echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk
65+ echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk
66+ echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk
67+ echo ' if (state == "cabal") {' >> .colorful.awk
68+ echo ' print blue($0)' >> .colorful.awk
69+ echo ' } else {' >> .colorful.awk
70+ echo ' print $0' >> .colorful.awk
71+ echo ' }' >> .colorful.awk
72+ echo '}' >> .colorful.awk
73+ - cat .colorful.awk
74+ - |
75+ color_cabal_output () {
76+ awk -f $TOP/.colorful.awk
77+ }
78+ - echo text | color_cabal_output
79+install:
80+ - ${CABAL} --version
81+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
82+ - TEST=--enable-tests
83+ - BENCH=--enable-benchmarks
84+ - GHCHEAD=${GHCHEAD-false}
85+ - rm -f $CABALHOME/config
86+ - |
87+ echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
88+ echo "remote-build-reporting: anonymous" >> $CABALHOME/config
89+ echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
90+ echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
91+ echo "world-file: $CABALHOME/world" >> $CABALHOME/config
92+ echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
93+ echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
94+ echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
95+ echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
96+ echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
97+ echo "install-dirs user" >> $CABALHOME/config
98+ echo " prefix: $CABALHOME" >> $CABALHOME/config
99+ echo "repository hackage.haskell.org" >> $CABALHOME/config
100+ echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
101+ - |
102+ if $GHCHEAD; then
103+ echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1/g')" >> $CABALHOME/config
104+
105+ echo "repository head.hackage" >> $CABALHOME/config
106+ echo " url: http://head.hackage.haskell.org/" >> $CABALHOME/config
107+ echo " secure: True" >> $CABALHOME/config
108+ echo " root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740" >> $CABALHOME/config
109+ echo " 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb" >> $CABALHOME/config
110+ echo " 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e" >> $CABALHOME/config
111+ echo " key-threshold: 3" >> $CABALHOME/config
112+ fi
113+ - cat $CABALHOME/config
114+ - rm -fv cabal.project cabal.project.local cabal.project.freeze
115+ - travis_retry ${CABAL} v2-update -v
116+ # Generate cabal.project
117+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
118+ - touch cabal.project
119+ - |
120+ echo 'packages: "."' >> cabal.project
121+ - |
122+ echo "write-ghc-environment-files: always" >> cabal.project
123+ - "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"
124+ - cat cabal.project || true
125+ - cat cabal.project.local || true
126+ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
127+ - ${CABAL} v2-freeze -w ${HC} ${TEST} ${BENCH} | color_cabal_output
128+ - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
129+ - rm cabal.project.freeze
130+ - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all | color_cabal_output
131+ - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output
132+script:
133+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
134+ # Packaging...
135+ - ${CABAL} v2-sdist all | color_cabal_output
136+ # Unpacking...
137+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
138+ - cd ${DISTDIR} || false
139+ - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
140+ # Generate cabal.project
141+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
142+ - touch cabal.project
143+ - |
144+ echo 'packages: "swagger2-*/*.cabal"' >> cabal.project
145+ - |
146+ echo "write-ghc-environment-files: always" >> cabal.project
147+ - "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"
148+ - cat cabal.project || true
149+ - cat cabal.project.local || true
150+ # Building...
151+ # this builds all libraries and executables (without tests/benchmarks)
152+ - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output
153+ # Building with tests and benchmarks...
154+ # build & run tests, build benchmarks
155+ - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} all | color_cabal_output
156+ # Testing...
157+ - ${CABAL} v2-test -w ${HC} ${TEST} ${BENCH} all | color_cabal_output
158+ # cabal check...
159+ - (cd swagger2-* && ${CABAL} -vnormal check)
160+ # haddock...
161+ - if [ $HCNUMVER -ge 80400 ] ; then ${CABAL} v2-haddock -w ${HC} ${TEST} ${BENCH} all | color_cabal_output ; fi
162+ # Building without installed constraints for packages in global-db...
163+ - rm -f cabal.project.local
164+ - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output
165+
166+# REGENDATA ["--branches","master","--haddock-jobs=>=8.4","--output",".travis.yml","swagger2.cabal"]
167+# EOF
CHANGELOG.md−75
@@ -1,78 +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−
63−2.5
64−---
65−
66−Highlights:
67−- Add instance for `TimeOfDay` (see [#196]( https://github.com/GetShopTV/swagger2/pull/196 ));
68−- Add support for [`optics`](https://hackage.haskell.org/package/optics) (see [#200]( https://github.com/GetShopTV/swagger2/pull/200 ));
69−- Slightly better validation errors (see [#195]( https://github.com/GetShopTV/swagger2/pull/195 ));
70−
71−Fixes and minor changes:
72−- Minor cleanup (see [#194]( https://github.com/GetShopTV/swagger2/pull/194 ));
73−- Allow base-4.13 and other GHC-8.8 related stuff (see [#198]( https://github.com/GetShopTV/swagger2/pull/198 ));
74−- Fix `stack.yaml` (see [#201]( https://github.com/GetShopTV/swagger2/pull/201 ));
75−
762.4
12.4
77---
2---
78
3
README.md+11−13
@@ -1,22 +1,21 @@
1−# OpenApi 3
1+# swagger2
2
2
3−[![Hackage](https://img.shields.io/hackage/v/openapi3.svg)](http://hackage.haskell.org/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)
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)
7
4
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)
9
9
10−The original OpenAPI 3.0 specification is available at http://swagger.io/specification/.
10+Swagger 2.0 data model.
11
11
12−This package is heavily based on excellent work on Swagger 2.0 at
12+The original Swagger 2.0 specification is available at http://swagger.io/specification/.
13−https://github.com/GetShopTV/swagger2.
14
13
15## Usage
14## Usage
16
15
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.
18
17
19−Please refer to [haddock documentation](http://hackage.haskell.org/package/openapi3).
18+Please refer to [haddock documentation](http://hackage.haskell.org/package/swagger2).
20
19
21Some examples can be found in [`examples/` directory](/examples).
20Some examples can be found in [`examples/` directory](/examples).
22
21
@@ -34,8 +33,7 @@ Many Swagger tools, including server and client code generation for many languag
34
33
35We are happy to receive bug reports, fixes, documentation enhancements, and other improvements.
34We are happy to receive bug reports, fixes, documentation enhancements, and other improvements.
36
35
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).
38
37
39*GetShopTV Team*
38*GetShopTV Team*
40
39
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 @@
1packages: .
1packages: .
2tests: true
2tests: true
3−
4−allow-newer: http-media:base
examples/hackage.hs+20−16
@@ -10,10 +10,10 @@ import Data.Proxy
10import Data.Text (Text)
10import Data.Text (Text)
11import GHC.Generics
11import GHC.Generics
12
12
13−import Data.OpenApi
13+import Data.Swagger
14−import Data.OpenApi.Declare
14+import Data.Swagger.Declare
15−import Data.OpenApi.Lens
15+import Data.Swagger.Lens
16−import Data.OpenApi.Operation
16+import Data.Swagger.Operation
17
17
18type Username = Text
18type Username = Text
19
19
@@ -27,7 +27,7 @@ instance ToSchema UserSummary where
27 usernameSchema <- declareSchemaRef (Proxy :: Proxy Username)
27 usernameSchema <- declareSchemaRef (Proxy :: Proxy Username)
28 useridSchema <- declareSchemaRef (Proxy :: Proxy Int)
28 useridSchema <- declareSchemaRef (Proxy :: Proxy Int)
29 return $ NamedSchema (Just "UserSummary") $ mempty
29 return $ NamedSchema (Just "UserSummary") $ mempty
30− & type_ ?~ OpenApiObject
30+ & type_ ?~ SwaggerObject
31 & properties .~
31 & properties .~
32 [ ("summaryUsername", usernameSchema )
32 [ ("summaryUsername", usernameSchema )
33 , ("summaryUserid" , useridSchema )
33 , ("summaryUserid" , useridSchema )
@@ -47,36 +47,40 @@ data UserDetailed = UserDetailed
47newtype Package = Package { packageName :: Text }
47newtype Package = Package { packageName :: Text }
48 deriving (Generic, ToSchema)
48 deriving (Generic, ToSchema)
49
49
50−hackageOpenApi :: OpenApi
50+hackageSwagger :: Swagger
51−hackageOpenApi = spec & components.schemas .~ defs
51+hackageSwagger = spec & definitions .~ defs
52 where
52 where
53− (defs, spec) = runDeclare declareHackageOpenApi mempty
53+ (defs, spec) = runDeclare declareHackageSwagger mempty
54
54
55−declareHackageOpenApi :: Declare (Definitions Schema) OpenApi
55+declareHackageSwagger :: Declare (Definitions Schema) Swagger
56−declareHackageOpenApi = do
56+declareHackageSwagger = do
57 -- param schemas
57 -- param schemas
58 let usernameParamSchema = toParamSchema (Proxy :: Proxy Username)
58 let usernameParamSchema = toParamSchema (Proxy :: Proxy Username)
59
59
60 -- responses
60 -- responses
61− userSummaryResponse <- declareResponse "application/json" (Proxy :: Proxy UserSummary)
61+ userSummaryResponse <- declareResponse (Proxy :: Proxy UserSummary)
62− userDetailedResponse <- declareResponse "application/json" (Proxy :: Proxy UserDetailed)
62+ userDetailedResponse <- declareResponse (Proxy :: Proxy UserDetailed)
63− packagesResponse <- declareResponse "application/json" (Proxy :: Proxy [Package])
63+ packagesResponse <- declareResponse (Proxy :: Proxy [Package])
64
64
65 return $ mempty
65 return $ mempty
66 & paths .~
66 & paths .~
67 [ ("/users", mempty & get ?~ (mempty
67 [ ("/users", mempty & get ?~ (mempty
68+ & produces ?~ MimeList ["application/json"]
68 & at 200 ?~ Inline userSummaryResponse))
69 & at 200 ?~ Inline userSummaryResponse))
69 , ("/user/{username}", mempty & get ?~ (mempty
70 , ("/user/{username}", mempty & get ?~ (mempty
71+ & produces ?~ MimeList ["application/json"]
70 & parameters .~ [ Inline $ mempty
72 & parameters .~ [ Inline $ mempty
71 & name .~ "username"
73 & name .~ "username"
72 & required ?~ True
74 & required ?~ True
75+ & schema .~ ParamOther (mempty
73− & in_ .~ ParamPath
76+ & in_ .~ ParamPath
74− & schema ?~ Inline usernameParamSchema ]
77+ & paramSchema .~ usernameParamSchema) ]
75 & at 200 ?~ Inline userDetailedResponse))
78 & at 200 ?~ Inline userDetailedResponse))
76 , ("/packages", mempty & get ?~ (mempty
79 , ("/packages", mempty & get ?~ (mempty
80+ & produces ?~ MimeList ["application/json"]
77 & at 200 ?~ Inline packagesResponse))
81 & at 200 ?~ Inline packagesResponse))
78 ]
82 ]
79
83
80main :: IO ()
84main :: IO ()
81−main = putStrLn . read . show . encode $ hackageOpenApi
85+main = putStrLn . read . show . encode $ hackageSwagger
82
86
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+114−197
@@ -1,5 +1,6 @@
1+{-# LANGUAGE CPP #-}
1-- |
2-- |
2−-- Module: Data.OpenApi
3+-- Module: Data.Swagger
3-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
4-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
4-- Stability: experimental
5-- Stability: experimental
5--
6--
@@ -9,7 +10,7 @@
9-- These files can then be used by the Swagger-UI project to display the API
10-- These files can then be used by the Swagger-UI project to display the API
10-- and Swagger-Codegen to generate clients in various languages.
11-- and Swagger-Codegen to generate clients in various languages.
11-- Additional utilities can also take advantage of the resulting files, such as testing tools.
12-- Additional utilities can also take advantage of the resulting files, such as testing tools.
12−module Data.OpenApi (
13+module Data.Swagger (
13 -- * How to use this library
14 -- * How to use this library
14 -- $howto
15 -- $howto
15
16
@@ -29,18 +30,16 @@ module Data.OpenApi (
29 -- $validation
30 -- $validation
30
31
31 -- * Re-exports
32 -- * Re-exports
32− module Data.OpenApi.Lens,
33+ module Data.Swagger.Lens,
33− module Data.OpenApi.Optics,
34+ module Data.Swagger.Operation,
34− module Data.OpenApi.Operation,
35− module Data.OpenApi.ParamSchema,
35+ module Data.Swagger.ParamSchema,
36− module Data.OpenApi.Schema,
36+ module Data.Swagger.Schema,
37− module Data.OpenApi.Schema.Validation,
37+ module Data.Swagger.Schema.Validation,
38
38
39 -- * Swagger specification
39 -- * Swagger specification
40− OpenApi(..),
40+ Swagger(..),
41− Server(..),
41+ Host(..),
42− ServerVariable(..),
42+ Scheme(..),
43− Components(..),
44
43
45 -- ** Info types
44 -- ** Info types
46 Info(..),
45 Info(..),
@@ -56,43 +55,38 @@ module Data.OpenApi (
56 TagName,
55 TagName,
57
56
58 -- ** Types and formats
57 -- ** Types and formats
59− OpenApiType(..),
58+ SwaggerType(..),
60 Format,
59 Format,
61 Definitions,
60 Definitions,
62− Style(..),
61+ CollectionFormat(..),
63
62
64 -- ** Parameters
63 -- ** Parameters
65 Param(..),
64 Param(..),
65+ ParamAnySchema(..),
66+ ParamOtherSchema(..),
66 ParamLocation(..),
67 ParamLocation(..),
67 ParamName,
68 ParamName,
68 Header(..),
69 Header(..),
69 HeaderName,
70 HeaderName,
70 Example(..),
71 Example(..),
71− RequestBody(..),
72− MediaTypeObject(..),
73− Encoding(..),
74
72
75 -- ** Schemas
73 -- ** Schemas
74+ ParamSchema(..),
76 Schema(..),
75 Schema(..),
77 NamedSchema(..),
76 NamedSchema(..),
78− OpenApiItems(..),
77+ SwaggerItems(..),
79 Xml(..),
78 Xml(..),
80 Pattern,
79 Pattern,
81 AdditionalProperties(..),
80 AdditionalProperties(..),
82− Discriminator(..),
83
81
84 -- ** Responses
82 -- ** Responses
85 Responses(..),
83 Responses(..),
86 Response(..),
84 Response(..),
87 HttpStatusCode,
85 HttpStatusCode,
88− Link(..),
89− Callback(..),
90
86
91 -- ** Security
87 -- ** Security
92 SecurityScheme(..),
88 SecurityScheme(..),
93 SecuritySchemeType(..),
89 SecuritySchemeType(..),
94− HttpSchemeType(..),
95− SecurityDefinitions(..),
96 SecurityRequirement(..),
90 SecurityRequirement(..),
97
91
98 -- *** API key
92 -- *** API key
@@ -100,12 +94,8 @@ module Data.OpenApi (
100 ApiKeyLocation(..),
94 ApiKeyLocation(..),
101
95
102 -- *** OAuth2
96 -- *** OAuth2
103− OAuth2Flows(..),
97+ OAuth2Params(..),
104 OAuth2Flow(..),
98 OAuth2Flow(..),
105− OAuth2ImplicitFlow(..),
106− OAuth2PasswordFlow(..),
107− OAuth2ClientCredentialsFlow(..),
108− OAuth2AuthorizationCodeFlow(..),
109 AuthorizationURL,
99 AuthorizationURL,
110 TokenURL,
100 TokenURL,
111
101
@@ -121,14 +111,13 @@ module Data.OpenApi (
121 URL(..),
111 URL(..),
122) where
112) where
123
113
124−import Data.OpenApi.Lens
114+import Data.Swagger.Lens
125−import Data.OpenApi.Optics ()
115+import Data.Swagger.Operation
126−import Data.OpenApi.Operation
127−import Data.OpenApi.ParamSchema
116+import Data.Swagger.ParamSchema
128−import Data.OpenApi.Schema
117+import Data.Swagger.Schema
129−import Data.OpenApi.Schema.Validation
118+import Data.Swagger.Schema.Validation
130
119
131−import Data.OpenApi.Internal
120+import Data.Swagger.Internal
132
121
133-- $setup
122-- $setup
134-- >>> import Control.Lens
123-- >>> import Control.Lens
@@ -136,8 +125,6 @@ import Data.OpenApi.Internal
136-- >>> import Data.Monoid
125-- >>> import Data.Monoid
137-- >>> import Data.Proxy
126-- >>> import Data.Proxy
138-- >>> import GHC.Generics
127-- >>> import GHC.Generics
139−-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
140−-- >>> import Data.OpenApi.Internal.Utils
141-- >>> :set -XDeriveGeneric
128-- >>> :set -XDeriveGeneric
142-- >>> :set -XOverloadedStrings
129-- >>> :set -XOverloadedStrings
143-- >>> :set -XOverloadedLists
130-- >>> :set -XOverloadedLists
@@ -154,16 +141,8 @@ import Data.OpenApi.Internal
154--
141--
155-- In this library you can use @'mempty'@ for a default/empty value. For instance:
142-- In this library you can use @'mempty'@ for a default/empty value. For instance:
156--
143--
157−-- >>> BSL.putStrLn $ encodePretty (mempty :: OpenApi)
144+-- >>> encode (mempty :: Swagger)
158−-- {
159−-- "components": {},
160−-- "info": {
161−-- "title": "",
162−-- "version": ""
145+-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"}}"
163−-- },
164−-- "openapi": "3.0.0",
165−-- "paths": {}
166−-- }
167--
146--
168-- As you can see some spec properties (e.g. @"version"@) are there even when the spec is empty.
147-- As you can see some spec properties (e.g. @"version"@) are there even when the spec is empty.
169-- That is because these properties are actually required ones.
148-- That is because these properties are actually required ones.
@@ -171,87 +150,45 @@ import Data.OpenApi.Internal
171-- You /should/ always override the default (empty) value for these properties,
150-- You /should/ always override the default (empty) value for these properties,
172-- although it is not strictly necessary:
151-- although it is not strictly necessary:
173--
152--
174−-- >>> BSL.putStrLn $ encodePretty mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
153+-- >>> encode mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
175−-- {
176−-- "title": "Todo API",
154+-- "{\"version\":\"1.0\",\"title\":\"Todo API\"}"
177−-- "version": "1.0"
178−-- }
179--
155--
180-- You can merge two values using @'mappend'@ or its infix version @('<>')@:
156-- You can merge two values using @'mappend'@ or its infix version @('<>')@:
181--
157--
182−-- >>> BSL.putStrLn $ encodePretty $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
158+-- >>> encode $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
183−-- {
184−-- "title": "Todo API",
185−-- "version": "1.0"
159+-- "{\"version\":\"1.0\",\"title\":\"Todo API\"}"
186−-- }
187−
188--
160--
189-- This can be useful for combining specifications of endpoints into a whole API specification:
161-- This can be useful for combining specifications of endpoints into a whole API specification:
190--
162--
191-- @
163-- @
192-- \-\- /account subAPI specification
164-- \-\- /account subAPI specification
193−-- accountAPI :: OpenApi
165+-- accountAPI :: Swagger
194--
166--
195-- \-\- /task subAPI specification
167-- \-\- /task subAPI specification
196−-- taskAPI :: OpenApi
168+-- taskAPI :: Swagger
197--
169--
198-- \-\- while API specification is just a combination
170-- \-\- while API specification is just a combination
199-- \-\- of subAPIs' specifications
171-- \-\- of subAPIs' specifications
200−-- api :: OpenApi
172+-- api :: Swagger
201-- api = accountAPI <> taskAPI
173-- api = accountAPI <> taskAPI
202-- @
174-- @
203
175
204-- $lens
176-- $lens
205--
177--
206−-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.OpenApi.Optics".
207−--
208-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
178-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
209-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses
179-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses
210-- make it fairly simple to construct/modify any part of the specification:
180-- make it fairly simple to construct/modify any part of the specification:
211--
181--
212-- >>> :{
182-- >>> :{
213−-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
183+-- encode $ (mempty :: Swagger)
214−-- & components . schemas .~ [ ("User", mempty & type_ ?~ OpenApiString) ]
184+-- & definitions .~ [ ("User", mempty & type_ ?~ SwaggerString) ]
215-- & paths .~
185-- & paths .~
216-- [ ("/user", mempty & get ?~ (mempty
186-- [ ("/user", mempty & get ?~ (mempty
187+-- & produces ?~ MimeList ["application/json"]
217−-- & at 200 ?~ ("OK" & _Inline.content.at "application/json" ?~ (mempty & schema ?~ Ref (Reference "User")))
188+-- & at 200 ?~ ("OK" & _Inline.schema ?~ Ref (Reference "User"))
218-- & at 404 ?~ "User info not found")) ]
189-- & at 404 ?~ "User info not found")) ]
219-- :}
190-- :}
220−-- {
191+-- "{\"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\"}}}"
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−-- }
255--
192--
256-- In the snippet above we declare an API with a single path @/user@. This path provides method @GET@
193-- In the snippet above we declare an API with a single path @/user@. This path provides method @GET@
257-- which produces @application/json@ output. It should respond with code @200@ and body specified
194-- which produces @application/json@ output. It should respond with code @200@ and body specified
@@ -263,34 +200,30 @@ import Data.OpenApi.Internal
263-- common field is @'description'@. Many components of a Swagger specification
200-- common field is @'description'@. Many components of a Swagger specification
264-- can have descriptions, and you can use the same name for them:
201-- can have descriptions, and you can use the same name for them:
265--
202--
266−-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & description .~ "No content"
203+-- >>> encode $ (mempty :: Response) & description .~ "No content"
267−-- {
268−-- "description": "No content"
204+-- "{\"description\":\"No content\"}"
269−-- }
270-- >>> :{
205-- >>> :{
271−-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)
206+-- encode $ (mempty :: Schema)
272−-- & type_ ?~ OpenApiBoolean
207+-- & type_ ?~ SwaggerBoolean
273-- & description ?~ "To be or not to be"
208-- & description ?~ "To be or not to be"
274-- :}
209-- :}
275−-- {
276−-- "description": "To be or not to be",
210+-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"
277−-- "type": "boolean"
278−-- }
211+--
212+-- @'ParamSchema'@ is basically the /base schema specification/ and many types contain it (see @'HasParamSchema'@).
213+-- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.
214+-- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:
215+--
216+-- >>> encode $ (mempty :: Header) & type_ ?~ SwaggerNumber
217+-- "{\"type\":\"number\"}"
279--
218--
280-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
219-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
281-- have direct access to it via @'at' code@. Example:
220-- have direct access to it via @'at' code@. Example:
282--
221--
283-- >>> :{
222-- >>> :{
284−-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)
223+-- encode $ (mempty :: Operation)
285-- & at 404 ?~ "Not found"
224-- & at 404 ?~ "Not found"
286-- :}
225-- :}
287−-- {
288−-- "responses": {
289−-- "404": {
290−-- "description": "Not found"
226+-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"
291−-- }
292−-- }
293−-- }
294--
227--
295-- You might've noticed that @'type_'@ has an extra underscore in its name
228-- You might've noticed that @'type_'@ has an extra underscore in its name
296-- compared to, say, @'description'@ field accessor.
229-- compared to, say, @'description'@ field accessor.
@@ -306,7 +239,7 @@ import Data.OpenApi.Internal
306-- @'ParamSchema'@ and @'Schema'@ are the two core types for data model specification.
239-- @'ParamSchema'@ and @'Schema'@ are the two core types for data model specification.
307--
240--
308-- @'ParamSchema' t@ specifies all the common properties, available for every data schema.
241-- @'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'@).
242+-- The @t@ parameter imposes some restrictions on @type@ and @items@ properties (see @'SwaggerType'@ and @'SwaggerItems'@).
310--
243--
311-- @'Schema'@ is used for request and response bodies and allows specifying objects
244-- @'Schema'@ is used for request and response bodies and allows specifying objects
312-- with properties in addition to what @'ParamSchema'@ provides.
245-- with properties in addition to what @'ParamSchema'@ provides.
@@ -337,81 +270,65 @@ import Data.OpenApi.Internal
337-- >>> data Person = Person { name :: String, age :: Integer } deriving Generic
270-- >>> data Person = Person { name :: String, age :: Integer } deriving Generic
338-- >>> instance ToJSON Person
271-- >>> instance ToJSON Person
339-- >>> instance ToSchema Person
272-- >>> instance ToSchema Person
340−-- >>> BSL.putStrLn $ encodePretty (Person "David" 28)
273+-- >>> encode (Person "David" 28)
341−-- {
342−-- "age": 28,
343−-- "name": "David"
274+-- "{\"age\":28,\"name\":\"David\"}"
344−-- }
345−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Person)
275+-- >>> encode $ toSchema (Proxy :: Proxy Person)
346−-- {
276+-- "{\"required\":[\"name\",\"age\"],\"properties\":{\"name\":{\"type\":\"string\"},\"age\":{\"type\":\"integer\"}},\"type\":\"object\"}"
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−--
277+--
362−-- This package implements OpenAPI 3.0 spec, which supports @oneOf@ in schemas, allowing any sum types
278+-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a
363−-- to be faithfully represented. All sum encodings supported by @aeson@ are supported here as well, with
279+-- schema for basic enums like
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−--
280+--
368−-- >>> data Error = ErrorNoUser { userId :: Int } | ErrorAccessDenied { requiredPermission :: String } deriving Generic
281+-- >>> data SampleEnum = ChoiceOne | ChoiceTwo deriving Generic
369−-- >>> instance ToJSON Error
282+-- >>> instance ToSchema SampleEnum
370−-- >>> instance ToSchema Error
283+-- >>> instance ToJSON SampleEnum
371−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Error)
284+--
285+-- and for sum types that have constructors with values
286+--
287+-- >>> data SampleSumType = ChoiceInt Int | ChoiceString String deriving Generic
288+-- >>> instance ToSchema SampleSumType
289+-- >>> instance ToJSON SampleSumType
290+--
291+-- we can not derive a valid schema for a mix of the above. The following will result in a type error
372−-- {
292+--
373−-- "oneOf": [
293+#if __GLASGOW_HASKELL__ < 800
374−-- {
294+-- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic
375−-- "properties": {
295+-- >>> instance ToSchema BadMixedType
376−-- "tag": {
296+-- ...
377−-- "enum": [
297+-- ... error:
378−-- "ErrorNoUser"
298+-- ... • No instance for (Data.Swagger.Internal.TypeShape.CannotDeriveSchemaForMixedSumType
379−-- ],
299+-- ... BadMixedType)
380−-- "type": "string"
300+-- ... arising from a use of ‘Data.Swagger.Internal.Schema.$dmdeclareNamedSchema’
381−-- },
301+-- ... • In the expression:
382−-- "userId": {
302+-- ... Data.Swagger.Internal.Schema.$dmdeclareNamedSchema @BadMixedType
383−-- "maximum": 9223372036854775807,
303+-- ... In an equation for ‘declareNamedSchema’:
384−-- "minimum": -9223372036854775808,
304+-- ... declareNamedSchema
385−-- "type": "integer"
305+-- ... = Data.Swagger.Internal.Schema.$dmdeclareNamedSchema @BadMixedType
386−-- }
306+-- ... In the instance declaration for ‘ToSchema BadMixedType’
307+#else
308+-- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic
309+-- >>> instance ToSchema BadMixedType
387−-- },
310+-- ...
388−-- "required": [
311+-- ... error:
389−-- "userId",
312+-- ... • Cannot derive Generic-based Swagger Schema for BadMixedType
390−-- "tag"
313+-- ... BadMixedType is a mixed sum type (has both unit and non-unit constructors).
391−-- ],
314+-- ... Swagger does not have a good representation for these types.
392−-- "type": "object"
315+-- ... Use genericDeclareNamedSchemaUnrestricted if you want to derive schema
393−-- },
316+-- ... that matches aeson's Generic-based toJSON,
394−-- {
317+-- ... but that's not supported by some Swagger tools.
395−-- "properties": {
318+-- ... • In the expression:
396−-- "requiredPermission": {
319+-- ... Data.Swagger.Internal.Schema.$dmdeclareNamedSchema @BadMixedType
397−-- "type": "string"
320+-- ... In an equation for ‘declareNamedSchema’:
398−-- },
321+-- ... declareNamedSchema
399−-- "tag": {
322+-- ... = Data.Swagger.Internal.Schema.$dmdeclareNamedSchema @BadMixedType
400−-- "enum": [
323+-- ... In the instance declaration for ‘ToSchema BadMixedType’
401−-- "ErrorAccessDenied"
324+#endif
402−-- ],
325+--
403−-- "type": "string"
326+-- We can use 'genericDeclareNamedSchemaUnrestricted' to try our best to represent this type as a Swagger Schema and match 'ToJSON':
404−-- }
327+--
405−-- },
328+-- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic
406−-- "required": [
329+-- >>> instance ToSchema BadMixedType where declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
407−-- "requiredPermission",
330+-- >>> instance ToJSON BadMixedType
408−-- "tag"
409−-- ],
410−-- "type": "object"
411−-- }
412−-- ],
413−-- "type": "object"
414−-- }
331+--
415
332
416-- $manipulation
333-- $manipulation
417-- Sometimes you have to work with an imported or generated @'Swagger'@.
334-- Sometimes you have to work with an imported or generated @'Swagger'@.
@@ -419,10 +336,10 @@ import Data.OpenApi.Internal
419-- for a type-level servant API.
336-- for a type-level servant API.
420--
337--
421-- Lenses and prisms can be used to manipulate such specification to add additional information, tags, extra responses, etc.
338-- 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.
339+-- To facilitate common needs, @"Data.Swagger.Operation"@ module provides useful helpers.
423
340
424-- $validation
341-- $validation
425-- While @'ToParamSchema'@ and @'ToSchema'@ provide means to easily obtain schemas for Haskell types,
342-- While @'ToParamSchema'@ and @'ToSchema'@ provide means to easily obtain schemas for Haskell types,
426-- there is no static mechanism to ensure those instances correspond to the @'ToHttpApiData'@ or @'ToJSON'@ instances.
343-- there is no static mechanism to ensure those instances correspond to the @'ToHttpApiData'@ or @'ToJSON'@ instances.
427--
344--
428−-- @"Data.OpenApi.Schema.Validation"@ addresses @'ToJSON'@/@'ToSchema'@ validation.
345+-- @"Data.Swagger.Schema.Validation"@ addresses @'ToJSON'@/@'ToSchema'@ validation.
src/Data/OpenApi/Declare.hs → src/Data/Swagger/Declare.hsrenamed+9−5
@@ -4,12 +4,12 @@
4{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE UndecidableInstances #-}
5{-# LANGUAGE UndecidableInstances #-}
6-- |
6-- |
7−-- Module: Data.OpenApi.Declare
7+-- Module: Data.Swagger.Declare
8-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
8-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
9-- Stability: experimental
9-- Stability: experimental
10--
10--
11-- Declare monad transformer and associated functions.
11-- Declare monad transformer and associated functions.
12−module Data.OpenApi.Declare where
12+module Data.Swagger.Declare where
13
13
14import Prelude ()
14import Prelude ()
15import Prelude.Compat
15import Prelude.Compat
@@ -60,7 +60,7 @@ instance (Applicative m, Monad m, Monoid d) => Monad (DeclareT d m) where
60 return (mappend d' d'', y)
60 return (mappend d' d'', y)
61
61
62instance Monoid d => MonadTrans (DeclareT d) where
62instance Monoid d => MonadTrans (DeclareT d) where
63− lift m = DeclareT (\_ -> (,) mempty <$> m)
63+ lift m = DeclareT (\_ -> (,) mempty `liftM` m)
64
64
65-- |
65-- |
66-- Definitions of @declare@ and @look@ must satisfy the following laws:
66-- Definitions of @declare@ and @look@ must satisfy the following laws:
@@ -103,12 +103,12 @@ looks f = f <$> look
103-- | Evaluate @'DeclareT' d m a@ computation,
103-- | Evaluate @'DeclareT' d m a@ computation,
104-- ignoring new output @d@.
104-- ignoring new output @d@.
105evalDeclareT :: Monad m => DeclareT d m a -> d -> m a
105evalDeclareT :: 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
107
107
108-- | Execute @'DeclateT' d m a@ computation,
108-- | Execute @'DeclateT' d m a@ computation,
109-- ignoring result and only producing new output @d@.
109-- ignoring result and only producing new output @d@.
110execDeclareT :: Monad m => DeclareT d m a -> d -> m d
110execDeclareT :: 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
112
112
113-- | Evaluate @'DeclareT' d m a@ computation,
113-- | Evaluate @'DeclareT' d m a@ computation,
114-- starting with empty output history.
114-- starting with empty output history.
@@ -162,6 +162,10 @@ instance MonadDeclare d m => MonadDeclare d (IdentityT m) where
162 declare = lift . declare
162 declare = lift . declare
163 look = lift look
163 look = lift look
164
164
165+instance MonadDeclare d m => MonadDeclare d (ListT m) where
166+ declare = lift . declare
167+ look = lift look
168+
165instance MonadDeclare d m => MonadDeclare d (MaybeT m) where
169instance MonadDeclare d m => MonadDeclare d (MaybeT m) where
166 declare = lift . declare
170 declare = lift . declare
167 look = lift look
171 look = lift look
src/Data/Swagger/Internal.hsnew file+1392
@@ -0,0 +1,1392 @@
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 :: Definitions SecurityScheme
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+-- | Lists the required security schemes to execute this operation.
759+-- The object can have multiple security schemes declared in it which are all required
760+-- (that is, there is a logical AND between the schemes).
761+newtype SecurityRequirement = SecurityRequirement
762+ { getSecurityRequirement :: InsOrdHashMap Text [Text]
763+ } deriving (Eq, Read, Show, Semigroup, Monoid, ToJSON, FromJSON, Data, Typeable)
764+
765+-- | Tag name.
766+type TagName = Text
767+
768+-- | Allows adding meta data to a single tag that is used by @Operation@.
769+-- It is not mandatory to have a @Tag@ per tag used there.
770+data Tag = Tag
771+ { -- | The name of the tag.
772+ _tagName :: TagName
773+
774+ -- | A short description for the tag.
775+ -- GFM syntax can be used for rich text representation.
776+ , _tagDescription :: Maybe Text
777+
778+ -- | Additional external documentation for this tag.
779+ , _tagExternalDocs :: Maybe ExternalDocs
780+ } deriving (Eq, Ord, Show, Generic, Data, Typeable)
781+
782+instance Hashable Tag
783+
784+instance IsString Tag where
785+ fromString s = Tag (fromString s) Nothing Nothing
786+
787+-- | Allows referencing an external resource for extended documentation.
788+data ExternalDocs = ExternalDocs
789+ { -- | A short description of the target documentation.
790+ -- GFM syntax can be used for rich text representation.
791+ _externalDocsDescription :: Maybe Text
792+
793+ -- | The URL for the target documentation.
794+ , _externalDocsUrl :: URL
795+ } deriving (Eq, Ord, Show, Generic, Data, Typeable)
796+
797+instance Hashable ExternalDocs
798+
799+-- | A simple object to allow referencing other definitions in the specification.
800+-- It can be used to reference parameters and responses that are defined at the top level for reuse.
801+newtype Reference = Reference { getReference :: Text }
802+ deriving (Eq, Show, Data, Typeable)
803+
804+data Referenced a
805+ = Ref Reference
806+ | Inline a
807+ deriving (Eq, Show, Functor, Data, Typeable)
808+
809+instance IsString a => IsString (Referenced a) where
810+ fromString = Inline . fromString
811+
812+newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
813+
814+data AdditionalProperties
815+ = AdditionalPropertiesAllowed Bool
816+ | AdditionalPropertiesSchema (Referenced Schema)
817+ deriving (Eq, Show, Data, Typeable)
818+
819+-- =======================================================================
820+-- Monoid instances
821+-- =======================================================================
822+
823+instance Semigroup Swagger where
824+ (<>) = genericMappend
825+instance Monoid Swagger where
826+ mempty = genericMempty
827+ mappend = (<>)
828+
829+instance Semigroup Info where
830+ (<>) = genericMappend
831+instance Monoid Info where
832+ mempty = genericMempty
833+ mappend = (<>)
834+
835+instance Semigroup Contact where
836+ (<>) = genericMappend
837+instance Monoid Contact where
838+ mempty = genericMempty
839+ mappend = (<>)
840+
841+instance Semigroup PathItem where
842+ (<>) = genericMappend
843+instance Monoid PathItem where
844+ mempty = genericMempty
845+ mappend = (<>)
846+
847+instance Semigroup Schema where
848+ (<>) = genericMappend
849+instance Monoid Schema where
850+ mempty = genericMempty
851+ mappend = (<>)
852+
853+instance Semigroup (ParamSchema t) where
854+ (<>) = genericMappend
855+instance Monoid (ParamSchema t) where
856+ mempty = genericMempty
857+ mappend = (<>)
858+
859+instance Semigroup Param where
860+ (<>) = genericMappend
861+instance Monoid Param where
862+ mempty = genericMempty
863+ mappend = (<>)
864+
865+instance Semigroup ParamOtherSchema where
866+ (<>) = genericMappend
867+instance Monoid ParamOtherSchema where
868+ mempty = genericMempty
869+ mappend = (<>)
870+
871+instance Semigroup Header where
872+ (<>) = genericMappend
873+instance Monoid Header where
874+ mempty = genericMempty
875+ mappend = (<>)
876+
877+instance Semigroup Responses where
878+ (<>) = genericMappend
879+instance Monoid Responses where
880+ mempty = genericMempty
881+ mappend = (<>)
882+
883+instance Semigroup Response where
884+ (<>) = genericMappend
885+instance Monoid Response where
886+ mempty = genericMempty
887+ mappend = (<>)
888+
889+instance Semigroup ExternalDocs where
890+ (<>) = genericMappend
891+instance Monoid ExternalDocs where
892+ mempty = genericMempty
893+ mappend = (<>)
894+
895+instance Semigroup Operation where
896+ (<>) = genericMappend
897+instance Monoid Operation where
898+ mempty = genericMempty
899+ mappend = (<>)
900+
901+instance Semigroup Example where
902+ (<>) = genericMappend
903+instance Monoid Example where
904+ mempty = genericMempty
905+ mappend = (<>)
906+
907+-- =======================================================================
908+-- SwaggerMonoid helper instances
909+-- =======================================================================
910+
911+instance SwaggerMonoid Info
912+instance SwaggerMonoid PathItem
913+instance SwaggerMonoid Schema
914+instance SwaggerMonoid (ParamSchema t)
915+instance SwaggerMonoid Param
916+instance SwaggerMonoid ParamOtherSchema
917+instance SwaggerMonoid Responses
918+instance SwaggerMonoid Response
919+instance SwaggerMonoid ExternalDocs
920+instance SwaggerMonoid Operation
921+instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
922+
923+instance SwaggerMonoid MimeList
924+deriving instance SwaggerMonoid URL
925+
926+instance SwaggerMonoid (SwaggerType t) where
927+ swaggerMempty = SwaggerString
928+ swaggerMappend _ y = y
929+
930+instance SwaggerMonoid ParamLocation where
931+ swaggerMempty = ParamQuery
932+ swaggerMappend _ y = y
933+
934+instance OVERLAPPING_ SwaggerMonoid (InsOrdHashMap FilePath PathItem) where
935+ swaggerMempty = InsOrdHashMap.empty
936+ swaggerMappend = InsOrdHashMap.unionWith mappend
937+
938+instance Monoid a => SwaggerMonoid (Referenced a) where
939+ swaggerMempty = Inline mempty
940+ swaggerMappend (Inline x) (Inline y) = Inline (mappend x y)
941+ swaggerMappend _ y = y
942+
943+instance SwaggerMonoid ParamAnySchema where
944+ swaggerMempty = ParamOther swaggerMempty
945+ swaggerMappend (ParamBody x) (ParamBody y) = ParamBody (swaggerMappend x y)
946+ swaggerMappend (ParamOther x) (ParamOther y) = ParamOther (swaggerMappend x y)
947+ swaggerMappend _ y = y
948+
949+-- =======================================================================
950+-- Simple Generic-based ToJSON instances
951+-- =======================================================================
952+
953+instance ToJSON ParamLocation where
954+ toJSON = genericToJSON (jsonPrefix "Param")
955+
956+instance ToJSON Info where
957+ toJSON = genericToJSON (jsonPrefix "Info")
958+
959+instance ToJSON Contact where
960+ toJSON = genericToJSON (jsonPrefix "Contact")
961+
962+instance ToJSON License where
963+ toJSON = genericToJSON (jsonPrefix "License")
964+
965+instance ToJSON ApiKeyLocation where
966+ toJSON = genericToJSON (jsonPrefix "ApiKey")
967+
968+instance ToJSON ApiKeyParams where
969+ toJSON = genericToJSON (jsonPrefix "apiKey")
970+
971+instance ToJSON Scheme where
972+ toJSON = genericToJSON (jsonPrefix "")
973+
974+instance ToJSON Tag where
975+ toJSON = genericToJSON (jsonPrefix "Tag")
976+
977+instance ToJSON ExternalDocs where
978+ toJSON = genericToJSON (jsonPrefix "ExternalDocs")
979+
980+instance ToJSON Xml where
981+ toJSON = genericToJSON (jsonPrefix "Xml")
982+
983+-- =======================================================================
984+-- Simple Generic-based FromJSON instances
985+-- =======================================================================
986+
987+instance FromJSON ParamLocation where
988+ parseJSON = genericParseJSON (jsonPrefix "Param")
989+
990+instance FromJSON Info where
991+ parseJSON = genericParseJSON (jsonPrefix "Info")
992+
993+instance FromJSON Contact where
994+ parseJSON = genericParseJSON (jsonPrefix "Contact")
995+
996+instance FromJSON License where
997+ parseJSON = genericParseJSON (jsonPrefix "License")
998+
999+instance FromJSON ApiKeyLocation where
1000+ parseJSON = genericParseJSON (jsonPrefix "ApiKey")
1001+
1002+instance FromJSON ApiKeyParams where
1003+ parseJSON = genericParseJSON (jsonPrefix "apiKey")
1004+
1005+instance FromJSON Scheme where
1006+ parseJSON = genericParseJSON (jsonPrefix "")
1007+
1008+instance FromJSON Tag where
1009+ parseJSON = genericParseJSON (jsonPrefix "Tag")
1010+
1011+instance FromJSON ExternalDocs where
1012+ parseJSON = genericParseJSON (jsonPrefix "ExternalDocs")
1013+
1014+-- =======================================================================
1015+-- Manual ToJSON instances
1016+-- =======================================================================
1017+
1018+instance ToJSON OAuth2Flow where
1019+ toJSON (OAuth2Implicit authUrl) = object
1020+ [ "flow" .= ("implicit" :: Text)
1021+ , "authorizationUrl" .= authUrl ]
1022+ toJSON (OAuth2Password tokenUrl) = object
1023+ [ "flow" .= ("password" :: Text)
1024+ , "tokenUrl" .= tokenUrl ]
1025+ toJSON (OAuth2Application tokenUrl) = object
1026+ [ "flow" .= ("application" :: Text)
1027+ , "tokenUrl" .= tokenUrl ]
1028+ toJSON (OAuth2AccessCode authUrl tokenUrl) = object
1029+ [ "flow" .= ("accessCode" :: Text)
1030+ , "authorizationUrl" .= authUrl
1031+ , "tokenUrl" .= tokenUrl ]
1032+
1033+instance ToJSON OAuth2Params where
1034+ toJSON = sopSwaggerGenericToJSON
1035+ DEFINE_TOENCODING
1036+
1037+instance ToJSON SecuritySchemeType where
1038+ toJSON SecuritySchemeBasic
1039+ = object [ "type" .= ("basic" :: Text) ]
1040+ toJSON (SecuritySchemeApiKey params)
1041+ = toJSON params
1042+ <+> object [ "type" .= ("apiKey" :: Text) ]
1043+ toJSON (SecuritySchemeOAuth2 params)
1044+ = toJSON params
1045+ <+> object [ "type" .= ("oauth2" :: Text) ]
1046+
1047+instance ToJSON Swagger where
1048+ toJSON = sopSwaggerGenericToJSON
1049+ DEFINE_TOENCODING
1050+
1051+instance ToJSON SecurityScheme where
1052+ toJSON = sopSwaggerGenericToJSON
1053+ DEFINE_TOENCODING
1054+
1055+instance ToJSON Schema where
1056+ toJSON = sopSwaggerGenericToJSON
1057+ DEFINE_TOENCODING
1058+
1059+instance ToJSON Header where
1060+ toJSON = sopSwaggerGenericToJSON
1061+ DEFINE_TOENCODING
1062+
1063+-- | As for nullary schema for 0-arity type constructors, see
1064+-- <https://github.com/GetShopTV/swagger2/issues/167>.
1065+--
1066+-- >>> encode (SwaggerItemsArray [])
1067+-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1068+--
1069+instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
1070+ toJSON (SwaggerItemsPrimitive fmt schema) = object
1071+ [ "collectionFormat" .= fmt
1072+ , "items" .= schema ]
1073+ toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1074+ toJSON (SwaggerItemsArray []) = object
1075+ [ "items" .= object []
1076+ , "maxItems" .= (0 :: Int)
1077+ , "example" .= Array mempty
1078+ ]
1079+ toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1080+
1081+instance ToJSON Host where
1082+ toJSON (Host host mport) = toJSON $
1083+ case mport of
1084+ Nothing -> host
1085+ Just port -> host ++ ":" ++ show port
1086+
1087+instance ToJSON MimeList where
1088+ toJSON (MimeList xs) = toJSON (map show xs)
1089+
1090+instance ToJSON Param where
1091+ toJSON = sopSwaggerGenericToJSON
1092+ DEFINE_TOENCODING
1093+
1094+instance ToJSON ParamAnySchema where
1095+ toJSON (ParamBody s) = object [ "in" .= ("body" :: Text), "schema" .= s ]
1096+ toJSON (ParamOther s) = toJSON s
1097+
1098+instance ToJSON ParamOtherSchema where
1099+ toJSON = sopSwaggerGenericToJSON
1100+ DEFINE_TOENCODING
1101+
1102+instance ToJSON Responses where
1103+ toJSON = sopSwaggerGenericToJSON
1104+ DEFINE_TOENCODING
1105+
1106+instance ToJSON Response where
1107+ toJSON = sopSwaggerGenericToJSON
1108+ DEFINE_TOENCODING
1109+
1110+instance ToJSON Operation where
1111+ toJSON = sopSwaggerGenericToJSON
1112+ DEFINE_TOENCODING
1113+
1114+instance ToJSON PathItem where
1115+ toJSON = sopSwaggerGenericToJSON
1116+ DEFINE_TOENCODING
1117+
1118+instance ToJSON Example where
1119+ toJSON = toJSON . Map.mapKeys show . getExample
1120+
1121+instance ToJSON Reference where
1122+ toJSON (Reference ref) = object [ "$ref" .= ref ]
1123+
1124+referencedToJSON :: ToJSON a => Text -> Referenced a -> Value
1125+referencedToJSON prefix (Ref (Reference ref)) = object [ "$ref" .= (prefix <> ref) ]
1126+referencedToJSON _ (Inline x) = toJSON x
1127+
1128+instance ToJSON (Referenced Schema) where toJSON = referencedToJSON "#/definitions/"
1129+instance ToJSON (Referenced Param) where toJSON = referencedToJSON "#/parameters/"
1130+instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/responses/"
1131+
1132+instance ToJSON (SwaggerType t) where
1133+ toJSON SwaggerArray = "array"
1134+ toJSON SwaggerString = "string"
1135+ toJSON SwaggerInteger = "integer"
1136+ toJSON SwaggerNumber = "number"
1137+ toJSON SwaggerBoolean = "boolean"
1138+ toJSON SwaggerFile = "file"
1139+ toJSON SwaggerNull = "null"
1140+ toJSON SwaggerObject = "object"
1141+
1142+instance ToJSON (CollectionFormat t) where
1143+ toJSON CollectionCSV = "csv"
1144+ toJSON CollectionSSV = "ssv"
1145+ toJSON CollectionTSV = "tsv"
1146+ toJSON CollectionPipes = "pipes"
1147+ toJSON CollectionMulti = "multi"
1148+
1149+instance ToJSON (ParamSchema k) where
1150+ -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1151+ toJSON = sopSwaggerGenericToJSONWithOpts $
1152+ mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1153+
1154+instance ToJSON AdditionalProperties where
1155+ toJSON (AdditionalPropertiesAllowed b) = toJSON b
1156+ toJSON (AdditionalPropertiesSchema s) = toJSON s
1157+
1158+-- =======================================================================
1159+-- Manual FromJSON instances
1160+-- =======================================================================
1161+
1162+instance FromJSON OAuth2Flow where
1163+ parseJSON (Object o) = do
1164+ (flow :: Text) <- o .: "flow"
1165+ case flow of
1166+ "implicit" -> OAuth2Implicit <$> o .: "authorizationUrl"
1167+ "password" -> OAuth2Password <$> o .: "tokenUrl"
1168+ "application" -> OAuth2Application <$> o .: "tokenUrl"
1169+ "accessCode" -> OAuth2AccessCode
1170+ <$> o .: "authorizationUrl"
1171+ <*> o .: "tokenUrl"
1172+ _ -> empty
1173+ parseJSON _ = empty
1174+
1175+instance FromJSON OAuth2Params where
1176+ parseJSON = sopSwaggerGenericParseJSON
1177+
1178+instance FromJSON SecuritySchemeType where
1179+ parseJSON js@(Object o) = do
1180+ (t :: Text) <- o .: "type"
1181+ case t of
1182+ "basic" -> pure SecuritySchemeBasic
1183+ "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1184+ "oauth2" -> SecuritySchemeOAuth2 <$> parseJSON js
1185+ _ -> empty
1186+ parseJSON _ = empty
1187+
1188+instance FromJSON Swagger where
1189+ parseJSON = sopSwaggerGenericParseJSON
1190+
1191+instance FromJSON SecurityScheme where
1192+ parseJSON = sopSwaggerGenericParseJSON
1193+
1194+instance FromJSON Schema where
1195+ parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1196+ where nullaryCleanup :: Schema -> Schema
1197+ nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1198+ if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1199+ then s { _schemaExample = Nothing
1200+ , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1201+ else s
1202+
1203+instance FromJSON Header where
1204+ parseJSON = sopSwaggerGenericParseJSON
1205+
1206+instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1207+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1208+ <$> o .:? "collectionFormat"
1209+ <*> (o .: "items" >>= parseJSON)
1210+
1211+instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1212+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1213+ <$> o .:? "collectionFormat"
1214+ <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1215+
1216+-- |
1217+--
1218+-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1219+-- Just (SwaggerItemsArray [])
1220+--
1221+-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1222+-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1223+--
1224+-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1225+-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1226+--
1227+instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1228+ parseJSON js@(Object obj)
1229+ | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1230+ | otherwise = SwaggerItemsObject <$> parseJSON js
1231+ parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1232+ parseJSON _ = empty
1233+
1234+instance FromJSON Host where
1235+ parseJSON (String s) = case map Text.unpack $ Text.split (== ':') s of
1236+ [host] -> return $ Host host Nothing
1237+ [host, port] -> case readMaybe port of
1238+ Nothing -> fail $ "Invalid port `" ++ port ++ "'"
1239+ Just p -> return $ Host host (Just (fromInteger p))
1240+ _ -> fail $ "Invalid host `" ++ Text.unpack s ++ "'"
1241+ parseJSON _ = empty
1242+
1243+instance FromJSON MimeList where
1244+ parseJSON js = (MimeList . map fromString) <$> parseJSON js
1245+
1246+instance FromJSON Param where
1247+ parseJSON = sopSwaggerGenericParseJSON
1248+
1249+instance FromJSON ParamAnySchema where
1250+ parseJSON js@(Object o) = do
1251+ (i :: Text) <- o .: "in"
1252+ case i of
1253+ "body" -> do
1254+ schema <- o .: "schema"
1255+ ParamBody <$> parseJSON schema
1256+ _ -> ParamOther <$> parseJSON js
1257+ parseJSON _ = empty
1258+
1259+instance FromJSON ParamOtherSchema where
1260+ parseJSON = sopSwaggerGenericParseJSON
1261+
1262+instance FromJSON Responses where
1263+ parseJSON (Object o) = Responses
1264+ <$> o .:? "default"
1265+ <*> (parseJSON (Object (HashMap.delete "default" o)))
1266+ parseJSON _ = empty
1267+
1268+instance FromJSON Example where
1269+ parseJSON js = do
1270+ m <- parseJSON js
1271+ pure $ Example (Map.mapKeys fromString m)
1272+
1273+instance FromJSON Response where
1274+ parseJSON = sopSwaggerGenericParseJSON
1275+
1276+instance FromJSON Operation where
1277+ parseJSON = sopSwaggerGenericParseJSON
1278+
1279+instance FromJSON PathItem where
1280+ parseJSON = sopSwaggerGenericParseJSON
1281+
1282+instance FromJSON Reference where
1283+ parseJSON (Object o) = Reference <$> o .: "$ref"
1284+ parseJSON _ = empty
1285+
1286+referencedParseJSON :: FromJSON a => Text -> Value -> JSON.Parser (Referenced a)
1287+referencedParseJSON prefix js@(Object o) = do
1288+ ms <- o .:? "$ref"
1289+ case ms of
1290+ Nothing -> Inline <$> parseJSON js
1291+ Just s -> Ref <$> parseRef s
1292+ where
1293+ parseRef s = do
1294+ case Text.stripPrefix prefix s of
1295+ Nothing -> fail $ "expected $ref of the form \"" <> Text.unpack prefix <> "*\", but got " <> show s
1296+ Just suffix -> pure (Reference suffix)
1297+referencedParseJSON _ _ = fail "referenceParseJSON: not an object"
1298+
1299+instance FromJSON (Referenced Schema) where parseJSON = referencedParseJSON "#/definitions/"
1300+instance FromJSON (Referenced Param) where parseJSON = referencedParseJSON "#/parameters/"
1301+instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#/responses/"
1302+
1303+instance FromJSON Xml where
1304+ parseJSON = genericParseJSON (jsonPrefix "xml")
1305+
1306+instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1307+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1308+
1309+instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1310+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1311+
1312+instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1313+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1314+
1315+instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1316+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1317+
1318+-- NOTE: There aren't collections of 'Schema'
1319+--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1320+-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1321+
1322+instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1323+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1324+
1325+instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1326+ parseJSON = sopSwaggerGenericParseJSON
1327+instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1328+ parseJSON = sopSwaggerGenericParseJSON
1329+instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1330+ parseJSON = sopSwaggerGenericParseJSON
1331+
1332+instance FromJSON AdditionalProperties where
1333+ parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1334+ parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1335+
1336+-------------------------------------------------------------------------------
1337+-- TH splices
1338+-------------------------------------------------------------------------------
1339+
1340+deriveGeneric ''Header
1341+deriveGeneric ''OAuth2Params
1342+deriveGeneric ''Operation
1343+deriveGeneric ''Param
1344+deriveGeneric ''ParamOtherSchema
1345+deriveGeneric ''PathItem
1346+deriveGeneric ''Response
1347+deriveGeneric ''Responses
1348+deriveGeneric ''SecurityScheme
1349+deriveGeneric ''Schema
1350+deriveGeneric ''ParamSchema
1351+deriveGeneric ''Swagger
1352+
1353+instance HasSwaggerAesonOptions Header where
1354+ swaggerAesonOptions _ = mkSwaggerAesonOptions "header" & saoSubObject ?~ "paramSchema"
1355+instance HasSwaggerAesonOptions OAuth2Params where
1356+ swaggerAesonOptions _ = mkSwaggerAesonOptions "oauth2" & saoSubObject ?~ "flow"
1357+instance HasSwaggerAesonOptions Operation where
1358+ swaggerAesonOptions _ = mkSwaggerAesonOptions "operation"
1359+instance HasSwaggerAesonOptions Param where
1360+ swaggerAesonOptions _ = mkSwaggerAesonOptions "param" & saoSubObject ?~ "schema"
1361+instance HasSwaggerAesonOptions ParamOtherSchema where
1362+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramOtherSchema" & saoSubObject ?~ "paramSchema"
1363+instance HasSwaggerAesonOptions PathItem where
1364+ swaggerAesonOptions _ = mkSwaggerAesonOptions "pathItem"
1365+instance HasSwaggerAesonOptions Response where
1366+ swaggerAesonOptions _ = mkSwaggerAesonOptions "response"
1367+instance HasSwaggerAesonOptions Responses where
1368+ swaggerAesonOptions _ = mkSwaggerAesonOptions "responses" & saoSubObject ?~ "responses"
1369+instance HasSwaggerAesonOptions SecurityScheme where
1370+ swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1371+instance HasSwaggerAesonOptions Schema where
1372+ swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1373+instance HasSwaggerAesonOptions Swagger where
1374+ swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("swagger", "2.0")]
1375+
1376+instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
1377+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1378+instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
1379+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1380+-- NOTE: Schema doesn't have 'items' sub object!
1381+instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
1382+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
1383+
1384+instance AesonDefaultValue (ParamSchema s)
1385+instance AesonDefaultValue OAuth2Flow
1386+instance AesonDefaultValue Responses
1387+instance AesonDefaultValue ParamAnySchema
1388+instance AesonDefaultValue SecuritySchemeType
1389+instance AesonDefaultValue (SwaggerType a)
1390+instance AesonDefaultValue MimeList where defaultValue = Just mempty
1391+instance AesonDefaultValue Info
1392+instance AesonDefaultValue ParamLocation
src/Data/OpenApi/Internal/AesonUtils.hs → src/Data/Swagger/Internal/AesonUtils.hsrenamed+45−12
@@ -1,15 +1,20 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE GADTs #-}
4{-# LANGUAGE GADTs #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ExplicitForAll #-}
6{-# LANGUAGE ExplicitForAll #-}
6{-# LANGUAGE TemplateHaskell #-}
7{-# LANGUAGE TemplateHaskell #-}
8+#if __GLASGOW_HASKELL__ >= 800
7{-# LANGUAGE UndecidableSuperClasses #-}
9{-# LANGUAGE UndecidableSuperClasses #-}
10+#endif
8−module Data.OpenApi.Internal.AesonUtils (
11+module Data.Swagger.Internal.AesonUtils (
9 -- * Generic functions
12 -- * Generic functions
10 AesonDefaultValue(..),
13 AesonDefaultValue(..),
11 sopSwaggerGenericToJSON,
14 sopSwaggerGenericToJSON,
15+#if MIN_VERSION_aeson(0,10,0)
12 sopSwaggerGenericToEncoding,
16 sopSwaggerGenericToEncoding,
17+#endif
13 sopSwaggerGenericToJSONWithOpts,
18 sopSwaggerGenericToJSONWithOpts,
14 sopSwaggerGenericParseJSON,
19 sopSwaggerGenericParseJSON,
15 -- * Options
20 -- * Options
@@ -27,7 +32,7 @@ import Prelude.Compat
27import Control.Applicative ((<|>))
32import Control.Applicative ((<|>))
28import Control.Lens (makeLenses, (^.))
33import Control.Lens (makeLenses, (^.))
29import Control.Monad (unless)
34import 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)
31import Data.Aeson.Types (Parser, Pair)
36import Data.Aeson.Types (Parser, Pair)
32import Data.Char (toLower, isUpper)
37import Data.Char (toLower, isUpper)
33import Data.Foldable (traverse_)
38import Data.Foldable (traverse_)
@@ -36,11 +41,14 @@ import Data.Text (Text)
36import Generics.SOP
41import Generics.SOP
37
42
38import qualified Data.Text as T
43import qualified Data.Text as T
44+import qualified Data.HashMap.Strict as HM
39import qualified Data.Set as Set
45import qualified Data.Set as Set
40import qualified Data.HashMap.Strict.InsOrd as InsOrd
46import qualified Data.HashMap.Strict.InsOrd as InsOrd
41import qualified Data.HashSet.InsOrd as InsOrdHS
47import qualified Data.HashSet.InsOrd as InsOrdHS
42
48
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
44
52
45-------------------------------------------------------------------------------
53-------------------------------------------------------------------------------
46-- SwaggerAesonOptions
54-- SwaggerAesonOptions
@@ -48,7 +56,7 @@ import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)
48
56
49data SwaggerAesonOptions = SwaggerAesonOptions
57data SwaggerAesonOptions = SwaggerAesonOptions
50 { _saoPrefix :: String
58 { _saoPrefix :: String
51− , _saoAdditionalPairs :: [Pair]
59+ , _saoAdditionalPairs :: [(Text, Value)]
52 , _saoSubObject :: Maybe String
60 , _saoSubObject :: Maybe String
53 }
61 }
54
62
@@ -138,7 +146,11 @@ sopSwaggerGenericToJSON'
138 -> DatatypeInfo '[xs]
146 -> DatatypeInfo '[xs]
139 -> POP Maybe '[xs]
147 -> POP Maybe '[xs]
140 -> [Pair]
148 -> [Pair]
149+#if MIN_VERSION_generics_sop(0,5,0)
141sopSwaggerGenericToJSON' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =
150sopSwaggerGenericToJSON' 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
142 sopSwaggerGenericToJSON'' opts fields fieldsInfo defs
154 sopSwaggerGenericToJSON'' opts fields fieldsInfo defs
143sopSwaggerGenericToJSON' _ _ _ _ = error "sopSwaggerGenericToJSON: unsupported type"
155sopSwaggerGenericToJSON' _ _ _ _ = error "sopSwaggerGenericToJSON: unsupported type"
144
156
@@ -155,18 +167,21 @@ sopSwaggerGenericToJSON'' (SwaggerAesonOptions prefix _ sub) = go
155 go Nil Nil Nil = []
167 go Nil Nil Nil = []
156 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
168 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
157 | Just name' == sub = case json of
169 | Just name' == sub = case json of
158− Object m -> objectToList m ++ rest
170+ Object m -> HM.toList m ++ rest
159 Null -> rest
171 Null -> rest
160 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
172 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
161 -- If default value: omit it.
173 -- If default value: omit it.
162 | Just x == def =
174 | Just x == def =
163 rest
175 rest
164 | otherwise =
176 | otherwise =
165− (stringToKey name', json) : rest
177+ (T.pack name', json) : rest
166 where
178 where
167 json = toJSON x
179 json = toJSON x
168 name' = fieldNameModifier name
180 name' = fieldNameModifier name
169 rest = go xs names defs
181 rest = go xs names defs
182+#if __GLASGOW_HASKELL__ < 800
183+ go _ _ _ = error "not empty"
184+#endif
170
185
171 fieldNameModifier = modifier . drop 1
186 fieldNameModifier = modifier . drop 1
172 modifier = lowerFirstUppers . drop (length prefix)
187 modifier = lowerFirstUppers . drop (length prefix)
@@ -196,11 +211,11 @@ sopSwaggerGenericParseJSON = withObject "Swagger Record Object" $ \obj ->
196 proxy = Proxy :: Proxy a
211 proxy = Proxy :: Proxy a
197 opts = swaggerAesonOptions proxy
212 opts = swaggerAesonOptions proxy
198
213
199− parseAdditionalField :: Object -> Pair -> Parser ()
214+ parseAdditionalField :: Object -> (Text, Value) -> Parser ()
200 parseAdditionalField obj (k, v) = do
215 parseAdditionalField obj (k, v) = do
201 v' <- obj .: k
216 v' <- obj .: k
202 unless (v == v') $ fail $
217 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
204 ++ ": " ++ show v
219 ++ ": " ++ show v
205 ++ " /= " ++ show v'
220 ++ " /= " ++ show v'
206
221
@@ -211,7 +226,11 @@ sopSwaggerGenericParseJSON'
211 -> DatatypeInfo '[xs]
226 -> DatatypeInfo '[xs]
212 -> POP Maybe '[xs]
227 -> POP Maybe '[xs]
213 -> Parser (SOP I '[xs])
228 -> Parser (SOP I '[xs])
229+#if MIN_VERSION_generics_sop(0,5,0)
214sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =
230sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =
231+#else
232+sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =
233+#endif
215 SOP . Z <$> sopSwaggerGenericParseJSON'' opts obj fieldsInfo defs
234 SOP . Z <$> sopSwaggerGenericParseJSON'' opts obj fieldsInfo defs
216sopSwaggerGenericParseJSON' _ _ _ _ = error "sopSwaggerGenericParseJSON: unsupported type"
235sopSwaggerGenericParseJSON' _ _ _ _ = error "sopSwaggerGenericParseJSON: unsupported type"
217
236
@@ -231,8 +250,8 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
231 -- Note: we might strip fields of outer structure.
250 -- Note: we might strip fields of outer structure.
232 cons <$> (withDef $ parseJSON $ Object obj) <*> rest
251 cons <$> (withDef $ parseJSON $ Object obj) <*> rest
233 | otherwise = case def of
252 | otherwise = case def of
234− Just def' -> cons <$> obj .:? stringToKey name' .!= def' <*> rest
253+ Just def' -> cons <$> obj .:? T.pack name' .!= def' <*> rest
235− Nothing -> cons <$> obj .: stringToKey name' <*> rest
254+ Nothing -> cons <$> obj .: T.pack name' <*> rest
236 where
255 where
237 cons h t = I h :* t
256 cons h t = I h :* t
238 name' = fieldNameModifier name
257 name' = fieldNameModifier name
@@ -241,6 +260,9 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
241 withDef = case def of
260 withDef = case def of
242 Just def' -> (<|> pure def')
261 Just def' -> (<|> pure def')
243 Nothing -> id
262 Nothing -> id
263+#if __GLASGOW_HASKELL__ < 800
264+ go _ _ = error "not empty"
265+#endif
244
266
245 fieldNameModifier = modifier . drop 1
267 fieldNameModifier = modifier . drop 1
246 modifier = lowerFirstUppers . drop (length prefix)
268 modifier = lowerFirstUppers . drop (length prefix)
@@ -251,6 +273,8 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
251-- ToEncoding
273-- ToEncoding
252-------------------------------------------------------------------------------
274-------------------------------------------------------------------------------
253
275
276+#if MIN_VERSION_aeson(0,10,0)
277+
254sopSwaggerGenericToEncoding
278sopSwaggerGenericToEncoding
255 :: forall a xs.
279 :: forall a xs.
256 ( HasDatatypeInfo a
280 ( HasDatatypeInfo a
@@ -278,7 +302,11 @@ sopSwaggerGenericToEncoding'
278 -> DatatypeInfo '[xs]
302 -> DatatypeInfo '[xs]
279 -> POP Maybe '[xs]
303 -> POP Maybe '[xs]
280 -> Series
304 -> Series
305+#if MIN_VERSION_generics_sop(0,5,0)
281sopSwaggerGenericToEncoding' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =
306sopSwaggerGenericToEncoding' 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
282 sopSwaggerGenericToEncoding'' opts fields fieldsInfo defs
310 sopSwaggerGenericToEncoding'' opts fields fieldsInfo defs
283sopSwaggerGenericToEncoding' _ _ _ _ = error "sopSwaggerGenericToEncoding: unsupported type"
311sopSwaggerGenericToEncoding' _ _ _ _ = error "sopSwaggerGenericToEncoding: unsupported type"
284
312
@@ -295,19 +323,24 @@ sopSwaggerGenericToEncoding'' (SwaggerAesonOptions prefix _ sub) = go
295 go Nil Nil Nil = mempty
323 go Nil Nil Nil = mempty
296 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
324 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
297 | Just name' == sub = case toJSON x of
325 | Just name' == sub = case toJSON x of
298− Object m -> pairsToSeries (objectToList m) <> rest
326+ Object m -> pairsToSeries (HM.toList m) <> rest
299 Null -> rest
327 Null -> rest
300 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
328 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
301 -- If default value: omit it.
329 -- If default value: omit it.
302 | Just x == def =
330 | Just x == def =
303 rest
331 rest
304 | otherwise =
332 | otherwise =
305− (stringToKey name' .= x) <> rest
333+ (T.pack name' .= x) <> rest
306 where
334 where
307 name' = fieldNameModifier name
335 name' = fieldNameModifier name
308 rest = go xs names defs
336 rest = go xs names defs
337+#if __GLASGOW_HASKELL__ < 800
338+ go _ _ _ = error "not empty"
339+#endif
309
340
310 fieldNameModifier = modifier . drop 1
341 fieldNameModifier = modifier . drop 1
311 modifier = lowerFirstUppers . drop (length prefix)
342 modifier = lowerFirstUppers . drop (length prefix)
312 lowerFirstUppers s = map toLower x ++ y
343 lowerFirstUppers s = map toLower x ++ y
313 where (x, y) = span isUpper s
344 where (x, y) = span isUpper s
345+
346+#endif
src/Data/OpenApi/Internal/ParamSchema.hs → src/Data/Swagger/Internal/ParamSchema.hsrenamed+67−87
@@ -1,3 +1,4 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
@@ -11,11 +12,14 @@
11{-# LANGUAGE TypeOperators #-}
12{-# LANGUAGE TypeOperators #-}
12{-# LANGUAGE TypeSynonymInstances #-}
13{-# LANGUAGE TypeSynonymInstances #-}
13{-# LANGUAGE UndecidableInstances #-}
14{-# LANGUAGE UndecidableInstances #-}
15+#if __GLASGOW_HASKELL__ >= 800
14-- Generic a is redundant in ToParamSchema a default imple
16-- Generic a is redundant in ToParamSchema a default imple
15{-# OPTIONS_GHC -Wno-redundant-constraints #-}
17{-# OPTIONS_GHC -Wno-redundant-constraints #-}
16-- For TypeErrors
18-- For TypeErrors
17{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
19{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
20+#endif
21+#include "overlapping-compat.h"
18−module Data.OpenApi.Internal.ParamSchema where
22+module Data.Swagger.Internal.ParamSchema where
19
23
20import Control.Lens
24import Control.Lens
21import Data.Aeson (ToJSON (..))
25import Data.Aeson (ToJSON (..))
@@ -41,40 +45,37 @@ import Data.Word
41import Data.UUID.Types (UUID)
45import Data.UUID.Types (UUID)
42import Web.Cookie (SetCookie)
46import Web.Cookie (SetCookie)
43
47
44−import Data.OpenApi.Internal
48+import Data.Swagger.Internal
45−import Data.OpenApi.Lens
49+import Data.Swagger.Lens
46−import Data.OpenApi.SchemaOptions
50+import Data.Swagger.SchemaOptions
47
51
52+#if __GLASGOW_HASKELL__ < 800
53+#else
48import qualified Data.ByteString as BS
54import qualified Data.ByteString as BS
49−import qualified Data.ByteString.Lazy.Char8 as BSL
55+import qualified Data.ByteString.Lazy as BSL
50import GHC.TypeLits (TypeError, ErrorMessage(..))
56import GHC.TypeLits (TypeError, ErrorMessage(..))
57+#endif
51
58
52-- | Default schema for binary data (any sequence of octets).
59-- | Default schema for binary data (any sequence of octets).
53−binarySchema :: Schema
60+binaryParamSchema :: ParamSchema t
54−binarySchema = mempty
61+binaryParamSchema = mempty
55− & type_ ?~ OpenApiString
62+ & type_ ?~ SwaggerString
56 & format ?~ "binary"
63 & format ?~ "binary"
57
64
58-- | Default schema for binary data (base64 encoded).
65-- | Default schema for binary data (base64 encoded).
59−byteSchema :: Schema
66+byteParamSchema :: ParamSchema t
60−byteSchema = mempty
67+byteParamSchema = mempty
61− & type_ ?~ OpenApiString
68+ & type_ ?~ SwaggerString
62 & format ?~ "byte"
69 & format ?~ "byte"
63
70
64-- | Default schema for password string.
71-- | Default schema for password string.
65-- @"password"@ format is used to hint UIs the input needs to be obscured.
72-- @"password"@ format is used to hint UIs the input needs to be obscured.
66−passwordSchema :: Schema
73+passwordParamSchema :: ParamSchema t
67−passwordSchema = mempty
74+passwordParamSchema = mempty
68− & type_ ?~ OpenApiString
75+ & type_ ?~ SwaggerString
69 & format ?~ "password"
76 & format ?~ "password"
70
77
71−-- | Convert a type into a plain @'Schema'@.
78+-- | Convert a type into a plain @'ParamSchema'@.
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--
79--
79-- An example type and instance:
80-- An example type and instance:
80--
81--
@@ -87,7 +88,7 @@ passwordSchema = mempty
87--
88--
88-- instance ToParamSchema Direction where
89-- instance ToParamSchema Direction where
89-- toParamSchema _ = mempty
90-- toParamSchema _ = mempty
90−-- & type_ ?~ OpenApiString
91+-- & type_ ?~ SwaggerString
91-- & enum_ ?~ [ \"Up\", \"Down\" ]
92-- & enum_ ?~ [ \"Up\", \"Down\" ]
92-- @
93-- @
93--
94--
@@ -112,26 +113,24 @@ passwordSchema = mempty
112class ToParamSchema a where
113class ToParamSchema a where
113 -- | Convert a type into a plain parameter schema.
114 -- | Convert a type into a plain parameter schema.
114 --
115 --
115− -- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy Integer)
116+ -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)
116− -- {
117− -- "type": "integer"
117+ -- "{\"type\":\"integer\"}"
118− -- }
119− toParamSchema :: Proxy a -> Schema
118+ toParamSchema :: Proxy a -> ParamSchema t
120− default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> Schema
119+ default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema t
121 toParamSchema = genericToParamSchema defaultSchemaOptions
120 toParamSchema = genericToParamSchema defaultSchemaOptions
122
121
123−instance {-# OVERLAPPING #-} ToParamSchema String where
122+instance OVERLAPPING_ ToParamSchema String where
124− toParamSchema _ = mempty & type_ ?~ OpenApiString
123+ toParamSchema _ = mempty & type_ ?~ SwaggerString
125
124
126instance ToParamSchema Bool where
125instance ToParamSchema Bool where
127− toParamSchema _ = mempty & type_ ?~ OpenApiBoolean
126+ toParamSchema _ = mempty & type_ ?~ SwaggerBoolean
128
127
129instance ToParamSchema Integer where
128instance ToParamSchema Integer where
130− toParamSchema _ = mempty & type_ ?~ OpenApiInteger
129+ toParamSchema _ = mempty & type_ ?~ SwaggerInteger
131
130
132instance ToParamSchema Natural where
131instance ToParamSchema Natural where
133 toParamSchema _ = mempty
132 toParamSchema _ = mempty
134− & type_ ?~ OpenApiInteger
133+ & type_ ?~ SwaggerInteger
135 & minimum_ ?~ 0
134 & minimum_ ?~ 0
136 & exclusiveMinimum ?~ False
135 & exclusiveMinimum ?~ False
137
136
@@ -148,63 +147,52 @@ instance ToParamSchema Int64 where
148instance ToParamSchema Word where toParamSchema = toParamSchemaBoundedIntegral
147instance ToParamSchema Word where toParamSchema = toParamSchemaBoundedIntegral
149instance ToParamSchema Word8 where toParamSchema = toParamSchemaBoundedIntegral
148instance ToParamSchema Word8 where toParamSchema = toParamSchemaBoundedIntegral
150instance ToParamSchema Word16 where toParamSchema = toParamSchemaBoundedIntegral
149instance ToParamSchema Word16 where toParamSchema = toParamSchemaBoundedIntegral
151−
152−instance ToParamSchema Word32 where
150+instance ToParamSchema Word32 where toParamSchema = toParamSchemaBoundedIntegral
153− toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int32"
154−
155−instance ToParamSchema Word64 where
151+instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral
156− toParamSchema proxy = toParamSchemaBoundedIntegral proxy & format ?~ "int64"
157
152
158-- | Default plain schema for @'Bounded'@, @'Integral'@ types.
153-- | Default plain schema for @'Bounded'@, @'Integral'@ types.
159--
154--
160−-- >>> BSL.putStrLn $ encodePretty $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
155+-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
161−-- {
162−-- "maximum": 127,
163−-- "minimum": -128,
164−-- "type": "integer"
156+-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
165−-- }
166−toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> Schema
157+toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema t
167toParamSchemaBoundedIntegral _ = mempty
158toParamSchemaBoundedIntegral _ = mempty
168− & type_ ?~ OpenApiInteger
159+ & type_ ?~ SwaggerInteger
169 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
160 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
170 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
161 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
171
162
172instance ToParamSchema Char where
163instance ToParamSchema Char where
173 toParamSchema _ = mempty
164 toParamSchema _ = mempty
174− & type_ ?~ OpenApiString
165+ & type_ ?~ SwaggerString
175 & maxLength ?~ 1
166 & maxLength ?~ 1
176 & minLength ?~ 1
167 & minLength ?~ 1
177
168
178instance ToParamSchema Scientific where
169instance ToParamSchema Scientific where
179− toParamSchema _ = mempty & type_ ?~ OpenApiNumber
170+ toParamSchema _ = mempty & type_ ?~ SwaggerNumber
180
171
181instance HasResolution a => ToParamSchema (Fixed a) where
172instance HasResolution a => ToParamSchema (Fixed a) where
182 toParamSchema _ = mempty
173 toParamSchema _ = mempty
183− & type_ ?~ OpenApiNumber
174+ & type_ ?~ SwaggerNumber
184 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
175 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
185
176
186instance ToParamSchema Double where
177instance ToParamSchema Double where
187 toParamSchema _ = mempty
178 toParamSchema _ = mempty
188− & type_ ?~ OpenApiNumber
179+ & type_ ?~ SwaggerNumber
189 & format ?~ "double"
180 & format ?~ "double"
190
181
191instance ToParamSchema Float where
182instance ToParamSchema Float where
192 toParamSchema _ = mempty
183 toParamSchema _ = mempty
193− & type_ ?~ OpenApiNumber
184+ & type_ ?~ SwaggerNumber
194 & format ?~ "float"
185 & format ?~ "float"
195
186
196−timeParamSchema :: String -> Schema
187+timeParamSchema :: String -> ParamSchema t
197timeParamSchema fmt = mempty
188timeParamSchema fmt = mempty
198− & type_ ?~ OpenApiString
189+ & type_ ?~ SwaggerString
199 & format ?~ T.pack fmt
190 & format ?~ T.pack fmt
200
191
201-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
192-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
202instance ToParamSchema Day where
193instance ToParamSchema Day where
203 toParamSchema _ = timeParamSchema "date"
194 toParamSchema _ = timeParamSchema "date"
204
195
205−-- |
206−-- >>> toParamSchema (Proxy :: Proxy TimeOfDay) ^. format
207−-- Just "hh:MM:ss"
208instance ToParamSchema TimeOfDay where
196instance ToParamSchema TimeOfDay where
209 toParamSchema _ = timeParamSchema "hh:MM:ss"
197 toParamSchema _ = timeParamSchema "hh:MM:ss"
210
198
@@ -216,9 +204,9 @@ instance ToParamSchema LocalTime where
216
204
217-- |
205-- |
218-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
206-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
219−-- Just "date-time"
207+-- Just "yyyy-mm-ddThh:MM:ss+hhMM"
220instance ToParamSchema ZonedTime where
208instance ToParamSchema ZonedTime where
221− toParamSchema _ = timeParamSchema "date-time"
209+ toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+hhMM"
222
210
223-- |
211-- |
224-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format
212-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format
@@ -237,21 +225,25 @@ instance ToParamSchema TL.Text where
237
225
238instance ToParamSchema Version where
226instance ToParamSchema Version where
239 toParamSchema _ = mempty
227 toParamSchema _ = mempty
240− & type_ ?~ OpenApiString
228+ & type_ ?~ SwaggerString
241 & pattern ?~ "^\\d+(\\.\\d+)*$"
229 & pattern ?~ "^\\d+(\\.\\d+)*$"
242
230
243instance ToParamSchema SetCookie where
231instance ToParamSchema SetCookie where
244 toParamSchema _ = mempty
232 toParamSchema _ = mempty
245− & type_ ?~ OpenApiString
233+ & type_ ?~ SwaggerString
234+
246
235
236+#if __GLASGOW_HASKELL__ < 800
237+#else
247type family ToParamSchemaByteStringError bs where
238type family ToParamSchemaByteStringError bs where
248 ToParamSchemaByteStringError bs = TypeError
239 ToParamSchemaByteStringError bs = TypeError
249 ( 'Text "Impossible to have an instance " :<>: ShowType (ToParamSchema bs) :<>: Text "."
240 ( 'Text "Impossible to have an instance " :<>: ShowType (ToParamSchema bs) :<>: Text "."
250 :$$: 'Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
241 :$$: 'Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
251− :$$: 'Text "Consider using byteParamSchema or binaryParamSchemaemplates." )
242+ :$$: 'Text "Consider using byteParamSchema or binaryParamSchema templates." )
252
243
253instance ToParamSchemaByteStringError BS.ByteString => ToParamSchema BS.ByteString where toParamSchema = error "impossible"
244instance ToParamSchemaByteStringError BS.ByteString => ToParamSchema BS.ByteString where toParamSchema = error "impossible"
254instance ToParamSchemaByteStringError BSL.ByteString => ToParamSchema BSL.ByteString where toParamSchema = error "impossible"
245instance ToParamSchemaByteStringError BSL.ByteString => ToParamSchema BSL.ByteString where toParamSchema = error "impossible"
246+#endif
255
247
256instance ToParamSchema All where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool)
248instance ToParamSchema All where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool)
257instance ToParamSchema Any where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool)
249instance ToParamSchema Any where toParamSchema _ = toParamSchema (Proxy :: Proxy Bool)
@@ -265,8 +257,8 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t
265
257
266instance ToParamSchema a => ToParamSchema [a] where
258instance ToParamSchema a => ToParamSchema [a] where
267 toParamSchema _ = mempty
259 toParamSchema _ = mempty
268− & type_ ?~ OpenApiArray
260+ & type_ ?~ SwaggerArray
269− & items ?~ OpenApiItemsObject (Inline $ toParamSchema (Proxy :: Proxy a))
261+ & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))
270
262
271instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
263instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
272instance ToParamSchema a => ToParamSchema (VP.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
264instance ToParamSchema a => ToParamSchema (VP.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
@@ -281,40 +273,29 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
281 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
273 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
282
274
283-- |
275-- |
284−-- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy ())
276+-- >>> encode $ toParamSchema (Proxy :: Proxy ())
285−-- {
286−-- "enum": [
277+-- "{\"type\":\"string\",\"enum\":[\"_\"]}"
287−-- "_"
288−-- ],
289−-- "type": "string"
290−-- }
291instance ToParamSchema () where
278instance ToParamSchema () where
292 toParamSchema _ = mempty
279 toParamSchema _ = mempty
293− & type_ ?~ OpenApiString
280+ & type_ ?~ SwaggerString
294 & enum_ ?~ ["_"]
281 & enum_ ?~ ["_"]
295
282
296instance ToParamSchema UUID where
283instance ToParamSchema UUID where
297 toParamSchema _ = mempty
284 toParamSchema _ = mempty
298− & type_ ?~ OpenApiString
285+ & type_ ?~ SwaggerString
299 & format ?~ "uuid"
286 & format ?~ "uuid"
300
287
301−-- | A configurable generic @'Schema'@ creator.
288+-- | A configurable generic @'ParamSchema'@ creator.
302--
289--
303-- >>> :set -XDeriveGeneric
290-- >>> :set -XDeriveGeneric
304-- >>> data Color = Red | Blue deriving Generic
291-- >>> data Color = Red | Blue deriving Generic
305−-- >>> BSL.putStrLn $ encodePretty $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
292+-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
306−-- {
293+-- "{\"type\":\"string\",\"enum\":[\"Red\",\"Blue\"]}"
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
294+genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> ParamSchema t
314genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
295genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
315
296
316class GToParamSchema (f :: * -> *) where
297class GToParamSchema (f :: * -> *) where
317− gtoParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
298+ gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
318
299
319instance GToParamSchema f => GToParamSchema (D1 d f) where
300instance GToParamSchema f => GToParamSchema (D1 d f) where
320 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
301 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
@@ -332,14 +313,14 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) wh
332 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
313 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
333
314
334class GEnumParamSchema (f :: * -> *) where
315class GEnumParamSchema (f :: * -> *) where
335− genumParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
316+ genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
336
317
337instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
318instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
338 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)
319 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)
339
320
340instance Constructor c => GEnumParamSchema (C1 c U1) where
321instance Constructor c => GEnumParamSchema (C1 c U1) where
341 genumParamSchema opts _ s = s
322 genumParamSchema opts _ s = s
342− & type_ ?~ OpenApiString
323+ & type_ ?~ SwaggerString
343 & enum_ %~ addEnumValue tag
324 & enum_ %~ addEnumValue tag
344 where
325 where
345 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
326 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
@@ -351,4 +332,3 @@ data Proxy3 a b c = Proxy3
351
332
352-- $setup
333-- $setup
353-- >>> import Data.Aeson (encode)
334-- >>> 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 @@
1{-# LANGUAGE CPP #-}
1{-# LANGUAGE CPP #-}
2{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE ConstraintKinds #-}
3−{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE DefaultSignatures #-}
5{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE KindSignatures #-}
6{-# LANGUAGE KindSignatures #-}
7+{-# LANGUAGE DataKinds #-}
8{-# LANGUAGE OverloadedLists #-}
8{-# LANGUAGE OverloadedLists #-}
9{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE OverloadedStrings #-}
10{-# LANGUAGE PackageImports #-}
10{-# LANGUAGE PackageImports #-}
11{-# LANGUAGE PolyKinds #-}
11{-# LANGUAGE PolyKinds #-}
12{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE ScopedTypeVariables #-}
13{-# LANGUAGE TupleSections #-}
13{-# LANGUAGE TupleSections #-}
14−{-# LANGUAGE TypeApplications #-}
15{-# LANGUAGE TypeFamilies #-}
14{-# LANGUAGE TypeFamilies #-}
16{-# LANGUAGE TypeOperators #-}
15{-# LANGUAGE TypeOperators #-}
17{-# LANGUAGE TypeSynonymInstances #-}
16{-# LANGUAGE TypeSynonymInstances #-}
18{-# LANGUAGE UndecidableInstances #-}
17{-# LANGUAGE UndecidableInstances #-}
18+#if __GLASGOW_HASKELL__ >= 800
19+-- Few generics related redundant constraints
19{-# OPTIONS_GHC -Wno-redundant-constraints #-}
20{-# OPTIONS_GHC -Wno-redundant-constraints #-}
20-- For TypeErrors
21-- For TypeErrors
21{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
22{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
23+#endif
24+#include "overlapping-compat.h"
22−module Data.OpenApi.Internal.Schema where
25+module Data.Swagger.Internal.Schema where
23
26
24import Prelude ()
27import Prelude ()
25import Prelude.Compat
28import Prelude.Compat
26
29
27−import Control.Lens hiding (allOf)
30+import Control.Lens
28import Data.Data.Lens (template)
31import Data.Data.Lens (template)
29
32
30import Control.Monad
33import Control.Monad
31import Control.Monad.Writer
34import Control.Monad.Writer
32−import Data.Aeson (Object (..), SumEncoding (..), ToJSON (..), ToJSONKey (..),
35+import Data.Aeson (ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..), Value (..), Object(..))
33− ToJSONKeyFunction (..), Value (..))
34import Data.Char
36import Data.Char
35import Data.Data (Data)
37import Data.Data (Data)
36import Data.Foldable (traverse_)
38import Data.Foldable (traverse_)
@@ -42,10 +44,8 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
42import Data.Int
44import Data.Int
43import Data.IntSet (IntSet)
45import Data.IntSet (IntSet)
44import Data.IntMap (IntMap)
46import Data.IntMap (IntMap)
45−import Data.List (sort)
46import Data.List.NonEmpty.Compat (NonEmpty)
47import Data.List.NonEmpty.Compat (NonEmpty)
47import Data.Map (Map)
48import Data.Map (Map)
48−import Data.Maybe (fromMaybe)
49import Data.Proxy
49import Data.Proxy
50import Data.Scientific (Scientific)
50import Data.Scientific (Scientific)
51import Data.Fixed (Fixed, HasResolution, Pico)
51import Data.Fixed (Fixed, HasResolution, Pico)
@@ -62,20 +62,21 @@ import Numeric.Natural.Compat (Natural)
62import Data.Word
62import Data.Word
63import GHC.Generics
63import GHC.Generics
64import qualified Data.UUID.Types as UUID
64import qualified Data.UUID.Types as UUID
65−import Type.Reflection (Typeable, typeRep)
66
65
67−import Data.OpenApi.Aeson.Compat (keyToText, objectKeys, toInsOrdHashMap)
68−import Data.OpenApi.Declare
66+import Data.Swagger.Declare
69−import Data.OpenApi.Internal
67+import Data.Swagger.Internal
70−import Data.OpenApi.Internal.ParamSchema (ToParamSchema (..))
68+import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
71−import Data.OpenApi.Internal.TypeShape
72−import Data.OpenApi.Lens hiding (name, schema)
69+import Data.Swagger.Lens hiding (name, schema)
73−import qualified Data.OpenApi.Lens as Swagger
70+import qualified Data.Swagger.Lens as Swagger
74−import Data.OpenApi.SchemaOptions
71+import Data.Swagger.SchemaOptions
72+import Data.Swagger.Internal.TypeShape
75
73
74+#if __GLASGOW_HASKELL__ < 800
75+#else
76import qualified Data.ByteString as BS
76import qualified Data.ByteString as BS
77−import qualified Data.ByteString.Lazy.Char8 as BSL
77+import qualified Data.ByteString.Lazy as BSL
78import GHC.TypeLits (TypeError, ErrorMessage(..))
78import GHC.TypeLits (TypeError, ErrorMessage(..))
79+#endif
79
80
80unnamed :: Schema -> NamedSchema
81unnamed :: Schema -> NamedSchema
81unnamed schema = NamedSchema Nothing schema
82unnamed schema = NamedSchema Nothing schema
@@ -102,7 +103,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
102--
103--
103-- import Control.Lens
104-- import Control.Lens
104-- import Data.Proxy
105-- import Data.Proxy
105−-- import Data.OpenApi
106+-- import Data.Swagger
106--
107--
107-- data Coord = Coord { x :: Double, y :: Double }
108-- data Coord = Coord { x :: Double, y :: Double }
108--
109--
@@ -110,7 +111,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
110-- declareNamedSchema _ = do
111-- declareNamedSchema _ = do
111-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
112-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
112-- return $ NamedSchema (Just \"Coord\") $ mempty
113-- return $ NamedSchema (Just \"Coord\") $ mempty
113−-- & type_ ?~ OpenApiObject
114+-- & type_ ?~ SwaggerObject
114-- & properties .~
115-- & properties .~
115-- [ (\"x\", doubleSchema)
116-- [ (\"x\", doubleSchema)
116-- , (\"y\", doubleSchema)
117-- , (\"y\", doubleSchema)
@@ -136,13 +137,13 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
136--
137--
137-- instance ToSchema Coord
138-- instance ToSchema Coord
138-- @
139-- @
139−class Typeable a => ToSchema a where
140+class ToSchema a where
140 -- | Convert a type into an optionally named schema
141 -- | Convert a type into an optionally named schema
141 -- together with all used definitions.
142 -- together with all used definitions.
142 -- Note that the schema itself is included in definitions
143 -- Note that the schema itself is included in definitions
143 -- only if it is recursive (and thus needs its definition in scope).
144 -- only if it is recursive (and thus needs its definition in scope).
144 declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
145 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") =>
146 Proxy a -> Declare (Definitions Schema) NamedSchema
147 Proxy a -> Declare (Definitions Schema) NamedSchema
147 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
148 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
148
149
@@ -158,19 +159,13 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
158--
159--
159-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
160-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
160-- Nothing
161-- Nothing
161−-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy String) ^. schema)
162+-- >>> encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
162−-- {
163−-- "type": "string"
163+-- "{\"type\":\"string\"}"
164−-- }
165--
164--
166-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
165-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
167-- Just "Day"
166-- Just "Day"
168−-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy Day) ^. schema)
167+-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
169−-- {
170−-- "example": "2016-07-22",
168+-- "{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"
171−-- "format": "date",
172−-- "type": "string"
173−-- }
174toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
169toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
175toNamedSchema = undeclare . declareNamedSchema
170toNamedSchema = undeclare . declareNamedSchema
176
171
@@ -186,35 +181,22 @@ schemaName = _namedSchemaName . toNamedSchema
186
181
187-- | Convert a type into a schema.
182-- | Convert a type into a schema.
188--
183--
189−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Int8)
184+-- >>> encode $ toSchema (Proxy :: Proxy Int8)
190−-- {
191−-- "maximum": 127,
192−-- "minimum": -128,
193−-- "type": "integer"
185+-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
194−-- }
195--
186--
196−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy [Day])
187+-- >>> encode $ toSchema (Proxy :: Proxy [Day])
197−-- {
198−-- "items": {
199−-- "$ref": "#/components/schemas/Day"
200−-- },
201−-- "type": "array"
188+-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"
202−-- }
203toSchema :: ToSchema a => Proxy a -> Schema
189toSchema :: ToSchema a => Proxy a -> Schema
204toSchema = _namedSchemaSchema . toNamedSchema
190toSchema = _namedSchemaSchema . toNamedSchema
205
191
206-- | Convert a type into a referenced schema if possible.
192-- | Convert a type into a referenced schema if possible.
207-- Only named schemas can be referenced, nameless schemas are inlined.
193-- Only named schemas can be referenced, nameless schemas are inlined.
208--
194--
209−-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Integer)
195+-- >>> encode $ toSchemaRef (Proxy :: Proxy Integer)
210−-- {
211−-- "type": "integer"
196+-- "{\"type\":\"integer\"}"
212−-- }
213--
197--
214−-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Day)
198+-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)
215−-- {
199+-- "{\"$ref\":\"#/definitions/Day\"}"
216−-- "$ref": "#/components/schemas/Day"
217−-- }
218toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
200toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
219toSchemaRef = undeclare . declareSchemaRef
201toSchemaRef = undeclare . declareSchemaRef
220
202
@@ -282,15 +264,8 @@ inlineAllSchemas = inlineSchemasWhen (const True)
282
264
283-- | Convert a type into a schema without references.
265-- | Convert a type into a schema without references.
284--
266--
285−-- >>> BSL.putStrLn $ encodePretty $ toInlinedSchema (Proxy :: Proxy [Day])
267+-- >>> encode $ toInlinedSchema (Proxy :: Proxy [Day])
286−-- {
287−-- "items": {
288−-- "example": "2016-07-22",
268+-- "{\"items\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"},\"type\":\"array\"}"
289−-- "format": "date",
290−-- "type": "string"
291−-- },
292−-- "type": "array"
293−-- }
294--
269--
295-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
270-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
296-- when inlining recursive schemas.
271-- when inlining recursive schemas.
@@ -320,67 +295,41 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
320 traverse_ usedNames (InsOrdHashMap.lookup name defs)
295 traverse_ usedNames (InsOrdHashMap.lookup name defs)
321 Inline subschema -> usedNames subschema
296 Inline subschema -> usedNames subschema
322
297
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+
323-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
317-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
324-- Produced schema can be used for further refinement.
318-- Produced schema can be used for further refinement.
325--
319--
326−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema "hello"
320+-- >>> encode $ sketchSchema "hello"
327−-- {
328−-- "example": "hello",
321+-- "{\"example\":\"hello\",\"type\":\"string\"}"
329−-- "type": "string"
330−-- }
331--
322--
332−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (1, 2, 3)
323+-- >>> encode $ sketchSchema (1, 2, 3)
333−-- {
334−-- "example": [
335−-- 1,
336−-- 2,
337−-- 3
338−-- ],
339−-- "items": {
340−-- "type": "number"
324+-- "{\"example\":[1,2,3],\"items\":{\"type\":\"number\"},\"type\":\"array\"}"
341−-- },
342−-- "type": "array"
343−-- }
344--
325--
345−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema ("Jack", 25)
326+-- >>> encode $ sketchSchema ("Jack", 25)
346−-- {
327+-- "{\"example\":[\"Jack\",25],\"items\":[{\"type\":\"string\"},{\"type\":\"number\"}],\"type\":\"array\"}"
347−-- "example": [
348−-- "Jack",
349−-- 25
350−-- ],
351−-- "items": [
352−-- {
353−-- "type": "string"
354−-- },
355−-- {
356−-- "type": "number"
357−-- }
358−-- ],
359−-- "type": "array"
360−-- }
361--
328--
362-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
329-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
363-- >>> instance ToJSON Person
330-- >>> instance ToJSON Person
364−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (Person "Jack" 25)
331+-- >>> encode $ sketchSchema (Person "Jack" 25)
365−-- {
332+-- "{\"required\":[\"age\",\"name\"],\"properties\":{\"age\":{\"type\":\"number\"},\"name\":{\"type\":\"string\"}},\"example\":{\"age\":25,\"name\":\"Jack\"},\"type\":\"object\"}"
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−-- }
384sketchSchema :: ToJSON a => a -> Schema
333sketchSchema :: ToJSON a => a -> Schema
385sketchSchema = sketch . toJSON
334sketchSchema = sketch . toJSON
386 where
335 where
@@ -388,15 +337,15 @@ sketchSchema = sketch . toJSON
388 sketch js@(Bool _) = go js
337 sketch js@(Bool _) = go js
389 sketch js = go js & example ?~ js
338 sketch js = go js & example ?~ js
390
339
391− go Null = mempty & type_ ?~ OpenApiNull
340+ go Null = mempty & type_ ?~ SwaggerNull
392− go (Bool _) = mempty & type_ ?~ OpenApiBoolean
341+ go (Bool _) = mempty & type_ ?~ SwaggerBoolean
393− go (String _) = mempty & type_ ?~ OpenApiString
342+ go (String _) = mempty & type_ ?~ SwaggerString
394− go (Number _) = mempty & type_ ?~ OpenApiNumber
343+ go (Number _) = mempty & type_ ?~ SwaggerNumber
395 go (Array xs) = mempty
344 go (Array xs) = mempty
396− & type_ ?~ OpenApiArray
345+ & type_ ?~ SwaggerArray
397 & items ?~ case ischema of
346 & items ?~ case ischema of
398− Just s -> OpenApiItemsObject (Inline s)
347+ Just s -> SwaggerItemsObject (Inline s)
399− _ -> OpenApiItemsArray (map Inline ys)
348+ _ -> SwaggerItemsArray (map Inline ys)
400 where
349 where
401 ys = map go (V.toList xs)
350 ys = map go (V.toList xs)
402 allSame = and ((zipWith (==)) ys (tail ys))
351 allSame = and ((zipWith (==)) ys (tail ys))
@@ -405,190 +354,76 @@ sketchSchema = sketch . toJSON
405 (z:_) | allSame -> Just z
354 (z:_) | allSame -> Just z
406 _ -> Nothing
355 _ -> Nothing
407 go (Object o) = mempty
356 go (Object o) = mempty
408− & type_ ?~ OpenApiObject
357+ & type_ ?~ SwaggerObject
409− & required .~ sort (objectKeys o)
358+ & required .~ HashMap.keys o
410− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
359+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
411
360
412-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
361-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
413-- Produced schema uses as much constraints as possible.
362-- Produced schema uses as much constraints as possible.
414--
363--
415−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema "hello"
364+-- >>> encode $ sketchStrictSchema "hello"
416−-- {
365+-- "{\"maxLength\":5,\"pattern\":\"hello\",\"minLength\":5,\"type\":\"string\",\"enum\":[\"hello\"]}"
417−-- "enum": [
418−-- "hello"
419−-- ],
420−-- "maxLength": 5,
421−-- "minLength": 5,
422−-- "pattern": "hello",
423−-- "type": "string"
424−-- }
425--
366--
426−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (1, 2, 3)
367+-- >>> encode $ sketchStrictSchema (1, 2, 3)
427−-- {
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]]}"
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−-- }
469--
369--
470−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema ("Jack", 25)
370+-- >>> encode $ sketchStrictSchema ("Jack", 25)
471−-- {
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]]}"
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−-- }
503--
372--
504-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
373-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
505-- >>> instance ToJSON Person
374-- >>> instance ToJSON Person
506−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (Person "Jack" 25)
375+-- >>> encode $ sketchStrictSchema (Person "Jack" 25)
507−-- {
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\"}]}"
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−-- }
542sketchStrictSchema :: ToJSON a => a -> Schema
377sketchStrictSchema :: ToJSON a => a -> Schema
543sketchStrictSchema = go . toJSON
378sketchStrictSchema = go . toJSON
544 where
379 where
545− go Null = mempty & type_ ?~ OpenApiNull
380+ go Null = mempty & type_ ?~ SwaggerNull
546 go js@(Bool _) = mempty
381 go js@(Bool _) = mempty
547− & type_ ?~ OpenApiBoolean
382+ & type_ ?~ SwaggerBoolean
548 & enum_ ?~ [js]
383 & enum_ ?~ [js]
549 go js@(String s) = mempty
384 go js@(String s) = mempty
550− & type_ ?~ OpenApiString
385+ & type_ ?~ SwaggerString
551 & maxLength ?~ fromIntegral (T.length s)
386 & maxLength ?~ fromIntegral (T.length s)
552 & minLength ?~ fromIntegral (T.length s)
387 & minLength ?~ fromIntegral (T.length s)
553 & pattern ?~ s
388 & pattern ?~ s
554 & enum_ ?~ [js]
389 & enum_ ?~ [js]
555 go js@(Number n) = mempty
390 go js@(Number n) = mempty
556− & type_ ?~ OpenApiNumber
391+ & type_ ?~ SwaggerNumber
557 & maximum_ ?~ n
392 & maximum_ ?~ n
558 & minimum_ ?~ n
393 & minimum_ ?~ n
559 & multipleOf ?~ n
394 & multipleOf ?~ n
560 & enum_ ?~ [js]
395 & enum_ ?~ [js]
561 go js@(Array xs) = mempty
396 go js@(Array xs) = mempty
562− & type_ ?~ OpenApiArray
397+ & type_ ?~ SwaggerArray
563 & maxItems ?~ fromIntegral sz
398 & maxItems ?~ fromIntegral sz
564 & minItems ?~ fromIntegral sz
399 & minItems ?~ fromIntegral sz
565− & items ?~ OpenApiItemsArray (map (Inline . go) (V.toList xs))
400+ & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
566 & uniqueItems ?~ allUnique
401 & uniqueItems ?~ allUnique
567 & enum_ ?~ [js]
402 & enum_ ?~ [js]
568 where
403 where
569 sz = length xs
404 sz = length xs
570 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
405 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
571 go js@(Object o) = mempty
406 go js@(Object o) = mempty
572− & type_ ?~ OpenApiObject
407+ & type_ ?~ SwaggerObject
573− & required .~ sort names
408+ & required .~ names
574− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
409+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
575 & maxProperties ?~ fromIntegral (length names)
410 & maxProperties ?~ fromIntegral (length names)
576 & minProperties ?~ fromIntegral (length names)
411 & minProperties ?~ fromIntegral (length names)
577 & enum_ ?~ [js]
412 & enum_ ?~ [js]
578 where
413 where
579− names = objectKeys o
414+ names = HashMap.keys o
580
415
581class GToSchema (f :: * -> *) where
416class GToSchema (f :: * -> *) where
582 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
417 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
583
418
584−instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
419+instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
585 declareNamedSchema _ = do
420 declareNamedSchema _ = do
586 ref <- declareSchemaRef (Proxy :: Proxy a)
421 ref <- declareSchemaRef (Proxy :: Proxy a)
587 return $ unnamed $ mempty
422 return $ unnamed $ mempty
588− & type_ ?~ OpenApiArray
423+ & type_ ?~ SwaggerArray
589− & items ?~ OpenApiItemsObject ref
424+ & items ?~ SwaggerItemsObject ref
590
425
591−instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
426+instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
592instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
427instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
593instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
428instance ToSchema Integer where declareNamedSchema = plain . paramSchemaToSchema
594instance ToSchema Natural where declareNamedSchema = plain . paramSchemaToSchema
429instance ToSchema Natural where declareNamedSchema = plain . paramSchemaToSchema
@@ -611,14 +446,12 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
611instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
446instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
612instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
447instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
613
448
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
615
450
616instance ToSchema a => ToSchema (Maybe a) where
451instance ToSchema a => ToSchema (Maybe a) where
617 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
452 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
618
453
619−instance (ToSchema a, ToSchema b) => ToSchema (Either a b) where
454+instance (ToSchema a, ToSchema b) => ToSchema (Either a b)
620− -- To match Aeson instance
621− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { sumEncoding = ObjectWithSingleField }
622
455
623instance ToSchema () where
456instance ToSchema () where
624 declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
457 declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
@@ -628,22 +461,16 @@ instance ToSchema UUID.UUID where
628 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
461 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
629 & example ?~ toJSON (UUID.toText UUID.nil)
462 & example ?~ toJSON (UUID.toText UUID.nil)
630
463
631−instance (ToSchema a, ToSchema b) => ToSchema (a, b) where
464+instance (ToSchema a, ToSchema b) => ToSchema (a, b)
632− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
633−instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) where
465+instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
634− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
635−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d) where
466+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
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
467+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e)
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
468+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
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
469+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
642− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
643
470
644timeSchema :: T.Text -> Schema
471timeSchema :: T.Text -> Schema
645timeSchema fmt = mempty
472timeSchema fmt = mempty
646− & type_ ?~ OpenApiString
473+ & type_ ?~ SwaggerString
647 & format ?~ fmt
474 & format ?~ fmt
648
475
649-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
476-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -658,7 +485,7 @@ instance ToSchema LocalTime where
658 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
485 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
659 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
486 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
660
487
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.
662instance ToSchema ZonedTime where
489instance ToSchema ZonedTime where
663 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
490 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
664 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
491 & 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
678
505
679instance ToSchema Version where declareNamedSchema = plain . paramSchemaToSchema
506instance ToSchema Version where declareNamedSchema = plain . paramSchemaToSchema
680
507
508+#if __GLASGOW_HASKELL__ < 800
509+#else
681type family ToSchemaByteStringError bs where
510type family ToSchemaByteStringError bs where
682 ToSchemaByteStringError bs = TypeError
511 ToSchemaByteStringError bs = TypeError
683 ( Text "Impossible to have an instance " :<>: ShowType (ToSchema bs) :<>: Text "."
512 ( Text "Impossible to have an instance " :<>: ShowType (ToSchema bs) :<>: Text "."
@@ -686,13 +515,15 @@ type family ToSchemaByteStringError bs where
686
515
687instance ToSchemaByteStringError BS.ByteString => ToSchema BS.ByteString where declareNamedSchema = error "impossible"
516instance ToSchemaByteStringError BS.ByteString => ToSchema BS.ByteString where declareNamedSchema = error "impossible"
688instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where declareNamedSchema = error "impossible"
517instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where declareNamedSchema = error "impossible"
518+#endif
689
519
690instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
520instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
691
521
692-- | NOTE: This schema does not account for the uniqueness of keys.
522-- | 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
694 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
524 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
695
525
526+#if MIN_VERSION_aeson(1,0,0)
696instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
527instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
697 declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction k of
528 declareNamedSchema _ = case toJSONKey :: ToJSONKeyFunction k of
698 ToJSONKeyText _ _ -> declareObjectMapSchema
529 ToJSONKeyText _ _ -> declareObjectMapSchema
@@ -701,15 +532,33 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
701 declareObjectMapSchema = do
532 declareObjectMapSchema = do
702 schema <- declareSchemaRef (Proxy :: Proxy v)
533 schema <- declareSchemaRef (Proxy :: Proxy v)
703 return $ unnamed $ mempty
534 return $ unnamed $ mempty
704− & type_ ?~ OpenApiObject
535+ & type_ ?~ SwaggerObject
705 & additionalProperties ?~ AdditionalPropertiesSchema schema
536 & additionalProperties ?~ AdditionalPropertiesSchema schema
706
537
707instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
538instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
708 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))
539 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))
709
540
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+
710−instance {-# OVERLAPPING #-} ToSchema Object where
559+instance OVERLAPPING_ ToSchema Object where
711 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
560 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
712− & type_ ?~ OpenApiObject
561+ & type_ ?~ SwaggerObject
713 & description ?~ "Arbitrary JSON object."
562 & description ?~ "Arbitrary JSON object."
714 & additionalProperties ?~ AdditionalPropertiesAllowed True
563 & additionalProperties ?~ AdditionalPropertiesAllowed True
715
564
@@ -746,15 +595,11 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
746
595
747-- | Default schema for @'Bounded'@, @'Integral'@ types.
596-- | Default schema for @'Bounded'@, @'Integral'@ types.
748--
597--
749−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
598+-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
750−-- {
751−-- "maximum": 32767,
599+-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
752−-- "minimum": -32768,
753−-- "type": "integer"
754−-- }
755toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
600toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
756toSchemaBoundedIntegral _ = mempty
601toSchemaBoundedIntegral _ = mempty
757− & type_ ?~ OpenApiInteger
602+ & type_ ?~ SwaggerInteger
758 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
603 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
759 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
604 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
760
605
@@ -783,27 +628,8 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
783-- >>> instance ToSchema ButtonState
628-- >>> instance ToSchema ButtonState
784-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
629-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
785-- >>> type ImageUrl = T.Text
630-- >>> type ImageUrl = T.Text
786−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
631+-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
787−-- {
632+-- "{\"properties\":{\"Neutral\":{\"type\":\"string\"},\"Focus\":{\"type\":\"string\"},\"Active\":{\"type\":\"string\"},\"Hover\":{\"type\":\"string\"},\"Disabled\":{\"type\":\"string\"}},\"type\":\"object\"}"
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−-- }
807--
633--
808-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
634-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
809-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
635-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -811,15 +637,15 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.
811 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
637 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
812 => Proxy (map key value) -> Declare (Definitions Schema) Schema
638 => Proxy (map key value) -> Declare (Definitions Schema) Schema
813declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
639declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
814− ToJSONKeyText getKey _ -> objectSchema getKey
640+ ToJSONKeyText keyToText _ -> objectSchema keyToText
815 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
641 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
816 where
642 where
817− objectSchema getKey = do
643+ objectSchema keyToText = do
818 valueRef <- declareSchemaRef (Proxy :: Proxy value)
644 valueRef <- declareSchemaRef (Proxy :: Proxy value)
819 let allKeys = [minBound..maxBound :: key]
645 let allKeys = [minBound..maxBound :: key]
820− mkPair k = (keyToText $ getKey k, valueRef)
646+ mkPair k = (keyToText k, valueRef)
821 return $ mempty
647 return $ mempty
822− & type_ ?~ OpenApiObject
648+ & type_ ?~ SwaggerObject
823 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
649 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
824
650
825-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
651-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -830,27 +656,8 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
830-- >>> instance ToSchema ButtonState
656-- >>> instance ToSchema ButtonState
831-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
657-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
832-- >>> type ImageUrl = T.Text
658-- >>> type ImageUrl = T.Text
833−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
659+-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
834−-- {
660+-- "{\"properties\":{\"Neutral\":{\"type\":\"string\"},\"Focus\":{\"type\":\"string\"},\"Active\":{\"type\":\"string\"},\"Hover\":{\"type\":\"string\"},\"Disabled\":{\"type\":\"string\"}},\"type\":\"object\"}"
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−-- }
854--
661--
855-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
662-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
856-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
663-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -860,32 +667,32 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.
860toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
667toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
861
668
862-- | A configurable generic @'Schema'@ creator.
669-- | A configurable generic @'Schema'@ creator.
863−genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
670+genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>
864 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
671 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
865−genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
672+genericDeclareSchema = genericDeclareSchemaUnrestricted
866
673
867-- | A configurable generic @'NamedSchema'@ creator.
674-- | A configurable generic @'NamedSchema'@ creator.
868-- This function applied to @'defaultSchemaOptions'@
675-- This function applied to @'defaultSchemaOptions'@
869-- is used as the default for @'declareNamedSchema'@
676-- is used as the default for @'declareNamedSchema'@
870-- when the type is an instance of @'Generic'@.
677-- 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.
871--
683--
872−-- Default implementation will use the name from 'Typeable' instance, including concrete
684+-- Unlike 'genericDeclareSchema' also works for mixed sum types.
873−-- instantioations of type variables.
685+-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
874−--
686+genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
875−-- For example:
687+genericDeclareSchemaUnrestricted opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchemaUnrestricted opts proxy
688+
689+-- | A configurable generic @'NamedSchema'@ creator.
876--
690--
877−-- >>> _namedSchemaName $ undeclare $ genericDeclareNamedSchema defaultSchemaOptions (Proxy :: Proxy (Either Int Bool))
691+-- Unlike 'genericDeclareNamedSchema' also works for mixed sum types.
878−-- Just "Either_Int_Bool"
692+-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
879−genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>
693+genericDeclareNamedSchemaUnrestricted :: forall a. (Generic a, GToSchema (Rep a)) =>
880 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
694 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
881−genericDeclareNamedSchema opts _ =
882− rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
695+genericDeclareNamedSchemaUnrestricted opts _ = 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−
889
696
890-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
697-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
891genericNameSchema :: forall a d f.
698genericNameSchema :: forall a d f.
@@ -901,19 +708,19 @@ gdatatypeSchemaName opts _ = case orig of
901 orig = datatypeName (Proxy3 :: Proxy3 d f a)
708 orig = datatypeName (Proxy3 :: Proxy3 d f a)
902 name = datatypeNameModifier opts orig
709 name = datatypeNameModifier opts orig
903
710
904−-- | Construct 'NamedSchema' usinng 'ToParamSchema'.
711+-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
905paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
712paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
906 SchemaOptions -> Proxy a -> NamedSchema
713 SchemaOptions -> Proxy a -> NamedSchema
907paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
714paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
908
715
909−-- | Construct 'Schema' usinng 'ToParamSchema'.
716+-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
910paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
717paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
911−paramSchemaToSchema = toParamSchema
718+paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
912
719
913nullarySchema :: Schema
720nullarySchema :: Schema
914nullarySchema = mempty
721nullarySchema = mempty
915− & type_ ?~ OpenApiArray
722+ & type_ ?~ SwaggerArray
916− & items ?~ OpenApiItemsArray []
723+ & items ?~ SwaggerItemsArray []
917
724
918gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
725gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
919gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
726gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
@@ -931,10 +738,10 @@ instance (Datatype d, GToSchema f) => GToSchema (D1 d f) where
931 where
738 where
932 name = gdatatypeSchemaName opts (Proxy :: Proxy d)
739 name = gdatatypeSchemaName opts (Proxy :: Proxy d)
933
740
934−instance {-# OVERLAPPABLE #-} GToSchema f => GToSchema (C1 c f) where
741+instance OVERLAPPABLE_ GToSchema f => GToSchema (C1 c f) where
935 gdeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy f)
742 gdeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy f)
936
743
937−instance {-# OVERLAPPING #-} Constructor c => GToSchema (C1 c U1) where
744+instance OVERLAPPING_ Constructor c => GToSchema (C1 c U1) where
938 gdeclareNamedSchema = gdeclareNamedSumSchema
745 gdeclareNamedSchema = gdeclareNamedSumSchema
939
746
940-- | Single field constructor.
747-- | Single field constructor.
@@ -943,15 +750,12 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
943 | unwrapUnaryRecords opts = fieldSchema
750 | unwrapUnaryRecords opts = fieldSchema
944 | otherwise =
751 | otherwise =
945 case schema ^. items of
752 case schema ^. items of
946− Just (OpenApiItemsArray [_]) -> fieldSchema
753+ Just (SwaggerItemsArray [_]) -> fieldSchema
947 _ -> do
754 _ -> do
948− -- We have to run recordSchema instead of just using its defs,
755+ declare 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')
756+ return (unnamed schema)
953 where
757 where
954− (_, NamedSchema _ schema) = runDeclare recordSchema mempty
758+ (defs, NamedSchema _ schema) = runDeclare recordSchema mempty
955 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
759 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
956 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
760 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
957
761
@@ -974,10 +778,10 @@ gdeclareSchemaRef opts proxy = do
974 return $ Ref (Reference name)
778 return $ Ref (Reference name)
975 _ -> Inline <$> gdeclareSchema opts proxy
779 _ -> Inline <$> gdeclareSchema opts proxy
976
780
977−appendItem :: Referenced Schema -> Maybe OpenApiItems -> Maybe OpenApiItems
781+appendItem :: Referenced Schema -> Maybe (SwaggerItems 'SwaggerKindSchema) -> Maybe (SwaggerItems 'SwaggerKindSchema)
978−appendItem x Nothing = Just (OpenApiItemsArray [x])
782+appendItem x Nothing = Just (SwaggerItemsArray [x])
979−appendItem x (Just (OpenApiItemsArray xs)) = Just (OpenApiItemsArray (xs ++ [x]))
783+appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
980−appendItem _ _ = error "GToSchema.appendItem: cannot append to OpenApiItemsObject"
784+appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
981
785
982withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
786withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
983 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
787 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
@@ -986,12 +790,12 @@ withFieldSchema opts _ isRequiredField schema = do
986 return $
790 return $
987 if T.null fname
791 if T.null fname
988 then schema
792 then schema
989− & type_ ?~ OpenApiArray
793+ & type_ ?~ SwaggerArray
990 & items %~ appendItem ref
794 & items %~ appendItem ref
991 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
795 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
992 & minItems %~ Just . maybe 1 (+1) -- increment minItems
796 & minItems %~ Just . maybe 1 (+1) -- increment minItems
993 else schema
797 else schema
994− & type_ ?~ OpenApiObject
798+ & type_ ?~ SwaggerObject
995 & properties . at fname ?~ ref
799 & properties . at fname ?~ ref
996 & if isRequiredField
800 & if isRequiredField
997 then required %~ (++ [fname])
801 then required %~ (++ [fname])
@@ -1000,127 +804,79 @@ withFieldSchema opts _ isRequiredField schema = do
1000 fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
804 fname = T.pack (fieldLabelModifier opts (selName (Proxy3 :: Proxy3 s f p)))
1001
805
1002-- | Optional record fields.
806-- | 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
1004 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
808 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s (K1 i (Maybe c))) False
1005
809
1006-- | Record fields.
810-- | 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
1008 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True
812 gdeclareNamedSchema opts _ = fmap unnamed . withFieldSchema opts (Proxy2 :: Proxy2 s f) True
1009
813
1010−instance {-# OVERLAPPING #-} ToSchema c => GToSchema (K1 i (Maybe c)) where
814+instance OVERLAPPING_ ToSchema c => GToSchema (K1 i (Maybe c)) where
1011 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
815 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
1012
816
1013−instance {-# OVERLAPPABLE #-} ToSchema c => GToSchema (K1 i c) where
817+instance OVERLAPPABLE_ ToSchema c => GToSchema (K1 i c) where
1014 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
818 gdeclareNamedSchema _ _ _ = declareNamedSchema (Proxy :: Proxy c)
1015
819
1016instance ( GSumToSchema f
820instance ( GSumToSchema f
1017 , GSumToSchema g
821 , GSumToSchema g
1018 ) => GToSchema (f :+: g)
822 ) => GToSchema (f :+: g)
1019 where
823 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
1022
825
1023gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
826gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
1024−gdeclareNamedSumSchema opts proxy _
827+gdeclareNamedSumSchema opts proxy s
1025− | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchemas)
828+ | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
1026− | otherwise = do
1027− (schemas, _) <- runWriterT declareSumSchema
829+ | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
1028− return $ unnamed $ mempty
1029− & type_ ?~ OpenApiObject
1030− & oneOf ?~ (snd <$> schemas)
1031 where
830 where
1032− declareSumSchema = gsumToSchema opts proxy
831+ declareSumSchema = gsumToSchema opts proxy s
1033− (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
832+ (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
1034
833
1035− toStringTag schemas = mempty
834+ toStringTag schema = mempty
1036− & type_ ?~ OpenApiString
835+ & type_ ?~ SwaggerString
1037− & enum_ ?~ map (String . fst) sumSchemas
836+ & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
1038
837
1039type AllNullary = All
838type AllNullary = All
1040
839
1041class GSumToSchema (f :: * -> *) where
840class 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
1043
842
1044instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
843instance (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)
1047
845
1048−-- | Convert one component of the sum to schema, to be later combined with @oneOf@.
1049gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
846gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
1050− Maybe (Referenced Schema) -> SchemaOptions -> Proxy (C1 c f) -> (T.Text, Referenced Schema)
847+ Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
1051−gsumConToSchemaWith ref opts _ = (tag, schema)
848+gsumConToSchemaWith ref opts _ schema = schema
849+ & type_ ?~ SwaggerObject
850+ & properties . at tag ?~ ref
851+ & maxProperties ?~ 1
852+ & minProperties ?~ 1
1052 where
853 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−
1089 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
854 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
1093
855
1094gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
856gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
1095− SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
857+ SchemaOptions -> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
1096−gsumConToSchema opts proxy = do
858+gsumConToSchema opts proxy schema = do
1097 ref <- gdeclareSchemaRef opts proxy
859 ref <- gdeclareSchemaRef opts proxy
1098− return [gsumConToSchemaWith (Just ref) opts proxy]
860+ return $ gsumConToSchemaWith ref opts proxy schema
1099
861
1100−instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
862+instance OVERLAPPABLE_ (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
1101− gsumToSchema opts proxy = do
863+ gsumToSchema opts proxy schema = do
1102 tell (All False)
864 tell (All False)
1103− lift $ gsumConToSchema opts proxy
865+ lift $ gsumConToSchema opts proxy schema
1104
866
1105instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
867instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
1106− gsumToSchema opts proxy = do
868+ gsumToSchema opts proxy schema = do
1107 tell (All False)
869 tell (All False)
1108− lift $ gsumConToSchema opts proxy
870+ lift $ gsumConToSchema opts proxy schema
1109
871
1110instance Constructor c => GSumToSchema (C1 c U1) where
872instance 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
1112
874
1113data Proxy2 a b = Proxy2
875data Proxy2 a b = Proxy2
1114
876
1115data Proxy3 a b c = Proxy3
877data Proxy3 a b c = Proxy3
1116
878
1117−{- $setup
879+-- $setup
1118−>>> import Data.OpenApi
880+-- >>> import Data.Swagger
1119−>>> import Data.Aeson (encode)
881+-- >>> import Data.Aeson (encode)
1120−>>> import Data.Aeson.Types (toJSONKeyText)
882+-- >>> import Data.Aeson.Types (toJSONKeyText)
1121−>>> import Data.OpenApi.Internal.Utils
1122−>>> :set -XScopedTypeVariables
1123−>>> :set -XDeriveAnyClass
1124−>>> :set -XStandaloneDeriving
1125−>>> :set -XTypeApplications
1126−-}
src/Data/OpenApi/Internal/Schema/Validation.hs → src/Data/Swagger/Internal/Schema/Validation.hsrenamed+91−202
@@ -1,5 +1,4 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE CPP #-}
3{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE DeriveFunctor #-}
5{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
@@ -13,51 +12,40 @@
13{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE ScopedTypeVariables #-}
14{-# LANGUAGE TemplateHaskell #-}
13{-# LANGUAGE TemplateHaskell #-}
15{-# LANGUAGE UndecidableInstances #-}
14{-# LANGUAGE UndecidableInstances #-}
16−{-# LANGUAGE ViewPatterns #-}
17-- |
15-- |
18−-- Module: Data.OpenApi.Internal.Schema.Validation
16+-- Module: Data.Swagger.Internal.Schema.Validation
19-- Copyright: (c) 2015 GetShopTV
17-- Copyright: (c) 2015 GetShopTV
20-- License: BSD3
18-- License: BSD3
21-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
19-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
22-- Stability: experimental
20-- Stability: experimental
23--
21--
24-- Validate JSON values with Swagger Schema.
22-- Validate JSON values with Swagger Schema.
25−module Data.OpenApi.Internal.Schema.Validation where
23+module Data.Swagger.Internal.Schema.Validation where
26−
27−import Prelude ()
28−import Prelude.Compat
29
24
30import Control.Applicative
25import Control.Applicative
31−import Control.Lens hiding (allOf)
26+import Control.Lens
32−import Control.Monad (forM, forM_, when)
27+import Control.Monad (when)
33
28
34import Data.Aeson hiding (Result)
29import Data.Aeson hiding (Result)
35−#if MIN_VERSION_aeson(2,0,0)
36−import qualified Data.Aeson.KeyMap as KeyMap
37−#endif
38import Data.Foldable (for_, sequenceA_,
30import Data.Foldable (for_, sequenceA_,
39 traverse_)
31 traverse_)
40−#if !MIN_VERSION_aeson(2,0,0)
41import Data.HashMap.Strict (HashMap)
32import Data.HashMap.Strict (HashMap)
42−#endif
33+import qualified Data.HashMap.Strict as HashMap
43import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
34import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
44import qualified "unordered-containers" Data.HashSet as HashSet
35import qualified "unordered-containers" Data.HashSet as HashSet
45−import Data.Maybe (fromMaybe)
36+import Data.List (intercalate)
37+import Data.Monoid
46import Data.Proxy
38import Data.Proxy
47import Data.Scientific (Scientific, isInteger)
39import Data.Scientific (Scientific, isInteger)
48import Data.Text (Text)
40import Data.Text (Text)
49import qualified Data.Text as Text
41import qualified Data.Text as Text
50−import qualified Data.Text.Lazy as TL
51−import qualified Data.Text.Lazy.Encoding as TL
52import Data.Vector (Vector)
42import Data.Vector (Vector)
53import qualified Data.Vector as Vector
43import qualified Data.Vector as Vector
54
44
55−import Data.OpenApi.Aeson.Compat (hasKey, keyToText, lookupKey, objectToList)
56−import Data.OpenApi.Declare
45+import Data.Swagger.Declare
57−import Data.OpenApi.Internal
46+import Data.Swagger.Internal
58−import Data.OpenApi.Internal.Schema
47+import Data.Swagger.Internal.Schema
59−import Data.OpenApi.Internal.Utils
48+import Data.Swagger.Lens
60−import Data.OpenApi.Lens
61
49
62-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
50-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
63-- This can be used with QuickCheck to ensure those instances are coherent:
51-- This can be used with QuickCheck to ensure those instances are coherent:
@@ -66,101 +54,18 @@ import Data.OpenApi.Lens
66--
54--
67-- /NOTE:/ @'validateToJSON'@ does not perform string pattern validation.
55-- /NOTE:/ @'validateToJSON'@ does not perform string pattern validation.
68-- See @'validateToJSONWithPatternChecker'@.
56-- See @'validateToJSONWithPatternChecker'@.
69−--
70−-- See 'renderValidationErrors' on how the output is structured.
71−validatePrettyToJSON :: forall a. (ToJSON a, ToSchema a) => a -> Maybe String
72−validatePrettyToJSON = renderValidationErrors validateToJSON
73−
74−-- | Variant of 'validatePrettyToJSON' with typed output.
75validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [ValidationError]
57validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [ValidationError]
76validateToJSON = validateToJSONWithPatternChecker (\_pattern _str -> True)
58validateToJSON = validateToJSONWithPatternChecker (\_pattern _str -> True)
77
59
78-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value and pattern checker.
60-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value and pattern checker.
79-- This can be used with QuickCheck to ensure those instances are coherent.
61-- This can be used with QuickCheck to ensure those instances are coherent.
80--
62--
81−-- For validation without patterns see @'validateToJSON'@. See also:
63+-- For validation without patterns see @'validateToJSON'@.
82−-- 'renderValidationErrors'.
83validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) => (Pattern -> Text -> Bool) -> a -> [ValidationError]
64validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) => (Pattern -> Text -> Bool) -> a -> [ValidationError]
84validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checker defs sch . toJSON
65validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checker defs sch . toJSON
85 where
66 where
86 (defs, sch) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
67 (defs, sch) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
87
68
88−-- | Pretty print validation errors
89−-- together with actual JSON and Swagger Schema
90−-- (using 'encodePretty').
91−--
92−-- >>> import Data.Aeson as Aeson
93−-- >>> import Data.Foldable (traverse_)
94−-- >>> import GHC.Generics
95−-- >>> data Phone = Phone { value :: String } deriving (Generic)
96−-- >>> data Person = Person { name :: String, phone :: Phone } deriving (Generic)
97−-- >>> instance ToJSON Person where toJSON p = object [ "name" Aeson..= name p ]
98−-- >>> instance ToSchema Phone
99−-- >>> instance ToSchema Person
100−-- >>> let person = Person { name = "John", phone = Phone "123456" }
101−-- >>> traverse_ putStrLn $ renderValidationErrors validateToJSON person
102−-- Validation against the schema fails:
103−-- * property "phone" is required, but not found in "{\"name\":\"John\"}"
104−-- <BLANKLINE>
105−-- JSON value:
106−-- {
107−-- "name": "John"
108−-- }
109−-- <BLANKLINE>
110−-- Swagger Schema:
111−-- {
112−-- "properties": {
113−-- "name": {
114−-- "type": "string"
115−-- },
116−-- "phone": {
117−-- "$ref": "#/components/schemas/Phone"
118−-- }
119−-- },
120−-- "required": [
121−-- "name",
122−-- "phone"
123−-- ],
124−-- "type": "object"
125−-- }
126−-- <BLANKLINE>
127−-- Swagger Description Context:
128−-- {
129−-- "Phone": {
130−-- "properties": {
131−-- "value": {
132−-- "type": "string"
133−-- }
134−-- },
135−-- "required": [
136−-- "value"
137−-- ],
138−-- "type": "object"
139−-- }
140−-- }
141−-- <BLANKLINE>
142−renderValidationErrors
143− :: forall a. (ToJSON a, ToSchema a)
144− => (a -> [ValidationError]) -> a -> Maybe String
145−renderValidationErrors f x =
146− case f x of
147− [] -> Nothing
148− errors -> Just $ unlines
149− [ "Validation against the schema fails:"
150− , unlines (map (" * " ++) errors)
151− , "JSON value:"
152− , ppJSONString (toJSON x)
153− , ""
154− , "Swagger Schema:"
155− , ppJSONString (toJSON schema_)
156− , ""
157− , "Swagger Description Context:"
158− , ppJSONString (toJSON refs_)
159− ]
160− where
161− ppJSONString = TL.unpack . TL.decodeUtf8 . encodePretty
162− (refs_, schema_) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty
163−
164-- | Validate JSON @'Value'@ against Swagger @'Schema'@.
69-- | Validate JSON @'Value'@ against Swagger @'Schema'@.
165--
70--
166-- prop> validateJSON mempty (toSchema (Proxy :: Proxy Int)) (toJSON (x :: Int)) == []
71-- prop> validateJSON mempty (toSchema (Proxy :: Proxy Int)) (toJSON (x :: Int)) == []
@@ -211,7 +116,7 @@ instance Monad Result where
211
116
212-- | Validation configuration.
117-- | Validation configuration.
213data Config = Config
118data Config = Config
214− { -- | Pattern checker for @'_schemaPattern'@ validation.
119+ { -- | Pattern checker for @'_paramSchemaPattern'@ validation.
215 configPatternChecker :: Pattern -> Text -> Bool
120 configPatternChecker :: Pattern -> Text -> Bool
216 -- | Schema definitions in scope to resolve references.
121 -- | Schema definitions in scope to resolve references.
217 , configDefinitions :: Definitions Schema
122 , configDefinitions :: Definitions Schema
@@ -304,34 +209,40 @@ validateWithSchemaRef (Inline s) js = sub s (validateWithSchema js)
304
209
305-- | Validate JSON @'Value'@ with Swagger @'Schema'@.
210-- | Validate JSON @'Value'@ with Swagger @'Schema'@.
306validateWithSchema :: Value -> Validation Schema ()
211validateWithSchema :: Value -> Validation Schema ()
307−validateWithSchema val = do
212+validateWithSchema value = do
308− validateSchemaType val
213+ validateSchemaType value
309− validateEnum val
214+ sub_ paramSchema $ validateEnum value
215+
216+-- | Validate JSON @'Value'@ with Swagger @'ParamSchema'@.
217+validateWithParamSchema :: Value -> Validation (ParamSchema t) ()
218+validateWithParamSchema value = do
219+ validateParamSchemaType value
220+ validateEnum value
310
221
311−validateInteger :: Scientific -> Validation Schema ()
222+validateInteger :: Scientific -> Validation (ParamSchema t) ()
312validateInteger n = do
223validateInteger n = do
313 when (not (isInteger n)) $
224 when (not (isInteger n)) $
314 invalid ("not an integer")
225 invalid ("not an integer")
315 validateNumber n
226 validateNumber n
316
227
317−validateNumber :: Scientific -> Validation Schema ()
228+validateNumber :: Scientific -> Validation (ParamSchema t) ()
318validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do
229validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do
319 let exMax = Just True == sch ^. exclusiveMaximum
230 let exMax = Just True == sch ^. exclusiveMaximum
320 exMin = Just True == sch ^. exclusiveMinimum
231 exMin = Just True == sch ^. exclusiveMinimum
321
232
322 check maximum_ $ \m ->
233 check maximum_ $ \m ->
323 when (if exMax then (n >= m) else (n > m)) $
234 when (if exMax then (n >= m) else (n > m)) $
324− invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ (if exMax then "<" else "<=") ++ show m ++ ")")
235+ invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ if exMax then "<" else "<=" ++ show m ++ ")")
325
236
326 check minimum_ $ \m ->
237 check minimum_ $ \m ->
327 when (if exMin then (n <= m) else (n < m)) $
238 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 ++ ")")
239+ invalid ("value " ++ show n ++ " falls below minimum (should be " ++ if exMin then ">" else ">=" ++ show m ++ ")")
329
240
330 check multipleOf $ \k ->
241 check multipleOf $ \k ->
331 when (not (isInteger (n / k))) $
242 when (not (isInteger (n / k))) $
332 invalid ("expected a multiple of " ++ show k ++ " but got " ++ show n)
243 invalid ("expected a multiple of " ++ show k ++ " but got " ++ show n)
333
244
334−validateString :: Text -> Validation Schema ()
245+validateString :: Text -> Validation (ParamSchema t) ()
335validateString s = do
246validateString s = do
336 check maxLength $ \n ->
247 check maxLength $ \n ->
337 when (len > fromInteger n) $
248 when (len > fromInteger n) $
@@ -348,7 +259,7 @@ validateString s = do
348 where
259 where
349 len = Text.length s
260 len = Text.length s
350
261
351−validateArray :: Vector Value -> Validation Schema ()
262+validateArray :: Vector Value -> Validation (ParamSchema t) ()
352validateArray xs = do
263validateArray xs = do
353 check maxItems $ \n ->
264 check maxItems $ \n ->
354 when (len > fromInteger n) $
265 when (len > fromInteger n) $
@@ -359,8 +270,9 @@ validateArray xs = do
359 invalid ("array is too short (size should be >=" ++ show n ++ ")")
270 invalid ("array is too short (size should be >=" ++ show n ++ ")")
360
271
361 check items $ \case
272 check items $ \case
273+ SwaggerItemsPrimitive _ itemSchema -> sub itemSchema $ traverse_ validateWithParamSchema xs
362− OpenApiItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs
274+ SwaggerItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs
363− OpenApiItemsArray itemSchemas -> do
275+ SwaggerItemsArray itemSchemas -> do
364 when (len /= length itemSchemas) $
276 when (len /= length itemSchemas) $
365 invalid ("array size is invalid (should be exactly " ++ show (length itemSchemas) ++ ")")
277 invalid ("array size is invalid (should be exactly " ++ show (length itemSchemas) ++ ")")
366 sequenceA_ (zipWith validateWithSchemaRef itemSchemas (Vector.toList xs))
278 sequenceA_ (zipWith validateWithSchemaRef itemSchemas (Vector.toList xs))
@@ -372,20 +284,11 @@ validateArray xs = do
372 len = Vector.length xs
284 len = Vector.length xs
373 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))
285 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))
374
286
375−validateObject ::
376−#if MIN_VERSION_aeson(2,0,0)
377− KeyMap.KeyMap Value
378−#else
379− HashMap Text Value
287+validateObject :: HashMap Text Value -> Validation Schema ()
380−#endif
381− -> Validation Schema ()
382validateObject o = withSchema $ \sch ->
288validateObject o = withSchema $ \sch ->
383 case sch ^. discriminator of
289 case sch ^. discriminator of
384− Just (Discriminator pname types) -> case fromJSON <$> lookupKey pname o of
290+ Just pname -> case fromJSON <$> HashMap.lookup 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)
291+ Just (Success ref) -> validateWithSchemaRef ref (Object o)
389 Just (Error msg) -> invalid ("failed to parse discriminator property " ++ show pname ++ ": " ++ show msg)
292 Just (Error msg) -> invalid ("failed to parse discriminator property " ++ show pname ++ ": " ++ show msg)
390 Nothing -> invalid ("discriminator property " ++ show pname ++ "is missing")
293 Nothing -> invalid ("discriminator property " ++ show pname ++ "is missing")
391 Nothing -> do
294 Nothing -> do
@@ -400,15 +303,15 @@ validateObject o = withSchema $ \sch ->
400 validateRequired
303 validateRequired
401 validateProps
304 validateProps
402 where
305 where
403− size = fromIntegral (length o)
306+ size = fromIntegral (HashMap.size o)
404
307
405 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)
308 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)
406 validateReq n =
309 validateReq n =
407− when (not (hasKey n o)) $
310+ when (not (HashMap.member n o)) $
408 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))
311 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))
409
312
410 validateProps = withSchema $ \sch -> do
313 validateProps = withSchema $ \sch -> do
411− for_ (objectToList o) $ \(keyToText -> k, v) ->
314+ for_ (HashMap.toList o) $ \(k, v) ->
412 case v of
315 case v of
413 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property
316 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property
414 _ ->
317 _ ->
@@ -424,21 +327,21 @@ validateObject o = withSchema $ \sch ->
424 unknownProperty pname = invalid $
327 unknownProperty pname = invalid $
425 "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"
328 "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"
426
329
427−validateEnum :: Value -> Validation Schema ()
330+validateEnum :: Value -> Validation (ParamSchema t) ()
428−validateEnum val = do
331+validateEnum value = do
429 check enum_ $ \xs ->
332 check enum_ $ \xs ->
430− when (val `notElem` xs) $
333+ when (value `notElem` xs) $
431− invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show val)
334+ invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)
432
335
433-- | Infer schema type based on used properties.
336-- | Infer schema type based on used properties.
434--
337--
435-- This is like 'inferParamSchemaTypes', but also works for objects:
338-- This is like 'inferParamSchemaTypes', but also works for objects:
436--
339--
437-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"
340-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"
438−-- Just [OpenApiObject]
341+-- Just [SwaggerObject]
439−inferSchemaTypes :: Schema -> [OpenApiType]
342+inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]
440−inferSchemaTypes sch = inferParamSchemaTypes sch ++
343+inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++
441− [ OpenApiObject | any ($ sch)
344+ [ SwaggerObject | any ($ sch)
442 [ has (additionalProperties._Just)
345 [ has (additionalProperties._Just)
443 , has (maxProperties._Just)
346 , has (maxProperties._Just)
444 , has (minProperties._Just)
347 , has (minProperties._Just)
@@ -448,89 +351,75 @@ inferSchemaTypes sch = inferParamSchemaTypes sch ++
448-- | Infer schema type based on used properties.
351-- | Infer schema type based on used properties.
449--
352--
450-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"
353-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"
451−-- Just [OpenApiString]
354+-- Just [SwaggerString]
452--
355--
453-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"
356-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"
454−-- Just [OpenApiArray]
357+-- Just [SwaggerArray]
455--
358--
456−-- From numeric properties 'OpenApiInteger' type is inferred.
359+-- From numeric properties 'SwaggerInteger' type is inferred.
457−-- If you want 'OpenApiNumber' instead, you must specify it explicitly.
360+-- If you want 'SwaggerNumber' instead, you must specify it explicitly.
458--
361--
459-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"
362-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"
460−-- Just [OpenApiInteger]
363+-- Just [SwaggerInteger]
461−inferParamSchemaTypes :: Schema -> [OpenApiType]
364+inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]
462inferParamSchemaTypes sch = concat
365inferParamSchemaTypes sch = concat
463− [ [ OpenApiArray | any ($ sch)
366+ [ [ SwaggerArray | any ($ sch)
464 [ has (items._Just)
367 [ has (items._Just)
465 , has (maxItems._Just)
368 , has (maxItems._Just)
466 , has (minItems._Just)
369 , has (minItems._Just)
467 , has (uniqueItems._Just) ] ]
370 , has (uniqueItems._Just) ] ]
468− , [ OpenApiInteger | any ($ sch)
371+ , [ SwaggerInteger | any ($ sch)
469 [ has (exclusiveMaximum._Just)
372 [ has (exclusiveMaximum._Just)
470 , has (exclusiveMinimum._Just)
373 , has (exclusiveMinimum._Just)
471 , has (maximum_._Just)
374 , has (maximum_._Just)
472 , has (minimum_._Just)
375 , has (minimum_._Just)
473 , has (multipleOf._Just) ] ]
376 , has (multipleOf._Just) ] ]
474− , [ OpenApiString | any ($ sch)
377+ , [ SwaggerString | any ($ sch)
475 [ has (maxLength._Just)
378 [ has (maxLength._Just)
476 , has (minLength._Just)
379 , has (minLength._Just)
477 , has (pattern._Just) ] ]
380 , has (pattern._Just) ] ]
478 ]
381 ]
479
382
480validateSchemaType :: Value -> Validation Schema ()
383validateSchemaType :: Value -> Validation Schema ()
481−validateSchemaType val = withSchema $ \sch ->
384+validateSchemaType value = 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
385+ case (sch ^. type_, value) of
498− (Just OpenApiNull, Null) -> valid
386+ (Just SwaggerNull, Null) -> valid
499− (Just OpenApiBoolean, Bool _) -> valid
387+ (Just SwaggerBoolean, Bool _) -> valid
500− (Just OpenApiInteger, Number n) -> validateInteger n
388+ (Just SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)
501− (Just OpenApiNumber, Number n) -> validateNumber n
389+ (Just SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)
502− (Just OpenApiString, String s) -> validateString s
390+ (Just SwaggerString, String s) -> sub_ paramSchema (validateString s)
503− (Just OpenApiArray, Array xs) -> validateArray xs
391+ (Just SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)
504− (Just OpenApiObject, Object o) -> validateObject o
392+ (Just SwaggerObject, Object o) -> validateObject o
505− (Nothing, Null) -> valid
393+ (Nothing, Null) -> valid
506− (Nothing, Bool _) -> valid
394+ (Nothing, Bool _) -> valid
507− -- Number by default
395+ -- Number by default
508− (Nothing, Number n) -> validateNumber n
396+ (Nothing, Number n) -> sub_ paramSchema (validateNumber n)
509− (Nothing, String s) -> validateString s
397+ (Nothing, String s) -> sub_ paramSchema (validateString s)
510− (Nothing, Array xs) -> validateArray xs
398+ (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)
511− (Nothing, Object o) -> validateObject o
399+ (Nothing, Object o) -> validateObject o
512− bad -> invalid $ "expected JSON value of type " ++ showType bad
400+ param@(t, _) -> invalid $ "expected JSON value of type " ++ showType param
513−
401+
514−validateParamSchemaType :: Value -> Validation Schema ()
402+validateParamSchemaType :: Value -> Validation (ParamSchema t) ()
515−validateParamSchemaType val = withSchema $ \sch ->
403+validateParamSchemaType value = withSchema $ \sch ->
516− case (sch ^. type_, val) of
404+ case (sch ^. type_, value) of
517− (Just OpenApiBoolean, Bool _) -> valid
405+ (Just SwaggerBoolean, Bool _) -> valid
518− (Just OpenApiInteger, Number n) -> validateInteger n
406+ (Just SwaggerInteger, Number n) -> validateInteger n
519− (Just OpenApiNumber, Number n) -> validateNumber n
407+ (Just SwaggerNumber, Number n) -> validateNumber n
520− (Just OpenApiString, String s) -> validateString s
408+ (Just SwaggerString, String s) -> validateString s
521− (Just OpenApiArray, Array xs) -> validateArray xs
409+ (Just SwaggerArray, Array xs) -> validateArray xs
522 (Nothing, Bool _) -> valid
410 (Nothing, Bool _) -> valid
523 -- Number by default
411 -- Number by default
524 (Nothing, Number n) -> validateNumber n
412 (Nothing, Number n) -> validateNumber n
525 (Nothing, String s) -> validateString s
413 (Nothing, String s) -> validateString s
526 (Nothing, Array xs) -> validateArray xs
414 (Nothing, Array xs) -> validateArray xs
415+ (t, _) -> invalid $ "expected JSON value of type " ++ show t
527− bad -> invalid $ "expected JSON value of type " ++ showType bad
416+ param@(t, _) -> invalid $ "expected JSON value of type " ++ showType param
528−
417+
529−showType :: (Maybe OpenApiType, Value) -> String
418+showType :: (Maybe (SwaggerType t), Value) -> String
530−showType (Just ty, _) = show ty
419+showType (Just type_, _) = show type_
531−showType (Nothing, Null) = "OpenApiNull"
420+showType (Nothing, Null) = "SwaggerNull"
532−showType (Nothing, Bool _) = "OpenApiBoolean"
421+showType (Nothing, Bool _) = "SwaggerBoolean"
533−showType (Nothing, Number _) = "OpenApiNumber"
422+showType (Nothing, Number _) = "SwaggerNumber"
534−showType (Nothing, String _) = "OpenApiString"
423+showType (Nothing, String _) = "SwaggerString"
535−showType (Nothing, Array _) = "OpenApiArray"
424+showType (Nothing, Array _) = "SwaggerArray"
536−showType (Nothing, Object _) = "OpenApiObject"
425+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 #-}
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
4+{-# LANGUAGE KindSignatures #-}
3{-# LANGUAGE TypeFamilies #-}
5{-# LANGUAGE TypeFamilies #-}
4{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE UndecidableInstances #-}
7{-# LANGUAGE UndecidableInstances #-}
6
8
7−module Data.OpenApi.Internal.TypeShape where
9+module Data.Swagger.Internal.TypeShape where
8
10
9import Data.Proxy
11import Data.Proxy
10import GHC.Generics
12import GHC.Generics
@@ -35,6 +37,11 @@ type family TypeHasSimpleShape t (f :: Symbol) :: Constraint where
35type family GenericHasSimpleShape t (f :: Symbol) (s :: TypeShape) :: Constraint where
37type family GenericHasSimpleShape t (f :: Symbol) (s :: TypeShape) :: Constraint where
36 GenericHasSimpleShape t f Enumeration = ()
38 GenericHasSimpleShape t f Enumeration = ()
37 GenericHasSimpleShape t f SumOfProducts = ()
39 GenericHasSimpleShape t f SumOfProducts = ()
40+#if __GLASGOW_HASKELL__ < 800
41+ GenericHasSimpleShape t f Mixed = CannotDeriveSchemaForMixedSumType t
42+
43+class CannotDeriveSchemaForMixedSumType t where
44+#else
38 GenericHasSimpleShape t f Mixed =
45 GenericHasSimpleShape t f Mixed =
39 TypeError
46 TypeError
40 ( Text "Cannot derive Generic-based Swagger Schema for " :<>: ShowType t
47 ( Text "Cannot derive Generic-based Swagger Schema for " :<>: ShowType t
@@ -44,6 +51,7 @@ type family GenericHasSimpleShape t (f :: Symbol) (s :: TypeShape) :: Constraint
44 :$$: Text "that matches aeson's Generic-based toJSON,"
51 :$$: Text "that matches aeson's Generic-based toJSON,"
45 :$$: Text "but that's not supported by some Swagger tools."
52 :$$: Text "but that's not supported by some Swagger tools."
46 )
53 )
54+#endif
47
55
48-- | Infer a 'TypeShape' for a generic representation of a type.
56-- | Infer a 'TypeShape' for a generic representation of a type.
49type family GenericShape (g :: * -> *) :: TypeShape
57type family GenericShape (g :: * -> *) :: TypeShape
@@ -54,3 +62,5 @@ type instance GenericShape (D1 d f) = GenericShape f
54type instance GenericShape (C1 c U1) = Enumeration
62type instance GenericShape (C1 c U1) = Enumeration
55type instance GenericShape (C1 c (S1 s f)) = SumOfProducts
63type instance GenericShape (C1 c (S1 s f)) = SumOfProducts
56type instance GenericShape (C1 c (f :*: g)) = SumOfProducts
64type 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 @@
4{-# LANGUAGE OverloadedStrings #-}
4{-# LANGUAGE OverloadedStrings #-}
5{-# LANGUAGE RankNTypes #-}
5{-# LANGUAGE RankNTypes #-}
6{-# LANGUAGE TypeOperators #-}
6{-# LANGUAGE TypeOperators #-}
7−module Data.OpenApi.Internal.Utils where
7+module Data.Swagger.Internal.Utils where
8
8
9import Prelude ()
9import Prelude ()
10import Prelude.Compat
10import Prelude.Compat
@@ -13,8 +13,6 @@ import Control.Lens ((&), (%~))
13import Control.Lens.TH
13import Control.Lens.TH
14import Data.Aeson
14import Data.Aeson
15import Data.Aeson.Types
15import Data.Aeson.Types
16−import qualified Data.Aeson.Encode.Pretty as P
17−import qualified Data.ByteString.Lazy as BSL
18import Data.Char
16import Data.Char
19import Data.Data
17import Data.Data
20import Data.Hashable (Hashable)
18import Data.Hashable (Hashable)
@@ -46,7 +44,6 @@ swaggerFieldRules = defaultFieldRules & lensField %~ swaggerFieldNamer
46 fixName' "maximum" = "maximum_" -- Prelude conflict
44 fixName' "maximum" = "maximum_" -- Prelude conflict
47 fixName' "enum" = "enum_" -- Control.Lens conflict
45 fixName' "enum" = "enum_" -- Control.Lens conflict
48 fixName' "head" = "head_" -- Prelude conflict
46 fixName' "head" = "head_" -- Prelude conflict
49− fixName' "not" = "not_" -- Prelude conflict
50 fixName' n = n
47 fixName' n = n
51
48
52gunfoldEnum :: String -> [a] -> (forall b r. Data b => c (b -> r) -> c r) -> (forall r. r -> c r) -> Constr -> c a
49gunfoldEnum :: 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
134 swaggerMempty = Nothing
131 swaggerMempty = Nothing
135 swaggerMappend x Nothing = x
132 swaggerMappend x Nothing = x
136 swaggerMappend _ y = y
133 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+180
@@ -0,0 +1,180 @@
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+instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema
100+
101+-- HasType instances
102+instance HasType Header (Maybe (SwaggerType ('SwaggerKindNormal Header))) where type_ = paramSchema.type_
103+instance HasType Schema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_
104+instance HasType NamedSchema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_
105+instance HasType ParamOtherSchema (Maybe (SwaggerType 'SwaggerKindParamOtherSchema)) where type_ = paramSchema.type_
106+
107+-- HasDefault instances
108+instance HasDefault Header (Maybe Value) where default_ = paramSchema.default_
109+instance HasDefault Schema (Maybe Value) where default_ = paramSchema.default_
110+instance HasDefault ParamOtherSchema (Maybe Value) where default_ = paramSchema.default_
111+
112+-- OVERLAPPABLE instances
113+
114+instance
115+#if __GLASGOW_HASKELL__ >= 710
116+ OVERLAPPABLE_
117+#endif
118+ HasParamSchema s (ParamSchema t)
119+ => HasFormat s (Maybe Format) where
120+ format = paramSchema.format
121+
122+instance
123+#if __GLASGOW_HASKELL__ >= 710
124+ OVERLAPPABLE_
125+#endif
126+ HasParamSchema s (ParamSchema t)
127+ => HasItems s (Maybe (SwaggerItems t)) where
128+ items = paramSchema.items
129+
130+instance
131+#if __GLASGOW_HASKELL__ >= 710
132+ OVERLAPPABLE_
133+#endif
134+ HasParamSchema s (ParamSchema t)
135+ => HasMaximum s (Maybe Scientific) where
136+ maximum_ = paramSchema.maximum_
137+
138+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
139+ => HasExclusiveMaximum s (Maybe Bool) where
140+ exclusiveMaximum = paramSchema.exclusiveMaximum
141+
142+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
143+ => HasMinimum s (Maybe Scientific) where
144+ minimum_ = paramSchema.minimum_
145+
146+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
147+ => HasExclusiveMinimum s (Maybe Bool) where
148+ exclusiveMinimum = paramSchema.exclusiveMinimum
149+
150+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
151+ => HasMaxLength s (Maybe Integer) where
152+ maxLength = paramSchema.maxLength
153+
154+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
155+ => HasMinLength s (Maybe Integer) where
156+ minLength = paramSchema.minLength
157+
158+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
159+ => HasPattern s (Maybe Text) where
160+ pattern = paramSchema.pattern
161+
162+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
163+ => HasMaxItems s (Maybe Integer) where
164+ maxItems = paramSchema.maxItems
165+
166+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
167+ => HasMinItems s (Maybe Integer) where
168+ minItems = paramSchema.minItems
169+
170+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
171+ => HasUniqueItems s (Maybe Bool) where
172+ uniqueItems = paramSchema.uniqueItems
173+
174+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
175+ => HasEnum s (Maybe [Value]) where
176+ enum_ = paramSchema.enum_
177+
178+instance OVERLAPPABLE_ HasParamSchema s (ParamSchema t)
179+ => HasMultipleOf s (Maybe Scientific) where
180+ multipleOf = paramSchema.multipleOf
src/Data/OpenApi/Operation.hs → src/Data/Swagger/Operation.hsrenamed+36−148
@@ -1,13 +1,13 @@
1{-# LANGUAGE RankNTypes #-}
1{-# LANGUAGE RankNTypes #-}
2-- |
2-- |
3−-- Module: Data.OpenApi.Operation
3+-- Module: Data.Swagger.Operation
4-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
4-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
5-- Stability: experimental
5-- Stability: experimental
6--
6--
7-- Helper traversals and functions for Swagger operations manipulations.
7-- Helper traversals and functions for Swagger operations manipulations.
8-- These might be useful when you already have Swagger specification
8-- These might be useful when you already have Swagger specification
9-- generated by something else.
9-- generated by something else.
10−module Data.OpenApi.Operation (
10+module Data.Swagger.Operation (
11 -- * Operation traversals
11 -- * Operation traversals
12 allOperations,
12 allOperations,
13 operationsOf,
13 operationsOf,
@@ -39,13 +39,11 @@ import Data.List.Compat
39import Data.Maybe (mapMaybe)
39import Data.Maybe (mapMaybe)
40import Data.Proxy
40import Data.Proxy
41import qualified Data.Set as Set
41import qualified Data.Set as Set
42−import Data.Text (Text)
43−import Network.HTTP.Media (MediaType)
44
42
45−import Data.OpenApi.Declare
43+import Data.Swagger.Declare
46−import Data.OpenApi.Internal
44+import Data.Swagger.Internal
47−import Data.OpenApi.Lens
45+import Data.Swagger.Lens
48−import Data.OpenApi.Schema
46+import Data.Swagger.Schema
49
47
50import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
48import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
51import qualified Data.HashSet.InsOrd as InsOrdHS
49import qualified Data.HashSet.InsOrd as InsOrdHS
@@ -54,18 +52,14 @@ import qualified Data.HashSet.InsOrd as InsOrdHS
54-- >>> import Data.Aeson
52-- >>> import Data.Aeson
55-- >>> import Data.Proxy
53-- >>> import Data.Proxy
56-- >>> import Data.Time
54-- >>> import Data.Time
57−-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
58−-- >>> import Data.OpenApi.Internal.Utils
59
55
60-- | Prepend path piece to all operations of the spec.
56-- | Prepend path piece to all operations of the spec.
61-- Leading and trailing slashes are trimmed/added automatically.
57-- Leading and trailing slashes are trimmed/added automatically.
62--
58--
63−-- >>> let api = (mempty :: OpenApi) & paths .~ [("/info", mempty)]
59+-- >>> let api = (mempty :: Swagger) & paths .~ [("/info", mempty)]
64−-- >>> BSL.putStrLn $ encodePretty $ prependPath "user/{user_id}" api ^. paths
60+-- >>> encode $ prependPath "user/{user_id}" api ^. paths
65−-- {
66−-- "/user/{user_id}/info": {}
61+-- "{\"/user/{user_id}/info\":{}}"
67−-- }
68−prependPath :: FilePath -> OpenApi -> OpenApi
62+prependPath :: FilePath -> Swagger -> Swagger
69prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
63prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
70 where
64 where
71 x </> y = case trim y of
65 x </> y = case trim y of
@@ -75,7 +69,7 @@ prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
75 trim = dropWhile (== '/') . dropWhileEnd (== '/')
69 trim = dropWhile (== '/') . dropWhileEnd (== '/')
76
70
77-- | All operations of a Swagger spec.
71-- | All operations of a Swagger spec.
78−allOperations :: Traversal' OpenApi Operation
72+allOperations :: Traversal' Swagger Operation
79allOperations = paths.traverse.template
73allOperations = paths.traverse.template
80
74
81-- | @'operationsOf' sub@ will traverse only those operations
75-- | @'operationsOf' sub@ will traverse only those operations
@@ -83,66 +77,13 @@ allOperations = paths.traverse.template
83-- by both path and method.
77-- by both path and method.
84--
78--
85-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
79-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
86−-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
80+-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
87−-- >>> let sub = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]
81+-- >>> let sub = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
88−-- >>> BSL.putStrLn $ encodePretty api
82+-- >>> encode api
89−-- {
83+-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"description\":\"OK\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
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"
84+-- >>> encode $ api & operationsOf sub . at 404 ?~ "Not found"
116−-- {
85+-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"404\":{\"description\":\"Not found\"},\"200\":{\"description\":\"OK\"}}},\"post\":{\"responses\":{\"200\":{\"description\":\"OK\"}}}}}}"
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
86+operationsOf :: Swagger -> Traversal' Swagger Operation
146operationsOf sub = paths.itraversed.withIndex.subops
87operationsOf sub = paths.itraversed.withIndex.subops
147 where
88 where
148 -- | Traverse operations that correspond to paths and methods of the sub API.
89 -- | Traverse operations that correspond to paths and methods of the sub API.
@@ -164,12 +105,12 @@ operationsOf sub = paths.itraversed.withIndex.subops
164-- @
105-- @
165-- 'applyTags' = 'applyTagsFor' 'allOperations'
106-- 'applyTags' = 'applyTagsFor' 'allOperations'
166-- @
107-- @
167−applyTags :: [Tag] -> OpenApi -> OpenApi
108+applyTags :: [Tag] -> Swagger -> Swagger
168applyTags = applyTagsFor allOperations
109applyTags = applyTagsFor allOperations
169
110
170-- | Apply tags to a part of Swagger spec and update the global
111-- | Apply tags to a part of Swagger spec and update the global
171-- list of tags.
112-- list of tags.
172−applyTagsFor :: Traversal' OpenApi Operation -> [Tag] -> OpenApi -> OpenApi
113+applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
173applyTagsFor ops ts swag = swag
114applyTagsFor ops ts swag = swag
174 & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))
115 & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))
175 & tags %~ (<> InsOrdHS.fromList ts)
116 & tags %~ (<> InsOrdHS.fromList ts)
@@ -177,32 +118,12 @@ applyTagsFor ops ts swag = swag
177-- | Construct a response with @'Schema'@ while declaring all
118-- | Construct a response with @'Schema'@ while declaring all
178-- necessary schema definitions.
119-- necessary schema definitions.
179--
120--
180−-- FIXME doc
181−--
182−-- >>> BSL.putStrLn $ encodePretty $ runDeclare (declareResponse "application/json" (Proxy :: Proxy Day)) mempty
121+-- >>> encode $ runDeclare (declareResponse (Proxy :: Proxy Day)) mempty
183−-- [
122+-- "[{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}},{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}]"
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
123+declareResponse :: ToSchema a => Proxy a -> Declare (Definitions Schema) Response
203−declareResponse cType proxy = do
124+declareResponse proxy = do
204 s <- declareSchemaRef proxy
125 s <- declareSchemaRef proxy
205− return (mempty & content.at cType ?~ (mempty & schema ?~ s))
126+ return (mempty & schema ?~ s)
206
127
207-- | Set response for all operations.
128-- | Set response for all operations.
208-- This will also update global schema definitions.
129-- This will also update global schema definitions.
@@ -215,46 +136,13 @@ declareResponse cType proxy = do
215--
136--
216-- Example:
137-- Example:
217--
138--
218−-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]
139+-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
219−-- >>> let res = declareResponse "application/json" (Proxy :: Proxy Day)
140+-- >>> let res = declareResponse (Proxy :: Proxy Day)
220−-- >>> BSL.putStrLn $ encodePretty $ api & setResponse 200 res
141+-- >>> encode $ api & setResponse 200 res
221−-- {
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\"}}}"
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−-- }
255--
143--
256-- See also @'setResponseWith'@.
144-- See also @'setResponseWith'@.
257−setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
145+setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
258setResponse = setResponseFor allOperations
146setResponse = setResponseFor allOperations
259
147
260-- | Set or update response for all operations.
148-- | Set or update response for all operations.
@@ -268,7 +156,7 @@ setResponse = setResponseFor allOperations
268-- @
156-- @
269--
157--
270-- See also @'setResponse'@.
158-- 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
272setResponseWith = setResponseForWith allOperations
160setResponseWith = setResponseForWith allOperations
273
161
274-- | Set response for specified operations.
162-- | Set response for specified operations.
@@ -277,9 +165,9 @@ setResponseWith = setResponseForWith allOperations
277-- If the response already exists it will be overwritten.
165-- If the response already exists it will be overwritten.
278--
166--
279-- See also @'setResponseForWith'@.
167-- 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
281setResponseFor ops code dres swag = swag
169setResponseFor ops code dres swag = swag
282− & components.schemas %~ (<> defs)
170+ & definitions %~ (<> defs)
283 & ops . at code ?~ Inline res
171 & ops . at code ?~ Inline res
284 where
172 where
285 (defs, res) = runDeclare dres mempty
173 (defs, res) = runDeclare dres mempty
@@ -291,14 +179,14 @@ setResponseFor ops code dres swag = swag
291-- then just the new response is used.
179-- then just the new response is used.
292--
180--
293-- See also @'setResponseFor'@.
181-- 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
295setResponseForWith ops f code dres swag = swag
183setResponseForWith ops f code dres swag = swag
296− & components.schemas %~ (<> defs)
184+ & definitions %~ (<> defs)
297 & ops . at code %~ Just . Inline . combine
185 & ops . at code %~ Just . Inline . combine
298 where
186 where
299 (defs, new) = runDeclare dres mempty
187 (defs, new) = runDeclare dres mempty
300
188
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
302 Just old -> f old new
190 Just old -> f old new
303 Nothing -> new -- response name can't be dereferenced, replacing with new response
191 Nothing -> new -- response name can't be dereferenced, replacing with new response
304 combine (Just (Inline old)) = f old new
192 combine (Just (Inline old)) = f old new
src/Data/OpenApi/ParamSchema.hs → src/Data/Swagger/ParamSchema.hsrenamed+7−7
@@ -1,10 +1,10 @@
1-- |
1-- |
2−-- Module: Data.OpenApi.ParamSchema
2+-- Module: Data.Swagger.ParamSchema
3-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
3-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
4-- Stability: experimental
4-- Stability: experimental
5--
5--
6-- Types and functions for working with Swagger parameter schema.
6-- Types and functions for working with Swagger parameter schema.
7−module Data.OpenApi.ParamSchema (
7+module Data.Swagger.ParamSchema (
8 -- * Encoding
8 -- * Encoding
9 ToParamSchema(..),
9 ToParamSchema(..),
10
10
@@ -13,14 +13,14 @@ module Data.OpenApi.ParamSchema (
13 toParamSchemaBoundedIntegral,
13 toParamSchemaBoundedIntegral,
14
14
15 -- * Schema templates
15 -- * Schema templates
16− passwordSchema,
16+ passwordParamSchema,
17− binarySchema,
17+ binaryParamSchema,
18− byteSchema,
18+ byteParamSchema,
19
19
20 -- * Generic encoding configuration
20 -- * Generic encoding configuration
21 SchemaOptions(..),
21 SchemaOptions(..),
22 defaultSchemaOptions,
22 defaultSchemaOptions,
23) where
23) where
24
24
25−import Data.OpenApi.Internal.ParamSchema
25+import Data.Swagger.Internal.ParamSchema
26−import Data.OpenApi.SchemaOptions
26+import Data.Swagger.SchemaOptions
src/Data/OpenApi/Schema.hs → src/Data/Swagger/Schema.hsrenamed+13−4
@@ -1,10 +1,10 @@
1-- |
1-- |
2−-- Module: Data.OpenApi.Schema
2+-- Module: Data.Swagger.Schema
3-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
3-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
4-- Stability: experimental
4-- Stability: experimental
5--
5--
6-- Types and functions for working with Swagger schema.
6-- Types and functions for working with Swagger schema.
7−module Data.OpenApi.Schema (
7+module Data.Swagger.Schema (
8 -- * Encoding
8 -- * Encoding
9 ToSchema(..),
9 ToSchema(..),
10 declareSchema,
10 declareSchema,
@@ -32,6 +32,15 @@ module Data.OpenApi.Schema (
32 paramSchemaToNamedSchema,
32 paramSchemaToNamedSchema,
33 paramSchemaToSchema,
33 paramSchemaToSchema,
34
34
35+ -- ** Unrestricted versions
36+ genericDeclareNamedSchemaUnrestricted,
37+ genericDeclareSchemaUnrestricted,
38+
39+ -- * Schema templates
40+ passwordSchema,
41+ binarySchema,
42+ byteSchema,
43+
35 -- * Sketching @'Schema'@s using @'ToJSON'@
44 -- * Sketching @'Schema'@s using @'ToJSON'@
36 sketchSchema,
45 sketchSchema,
37 sketchStrictSchema,
46 sketchStrictSchema,
@@ -48,5 +57,5 @@ module Data.OpenApi.Schema (
48 fromAesonOptions,
57 fromAesonOptions,
49) where
58) where
50
59
51−import Data.OpenApi.Internal.Schema
60+import Data.Swagger.Internal.Schema
52−import Data.OpenApi.SchemaOptions
61+import Data.Swagger.SchemaOptions
src/Data/OpenApi/Schema/Generator.hs → src/Data/Swagger/Schema/Generator.hsrenamed+20−23
@@ -2,7 +2,7 @@
2{-# LANGUAGE OverloadedLists #-}
2{-# LANGUAGE OverloadedLists #-}
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4
4
5−module Data.OpenApi.Schema.Generator where
5+module Data.Swagger.Schema.Generator where
6
6
7import Prelude ()
7import Prelude ()
8import Prelude.Compat
8import Prelude.Compat
@@ -13,27 +13,24 @@ import Data.Aeson
13import Data.Aeson.Types
13import Data.Aeson.Types
14import qualified Data.HashMap.Strict.InsOrd as M
14import qualified Data.HashMap.Strict.InsOrd as M
15import Data.Maybe
15import Data.Maybe
16+import Data.Maybe
16import Data.Proxy
17import Data.Proxy
17import Data.Scientific
18import Data.Scientific
18import qualified Data.Set as S
19import qualified Data.Set as S
19−import Data.OpenApi
20+import Data.Swagger
20−import Data.OpenApi.Declare
21+import Data.Swagger.Declare
21−import Data.OpenApi.Internal.Schema.Validation (inferSchemaTypes)
22+import Data.Swagger.Internal.Schema.Validation (inferSchemaTypes)
22import qualified Data.Text as T
23import qualified Data.Text as T
23import qualified Data.Vector as V
24import qualified Data.Vector as V
24import Test.QuickCheck (arbitrary)
25import Test.QuickCheck (arbitrary)
25import Test.QuickCheck.Gen
26import Test.QuickCheck.Gen
26import Test.QuickCheck.Property
27import Test.QuickCheck.Property
27
28
28−import Data.OpenApi.Aeson.Compat (fromInsOrdHashMap)
29−
30-- | Note: 'schemaGen' may 'error', if schema type is not specified,
29-- | Note: 'schemaGen' may 'error', if schema type is not specified,
31-- and cannot be inferred.
30-- and cannot be inferred.
32schemaGen :: Definitions Schema -> Schema -> Gen Value
31schemaGen :: Definitions Schema -> Schema -> Gen Value
33schemaGen _ schema
32schemaGen _ schema
34− | Just cases <- schema ^. enum_ = elements cases
33+ | Just cases <- schema ^. paramSchema . enum_ = elements cases
35−schemaGen defns schema
36− | Just variants <- schema ^. oneOf = schemaGen defns =<< elements (dereference defns <$> variants)
37schemaGen defns schema =
34schemaGen defns schema =
38 case schema ^. type_ of
35 case schema ^. type_ of
39 Nothing ->
36 Nothing ->
@@ -41,25 +38,25 @@ schemaGen defns schema =
41 [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)
38 [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)
42 -- Gen is not MonadFail
39 -- Gen is not MonadFail
43 _ -> error "unable to infer schema type"
40 _ -> error "unable to infer schema type"
44− Just OpenApiBoolean -> Bool <$> elements [True, False]
41+ Just SwaggerBoolean -> Bool <$> elements [True, False]
45− Just OpenApiNull -> pure Null
42+ Just SwaggerNull -> pure Null
46− Just OpenApiNumber
43+ Just SwaggerNumber
47 | Just min <- schema ^. minimum_
44 | Just min <- schema ^. minimum_
48 , Just max <- schema ^. maximum_ ->
45 , Just max <- schema ^. maximum_ ->
49 Number . fromFloatDigits <$>
46 Number . fromFloatDigits <$>
50 choose (toRealFloat min, toRealFloat max :: Double)
47 choose (toRealFloat min, toRealFloat max :: Double)
51 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)
48 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)
52− Just OpenApiInteger
49+ Just SwaggerInteger
53 | Just min <- schema ^. minimum_
50 | Just min <- schema ^. minimum_
54 , Just max <- schema ^. maximum_ ->
51 , Just max <- schema ^. maximum_ ->
55 Number . fromInteger <$>
52 Number . fromInteger <$>
56 choose (truncate min, truncate max)
53 choose (truncate min, truncate max)
57 | otherwise -> Number . fromInteger <$> arbitrary
54 | otherwise -> Number . fromInteger <$> arbitrary
58− Just OpenApiArray
55+ Just SwaggerArray
59 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
56 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
60 | Just items <- schema ^. items ->
57 | Just items <- schema ^. items ->
61 case items of
58 case items of
62− OpenApiItemsObject ref -> do
59+ SwaggerItemsObject ref -> do
63 size <- getSize
60 size <- getSize
64 let itemSchema = dereference defns ref
61 let itemSchema = dereference defns ref
65 minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems
62 minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems
@@ -67,17 +64,17 @@ schemaGen defns schema =
67 arrayLength <- choose (minLength', max minLength' maxLength')
64 arrayLength <- choose (minLength', max minLength' maxLength')
68 generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema
65 generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema
69 return . Array $ V.fromList generatedArray
66 return . Array $ V.fromList generatedArray
70− OpenApiItemsArray refs ->
67+ SwaggerItemsArray refs ->
71 let itemGens = schemaGen defns . dereference defns <$> refs
68 let itemGens = schemaGen defns . dereference defns <$> refs
72 in fmap (Array . V.fromList) $ sequence itemGens
69 in fmap (Array . V.fromList) $ sequence itemGens
73− Just OpenApiString -> do
70+ Just SwaggerString -> do
74 size <- getSize
71 size <- getSize
75 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
72 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
76 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
73 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
77 length <- choose (minLength', max minLength' maxLength')
74 length <- choose (minLength', max minLength' maxLength')
78 str <- vectorOf length arbitrary
75 str <- vectorOf length arbitrary
79 return . String $ T.pack str
76 return . String $ T.pack str
80− Just OpenApiObject -> do
77+ Just SwaggerObject -> do
81 size <- getSize
78 size <- getSize
82 let props = dereference defns <$> schema ^. properties
79 let props = dereference defns <$> schema ^. properties
83 reqKeys = S.fromList $ schema ^. required
80 reqKeys = S.fromList $ schema ^. required
@@ -97,11 +94,11 @@ schemaGen defns schema =
97 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
94 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
98 _ -> return []
95 _ -> return []
99 x <- sequence $ gens <> additionalGens
96 x <- sequence $ gens <> additionalGens
100− return . Object $ fromInsOrdHashMap x
97+ return . Object $ M.toHashMap x
101−
98+ where
102−dereference :: Definitions a -> Referenced a -> a
99+ dereference :: Definitions a -> Referenced a -> a
103−dereference _ (Inline a) = a
100+ dereference _ (Inline a) = a
104−dereference defs (Ref (Reference ref)) = fromJust $ M.lookup ref defs
101+ dereference defs (Ref (Reference ref)) = fromJust $ M.lookup ref defs
105
102
106genValue :: (ToSchema a) => Proxy a -> Gen Value
103genValue :: (ToSchema a) => Proxy a -> Gen Value
107genValue p =
104genValue p =
src/Data/OpenApi/Schema/Validation.hs → src/Data/Swagger/Schema/Validation.hsrenamed+7−9
@@ -1,10 +1,10 @@
1-- |
1-- |
2−-- Module: Data.OpenApi.Schema.Validation
2+-- Module: Data.Swagger.Schema.Validation
3-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
3-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
4-- Stability: experimental
4-- Stability: experimental
5--
5--
6-- Validate JSON values with Swagger Schema.
6-- Validate JSON values with Swagger Schema.
7−module Data.OpenApi.Schema.Validation (
7+module Data.Swagger.Schema.Validation (
8 -- * How to use validation
8 -- * How to use validation
9 -- $howto
9 -- $howto
10
10
@@ -19,23 +19,21 @@ module Data.OpenApi.Schema.Validation (
19 ValidationError,
19 ValidationError,
20
20
21 -- ** Using 'ToJSON' and 'ToSchema'
21 -- ** Using 'ToJSON' and 'ToSchema'
22− validatePrettyToJSON,
23 validateToJSON,
22 validateToJSON,
24 validateToJSONWithPatternChecker,
23 validateToJSONWithPatternChecker,
25− renderValidationErrors,
26
24
27 -- ** Using 'Value' and 'Schema'
25 -- ** Using 'Value' and 'Schema'
28 validateJSON,
26 validateJSON,
29 validateJSONWithPatternChecker,
27 validateJSONWithPatternChecker,
30) where
28) where
31
29
32−import Data.OpenApi.Internal.Schema.Validation
30+import Data.Swagger.Internal.Schema.Validation
33
31
34-- $setup
32-- $setup
35-- >>> import Control.Lens
33-- >>> import Control.Lens
36-- >>> import Data.Aeson
34-- >>> import Data.Aeson
37-- >>> import Data.Proxy
35-- >>> import Data.Proxy
38−-- >>> import Data.OpenApi
36+-- >>> import Data.Swagger
39-- >>> import GHC.Generics
37-- >>> import GHC.Generics
40-- >>> :set -XDeriveGeneric
38-- >>> :set -XDeriveGeneric
41
39
@@ -71,11 +69,11 @@ import Data.OpenApi.Internal.Schema.Validation
71-- generally fails for @null@ JSON:
69-- generally fails for @null@ JSON:
72--
70--
73-- >>> validateToJSON (Nothing :: Maybe String)
71-- >>> validateToJSON (Nothing :: Maybe String)
74−-- ["expected JSON value of type OpenApiString"]
72+-- ["expected JSON value of type SwaggerString"]
75-- >>> validateToJSON ([Just "hello", Nothing] :: [Maybe String])
73-- >>> validateToJSON ([Just "hello", Nothing] :: [Maybe String])
76−-- ["expected JSON value of type OpenApiString"]
74+-- ["expected JSON value of type SwaggerString"]
77-- >>> validateToJSON (123, Nothing :: Maybe String)
75-- >>> validateToJSON (123, Nothing :: Maybe String)
78−-- ["expected JSON value of type OpenApiString"]
76+-- ["expected JSON value of type SwaggerString"]
79--
77--
80-- However, when @'Maybe' a@ is a type of a record field,
78-- However, when @'Maybe' a@ is a type of a record field,
81-- validation takes @'required'@ property of the @'Schema'@
79-- validation takes @'required'@ property of the @'Schema'@
src/Data/OpenApi/SchemaOptions.hs → src/Data/Swagger/SchemaOptions.hsrenamed+3−7
@@ -1,11 +1,11 @@
1{-# LANGUAGE RecordWildCards #-}
1{-# LANGUAGE RecordWildCards #-}
2-- |
2-- |
3−-- Module: Data.OpenApi.SchemaOptions
3+-- Module: Data.Swagger.SchemaOptions
4-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
4-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
5-- Stability: experimental
5-- Stability: experimental
6--
6--
7-- Generic deriving options for @'ToParamSchema'@ and @'ToSchema'@.
7-- Generic deriving options for @'ToParamSchema'@ and @'ToSchema'@.
8−module Data.OpenApi.SchemaOptions where
8+module Data.Swagger.SchemaOptions where
9
9
10import qualified Data.Aeson.Types as Aeson
10import qualified Data.Aeson.Types as Aeson
11
11
@@ -22,8 +22,6 @@ data SchemaOptions = SchemaOptions
22 , allNullaryToStringTag :: Bool
22 , allNullaryToStringTag :: Bool
23 -- | Hide the field name when a record constructor has only one field, like a newtype.
23 -- | Hide the field name when a record constructor has only one field, like a newtype.
24 , unwrapUnaryRecords :: Bool
24 , unwrapUnaryRecords :: Bool
25− -- | Specifies how to encode constructors of a sum datatype.
26− , sumEncoding :: Aeson.SumEncoding
27 }
25 }
28
26
29-- | Default encoding @'SchemaOptions'@.
27-- | Default encoding @'SchemaOptions'@.
@@ -35,7 +33,6 @@ data SchemaOptions = SchemaOptions
35-- , 'datatypeNameModifier' = id
33-- , 'datatypeNameModifier' = id
36-- , 'allNullaryToStringTag' = True
34-- , 'allNullaryToStringTag' = True
37-- , 'unwrapUnaryRecords' = False
35-- , 'unwrapUnaryRecords' = False
38−-- , 'sumEncoding' = 'Aeson.defaultTaggedObject'
39-- }
36-- }
40-- @
37-- @
41defaultSchemaOptions :: SchemaOptions
38defaultSchemaOptions :: SchemaOptions
@@ -45,7 +42,6 @@ defaultSchemaOptions = SchemaOptions
45 , datatypeNameModifier = id
42 , datatypeNameModifier = id
46 , allNullaryToStringTag = True
43 , allNullaryToStringTag = True
47 , unwrapUnaryRecords = False
44 , unwrapUnaryRecords = False
48− , sumEncoding = Aeson.defaultTaggedObject
49 }
45 }
50
46
51-- | Convert 'Aeson.Options' to 'SchemaOptions'.
47-- | Convert 'Aeson.Options' to 'SchemaOptions'.
@@ -60,6 +56,7 @@ defaultSchemaOptions = SchemaOptions
60-- Note that these fields have no effect on `SchemaOptions`:
56-- Note that these fields have no effect on `SchemaOptions`:
61--
57--
62-- * 'Aeson.omitNothingFields'
58-- * 'Aeson.omitNothingFields'
59+-- * 'Aeson.sumEncoding'
63-- * 'Aeson.tagSingleConstructors'
60-- * 'Aeson.tagSingleConstructors'
64--
61--
65-- The rest is defined as in 'defaultSchemaOptions'.
62-- The rest is defined as in 'defaultSchemaOptions'.
@@ -72,5 +69,4 @@ fromAesonOptions opts = defaultSchemaOptions
72 , constructorTagModifier = Aeson.constructorTagModifier opts
69 , constructorTagModifier = Aeson.constructorTagModifier opts
73 , allNullaryToStringTag = Aeson.allNullaryToStringTag opts
70 , allNullaryToStringTag = Aeson.allNullaryToStringTag opts
74 , unwrapUnaryRecords = Aeson.unwrapUnaryRecords opts
71 , unwrapUnaryRecords = Aeson.unwrapUnaryRecords opts
75− , sumEncoding = Aeson.sumEncoding opts
76 }
72 }
stack.yaml+5−6
@@ -1,9 +1,8 @@
1−resolver: lts-16.31
1+resolver: lts-12.10
2packages:
2packages:
3- '.'
3- '.'
4extra-deps:
4extra-deps:
5−- optics-core-0.3
5+- aeson-1.4.2.0
6−- optics-th-0.3
6+- base-compat-batteries-0.10.4
7−- optics-extra-0.3
7+- contravariant-1.5
8−- indexed-profunctors-0.1
9−- insert-ordered-containers-0.2.3.1
8+- insert-ordered-containers-0.2.2
swagger2.cabalnew file+152
@@ -0,0 +1,152 @@
1+cabal-version: >=1.10
2+name: swagger2
3+version: 2.4
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 ==7.8.4
28+ || ==7.10.3
29+ || ==8.0.2
30+ || ==8.2.2
31+ || ==8.4.4
32+ || ==8.6.5
33+ || ==8.8.1
34+
35+custom-setup
36+ setup-depends:
37+ base, Cabal, cabal-doctest >=1.0.6 && <1.1
38+
39+library
40+ hs-source-dirs: src
41+ include-dirs: include
42+ exposed-modules:
43+ Data.Swagger
44+ Data.Swagger.Declare
45+ Data.Swagger.Lens
46+ Data.Swagger.Operation
47+ Data.Swagger.ParamSchema
48+ Data.Swagger.Schema
49+ Data.Swagger.Schema.Generator
50+ Data.Swagger.Schema.Validation
51+ Data.Swagger.SchemaOptions
52+
53+ -- internal modules
54+ Data.Swagger.Internal
55+ Data.Swagger.Internal.Schema
56+ Data.Swagger.Internal.Schema.Validation
57+ Data.Swagger.Internal.ParamSchema
58+ Data.Swagger.Internal.Utils
59+ Data.Swagger.Internal.AesonUtils
60+ Data.Swagger.Internal.TypeShape
61+
62+ -- GHC boot libraries
63+ build-depends:
64+ base >=4.7 && <4.13
65+ , bytestring >=0.10.4.0 && <0.11
66+ , containers >=0.5.5.1 && <0.7
67+ , template-haskell >=2.9.0.0 && <2.15
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.11
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.2 && <0.3
85+ , lens >=4.16.1 && <4.18
86+ , network >=2.6.3.5 && <3.2
87+ , scientific >=0.3.6.2 && <0.4
88+ , transformers-compat >=0.3 && <0.7
89+ , unordered-containers >=0.2.9.0 && <0.3
90+ , uuid-types >=1.0.3 && <1.1
91+ , vector >=0.12.0.1 && <0.13
92+ , QuickCheck >=2.10.1 && <2.14
93+
94+ default-language: Haskell2010
95+
96+test-suite spec
97+ type: exitcode-stdio-1.0
98+ hs-source-dirs: test
99+ main-is: Spec.hs
100+
101+ -- From library parat
102+ -- We need aeson's toEncoding for doctests too
103+ build-depends:
104+ base
105+ , swagger2
106+ , aeson
107+ , base-compat-batteries
108+ , bytestring
109+ , containers
110+ , hashable
111+ , insert-ordered-containers
112+ , lens
113+ , mtl
114+ , template-haskell
115+ , text
116+ , time
117+ , unordered-containers
118+ , vector
119+ , QuickCheck
120+
121+ -- test-suite only dependencies
122+ build-depends:
123+ hspec >=2.5.5 && <2.8
124+ , HUnit >=1.6.0.0 && <1.7
125+ , quickcheck-instances >=0.3.19 && <0.14
126+ , utf8-string >=1.0.1.1 && <1.1
127+
128+ -- https://github.com/haskell/cabal/issues/3708
129+ build-tool-depends:
130+ hspec-discover:hspec-discover >=2.5.5 && <2.8
131+
132+ other-modules:
133+ SpecCommon
134+ Data.SwaggerSpec
135+ Data.Swagger.CommonTestTypes
136+ Data.Swagger.ParamSchemaSpec
137+ Data.Swagger.SchemaSpec
138+ Data.Swagger.Schema.ValidationSpec
139+ Data.Swagger.Schema.GeneratorSpec
140+ default-language: Haskell2010
141+
142+test-suite doctests
143+ -- See QuickCheck note in https://github.com/phadej/cabal-doctest#notes
144+ build-depends: base, doctest, Glob, QuickCheck
145+ default-language: Haskell2010
146+ hs-source-dirs: test
147+ main-is: doctests.hs
148+ type: exitcode-stdio-1.0
149+
150+source-repository head
151+ type: git
152+ 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+102−492
@@ -2,7 +2,7 @@
2{-# LANGUAGE QuasiQuotes #-}
2{-# LANGUAGE QuasiQuotes #-}
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4
4
5−module Data.OpenApi.CommonTestTypes where
5+module Data.Swagger.CommonTestTypes where
6
6
7import Prelude ()
7import Prelude ()
8import Prelude.Compat
8import Prelude.Compat
@@ -15,10 +15,11 @@ import Data.Map (Map)
15import Data.Proxy
15import Data.Proxy
16import Data.Set (Set)
16import Data.Set (Set)
17import qualified Data.Text as Text
17import qualified Data.Text as Text
18−import Data.Word
19import GHC.Generics
18import GHC.Generics
20
19
21−import Data.OpenApi
20+import Data.Swagger
21+import Data.Swagger.Declare
22+import Data.Swagger.Internal (SwaggerKind (..))
22
23
23-- ========================================================================
24-- ========================================================================
24-- Unit type
25-- Unit type
@@ -88,7 +89,7 @@ paintSchemaJSON = [aesonQQ|
88 {
89 {
89 "color":
90 "color":
90 {
91 {
91− "$ref": "#/components/schemas/Color"
92+ "$ref": "#/definitions/Color"
92 }
93 }
93 },
94 },
94 "required": ["color"]
95 "required": ["color"]
@@ -181,7 +182,7 @@ userGroupSchemaJSON :: Value
181userGroupSchemaJSON = [aesonQQ|
182userGroupSchemaJSON = [aesonQQ|
182{
183{
183 "type": "array",
184 "type": "array",
184− "items": { "$ref": "#/components/schemas/UserId" },
185+ "items": { "$ref": "#/definitions/UserId" },
185 "uniqueItems": true
186 "uniqueItems": true
186}
187}
187|]
188|]
@@ -228,7 +229,7 @@ playerSchemaJSON = [aesonQQ|
228 {
229 {
229 "position":
230 "position":
230 {
231 {
231− "$ref": "#/components/schemas/Point"
232+ "$ref": "#/definitions/Point"
232 }
233 }
233 },
234 },
234 "required": ["position"]
235 "required": ["position"]
@@ -250,7 +251,7 @@ playersSchemaJSON = [aesonQQ|
250 {
251 {
251 "position":
252 "position":
252 {
253 {
253− "$ref": "#/components/schemas/Point"
254+ "$ref": "#/definitions/Point"
254 }
255 }
255 },
256 },
256 "required": ["position"]
257 "required": ["position"]
@@ -271,192 +272,106 @@ instance ToSchema Character
271characterSchemaJSON :: Value
272characterSchemaJSON :: Value
272characterSchemaJSON = [aesonQQ|
273characterSchemaJSON = [aesonQQ|
273{
274{
274− "oneOf": [
275+ "type": "object",
276+ "properties":
275 {
277 {
276− "required": [
278+ "PC": { "$ref": "#/definitions/Player" },
277− "tag",
279+ "NPC":
278− "contents"
280+ {
279− ],
280− "type": "object",
281+ "type": "object",
281− "properties": {
282+ "properties":
282− "tag": {
283+ {
283− "type": "string",
284+ "npcName": { "type": "string" },
284− "enum": [
285+ "npcPosition": { "$ref": "#/definitions/Point" }
285− "PC"
286− ]
287− },
286+ },
288− "contents": {
287+ "required": ["npcName", "npcPosition"]
289− "$ref": "#/components/schemas/Player"
290 }
288 }
291− }
292 },
289 },
293− {
290+ "maxProperties": 1,
294− "required": [
291+ "minProperties": 1
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"
317}
292}
318−
319|]
293|]
320
294
321characterInlinedSchemaJSON :: Value
295characterInlinedSchemaJSON :: Value
322characterInlinedSchemaJSON = [aesonQQ|
296characterInlinedSchemaJSON = [aesonQQ|
323{
297{
324− "oneOf": [
298+ "type": "object",
299+ "properties":
325 {
300 {
326− "required": [
327− "tag",
328− "contents"
329− ],
330− "type": "object",
331− "properties": {
332− "tag": {
333− "type": "string",
334− "enum": [
335− "PC"
301+ "PC":
336− ]
302+ {
337− },
338− "contents": {
339− "required": [
340− "position"
341− ],
342 "type": "object",
303 "type": "object",
343− "properties": {
304+ "properties":
305+ {
344− "position": {
306+ "position":
307+ {
308+ "type": "object",
309+ "properties":
310+ {
311+ "x": { "type": "number", "format": "double" },
312+ "y": { "type": "number", "format": "double" }
313+ },
345− "required": [
314+ "required": ["x", "y"]
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"
358 }
315 }
359− }
360− }
316+ },
361− }
362− }
363− }
364− },
365− {
366− "required": [
317+ "required": ["position"]
367− "npcName",
368− "npcPosition",
369− "tag"
370− ],
371− "type": "object",
372− "properties": {
373− "tag": {
374− "type": "string",
375− "enum": [
376− "NPC"
377− ]
378 },
318 },
379− "npcPosition": {
319+ "NPC":
380− "required": [
320+ {
381− "x",
382− "y"
383− ],
384 "type": "object",
321 "type": "object",
385− "properties": {
322+ "properties":
386− "x": {
323+ {
324+ "npcName": { "type": "string" },
325+ "npcPosition":
326+ {
327+ "type": "object",
328+ "properties":
329+ {
387− "format": "double",
330+ "x": { "type": "number", "format": "double" },
388− "type": "number"
331+ "y": { "type": "number", "format": "double" }
332+ },
333+ "required": ["x", "y"]
334+ }
389 },
335 },
390− "y": {
391− "format": "double",
392− "type": "number"
393− }
394− }
395− },
396− "npcName": {
336+ "required": ["npcName", "npcPosition"]
397− "type": "string"
398 }
337 }
399− }
400− }
338+ },
401− ],
339+ "maxProperties": 1,
402− "type": "object"
340+ "minProperties": 1
403}
341}
404|]
342|]
405
343
406characterInlinedPlayerSchemaJSON :: Value
344characterInlinedPlayerSchemaJSON :: Value
407characterInlinedPlayerSchemaJSON = [aesonQQ|
345characterInlinedPlayerSchemaJSON = [aesonQQ|
408{
346{
409− "oneOf": [
347+ "type": "object",
348+ "properties":
410 {
349 {
411− "required": [
350+ "PC":
412− "tag",
351+ {
413− "contents"
414− ],
415− "type": "object",
352+ "type": "object",
416− "properties": {
353+ "properties":
417− "tag": {
354+ {
418− "type": "string",
355+ "position":
419− "enum": [
356+ {
420− "PC"
357+ "$ref": "#/definitions/Point"
421− ]
358+ }
359+ },
360+ "required": ["position"]
422 },
361 },
423− "contents": {
362+ "NPC":
424− "required": [
363+ {
425− "position"
426− ],
427 "type": "object",
364 "type": "object",
428− "properties": {
365+ "properties":
429− "position": {
366+ {
430− "$ref": "#/components/schemas/Point"
367+ "npcName": { "type": "string" },
368+ "npcPosition": { "$ref": "#/definitions/Point" }
431− }
369+ },
432− }
370+ "required": ["npcName", "npcPosition"]
433 }
371 }
434− }
435 },
372 },
436− {
373+ "maxProperties": 1,
437− "required": [
374+ "minProperties": 1
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"
460}
375}
461|]
376|]
462
377
@@ -568,7 +483,7 @@ myRoseTreeSchemaJSON = [aesonQQ|
568 "type": "array",
483 "type": "array",
569 "items":
484 "items":
570 {
485 {
571− "$ref": "#/components/schemas/RoseTree"
486+ "$ref": "#/definitions/RoseTree"
572 }
487 }
573 }
488 }
574 },
489 },
@@ -597,7 +512,7 @@ myRoseTreeSchemaJSON' = [aesonQQ|
597 "type": "array",
512 "type": "array",
598 "items":
513 "items":
599 {
514 {
600− "$ref": "#/components/schemas/myrosetree'"
515+ "$ref": "#/definitions/myrosetree'"
601 }
516 }
602 }
517 }
603 },
518 },
@@ -628,169 +543,42 @@ data Light
628 deriving (Generic)
543 deriving (Generic)
629
544
630instance ToSchema Light where
545instance ToSchema Light where
631− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
546+ declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
632 { unwrapUnaryRecords = True }
547 { unwrapUnaryRecords = True }
633
548
634lightSchemaJSON :: Value
549lightSchemaJSON :: Value
635lightSchemaJSON = [aesonQQ|
550lightSchemaJSON = [aesonQQ|
636{
551{
637− "oneOf": [
638− {
639− "required": [
640− "tag"
641− ],
642− "type": "object",
552+ "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": {
553+ "properties":
659− "tag": {
660− "type": "string",
661− "enum": [
662− "LightFreq"
663− ]
664− },
665− "contents": {
666− "format": "double",
667− "type": "number"
668− }
669− }
670− },
671 {
554 {
672− "required": [
555+ "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },
673− "tag",
556+ "LightFreq": { "type": "number", "format": "double" },
674− "contents"
675− ],
676− "type": "object",
677− "properties": {
678− "tag": {
679− "type": "string",
680− "enum": [
681− "LightColor"
557+ "LightColor": { "$ref": "#/definitions/Color" },
682− ]
558+ "LightWaveLength": { "type": "number", "format": "double" }
683− },
684− "contents": {
685− "$ref": "#/components/schemas/Color"
686− }
687− }
688 },
559 },
689− {
560+ "maxProperties": 1,
690− "required": [
561+ "minProperties": 1
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"
710}
562}
711|]
563|]
712
564
713lightInlinedSchemaJSON :: Value
565lightInlinedSchemaJSON :: Value
714lightInlinedSchemaJSON = [aesonQQ|
566lightInlinedSchemaJSON = [aesonQQ|
715{
567{
716− "oneOf": [
717− {
718− "required": [
719− "tag"
720− ],
721− "type": "object",
568+ "type": "object",
722− "properties": {
569+ "properties":
723− "tag": {
724− "type": "string",
725− "enum": [
726− "NoLight"
727− ]
728− }
729− }
730− },
731 {
570 {
732− "required": [
571+ "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },
733− "tag",
572+ "LightFreq": { "type": "number", "format": "double" },
734− "contents"
573+ "LightColor":
735− ],
574+ {
736− "type": "object",
737− "properties": {
738− "tag": {
739 "type": "string",
575 "type": "string",
740− "enum": [
576+ "enum": ["Red", "Green", "Blue"]
741− "LightFreq"
742− ]
743 },
577 },
744− "contents": {
745− "format": "double",
746− "type": "number"
578+ "LightWaveLength": { "type": "number", "format": "double" }
747− }
748− }
749 },
579 },
750− {
580+ "maxProperties": 1,
751− "required": [
581+ "minProperties": 1
752− "tag",
753− "contents"
754− ],
755− "type": "object",
756− "properties": {
757− "tag": {
758− "type": "string",
759− "enum": [
760− "LightColor"
761− ]
762− },
763− "contents": {
764− "type": "string",
765− "enum": [
766− "Red",
767− "Green",
768− "Blue"
769− ]
770− }
771− }
772− },
773− {
774− "required": [
775− "waveLength",
776− "tag"
777− ],
778− "type": "object",
779− "properties": {
780− "tag": {
781− "type": "string",
782− "enum": [
783− "LightWaveLength"
784− ]
785− },
786− "waveLength": {
787− "format": "double",
788− "type": "number"
789− }
790− }
791− }
792− ],
793− "type": "object"
794}
582}
795|]
583|]
796
584
@@ -862,181 +650,3 @@ singleMaybeFieldSchemaJSON = [aesonQQ|
862 }
650 }
863}
651}
864|]
652|]
865−
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−|]
989−
990−-- ========================================================================
991−-- TimeOfDay
992−-- ========================================================================
993−data TimeOfDay
994− = Int
995− | Pico
996− deriving (Generic)
997−instance ToSchema TimeOfDay
998−instance ToParamSchema TimeOfDay
999−
1000−
1001−timeOfDaySchemaJSON :: Value
1002−timeOfDaySchemaJSON = [aesonQQ|
1003−{
1004− "example": "12:33:15",
1005− "type": "string",
1006− "format": "hh:MM:ss"
1007−}
1008−|]
1009−
1010−timeOfDayParamSchemaJSON :: Value
1011−timeOfDayParamSchemaJSON = [aesonQQ|
1012−{
1013− "type": "string",
1014− "format": "hh:MM:ss"
1015−}
1016−|]
1017−
1018−
1019−-- ========================================================================
1020−-- UnsignedInts
1021−-- ========================================================================
1022−data UnsignedInts = UnsignedInts
1023− { unsignedIntsUint32 :: Word32
1024− , unsignedIntsUint64 :: Word64
1025− } deriving (Generic)
1026−
1027−instance ToSchema UnsignedInts where
1028− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
1029− { fieldLabelModifier = map toLower . drop (length "unsignedInts") }
1030−
1031−unsignedIntsSchemaJSON :: Value
1032−unsignedIntsSchemaJSON = [aesonQQ|
1033−{
1034− "type": "object",
1035− "properties":
1036− {
1037− "uint32": { "type": "integer", "format": "int32", "minimum": 0, "maximum": 4294967295 },
1038− "uint64": { "type": "integer", "format": "int64", "minimum": 0, "maximum": 18446744073709551615 }
1039− },
1040− "required": ["uint32", "uint64"]
1041−}
1042−|]
test/Data/OpenApi/ParamSchemaSpec.hs → test/Data/Swagger/ParamSchemaSpec.hsrenamed+6−10
@@ -3,26 +3,23 @@
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE TemplateHaskell #-}
4{-# LANGUAGE TemplateHaskell #-}
5{-# LANGUAGE QuasiQuotes #-}
5{-# LANGUAGE QuasiQuotes #-}
6−{-# LANGUAGE OverloadedStrings #-}
7−module Data.OpenApi.ParamSchemaSpec where
6+module Data.Swagger.ParamSchemaSpec where
8
7
9−import Data.Aeson
8+import Data.Aeson (Value)
10import Data.Aeson.QQ.Simple
9import Data.Aeson.QQ.Simple
11import Data.Char
10import Data.Char
12import Data.Proxy
11import Data.Proxy
13import GHC.Generics
12import GHC.Generics
14
13
15−import Data.OpenApi
14+import Data.Swagger
15+import Data.Swagger.Internal (SwaggerKind(..))
16
16
17−import Data.OpenApi.CommonTestTypes
17+import Data.Swagger.CommonTestTypes
18import SpecCommon
18import SpecCommon
19import Test.Hspec
19import Test.Hspec
20−import Data.Time.LocalTime
21−
22−import qualified Data.HashMap.Strict as HM
23
20
24checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec
21checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec
25−checkToParamSchema proxy js = (toParamSchema proxy :: Schema) <=> js
22+checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js
26
23
27spec :: Spec
24spec :: Spec
28spec = do
25spec = do
@@ -33,7 +30,6 @@ spec = do
33 context "Unary records" $ do
30 context "Unary records" $ do
34 context "Email (unary record)" $ checkToParamSchema (Proxy :: Proxy Email) emailSchemaJSON
31 context "Email (unary record)" $ checkToParamSchema (Proxy :: Proxy Email) emailSchemaJSON
35 context "UserId (non-record newtype)" $ checkToParamSchema (Proxy :: Proxy UserId) userIdSchemaJSON
32 context "UserId (non-record newtype)" $ checkToParamSchema (Proxy :: Proxy UserId) userIdSchemaJSON
36− context "TimeOfDay" $ checkToParamSchema (Proxy :: Proxy Data.Time.LocalTime.TimeOfDay) timeOfDayParamSchemaJSON
37
33
38main :: IO ()
34main :: IO ()
39main = hspec spec
35main = hspec spec
test/Data/OpenApi/Schema/GeneratorSpec.hs → test/Data/Swagger/Schema/GeneratorSpec.hsrenamed+7−7
@@ -1,13 +1,13 @@
1{-# LANGUAGE OverloadedLists #-}
1{-# LANGUAGE OverloadedLists #-}
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE PackageImports #-}
3{-# LANGUAGE PackageImports #-}
4−module Data.OpenApi.Schema.GeneratorSpec where
4+module Data.Swagger.Schema.GeneratorSpec where
5
5
6import Prelude ()
6import Prelude ()
7import Prelude.Compat
7import Prelude.Compat
8
8
9−import Data.OpenApi
9+import Data.Swagger
10−import Data.OpenApi.Schema.Generator
10+import Data.Swagger.Schema.Generator
11
11
12import Control.Lens.Operators
12import Control.Lens.Operators
13import Data.Aeson
13import Data.Aeson
@@ -103,7 +103,7 @@ instance FromJSON WrongType where
103instance ToSchema WrongType where
103instance ToSchema WrongType where
104 declareNamedSchema _ = return . NamedSchema (Just "WrongType") $
104 declareNamedSchema _ = return . NamedSchema (Just "WrongType") $
105 mempty
105 mempty
106− & type_ ?~ OpenApiObject
106+ & type_ ?~ SwaggerObject
107
107
108
108
109data MissingRequired = MissingRequired
109data MissingRequired = MissingRequired
@@ -123,7 +123,7 @@ instance ToSchema MissingRequired where
123 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)
123 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)
124 return . NamedSchema (Just "MissingRequired") $
124 return . NamedSchema (Just "MissingRequired") $
125 mempty
125 mempty
126− & type_ ?~ OpenApiObject
126+ & type_ ?~ SwaggerObject
127 & properties .~ [("propA", stringSchema)
127 & properties .~ [("propA", stringSchema)
128 ,("propB", boolSchema)
128 ,("propB", boolSchema)
129 ]
129 ]
@@ -145,7 +145,7 @@ instance ToSchema MissingProperty where
145 stringSchema <- declareSchemaRef (Proxy :: Proxy String)
145 stringSchema <- declareSchemaRef (Proxy :: Proxy String)
146 return . NamedSchema (Just "MissingProperty") $
146 return . NamedSchema (Just "MissingProperty") $
147 mempty
147 mempty
148− & type_ ?~ OpenApiObject
148+ & type_ ?~ SwaggerObject
149 & properties .~ [("propC", stringSchema)]
149 & properties .~ [("propC", stringSchema)]
150 & required .~ ["propC"]
150 & required .~ ["propC"]
151
151
@@ -163,6 +163,6 @@ instance ToSchema WrongPropType where
163 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)
163 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)
164 return . NamedSchema (Just "WrongPropType") $
164 return . NamedSchema (Just "WrongPropType") $
165 mempty
165 mempty
166− & type_ ?~ OpenApiObject
166+ & type_ ?~ SwaggerObject
167 & properties .~ [("propE", boolSchema)]
167 & properties .~ [("propE", boolSchema)]
168 & required .~ ["propE"]
168 & required .~ ["propE"]
test/Data/OpenApi/Schema/ValidationSpec.hs → test/Data/Swagger/Schema/ValidationSpec.hsrenamed+9−55
@@ -4,15 +4,11 @@
4{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE RecordWildCards #-}
5{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
7−module Data.OpenApi.Schema.ValidationSpec where
7+module Data.Swagger.Schema.ValidationSpec where
8
8
9import Control.Applicative
9import Control.Applicative
10import Control.Lens ((&), (.~), (?~))
10import Control.Lens ((&), (.~), (?~))
11import Data.Aeson
11import 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
16import Data.Aeson.Types
12import Data.Aeson.Types
17import Data.Hashable (Hashable)
13import Data.Hashable (Hashable)
18import Data.HashMap.Strict (HashMap)
14import Data.HashMap.Strict (HashMap)
@@ -33,9 +29,8 @@ import Data.Version (Version)
33import Data.Word
29import Data.Word
34import GHC.Generics
30import GHC.Generics
35
31
36−import Data.OpenApi
32+import Data.Swagger
37−import Data.OpenApi.Declare
33+import Data.Swagger.Declare
38−import Data.OpenApi.Aeson.Compat (stringToKey)
39
34
40import Test.Hspec
35import Test.Hspec
41import Test.Hspec.QuickCheck
36import Test.Hspec.QuickCheck
@@ -97,8 +92,6 @@ spec = do
97 prop "Paint" $ shouldValidate (Proxy :: Proxy Paint)
92 prop "Paint" $ shouldValidate (Proxy :: Proxy Paint)
98 prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
93 prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
99 prop "Light" $ shouldValidate (Proxy :: Proxy Light)
94 prop "Light" $ shouldValidate (Proxy :: Proxy Light)
100− prop "Light TaggedObject" $ shouldValidate (Proxy :: Proxy LightTaggedObject)
101− prop "Light UntaggedValue" $ shouldValidate (Proxy :: Proxy LightUntaggedValue)
102 prop "ButtonImages" $ shouldValidate (Proxy :: Proxy ButtonImages)
95 prop "ButtonImages" $ shouldValidate (Proxy :: Proxy ButtonImages)
103 prop "Version" $ shouldValidate (Proxy :: Proxy Version)
96 prop "Version" $ shouldValidate (Proxy :: Proxy Version)
104 prop "FreeForm" $ shouldValidate (Proxy :: Proxy FreeForm)
97 prop "FreeForm" $ shouldValidate (Proxy :: Proxy FreeForm)
@@ -130,9 +123,9 @@ instance Arbitrary Person where
130
123
131invalidPersonToJSON :: Person -> Value
124invalidPersonToJSON :: Person -> Value
132invalidPersonToJSON Person{..} = object
125invalidPersonToJSON Person{..} = object
133− [ stringToKey "personName" .= toJSON name
126+ [ T.pack "personName" .= toJSON name
134− , stringToKey "personPhone" .= toJSON phone
127+ , T.pack "personPhone" .= toJSON phone
135− , stringToKey "personEmail" .= toJSON email
128+ , T.pack "personEmail" .= toJSON email
136 ]
129 ]
137
130
138-- ========================================================================
131-- ========================================================================
@@ -196,10 +189,10 @@ instance Arbitrary MyRoseTree where
196data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic)
189data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic)
197
190
198instance ToSchema Light where
191instance ToSchema Light where
199− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = ObjectWithSingleField }
192+ declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
200
193
201instance ToJSON Light where
194instance ToJSON Light where
202− toJSON = genericToJSON defaultOptions { Data.Aeson.Types.sumEncoding = ObjectWithSingleField }
195+ toJSON = genericToJSON defaultOptions { sumEncoding = ObjectWithSingleField }
203
196
204instance Arbitrary Light where
197instance Arbitrary Light where
205 arbitrary = oneof
198 arbitrary = oneof
@@ -211,34 +204,6 @@ instance Arbitrary Light where
211invalidLightToJSON :: Light -> Value
204invalidLightToJSON :: Light -> Value
212invalidLightToJSON = genericToJSON defaultOptions
205invalidLightToJSON = genericToJSON defaultOptions
213
206
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−
242-- ========================================================================
207-- ========================================================================
243-- ButtonImages (bounded enum key mapping)
208-- ButtonImages (bounded enum key mapping)
244-- ========================================================================
209-- ========================================================================
@@ -283,7 +248,7 @@ instance ToJSON FreeForm where
283
248
284instance ToSchema FreeForm where
249instance ToSchema FreeForm where
285 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
250 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
286− & type_ ?~ OpenApiObject
251+ & type_ ?~ SwaggerObject
287 & additionalProperties ?~ AdditionalPropertiesAllowed True
252 & additionalProperties ?~ AdditionalPropertiesAllowed True
288
253
289instance Arbitrary FreeForm where
254instance Arbitrary FreeForm where
@@ -301,8 +266,6 @@ instance Eq ZonedTime where
301-- Arbitrary instance for Data.Aeson.Value
266-- Arbitrary instance for Data.Aeson.Value
302-- ========================================================================
267-- ========================================================================
303
268
304−-- These instances were introduces in aeson upstream in 2.0.3
305−#if !MIN_VERSION_aeson(2,0,3)
306instance Arbitrary Value where
269instance Arbitrary Value where
307 -- Weights are almost random
270 -- Weights are almost random
308 -- Uniform oneof tends not to build complex objects cause of recursive call.
271 -- Uniform oneof tends not to build complex objects cause of recursive call.
@@ -313,12 +276,3 @@ instance Arbitrary Value where
313 , (3, Number <$> arbitrary)
276 , (3, Number <$> arbitrary)
314 , (3, Bool <$> arbitrary)
277 , (3, Bool <$> arbitrary)
315 , (1, return Null) ]
278 , (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+17−21
@@ -2,66 +2,65 @@
2{-# LANGUAGE ScopedTypeVariables #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE TemplateHaskell #-}
4{-# LANGUAGE QuasiQuotes #-}
4{-# LANGUAGE QuasiQuotes #-}
5−module Data.OpenApi.SchemaSpec where
5+module Data.Swagger.SchemaSpec where
6
6
7import Prelude ()
7import Prelude ()
8import Prelude.Compat
8import Prelude.Compat
9
9
10import Control.Lens ((^.))
10import Control.Lens ((^.))
11−import Data.Aeson (Value)
11+import Data.Aeson (Value, ToJSON(..), ToJSONKey(..))
12+import Data.Aeson.Types (toJSONKeyText)
13+import Data.Aeson.QQ.Simple
14+import Data.Char
12import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
15import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
13import Data.Proxy
16import Data.Proxy
14import Data.Set (Set)
17import Data.Set (Set)
18+import Data.Map (Map)
15import qualified Data.Text as Text
19import qualified Data.Text as Text
20+import GHC.Generics
16
21
17−import Data.OpenApi
22+import Data.Swagger
18−import Data.OpenApi.Declare
23+import Data.Swagger.Declare
19
24
20−import Data.OpenApi.CommonTestTypes
25+import Data.Swagger.CommonTestTypes
21import SpecCommon
26import SpecCommon
22import Test.Hspec
27import Test.Hspec
23
28
24−import qualified Data.HashMap.Strict as HM
25−import Data.Time.LocalTime
26−
27−checkToSchema :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
29+checkToSchema :: ToSchema a => Proxy a -> Value -> Spec
28checkToSchema proxy js = toSchema proxy <=> js
30checkToSchema proxy js = toSchema proxy <=> js
29
31
30−checkSchemaName :: (HasCallStack, ToSchema a) => Maybe String -> Proxy a -> Spec
32+checkSchemaName :: ToSchema a => Maybe String -> Proxy a -> Spec
31checkSchemaName sname proxy =
33checkSchemaName sname proxy =
32 it ("schema name is " ++ show sname) $
34 it ("schema name is " ++ show sname) $
33 schemaName proxy `shouldBe` fmap Text.pack sname
35 schemaName proxy `shouldBe` fmap Text.pack sname
34
36
35−checkDefs :: (HasCallStack, ToSchema a) => Proxy a -> [String] -> Spec
37+checkDefs :: ToSchema a => Proxy a -> [String] -> Spec
36checkDefs proxy names =
38checkDefs proxy names =
37 it ("uses these definitions " ++ show names) $
39 it ("uses these definitions " ++ show names) $
38 InsOrdHashMap.keys defs `shouldBe` map Text.pack names
40 InsOrdHashMap.keys defs `shouldBe` map Text.pack names
39 where
41 where
40 defs = execDeclare (declareNamedSchema proxy) mempty
42 defs = execDeclare (declareNamedSchema proxy) mempty
41
43
42−checkProperties :: (HasCallStack, ToSchema a) => Proxy a -> [String] -> Spec
44+checkProperties :: ToSchema a => Proxy a -> [String] -> Spec
43checkProperties proxy names =
45checkProperties proxy names =
44 it ("has these fields in order " ++ show names) $
46 it ("has these fields in order " ++ show names) $
45 InsOrdHashMap.keys fields `shouldBe` map Text.pack names
47 InsOrdHashMap.keys fields `shouldBe` map Text.pack names
46 where
48 where
47 fields = toSchema proxy ^. properties
49 fields = toSchema proxy ^. properties
48
50
49−checkInlinedSchema :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
51+checkInlinedSchema :: ToSchema a => Proxy a -> Value -> Spec
50checkInlinedSchema proxy js = toInlinedSchema proxy <=> js
52checkInlinedSchema proxy js = toInlinedSchema proxy <=> js
51
53
52−checkInlinedSchemas :: (HasCallStack, ToSchema a) => [String] -> Proxy a -> Value -> Spec
54+checkInlinedSchemas :: ToSchema a => [String] -> Proxy a -> Value -> Spec
53checkInlinedSchemas names proxy js = inlineSchemas (map Text.pack names) defs s <=> js
55checkInlinedSchemas names proxy js = inlineSchemas (map Text.pack names) defs s <=> js
54 where
56 where
55 (defs, s) = runDeclare (declareSchema proxy) mempty
57 (defs, s) = runDeclare (declareSchema proxy) mempty
56
58
57−checkInlinedRecSchema :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
59+checkInlinedRecSchema :: ToSchema a => Proxy a -> Value -> Spec
58checkInlinedRecSchema proxy js = inlineNonRecursiveSchemas defs s <=> js
60checkInlinedRecSchema proxy js = inlineNonRecursiveSchemas defs s <=> js
59 where
61 where
60 (defs, s) = runDeclare (declareSchema proxy) mempty
62 (defs, s) = runDeclare (declareSchema proxy) mempty
61
63
62−checkToSchemaDeclare :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
63−checkToSchemaDeclare proxy js = runDeclare (declareSchemaRef proxy) mempty <=> js
64−
65spec :: Spec
64spec :: Spec
66spec = do
65spec = do
67 describe "Generic ToSchema" $ do
66 describe "Generic ToSchema" $ do
@@ -81,7 +80,6 @@ spec = do
81 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON
80 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON
82 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON
81 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON
83 context "SingleMaybeField (unary record with Maybe)" $ checkToSchema (Proxy :: Proxy SingleMaybeField) singleMaybeFieldSchemaJSON
82 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
85 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON
83 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON
86 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
84 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
87 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
85 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
@@ -89,7 +87,6 @@ spec = do
89 context "Status (sum of unary constructors)" $ checkToSchema (Proxy :: Proxy Status) statusSchemaJSON
87 context "Status (sum of unary constructors)" $ checkToSchema (Proxy :: Proxy Status) statusSchemaJSON
90 context "Character (ref and record sum)" $ checkToSchema (Proxy :: Proxy Character) characterSchemaJSON
88 context "Character (ref and record sum)" $ checkToSchema (Proxy :: Proxy Character) characterSchemaJSON
91 context "Light (sum with unwrapUnaryRecords)" $ checkToSchema (Proxy :: Proxy Light) lightSchemaJSON
89 context "Light (sum with unwrapUnaryRecords)" $ checkToSchema (Proxy :: Proxy Light) lightSchemaJSON
92− context "UnsignedInts" $ checkToSchema (Proxy :: Proxy UnsignedInts) unsignedIntsSchemaJSON
93 context "Schema name" $ do
90 context "Schema name" $ do
94 context "String" $ checkSchemaName Nothing (Proxy :: Proxy String)
91 context "String" $ checkSchemaName Nothing (Proxy :: Proxy String)
95 context "(Int, Float)" $ checkSchemaName Nothing (Proxy :: Proxy (Int, Float))
92 context "(Int, Float)" $ checkSchemaName Nothing (Proxy :: Proxy (Int, Float))
@@ -113,7 +110,6 @@ spec = do
113 context "MyRoseTree' (inlineNonRecursiveSchemas)" $ checkInlinedRecSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
110 context "MyRoseTree' (inlineNonRecursiveSchemas)" $ checkInlinedRecSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
114 describe "Bounded Enum key mapping" $ do
111 describe "Bounded Enum key mapping" $ do
115 context "ButtonImages" $ checkToSchema (Proxy :: Proxy ButtonImages) buttonImagesSchemaJSON
112 context "ButtonImages" $ checkToSchema (Proxy :: Proxy ButtonImages) buttonImagesSchemaJSON
116− context "TimeOfDay" $ checkToSchema (Proxy :: Proxy Data.Time.LocalTime.TimeOfDay) timeOfDaySchemaJSON
117
113
118main :: IO ()
114main :: IO ()
119main = hspec spec
115main = hspec spec
test/Data/SwaggerSpec.hsnew file+1661
@@ -0,0 +1,1661 @@
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 "Composition Schema Example" $ compositionSchemaExample <=> compositionSchemaExampleJSON
47+ describe "Swagger Object" $ do
48+ context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
49+ context "PetStore Example" $
50+ it "decodes successfully" $ do
51+ fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: Swagger) -> True; _ -> False)
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+ & consumes ?~ MimeList ["application/x-www-form-urlencoded"]
135+ & produces ?~ MimeList ["application/json", "application/xml"]
136+ & parameters .~ map Inline
137+ [ mempty
138+ & name .~ "petId"
139+ & description ?~ "ID of pet that needs to be updated"
140+ & required ?~ True
141+ & schema .~ ParamOther (stringSchema ParamPath)
142+ , mempty
143+ & name .~ "name"
144+ & description ?~ "Updated name of the pet"
145+ & required ?~ False
146+ & schema .~ ParamOther (stringSchema ParamFormData)
147+ , mempty
148+ & name .~ "status"
149+ & description ?~ "Updated status of the pet"
150+ & required ?~ False
151+ & schema .~ ParamOther (stringSchema ParamFormData)
152+ ]
153+
154+ & at 200 ?~ "Pet updated."
155+ & at 405 ?~ "Invalid input"
156+ & security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]
157+ where
158+ stringSchema :: ParamLocation -> ParamOtherSchema
159+ stringSchema loc = mempty
160+ & in_ .~ loc
161+ & type_ ?~ SwaggerString
162+
163+operationExampleJSON :: Value
164+operationExampleJSON = [aesonQQ|
165+{
166+ "tags": [
167+ "pet"
168+ ],
169+ "summary": "Updates a pet in the store with form data",
170+ "description": "",
171+ "operationId": "updatePetWithForm",
172+ "consumes": [
173+ "application/x-www-form-urlencoded"
174+ ],
175+ "produces": [
176+ "application/json",
177+ "application/xml"
178+ ],
179+ "parameters": [
180+ {
181+ "name": "petId",
182+ "in": "path",
183+ "description": "ID of pet that needs to be updated",
184+ "required": true,
185+ "type": "string"
186+ },
187+ {
188+ "name": "name",
189+ "in": "formData",
190+ "description": "Updated name of the pet",
191+ "required": false,
192+ "type": "string"
193+ },
194+ {
195+ "name": "status",
196+ "in": "formData",
197+ "description": "Updated status of the pet",
198+ "required": false,
199+ "type": "string"
200+ }
201+ ],
202+ "responses": {
203+ "200": {
204+ "description": "Pet updated."
205+ },
206+ "405": {
207+ "description": "Invalid input"
208+ }
209+ },
210+ "security": [
211+ {
212+ "petstore_auth": [
213+ "write:pets",
214+ "read:pets"
215+ ]
216+ }
217+ ]
218+}
219+|]
220+
221+-- =======================================================================
222+-- Schema object
223+-- =======================================================================
224+
225+schemaPrimitiveExample :: Schema
226+schemaPrimitiveExample = mempty
227+ & type_ ?~ SwaggerString
228+ & format ?~ "email"
229+
230+schemaPrimitiveExampleJSON :: Value
231+schemaPrimitiveExampleJSON = [aesonQQ|
232+{
233+ "type": "string",
234+ "format": "email"
235+}
236+|]
237+
238+schemaSimpleModelExample :: Schema
239+schemaSimpleModelExample = mempty
240+ & type_ ?~ SwaggerObject
241+ & required .~ [ "name" ]
242+ & properties .~
243+ [ ("name", Inline (mempty & type_ ?~ SwaggerString))
244+ , ("address", Ref (Reference "Address"))
245+ , ("age", Inline $ mempty
246+ & minimum_ ?~ 0
247+ & type_ ?~ SwaggerInteger
248+ & format ?~ "int32" ) ]
249+
250+schemaSimpleModelExampleJSON :: Value
251+schemaSimpleModelExampleJSON = [aesonQQ|
252+{
253+ "type": "object",
254+ "required": [
255+ "name"
256+ ],
257+ "properties": {
258+ "name": {
259+ "type": "string"
260+ },
261+ "address": {
262+ "$ref": "#/definitions/Address"
263+ },
264+ "age": {
265+ "type": "integer",
266+ "format": "int32",
267+ "minimum": 0
268+ }
269+ }
270+}
271+|]
272+
273+schemaModelDictExample :: Schema
274+schemaModelDictExample = mempty
275+ & type_ ?~ SwaggerObject
276+ & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ SwaggerString))
277+
278+schemaModelDictExampleJSON :: Value
279+schemaModelDictExampleJSON = [aesonQQ|
280+{
281+ "type": "object",
282+ "additionalProperties": {
283+ "type": "string"
284+ }
285+}
286+|]
287+
288+schemaAdditionalExample :: Schema
289+schemaAdditionalExample = mempty
290+ & type_ ?~ SwaggerObject
291+ & additionalProperties ?~ AdditionalPropertiesAllowed True
292+
293+schemaAdditionalExampleJSON :: Value
294+schemaAdditionalExampleJSON = [aesonQQ|
295+{
296+ "type": "object",
297+ "additionalProperties": true
298+}
299+|]
300+
301+schemaWithExampleExample :: Schema
302+schemaWithExampleExample = mempty
303+ & type_ ?~ SwaggerObject
304+ & properties .~
305+ [ ("id", Inline $ mempty
306+ & type_ ?~ SwaggerInteger
307+ & format ?~ "int64" )
308+ , ("name", Inline $ mempty
309+ & type_ ?~ SwaggerString) ]
310+ & required .~ [ "name" ]
311+ & example ?~ [aesonQQ|
312+ {
313+ "name": "Puma",
314+ "id": 1
315+ }
316+ |]
317+
318+schemaWithExampleExampleJSON :: Value
319+schemaWithExampleExampleJSON = [aesonQQ|
320+{
321+ "type": "object",
322+ "properties": {
323+ "id": {
324+ "type": "integer",
325+ "format": "int64"
326+ },
327+ "name": {
328+ "type": "string"
329+ }
330+ },
331+ "required": [
332+ "name"
333+ ],
334+ "example": {
335+ "name": "Puma",
336+ "id": 1
337+ }
338+}
339+|]
340+
341+-- =======================================================================
342+-- Definitions object
343+-- =======================================================================
344+
345+definitionsExample :: HashMap Text Schema
346+definitionsExample =
347+ [ ("Category", mempty
348+ & type_ ?~ SwaggerObject
349+ & properties .~
350+ [ ("id", Inline $ mempty
351+ & type_ ?~ SwaggerInteger
352+ & format ?~ "int64")
353+ , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] )
354+ , ("Tag", mempty
355+ & type_ ?~ SwaggerObject
356+ & properties .~
357+ [ ("id", Inline $ mempty
358+ & type_ ?~ SwaggerInteger
359+ & format ?~ "int64")
360+ , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] ) ]
361+
362+definitionsExampleJSON :: Value
363+definitionsExampleJSON = [aesonQQ|
364+{
365+ "Category": {
366+ "type": "object",
367+ "properties": {
368+ "id": {
369+ "type": "integer",
370+ "format": "int64"
371+ },
372+ "name": {
373+ "type": "string"
374+ }
375+ }
376+ },
377+ "Tag": {
378+ "type": "object",
379+ "properties": {
380+ "id": {
381+ "type": "integer",
382+ "format": "int64"
383+ },
384+ "name": {
385+ "type": "string"
386+ }
387+ }
388+ }
389+}
390+|]
391+
392+-- =======================================================================
393+-- Parameters Definition object
394+-- =======================================================================
395+
396+paramsDefinitionExample :: HashMap Text Param
397+paramsDefinitionExample =
398+ [ ("skipParam", mempty
399+ & name .~ "skip"
400+ & description ?~ "number of items to skip"
401+ & required ?~ True
402+ & schema .~ ParamOther (mempty
403+ & in_ .~ ParamQuery
404+ & type_ ?~ SwaggerInteger
405+ & format ?~ "int32" ))
406+ , ("limitParam", mempty
407+ & name .~ "limit"
408+ & description ?~ "max records to return"
409+ & required ?~ True
410+ & schema .~ ParamOther (mempty
411+ & in_ .~ ParamQuery
412+ & type_ ?~ SwaggerInteger
413+ & format ?~ "int32" )) ]
414+
415+paramsDefinitionExampleJSON :: Value
416+paramsDefinitionExampleJSON = [aesonQQ|
417+{
418+ "skipParam": {
419+ "name": "skip",
420+ "in": "query",
421+ "description": "number of items to skip",
422+ "required": true,
423+ "type": "integer",
424+ "format": "int32"
425+ },
426+ "limitParam": {
427+ "name": "limit",
428+ "in": "query",
429+ "description": "max records to return",
430+ "required": true,
431+ "type": "integer",
432+ "format": "int32"
433+ }
434+}
435+|]
436+
437+-- =======================================================================
438+-- Responses Definition object
439+-- =======================================================================
440+
441+responsesDefinitionExample :: HashMap Text Response
442+responsesDefinitionExample =
443+ [ ("NotFound", mempty & description .~ "Entity not found.")
444+ , ("IllegalInput", mempty & description .~ "Illegal input for operation.") ]
445+
446+responsesDefinitionExampleJSON :: Value
447+responsesDefinitionExampleJSON = [aesonQQ|
448+{
449+ "NotFound": {
450+ "description": "Entity not found."
451+ },
452+ "IllegalInput": {
453+ "description": "Illegal input for operation."
454+ }
455+}
456+|]
457+
458+-- =======================================================================
459+-- Responses Definition object
460+-- =======================================================================
461+
462+securityDefinitionsExample :: HashMap Text SecurityScheme
463+securityDefinitionsExample =
464+ [ ("api_key", SecurityScheme
465+ { _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "api_key" ApiKeyHeader)
466+ , _securitySchemeDescription = Nothing })
467+ , ("petstore_auth", SecurityScheme
468+ { _securitySchemeType = SecuritySchemeOAuth2 (OAuth2Params
469+ { _oauth2Flow = OAuth2Implicit "http://swagger.io/api/oauth/dialog"
470+ , _oauth2Scopes =
471+ [ ("write:pets", "modify pets in your account")
472+ , ("read:pets", "read your pets") ] } )
473+ , _securitySchemeDescription = Nothing }) ]
474+
475+securityDefinitionsExampleJSON :: Value
476+securityDefinitionsExampleJSON = [aesonQQ|
477+{
478+ "api_key": {
479+ "type": "apiKey",
480+ "name": "api_key",
481+ "in": "header"
482+ },
483+ "petstore_auth": {
484+ "type": "oauth2",
485+ "authorizationUrl": "http://swagger.io/api/oauth/dialog",
486+ "flow": "implicit",
487+ "scopes": {
488+ "write:pets": "modify pets in your account",
489+ "read:pets": "read your pets"
490+ }
491+ }
492+}
493+|]
494+
495+-- =======================================================================
496+-- Swagger object
497+-- =======================================================================
498+
499+swaggerExample :: Swagger
500+swaggerExample = mempty
501+ & basePath ?~ "/"
502+ & schemes ?~ [Http]
503+ & info .~ (mempty
504+ & version .~ "1.0"
505+ & title .~ "Todo API"
506+ & license ?~ "MIT"
507+ & license._Just.url ?~ URL "http://mit.com"
508+ & description ?~ "This is a an API that tests servant-swagger support for a Todo API")
509+ & paths.at "/todo/{id}" ?~ (mempty & get ?~ ((mempty :: Operation)
510+ & at 200 ?~ Inline (mempty
511+ & description .~ "OK"
512+ & schema ?~ Inline (mempty
513+ & type_ ?~ SwaggerObject
514+ & example ?~ [aesonQQ|
515+ {
516+ "created": 100,
517+ "description": "get milk"
518+ } |]
519+ & description ?~ "This is some real Todo right here"
520+ & properties .~
521+ [ ("created", Inline $ mempty
522+ & type_ ?~ SwaggerInteger
523+ & format ?~ "int32")
524+ , ("description", Inline (mempty & type_ ?~ SwaggerString))]))
525+ & produces ?~ MimeList [ "application/json" ]
526+ & parameters .~
527+ [ Inline $ mempty
528+ & required ?~ True
529+ & name .~ "id"
530+ & description ?~ "TodoId param"
531+ & schema .~ ParamOther (mempty
532+ & in_ .~ ParamPath
533+ & type_ ?~ SwaggerString ) ]
534+ & tags .~ InsOrdHS.fromList [ "todo" ] ))
535+
536+swaggerExampleJSON :: Value
537+swaggerExampleJSON = [aesonQQ|
538+{
539+ "swagger": "2.0",
540+ "basePath": "/",
541+ "schemes": [
542+ "http"
543+ ],
544+ "info": {
545+ "version": "1.0",
546+ "title": "Todo API",
547+ "license": {
548+ "url": "http://mit.com",
549+ "name": "MIT"
550+ },
551+ "description": "This is a an API that tests servant-swagger support for a Todo API"
552+ },
553+ "paths": {
554+ "/todo/{id}": {
555+ "get": {
556+ "responses": {
557+ "200": {
558+ "schema": {
559+ "example": {
560+ "created": 100,
561+ "description": "get milk"
562+ },
563+ "type": "object",
564+ "description": "This is some real Todo right here",
565+ "properties": {
566+ "created": {
567+ "format": "int32",
568+ "type": "integer"
569+ },
570+ "description": {
571+ "type": "string"
572+ }
573+ }
574+ },
575+ "description": "OK"
576+ }
577+ },
578+ "produces": [
579+ "application/json"
580+ ],
581+ "parameters": [
582+ {
583+ "required": true,
584+ "in": "path",
585+ "name": "id",
586+ "type": "string",
587+ "description": "TodoId param"
588+ }
589+ ],
590+ "tags": [
591+ "todo"
592+ ]
593+ }
594+ }
595+ }
596+}
597+|]
598+
599+petstoreExampleJSON :: Value
600+petstoreExampleJSON = [aesonQQ|
601+{
602+ "swagger":"2.0",
603+ "info":{
604+ "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.",
605+ "version":"1.0.0",
606+ "title":"Swagger Petstore",
607+ "termsOfService":"http://swagger.io/terms/",
608+ "contact":{
609+ "email":"apiteam@swagger.io"
610+ },
611+ "license":{
612+ "name":"Apache 2.0",
613+ "url":"http://www.apache.org/licenses/LICENSE-2.0.html"
614+ }
615+ },
616+ "host":"petstore.swagger.io",
617+ "basePath":"/v2",
618+ "tags":[
619+ {
620+ "name":"pet",
621+ "description":"Everything about your Pets",
622+ "externalDocs":{
623+ "description":"Find out more",
624+ "url":"http://swagger.io"
625+ }
626+ },
627+ {
628+ "name":"store",
629+ "description":"Access to Petstore orders"
630+ },
631+ {
632+ "name":"user",
633+ "description":"Operations about user",
634+ "externalDocs":{
635+ "description":"Find out more about our store",
636+ "url":"http://swagger.io"
637+ }
638+ }
639+ ],
640+ "schemes":[
641+ "http"
642+ ],
643+ "paths":{
644+ "/pet":{
645+ "post":{
646+ "tags":[
647+ "pet"
648+ ],
649+ "summary":"Add a new pet to the store",
650+ "description":"",
651+ "operationId":"addPet",
652+ "consumes":[
653+ "application/json",
654+ "application/xml"
655+ ],
656+ "produces":[
657+ "application/xml",
658+ "application/json"
659+ ],
660+ "parameters":[
661+ {
662+ "in":"body",
663+ "name":"body",
664+ "description":"Pet object that needs to be added to the store",
665+ "required":true,
666+ "schema":{
667+ "$ref":"#/definitions/Pet"
668+ }
669+ }
670+ ],
671+ "responses":{
672+ "405":{
673+ "description":"Invalid input"
674+ }
675+ },
676+ "security":[
677+ {
678+ "petstore_auth":[
679+ "write:pets",
680+ "read:pets"
681+ ]
682+ }
683+ ]
684+ },
685+ "put":{
686+ "tags":[
687+ "pet"
688+ ],
689+ "summary":"Update an existing pet",
690+ "description":"",
691+ "operationId":"updatePet",
692+ "consumes":[
693+ "application/json",
694+ "application/xml"
695+ ],
696+ "produces":[
697+ "application/xml",
698+ "application/json"
699+ ],
700+ "parameters":[
701+ {
702+ "in":"body",
703+ "name":"body",
704+ "description":"Pet object that needs to be added to the store",
705+ "required":true,
706+ "schema":{
707+ "$ref":"#/definitions/Pet"
708+ }
709+ }
710+ ],
711+ "responses":{
712+ "400":{
713+ "description":"Invalid ID supplied"
714+ },
715+ "404":{
716+ "description":"Pet not found"
717+ },
718+ "405":{
719+ "description":"Validation exception"
720+ }
721+ },
722+ "security":[
723+ {
724+ "petstore_auth":[
725+ "write:pets",
726+ "read:pets"
727+ ]
728+ }
729+ ]
730+ }
731+ },
732+ "/pet/findByStatus":{
733+ "get":{
734+ "tags":[
735+ "pet"
736+ ],
737+ "summary":"Finds Pets by status",
738+ "description":"Multiple status values can be provided with comma seperated strings",
739+ "operationId":"findPetsByStatus",
740+ "produces":[
741+ "application/xml",
742+ "application/json"
743+ ],
744+ "parameters":[
745+ {
746+ "name":"status",
747+ "in":"query",
748+ "description":"Status values that need to be considered for filter",
749+ "required":true,
750+ "type":"array",
751+ "items":{
752+ "type":"string",
753+ "enum":[
754+ "available",
755+ "pending",
756+ "sold"
757+ ],
758+ "default":"available"
759+ },
760+ "collectionFormat":"csv"
761+ }
762+ ],
763+ "responses":{
764+ "200":{
765+ "description":"successful operation",
766+ "schema":{
767+ "type":"array",
768+ "items":{
769+ "$ref":"#/definitions/Pet"
770+ }
771+ }
772+ },
773+ "400":{
774+ "description":"Invalid status value"
775+ }
776+ },
777+ "security":[
778+ {
779+ "petstore_auth":[
780+ "write:pets",
781+ "read:pets"
782+ ]
783+ }
784+ ]
785+ }
786+ },
787+ "/pet/findByTags":{
788+ "get":{
789+ "tags":[
790+ "pet"
791+ ],
792+ "summary":"Finds Pets by tags",
793+ "description":"Muliple tags can be provided with comma seperated strings. Use tag1, tag2, tag3 for testing.",
794+ "operationId":"findPetsByTags",
795+ "produces":[
796+ "application/xml",
797+ "application/json"
798+ ],
799+ "parameters":[
800+ {
801+ "name":"tags",
802+ "in":"query",
803+ "description":"Tags to filter by",
804+ "required":true,
805+ "type":"array",
806+ "items":{
807+ "type":"string"
808+ },
809+ "collectionFormat":"csv"
810+ }
811+ ],
812+ "responses":{
813+ "200":{
814+ "description":"successful operation",
815+ "schema":{
816+ "type":"array",
817+ "items":{
818+ "$ref":"#/definitions/Pet"
819+ }
820+ }
821+ },
822+ "400":{
823+ "description":"Invalid tag value"
824+ }
825+ },
826+ "security":[
827+ {
828+ "petstore_auth":[
829+ "write:pets",
830+ "read:pets"
831+ ]
832+ }
833+ ]
834+ }
835+ },
836+ "/pet/{petId}":{
837+ "get":{
838+ "tags":[
839+ "pet"
840+ ],
841+ "summary":"Find pet by ID",
842+ "description":"Returns a single pet",
843+ "operationId":"getPetById",
844+ "produces":[
845+ "application/xml",
846+ "application/json"
847+ ],
848+ "parameters":[
849+ {
850+ "name":"petId",
851+ "in":"path",
852+ "description":"ID of pet to return",
853+ "required":true,
854+ "type":"integer",
855+ "format":"int64"
856+ }
857+ ],
858+ "responses":{
859+ "200":{
860+ "description":"successful operation",
861+ "schema":{
862+ "$ref":"#/definitions/Pet"
863+ }
864+ },
865+ "400":{
866+ "description":"Invalid ID supplied"
867+ },
868+ "404":{
869+ "description":"Pet not found"
870+ }
871+ },
872+ "security":[
873+ {
874+ "api_key": []
875+ }
876+ ]
877+ },
878+ "post":{
879+ "tags":[
880+ "pet"
881+ ],
882+ "summary":"Updates a pet in the store with form data",
883+ "description":"",
884+ "operationId":"updatePetWithForm",
885+ "consumes":[
886+ "application/x-www-form-urlencoded"
887+ ],
888+ "produces":[
889+ "application/xml",
890+ "application/json"
891+ ],
892+ "parameters":[
893+ {
894+ "name":"petId",
895+ "in":"path",
896+ "description":"ID of pet that needs to be updated",
897+ "required":true,
898+ "type":"integer",
899+ "format":"int64"
900+ },
901+ {
902+ "name":"name",
903+ "in":"formData",
904+ "description":"Updated name of the pet",
905+ "required":false,
906+ "type":"string"
907+ },
908+ {
909+ "name":"status",
910+ "in":"formData",
911+ "description":"Updated status of the pet",
912+ "required":false,
913+ "type":"string"
914+ }
915+ ],
916+ "responses":{
917+ "405":{
918+ "description":"Invalid input"
919+ }
920+ },
921+ "security":[
922+ {
923+ "petstore_auth":[
924+ "write:pets",
925+ "read:pets"
926+ ]
927+ }
928+ ]
929+ },
930+ "delete":{
931+ "tags":[
932+ "pet"
933+ ],
934+ "summary":"Deletes a pet",
935+ "description":"",
936+ "operationId":"deletePet",
937+ "produces":[
938+ "application/xml",
939+ "application/json"
940+ ],
941+ "parameters":[
942+ {
943+ "name":"api_key",
944+ "in":"header",
945+ "required":false,
946+ "type":"string"
947+ },
948+ {
949+ "name":"petId",
950+ "in":"path",
951+ "description":"Pet id to delete",
952+ "required":true,
953+ "type":"integer",
954+ "format":"int64"
955+ }
956+ ],
957+ "responses":{
958+ "400":{
959+ "description":"Invalid pet value"
960+ }
961+ },
962+ "security":[
963+ {
964+ "petstore_auth":[
965+ "write:pets",
966+ "read:pets"
967+ ]
968+ }
969+ ]
970+ }
971+ },
972+ "/pet/{petId}/uploadImage":{
973+ "post":{
974+ "tags":[
975+ "pet"
976+ ],
977+ "summary":"uploads an image",
978+ "description":"",
979+ "operationId":"uploadFile",
980+ "consumes":[
981+ "multipart/form-data"
982+ ],
983+ "produces":[
984+ "application/json"
985+ ],
986+ "parameters":[
987+ {
988+ "name":"petId",
989+ "in":"path",
990+ "description":"ID of pet to update",
991+ "required":true,
992+ "type":"integer",
993+ "format":"int64"
994+ },
995+ {
996+ "name":"additionalMetadata",
997+ "in":"formData",
998+ "description":"Additional data to pass to server",
999+ "required":false,
1000+ "type":"string"
1001+ },
1002+ {
1003+ "name":"file",
1004+ "in":"formData",
1005+ "description":"file to upload",
1006+ "required":false,
1007+ "type":"file"
1008+ }
1009+ ],
1010+ "responses":{
1011+ "200":{
1012+ "description":"successful operation",
1013+ "schema":{
1014+ "$ref":"#/definitions/ApiResponse"
1015+ }
1016+ }
1017+ },
1018+ "security":[
1019+ {
1020+ "petstore_auth":[
1021+ "write:pets",
1022+ "read:pets"
1023+ ]
1024+ }
1025+ ]
1026+ }
1027+ },
1028+ "/store/inventory":{
1029+ "get":{
1030+ "tags":[
1031+ "store"
1032+ ],
1033+ "summary":"Returns pet inventories by status",
1034+ "description":"Returns a map of status codes to quantities",
1035+ "operationId":"getInventory",
1036+ "produces":[
1037+ "application/json"
1038+ ],
1039+ "parameters": [],
1040+ "responses":{
1041+ "200":{
1042+ "description":"successful operation",
1043+ "schema":{
1044+ "type":"object",
1045+ "additionalProperties":{
1046+ "type":"integer",
1047+ "format":"int32"
1048+ }
1049+ }
1050+ }
1051+ },
1052+ "security":[
1053+ {
1054+ "api_key": []
1055+ }
1056+ ]
1057+ }
1058+ },
1059+ "/store/order":{
1060+ "post":{
1061+ "tags":[
1062+ "store"
1063+ ],
1064+ "summary":"Place an order for a pet",
1065+ "description":"",
1066+ "operationId":"placeOrder",
1067+ "produces":[
1068+ "application/xml",
1069+ "application/json"
1070+ ],
1071+ "parameters":[
1072+ {
1073+ "in":"body",
1074+ "name":"body",
1075+ "description":"order placed for purchasing the pet",
1076+ "required":true,
1077+ "schema":{
1078+ "$ref":"#/definitions/Order"
1079+ }
1080+ }
1081+ ],
1082+ "responses":{
1083+ "200":{
1084+ "description":"successful operation",
1085+ "schema":{
1086+ "$ref":"#/definitions/Order"
1087+ }
1088+ },
1089+ "400":{
1090+ "description":"Invalid Order"
1091+ }
1092+ }
1093+ }
1094+ },
1095+ "/store/order/{orderId}":{
1096+ "get":{
1097+ "tags":[
1098+ "store"
1099+ ],
1100+ "summary":"Find purchase order by ID",
1101+ "description":"For valid response try integer IDs with value <= 5 or > 10. Other values will generated exceptions",
1102+ "operationId":"getOrderById",
1103+ "produces":[
1104+ "application/xml",
1105+ "application/json"
1106+ ],
1107+ "parameters":[
1108+ {
1109+ "name":"orderId",
1110+ "in":"path",
1111+ "description":"ID of pet that needs to be fetched",
1112+ "required":true,
1113+ "type":"integer",
1114+ "maximum":5.0,
1115+ "minimum":1.0,
1116+ "format":"int64"
1117+ }
1118+ ],
1119+ "responses":{
1120+ "200":{
1121+ "description":"successful operation",
1122+ "schema":{
1123+ "$ref":"#/definitions/Order"
1124+ }
1125+ },
1126+ "400":{
1127+ "description":"Invalid ID supplied"
1128+ },
1129+ "404":{
1130+ "description":"Order not found"
1131+ }
1132+ }
1133+ },
1134+ "delete":{
1135+ "tags":[
1136+ "store"
1137+ ],
1138+ "summary":"Delete purchase order by ID",
1139+ "description":"For valid response try integer IDs with value < 1000. Anything above 1000 or nonintegers will generate API errors",
1140+ "operationId":"deleteOrder",
1141+ "produces":[
1142+ "application/xml",
1143+ "application/json"
1144+ ],
1145+ "parameters":[
1146+ {
1147+ "name":"orderId",
1148+ "in":"path",
1149+ "description":"ID of the order that needs to be deleted",
1150+ "required":true,
1151+ "type":"string",
1152+ "minimum":1.0
1153+ }
1154+ ],
1155+ "responses":{
1156+ "400":{
1157+ "description":"Invalid ID supplied"
1158+ },
1159+ "404":{
1160+ "description":"Order not found"
1161+ }
1162+ }
1163+ }
1164+ },
1165+ "/user":{
1166+ "post":{
1167+ "tags":[
1168+ "user"
1169+ ],
1170+ "summary":"Create user",
1171+ "description":"This can only be done by the logged in user.",
1172+ "operationId":"createUser",
1173+ "produces":[
1174+ "application/xml",
1175+ "application/json"
1176+ ],
1177+ "parameters":[
1178+ {
1179+ "in":"body",
1180+ "name":"body",
1181+ "description":"Created user object",
1182+ "required":true,
1183+ "schema":{
1184+ "$ref":"#/definitions/User"
1185+ }
1186+ }
1187+ ],
1188+ "responses":{
1189+ "default":{
1190+ "description":"successful operation"
1191+ }
1192+ }
1193+ }
1194+ },
1195+ "/user/createWithArray":{
1196+ "post":{
1197+ "tags":[
1198+ "user"
1199+ ],
1200+ "summary":"Creates list of users with given input array",
1201+ "description":"",
1202+ "operationId":"createUsersWithArrayInput",
1203+ "produces":[
1204+ "application/xml",
1205+ "application/json"
1206+ ],
1207+ "parameters":[
1208+ {
1209+ "in":"body",
1210+ "name":"body",
1211+ "description":"List of user object",
1212+ "required":true,
1213+ "schema":{
1214+ "type":"array",
1215+ "items":{
1216+ "$ref":"#/definitions/User"
1217+ }
1218+ }
1219+ }
1220+ ],
1221+ "responses":{
1222+ "default":{
1223+ "description":"successful operation"
1224+ }
1225+ }
1226+ }
1227+ },
1228+ "/user/createWithList":{
1229+ "post":{
1230+ "tags":[
1231+ "user"
1232+ ],
1233+ "summary":"Creates list of users with given input array",
1234+ "description":"",
1235+ "operationId":"createUsersWithListInput",
1236+ "produces":[
1237+ "application/xml",
1238+ "application/json"
1239+ ],
1240+ "parameters":[
1241+ {
1242+ "in":"body",
1243+ "name":"body",
1244+ "description":"List of user object",
1245+ "required":true,
1246+ "schema":{
1247+ "type":"array",
1248+ "items":{
1249+ "$ref":"#/definitions/User"
1250+ }
1251+ }
1252+ }
1253+ ],
1254+ "responses":{
1255+ "default":{
1256+ "description":"successful operation"
1257+ }
1258+ }
1259+ }
1260+ },
1261+ "/user/login":{
1262+ "get":{
1263+ "tags":[
1264+ "user"
1265+ ],
1266+ "summary":"Logs user into the system",
1267+ "description":"",
1268+ "operationId":"loginUser",
1269+ "produces":[
1270+ "application/xml",
1271+ "application/json"
1272+ ],
1273+ "parameters":[
1274+ {
1275+ "name":"username",
1276+ "in":"query",
1277+ "description":"The user name for login",
1278+ "required":true,
1279+ "type":"string"
1280+ },
1281+ {
1282+ "name":"password",
1283+ "in":"query",
1284+ "description":"The password for login in clear text",
1285+ "required":true,
1286+ "type":"string"
1287+ }
1288+ ],
1289+ "responses":{
1290+ "200":{
1291+ "description":"successful operation",
1292+ "schema":{
1293+ "type":"string"
1294+ },
1295+ "headers":{
1296+ "X-Rate-Limit":{
1297+ "type":"integer",
1298+ "format":"int32",
1299+ "description":"calls per hour allowed by the user"
1300+ },
1301+ "X-Expires-After":{
1302+ "type":"string",
1303+ "format":"date-time",
1304+ "description":"date in UTC when toekn expires"
1305+ }
1306+ }
1307+ },
1308+ "400":{
1309+ "description":"Invalid username/password supplied"
1310+ }
1311+ }
1312+ }
1313+ },
1314+ "/user/logout":{
1315+ "get":{
1316+ "tags":[
1317+ "user"
1318+ ],
1319+ "summary":"Logs out current logged in user session",
1320+ "description":"",
1321+ "operationId":"logoutUser",
1322+ "produces":[
1323+ "application/xml",
1324+ "application/json"
1325+ ],
1326+ "parameters": [],
1327+ "responses":{
1328+ "default":{
1329+ "description":"successful operation"
1330+ }
1331+ }
1332+ }
1333+ },
1334+ "/user/{username}":{
1335+ "get":{
1336+ "tags":[
1337+ "user"
1338+ ],
1339+ "summary":"Get user by user name",
1340+ "description":"",
1341+ "operationId":"getUserByName",
1342+ "produces":[
1343+ "application/xml",
1344+ "application/json"
1345+ ],
1346+ "parameters":[
1347+ {
1348+ "name":"username",
1349+ "in":"path",
1350+ "description":"The name that needs to be fetched. Use user1 for testing. ",
1351+ "required":true,
1352+ "type":"string"
1353+ }
1354+ ],
1355+ "responses":{
1356+ "200":{
1357+ "description":"successful operation",
1358+ "schema":{
1359+ "$ref":"#/definitions/User"
1360+ }
1361+ },
1362+ "400":{
1363+ "description":"Invalid username supplied"
1364+ },
1365+ "404":{
1366+ "description":"User not found"
1367+ }
1368+ }
1369+ },
1370+ "put":{
1371+ "tags":[
1372+ "user"
1373+ ],
1374+ "summary":"Updated user",
1375+ "description":"This can only be done by the logged in user.",
1376+ "operationId":"updateUser",
1377+ "produces":[
1378+ "application/xml",
1379+ "application/json"
1380+ ],
1381+ "parameters":[
1382+ {
1383+ "name":"username",
1384+ "in":"path",
1385+ "description":"name that need to be deleted",
1386+ "required":true,
1387+ "type":"string"
1388+ },
1389+ {
1390+ "in":"body",
1391+ "name":"body",
1392+ "description":"Updated user object",
1393+ "required":true,
1394+ "schema":{
1395+ "$ref":"#/definitions/User"
1396+ }
1397+ }
1398+ ],
1399+ "responses":{
1400+ "400":{
1401+ "description":"Invalid user supplied"
1402+ },
1403+ "404":{
1404+ "description":"User not found"
1405+ }
1406+ }
1407+ },
1408+ "delete":{
1409+ "tags":[
1410+ "user"
1411+ ],
1412+ "summary":"Delete user",
1413+ "description":"This can only be done by the logged in user.",
1414+ "operationId":"deleteUser",
1415+ "produces":[
1416+ "application/xml",
1417+ "application/json"
1418+ ],
1419+ "parameters":[
1420+ {
1421+ "name":"username",
1422+ "in":"path",
1423+ "description":"The name that needs to be deleted",
1424+ "required":true,
1425+ "type":"string"
1426+ }
1427+ ],
1428+ "responses":{
1429+ "400":{
1430+ "description":"Invalid username supplied"
1431+ },
1432+ "404":{
1433+ "description":"User not found"
1434+ }
1435+ }
1436+ }
1437+ }
1438+ },
1439+ "securityDefinitions":{
1440+ "petstore_auth":{
1441+ "type":"oauth2",
1442+ "authorizationUrl":"http://petstore.swagger.io/api/oauth/dialog",
1443+ "flow":"implicit",
1444+ "scopes":{
1445+ "write:pets":"modify pets in your account",
1446+ "read:pets":"read your pets"
1447+ }
1448+ },
1449+ "api_key":{
1450+ "type":"apiKey",
1451+ "name":"api_key",
1452+ "in":"header"
1453+ }
1454+ },
1455+ "definitions":{
1456+ "Order":{
1457+ "type":"object",
1458+ "properties":{
1459+ "id":{
1460+ "type":"integer",
1461+ "format":"int64"
1462+ },
1463+ "petId":{
1464+ "type":"integer",
1465+ "format":"int64"
1466+ },
1467+ "quantity":{
1468+ "type":"integer",
1469+ "format":"int32"
1470+ },
1471+ "shipDate":{
1472+ "type":"string",
1473+ "format":"date-time"
1474+ },
1475+ "status":{
1476+ "type":"string",
1477+ "description":"Order Status",
1478+ "enum":[
1479+ "placed",
1480+ "approved",
1481+ "delivered"
1482+ ]
1483+ },
1484+ "complete":{
1485+ "type":"boolean",
1486+ "default":false
1487+ }
1488+ },
1489+ "xml":{
1490+ "name":"Order"
1491+ }
1492+ },
1493+ "Category":{
1494+ "type":"object",
1495+ "properties":{
1496+ "id":{
1497+ "type":"integer",
1498+ "format":"int64"
1499+ },
1500+ "name":{
1501+ "type":"string"
1502+ }
1503+ },
1504+ "xml":{
1505+ "name":"Category"
1506+ }
1507+ },
1508+ "User":{
1509+ "type":"object",
1510+ "properties":{
1511+ "id":{
1512+ "type":"integer",
1513+ "format":"int64"
1514+ },
1515+ "username":{
1516+ "type":"string"
1517+ },
1518+ "firstName":{
1519+ "type":"string"
1520+ },
1521+ "lastName":{
1522+ "type":"string"
1523+ },
1524+ "email":{
1525+ "type":"string"
1526+ },
1527+ "password":{
1528+ "type":"string"
1529+ },
1530+ "phone":{
1531+ "type":"string"
1532+ },
1533+ "userStatus":{
1534+ "type":"integer",
1535+ "format":"int32",
1536+ "description":"User Status"
1537+ }
1538+ },
1539+ "xml":{
1540+ "name":"User"
1541+ }
1542+ },
1543+ "Tag":{
1544+ "type":"object",
1545+ "properties":{
1546+ "id":{
1547+ "type":"integer",
1548+ "format":"int64"
1549+ },
1550+ "name":{
1551+ "type":"string"
1552+ }
1553+ },
1554+ "xml":{
1555+ "name":"Tag"
1556+ }
1557+ },
1558+ "Pet":{
1559+ "type":"object",
1560+ "required":[
1561+ "name",
1562+ "photoUrls"
1563+ ],
1564+ "properties":{
1565+ "id":{
1566+ "type":"integer",
1567+ "format":"int64"
1568+ },
1569+ "category":{
1570+ "$ref":"#/definitions/Category"
1571+ },
1572+ "name":{
1573+ "type":"string",
1574+ "example":"doggie"
1575+ },
1576+ "photoUrls":{
1577+ "type":"array",
1578+ "xml":{
1579+ "name":"photoUrl",
1580+ "wrapped":true
1581+ },
1582+ "items":{
1583+ "type":"string"
1584+ }
1585+ },
1586+ "tags":{
1587+ "type":"array",
1588+ "xml":{
1589+ "name":"tag",
1590+ "wrapped":true
1591+ },
1592+ "items":{
1593+ "$ref":"#/definitions/Tag"
1594+ }
1595+ },
1596+ "status":{
1597+ "type":"string",
1598+ "description":"pet status in the store",
1599+ "enum":[
1600+ "available",
1601+ "pending",
1602+ "sold"
1603+ ]
1604+ }
1605+ },
1606+ "xml":{
1607+ "name":"Pet"
1608+ }
1609+ },
1610+ "ApiResponse":{
1611+ "type":"object",
1612+ "properties":{
1613+ "code":{
1614+ "type":"integer",
1615+ "format":"int32"
1616+ },
1617+ "type":{
1618+ "type":"string"
1619+ },
1620+ "message":{
1621+ "type":"string"
1622+ }
1623+ }
1624+ }
1625+ },
1626+ "externalDocs":{
1627+ "description":"Find out more about Swagger",
1628+ "url":"http://swagger.io"
1629+ }
1630+}
1631+|]
1632+
1633+compositionSchemaExample :: Schema
1634+compositionSchemaExample = mempty
1635+ & type_ ?~ SwaggerObject
1636+ & Data.Swagger.allOf ?~ [
1637+ Ref (Reference "Other")
1638+ , Inline (mempty
1639+ & type_ ?~ SwaggerObject
1640+ & properties .~
1641+ [ ("greet", Inline $ mempty
1642+ & type_ ?~ SwaggerString) ])
1643+ ]
1644+
1645+compositionSchemaExampleJSON :: Value
1646+compositionSchemaExampleJSON = [aesonQQ|
1647+{
1648+ "type": "object",
1649+ "allOf": [
1650+ {
1651+ "$ref": "#/definitions/Other"
1652+ },
1653+ {
1654+ "type": "object",
1655+ "properties": {
1656+ "greet": { "type": "string" }
1657+ }
1658+ }
1659+ ]
1660+}
1661+|]
test/SpecCommon.hs+9−1
@@ -8,7 +8,15 @@ import qualified Data.Vector as Vector
8
8
9import Test.Hspec
9import Test.Hspec
10
10
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+
11−(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec
19+(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a) => a -> Value -> Spec
12x <=> js = do
20x <=> js = do
13 it "encodes correctly" $ do
21 it "encodes correctly" $ do
14 toJSON x `shouldBe` js
22 toJSON x `shouldBe` js