git.iko.soy/typeable/openapi3
on 8087980 help sign in
.github/workflows/haskell-ci.ymldeleted−243
since splitsnapshots
unifiedsplit
@@ -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+155
@@ -0,0 +1,155 @@
1+# This Travis job script has been generated by a script via
2+#
3+# haskell-ci '--branches' 'master' '--haddock-jobs=>=8.4' '--output' '.travis.yml' 'swagger2.cabal'
4+#
5+# To regenerate the script (for example after adjusting tested-with) run
6+#
7+# haskell-ci regenerate
8+#
9+# For more information, see https://github.com/haskell-CI/haskell-ci
10+#
11+# version: 0.10
12+#
13+version: ~> 1.0
14+language: c
15+os: linux
16+dist: xenial
17+git:
18+ # whether to recursively clone submodules
19+ submodules: false
20+branches:
21+ only:
22+ - master
23+cache:
24+ directories:
25+ - $HOME/.cabal/packages
26+ - $HOME/.cabal/store
27+ - $HOME/.hlint
28+before_cache:
29+ - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
30+ # remove files that are regenerated by 'cabal update'
31+ - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*
32+ - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json
33+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
34+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
35+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
36+ - rm -rfv $CABALHOME/packages/head.hackage
37+jobs:
38+ include:
39+ - compiler: ghc-8.10.1
40+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.1","cabal-install-3.2"]}}
41+ os: linux
42+ - compiler: ghc-8.8.1
43+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.1","cabal-install-3.2"]}}
44+ os: linux
45+ - compiler: ghc-8.6.5
46+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.2"]}}
47+ os: linux
48+ - compiler: ghc-8.4.4
49+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.2"]}}
50+ os: linux
51+ - compiler: ghc-8.2.2
52+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.2.2","cabal-install-3.2"]}}
53+ os: linux
54+ - compiler: ghc-8.0.2
55+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.0.2","cabal-install-3.2"]}}
56+ os: linux
57+before_install:
58+ - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
59+ - WITHCOMPILER="-w $HC"
60+ - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
61+ - HCPKG="$HC-pkg"
62+ - unset CC
63+ - CABAL=/opt/ghc/bin/cabal
64+ - CABALHOME=$HOME/.cabal
65+ - export PATH="$CABALHOME/bin:$PATH"
66+ - TOP=$(pwd)
67+ - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
68+ - echo $HCNUMVER
69+ - CABAL="$CABAL -vnormal+nowrap"
70+ - set -o pipefail
71+ - TEST=--enable-tests
72+ - BENCH=--enable-benchmarks
73+ - HEADHACKAGE=false
74+ - rm -f $CABALHOME/config
75+ - |
76+ echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
77+ echo "remote-build-reporting: anonymous" >> $CABALHOME/config
78+ echo "write-ghc-environment-files: always" >> $CABALHOME/config
79+ echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
80+ echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
81+ echo "world-file: $CABALHOME/world" >> $CABALHOME/config
82+ echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
83+ echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
84+ echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
85+ echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
86+ echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
87+ echo "install-dirs user" >> $CABALHOME/config
88+ echo " prefix: $CABALHOME" >> $CABALHOME/config
89+ echo "repository hackage.haskell.org" >> $CABALHOME/config
90+ echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
91+install:
92+ - ${CABAL} --version
93+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
94+ - |
95+ echo "program-default-options" >> $CABALHOME/config
96+ echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
97+ - cat $CABALHOME/config
98+ - rm -fv cabal.project cabal.project.local cabal.project.freeze
99+ - travis_retry ${CABAL} v2-update -v
100+ # Generate cabal.project
101+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
102+ - touch cabal.project
103+ - |
104+ echo "packages: ." >> cabal.project
105+ - if [ $HCNUMVER -ge 80200 ] ; then echo 'package swagger2' >> cabal.project ; fi
106+ - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
107+ - |
108+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(swagger2)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
109+ - cat cabal.project || true
110+ - cat cabal.project.local || true
111+ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
112+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}
113+ - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
114+ - rm cabal.project.freeze
115+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all
116+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all
117+script:
118+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
119+ # Packaging...
120+ - ${CABAL} v2-sdist all
121+ # Unpacking...
122+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
123+ - cd ${DISTDIR} || false
124+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
125+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
126+ - PKGDIR_swagger2="$(find . -maxdepth 1 -type d -regex '.*/swagger2-[0-9.]*')"
127+ # Generate cabal.project
128+ - rm -rf cabal.project cabal.project.local cabal.project.freeze
129+ - touch cabal.project
130+ - |
131+ echo "packages: ${PKGDIR_swagger2}" >> cabal.project
132+ - if [ $HCNUMVER -ge 80200 ] ; then echo 'package swagger2' >> cabal.project ; fi
133+ - "if [ $HCNUMVER -ge 80200 ] ; then echo ' ghc-options: -Werror=missing-methods' >> cabal.project ; fi"
134+ - |
135+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(swagger2)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
136+ - cat cabal.project || true
137+ - cat cabal.project.local || true
138+ # Building...
139+ # this builds all libraries and executables (without tests/benchmarks)
140+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
141+ # Building with tests and benchmarks...
142+ # build & run tests, build benchmarks
143+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all
144+ # Testing...
145+ - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all
146+ # cabal check...
147+ - (cd ${PKGDIR_swagger2} && ${CABAL} -vnormal check)
148+ # haddock...
149+ - if [ $HCNUMVER -ge 80400 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all ; fi
150+ # Building without installed constraints for packages in global-db...
151+ - rm -f cabal.project.local
152+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
153+
154+# REGENDATA ("0.10",["--branches","master","--haddock-jobs=>=8.4","--output",".travis.yml","swagger2.cabal"])
155+# EOF
CHANGELOG.md−47
@@ -1,50 +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−
482.6.1
12.6.1
49-----
2-----
50
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
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/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+91−183
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module: Data.OpenApi
2+-- Module: Data.Swagger
3-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
3-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
4-- Stability: experimental
4-- Stability: experimental
5--
5--
@@ -9,7 +9,7 @@
9-- These files can then be used by the Swagger-UI project to display the API
9-- 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.
10-- and Swagger-Codegen to generate clients in various languages.
11-- Additional utilities can also take advantage of the resulting files, such as testing tools.
11-- Additional utilities can also take advantage of the resulting files, such as testing tools.
12−module Data.OpenApi (
12+module Data.Swagger (
13 -- * How to use this library
13 -- * How to use this library
14 -- $howto
14 -- $howto
15
15
@@ -29,15 +29,15 @@ module Data.OpenApi (
29 -- $validation
29 -- $validation
30
30
31 -- * Re-exports
31 -- * Re-exports
32− module Data.OpenApi.Lens,
32+ module Data.Swagger.Lens,
33− module Data.OpenApi.Optics,
33+ module Data.Swagger.Optics,
34− module Data.OpenApi.Operation,
34+ module Data.Swagger.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 Server(..),
42 ServerVariable(..),
42 ServerVariable(..),
43 Components(..),
43 Components(..),
@@ -56,10 +56,10 @@ module Data.OpenApi (
56 TagName,
56 TagName,
57
57
58 -- ** Types and formats
58 -- ** Types and formats
59− OpenApiType(..),
59+ SwaggerType(..),
60 Format,
60 Format,
61 Definitions,
61 Definitions,
62− Style(..),
62+ CollectionFormat(..),
63
63
64 -- ** Parameters
64 -- ** Parameters
65 Param(..),
65 Param(..),
@@ -73,9 +73,10 @@ module Data.OpenApi (
73 Encoding(..),
73 Encoding(..),
74
74
75 -- ** Schemas
75 -- ** Schemas
76+ ParamSchema(..),
76 Schema(..),
77 Schema(..),
77 NamedSchema(..),
78 NamedSchema(..),
78− OpenApiItems(..),
79+ SwaggerItems(..),
79 Xml(..),
80 Xml(..),
80 Pattern,
81 Pattern,
81 AdditionalProperties(..),
82 AdditionalProperties(..),
@@ -85,13 +86,10 @@ module Data.OpenApi (
85 Responses(..),
86 Responses(..),
86 Response(..),
87 Response(..),
87 HttpStatusCode,
88 HttpStatusCode,
88− Link(..),
89− Callback(..),
90
89
91 -- ** Security
90 -- ** Security
92 SecurityScheme(..),
91 SecurityScheme(..),
93 SecuritySchemeType(..),
92 SecuritySchemeType(..),
94− HttpSchemeType(..),
95 SecurityDefinitions(..),
93 SecurityDefinitions(..),
96 SecurityRequirement(..),
94 SecurityRequirement(..),
97
95
@@ -121,14 +119,14 @@ module Data.OpenApi (
121 URL(..),
119 URL(..),
122) where
120) where
123
121
124−import Data.OpenApi.Lens
122+import Data.Swagger.Lens
125−import Data.OpenApi.Optics ()
123+import Data.Swagger.Optics ()
126−import Data.OpenApi.Operation
124+import Data.Swagger.Operation
127−import Data.OpenApi.ParamSchema
125+import Data.Swagger.ParamSchema
128−import Data.OpenApi.Schema
126+import Data.Swagger.Schema
129−import Data.OpenApi.Schema.Validation
127+import Data.Swagger.Schema.Validation
130
128
131−import Data.OpenApi.Internal
129+import Data.Swagger.Internal
132
130
133-- $setup
131-- $setup
134-- >>> import Control.Lens
132-- >>> import Control.Lens
@@ -136,8 +134,6 @@ import Data.OpenApi.Internal
136-- >>> import Data.Monoid
134-- >>> import Data.Monoid
137-- >>> import Data.Proxy
135-- >>> import Data.Proxy
138-- >>> import GHC.Generics
136-- >>> import GHC.Generics
139−-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
140−-- >>> import Data.OpenApi.Internal.Utils
141-- >>> :set -XDeriveGeneric
137-- >>> :set -XDeriveGeneric
142-- >>> :set -XOverloadedStrings
138-- >>> :set -XOverloadedStrings
143-- >>> :set -XOverloadedLists
139-- >>> :set -XOverloadedLists
@@ -154,16 +150,8 @@ import Data.OpenApi.Internal
154--
150--
155-- In this library you can use @'mempty'@ for a default/empty value. For instance:
151-- In this library you can use @'mempty'@ for a default/empty value. For instance:
156--
152--
157−-- >>> BSL.putStrLn $ encodePretty (mempty :: OpenApi)
153+-- >>> encode (mempty :: Swagger)
158−-- {
159−-- "components": {},
160−-- "info": {
161−-- "title": "",
162−-- "version": ""
154+-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"}}"
163−-- },
164−-- "openapi": "3.0.0",
165−-- "paths": {}
166−-- }
167--
155--
168-- As you can see some spec properties (e.g. @"version"@) are there even when the spec is empty.
156-- 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.
157-- That is because these properties are actually required ones.
@@ -171,87 +159,47 @@ import Data.OpenApi.Internal
171-- You /should/ always override the default (empty) value for these properties,
159-- You /should/ always override the default (empty) value for these properties,
172-- although it is not strictly necessary:
160-- although it is not strictly necessary:
173--
161--
174−-- >>> BSL.putStrLn $ encodePretty mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
162+-- >>> encode mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
175−-- {
176−-- "title": "Todo API",
163+-- "{\"version\":\"1.0\",\"title\":\"Todo API\"}"
177−-- "version": "1.0"
178−-- }
179--
164--
180-- You can merge two values using @'mappend'@ or its infix version @('<>')@:
165-- You can merge two values using @'mappend'@ or its infix version @('<>')@:
181--
166--
182−-- >>> BSL.putStrLn $ encodePretty $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
167+-- >>> encode $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
183−-- {
184−-- "title": "Todo API",
185−-- "version": "1.0"
168+-- "{\"version\":\"1.0\",\"title\":\"Todo API\"}"
186−-- }
187−
188--
169--
189-- This can be useful for combining specifications of endpoints into a whole API specification:
170-- This can be useful for combining specifications of endpoints into a whole API specification:
190--
171--
191-- @
172-- @
192-- \-\- /account subAPI specification
173-- \-\- /account subAPI specification
193−-- accountAPI :: OpenApi
174+-- accountAPI :: Swagger
194--
175--
195-- \-\- /task subAPI specification
176-- \-\- /task subAPI specification
196−-- taskAPI :: OpenApi
177+-- taskAPI :: Swagger
197--
178--
198-- \-\- while API specification is just a combination
179-- \-\- while API specification is just a combination
199-- \-\- of subAPIs' specifications
180-- \-\- of subAPIs' specifications
200−-- api :: OpenApi
181+-- api :: Swagger
201-- api = accountAPI <> taskAPI
182-- api = accountAPI <> taskAPI
202-- @
183-- @
203
184
204-- $lens
185-- $lens
205--
186--
206−-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.OpenApi.Optics".
187+-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.Swagger.Optics".
207--
188--
208-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
189-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
209-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses
190-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses
210-- make it fairly simple to construct/modify any part of the specification:
191-- make it fairly simple to construct/modify any part of the specification:
211--
192--
212-- >>> :{
193-- >>> :{
213−-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
194+-- encode $ (mempty :: Swagger)
214−-- & components . schemas .~ [ ("User", mempty & type_ ?~ OpenApiString) ]
195+-- & definitions .~ [ ("User", mempty & type_ ?~ SwaggerString) ]
215-- & paths .~
196-- & paths .~
216-- [ ("/user", mempty & get ?~ (mempty
197-- [ ("/user", mempty & get ?~ (mempty
198+-- & produces ?~ MimeList ["application/json"]
217−-- & at 200 ?~ ("OK" & _Inline.content.at "application/json" ?~ (mempty & schema ?~ Ref (Reference "User")))
199+-- & at 200 ?~ ("OK" & _Inline.schema ?~ Ref (Reference "User"))
218-- & at 404 ?~ "User info not found")) ]
200-- & at 404 ?~ "User info not found")) ]
219-- :}
201-- :}
220−-- {
202+-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"produces\":[\"application/json\"],\"responses\":{\"404\":{\"description\":\"User info not found\"},\"200\":{\"schema\":{\"$ref\":\"#/definitions/User\"},\"description\":\"OK\"}}}}},\"definitions\":{\"User\":{\"type\":\"string\"}}}"
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--
203--
256-- In the snippet above we declare an API with a single path @/user@. This path provides method @GET@
204-- 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
205-- which produces @application/json@ output. It should respond with code @200@ and body specified
@@ -263,34 +211,30 @@ import Data.OpenApi.Internal
263-- common field is @'description'@. Many components of a Swagger specification
211-- common field is @'description'@. Many components of a Swagger specification
264-- can have descriptions, and you can use the same name for them:
212-- can have descriptions, and you can use the same name for them:
265--
213--
266−-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & description .~ "No content"
214+-- >>> encode $ (mempty :: Response) & description .~ "No content"
267−-- {
268−-- "description": "No content"
215+-- "{\"description\":\"No content\"}"
269−-- }
270-- >>> :{
216-- >>> :{
271−-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)
217+-- encode $ (mempty :: Schema)
272−-- & type_ ?~ OpenApiBoolean
218+-- & type_ ?~ SwaggerBoolean
273-- & description ?~ "To be or not to be"
219-- & description ?~ "To be or not to be"
274-- :}
220-- :}
275−-- {
276−-- "description": "To be or not to be",
221+-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"
277−-- "type": "boolean"
278−-- }
222+--
223+-- @'ParamSchema'@ is basically the /base schema specification/ and many types contain it (see @'HasParamSchema'@).
224+-- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.
225+-- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:
226+--
227+-- >>> encode $ (mempty :: Header) & type_ ?~ SwaggerNumber
228+-- "{\"type\":\"number\"}"
279--
229--
280-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
230-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
281-- have direct access to it via @'at' code@. Example:
231-- have direct access to it via @'at' code@. Example:
282--
232--
283-- >>> :{
233-- >>> :{
284−-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)
234+-- encode $ (mempty :: Operation)
285-- & at 404 ?~ "Not found"
235-- & at 404 ?~ "Not found"
286-- :}
236-- :}
287−-- {
288−-- "responses": {
289−-- "404": {
290−-- "description": "Not found"
237+-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"
291−-- }
292−-- }
293−-- }
294--
238--
295-- You might've noticed that @'type_'@ has an extra underscore in its name
239-- You might've noticed that @'type_'@ has an extra underscore in its name
296-- compared to, say, @'description'@ field accessor.
240-- compared to, say, @'description'@ field accessor.
@@ -306,7 +250,7 @@ import Data.OpenApi.Internal
306-- @'ParamSchema'@ and @'Schema'@ are the two core types for data model specification.
250-- @'ParamSchema'@ and @'Schema'@ are the two core types for data model specification.
307--
251--
308-- @'ParamSchema' t@ specifies all the common properties, available for every data schema.
252-- @'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'@).
253+-- The @t@ parameter imposes some restrictions on @type@ and @items@ properties (see @'SwaggerType'@ and @'SwaggerItems'@).
310--
254--
311-- @'Schema'@ is used for request and response bodies and allows specifying objects
255-- @'Schema'@ is used for request and response bodies and allows specifying objects
312-- with properties in addition to what @'ParamSchema'@ provides.
256-- with properties in addition to what @'ParamSchema'@ provides.
@@ -337,81 +281,45 @@ import Data.OpenApi.Internal
337-- >>> data Person = Person { name :: String, age :: Integer } deriving Generic
281-- >>> data Person = Person { name :: String, age :: Integer } deriving Generic
338-- >>> instance ToJSON Person
282-- >>> instance ToJSON Person
339-- >>> instance ToSchema Person
283-- >>> instance ToSchema Person
340−-- >>> BSL.putStrLn $ encodePretty (Person "David" 28)
284+-- >>> encode (Person "David" 28)
341−-- {
342−-- "age": 28,
343−-- "name": "David"
285+-- "{\"age\":28,\"name\":\"David\"}"
344−-- }
345−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Person)
286+-- >>> encode $ toSchema (Proxy :: Proxy Person)
346−-- {
287+-- "{\"required\":[\"name\",\"age\"],\"properties\":{\"name\":{\"type\":\"string\"},\"age\":{\"type\":\"integer\"}},\"type\":\"object\"}"
347−-- "properties": {
288+--
348−-- "age": {
289+-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a
349−-- "type": "integer"
290+-- schema for basic enums like
350−-- },
351−-- "name": {
352−-- "type": "string"
353−-- }
354−-- },
355−-- "required": [
356−-- "name",
357−-- "age"
291+--
358−-- ],
292+-- >>> data SampleEnum = ChoiceOne | ChoiceTwo deriving Generic
359−-- "type": "object"
293+-- >>> instance ToSchema SampleEnum
360−-- }
294+-- >>> instance ToJSON SampleEnum
361−--
295+--
362−-- This package implements OpenAPI 3.0 spec, which supports @oneOf@ in schemas, allowing any sum types
296+-- and for sum types that have constructors with values
363−-- to be faithfully represented. All sum encodings supported by @aeson@ are supported here as well, with
297+--
364−-- an exception of 'Data.Aeson.TwoElemArray', since OpenAPI spec does not support heterogeneous arrays.
298+-- >>> data SampleSumType = ChoiceInt Int | ChoiceString String deriving Generic
365−--
299+-- >>> instance ToSchema SampleSumType
366−-- An example with 'Data.Aeson.TaggedObject' encoding:
300+-- >>> instance ToJSON SampleSumType
301+--
302+-- we can not derive a valid schema for a mix of the above. The following will result in a type error
303+--
304+-- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic
305+-- >>> instance ToSchema BadMixedType
306+-- ...
307+-- ... error:
308+-- ... • Cannot derive Generic-based Swagger Schema for BadMixedType
309+-- ... BadMixedType is a mixed sum type (has both unit and non-unit constructors).
310+-- ... Swagger does not have a good representation for these types.
311+-- ... Use genericDeclareNamedSchemaUnrestricted if you want to derive schema
312+-- ... that matches aeson's Generic-based toJSON,
313+-- ... but that's not supported by some Swagger tools.
314+-- ...
315+-- ... In the instance declaration for ‘ToSchema BadMixedType’
316+--
317+-- We can use 'genericDeclareNamedSchemaUnrestricted' to try our best to represent this type as a Swagger Schema and match 'ToJSON':
367−--
318+--
368−-- >>> data Error = ErrorNoUser { userId :: Int } | ErrorAccessDenied { requiredPermission :: String } deriving Generic
319+-- >>> data BadMixedType = ChoiceBool Bool | JustTag deriving Generic
369−-- >>> instance ToJSON Error
320+-- >>> instance ToSchema BadMixedType where declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
370−-- >>> instance ToSchema Error
321+-- >>> instance ToJSON BadMixedType
371−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Error)
322+--
372−-- {
373−-- "oneOf": [
374−-- {
375−-- "properties": {
376−-- "tag": {
377−-- "enum": [
378−-- "ErrorNoUser"
379−-- ],
380−-- "type": "string"
381−-- },
382−-- "userId": {
383−-- "maximum": 9223372036854775807,
384−-- "minimum": -9223372036854775808,
385−-- "type": "integer"
386−-- }
387−-- },
388−-- "required": [
389−-- "userId",
390−-- "tag"
391−-- ],
392−-- "type": "object"
393−-- },
394−-- {
395−-- "properties": {
396−-- "requiredPermission": {
397−-- "type": "string"
398−-- },
399−-- "tag": {
400−-- "enum": [
401−-- "ErrorAccessDenied"
402−-- ],
403−-- "type": "string"
404−-- }
405−-- },
406−-- "required": [
407−-- "requiredPermission",
408−-- "tag"
409−-- ],
410−-- "type": "object"
411−-- }
412−-- ],
413−-- "type": "object"
414−-- }
415
323
416-- $manipulation
324-- $manipulation
417-- Sometimes you have to work with an imported or generated @'Swagger'@.
325-- Sometimes you have to work with an imported or generated @'Swagger'@.
@@ -419,10 +327,10 @@ import Data.OpenApi.Internal
419-- for a type-level servant API.
327-- for a type-level servant API.
420--
328--
421-- Lenses and prisms can be used to manipulate such specification to add additional information, tags, extra responses, etc.
329-- 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.
330+-- To facilitate common needs, @"Data.Swagger.Operation"@ module provides useful helpers.
423
331
424-- $validation
332-- $validation
425-- While @'ToParamSchema'@ and @'ToSchema'@ provide means to easily obtain schemas for Haskell types,
333-- 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.
334-- there is no static mechanism to ensure those instances correspond to the @'ToHttpApiData'@ or @'ToJSON'@ instances.
427--
335--
428−-- @"Data.OpenApi.Schema.Validation"@ addresses @'ToJSON'@/@'ToSchema'@ validation.
336+-- @"Data.Swagger.Schema.Validation"@ addresses @'ToJSON'@/@'ToSchema'@ validation.
src/Data/OpenApi/Declare.hs → src/Data/Swagger/Declare.hsrenamed+2−2
@@ -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
src/Data/OpenApi/Internal.hs → src/Data/Swagger/Internal.hsrenamed+391−415
@@ -1,6 +1,6 @@
1−{-# LANGUAGE CPP #-}
2{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3+{-# LANGUAGE DeriveFunctor #-}
4{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE DeriveGeneric #-}
5{-# LANGUAGE DeriveTraversable #-}
5{-# LANGUAGE DeriveTraversable #-}
6{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleContexts #-}
@@ -14,91 +14,87 @@
14{-# LANGUAGE TemplateHaskell #-}
14{-# LANGUAGE TemplateHaskell #-}
15{-# LANGUAGE TypeFamilies #-}
15{-# LANGUAGE TypeFamilies #-}
16{-# LANGUAGE UndecidableInstances #-}
16{-# LANGUAGE UndecidableInstances #-}
17−module Data.OpenApi.Internal where
17+module Data.Swagger.Internal where
18
18
19import Prelude ()
19import Prelude ()
20import Prelude.Compat
20import Prelude.Compat
21
21
22+import Control.Lens ((&), (.~), (?~))
22import Control.Applicative
23import Control.Applicative
23−import Control.Lens ((&), (.~), (?~))
24−import Data.Aeson hiding (Encoding)
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
25+import qualified Data.Aeson.Types as JSON
29−import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable,
26+import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
30− constrIndex, mkConstr, mkDataType)
31−import Data.Hashable (Hashable (..))
27+import Data.Hashable (Hashable)
32−import qualified Data.HashMap.Strict as HashMap
28+import qualified Data.HashMap.Strict as HashMap
33−import Data.HashSet.InsOrd (InsOrdHashSet)
29+import Data.HashSet.InsOrd (InsOrdHashSet)
34−import Data.Map (Map)
30+import Data.Map (Map)
35−import qualified Data.Map as Map
31+import qualified Data.Map as Map
36−import Data.Monoid (Monoid (..))
32+import Data.Monoid (Monoid (..))
37−import Data.Scientific (Scientific)
38−import Data.Semigroup.Compat (Semigroup (..))
33+import Data.Semigroup.Compat (Semigroup (..))
34+import Data.Scientific (Scientific)
39−import Data.String (IsString (..))
35+import Data.String (IsString(..))
40−import Data.Text (Text)
36+import Data.Text (Text)
41−import qualified Data.Text as Text
37+import qualified Data.Text as Text
42−import Data.Text.Encoding (encodeUtf8)
43−import GHC.Generics (Generic)
38+import GHC.Generics (Generic)
44−import Network.HTTP.Media (MediaType, mainType, parameters, parseAccept, subType, (//),
39+import Network.Socket (HostName, PortNumber)
45− (/:))
40+import Network.HTTP.Media (MediaType)
46−import Network.Socket (HostName, PortNumber)
47−import Text.Read (readMaybe)
41+import Text.Read (readMaybe)
48
42
49import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
43import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
50import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
44import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
51
45
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
58import Generics.SOP.TH (deriveGeneric)
46import Generics.SOP.TH (deriveGeneric)
47+import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON
48+ ,sopSwaggerGenericToJSONWithOpts
49+ ,sopSwaggerGenericParseJSON
50+ ,HasSwaggerAesonOptions(..)
51+ ,AesonDefaultValue(..)
52+ ,mkSwaggerAesonOptions
53+ ,saoAdditionalPairs
54+ ,saoSubObject)
55+import Data.Swagger.Internal.Utils
56+import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)
59
57
60-- $setup
58-- $setup
61-- >>> :seti -XDataKinds
59-- >>> :seti -XDataKinds
62-- >>> import Data.Aeson
60-- >>> import Data.Aeson
63−-- >>> import Data.ByteString.Lazy.Char8 as BSL
64−-- >>> import Data.OpenApi.Internal.Utils
65
61
66-- | A list of definitions that can be used in references.
62-- | A list of definitions that can be used in references.
67type Definitions = InsOrdHashMap Text
63type Definitions = InsOrdHashMap Text
68
64
69-- | This is the root document object for the API specification.
65-- | This is the root document object for the API specification.
70−data OpenApi = OpenApi
66+data Swagger = Swagger
71 { -- | Provides metadata about the API.
67 { -- | Provides metadata about the API.
72 -- The metadata can be used by the clients if needed.
68 -- The metadata can be used by the clients if needed.
73− _openApiInfo :: Info
69+ _swaggerInfo :: Info
74
70
75 -- | An array of Server Objects, which provide connectivity information
71 -- | 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,
72 -- 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 @/@.
73 -- the default value would be a 'Server' object with a url value of @/@.
78− , _openApiServers :: [Server]
74+ , _swaggerServers :: [Server]
79
75
80 -- | The available paths and operations for the API.
76 -- | The available paths and operations for the API.
81− , _openApiPaths :: InsOrdHashMap FilePath PathItem
77+ , _swaggerPaths :: InsOrdHashMap FilePath PathItem
82
78
83 -- | An element to hold various schemas for the specification.
79 -- | An element to hold various schemas for the specification.
84− , _openApiComponents :: Components
80+ , _swaggerComponents :: Components
85
81
86 -- | A declaration of which security mechanisms can be used across the API.
82 -- | 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.
83 -- 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.
84 -- Only one of the security requirement objects need to be satisfied to authorize a request.
89 -- Individual operations can override this definition.
85 -- Individual operations can override this definition.
90 -- To make security optional, an empty security requirement can be included in the array.
86 -- To make security optional, an empty security requirement can be included in the array.
91− , _openApiSecurity :: [SecurityRequirement]
87+ , _swaggerSecurity :: [SecurityRequirement]
92
88
93 -- | A list of tags used by the specification with additional metadata.
89 -- | 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.
90 -- 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.
91 -- 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.
92 -- 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.
93 -- Each tag name in the list MUST be unique.
98− , _openApiTags :: InsOrdHashSet Tag
94+ , _swaggerTags :: InsOrdHashSet Tag
99
95
100 -- | Additional external documentation.
96 -- | Additional external documentation.
101− , _openApiExternalDocs :: Maybe ExternalDocs
97+ , _swaggerExternalDocs :: Maybe ExternalDocs
102 } deriving (Eq, Show, Generic, Data, Typeable)
98 } deriving (Eq, Show, Generic, Data, Typeable)
103
99
104-- | The object provides metadata about the API.
100-- | The object provides metadata about the API.
@@ -195,10 +191,10 @@ data Components = Components
195 , _componentsParameters :: Definitions Param
191 , _componentsParameters :: Definitions Param
196 , _componentsExamples :: Definitions Example
192 , _componentsExamples :: Definitions Example
197 , _componentsRequestBodies :: Definitions RequestBody
193 , _componentsRequestBodies :: Definitions RequestBody
198− , _componentsHeaders :: Definitions Header
194+ , _componentsHeader :: Definitions Header
199− , _componentsSecuritySchemes :: SecurityDefinitions
195+ , _componentsSecuritySchemes :: Definitions SecurityScheme
200− , _componentsLinks :: Definitions Link
196+-- , _componentsLinks
201− , _componentsCallbacks :: Definitions Callback
197+-- , _componentsCallbacks
202 } deriving (Eq, Show, Generic, Data, Typeable)
198 } deriving (Eq, Show, Generic, Data, Typeable)
203
199
204-- | Describes the operations available on a single path.
200-- | Describes the operations available on a single path.
@@ -288,11 +284,7 @@ data Operation = Operation
288 -- | The list of possible responses as they are returned from executing this operation.
284 -- | The list of possible responses as they are returned from executing this operation.
289 , _operationResponses :: Responses
285 , _operationResponses :: Responses
290
286
291− -- | A map of possible out-of band callbacks related to the parent operation.
287+ -- TODO callbacks
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
288
297 -- | Declares this operation to be deprecated.
289 -- | Declares this operation to be deprecated.
298 -- Usage of the declared operation should be refrained.
290 -- Usage of the declared operation should be refrained.
@@ -312,22 +304,6 @@ data Operation = Operation
312 , _operationServers :: [Server]
304 , _operationServers :: [Server]
313 } deriving (Eq, Show, Generic, Data, Typeable)
305 } deriving (Eq, Show, Generic, Data, Typeable)
314
306
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.
307-- | Describes a single request body.
332data RequestBody = RequestBody
308data RequestBody = RequestBody
333 { -- | A brief description of the request body. This could contain examples of use.
309 { -- | A brief description of the request body. This could contain examples of use.
@@ -337,11 +313,9 @@ data RequestBody = RequestBody
337 -- | The content of the request body.
313 -- | The content of the request body.
338 -- The key is a media type or media type range and the value describes it.
314 -- 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.
315 -- For requests that match multiple keys, only the most specific key is applicable.
340− -- e.g. @text/plain@ overrides @text/\*@
316+ -- e.g. @text/plain@ overrides @text/*@
341− , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject
317+ , _requestBodyContent :: InsOrdHashMap {-MediaType-} Text MediaTypeObject -- FIXME Data MediaType
342
318
343− -- | Determines if the request body is required in the request.
344− -- Defaults to 'False'.
345 , _requestBodyRequired :: Maybe Bool
319 , _requestBodyRequired :: Maybe Bool
346 } deriving (Eq, Show, Generic, Data, Typeable)
320 } deriving (Eq, Show, Generic, Data, Typeable)
347
321
@@ -364,29 +338,6 @@ data MediaTypeObject = MediaTypeObject
364 , _mediaTypeObjectEncoding :: InsOrdHashMap Text Encoding
338 , _mediaTypeObjectEncoding :: InsOrdHashMap Text Encoding
365 } deriving (Eq, Show, Generic, Data, Typeable)
339 } deriving (Eq, Show, Generic, Data, Typeable)
366
340
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−
390data Encoding = Encoding
341data Encoding = Encoding
391 { -- | The Content-Type for encoding a specific property.
342 { -- | The Content-Type for encoding a specific property.
392 -- Default value depends on the property type: for @string@
343 -- Default value depends on the property type: for @string@
@@ -394,8 +345,8 @@ data Encoding = Encoding
394 -- for other primitive types – @text/plain@; for object - @application/json@;
345 -- for other primitive types – @text/plain@; for object - @application/json@;
395 -- for array – the default is defined based on the inner type.
346 -- for array – the default is defined based on the inner type.
396 -- The value can be a specific media type (e.g. @application/json@),
347 -- 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.
348+ -- a wildcard media type (e.g. @image/*@), or a comma-separated list of the two types.
398− _encodingContentType :: Maybe MediaType
349+ _encodingContentType :: Maybe Text
399
350
400 -- | A map allowing additional information to be provided as headers,
351 -- | A map allowing additional information to be provided as headers,
401 -- for example @Content-Disposition@. @Content-Type@ is described separately
352 -- for example @Content-Disposition@. @Content-Type@ is described separately
@@ -404,11 +355,11 @@ data Encoding = Encoding
404 , _encodingHeaders :: InsOrdHashMap Text (Referenced Header)
355 , _encodingHeaders :: InsOrdHashMap Text (Referenced Header)
405
356
406 -- | Describes how a specific property value will be serialized depending on its type.
357 -- | Describes how a specific property value will be serialized depending on its type.
407− -- See 'Param' Object for details on the style property.
358+ -- See Parameter Object for details on the style property.
408 -- The behavior follows the same values as query parameters, including default values.
359 -- The behavior follows the same values as query parameters, including default values.
409 -- This property SHALL be ignored if the request body media type
360 -- This property SHALL be ignored if the request body media type
410 -- is not @application/x-www-form-urlencoded@.
361 -- is not @application/x-www-form-urlencoded@.
411− , _encodingStyle :: Maybe Style
362+ , _encodingStyle :: Maybe Text -- TODO enum
412
363
413 -- | When this is true, property values of type @array@ or @object@ generate
364 -- | When this is true, property values of type @array@ or @object@ generate
414 -- separate parameters for each value of the array,
365 -- separate parameters for each value of the array,
@@ -434,15 +385,18 @@ mimeListConstr :: Constr
434mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
385mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
435
386
436mimeListDataType :: DataType
387mimeListDataType :: DataType
437−mimeListDataType = mkDataType "Data.OpenApi.MimeList" [mimeListConstr]
388+mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
438
389
439instance Data MimeList where
390instance Data MimeList where
440 gunfold k z c = case constrIndex c of
391 gunfold k z c = case constrIndex c of
441− 1 -> k (z (MimeList . map fromString))
392+ 1 -> k (z (\xs -> MimeList (map fromString xs)))
442 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
393 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
443 toConstr (MimeList _) = mimeListConstr
394 toConstr (MimeList _) = mimeListConstr
444 dataTypeOf _ = mimeListDataType
395 dataTypeOf _ = mimeListDataType
445
396
397+-- TODO style
398+-- TODO example
399+
446-- | Describes a single operation parameter.
400-- | Describes a single operation parameter.
447-- A unique parameter is defined by a combination of a name and location.
401-- A unique parameter is defined by a combination of a name and location.
448data Param = Param
402data Param = Param
@@ -452,7 +406,7 @@ data Param = Param
452
406
453 -- | A brief description of the parameter.
407 -- | A brief description of the parameter.
454 -- This could contain examples of use.
408 -- This could contain examples of use.
455− -- CommonMark syntax MAY be used for rich text representation.
409+ -- GFM syntax can be used for rich text representation.
456 , _paramDescription :: Maybe Text
410 , _paramDescription :: Maybe Text
457
411
458 -- | Determines whether this parameter is mandatory.
412 -- | Determines whether this parameter is mandatory.
@@ -470,49 +424,10 @@ data Param = Param
470 -- | Sets the ability to pass empty-valued parameters.
424 -- | Sets the ability to pass empty-valued parameters.
471 -- This is valid only for 'ParamQuery' parameters and allows sending
425 -- This is valid only for 'ParamQuery' parameters and allows sending
472 -- a parameter with an empty value. Default value is @false@.
426 -- a parameter with an empty value. Default value is @false@.
473− , _paramAllowEmptyValue :: Maybe Bool
427+ , _paramOtherSchemaAllowEmptyValue :: 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
428
482 -- | Parameter schema.
429 -- | Parameter schema.
483 , _paramSchema :: Maybe (Referenced Schema)
430 , _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)
431 } deriving (Eq, Show, Generic, Data, Typeable)
517
432
518data Example = Example
433data Example = Example
@@ -537,64 +452,138 @@ data Example = Example
537 , _exampleExternalValue :: Maybe URL
452 , _exampleExternalValue :: Maybe URL
538 } deriving (Eq, Show, Generic, Typeable, Data)
453 } deriving (Eq, Show, Generic, Typeable, Data)
539
454
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.
455+-- | Items for @'SwaggerArray'@ schemas.
577--
456--
578−-- __Warning__: OpenAPI 3.0 does not support tuple arrays. However, OpenAPI 3.1 will, as
457+-- @'SwaggerItemsPrimitive'@ should be used only for query params, headers and path pieces.
579−-- it will incorporate Json Schema mostly verbatim.
458+-- The @'CollectionFormat' t@ parameter specifies how elements of an array should be displayed.
459+-- Note that @fmt@ in @'SwaggerItemsPrimitive' fmt schema@ specifies format for elements of type @schema@.
460+-- This is different from the original Swagger's <http://swagger.io/specification/#itemsObject Items Object>.
580--
461--
581−-- @'OpenApiItemsObject'@ should be used to specify homogenous array @'Schema'@s.
462+-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
582--
463--
583−-- @'OpenApiItemsArray'@ should be used to specify tuple @'Schema'@s.
464+-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
584−data OpenApiItems where
465+data SwaggerItems t where
585− OpenApiItemsObject :: Referenced Schema -> OpenApiItems
466+ SwaggerItemsPrimitive :: Maybe (CollectionFormat k) -> ParamSchema k-> SwaggerItems k
586− OpenApiItemsArray :: [Referenced Schema] -> OpenApiItems
467+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems 'SwaggerKindSchema
587− deriving (Eq, Show, Typeable, Data)
468+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems 'SwaggerKindSchema
588−
469+ deriving (Typeable)
589−data OpenApiType where
470+
590− OpenApiString :: OpenApiType
471+deriving instance Eq (SwaggerItems t)
591− OpenApiNumber :: OpenApiType
472+deriving instance Show (SwaggerItems t)
592− OpenApiInteger :: OpenApiType
473+--deriving instance Typeable (SwaggerItems t)
593− OpenApiBoolean :: OpenApiType
474+
594− OpenApiArray :: OpenApiType
475+swaggerItemsPrimitiveConstr :: Constr
595− OpenApiNull :: OpenApiType
476+swaggerItemsPrimitiveConstr = mkConstr swaggerItemsDataType "SwaggerItemsPrimitive" [] Prefix
596− OpenApiObject :: OpenApiType
477+
597− deriving (Eq, Show, Typeable, Generic, Data)
478+swaggerItemsObjectConstr :: Constr
479+swaggerItemsObjectConstr = mkConstr swaggerItemsDataType "SwaggerItemsObject" [] Prefix
480+
481+swaggerItemsArrayConstr :: Constr
482+swaggerItemsArrayConstr = mkConstr swaggerItemsDataType "SwaggerItemsArray" [] Prefix
483+
484+swaggerItemsDataType :: DataType
485+swaggerItemsDataType = mkDataType "Data.Swagger.SwaggerItems" [swaggerItemsPrimitiveConstr]
486+
487+-- Note: unfortunately we have to write these Data instances by hand,
488+-- to get better contexts / avoid duplicate name when using standalone deriving
489+
490+instance Data t => Data (SwaggerItems ('SwaggerKindNormal t)) where
491+ -- TODO: define gfoldl
492+ gunfold k z c = case constrIndex c of
493+ 1 -> k (k (z SwaggerItemsPrimitive))
494+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems t)."
495+ toConstr _ = swaggerItemsPrimitiveConstr
496+ dataTypeOf _ = swaggerItemsDataType
497+
498+-- SwaggerItems SwaggerKindParamOtherSchema can be constructed using SwaggerItemsPrimitive only
499+instance Data (SwaggerItems 'SwaggerKindParamOtherSchema) where
500+ -- TODO: define gfoldl
501+ gunfold k z c = case constrIndex c of
502+ 1 -> k (k (z SwaggerItemsPrimitive))
503+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindParamOtherSchema)."
504+ toConstr _ = swaggerItemsPrimitiveConstr
505+ dataTypeOf _ = swaggerItemsDataType
506+
507+instance Data (SwaggerItems 'SwaggerKindSchema) where
508+ gfoldl _ _ (SwaggerItemsPrimitive _ _) = error " Data.Data.gfoldl: Constructor SwaggerItemsPrimitive used to construct SwaggerItems SwaggerKindSchema"
509+ gfoldl k z (SwaggerItemsObject ref) = z SwaggerItemsObject `k` ref
510+ gfoldl k z (SwaggerItemsArray ref) = z SwaggerItemsArray `k` ref
511+
512+ gunfold k z c = case constrIndex c of
513+ 2 -> k (z SwaggerItemsObject)
514+ 3 -> k (z SwaggerItemsArray)
515+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type (SwaggerItems SwaggerKindSchema)."
516+
517+ toConstr (SwaggerItemsPrimitive _ _) = error "Not supported"
518+ toConstr (SwaggerItemsObject _) = swaggerItemsObjectConstr
519+ toConstr (SwaggerItemsArray _) = swaggerItemsArrayConstr
520+
521+ dataTypeOf _ = swaggerItemsDataType
522+
523+-- | Type used as a kind to avoid overlapping instances.
524+data SwaggerKind t
525+ = SwaggerKindNormal t
526+ | SwaggerKindParamOtherSchema
527+ | SwaggerKindSchema
528+ deriving (Typeable)
529+
530+deriving instance Typeable 'SwaggerKindNormal
531+deriving instance Typeable 'SwaggerKindParamOtherSchema
532+deriving instance Typeable 'SwaggerKindSchema
533+
534+-- TODO remove
535+type family SwaggerKindType (k :: SwaggerKind *) :: *
536+type instance SwaggerKindType ('SwaggerKindNormal t) = t
537+type instance SwaggerKindType 'SwaggerKindSchema = Schema
538+--type instance SwaggerKindType 'SwaggerKindParamOtherSchema = ParamOtherSchema
539+
540+data SwaggerType t where
541+ SwaggerString :: SwaggerType t
542+ SwaggerNumber :: SwaggerType t
543+ SwaggerInteger :: SwaggerType t
544+ SwaggerBoolean :: SwaggerType t
545+ SwaggerArray :: SwaggerType t
546+ SwaggerFile :: SwaggerType 'SwaggerKindParamOtherSchema
547+ SwaggerNull :: SwaggerType 'SwaggerKindSchema
548+ SwaggerObject :: SwaggerType 'SwaggerKindSchema
549+ deriving (Typeable)
550+
551+deriving instance Eq (SwaggerType t)
552+deriving instance Show (SwaggerType t)
553+
554+swaggerTypeConstr :: Data (SwaggerType t) => SwaggerType t -> Constr
555+swaggerTypeConstr t = mkConstr (dataTypeOf t) (show t) [] Prefix
556+
557+swaggerTypeDataType :: {- Data (SwaggerType t) => -} SwaggerType t -> DataType
558+swaggerTypeDataType _ = mkDataType "Data.Swagger.SwaggerType" swaggerTypeConstrs
559+
560+swaggerCommonTypes :: [SwaggerType k]
561+swaggerCommonTypes = [SwaggerString, SwaggerNumber, SwaggerInteger, SwaggerBoolean, SwaggerArray]
562+
563+swaggerParamTypes :: [SwaggerType 'SwaggerKindParamOtherSchema]
564+swaggerParamTypes = swaggerCommonTypes ++ [SwaggerFile]
565+
566+swaggerSchemaTypes :: [SwaggerType 'SwaggerKindSchema]
567+swaggerSchemaTypes = swaggerCommonTypes ++ [error "SwaggerFile is invalid SwaggerType Schema", SwaggerNull, SwaggerObject]
568+
569+swaggerTypeConstrs :: [Constr]
570+swaggerTypeConstrs = map swaggerTypeConstr (swaggerCommonTypes :: [SwaggerType 'SwaggerKindSchema])
571+ ++ [swaggerTypeConstr SwaggerFile, swaggerTypeConstr SwaggerNull, swaggerTypeConstr SwaggerObject]
572+
573+instance Typeable t => Data (SwaggerType ('SwaggerKindNormal t)) where
574+ gunfold = gunfoldEnum "SwaggerType" swaggerCommonTypes
575+ toConstr = swaggerTypeConstr
576+ dataTypeOf = swaggerTypeDataType
577+
578+instance Data (SwaggerType 'SwaggerKindParamOtherSchema) where
579+ gunfold = gunfoldEnum "SwaggerType ParamOtherSchema" swaggerParamTypes
580+ toConstr = swaggerTypeConstr
581+ dataTypeOf = swaggerTypeDataType
582+
583+instance Data (SwaggerType 'SwaggerKindSchema) where
584+ gunfold = gunfoldEnum "SwaggerType Schema" swaggerSchemaTypes
585+ toConstr = swaggerTypeConstr
586+ dataTypeOf = swaggerTypeDataType
598
587
599data ParamLocation
588data ParamLocation
600 = -- | Parameters that are appended to the URL.
589 = -- | Parameters that are appended to the URL.
@@ -612,6 +601,42 @@ data ParamLocation
612
601
613type Format = Text
602type Format = Text
614
603
604+-- | Determines the format of the array.
605+data CollectionFormat t where
606+ -- Comma separated values: @foo,bar@.
607+ CollectionCSV :: CollectionFormat t
608+ -- Space separated values: @foo bar@.
609+ CollectionSSV :: CollectionFormat t
610+ -- Tab separated values: @foo\\tbar@.
611+ CollectionTSV :: CollectionFormat t
612+ -- Pipe separated values: @foo|bar@.
613+ CollectionPipes :: CollectionFormat t
614+ -- Corresponds to multiple parameter instances
615+ -- instead of multiple values for a single instance @foo=bar&foo=baz@.
616+ -- This is valid only for parameters in @'ParamQuery'@ or @'ParamFormData'@.
617+ CollectionMulti :: CollectionFormat 'SwaggerKindParamOtherSchema
618+ deriving (Typeable)
619+
620+deriving instance Eq (CollectionFormat t)
621+deriving instance Show (CollectionFormat t)
622+
623+collectionFormatConstr :: CollectionFormat t -> Constr
624+collectionFormatConstr cf = mkConstr collectionFormatDataType (show cf) [] Prefix
625+
626+collectionFormatDataType :: DataType
627+collectionFormatDataType = mkDataType "Data.Swagger.CollectionFormat" $
628+ map collectionFormatConstr collectionCommonFormats
629+
630+collectionCommonFormats :: [CollectionFormat t]
631+collectionCommonFormats = [ CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes ]
632+
633+instance Data t => Data (CollectionFormat ('SwaggerKindNormal t)) where
634+ gunfold = gunfoldEnum "CollectionFormat" collectionCommonFormats
635+ toConstr = collectionFormatConstr
636+ dataTypeOf _ = collectionFormatDataType
637+
638+deriving instance Data (CollectionFormat 'SwaggerKindParamOtherSchema)
639+
615type ParamName = Text
640type ParamName = Text
616
641
617data Schema = Schema
642data Schema = Schema
@@ -638,33 +663,9 @@ data Schema = Schema
638 , _schemaMaxProperties :: Maybe Integer
663 , _schemaMaxProperties :: Maybe Integer
639 , _schemaMinProperties :: Maybe Integer
664 , _schemaMinProperties :: Maybe Integer
640
665
641− , -- | Declares the value of the parameter that the server will use if none is provided,
666+ , _schemaParamSchema :: ParamSchema 'SwaggerKindSchema
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)
667 } deriving (Eq, Show, Generic, Data, Typeable)
664
668
665−-- | Regex pattern for @string@ type.
666−type Pattern = Text
667−
668data Discriminator = Discriminator
669data Discriminator = Discriminator
669 { -- | The name of the property in the payload that will hold the discriminator value.
670 { -- | The name of the property in the payload that will hold the discriminator value.
670 _discriminatorPropertyName :: Text
671 _discriminatorPropertyName :: Text
@@ -680,9 +681,39 @@ data NamedSchema = NamedSchema
680 , _namedSchemaSchema :: Schema
681 , _namedSchemaSchema :: Schema
681 } deriving (Eq, Show, Generic, Data, Typeable)
682 } deriving (Eq, Show, Generic, Data, Typeable)
682
683
684+-- | Regex pattern for @string@ type.
685+type Pattern = Text
686+
687+data ParamSchema (t :: SwaggerKind *) = ParamSchema
688+ { -- | Declares the value of the parameter that the server will use if none is provided,
689+ -- for example a @"count"@ to control the number of results per page might default to @100@
690+ -- if not supplied by the client in the request.
691+ -- (Note: "default" has no meaning for required parameters.)
692+ -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
693+ _paramSchemaDefault :: Maybe Value
694+
695+ , _paramSchemaType :: Maybe (SwaggerType t)
696+ , _paramSchemaFormat :: Maybe Format
697+ , _paramSchemaItems :: Maybe (SwaggerItems t)
698+ , _paramSchemaMaximum :: Maybe Scientific
699+ , _paramSchemaExclusiveMaximum :: Maybe Bool
700+ , _paramSchemaMinimum :: Maybe Scientific
701+ , _paramSchemaExclusiveMinimum :: Maybe Bool
702+ , _paramSchemaMaxLength :: Maybe Integer
703+ , _paramSchemaMinLength :: Maybe Integer
704+ , _paramSchemaPattern :: Maybe Pattern
705+ , _paramSchemaMaxItems :: Maybe Integer
706+ , _paramSchemaMinItems :: Maybe Integer
707+ , _paramSchemaUniqueItems :: Maybe Bool
708+ , _paramSchemaEnum :: Maybe [Value]
709+ , _paramSchemaMultipleOf :: Maybe Scientific
710+ } deriving (Eq, Show, Generic, Typeable)
711+
712+deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
713+
683data Xml = Xml
714data Xml = Xml
684 { -- | Replaces the name of the element/attribute used for the described schema property.
715 { -- | 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.
716+ -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.
686 -- When defined alongside type being array (outside the items),
717 -- When defined alongside type being array (outside the items),
687 -- it will affect the wrapping element and only if wrapped is true.
718 -- it will affect the wrapping element and only if wrapped is true.
688 -- If wrapped is false, it will be ignored.
719 -- If wrapped is false, it will be ignored.
@@ -734,46 +765,25 @@ data Response = Response
734 -- | A map containing descriptions of potential response payloads.
765 -- | A map containing descriptions of potential response payloads.
735 -- The key is a media type or media type range and the value describes it.
766 -- 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.
767 -- For responses that match multiple keys, only the most specific key is applicable.
737− -- e.g. @text/plain@ overrides @text/\*@.
768+ -- e.g. @text/plain@ overrides @text/*@.
738− , _responseContent :: InsOrdHashMap MediaType MediaTypeObject
769+ , _responseContent :: InsOrdHashMap Text MediaTypeObject
739
770
740 -- | Maps a header name to its definition.
771 -- | Maps a header name to its definition.
741 , _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)
772 , _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)
742
773
743− -- | A map of operations links that can be followed from the response.
774+ -- TODO links
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)
775 } deriving (Eq, Show, Generic, Data, Typeable)
748
776
749instance IsString Response where
777instance IsString Response where
750− fromString s = Response (fromString s) mempty mempty mempty
778+ fromString s = Response (fromString s) 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
779
760type HeaderName = Text
780type HeaderName = Text
761
781
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.
765data Header = Header
782data Header = Header
766 { -- | A short description of the header.
783 { -- | A short description of the header.
767− _headerDescription :: Maybe HeaderName
784+ _headerDescription :: Maybe Text
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
785
776− , _headerSchema :: Maybe (Referenced Schema)
786+ , _headerSchema :: ParamSchema ('SwaggerKindNormal Header)
777 } deriving (Eq, Show, Generic, Data, Typeable)
787 } deriving (Eq, Show, Generic, Data, Typeable)
778
788
779-- | The location of the API key.
789-- | The location of the API key.
@@ -797,17 +807,17 @@ type AuthorizationURL = Text
797-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
807-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
798type TokenURL = Text
808type TokenURL = Text
799
809
800−newtype OAuth2ImplicitFlow
810+data OAuth2ImplicitFlow = OAuth2ImplicitFlow
801− = OAuth2ImplicitFlow {_oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL}
811+ { _oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL
802− deriving (Eq, Show, Generic, Data, Typeable)
812+ } deriving (Eq, Show, Generic, Data, Typeable)
803
813
804−newtype OAuth2PasswordFlow
814+data OAuth2PasswordFlow = OAuth2PasswordFlow
805− = OAuth2PasswordFlow {_oAuth2PasswordFlowTokenUrl :: TokenURL}
815+ { _oAuth2PasswordFlowTokenUrl :: TokenURL
806− deriving (Eq, Show, Generic, Data, Typeable)
816+ } deriving (Eq, Show, Generic, Data, Typeable)
807
817
808−newtype OAuth2ClientCredentialsFlow
818+data OAuth2ClientCredentialsFlow = OAuth2ClientCredentialsFlow
809− = OAuth2ClientCredentialsFlow {_oAuth2ClientCredentialsFlowTokenUrl :: TokenURL}
819+ { _oAuth2ClientCredentialsFlowTokenUrl :: TokenURL
810− deriving (Eq, Show, Generic, Data, Typeable)
820+ } deriving (Eq, Show, Generic, Data, Typeable)
811
821
812data OAuth2AuthorizationCodeFlow = OAuth2AuthorizationCodeFlow
822data OAuth2AuthorizationCodeFlow = OAuth2AuthorizationCodeFlow
813 { _oAuth2AuthorizationCodeFlowAuthorizationUrl :: AuthorizationURL
823 { _oAuth2AuthorizationCodeFlowAuthorizationUrl :: AuthorizationURL
@@ -840,50 +850,8 @@ data OAuth2Flows = OAuth2Flows
840 , _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
850 , _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
841 } deriving (Eq, Show, Generic, Data, Typeable)
851 } deriving (Eq, Show, Generic, Data, Typeable)
842
852
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−--
885data SecuritySchemeType
853data SecuritySchemeType
886− = SecuritySchemeHttp HttpSchemeType
854+ = SecuritySchemeHttp
887 | SecuritySchemeApiKey ApiKeyParams
855 | SecuritySchemeApiKey ApiKeyParams
888 | SecuritySchemeOAuth2 OAuth2Flows
856 | SecuritySchemeOAuth2 OAuth2Flows
889 | SecuritySchemeOpenIdConnect URL
857 | SecuritySchemeOpenIdConnect URL
@@ -918,7 +886,7 @@ data Tag = Tag
918 _tagName :: TagName
886 _tagName :: TagName
919
887
920 -- | A short description for the tag.
888 -- | A short description for the tag.
921− -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
889+ -- GFM syntax can be used for rich text representation.
922 , _tagDescription :: Maybe Text
890 , _tagDescription :: Maybe Text
923
891
924 -- | Additional external documentation for this tag.
892 -- | Additional external documentation for this tag.
@@ -933,7 +901,7 @@ instance IsString Tag where
933-- | Allows referencing an external resource for extended documentation.
901-- | Allows referencing an external resource for extended documentation.
934data ExternalDocs = ExternalDocs
902data ExternalDocs = ExternalDocs
935 { -- | A short description of the target documentation.
903 { -- | A short description of the target documentation.
936− -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
904+ -- GFM syntax can be used for rich text representation.
937 _externalDocsDescription :: Maybe Text
905 _externalDocsDescription :: Maybe Text
938
906
939 -- | The URL for the target documentation.
907 -- | The URL for the target documentation.
@@ -980,18 +948,18 @@ deriveGeneric ''MediaTypeObject
980deriveGeneric ''Responses
948deriveGeneric ''Responses
981deriveGeneric ''SecurityScheme
949deriveGeneric ''SecurityScheme
982deriveGeneric ''Schema
950deriveGeneric ''Schema
983−deriveGeneric ''OpenApi
951+deriveGeneric ''ParamSchema
952+deriveGeneric ''Swagger
984deriveGeneric ''Example
953deriveGeneric ''Example
985deriveGeneric ''Encoding
954deriveGeneric ''Encoding
986−deriveGeneric ''Link
987
955
988-- =======================================================================
956-- =======================================================================
989-- Monoid instances
957-- Monoid instances
990-- =======================================================================
958-- =======================================================================
991
959
992−instance Semigroup OpenApi where
960+instance Semigroup Swagger where
993 (<>) = genericMappend
961 (<>) = genericMappend
994−instance Monoid OpenApi where
962+instance Monoid Swagger where
995 mempty = genericMempty
963 mempty = genericMempty
996 mappend = (<>)
964 mappend = (<>)
997
965
@@ -1025,6 +993,12 @@ instance Monoid Schema where
1025 mempty = genericMempty
993 mempty = genericMempty
1026 mappend = (<>)
994 mappend = (<>)
1027
995
996+instance Semigroup (ParamSchema t) where
997+ (<>) = genericMappend
998+instance Monoid (ParamSchema t) where
999+ mempty = genericMempty
1000+ mappend = (<>)
1001+
1028instance Semigroup Param where
1002instance Semigroup Param where
1029 (<>) = genericMappend
1003 (<>) = genericMappend
1030instance Monoid Param where
1004instance Monoid Param where
@@ -1119,19 +1093,19 @@ instance SwaggerMonoid Info
1119instance SwaggerMonoid Components
1093instance SwaggerMonoid Components
1120instance SwaggerMonoid PathItem
1094instance SwaggerMonoid PathItem
1121instance SwaggerMonoid Schema
1095instance SwaggerMonoid Schema
1096+instance SwaggerMonoid (ParamSchema t)
1122instance SwaggerMonoid Param
1097instance SwaggerMonoid Param
1123instance SwaggerMonoid Responses
1098instance SwaggerMonoid Responses
1124instance SwaggerMonoid Response
1099instance SwaggerMonoid Response
1125instance SwaggerMonoid ExternalDocs
1100instance SwaggerMonoid ExternalDocs
1126instance SwaggerMonoid Operation
1101instance SwaggerMonoid Operation
1127instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
1102instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
1128−instance SwaggerMonoid SecurityDefinitions
1129
1103
1130instance SwaggerMonoid MimeList
1104instance SwaggerMonoid MimeList
1131deriving instance SwaggerMonoid URL
1105deriving instance SwaggerMonoid URL
1132
1106
1133−instance SwaggerMonoid OpenApiType where
1107+instance SwaggerMonoid (SwaggerType t) where
1134− swaggerMempty = OpenApiString
1108+ swaggerMempty = SwaggerString
1135 swaggerMappend _ y = y
1109 swaggerMappend _ y = y
1136
1110
1137instance SwaggerMonoid ParamLocation where
1111instance SwaggerMonoid ParamLocation where
@@ -1151,12 +1125,6 @@ instance Monoid a => SwaggerMonoid (Referenced a) where
1151-- Simple Generic-based ToJSON instances
1125-- Simple Generic-based ToJSON instances
1152-- =======================================================================
1126-- =======================================================================
1153
1127
1154−instance ToJSON Style where
1155− toJSON = genericToJSON (jsonPrefix "Style")
1156−
1157−instance ToJSON OpenApiType where
1158− toJSON = genericToJSON (jsonPrefix "Swagger")
1159−
1160instance ToJSON ParamLocation where
1128instance ToJSON ParamLocation where
1161 toJSON = genericToJSON (jsonPrefix "Param")
1129 toJSON = genericToJSON (jsonPrefix "Param")
1162
1130
@@ -1206,12 +1174,6 @@ instance ToJSON OAuth2AuthorizationCodeFlow where
1206-- Simple Generic-based FromJSON instances
1174-- Simple Generic-based FromJSON instances
1207-- =======================================================================
1175-- =======================================================================
1208
1176
1209−instance FromJSON Style where
1210− parseJSON = genericParseJSON (jsonPrefix "Style")
1211−
1212−instance FromJSON OpenApiType where
1213− parseJSON = genericParseJSON (jsonPrefix "Swagger")
1214−
1215instance FromJSON ParamLocation where
1177instance FromJSON ParamLocation where
1216 parseJSON = genericParseJSON (jsonPrefix "Param")
1178 parseJSON = genericParseJSON (jsonPrefix "Param")
1217
1179
@@ -1258,14 +1220,7 @@ instance FromJSON OAuth2AuthorizationCodeFlow where
1258-- Manual ToJSON instances
1220-- Manual ToJSON instances
1259-- =======================================================================
1221-- =======================================================================
1260
1222
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
1223+instance (Eq p, ToJSON p, AesonDefaultValue p) =>ToJSON (OAuth2Flow p) where
1269 toJSON = sopSwaggerGenericToJSON
1224 toJSON = sopSwaggerGenericToJSON
1270 toEncoding = sopSwaggerGenericToEncoding
1225 toEncoding = sopSwaggerGenericToEncoding
1271
1226
@@ -1274,19 +1229,8 @@ instance ToJSON OAuth2Flows where
1274 toEncoding = sopSwaggerGenericToEncoding
1229 toEncoding = sopSwaggerGenericToEncoding
1275
1230
1276instance ToJSON SecuritySchemeType where
1231instance ToJSON SecuritySchemeType where
1277− toJSON (SecuritySchemeHttp ty) = case ty of
1232+ toJSON SecuritySchemeHttp
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)
1233+ = object [ "type" .= ("http" :: Text) ]
1288− , "scheme" .= t
1289− ]
1290 toJSON (SecuritySchemeApiKey params)
1234 toJSON (SecuritySchemeApiKey params)
1291 = toJSON params
1235 = toJSON params
1292 <+> object [ "type" .= ("apiKey" :: Text) ]
1236 <+> object [ "type" .= ("apiKey" :: Text) ]
@@ -1299,9 +1243,9 @@ instance ToJSON SecuritySchemeType where
1299 , "openIdConnectUrl" .= url
1243 , "openIdConnectUrl" .= url
1300 ]
1244 ]
1301
1245
1302−instance ToJSON OpenApi where
1246+instance ToJSON Swagger where
1303 toJSON a = sopSwaggerGenericToJSON a &
1247 toJSON a = sopSwaggerGenericToJSON a &
1304− if InsOrdHashMap.null (_openApiPaths a)
1248+ if InsOrdHashMap.null (_swaggerPaths a)
1305 then (<+> object ["paths" .= object []])
1249 then (<+> object ["paths" .= object []])
1306 else id
1250 else id
1307 toEncoding = sopSwaggerGenericToEncoding
1251 toEncoding = sopSwaggerGenericToEncoding
@@ -1315,8 +1259,8 @@ instance ToJSON SecurityScheme where
1315 toEncoding = sopSwaggerGenericToEncoding
1259 toEncoding = sopSwaggerGenericToEncoding
1316
1260
1317instance ToJSON Schema where
1261instance ToJSON Schema where
1318− toJSON = sopSwaggerGenericToJSONWithOpts $
1262+ toJSON = sopSwaggerGenericToJSON
1319− mkSwaggerAesonOptions "schema" & saoSubObject ?~ "items"
1263+ toEncoding = sopSwaggerGenericToEncoding
1320
1264
1321instance ToJSON Header where
1265instance ToJSON Header where
1322 toJSON = sopSwaggerGenericToJSON
1266 toJSON = sopSwaggerGenericToJSON
@@ -1325,21 +1269,20 @@ instance ToJSON Header where
1325-- | As for nullary schema for 0-arity type constructors, see
1269-- | As for nullary schema for 0-arity type constructors, see
1326-- <https://github.com/GetShopTV/swagger2/issues/167>.
1270-- <https://github.com/GetShopTV/swagger2/issues/167>.
1327--
1271--
1328−-- >>> BSL.putStrLn $ encodePretty (OpenApiItemsArray [])
1272+-- >>> encode (SwaggerItemsArray [])
1329−-- {
1330−-- "example": [],
1331−-- "items": {},
1332−-- "maxItems": 0
1273+-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1333−-- }
1334--
1274--
1335−instance ToJSON OpenApiItems where
1275+instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where
1336− toJSON (OpenApiItemsObject x) = object [ "items" .= x ]
1276+ toJSON (SwaggerItemsPrimitive fmt schema) = object
1277+ [ "collectionFormat" .= fmt
1278+ , "items" .= schema ]
1279+ toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1337− toJSON (OpenApiItemsArray []) = object
1280+ toJSON (SwaggerItemsArray []) = object
1338 [ "items" .= object []
1281 [ "items" .= object []
1339 , "maxItems" .= (0 :: Int)
1282 , "maxItems" .= (0 :: Int)
1340 , "example" .= Array mempty
1283 , "example" .= Array mempty
1341 ]
1284 ]
1342− toJSON (OpenApiItemsArray x) = object [ "items" .= x ]
1285+ toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1343
1286
1344instance ToJSON Components where
1287instance ToJSON Components where
1345 toJSON = sopSwaggerGenericToJSON
1288 toJSON = sopSwaggerGenericToJSON
@@ -1384,10 +1327,6 @@ instance ToJSON Encoding where
1384 toJSON = sopSwaggerGenericToJSON
1327 toJSON = sopSwaggerGenericToJSON
1385 toEncoding = sopSwaggerGenericToEncoding
1328 toEncoding = sopSwaggerGenericToEncoding
1386
1329
1387−instance ToJSON Link where
1388− toJSON = sopSwaggerGenericToJSON
1389− toEncoding = sopSwaggerGenericToEncoding
1390−
1391instance ToJSON SecurityDefinitions where
1330instance ToJSON SecurityDefinitions where
1392 toJSON (SecurityDefinitions sd) = toJSON sd
1331 toJSON (SecurityDefinitions sd) = toJSON sd
1393
1332
@@ -1404,31 +1343,37 @@ instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/compone
1404instance ToJSON (Referenced RequestBody) where toJSON = referencedToJSON "#/components/requestBodies/"
1343instance ToJSON (Referenced RequestBody) where toJSON = referencedToJSON "#/components/requestBodies/"
1405instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/components/examples/"
1344instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/components/examples/"
1406instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"
1345instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"
1407−instance ToJSON (Referenced Link) where toJSON = referencedToJSON "#/components/links/"
1346+
1408−instance ToJSON (Referenced Callback) where toJSON = referencedToJSON "#/components/callbacks/"
1347+instance ToJSON (SwaggerType t) where
1348+ toJSON SwaggerArray = "array"
1349+ toJSON SwaggerString = "string"
1350+ toJSON SwaggerInteger = "integer"
1351+ toJSON SwaggerNumber = "number"
1352+ toJSON SwaggerBoolean = "boolean"
1353+ toJSON SwaggerFile = "file"
1354+ toJSON SwaggerNull = "null"
1355+ toJSON SwaggerObject = "object"
1356+
1357+instance ToJSON (CollectionFormat t) where
1358+ toJSON CollectionCSV = "csv"
1359+ toJSON CollectionSSV = "ssv"
1360+ toJSON CollectionTSV = "tsv"
1361+ toJSON CollectionPipes = "pipes"
1362+ toJSON CollectionMulti = "multi"
1363+
1364+instance ToJSON (ParamSchema k) where
1365+ -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1366+ toJSON = sopSwaggerGenericToJSONWithOpts $
1367+ mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1409
1368
1410instance ToJSON AdditionalProperties where
1369instance ToJSON AdditionalProperties where
1411 toJSON (AdditionalPropertiesAllowed b) = toJSON b
1370 toJSON (AdditionalPropertiesAllowed b) = toJSON b
1412 toJSON (AdditionalPropertiesSchema s) = toJSON s
1371 toJSON (AdditionalPropertiesSchema s) = toJSON s
1413
1372
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-- =======================================================================
1373-- =======================================================================
1422-- Manual FromJSON instances
1374-- Manual FromJSON instances
1423-- =======================================================================
1375-- =======================================================================
1424
1376
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−
1432instance (Eq p, FromJSON p, AesonDefaultValue p) => FromJSON (OAuth2Flow p) where
1377instance (Eq p, FromJSON p, AesonDefaultValue p) => FromJSON (OAuth2Flow p) where
1433 parseJSON = sopSwaggerGenericParseJSON
1378 parseJSON = sopSwaggerGenericParseJSON
1434
1379
@@ -1439,19 +1384,14 @@ instance FromJSON SecuritySchemeType where
1439 parseJSON js@(Object o) = do
1384 parseJSON js@(Object o) = do
1440 (t :: Text) <- o .: "type"
1385 (t :: Text) <- o .: "type"
1441 case t of
1386 case t of
1442− "http" -> do
1443− scheme <- o .: "scheme"
1444− SecuritySchemeHttp <$> case scheme of
1387+ "http" -> pure SecuritySchemeHttp
1445− "bearer" -> HttpSchemeBearer <$> (o .:! "bearerFormat")
1446− "basic" -> pure HttpSchemeBasic
1447− t -> pure $ HttpSchemeCustom t
1448 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1388 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1449 "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")
1389 "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")
1450 "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")
1390 "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")
1451 _ -> empty
1391 _ -> empty
1452 parseJSON _ = empty
1392 parseJSON _ = empty
1453
1393
1454−instance FromJSON OpenApi where
1394+instance FromJSON Swagger where
1455 parseJSON = sopSwaggerGenericParseJSON
1395 parseJSON = sopSwaggerGenericParseJSON
1456
1396
1457instance FromJSON Server where
1397instance FromJSON Server where
@@ -1463,28 +1403,48 @@ instance FromJSON SecurityScheme where
1463instance FromJSON Schema where
1403instance FromJSON Schema where
1464 parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1404 parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1465 where nullaryCleanup :: Schema -> Schema
1405 where nullaryCleanup :: Schema -> Schema
1466− nullaryCleanup s =
1406+ nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1467− if _schemaItems s == Just (OpenApiItemsArray [])
1407+ if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1468 then s { _schemaExample = Nothing
1408 then s { _schemaExample = Nothing
1469− , _schemaMaxItems = Nothing
1409+ , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1470− }
1471 else s
1410 else s
1472
1411
1473instance FromJSON Header where
1412instance FromJSON Header where
1474 parseJSON = sopSwaggerGenericParseJSON
1413 parseJSON = sopSwaggerGenericParseJSON
1475
1414
1476−instance FromJSON OpenApiItems where
1415+instance (FromJSON (CollectionFormat ('SwaggerKindNormal t)), FromJSON (ParamSchema ('SwaggerKindNormal t))) => FromJSON (SwaggerItems ('SwaggerKindNormal t)) where
1416+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1417+ <$> o .:? "collectionFormat"
1418+ <*> (o .: "items" >>= parseJSON)
1419+
1420+instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where
1421+ parseJSON = withObject "SwaggerItemsPrimitive" $ \o -> SwaggerItemsPrimitive
1422+ <$> o .:? "collectionFormat"
1423+ <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))
1424+
1425+-- |
1426+--
1427+-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)
1428+-- Just (SwaggerItemsArray [])
1429+--
1430+-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)
1431+-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))
1432+--
1433+-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)
1434+-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])
1435+--
1436+instance FromJSON (SwaggerItems 'SwaggerKindSchema) where
1477 parseJSON js@(Object obj)
1437 parseJSON js@(Object obj)
1478− | null obj = pure $ OpenApiItemsArray [] -- Nullary schema.
1438+ | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1479− | otherwise = OpenApiItemsObject <$> parseJSON js
1439+ | otherwise = SwaggerItemsObject <$> parseJSON js
1480− parseJSON js@(Array _) = OpenApiItemsArray <$> parseJSON js
1440+ parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1481 parseJSON _ = empty
1441 parseJSON _ = empty
1482
1442
1483instance FromJSON Components where
1443instance FromJSON Components where
1484 parseJSON = sopSwaggerGenericParseJSON
1444 parseJSON = sopSwaggerGenericParseJSON
1485
1445
1486instance FromJSON MimeList where
1446instance FromJSON MimeList where
1487− parseJSON js = MimeList . map fromString <$> parseJSON js
1447+ parseJSON js = (MimeList . map fromString) <$> parseJSON js
1488
1448
1489instance FromJSON Param where
1449instance FromJSON Param where
1490 parseJSON = sopSwaggerGenericParseJSON
1450 parseJSON = sopSwaggerGenericParseJSON
@@ -1492,7 +1452,7 @@ instance FromJSON Param where
1492instance FromJSON Responses where
1452instance FromJSON Responses where
1493 parseJSON (Object o) = Responses
1453 parseJSON (Object o) = Responses
1494 <$> o .:? "default"
1454 <$> o .:? "default"
1495− <*> parseJSON (Object (deleteKey "default" o))
1455+ <*> (parseJSON (Object (HashMap.delete "default" o)))
1496 parseJSON _ = empty
1456 parseJSON _ = empty
1497
1457
1498instance FromJSON Example where
1458instance FromJSON Example where
@@ -1519,9 +1479,6 @@ instance FromJSON MediaTypeObject where
1519instance FromJSON Encoding where
1479instance FromJSON Encoding where
1520 parseJSON = sopSwaggerGenericParseJSON
1480 parseJSON = sopSwaggerGenericParseJSON
1521
1481
1522−instance FromJSON Link where
1523− parseJSON = sopSwaggerGenericParseJSON
1524−
1525instance FromJSON Reference where
1482instance FromJSON Reference where
1526 parseJSON (Object o) = Reference <$> o .: "$ref"
1483 parseJSON (Object o) = Reference <$> o .: "$ref"
1527 parseJSON _ = empty
1484 parseJSON _ = empty
@@ -1545,24 +1502,40 @@ instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#
1545instance FromJSON (Referenced RequestBody) where parseJSON = referencedParseJSON "#/components/requestBodies/"
1502instance FromJSON (Referenced RequestBody) where parseJSON = referencedParseJSON "#/components/requestBodies/"
1546instance FromJSON (Referenced Example) where parseJSON = referencedParseJSON "#/components/examples/"
1503instance FromJSON (Referenced Example) where parseJSON = referencedParseJSON "#/components/examples/"
1547instance FromJSON (Referenced Header) where parseJSON = referencedParseJSON "#/components/headers/"
1504instance 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
1505
1551instance FromJSON Xml where
1506instance FromJSON Xml where
1552 parseJSON = genericParseJSON (jsonPrefix "xml")
1507 parseJSON = genericParseJSON (jsonPrefix "xml")
1553
1508
1509+instance FromJSON (SwaggerType 'SwaggerKindSchema) where
1510+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerNull, SwaggerObject]
1511+
1512+instance FromJSON (SwaggerType 'SwaggerKindParamOtherSchema) where
1513+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray, SwaggerFile]
1514+
1515+instance FromJSON (SwaggerType ('SwaggerKindNormal t)) where
1516+ parseJSON = parseOneOf [SwaggerString, SwaggerInteger, SwaggerNumber, SwaggerBoolean, SwaggerArray]
1517+
1518+instance FromJSON (CollectionFormat ('SwaggerKindNormal t)) where
1519+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1520+
1521+-- NOTE: There aren't collections of 'Schema'
1522+--instance FromJSON (CollectionFormat (SwaggerKindSchema)) where
1523+-- parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes]
1524+
1525+instance FromJSON (CollectionFormat 'SwaggerKindParamOtherSchema) where
1526+ parseJSON = parseOneOf [CollectionCSV, CollectionSSV, CollectionTSV, CollectionPipes, CollectionMulti]
1527+
1528+instance (FromJSON (SwaggerType ('SwaggerKindNormal t)), FromJSON (SwaggerItems ('SwaggerKindNormal t))) => FromJSON (ParamSchema ('SwaggerKindNormal t)) where
1529+ parseJSON = sopSwaggerGenericParseJSON
1530+instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where
1531+ parseJSON = sopSwaggerGenericParseJSON
1532+instance FromJSON (ParamSchema 'SwaggerKindSchema) where
1533+ parseJSON = sopSwaggerGenericParseJSON
1534+
1554instance FromJSON AdditionalProperties where
1535instance FromJSON AdditionalProperties where
1555 parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1536 parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1556 parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1537 parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1557
1538
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−
1566instance HasSwaggerAesonOptions Server where
1539instance HasSwaggerAesonOptions Server where
1567 swaggerAesonOptions _ = mkSwaggerAesonOptions "server"
1540 swaggerAesonOptions _ = mkSwaggerAesonOptions "server"
1568instance HasSwaggerAesonOptions Components where
1541instance HasSwaggerAesonOptions Components where
@@ -1591,18 +1564,24 @@ instance HasSwaggerAesonOptions SecurityScheme where
1591 swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1564 swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1592instance HasSwaggerAesonOptions Schema where
1565instance HasSwaggerAesonOptions Schema where
1593 swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1566 swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1594−instance HasSwaggerAesonOptions OpenApi where
1567+instance HasSwaggerAesonOptions Swagger where
1595 swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")]
1568 swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")]
1596instance HasSwaggerAesonOptions Example where
1569instance HasSwaggerAesonOptions Example where
1597 swaggerAesonOptions _ = mkSwaggerAesonOptions "example"
1570 swaggerAesonOptions _ = mkSwaggerAesonOptions "example"
1598instance HasSwaggerAesonOptions Encoding where
1571instance HasSwaggerAesonOptions Encoding where
1599 swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding"
1572 swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding"
1600
1573
1601−instance HasSwaggerAesonOptions Link where
1574+instance HasSwaggerAesonOptions (ParamSchema ('SwaggerKindNormal t)) where
1575+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1576+instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindParamOtherSchema) where
1602− swaggerAesonOptions _ = mkSwaggerAesonOptions "link"
1577+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1578+-- NOTE: Schema doesn't have 'items' sub object!
1579+instance HasSwaggerAesonOptions (ParamSchema 'SwaggerKindSchema) where
1580+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
1603
1581
1604instance AesonDefaultValue Server
1582instance AesonDefaultValue Server
1605instance AesonDefaultValue Components
1583instance AesonDefaultValue Components
1584+instance AesonDefaultValue (ParamSchema s)
1606instance AesonDefaultValue OAuth2ImplicitFlow
1585instance AesonDefaultValue OAuth2ImplicitFlow
1607instance AesonDefaultValue OAuth2PasswordFlow
1586instance AesonDefaultValue OAuth2PasswordFlow
1608instance AesonDefaultValue OAuth2ClientCredentialsFlow
1587instance AesonDefaultValue OAuth2ClientCredentialsFlow
@@ -1610,10 +1589,7 @@ instance AesonDefaultValue OAuth2AuthorizationCodeFlow
1610instance AesonDefaultValue p => AesonDefaultValue (OAuth2Flow p)
1589instance AesonDefaultValue p => AesonDefaultValue (OAuth2Flow p)
1611instance AesonDefaultValue Responses
1590instance AesonDefaultValue Responses
1612instance AesonDefaultValue SecuritySchemeType
1591instance AesonDefaultValue SecuritySchemeType
1613−instance AesonDefaultValue OpenApiType
1592+instance AesonDefaultValue (SwaggerType a)
1614instance AesonDefaultValue MimeList where defaultValue = Just mempty
1593instance AesonDefaultValue MimeList where defaultValue = Just mempty
1615instance AesonDefaultValue Info
1594instance AesonDefaultValue Info
1616instance AesonDefaultValue ParamLocation
1595instance AesonDefaultValue ParamLocation
1617−instance AesonDefaultValue Link
1618−instance AesonDefaultValue SecurityDefinitions where
1619− defaultValue = Just mempty
src/Data/OpenApi/Internal/AesonUtils.hs → src/Data/Swagger/Internal/AesonUtils.hsrenamed+13−12
@@ -5,7 +5,7 @@
5{-# LANGUAGE ExplicitForAll #-}
5{-# LANGUAGE ExplicitForAll #-}
6{-# LANGUAGE TemplateHaskell #-}
6{-# LANGUAGE TemplateHaskell #-}
7{-# LANGUAGE UndecidableSuperClasses #-}
7{-# LANGUAGE UndecidableSuperClasses #-}
8−module Data.OpenApi.Internal.AesonUtils (
8+module Data.Swagger.Internal.AesonUtils (
9 -- * Generic functions
9 -- * Generic functions
10 AesonDefaultValue(..),
10 AesonDefaultValue(..),
11 sopSwaggerGenericToJSON,
11 sopSwaggerGenericToJSON,
@@ -27,7 +27,7 @@ import Prelude.Compat
27import Control.Applicative ((<|>))
27import Control.Applicative ((<|>))
28import Control.Lens (makeLenses, (^.))
28import Control.Lens (makeLenses, (^.))
29import Control.Monad (unless)
29import Control.Monad (unless)
30−import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), Object, object, (.:), (.:?), (.!=), withObject, Encoding, pairs, (.=), Series)
30+import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), Object, object, (.:), (.:?), (.!=), withObject)
31import Data.Aeson.Types (Parser, Pair)
31import Data.Aeson.Types (Parser, Pair)
32import Data.Char (toLower, isUpper)
32import Data.Char (toLower, isUpper)
33import Data.Foldable (traverse_)
33import Data.Foldable (traverse_)
@@ -36,11 +36,12 @@ import Data.Text (Text)
36import Generics.SOP
36import Generics.SOP
37
37
38import qualified Data.Text as T
38import qualified Data.Text as T
39+import qualified Data.HashMap.Strict as HM
39import qualified Data.Set as Set
40import qualified Data.Set as Set
40import qualified Data.HashMap.Strict.InsOrd as InsOrd
41import qualified Data.HashMap.Strict.InsOrd as InsOrd
41import qualified Data.HashSet.InsOrd as InsOrdHS
42import qualified Data.HashSet.InsOrd as InsOrdHS
42
43
43−import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)
44+import Data.Aeson (Encoding, pairs, (.=), Series)
44
45
45-------------------------------------------------------------------------------
46-------------------------------------------------------------------------------
46-- SwaggerAesonOptions
47-- SwaggerAesonOptions
@@ -48,7 +49,7 @@ import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)
48
49
49data SwaggerAesonOptions = SwaggerAesonOptions
50data SwaggerAesonOptions = SwaggerAesonOptions
50 { _saoPrefix :: String
51 { _saoPrefix :: String
51− , _saoAdditionalPairs :: [Pair]
52+ , _saoAdditionalPairs :: [(Text, Value)]
52 , _saoSubObject :: Maybe String
53 , _saoSubObject :: Maybe String
53 }
54 }
54
55
@@ -155,14 +156,14 @@ sopSwaggerGenericToJSON'' (SwaggerAesonOptions prefix _ sub) = go
155 go Nil Nil Nil = []
156 go Nil Nil Nil = []
156 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
157 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
157 | Just name' == sub = case json of
158 | Just name' == sub = case json of
158− Object m -> objectToList m ++ rest
159+ Object m -> HM.toList m ++ rest
159 Null -> rest
160 Null -> rest
160 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
161 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
161 -- If default value: omit it.
162 -- If default value: omit it.
162 | Just x == def =
163 | Just x == def =
163 rest
164 rest
164 | otherwise =
165 | otherwise =
165− (stringToKey name', json) : rest
166+ (T.pack name', json) : rest
166 where
167 where
167 json = toJSON x
168 json = toJSON x
168 name' = fieldNameModifier name
169 name' = fieldNameModifier name
@@ -196,11 +197,11 @@ sopSwaggerGenericParseJSON = withObject "Swagger Record Object" $ \obj ->
196 proxy = Proxy :: Proxy a
197 proxy = Proxy :: Proxy a
197 opts = swaggerAesonOptions proxy
198 opts = swaggerAesonOptions proxy
198
199
199− parseAdditionalField :: Object -> Pair -> Parser ()
200+ parseAdditionalField :: Object -> (Text, Value) -> Parser ()
200 parseAdditionalField obj (k, v) = do
201 parseAdditionalField obj (k, v) = do
201 v' <- obj .: k
202 v' <- obj .: k
202 unless (v == v') $ fail $
203 unless (v == v') $ fail $
203− "Additonal field don't match for key " ++ keyToString k
204+ "Additonal field don't match for key " ++ T.unpack k
204 ++ ": " ++ show v
205 ++ ": " ++ show v
205 ++ " /= " ++ show v'
206 ++ " /= " ++ show v'
206
207
@@ -231,8 +232,8 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
231 -- Note: we might strip fields of outer structure.
232 -- Note: we might strip fields of outer structure.
232 cons <$> (withDef $ parseJSON $ Object obj) <*> rest
233 cons <$> (withDef $ parseJSON $ Object obj) <*> rest
233 | otherwise = case def of
234 | otherwise = case def of
234− Just def' -> cons <$> obj .:? stringToKey name' .!= def' <*> rest
235+ Just def' -> cons <$> obj .:? T.pack name' .!= def' <*> rest
235− Nothing -> cons <$> obj .: stringToKey name' <*> rest
236+ Nothing -> cons <$> obj .: T.pack name' <*> rest
236 where
237 where
237 cons h t = I h :* t
238 cons h t = I h :* t
238 name' = fieldNameModifier name
239 name' = fieldNameModifier name
@@ -295,14 +296,14 @@ sopSwaggerGenericToEncoding'' (SwaggerAesonOptions prefix _ sub) = go
295 go Nil Nil Nil = mempty
296 go Nil Nil Nil = mempty
296 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
297 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
297 | Just name' == sub = case toJSON x of
298 | Just name' == sub = case toJSON x of
298− Object m -> pairsToSeries (objectToList m) <> rest
299+ Object m -> pairsToSeries (HM.toList m) <> rest
299 Null -> rest
300 Null -> rest
300 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
301 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
301 -- If default value: omit it.
302 -- If default value: omit it.
302 | Just x == def =
303 | Just x == def =
303 rest
304 rest
304 | otherwise =
305 | otherwise =
305− (stringToKey name' .= x) <> rest
306+ (T.pack name' .= x) <> rest
306 where
307 where
307 name' = fieldNameModifier name
308 name' = fieldNameModifier name
308 rest = go xs names defs
309 rest = go xs names defs
src/Data/OpenApi/Internal/ParamSchema.hs → src/Data/Swagger/Internal/ParamSchema.hsrenamed+53−77
@@ -15,7 +15,7 @@
15{-# OPTIONS_GHC -Wno-redundant-constraints #-}
15{-# OPTIONS_GHC -Wno-redundant-constraints #-}
16-- For TypeErrors
16-- For TypeErrors
17{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
17{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
18−module Data.OpenApi.Internal.ParamSchema where
18+module Data.Swagger.Internal.ParamSchema where
19
19
20import Control.Lens
20import Control.Lens
21import Data.Aeson (ToJSON (..))
21import Data.Aeson (ToJSON (..))
@@ -41,40 +41,34 @@ import Data.Word
41import Data.UUID.Types (UUID)
41import Data.UUID.Types (UUID)
42import Web.Cookie (SetCookie)
42import Web.Cookie (SetCookie)
43
43
44−import Data.OpenApi.Internal
44+import Data.Swagger.Internal
45−import Data.OpenApi.Lens
45+import Data.Swagger.Lens
46−import Data.OpenApi.SchemaOptions
46+import Data.Swagger.SchemaOptions
47
47
48import qualified Data.ByteString as BS
48import qualified Data.ByteString as BS
49−import qualified Data.ByteString.Lazy.Char8 as BSL
49+import qualified Data.ByteString.Lazy as BSL
50import GHC.TypeLits (TypeError, ErrorMessage(..))
50import GHC.TypeLits (TypeError, ErrorMessage(..))
51
51
52-- | Default schema for binary data (any sequence of octets).
52-- | Default schema for binary data (any sequence of octets).
53−binarySchema :: Schema
53+binaryParamSchema :: ParamSchema t
54−binarySchema = mempty
54+binaryParamSchema = mempty
55− & type_ ?~ OpenApiString
55+ & type_ ?~ SwaggerString
56 & format ?~ "binary"
56 & format ?~ "binary"
57
57
58-- | Default schema for binary data (base64 encoded).
58-- | Default schema for binary data (base64 encoded).
59−byteSchema :: Schema
59+byteParamSchema :: ParamSchema t
60−byteSchema = mempty
60+byteParamSchema = mempty
61− & type_ ?~ OpenApiString
61+ & type_ ?~ SwaggerString
62 & format ?~ "byte"
62 & format ?~ "byte"
63
63
64-- | Default schema for password string.
64-- | Default schema for password string.
65-- @"password"@ format is used to hint UIs the input needs to be obscured.
65-- @"password"@ format is used to hint UIs the input needs to be obscured.
66−passwordSchema :: Schema
66+passwordParamSchema :: ParamSchema t
67−passwordSchema = mempty
67+passwordParamSchema = mempty
68− & type_ ?~ OpenApiString
68+ & type_ ?~ SwaggerString
69 & format ?~ "password"
69 & format ?~ "password"
70
70
71−-- | Convert a type into a plain @'Schema'@.
71+-- | 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--
72--
79-- An example type and instance:
73-- An example type and instance:
80--
74--
@@ -87,7 +81,7 @@ passwordSchema = mempty
87--
81--
88-- instance ToParamSchema Direction where
82-- instance ToParamSchema Direction where
89-- toParamSchema _ = mempty
83-- toParamSchema _ = mempty
90−-- & type_ ?~ OpenApiString
84+-- & type_ ?~ SwaggerString
91-- & enum_ ?~ [ \"Up\", \"Down\" ]
85-- & enum_ ?~ [ \"Up\", \"Down\" ]
92-- @
86-- @
93--
87--
@@ -112,26 +106,24 @@ passwordSchema = mempty
112class ToParamSchema a where
106class ToParamSchema a where
113 -- | Convert a type into a plain parameter schema.
107 -- | Convert a type into a plain parameter schema.
114 --
108 --
115− -- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy Integer)
109+ -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)
116− -- {
117− -- "type": "integer"
110+ -- "{\"type\":\"integer\"}"
118− -- }
119− toParamSchema :: Proxy a -> Schema
111+ toParamSchema :: Proxy a -> ParamSchema t
120− default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> Schema
112+ default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema t
121 toParamSchema = genericToParamSchema defaultSchemaOptions
113 toParamSchema = genericToParamSchema defaultSchemaOptions
122
114
123instance {-# OVERLAPPING #-} ToParamSchema String where
115instance {-# OVERLAPPING #-} ToParamSchema String where
124− toParamSchema _ = mempty & type_ ?~ OpenApiString
116+ toParamSchema _ = mempty & type_ ?~ SwaggerString
125
117
126instance ToParamSchema Bool where
118instance ToParamSchema Bool where
127− toParamSchema _ = mempty & type_ ?~ OpenApiBoolean
119+ toParamSchema _ = mempty & type_ ?~ SwaggerBoolean
128
120
129instance ToParamSchema Integer where
121instance ToParamSchema Integer where
130− toParamSchema _ = mempty & type_ ?~ OpenApiInteger
122+ toParamSchema _ = mempty & type_ ?~ SwaggerInteger
131
123
132instance ToParamSchema Natural where
124instance ToParamSchema Natural where
133 toParamSchema _ = mempty
125 toParamSchema _ = mempty
134− & type_ ?~ OpenApiInteger
126+ & type_ ?~ SwaggerInteger
135 & minimum_ ?~ 0
127 & minimum_ ?~ 0
136 & exclusiveMinimum ?~ False
128 & exclusiveMinimum ?~ False
137
129
@@ -157,45 +149,41 @@ instance ToParamSchema Word64 where
157
149
158-- | Default plain schema for @'Bounded'@, @'Integral'@ types.
150-- | Default plain schema for @'Bounded'@, @'Integral'@ types.
159--
151--
160−-- >>> BSL.putStrLn $ encodePretty $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
152+-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
161−-- {
162−-- "maximum": 127,
163−-- "minimum": -128,
164−-- "type": "integer"
153+-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
165−-- }
166−toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> Schema
154+toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema t
167toParamSchemaBoundedIntegral _ = mempty
155toParamSchemaBoundedIntegral _ = mempty
168− & type_ ?~ OpenApiInteger
156+ & type_ ?~ SwaggerInteger
169 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
157 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
170 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
158 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
171
159
172instance ToParamSchema Char where
160instance ToParamSchema Char where
173 toParamSchema _ = mempty
161 toParamSchema _ = mempty
174− & type_ ?~ OpenApiString
162+ & type_ ?~ SwaggerString
175 & maxLength ?~ 1
163 & maxLength ?~ 1
176 & minLength ?~ 1
164 & minLength ?~ 1
177
165
178instance ToParamSchema Scientific where
166instance ToParamSchema Scientific where
179− toParamSchema _ = mempty & type_ ?~ OpenApiNumber
167+ toParamSchema _ = mempty & type_ ?~ SwaggerNumber
180
168
181instance HasResolution a => ToParamSchema (Fixed a) where
169instance HasResolution a => ToParamSchema (Fixed a) where
182 toParamSchema _ = mempty
170 toParamSchema _ = mempty
183− & type_ ?~ OpenApiNumber
171+ & type_ ?~ SwaggerNumber
184 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
172 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
185
173
186instance ToParamSchema Double where
174instance ToParamSchema Double where
187 toParamSchema _ = mempty
175 toParamSchema _ = mempty
188− & type_ ?~ OpenApiNumber
176+ & type_ ?~ SwaggerNumber
189 & format ?~ "double"
177 & format ?~ "double"
190
178
191instance ToParamSchema Float where
179instance ToParamSchema Float where
192 toParamSchema _ = mempty
180 toParamSchema _ = mempty
193− & type_ ?~ OpenApiNumber
181+ & type_ ?~ SwaggerNumber
194 & format ?~ "float"
182 & format ?~ "float"
195
183
196−timeParamSchema :: String -> Schema
184+timeParamSchema :: String -> ParamSchema t
197timeParamSchema fmt = mempty
185timeParamSchema fmt = mempty
198− & type_ ?~ OpenApiString
186+ & type_ ?~ SwaggerString
199 & format ?~ T.pack fmt
187 & format ?~ T.pack fmt
200
188
201-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
189-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -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,18 +225,18 @@ 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
246
234
247type family ToParamSchemaByteStringError bs where
235type family ToParamSchemaByteStringError bs where
248 ToParamSchemaByteStringError bs = TypeError
236 ToParamSchemaByteStringError bs = TypeError
249 ( 'Text "Impossible to have an instance " :<>: ShowType (ToParamSchema bs) :<>: Text "."
237 ( 'Text "Impossible to have an instance " :<>: ShowType (ToParamSchema bs) :<>: Text "."
250 :$$: 'Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
238 :$$: 'Text "Please, use a newtype wrapper around " :<>: ShowType bs :<>: Text " instead."
251− :$$: 'Text "Consider using byteParamSchema or binaryParamSchemaemplates." )
239+ :$$: 'Text "Consider using byteParamSchema or binaryParamSchema templates." )
252
240
253instance ToParamSchemaByteStringError BS.ByteString => ToParamSchema BS.ByteString where toParamSchema = error "impossible"
241instance ToParamSchemaByteStringError BS.ByteString => ToParamSchema BS.ByteString where toParamSchema = error "impossible"
254instance ToParamSchemaByteStringError BSL.ByteString => ToParamSchema BSL.ByteString where toParamSchema = error "impossible"
242instance ToParamSchemaByteStringError BSL.ByteString => ToParamSchema BSL.ByteString where toParamSchema = error "impossible"
@@ -265,8 +253,8 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t
265
253
266instance ToParamSchema a => ToParamSchema [a] where
254instance ToParamSchema a => ToParamSchema [a] where
267 toParamSchema _ = mempty
255 toParamSchema _ = mempty
268− & type_ ?~ OpenApiArray
256+ & type_ ?~ SwaggerArray
269− & items ?~ OpenApiItemsObject (Inline $ toParamSchema (Proxy :: Proxy a))
257+ & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))
270
258
271instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
259instance 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])
260instance ToParamSchema a => ToParamSchema (VP.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
@@ -281,40 +269,29 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
281 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
269 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
282
270
283-- |
271-- |
284−-- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy ())
272+-- >>> encode $ toParamSchema (Proxy :: Proxy ())
285−-- {
286−-- "enum": [
273+-- "{\"type\":\"string\",\"enum\":[\"_\"]}"
287−-- "_"
288−-- ],
289−-- "type": "string"
290−-- }
291instance ToParamSchema () where
274instance ToParamSchema () where
292 toParamSchema _ = mempty
275 toParamSchema _ = mempty
293− & type_ ?~ OpenApiString
276+ & type_ ?~ SwaggerString
294 & enum_ ?~ ["_"]
277 & enum_ ?~ ["_"]
295
278
296instance ToParamSchema UUID where
279instance ToParamSchema UUID where
297 toParamSchema _ = mempty
280 toParamSchema _ = mempty
298− & type_ ?~ OpenApiString
281+ & type_ ?~ SwaggerString
299 & format ?~ "uuid"
282 & format ?~ "uuid"
300
283
301−-- | A configurable generic @'Schema'@ creator.
284+-- | A configurable generic @'ParamSchema'@ creator.
302--
285--
303-- >>> :set -XDeriveGeneric
286-- >>> :set -XDeriveGeneric
304-- >>> data Color = Red | Blue deriving Generic
287-- >>> data Color = Red | Blue deriving Generic
305−-- >>> BSL.putStrLn $ encodePretty $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
288+-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
306−-- {
289+-- "{\"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
290+genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> ParamSchema t
314genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
291genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
315
292
316class GToParamSchema (f :: * -> *) where
293class GToParamSchema (f :: * -> *) where
317− gtoParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
294+ gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
318
295
319instance GToParamSchema f => GToParamSchema (D1 d f) where
296instance GToParamSchema f => GToParamSchema (D1 d f) where
320 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
297 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
@@ -332,14 +309,14 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) wh
332 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
309 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
333
310
334class GEnumParamSchema (f :: * -> *) where
311class GEnumParamSchema (f :: * -> *) where
335− genumParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
312+ genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t
336
313
337instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
314instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
338 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)
315 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)
339
316
340instance Constructor c => GEnumParamSchema (C1 c U1) where
317instance Constructor c => GEnumParamSchema (C1 c U1) where
341 genumParamSchema opts _ s = s
318 genumParamSchema opts _ s = s
342− & type_ ?~ OpenApiString
319+ & type_ ?~ SwaggerString
343 & enum_ %~ addEnumValue tag
320 & enum_ %~ addEnumValue tag
344 where
321 where
345 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
322 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
@@ -351,4 +328,3 @@ data Proxy3 a b c = Proxy3
351
328
352-- $setup
329-- $setup
353-- >>> import Data.Aeson (encode)
330-- >>> import Data.Aeson (encode)
354−-- >>> import Data.OpenApi.Internal.Utils
src/Data/OpenApi/Internal/Schema.hs → src/Data/Swagger/Internal/Schema.hsrenamed+172−446
@@ -1,17 +1,15 @@
1−{-# LANGUAGE CPP #-}
2{-# LANGUAGE ConstraintKinds #-}
1{-# LANGUAGE ConstraintKinds #-}
3−{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DefaultSignatures #-}
2{-# LANGUAGE DefaultSignatures #-}
5{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE KindSignatures #-}
5{-# LANGUAGE KindSignatures #-}
6+{-# LANGUAGE DataKinds #-}
8{-# LANGUAGE OverloadedLists #-}
7{-# LANGUAGE OverloadedLists #-}
9{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE OverloadedStrings #-}
10{-# LANGUAGE PackageImports #-}
9{-# LANGUAGE PackageImports #-}
11{-# LANGUAGE PolyKinds #-}
10{-# LANGUAGE PolyKinds #-}
12{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE ScopedTypeVariables #-}
13{-# LANGUAGE TupleSections #-}
12{-# LANGUAGE TupleSections #-}
14−{-# LANGUAGE TypeApplications #-}
15{-# LANGUAGE TypeFamilies #-}
13{-# LANGUAGE TypeFamilies #-}
16{-# LANGUAGE TypeOperators #-}
14{-# LANGUAGE TypeOperators #-}
17{-# LANGUAGE TypeSynonymInstances #-}
15{-# LANGUAGE TypeSynonymInstances #-}
@@ -19,18 +17,17 @@
19{-# OPTIONS_GHC -Wno-redundant-constraints #-}
17{-# OPTIONS_GHC -Wno-redundant-constraints #-}
20-- For TypeErrors
18-- For TypeErrors
21{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
19{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
22−module Data.OpenApi.Internal.Schema where
20+module Data.Swagger.Internal.Schema where
23
21
24import Prelude ()
22import Prelude ()
25import Prelude.Compat
23import Prelude.Compat
26
24
27−import Control.Lens hiding (allOf)
25+import Control.Lens
28import Data.Data.Lens (template)
26import Data.Data.Lens (template)
29
27
30import Control.Monad
28import Control.Monad
31import Control.Monad.Writer
29import Control.Monad.Writer
32−import Data.Aeson (Object (..), SumEncoding (..), ToJSON (..), ToJSONKey (..),
30+import Data.Aeson (ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..), Value (..), Object(..))
33− ToJSONKeyFunction (..), Value (..))
34import Data.Char
31import Data.Char
35import Data.Data (Data)
32import Data.Data (Data)
36import Data.Foldable (traverse_)
33import Data.Foldable (traverse_)
@@ -42,10 +39,8 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
42import Data.Int
39import Data.Int
43import Data.IntSet (IntSet)
40import Data.IntSet (IntSet)
44import Data.IntMap (IntMap)
41import Data.IntMap (IntMap)
45−import Data.List (sort)
46import Data.List.NonEmpty.Compat (NonEmpty)
42import Data.List.NonEmpty.Compat (NonEmpty)
47import Data.Map (Map)
43import Data.Map (Map)
48−import Data.Maybe (fromMaybe)
49import Data.Proxy
44import Data.Proxy
50import Data.Scientific (Scientific)
45import Data.Scientific (Scientific)
51import Data.Fixed (Fixed, HasResolution, Pico)
46import Data.Fixed (Fixed, HasResolution, Pico)
@@ -62,19 +57,17 @@ import Numeric.Natural.Compat (Natural)
62import Data.Word
57import Data.Word
63import GHC.Generics
58import GHC.Generics
64import qualified Data.UUID.Types as UUID
59import qualified Data.UUID.Types as UUID
65−import Type.Reflection (Typeable, typeRep)
66
60
67−import Data.OpenApi.Aeson.Compat (keyToText, objectKeys, toInsOrdHashMap)
68−import Data.OpenApi.Declare
61+import Data.Swagger.Declare
69−import Data.OpenApi.Internal
62+import Data.Swagger.Internal
70−import Data.OpenApi.Internal.ParamSchema (ToParamSchema (..))
63+import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
71−import Data.OpenApi.Internal.TypeShape
72−import Data.OpenApi.Lens hiding (name, schema)
64+import Data.Swagger.Lens hiding (name, schema)
73−import qualified Data.OpenApi.Lens as Swagger
65+import qualified Data.Swagger.Lens as Swagger
74−import Data.OpenApi.SchemaOptions
66+import Data.Swagger.SchemaOptions
67+import Data.Swagger.Internal.TypeShape
75
68
76import qualified Data.ByteString as BS
69import qualified Data.ByteString as BS
77−import qualified Data.ByteString.Lazy.Char8 as BSL
70+import qualified Data.ByteString.Lazy as BSL
78import GHC.TypeLits (TypeError, ErrorMessage(..))
71import GHC.TypeLits (TypeError, ErrorMessage(..))
79
72
80unnamed :: Schema -> NamedSchema
73unnamed :: Schema -> NamedSchema
@@ -102,7 +95,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
102--
95--
103-- import Control.Lens
96-- import Control.Lens
104-- import Data.Proxy
97-- import Data.Proxy
105−-- import Data.OpenApi
98+-- import Data.Swagger
106--
99--
107-- data Coord = Coord { x :: Double, y :: Double }
100-- data Coord = Coord { x :: Double, y :: Double }
108--
101--
@@ -110,7 +103,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
110-- declareNamedSchema _ = do
103-- declareNamedSchema _ = do
111-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
104-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
112-- return $ NamedSchema (Just \"Coord\") $ mempty
105-- return $ NamedSchema (Just \"Coord\") $ mempty
113−-- & type_ ?~ OpenApiObject
106+-- & type_ ?~ SwaggerObject
114-- & properties .~
107-- & properties .~
115-- [ (\"x\", doubleSchema)
108-- [ (\"x\", doubleSchema)
116-- , (\"y\", doubleSchema)
109-- , (\"y\", doubleSchema)
@@ -136,13 +129,13 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
136--
129--
137-- instance ToSchema Coord
130-- instance ToSchema Coord
138-- @
131-- @
139−class Typeable a => ToSchema a where
132+class ToSchema a where
140 -- | Convert a type into an optionally named schema
133 -- | Convert a type into an optionally named schema
141 -- together with all used definitions.
134 -- together with all used definitions.
142 -- Note that the schema itself is included in definitions
135 -- Note that the schema itself is included in definitions
143 -- only if it is recursive (and thus needs its definition in scope).
136 -- only if it is recursive (and thus needs its definition in scope).
144 declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
137 declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema
145− default declareNamedSchema :: (Generic a, GToSchema (Rep a)) =>
138+ default declareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
146 Proxy a -> Declare (Definitions Schema) NamedSchema
139 Proxy a -> Declare (Definitions Schema) NamedSchema
147 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
140 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
148
141
@@ -158,19 +151,13 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
158--
151--
159-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
152-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
160-- Nothing
153-- Nothing
161−-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy String) ^. schema)
154+-- >>> encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
162−-- {
163−-- "type": "string"
155+-- "{\"type\":\"string\"}"
164−-- }
165--
156--
166-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
157-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
167-- Just "Day"
158-- Just "Day"
168−-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy Day) ^. schema)
159+-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
169−-- {
170−-- "example": "2016-07-22",
160+-- "{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"
171−-- "format": "date",
172−-- "type": "string"
173−-- }
174toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
161toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
175toNamedSchema = undeclare . declareNamedSchema
162toNamedSchema = undeclare . declareNamedSchema
176
163
@@ -186,35 +173,22 @@ schemaName = _namedSchemaName . toNamedSchema
186
173
187-- | Convert a type into a schema.
174-- | Convert a type into a schema.
188--
175--
189−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Int8)
176+-- >>> encode $ toSchema (Proxy :: Proxy Int8)
190−-- {
191−-- "maximum": 127,
192−-- "minimum": -128,
193−-- "type": "integer"
177+-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
194−-- }
195--
178--
196−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy [Day])
179+-- >>> encode $ toSchema (Proxy :: Proxy [Day])
197−-- {
198−-- "items": {
199−-- "$ref": "#/components/schemas/Day"
200−-- },
201−-- "type": "array"
180+-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"
202−-- }
203toSchema :: ToSchema a => Proxy a -> Schema
181toSchema :: ToSchema a => Proxy a -> Schema
204toSchema = _namedSchemaSchema . toNamedSchema
182toSchema = _namedSchemaSchema . toNamedSchema
205
183
206-- | Convert a type into a referenced schema if possible.
184-- | Convert a type into a referenced schema if possible.
207-- Only named schemas can be referenced, nameless schemas are inlined.
185-- Only named schemas can be referenced, nameless schemas are inlined.
208--
186--
209−-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Integer)
187+-- >>> encode $ toSchemaRef (Proxy :: Proxy Integer)
210−-- {
211−-- "type": "integer"
188+-- "{\"type\":\"integer\"}"
212−-- }
213--
189--
214−-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Day)
190+-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)
215−-- {
191+-- "{\"$ref\":\"#/definitions/Day\"}"
216−-- "$ref": "#/components/schemas/Day"
217−-- }
218toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
192toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
219toSchemaRef = undeclare . declareSchemaRef
193toSchemaRef = undeclare . declareSchemaRef
220
194
@@ -282,15 +256,8 @@ inlineAllSchemas = inlineSchemasWhen (const True)
282
256
283-- | Convert a type into a schema without references.
257-- | Convert a type into a schema without references.
284--
258--
285−-- >>> BSL.putStrLn $ encodePretty $ toInlinedSchema (Proxy :: Proxy [Day])
259+-- >>> encode $ toInlinedSchema (Proxy :: Proxy [Day])
286−-- {
287−-- "items": {
288−-- "example": "2016-07-22",
260+-- "{\"items\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"},\"type\":\"array\"}"
289−-- "format": "date",
290−-- "type": "string"
291−-- },
292−-- "type": "array"
293−-- }
294--
261--
295-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
262-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
296-- when inlining recursive schemas.
263-- when inlining recursive schemas.
@@ -320,67 +287,41 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
320 traverse_ usedNames (InsOrdHashMap.lookup name defs)
287 traverse_ usedNames (InsOrdHashMap.lookup name defs)
321 Inline subschema -> usedNames subschema
288 Inline subschema -> usedNames subschema
322
289
290+-- | Default schema for binary data (any sequence of octets).
291+binarySchema :: Schema
292+binarySchema = mempty
293+ & type_ ?~ SwaggerString
294+ & format ?~ "binary"
295+
296+-- | Default schema for binary data (base64 encoded).
297+byteSchema :: Schema
298+byteSchema = mempty
299+ & type_ ?~ SwaggerString
300+ & format ?~ "byte"
301+
302+-- | Default schema for password string.
303+-- @"password"@ format is used to hint UIs the input needs to be obscured.
304+passwordSchema :: Schema
305+passwordSchema = mempty
306+ & type_ ?~ SwaggerString
307+ & format ?~ "password"
308+
323-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
309-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
324-- Produced schema can be used for further refinement.
310-- Produced schema can be used for further refinement.
325--
311--
326−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema "hello"
312+-- >>> encode $ sketchSchema "hello"
327−-- {
328−-- "example": "hello",
313+-- "{\"example\":\"hello\",\"type\":\"string\"}"
329−-- "type": "string"
330−-- }
331--
314--
332−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (1, 2, 3)
315+-- >>> encode $ sketchSchema (1, 2, 3)
333−-- {
334−-- "example": [
335−-- 1,
336−-- 2,
337−-- 3
338−-- ],
339−-- "items": {
340−-- "type": "number"
316+-- "{\"example\":[1,2,3],\"items\":{\"type\":\"number\"},\"type\":\"array\"}"
341−-- },
342−-- "type": "array"
343−-- }
344--
317--
345−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema ("Jack", 25)
318+-- >>> encode $ sketchSchema ("Jack", 25)
346−-- {
319+-- "{\"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--
320--
362-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
321-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
363-- >>> instance ToJSON Person
322-- >>> instance ToJSON Person
364−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (Person "Jack" 25)
323+-- >>> encode $ sketchSchema (Person "Jack" 25)
365−-- {
324+-- "{\"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
325sketchSchema :: ToJSON a => a -> Schema
385sketchSchema = sketch . toJSON
326sketchSchema = sketch . toJSON
386 where
327 where
@@ -388,15 +329,15 @@ sketchSchema = sketch . toJSON
388 sketch js@(Bool _) = go js
329 sketch js@(Bool _) = go js
389 sketch js = go js & example ?~ js
330 sketch js = go js & example ?~ js
390
331
391− go Null = mempty & type_ ?~ OpenApiNull
332+ go Null = mempty & type_ ?~ SwaggerNull
392− go (Bool _) = mempty & type_ ?~ OpenApiBoolean
333+ go (Bool _) = mempty & type_ ?~ SwaggerBoolean
393− go (String _) = mempty & type_ ?~ OpenApiString
334+ go (String _) = mempty & type_ ?~ SwaggerString
394− go (Number _) = mempty & type_ ?~ OpenApiNumber
335+ go (Number _) = mempty & type_ ?~ SwaggerNumber
395 go (Array xs) = mempty
336 go (Array xs) = mempty
396− & type_ ?~ OpenApiArray
337+ & type_ ?~ SwaggerArray
397 & items ?~ case ischema of
338 & items ?~ case ischema of
398− Just s -> OpenApiItemsObject (Inline s)
339+ Just s -> SwaggerItemsObject (Inline s)
399− _ -> OpenApiItemsArray (map Inline ys)
340+ _ -> SwaggerItemsArray (map Inline ys)
400 where
341 where
401 ys = map go (V.toList xs)
342 ys = map go (V.toList xs)
402 allSame = and ((zipWith (==)) ys (tail ys))
343 allSame = and ((zipWith (==)) ys (tail ys))
@@ -405,178 +346,64 @@ sketchSchema = sketch . toJSON
405 (z:_) | allSame -> Just z
346 (z:_) | allSame -> Just z
406 _ -> Nothing
347 _ -> Nothing
407 go (Object o) = mempty
348 go (Object o) = mempty
408− & type_ ?~ OpenApiObject
349+ & type_ ?~ SwaggerObject
409− & required .~ sort (objectKeys o)
350+ & required .~ HashMap.keys o
410− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
351+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
411
352
412-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
353-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
413-- Produced schema uses as much constraints as possible.
354-- Produced schema uses as much constraints as possible.
414--
355--
415−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema "hello"
356+-- >>> encode $ sketchStrictSchema "hello"
416−-- {
357+-- "{\"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--
358--
426−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (1, 2, 3)
359+-- >>> encode $ sketchStrictSchema (1, 2, 3)
427−-- {
360+-- "{\"minItems\":3,\"uniqueItems\":true,\"items\":[{\"maximum\":1,\"minimum\":1,\"multipleOf\":1,\"type\":\"number\",\"enum\":[1]},{\"maximum\":2,\"minimum\":2,\"multipleOf\":2,\"type\":\"number\",\"enum\":[2]},{\"maximum\":3,\"minimum\":3,\"multipleOf\":3,\"type\":\"number\",\"enum\":[3]}],\"maxItems\":3,\"type\":\"array\",\"enum\":[[1,2,3]]}"
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--
361--
470−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema ("Jack", 25)
362+-- >>> encode $ sketchStrictSchema ("Jack", 25)
471−-- {
363+-- "{\"minItems\":2,\"uniqueItems\":true,\"items\":[{\"maxLength\":4,\"pattern\":\"Jack\",\"minLength\":4,\"type\":\"string\",\"enum\":[\"Jack\"]},{\"maximum\":25,\"minimum\":25,\"multipleOf\":25,\"type\":\"number\",\"enum\":[25]}],\"maxItems\":2,\"type\":\"array\",\"enum\":[[\"Jack\",25]]}"
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--
364--
504-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
365-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
505-- >>> instance ToJSON Person
366-- >>> instance ToJSON Person
506−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (Person "Jack" 25)
367+-- >>> encode $ sketchStrictSchema (Person "Jack" 25)
507−-- {
368+-- "{\"required\":[\"age\",\"name\"],\"properties\":{\"age\":{\"maximum\":25,\"minimum\":25,\"multipleOf\":25,\"type\":\"number\",\"enum\":[25]},\"name\":{\"maxLength\":4,\"pattern\":\"Jack\",\"minLength\":4,\"type\":\"string\",\"enum\":[\"Jack\"]}},\"maxProperties\":2,\"minProperties\":2,\"type\":\"object\",\"enum\":[{\"age\":25,\"name\":\"Jack\"}]}"
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
369sketchStrictSchema :: ToJSON a => a -> Schema
543sketchStrictSchema = go . toJSON
370sketchStrictSchema = go . toJSON
544 where
371 where
545− go Null = mempty & type_ ?~ OpenApiNull
372+ go Null = mempty & type_ ?~ SwaggerNull
546 go js@(Bool _) = mempty
373 go js@(Bool _) = mempty
547− & type_ ?~ OpenApiBoolean
374+ & type_ ?~ SwaggerBoolean
548 & enum_ ?~ [js]
375 & enum_ ?~ [js]
549 go js@(String s) = mempty
376 go js@(String s) = mempty
550− & type_ ?~ OpenApiString
377+ & type_ ?~ SwaggerString
551 & maxLength ?~ fromIntegral (T.length s)
378 & maxLength ?~ fromIntegral (T.length s)
552 & minLength ?~ fromIntegral (T.length s)
379 & minLength ?~ fromIntegral (T.length s)
553 & pattern ?~ s
380 & pattern ?~ s
554 & enum_ ?~ [js]
381 & enum_ ?~ [js]
555 go js@(Number n) = mempty
382 go js@(Number n) = mempty
556− & type_ ?~ OpenApiNumber
383+ & type_ ?~ SwaggerNumber
557 & maximum_ ?~ n
384 & maximum_ ?~ n
558 & minimum_ ?~ n
385 & minimum_ ?~ n
559 & multipleOf ?~ n
386 & multipleOf ?~ n
560 & enum_ ?~ [js]
387 & enum_ ?~ [js]
561 go js@(Array xs) = mempty
388 go js@(Array xs) = mempty
562− & type_ ?~ OpenApiArray
389+ & type_ ?~ SwaggerArray
563 & maxItems ?~ fromIntegral sz
390 & maxItems ?~ fromIntegral sz
564 & minItems ?~ fromIntegral sz
391 & minItems ?~ fromIntegral sz
565− & items ?~ OpenApiItemsArray (map (Inline . go) (V.toList xs))
392+ & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
566 & uniqueItems ?~ allUnique
393 & uniqueItems ?~ allUnique
567 & enum_ ?~ [js]
394 & enum_ ?~ [js]
568 where
395 where
569 sz = length xs
396 sz = length xs
570 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
397 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
571 go js@(Object o) = mempty
398 go js@(Object o) = mempty
572− & type_ ?~ OpenApiObject
399+ & type_ ?~ SwaggerObject
573− & required .~ sort names
400+ & required .~ names
574− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
401+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
575 & maxProperties ?~ fromIntegral (length names)
402 & maxProperties ?~ fromIntegral (length names)
576 & minProperties ?~ fromIntegral (length names)
403 & minProperties ?~ fromIntegral (length names)
577 & enum_ ?~ [js]
404 & enum_ ?~ [js]
578 where
405 where
579− names = objectKeys o
406+ names = HashMap.keys o
580
407
581class GToSchema (f :: * -> *) where
408class GToSchema (f :: * -> *) where
582 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
409 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
@@ -585,8 +412,8 @@ instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
585 declareNamedSchema _ = do
412 declareNamedSchema _ = do
586 ref <- declareSchemaRef (Proxy :: Proxy a)
413 ref <- declareSchemaRef (Proxy :: Proxy a)
587 return $ unnamed $ mempty
414 return $ unnamed $ mempty
588− & type_ ?~ OpenApiArray
415+ & type_ ?~ SwaggerArray
589− & items ?~ OpenApiItemsObject ref
416+ & items ?~ SwaggerItemsObject ref
590
417
591instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
418instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
592instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
419instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
@@ -611,14 +438,12 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
611instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
438instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
612instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
439instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
613
440
614−instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
441+instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
615
442
616instance ToSchema a => ToSchema (Maybe a) where
443instance ToSchema a => ToSchema (Maybe a) where
617 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
444 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
618
445
619−instance (ToSchema a, ToSchema b) => ToSchema (Either a b) where
446+instance (ToSchema a, ToSchema b) => ToSchema (Either a b)
620− -- To match Aeson instance
621− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { sumEncoding = ObjectWithSingleField }
622
447
623instance ToSchema () where
448instance ToSchema () where
624 declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
449 declareNamedSchema _ = pure (NamedSchema Nothing nullarySchema)
@@ -628,22 +453,16 @@ instance ToSchema UUID.UUID where
628 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
453 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
629 & example ?~ toJSON (UUID.toText UUID.nil)
454 & example ?~ toJSON (UUID.toText UUID.nil)
630
455
631−instance (ToSchema a, ToSchema b) => ToSchema (a, b) where
456+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
457+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
458+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
459+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
460+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
461+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
462
644timeSchema :: T.Text -> Schema
463timeSchema :: T.Text -> Schema
645timeSchema fmt = mempty
464timeSchema fmt = mempty
646− & type_ ?~ OpenApiString
465+ & type_ ?~ SwaggerString
647 & format ?~ fmt
466 & format ?~ fmt
648
467
649-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
468-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -658,7 +477,7 @@ instance ToSchema LocalTime where
658 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
477 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
659 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
478 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
660
479
661−-- | Format @"date-time"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
480+-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
662instance ToSchema ZonedTime where
481instance ToSchema ZonedTime where
663 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
482 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
664 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
483 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
@@ -690,7 +509,7 @@ instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where
690instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
509instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
691
510
692-- | NOTE: This schema does not account for the uniqueness of keys.
511-- | NOTE: This schema does not account for the uniqueness of keys.
693−instance (ToSchema a) => ToSchema (IntMap a) where
512+instance ToSchema a => ToSchema (IntMap a) where
694 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
513 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
695
514
696instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
515instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
@@ -701,7 +520,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
701 declareObjectMapSchema = do
520 declareObjectMapSchema = do
702 schema <- declareSchemaRef (Proxy :: Proxy v)
521 schema <- declareSchemaRef (Proxy :: Proxy v)
703 return $ unnamed $ mempty
522 return $ unnamed $ mempty
704− & type_ ?~ OpenApiObject
523+ & type_ ?~ SwaggerObject
705 & additionalProperties ?~ AdditionalPropertiesSchema schema
524 & additionalProperties ?~ AdditionalPropertiesSchema schema
706
525
707instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
526instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
@@ -709,7 +528,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
709
528
710instance {-# OVERLAPPING #-} ToSchema Object where
529instance {-# OVERLAPPING #-} ToSchema Object where
711 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
530 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
712− & type_ ?~ OpenApiObject
531+ & type_ ?~ SwaggerObject
713 & description ?~ "Arbitrary JSON object."
532 & description ?~ "Arbitrary JSON object."
714 & additionalProperties ?~ AdditionalPropertiesAllowed True
533 & additionalProperties ?~ AdditionalPropertiesAllowed True
715
534
@@ -746,15 +565,11 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
746
565
747-- | Default schema for @'Bounded'@, @'Integral'@ types.
566-- | Default schema for @'Bounded'@, @'Integral'@ types.
748--
567--
749−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
568+-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
750−-- {
751−-- "maximum": 32767,
569+-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
752−-- "minimum": -32768,
753−-- "type": "integer"
754−-- }
755toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
570toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
756toSchemaBoundedIntegral _ = mempty
571toSchemaBoundedIntegral _ = mempty
757− & type_ ?~ OpenApiInteger
572+ & type_ ?~ SwaggerInteger
758 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
573 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
759 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
574 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
760
575
@@ -783,27 +598,8 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
783-- >>> instance ToSchema ButtonState
598-- >>> instance ToSchema ButtonState
784-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
599-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
785-- >>> type ImageUrl = T.Text
600-- >>> type ImageUrl = T.Text
786−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
601+-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
787−-- {
602+-- "{\"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--
603--
808-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
604-- 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.
605-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -811,15 +607,15 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.
811 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
607 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
812 => Proxy (map key value) -> Declare (Definitions Schema) Schema
608 => Proxy (map key value) -> Declare (Definitions Schema) Schema
813declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
609declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
814− ToJSONKeyText getKey _ -> objectSchema getKey
610+ ToJSONKeyText keyToText _ -> objectSchema keyToText
815 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
611 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
816 where
612 where
817− objectSchema getKey = do
613+ objectSchema keyToText = do
818 valueRef <- declareSchemaRef (Proxy :: Proxy value)
614 valueRef <- declareSchemaRef (Proxy :: Proxy value)
819 let allKeys = [minBound..maxBound :: key]
615 let allKeys = [minBound..maxBound :: key]
820− mkPair k = (keyToText $ getKey k, valueRef)
616+ mkPair k = (keyToText k, valueRef)
821 return $ mempty
617 return $ mempty
822− & type_ ?~ OpenApiObject
618+ & type_ ?~ SwaggerObject
823 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
619 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
824
620
825-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
621-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -830,27 +626,8 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
830-- >>> instance ToSchema ButtonState
626-- >>> instance ToSchema ButtonState
831-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
627-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
832-- >>> type ImageUrl = T.Text
628-- >>> type ImageUrl = T.Text
833−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
629+-- >>> encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
834−-- {
630+-- "{\"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--
631--
855-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
632-- 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.
633-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -860,32 +637,32 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.
860toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
637toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
861
638
862-- | A configurable generic @'Schema'@ creator.
639-- | A configurable generic @'Schema'@ creator.
863−genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
640+genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>
864 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
641 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
865−genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
642+genericDeclareSchema = genericDeclareSchemaUnrestricted
866
643
867-- | A configurable generic @'NamedSchema'@ creator.
644-- | A configurable generic @'NamedSchema'@ creator.
868-- This function applied to @'defaultSchemaOptions'@
645-- This function applied to @'defaultSchemaOptions'@
869-- is used as the default for @'declareNamedSchema'@
646-- is used as the default for @'declareNamedSchema'@
870-- when the type is an instance of @'Generic'@.
647-- when the type is an instance of @'Generic'@.
648+genericDeclareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>
649+ SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
650+genericDeclareNamedSchema = genericDeclareNamedSchemaUnrestricted
651+
652+-- | A configurable generic @'Schema'@ creator.
871--
653--
872−-- Default implementation will use the name from 'Typeable' instance, including concrete
654+-- Unlike 'genericDeclareSchema' also works for mixed sum types.
873−-- instantioations of type variables.
655+-- Use with care since some Swagger tools do not support well schemas for mixed sum types.
874−--
656+genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
875−-- For example:
657+genericDeclareSchemaUnrestricted opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchemaUnrestricted opts proxy
658+
659+-- | A configurable generic @'NamedSchema'@ creator.
876--
660--
877−-- >>> _namedSchemaName $ undeclare $ genericDeclareNamedSchema defaultSchemaOptions (Proxy :: Proxy (Either Int Bool))
661+-- Unlike 'genericDeclareNamedSchema' also works for mixed sum types.
878−-- Just "Either_Int_Bool"
662+-- 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) =>
663+genericDeclareNamedSchemaUnrestricted :: forall a. (Generic a, GToSchema (Rep a)) =>
880 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
664 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
881−genericDeclareNamedSchema opts _ =
882− rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
665+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
666
890-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
667-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
891genericNameSchema :: forall a d f.
668genericNameSchema :: forall a d f.
@@ -901,19 +678,19 @@ gdatatypeSchemaName opts _ = case orig of
901 orig = datatypeName (Proxy3 :: Proxy3 d f a)
678 orig = datatypeName (Proxy3 :: Proxy3 d f a)
902 name = datatypeNameModifier opts orig
679 name = datatypeNameModifier opts orig
903
680
904−-- | Construct 'NamedSchema' usinng 'ToParamSchema'.
681+-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
905paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
682paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
906 SchemaOptions -> Proxy a -> NamedSchema
683 SchemaOptions -> Proxy a -> NamedSchema
907paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
684paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
908
685
909−-- | Construct 'Schema' usinng 'ToParamSchema'.
686+-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
910paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
687paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
911−paramSchemaToSchema = toParamSchema
688+paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
912
689
913nullarySchema :: Schema
690nullarySchema :: Schema
914nullarySchema = mempty
691nullarySchema = mempty
915− & type_ ?~ OpenApiArray
692+ & type_ ?~ SwaggerArray
916− & items ?~ OpenApiItemsArray []
693+ & items ?~ SwaggerItemsArray []
917
694
918gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
695gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
919gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
696gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
@@ -943,15 +720,12 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
943 | unwrapUnaryRecords opts = fieldSchema
720 | unwrapUnaryRecords opts = fieldSchema
944 | otherwise =
721 | otherwise =
945 case schema ^. items of
722 case schema ^. items of
946− Just (OpenApiItemsArray [_]) -> fieldSchema
723+ Just (SwaggerItemsArray [_]) -> fieldSchema
947 _ -> do
724 _ -> do
948− -- We have to run recordSchema instead of just using its defs,
725+ 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')
726+ return (unnamed schema)
953 where
727 where
954− (_, NamedSchema _ schema) = runDeclare recordSchema mempty
728+ (defs, NamedSchema _ schema) = runDeclare recordSchema mempty
955 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
729 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
956 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
730 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
957
731
@@ -974,10 +748,10 @@ gdeclareSchemaRef opts proxy = do
974 return $ Ref (Reference name)
748 return $ Ref (Reference name)
975 _ -> Inline <$> gdeclareSchema opts proxy
749 _ -> Inline <$> gdeclareSchema opts proxy
976
750
977−appendItem :: Referenced Schema -> Maybe OpenApiItems -> Maybe OpenApiItems
751+appendItem :: Referenced Schema -> Maybe (SwaggerItems 'SwaggerKindSchema) -> Maybe (SwaggerItems 'SwaggerKindSchema)
978−appendItem x Nothing = Just (OpenApiItemsArray [x])
752+appendItem x Nothing = Just (SwaggerItemsArray [x])
979−appendItem x (Just (OpenApiItemsArray xs)) = Just (OpenApiItemsArray (xs ++ [x]))
753+appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
980−appendItem _ _ = error "GToSchema.appendItem: cannot append to OpenApiItemsObject"
754+appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
981
755
982withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
756withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
983 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
757 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
@@ -986,12 +760,12 @@ withFieldSchema opts _ isRequiredField schema = do
986 return $
760 return $
987 if T.null fname
761 if T.null fname
988 then schema
762 then schema
989− & type_ ?~ OpenApiArray
763+ & type_ ?~ SwaggerArray
990 & items %~ appendItem ref
764 & items %~ appendItem ref
991 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
765 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
992 & minItems %~ Just . maybe 1 (+1) -- increment minItems
766 & minItems %~ Just . maybe 1 (+1) -- increment minItems
993 else schema
767 else schema
994− & type_ ?~ OpenApiObject
768+ & type_ ?~ SwaggerObject
995 & properties . at fname ?~ ref
769 & properties . at fname ?~ ref
996 & if isRequiredField
770 & if isRequiredField
997 then required %~ (++ [fname])
771 then required %~ (++ [fname])
@@ -1017,110 +791,62 @@ instance ( GSumToSchema f
1017 , GSumToSchema g
791 , GSumToSchema g
1018 ) => GToSchema (f :+: g)
792 ) => GToSchema (f :+: g)
1019 where
793 where
1020− -- Aeson does not unwrap unary record in sum types.
1021− gdeclareNamedSchema opts p s = gdeclareNamedSumSchema (opts { unwrapUnaryRecords = False } )p s
794+ gdeclareNamedSchema = gdeclareNamedSumSchema
1022
795
1023gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
796gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
1024−gdeclareNamedSumSchema opts proxy _
797+gdeclareNamedSumSchema opts proxy s
1025− | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchemas)
798+ | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)
1026− | otherwise = do
1027− (schemas, _) <- runWriterT declareSumSchema
799+ | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema
1028− return $ unnamed $ mempty
1029− & type_ ?~ OpenApiObject
1030− & oneOf ?~ (snd <$> schemas)
1031 where
800 where
1032− declareSumSchema = gsumToSchema opts proxy
801+ declareSumSchema = gsumToSchema opts proxy s
1033− (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
802+ (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
1034
803
1035− toStringTag schemas = mempty
804+ toStringTag schema = mempty
1036− & type_ ?~ OpenApiString
805+ & type_ ?~ SwaggerString
1037− & enum_ ?~ map (String . fst) sumSchemas
806+ & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
1038
807
1039type AllNullary = All
808type AllNullary = All
1040
809
1041class GSumToSchema (f :: * -> *) where
810class GSumToSchema (f :: * -> *) where
1042− gsumToSchema :: SchemaOptions -> Proxy f -> WriterT AllNullary (Declare (Definitions Schema)) [(T.Text, Referenced Schema)]
811+ gsumToSchema :: SchemaOptions -> Proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema
1043
812
1044instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
813instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
1045− gsumToSchema opts _ =
1046− (<>) <$> gsumToSchema opts (Proxy :: Proxy f) <*> gsumToSchema opts (Proxy :: Proxy g)
814+ gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)
1047
815
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) =>
816gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
1050− Maybe (Referenced Schema) -> SchemaOptions -> Proxy (C1 c f) -> (T.Text, Referenced Schema)
817+ Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
1051−gsumConToSchemaWith ref opts _ = (tag, schema)
818+gsumConToSchemaWith ref opts _ schema = schema
819+ & type_ ?~ SwaggerObject
820+ & properties . at tag ?~ ref
821+ & maxProperties ?~ 1
822+ & minProperties ?~ 1
1052 where
823 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)))
824 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
825
1094gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
826gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
1095− SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
827+ SchemaOptions -> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema
1096−gsumConToSchema opts proxy = do
828+gsumConToSchema opts proxy schema = do
1097 ref <- gdeclareSchemaRef opts proxy
829 ref <- gdeclareSchemaRef opts proxy
1098− return [gsumConToSchemaWith (Just ref) opts proxy]
830+ return $ gsumConToSchemaWith ref opts proxy schema
1099
831
1100instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
832instance {-# OVERLAPPABLE #-} (Constructor c, GToSchema f) => GSumToSchema (C1 c f) where
1101− gsumToSchema opts proxy = do
833+ gsumToSchema opts proxy schema = do
1102 tell (All False)
834 tell (All False)
1103− lift $ gsumConToSchema opts proxy
835+ lift $ gsumConToSchema opts proxy schema
1104
836
1105instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
837instance (Constructor c, Selector s, GToSchema f) => GSumToSchema (C1 c (S1 s f)) where
1106− gsumToSchema opts proxy = do
838+ gsumToSchema opts proxy schema = do
1107 tell (All False)
839 tell (All False)
1108− lift $ gsumConToSchema opts proxy
840+ lift $ gsumConToSchema opts proxy schema
1109
841
1110instance Constructor c => GSumToSchema (C1 c U1) where
842instance Constructor c => GSumToSchema (C1 c U1) where
1111− gsumToSchema opts proxy = pure $ (:[]) $ gsumConToSchemaWith Nothing opts proxy
843+ gsumToSchema opts proxy = pure . gsumConToSchemaWith (Inline nullarySchema) opts proxy
1112
844
1113data Proxy2 a b = Proxy2
845data Proxy2 a b = Proxy2
1114
846
1115data Proxy3 a b c = Proxy3
847data Proxy3 a b c = Proxy3
1116
848
1117−{- $setup
849+-- $setup
1118−>>> import Data.OpenApi
850+-- >>> import Data.Swagger
1119−>>> import Data.Aeson (encode)
851+-- >>> import Data.Aeson (encode)
1120−>>> import Data.Aeson.Types (toJSONKeyText)
852+-- >>> 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+98−119
@@ -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,33 +12,29 @@
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
24
27import Prelude ()
25import Prelude ()
28import Prelude.Compat
26import Prelude.Compat
29
27
30import Control.Applicative
28import Control.Applicative
31−import Control.Lens hiding (allOf)
29+import Control.Lens
32−import Control.Monad (forM, forM_, when)
30+import Control.Monad (when)
33
31
34import Data.Aeson hiding (Result)
32import Data.Aeson hiding (Result)
35−#if MIN_VERSION_aeson(2,0,0)
33+import Data.Aeson.Encode.Pretty (encodePretty)
36−import qualified Data.Aeson.KeyMap as KeyMap
37−#endif
38import Data.Foldable (for_, sequenceA_,
34import Data.Foldable (for_, sequenceA_,
39 traverse_)
35 traverse_)
40−#if !MIN_VERSION_aeson(2,0,0)
41import Data.HashMap.Strict (HashMap)
36import Data.HashMap.Strict (HashMap)
42−#endif
37+import qualified Data.HashMap.Strict as HashMap
43import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
38import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
44import qualified "unordered-containers" Data.HashSet as HashSet
39import qualified "unordered-containers" Data.HashSet as HashSet
45import Data.Maybe (fromMaybe)
40import Data.Maybe (fromMaybe)
@@ -52,12 +47,10 @@ import qualified Data.Text.Lazy.Encoding as TL
52import Data.Vector (Vector)
47import Data.Vector (Vector)
53import qualified Data.Vector as Vector
48import qualified Data.Vector as Vector
54
49
55−import Data.OpenApi.Aeson.Compat (hasKey, keyToText, lookupKey, objectToList)
56−import Data.OpenApi.Declare
50+import Data.Swagger.Declare
57−import Data.OpenApi.Internal
51+import Data.Swagger.Internal
58−import Data.OpenApi.Internal.Schema
52+import Data.Swagger.Internal.Schema
59−import Data.OpenApi.Internal.Utils
53+import Data.Swagger.Lens
60−import Data.OpenApi.Lens
61
54
62-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
55-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
63-- This can be used with QuickCheck to ensure those instances are coherent:
56-- This can be used with QuickCheck to ensure those instances are coherent:
@@ -109,33 +102,33 @@ validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checke
109-- <BLANKLINE>
102-- <BLANKLINE>
110-- Swagger Schema:
103-- Swagger Schema:
111-- {
104-- {
112−-- "properties": {
113−-- "name": {
114−-- "type": "string"
115−-- },
116−-- "phone": {
117−-- "$ref": "#/components/schemas/Phone"
118−-- }
119−-- },
120-- "required": [
105-- "required": [
121-- "name",
106-- "name",
122-- "phone"
107-- "phone"
123-- ],
108-- ],
124−-- "type": "object"
109+-- "type": "object",
110+-- "properties": {
111+-- "phone": {
112+-- "$ref": "#/definitions/Phone"
113+-- },
114+-- "name": {
115+-- "type": "string"
116+-- }
117+-- }
125-- }
118-- }
126-- <BLANKLINE>
119-- <BLANKLINE>
127-- Swagger Description Context:
120-- Swagger Description Context:
128-- {
121-- {
129-- "Phone": {
122-- "Phone": {
123+-- "required": [
124+-- "value"
125+-- ],
126+-- "type": "object",
130-- "properties": {
127-- "properties": {
131-- "value": {
128-- "value": {
132-- "type": "string"
129-- "type": "string"
133-- }
130-- }
134−-- },
131+-- }
135−-- "required": [
136−-- "value"
137−-- ],
138−-- "type": "object"
139-- }
132-- }
140-- }
133-- }
141-- <BLANKLINE>
134-- <BLANKLINE>
@@ -211,7 +204,7 @@ instance Monad Result where
211
204
212-- | Validation configuration.
205-- | Validation configuration.
213data Config = Config
206data Config = Config
214− { -- | Pattern checker for @'_schemaPattern'@ validation.
207+ { -- | Pattern checker for @'_paramSchemaPattern'@ validation.
215 configPatternChecker :: Pattern -> Text -> Bool
208 configPatternChecker :: Pattern -> Text -> Bool
216 -- | Schema definitions in scope to resolve references.
209 -- | Schema definitions in scope to resolve references.
217 , configDefinitions :: Definitions Schema
210 , configDefinitions :: Definitions Schema
@@ -304,34 +297,40 @@ validateWithSchemaRef (Inline s) js = sub s (validateWithSchema js)
304
297
305-- | Validate JSON @'Value'@ with Swagger @'Schema'@.
298-- | Validate JSON @'Value'@ with Swagger @'Schema'@.
306validateWithSchema :: Value -> Validation Schema ()
299validateWithSchema :: Value -> Validation Schema ()
307−validateWithSchema val = do
300+validateWithSchema value = do
308− validateSchemaType val
301+ validateSchemaType value
309− validateEnum val
302+ sub_ paramSchema $ validateEnum value
303+
304+-- | Validate JSON @'Value'@ with Swagger @'ParamSchema'@.
305+validateWithParamSchema :: Value -> Validation (ParamSchema t) ()
306+validateWithParamSchema value = do
307+ validateParamSchemaType value
308+ validateEnum value
310
309
311−validateInteger :: Scientific -> Validation Schema ()
310+validateInteger :: Scientific -> Validation (ParamSchema t) ()
312validateInteger n = do
311validateInteger n = do
313 when (not (isInteger n)) $
312 when (not (isInteger n)) $
314 invalid ("not an integer")
313 invalid ("not an integer")
315 validateNumber n
314 validateNumber n
316
315
317−validateNumber :: Scientific -> Validation Schema ()
316+validateNumber :: Scientific -> Validation (ParamSchema t) ()
318validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do
317validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do
319 let exMax = Just True == sch ^. exclusiveMaximum
318 let exMax = Just True == sch ^. exclusiveMaximum
320 exMin = Just True == sch ^. exclusiveMinimum
319 exMin = Just True == sch ^. exclusiveMinimum
321
320
322 check maximum_ $ \m ->
321 check maximum_ $ \m ->
323 when (if exMax then (n >= m) else (n > m)) $
322 when (if exMax then (n >= m) else (n > m)) $
324− invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ (if exMax then "<" else "<=") ++ show m ++ ")")
323+ invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ if exMax then "<" else "<=" ++ show m ++ ")")
325
324
326 check minimum_ $ \m ->
325 check minimum_ $ \m ->
327 when (if exMin then (n <= m) else (n < m)) $
326 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 ++ ")")
327+ invalid ("value " ++ show n ++ " falls below minimum (should be " ++ if exMin then ">" else ">=" ++ show m ++ ")")
329
328
330 check multipleOf $ \k ->
329 check multipleOf $ \k ->
331 when (not (isInteger (n / k))) $
330 when (not (isInteger (n / k))) $
332 invalid ("expected a multiple of " ++ show k ++ " but got " ++ show n)
331 invalid ("expected a multiple of " ++ show k ++ " but got " ++ show n)
333
332
334−validateString :: Text -> Validation Schema ()
333+validateString :: Text -> Validation (ParamSchema t) ()
335validateString s = do
334validateString s = do
336 check maxLength $ \n ->
335 check maxLength $ \n ->
337 when (len > fromInteger n) $
336 when (len > fromInteger n) $
@@ -348,7 +347,7 @@ validateString s = do
348 where
347 where
349 len = Text.length s
348 len = Text.length s
350
349
351−validateArray :: Vector Value -> Validation Schema ()
350+validateArray :: Vector Value -> Validation (ParamSchema t) ()
352validateArray xs = do
351validateArray xs = do
353 check maxItems $ \n ->
352 check maxItems $ \n ->
354 when (len > fromInteger n) $
353 when (len > fromInteger n) $
@@ -359,8 +358,9 @@ validateArray xs = do
359 invalid ("array is too short (size should be >=" ++ show n ++ ")")
358 invalid ("array is too short (size should be >=" ++ show n ++ ")")
360
359
361 check items $ \case
360 check items $ \case
361+ SwaggerItemsPrimitive _ itemSchema -> sub itemSchema $ traverse_ validateWithParamSchema xs
362− OpenApiItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs
362+ SwaggerItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs
363− OpenApiItemsArray itemSchemas -> do
363+ SwaggerItemsArray itemSchemas -> do
364 when (len /= length itemSchemas) $
364 when (len /= length itemSchemas) $
365 invalid ("array size is invalid (should be exactly " ++ show (length itemSchemas) ++ ")")
365 invalid ("array size is invalid (should be exactly " ++ show (length itemSchemas) ++ ")")
366 sequenceA_ (zipWith validateWithSchemaRef itemSchemas (Vector.toList xs))
366 sequenceA_ (zipWith validateWithSchemaRef itemSchemas (Vector.toList xs))
@@ -372,16 +372,10 @@ validateArray xs = do
372 len = Vector.length xs
372 len = Vector.length xs
373 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))
373 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))
374
374
375−validateObject ::
376−#if MIN_VERSION_aeson(2,0,0)
377− KeyMap.KeyMap Value
378−#else
379− HashMap Text Value
375+validateObject :: HashMap Text Value -> Validation Schema ()
380−#endif
381− -> Validation Schema ()
382validateObject o = withSchema $ \sch ->
376validateObject o = withSchema $ \sch ->
383 case sch ^. discriminator of
377 case sch ^. discriminator of
384− Just (Discriminator pname types) -> case fromJSON <$> lookupKey pname o of
378+ Just (Discriminator pname types) -> case fromJSON <$> HashMap.lookup pname o of
385 Just (Success pvalue) ->
379 Just (Success pvalue) ->
386 let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types
380 let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types
387 -- TODO ref may be name or reference
381 -- TODO ref may be name or reference
@@ -400,15 +394,15 @@ validateObject o = withSchema $ \sch ->
400 validateRequired
394 validateRequired
401 validateProps
395 validateProps
402 where
396 where
403− size = fromIntegral (length o)
397+ size = fromIntegral (HashMap.size o)
404
398
405 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)
399 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)
406 validateReq n =
400 validateReq n =
407− when (not (hasKey n o)) $
401+ when (not (HashMap.member n o)) $
408 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))
402 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))
409
403
410 validateProps = withSchema $ \sch -> do
404 validateProps = withSchema $ \sch -> do
411− for_ (objectToList o) $ \(keyToText -> k, v) ->
405+ for_ (HashMap.toList o) $ \(k, v) ->
412 case v of
406 case v of
413 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property
407 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property
414 _ ->
408 _ ->
@@ -424,21 +418,21 @@ validateObject o = withSchema $ \sch ->
424 unknownProperty pname = invalid $
418 unknownProperty pname = invalid $
425 "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"
419 "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"
426
420
427−validateEnum :: Value -> Validation Schema ()
421+validateEnum :: Value -> Validation (ParamSchema t) ()
428−validateEnum val = do
422+validateEnum value = do
429 check enum_ $ \xs ->
423 check enum_ $ \xs ->
430− when (val `notElem` xs) $
424+ when (value `notElem` xs) $
431− invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show val)
425+ invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)
432
426
433-- | Infer schema type based on used properties.
427-- | Infer schema type based on used properties.
434--
428--
435-- This is like 'inferParamSchemaTypes', but also works for objects:
429-- This is like 'inferParamSchemaTypes', but also works for objects:
436--
430--
437-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"
431-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"
438−-- Just [OpenApiObject]
432+-- Just [SwaggerObject]
439−inferSchemaTypes :: Schema -> [OpenApiType]
433+inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]
440−inferSchemaTypes sch = inferParamSchemaTypes sch ++
434+inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++
441− [ OpenApiObject | any ($ sch)
435+ [ SwaggerObject | any ($ sch)
442 [ has (additionalProperties._Just)
436 [ has (additionalProperties._Just)
443 , has (maxProperties._Just)
437 , has (maxProperties._Just)
444 , has (minProperties._Just)
438 , has (minProperties._Just)
@@ -448,77 +442,62 @@ inferSchemaTypes sch = inferParamSchemaTypes sch ++
448-- | Infer schema type based on used properties.
442-- | Infer schema type based on used properties.
449--
443--
450-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"
444-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"
451−-- Just [OpenApiString]
445+-- Just [SwaggerString]
452--
446--
453-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"
447-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"
454−-- Just [OpenApiArray]
448+-- Just [SwaggerArray]
455--
449--
456−-- From numeric properties 'OpenApiInteger' type is inferred.
450+-- From numeric properties 'SwaggerInteger' type is inferred.
457−-- If you want 'OpenApiNumber' instead, you must specify it explicitly.
451+-- If you want 'SwaggerNumber' instead, you must specify it explicitly.
458--
452--
459-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"
453-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"
460−-- Just [OpenApiInteger]
454+-- Just [SwaggerInteger]
461−inferParamSchemaTypes :: Schema -> [OpenApiType]
455+inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]
462inferParamSchemaTypes sch = concat
456inferParamSchemaTypes sch = concat
463− [ [ OpenApiArray | any ($ sch)
457+ [ [ SwaggerArray | any ($ sch)
464 [ has (items._Just)
458 [ has (items._Just)
465 , has (maxItems._Just)
459 , has (maxItems._Just)
466 , has (minItems._Just)
460 , has (minItems._Just)
467 , has (uniqueItems._Just) ] ]
461 , has (uniqueItems._Just) ] ]
468− , [ OpenApiInteger | any ($ sch)
462+ , [ SwaggerInteger | any ($ sch)
469 [ has (exclusiveMaximum._Just)
463 [ has (exclusiveMaximum._Just)
470 , has (exclusiveMinimum._Just)
464 , has (exclusiveMinimum._Just)
471 , has (maximum_._Just)
465 , has (maximum_._Just)
472 , has (minimum_._Just)
466 , has (minimum_._Just)
473 , has (multipleOf._Just) ] ]
467 , has (multipleOf._Just) ] ]
474− , [ OpenApiString | any ($ sch)
468+ , [ SwaggerString | any ($ sch)
475 [ has (maxLength._Just)
469 [ has (maxLength._Just)
476 , has (minLength._Just)
470 , has (minLength._Just)
477 , has (pattern._Just) ] ]
471 , has (pattern._Just) ] ]
478 ]
472 ]
479
473
480validateSchemaType :: Value -> Validation Schema ()
474validateSchemaType :: Value -> Validation Schema ()
481−validateSchemaType val = withSchema $ \sch ->
475+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
476+ case (sch ^. type_, value) of
498− (Just OpenApiNull, Null) -> valid
477+ (Just SwaggerNull, Null) -> valid
499− (Just OpenApiBoolean, Bool _) -> valid
478+ (Just SwaggerBoolean, Bool _) -> valid
500− (Just OpenApiInteger, Number n) -> validateInteger n
479+ (Just SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)
501− (Just OpenApiNumber, Number n) -> validateNumber n
480+ (Just SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)
502− (Just OpenApiString, String s) -> validateString s
481+ (Just SwaggerString, String s) -> sub_ paramSchema (validateString s)
503− (Just OpenApiArray, Array xs) -> validateArray xs
482+ (Just SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)
504− (Just OpenApiObject, Object o) -> validateObject o
483+ (Just SwaggerObject, Object o) -> validateObject o
505− (Nothing, Null) -> valid
484+ (Nothing, Null) -> valid
506− (Nothing, Bool _) -> valid
485+ (Nothing, Bool _) -> valid
507− -- Number by default
486+ -- Number by default
508− (Nothing, Number n) -> validateNumber n
487+ (Nothing, Number n) -> sub_ paramSchema (validateNumber n)
509− (Nothing, String s) -> validateString s
488+ (Nothing, String s) -> sub_ paramSchema (validateString s)
510− (Nothing, Array xs) -> validateArray xs
489+ (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)
511− (Nothing, Object o) -> validateObject o
490+ (Nothing, Object o) -> validateObject o
512− bad -> invalid $ "expected JSON value of type " ++ showType bad
491+ bad -> invalid $ "expected JSON value of type " ++ showType bad
513−
492+
514−validateParamSchemaType :: Value -> Validation Schema ()
493+validateParamSchemaType :: Value -> Validation (ParamSchema t) ()
515−validateParamSchemaType val = withSchema $ \sch ->
494+validateParamSchemaType value = withSchema $ \sch ->
516− case (sch ^. type_, val) of
495+ case (sch ^. type_, value) of
517− (Just OpenApiBoolean, Bool _) -> valid
496+ (Just SwaggerBoolean, Bool _) -> valid
518− (Just OpenApiInteger, Number n) -> validateInteger n
497+ (Just SwaggerInteger, Number n) -> validateInteger n
519− (Just OpenApiNumber, Number n) -> validateNumber n
498+ (Just SwaggerNumber, Number n) -> validateNumber n
520− (Just OpenApiString, String s) -> validateString s
499+ (Just SwaggerString, String s) -> validateString s
521− (Just OpenApiArray, Array xs) -> validateArray xs
500+ (Just SwaggerArray, Array xs) -> validateArray xs
522 (Nothing, Bool _) -> valid
501 (Nothing, Bool _) -> valid
523 -- Number by default
502 -- Number by default
524 (Nothing, Number n) -> validateNumber n
503 (Nothing, Number n) -> validateNumber n
@@ -526,11 +505,11 @@ validateParamSchemaType val = withSchema $ \sch ->
526 (Nothing, Array xs) -> validateArray xs
505 (Nothing, Array xs) -> validateArray xs
527 bad -> invalid $ "expected JSON value of type " ++ showType bad
506 bad -> invalid $ "expected JSON value of type " ++ showType bad
528
507
529−showType :: (Maybe OpenApiType, Value) -> String
508+showType :: (Maybe (SwaggerType t), Value) -> String
530showType (Just ty, _) = show ty
509showType (Just ty, _) = show ty
531−showType (Nothing, Null) = "OpenApiNull"
510+showType (Nothing, Null) = "SwaggerNull"
532−showType (Nothing, Bool _) = "OpenApiBoolean"
511+showType (Nothing, Bool _) = "SwaggerBoolean"
533−showType (Nothing, Number _) = "OpenApiNumber"
512+showType (Nothing, Number _) = "SwaggerNumber"
534−showType (Nothing, String _) = "OpenApiString"
513+showType (Nothing, String _) = "SwaggerString"
535−showType (Nothing, Array _) = "OpenApiArray"
514+showType (Nothing, Array _) = "SwaggerArray"
536−showType (Nothing, Object _) = "OpenApiObject"
515+showType (Nothing, Object _) = "SwaggerObject"
src/Data/OpenApi/Internal/TypeShape.hs → src/Data/Swagger/Internal/TypeShape.hsrenamed+1−1
@@ -4,7 +4,7 @@
4{-# LANGUAGE TypeOperators #-}
4{-# LANGUAGE TypeOperators #-}
5{-# LANGUAGE UndecidableInstances #-}
5{-# LANGUAGE UndecidableInstances #-}
6
6
7−module Data.OpenApi.Internal.TypeShape where
7+module Data.Swagger.Internal.TypeShape where
8
8
9import Data.Proxy
9import Data.Proxy
10import GHC.Generics
10import GHC.Generics
src/Data/OpenApi/Internal/Utils.hs → src/Data/Swagger/Internal/Utils.hsrenamed+1−6
@@ -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)
@@ -134,6 +132,3 @@ instance SwaggerMonoid (Maybe a) where
134 swaggerMempty = Nothing
132 swaggerMempty = Nothing
135 swaggerMappend x Nothing = x
133 swaggerMappend x Nothing = x
136 swaggerMappend _ y = y
134 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 FlexibleContexts #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE FunctionalDependencies #-}
4+{-# LANGUAGE GADTs #-}
5+{-# LANGUAGE MultiParamTypeClasses #-}
6+{-# LANGUAGE RankNTypes #-}
7+{-# LANGUAGE TemplateHaskell #-}
8+{-# LANGUAGE TypeFamilies #-}
9+{-# LANGUAGE DataKinds #-}
10+{-# LANGUAGE UndecidableInstances #-}
11+{-# OPTIONS_GHC -fno-warn-orphans #-}
12+-- |
13+-- Module: Data.Swagger.Lens
14+-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
15+-- Stability: experimental
16+--
17+-- Lenses and prisms for Swagger.
18+module Data.Swagger.Lens where
19+
20+import Control.Lens
21+import Data.Aeson (Value)
22+import Data.Scientific (Scientific)
23+import Data.Swagger.Internal
24+import Data.Swagger.Internal.Utils
25+import Data.Text (Text)
26+
27+-- * Classy lenses
28+
29+makeFields ''Swagger
30+makeFields ''Components
31+makeFields ''Server
32+-- conflict with enum of ParamSchema
33+--makeLensesWith swaggerFieldRules ''ServerVariable
34+makeFields ''RequestBody
35+makeFields ''MediaTypeObject
36+makeFields ''Info
37+makeFields ''Contact
38+makeFields ''License
39+makeLensesWith swaggerFieldRules ''PathItem
40+makeFields ''Tag
41+makeFields ''Operation
42+makeLensesWith swaggerFieldRules ''Param
43+makeFields ''Header
44+makeLensesWith swaggerFieldRules ''Schema
45+makeFields ''NamedSchema
46+makeLensesWith swaggerFieldRules ''ParamSchema
47+makeFields ''Xml
48+makeLensesWith swaggerFieldRules ''Responses
49+makeFields ''Response
50+makeLensesWith swaggerFieldRules ''SecurityScheme
51+makeFields ''ApiKeyParams
52+makeFields ''OAuth2ImplicitFlow
53+makeFields ''OAuth2PasswordFlow
54+makeFields ''OAuth2ClientCredentialsFlow
55+makeFields ''OAuth2AuthorizationCodeFlow
56+makeFields ''OAuth2Flow
57+makeFields ''OAuth2Flows
58+makeFields ''ExternalDocs
59+makeFields ''Encoding
60+makeFields ''Example
61+makeFields ''Discriminator
62+
63+-- * Prisms
64+-- ** 'SecuritySchemeType' prisms
65+makePrisms ''SecuritySchemeType
66+-- ** 'Referenced' prisms
67+makePrisms ''Referenced
68+
69+-- ** 'SwaggerItems' prisms
70+
71+_SwaggerItemsArray :: Review (SwaggerItems 'SwaggerKindSchema) [Referenced Schema]
72+_SwaggerItemsArray
73+ = unto (\x -> SwaggerItemsArray x)
74+{- \x -> case x of
75+ SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)
76+ SwaggerItemsObject o -> Left (SwaggerItemsObject o)
77+ SwaggerItemsArray a -> Right a
78+-}
79+
80+_SwaggerItemsObject :: Review (SwaggerItems 'SwaggerKindSchema) (Referenced Schema)
81+_SwaggerItemsObject
82+ = unto (\x -> SwaggerItemsObject x)
83+{- \x -> case x of
84+ SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)
85+ SwaggerItemsObject o -> Right o
86+ SwaggerItemsArray a -> Left (SwaggerItemsArray a)
87+-}
88+
89+_SwaggerItemsPrimitive :: forall t p f. (Profunctor p, Bifunctor p, Functor f) => Optic' p f (SwaggerItems t) (Maybe (CollectionFormat t), ParamSchema t)
90+_SwaggerItemsPrimitive = unto (\(c, p) -> SwaggerItemsPrimitive c p)
91+
92+-- =============================================================
93+-- More helpful instances for easier access to schema properties
94+
95+type instance Index Responses = HttpStatusCode
96+type instance Index Operation = HttpStatusCode
97+
98+type instance IxValue Responses = Referenced Response
99+type instance IxValue Operation = Referenced Response
100+
101+instance Ixed Responses where ix n = responses . ix n
102+instance At Responses where at n = responses . at n
103+
104+instance Ixed Operation where ix n = responses . ix n
105+instance At Operation where at n = responses . at n
106+
107+instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema
108+
109+-- HasType instances
110+instance HasType Header (Maybe (SwaggerType ('SwaggerKindNormal Header))) where type_ = schema.type_
111+instance HasType Schema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_
112+instance HasType NamedSchema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_
113+
114+-- HasDefault instances
115+instance HasDefault Header (Maybe Value) where default_ = schema.default_
116+instance HasDefault Schema (Maybe Value) where default_ = paramSchema.default_
117+
118+-- OVERLAPPABLE instances
119+
120+instance
121+ {-# OVERLAPPABLE #-}
122+ HasParamSchema s (ParamSchema t)
123+ => HasFormat s (Maybe Format) where
124+ format = paramSchema.format
125+
126+instance
127+ {-# OVERLAPPABLE #-}
128+ HasParamSchema s (ParamSchema t)
129+ => HasItems s (Maybe (SwaggerItems t)) where
130+ items = paramSchema.items
131+
132+instance
133+ {-# OVERLAPPABLE #-}
134+ HasParamSchema s (ParamSchema t)
135+ => HasMaximum s (Maybe Scientific) where
136+ maximum_ = paramSchema.maximum_
137+
138+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
139+ => HasExclusiveMaximum s (Maybe Bool) where
140+ exclusiveMaximum = paramSchema.exclusiveMaximum
141+
142+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
143+ => HasMinimum s (Maybe Scientific) where
144+ minimum_ = paramSchema.minimum_
145+
146+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
147+ => HasExclusiveMinimum s (Maybe Bool) where
148+ exclusiveMinimum = paramSchema.exclusiveMinimum
149+
150+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
151+ => HasMaxLength s (Maybe Integer) where
152+ maxLength = paramSchema.maxLength
153+
154+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
155+ => HasMinLength s (Maybe Integer) where
156+ minLength = paramSchema.minLength
157+
158+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
159+ => HasPattern s (Maybe Text) where
160+ pattern = paramSchema.pattern
161+
162+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
163+ => HasMaxItems s (Maybe Integer) where
164+ maxItems = paramSchema.maxItems
165+
166+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
167+ => HasMinItems s (Maybe Integer) where
168+ minItems = paramSchema.minItems
169+
170+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
171+ => HasUniqueItems s (Maybe Bool) where
172+ uniqueItems = paramSchema.uniqueItems
173+
174+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
175+ => HasEnum s (Maybe [Value]) where
176+ enum_ = paramSchema.enum_
177+
178+instance {-# OVERLAPPABLE #-} HasParamSchema s (ParamSchema t)
179+ => HasMultipleOf s (Maybe Scientific) where
180+ multipleOf = paramSchema.multipleOf
src/Data/OpenApi/Operation.hs → src/Data/Swagger/Operation.hsrenamed+31−140
@@ -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,
@@ -40,12 +40,11 @@ import Data.Maybe (mapMaybe)
40import Data.Proxy
40import Data.Proxy
41import qualified Data.Set as Set
41import qualified Data.Set as Set
42import Data.Text (Text)
42import Data.Text (Text)
43−import Network.HTTP.Media (MediaType)
44
43
45−import Data.OpenApi.Declare
44+import Data.Swagger.Declare
46−import Data.OpenApi.Internal
45+import Data.Swagger.Internal
47−import Data.OpenApi.Lens
46+import Data.Swagger.Lens
48−import Data.OpenApi.Schema
47+import Data.Swagger.Schema
49
48
50import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
49import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
51import qualified Data.HashSet.InsOrd as InsOrdHS
50import qualified Data.HashSet.InsOrd as InsOrdHS
@@ -54,18 +53,14 @@ import qualified Data.HashSet.InsOrd as InsOrdHS
54-- >>> import Data.Aeson
53-- >>> import Data.Aeson
55-- >>> import Data.Proxy
54-- >>> import Data.Proxy
56-- >>> import Data.Time
55-- >>> import Data.Time
57−-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
58−-- >>> import Data.OpenApi.Internal.Utils
59
56
60-- | Prepend path piece to all operations of the spec.
57-- | Prepend path piece to all operations of the spec.
61-- Leading and trailing slashes are trimmed/added automatically.
58-- Leading and trailing slashes are trimmed/added automatically.
62--
59--
63−-- >>> let api = (mempty :: OpenApi) & paths .~ [("/info", mempty)]
60+-- >>> let api = (mempty :: Swagger) & paths .~ [("/info", mempty)]
64−-- >>> BSL.putStrLn $ encodePretty $ prependPath "user/{user_id}" api ^. paths
61+-- >>> encode $ prependPath "user/{user_id}" api ^. paths
65−-- {
66−-- "/user/{user_id}/info": {}
62+-- "{\"/user/{user_id}/info\":{}}"
67−-- }
68−prependPath :: FilePath -> OpenApi -> OpenApi
63+prependPath :: FilePath -> Swagger -> Swagger
69prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
64prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
70 where
65 where
71 x </> y = case trim y of
66 x </> y = case trim y of
@@ -75,7 +70,7 @@ prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
75 trim = dropWhile (== '/') . dropWhileEnd (== '/')
70 trim = dropWhile (== '/') . dropWhileEnd (== '/')
76
71
77-- | All operations of a Swagger spec.
72-- | All operations of a Swagger spec.
78−allOperations :: Traversal' OpenApi Operation
73+allOperations :: Traversal' Swagger Operation
79allOperations = paths.traverse.template
74allOperations = paths.traverse.template
80
75
81-- | @'operationsOf' sub@ will traverse only those operations
76-- | @'operationsOf' sub@ will traverse only those operations
@@ -83,66 +78,13 @@ allOperations = paths.traverse.template
83-- by both path and method.
78-- by both path and method.
84--
79--
85-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
80-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
86−-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
81+-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
87−-- >>> let sub = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]
82+-- >>> let sub = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
88−-- >>> BSL.putStrLn $ encodePretty api
83+-- >>> encode api
89−-- {
84+-- "{\"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"
85+-- >>> encode $ api & operationsOf sub . at 404 ?~ "Not found"
116−-- {
86+-- "{\"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
87+operationsOf :: Swagger -> Traversal' Swagger Operation
146operationsOf sub = paths.itraversed.withIndex.subops
88operationsOf sub = paths.itraversed.withIndex.subops
147 where
89 where
148 -- | Traverse operations that correspond to paths and methods of the sub API.
90 -- | Traverse operations that correspond to paths and methods of the sub API.
@@ -164,12 +106,12 @@ operationsOf sub = paths.itraversed.withIndex.subops
164-- @
106-- @
165-- 'applyTags' = 'applyTagsFor' 'allOperations'
107-- 'applyTags' = 'applyTagsFor' 'allOperations'
166-- @
108-- @
167−applyTags :: [Tag] -> OpenApi -> OpenApi
109+applyTags :: [Tag] -> Swagger -> Swagger
168applyTags = applyTagsFor allOperations
110applyTags = applyTagsFor allOperations
169
111
170-- | Apply tags to a part of Swagger spec and update the global
112-- | Apply tags to a part of Swagger spec and update the global
171-- list of tags.
113-- list of tags.
172−applyTagsFor :: Traversal' OpenApi Operation -> [Tag] -> OpenApi -> OpenApi
114+applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
173applyTagsFor ops ts swag = swag
115applyTagsFor ops ts swag = swag
174 & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))
116 & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))
175 & tags %~ (<> InsOrdHS.fromList ts)
117 & tags %~ (<> InsOrdHS.fromList ts)
@@ -179,27 +121,9 @@ applyTagsFor ops ts swag = swag
179--
121--
180-- FIXME doc
122-- FIXME doc
181--
123--
182−-- >>> BSL.putStrLn $ encodePretty $ runDeclare (declareResponse "application/json" (Proxy :: Proxy Day)) mempty
124+-- >>> encode $ runDeclare (declareResponse (Proxy :: Proxy Day)) mempty
183−-- [
125+-- "[{\"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
126+declareResponse :: ToSchema a => Text -> Proxy a -> Declare (Definitions Schema) Response
203declareResponse cType proxy = do
127declareResponse cType proxy = do
204 s <- declareSchemaRef proxy
128 s <- declareSchemaRef proxy
205 return (mempty & content.at cType ?~ (mempty & schema ?~ s))
129 return (mempty & content.at cType ?~ (mempty & schema ?~ s))
@@ -215,46 +139,13 @@ declareResponse cType proxy = do
215--
139--
216-- Example:
140-- Example:
217--
141--
218−-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]
142+-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
219−-- >>> let res = declareResponse "application/json" (Proxy :: Proxy Day)
143+-- >>> let res = declareResponse (Proxy :: Proxy Day)
220−-- >>> BSL.putStrLn $ encodePretty $ api & setResponse 200 res
144+-- >>> encode $ api & setResponse 200 res
221−-- {
145+-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"responses\":{\"200\":{\"schema\":{\"$ref\":\"#/definitions/Day\"},\"description\":\"\"}}}}},\"definitions\":{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}}}"
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--
146--
256-- See also @'setResponseWith'@.
147-- See also @'setResponseWith'@.
257−setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
148+setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
258setResponse = setResponseFor allOperations
149setResponse = setResponseFor allOperations
259
150
260-- | Set or update response for all operations.
151-- | Set or update response for all operations.
@@ -268,7 +159,7 @@ setResponse = setResponseFor allOperations
268-- @
159-- @
269--
160--
270-- See also @'setResponse'@.
161-- See also @'setResponse'@.
271−setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
162+setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
272setResponseWith = setResponseForWith allOperations
163setResponseWith = setResponseForWith allOperations
273
164
274-- | Set response for specified operations.
165-- | Set response for specified operations.
@@ -277,7 +168,7 @@ setResponseWith = setResponseForWith allOperations
277-- If the response already exists it will be overwritten.
168-- If the response already exists it will be overwritten.
278--
169--
279-- See also @'setResponseForWith'@.
170-- See also @'setResponseForWith'@.
280−setResponseFor :: Traversal' OpenApi Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
171+setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
281setResponseFor ops code dres swag = swag
172setResponseFor ops code dres swag = swag
282 & components.schemas %~ (<> defs)
173 & components.schemas %~ (<> defs)
283 & ops . at code ?~ Inline res
174 & ops . at code ?~ Inline res
@@ -291,7 +182,7 @@ setResponseFor ops code dres swag = swag
291-- then just the new response is used.
182-- then just the new response is used.
292--
183--
293-- See also @'setResponseFor'@.
184-- See also @'setResponseFor'@.
294−setResponseForWith :: Traversal' OpenApi Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
185+setResponseForWith :: Traversal' Swagger Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
295setResponseForWith ops f code dres swag = swag
186setResponseForWith ops f code dres swag = swag
296 & components.schemas %~ (<> defs)
187 & components.schemas %~ (<> defs)
297 & ops . at code %~ Just . Inline . combine
188 & ops . at code %~ Just . Inline . combine
src/Data/Swagger/Optics.hsnew file+509
@@ -0,0 +1,509 @@
1+{-# LANGUAGE DataKinds #-}
2+{-# LANGUAGE FlexibleInstances #-}
3+{-# LANGUAGE MultiParamTypeClasses #-}
4+{-# LANGUAGE OverloadedLabels #-}
5+{-# LANGUAGE TemplateHaskell #-}
6+{-# LANGUAGE TypeFamilies #-}
7+{-# LANGUAGE UndecidableInstances #-}
8+{-# OPTIONS_GHC -fno-warn-orphans #-}
9+-- |
10+-- Module: Data.Swagger.Optics
11+-- Maintainer: Andrzej Rybczak <andrzej@rybczak.net>
12+-- Stability: experimental
13+--
14+-- Lenses and prisms for the <https://hackage.haskell.org/package/optics optics>
15+-- library.
16+--
17+-- >>> import Data.Aeson
18+-- >>> import Optics.Core
19+-- >>> :set -XOverloadedLabels
20+--
21+-- Example from the "Data.Swagger" module using @optics@:
22+--
23+-- >>> :{
24+-- encode $ (mempty :: Swagger)
25+-- & #definitions .~ [ ("User", mempty & #type ?~ SwaggerString) ]
26+-- & #paths .~
27+-- [ ("/user", mempty & #get ?~ (mempty
28+-- & #produces ?~ MimeList ["application/json"]
29+-- & at 200 ?~ ("OK" & #_Inline % #schema ?~ Ref (Reference "User"))
30+-- & at 404 ?~ "User info not found")) ]
31+-- :}
32+-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"produces\":[\"application/json\"],\"responses\":{\"404\":{\"description\":\"User info not found\"},\"200\":{\"schema\":{\"$ref\":\"#/definitions/User\"},\"description\":\"OK\"}}}}},\"definitions\":{\"User\":{\"type\":\"string\"}}}"
33+--
34+-- For convenience optics are defined as /labels/. It means that field accessor
35+-- names can be overloaded for different types. One such common field is
36+-- @#description@. Many components of a Swagger specification can have
37+-- descriptions, and you can use the same name for them:
38+--
39+-- >>> encode $ (mempty :: Response) & #description .~ "No content"
40+-- "{\"description\":\"No content\"}"
41+-- >>> :{
42+-- encode $ (mempty :: Schema)
43+-- & #type ?~ SwaggerBoolean
44+-- & #description ?~ "To be or not to be"
45+-- :}
46+-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"
47+--
48+-- @'ParamSchema'@ is basically the /base schema specification/ and many types
49+-- contain it. So for convenience, all @'ParamSchema'@ fields are transitively
50+-- made fields of the type that has it. For example, you can use @#type@ to
51+-- access @'SwaggerType'@ of @'Header'@ schema without having to use
52+-- @#paramSchema@:
53+--
54+-- >>> encode $ (mempty :: Header) & #type ?~ SwaggerNumber
55+-- "{\"type\":\"number\"}"
56+--
57+-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and
58+-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:
59+--
60+-- >>> :{
61+-- encode $ (mempty :: Operation)
62+-- & at 404 ?~ "Not found"
63+-- :}
64+-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"
65+--
66+module Data.Swagger.Optics () where
67+
68+import Data.Aeson (Value)
69+import Data.Scientific (Scientific)
70+import Data.Swagger.Internal
71+import Data.Text (Text)
72+import Optics.Core
73+import Optics.TH
74+
75+-- Lenses
76+
77+makeFieldLabels ''Swagger
78+makeFieldLabels ''Components
79+makeFieldLabels ''Server
80+makeFieldLabels ''ServerVariable
81+makeFieldLabels ''RequestBody
82+makeFieldLabels ''MediaTypeObject
83+makeFieldLabels ''Info
84+makeFieldLabels ''Contact
85+makeFieldLabels ''License
86+makeFieldLabels ''PathItem
87+makeFieldLabels ''Tag
88+makeFieldLabels ''Operation
89+makeFieldLabels ''Param
90+makeFieldLabels ''Header
91+makeFieldLabels ''Schema
92+makeFieldLabels ''NamedSchema
93+makeFieldLabels ''ParamSchema
94+makeFieldLabels ''Xml
95+makeFieldLabels ''Responses
96+makeFieldLabels ''Response
97+makeFieldLabels ''SecurityScheme
98+makeFieldLabels ''ApiKeyParams
99+makeFieldLabels ''OAuth2ImplicitFlow
100+makeFieldLabels ''OAuth2PasswordFlow
101+makeFieldLabels ''OAuth2ClientCredentialsFlow
102+makeFieldLabels ''OAuth2AuthorizationCodeFlow
103+makeFieldLabels ''OAuth2Flow
104+makeFieldLabels ''OAuth2Flows
105+makeFieldLabels ''ExternalDocs
106+makeFieldLabels ''Encoding
107+makeFieldLabels ''Example
108+makeFieldLabels ''Discriminator
109+
110+-- Prisms
111+
112+makePrismLabels ''SecuritySchemeType
113+makePrismLabels ''Referenced
114+
115+-- SwaggerItems prisms
116+
117+instance
118+ ( a ~ [Referenced Schema]
119+ , b ~ [Referenced Schema]
120+ ) => LabelOptic "_SwaggerItemsArray"
121+ A_Review
122+ (SwaggerItems 'SwaggerKindSchema)
123+ (SwaggerItems 'SwaggerKindSchema)
124+ a
125+ b where
126+ labelOptic = unto (\x -> SwaggerItemsArray x)
127+ {-# INLINE labelOptic #-}
128+
129+instance
130+ ( a ~ Referenced Schema
131+ , b ~ Referenced Schema
132+ ) => LabelOptic "_SwaggerItemsObject"
133+ A_Review
134+ (SwaggerItems 'SwaggerKindSchema)
135+ (SwaggerItems 'SwaggerKindSchema)
136+ a
137+ b where
138+ labelOptic = unto (\x -> SwaggerItemsObject x)
139+ {-# INLINE labelOptic #-}
140+
141+instance
142+ ( a ~ (Maybe (CollectionFormat t), ParamSchema t)
143+ , b ~ (Maybe (CollectionFormat t), ParamSchema t)
144+ ) => LabelOptic "_SwaggerItemsPrimitive"
145+ A_Review
146+ (SwaggerItems t)
147+ (SwaggerItems t)
148+ a
149+ b where
150+ labelOptic = unto (\(c, p) -> SwaggerItemsPrimitive c p)
151+ {-# INLINE labelOptic #-}
152+
153+-- =============================================================
154+-- More helpful instances for easier access to schema properties
155+
156+type instance Index Responses = HttpStatusCode
157+type instance Index Operation = HttpStatusCode
158+
159+type instance IxValue Responses = Referenced Response
160+type instance IxValue Operation = Referenced Response
161+
162+instance Ixed Responses where
163+ ix n = #responses % ix n
164+ {-# INLINE ix #-}
165+instance At Responses where
166+ at n = #responses % at n
167+ {-# INLINE at #-}
168+
169+instance Ixed Operation where
170+ ix n = #responses % ix n
171+ {-# INLINE ix #-}
172+instance At Operation where
173+ at n = #responses % at n
174+ {-# INLINE at #-}
175+
176+-- #paramSchema
177+
178+instance
179+ ( a ~ ParamSchema 'SwaggerKindSchema
180+ , b ~ ParamSchema 'SwaggerKindSchema
181+ ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where
182+ labelOptic = #schema % #paramSchema
183+ {-# INLINE labelOptic #-}
184+
185+-- #type
186+
187+instance
188+ ( a ~ Maybe (SwaggerType ('SwaggerKindNormal Header))
189+ , b ~ Maybe (SwaggerType ('SwaggerKindNormal Header))
190+ ) => LabelOptic "type" A_Lens Header Header a b where
191+ labelOptic = #schema % #type
192+ {-# INLINE labelOptic #-}
193+
194+instance
195+ ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)
196+ , b ~ Maybe (SwaggerType 'SwaggerKindSchema)
197+ ) => LabelOptic "type" A_Lens Schema Schema a b where
198+ labelOptic = #paramSchema % #type
199+ {-# INLINE labelOptic #-}
200+
201+instance
202+ ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)
203+ , b ~ Maybe (SwaggerType 'SwaggerKindSchema)
204+ ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where
205+ labelOptic = #paramSchema % #type
206+ {-# INLINE labelOptic #-}
207+
208+-- #default
209+
210+instance
211+ ( a ~ Maybe Value, b ~ Maybe Value
212+ ) => LabelOptic "default" A_Lens Header Header a b where
213+ labelOptic = #schema % #default
214+ {-# INLINE labelOptic #-}
215+
216+instance
217+ ( a ~ Maybe Value, b ~ Maybe Value
218+ ) => LabelOptic "default" A_Lens Schema Schema a b where
219+ labelOptic = #paramSchema % #default
220+ {-# INLINE labelOptic #-}
221+
222+instance
223+ ( a ~ Maybe Value, b ~ Maybe Value
224+ ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where
225+ labelOptic = #paramSchema % #default
226+ {-# INLINE labelOptic #-}
227+
228+-- #format
229+
230+instance
231+ ( a ~ Maybe Format, b ~ Maybe Format
232+ ) => LabelOptic "format" A_Lens Header Header a b where
233+ labelOptic = #schema % #format
234+ {-# INLINE labelOptic #-}
235+
236+instance
237+ ( a ~ Maybe Format, b ~ Maybe Format
238+ ) => LabelOptic "format" A_Lens Schema Schema a b where
239+ labelOptic = #paramSchema % #format
240+ {-# INLINE labelOptic #-}
241+
242+instance
243+ ( a ~ Maybe Format, b ~ Maybe Format
244+ ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where
245+ labelOptic = #paramSchema % #format
246+ {-# INLINE labelOptic #-}
247+
248+-- #items
249+
250+instance
251+ ( a ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))
252+ , b ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))
253+ ) => LabelOptic "items" A_Lens Header Header a b where
254+ labelOptic = #schema % #items
255+ {-# INLINE labelOptic #-}
256+
257+instance
258+ ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)
259+ , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)
260+ ) => LabelOptic "items" A_Lens Schema Schema a b where
261+ labelOptic = #paramSchema % #items
262+ {-# INLINE labelOptic #-}
263+
264+instance
265+ ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)
266+ , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)
267+ ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where
268+ labelOptic = #paramSchema % #items
269+ {-# INLINE labelOptic #-}
270+
271+-- #maximum
272+
273+instance
274+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
275+ ) => LabelOptic "maximum" A_Lens Header Header a b where
276+ labelOptic = #schema % #maximum
277+ {-# INLINE labelOptic #-}
278+
279+instance
280+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
281+ ) => LabelOptic "maximum" A_Lens Schema Schema a b where
282+ labelOptic = #paramSchema % #maximum
283+ {-# INLINE labelOptic #-}
284+
285+instance
286+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
287+ ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where
288+ labelOptic = #paramSchema % #maximum
289+ {-# INLINE labelOptic #-}
290+
291+-- #exclusiveMaximum
292+
293+instance
294+ ( a ~ Maybe Bool, b ~ Maybe Bool
295+ ) => LabelOptic "exclusiveMaximum" A_Lens Header Header a b where
296+ labelOptic = #schema % #exclusiveMaximum
297+ {-# INLINE labelOptic #-}
298+
299+instance
300+ ( a ~ Maybe Bool, b ~ Maybe Bool
301+ ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where
302+ labelOptic = #paramSchema % #exclusiveMaximum
303+ {-# INLINE labelOptic #-}
304+
305+instance
306+ ( a ~ Maybe Bool, b ~ Maybe Bool
307+ ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where
308+ labelOptic = #paramSchema % #exclusiveMaximum
309+ {-# INLINE labelOptic #-}
310+
311+-- #minimum
312+
313+instance
314+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
315+ ) => LabelOptic "minimum" A_Lens Header Header a b where
316+ labelOptic = #schema % #minimum
317+ {-# INLINE labelOptic #-}
318+
319+instance
320+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
321+ ) => LabelOptic "minimum" A_Lens Schema Schema a b where
322+ labelOptic = #paramSchema % #minimum
323+ {-# INLINE labelOptic #-}
324+
325+instance
326+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
327+ ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where
328+ labelOptic = #paramSchema % #minimum
329+ {-# INLINE labelOptic #-}
330+
331+-- #exclusiveMinimum
332+
333+instance
334+ ( a ~ Maybe Bool, b ~ Maybe Bool
335+ ) => LabelOptic "exclusiveMinimum" A_Lens Header Header a b where
336+ labelOptic = #schema % #exclusiveMinimum
337+ {-# INLINE labelOptic #-}
338+
339+instance
340+ ( a ~ Maybe Bool, b ~ Maybe Bool
341+ ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where
342+ labelOptic = #paramSchema % #exclusiveMinimum
343+ {-# INLINE labelOptic #-}
344+
345+instance
346+ ( a ~ Maybe Bool, b ~ Maybe Bool
347+ ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where
348+ labelOptic = #paramSchema % #exclusiveMinimum
349+ {-# INLINE labelOptic #-}
350+
351+-- #maxLength
352+
353+instance
354+ ( a ~ Maybe Integer, b ~ Maybe Integer
355+ ) => LabelOptic "maxLength" A_Lens Header Header a b where
356+ labelOptic = #schema % #maxLength
357+ {-# INLINE labelOptic #-}
358+
359+instance
360+ ( a ~ Maybe Integer, b ~ Maybe Integer
361+ ) => LabelOptic "maxLength" A_Lens Schema Schema a b where
362+ labelOptic = #paramSchema % #maxLength
363+ {-# INLINE labelOptic #-}
364+
365+instance
366+ ( a ~ Maybe Integer, b ~ Maybe Integer
367+ ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where
368+ labelOptic = #paramSchema % #maxLength
369+ {-# INLINE labelOptic #-}
370+
371+-- #minLength
372+
373+instance
374+ ( a ~ Maybe Integer, b ~ Maybe Integer
375+ ) => LabelOptic "minLength" A_Lens Header Header a b where
376+ labelOptic = #schema % #minLength
377+ {-# INLINE labelOptic #-}
378+
379+instance
380+ ( a ~ Maybe Integer, b ~ Maybe Integer
381+ ) => LabelOptic "minLength" A_Lens Schema Schema a b where
382+ labelOptic = #paramSchema % #minLength
383+ {-# INLINE labelOptic #-}
384+
385+instance
386+ ( a ~ Maybe Integer, b ~ Maybe Integer
387+ ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where
388+ labelOptic = #paramSchema % #minLength
389+ {-# INLINE labelOptic #-}
390+
391+-- #pattern
392+
393+instance
394+ ( a ~ Maybe Text, b ~ Maybe Text
395+ ) => LabelOptic "pattern" A_Lens Header Header a b where
396+ labelOptic = #schema % #pattern
397+ {-# INLINE labelOptic #-}
398+
399+instance
400+ ( a ~ Maybe Text, b ~ Maybe Text
401+ ) => LabelOptic "pattern" A_Lens Schema Schema a b where
402+ labelOptic = #paramSchema % #pattern
403+ {-# INLINE labelOptic #-}
404+
405+instance
406+ ( a ~ Maybe Text, b ~ Maybe Text
407+ ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where
408+ labelOptic = #paramSchema % #pattern
409+ {-# INLINE labelOptic #-}
410+
411+-- #maxItems
412+
413+instance
414+ ( a ~ Maybe Integer, b ~ Maybe Integer
415+ ) => LabelOptic "maxItems" A_Lens Header Header a b where
416+ labelOptic = #schema % #maxItems
417+ {-# INLINE labelOptic #-}
418+
419+instance
420+ ( a ~ Maybe Integer, b ~ Maybe Integer
421+ ) => LabelOptic "maxItems" A_Lens Schema Schema a b where
422+ labelOptic = #paramSchema % #maxItems
423+ {-# INLINE labelOptic #-}
424+
425+instance
426+ ( a ~ Maybe Integer, b ~ Maybe Integer
427+ ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where
428+ labelOptic = #paramSchema % #maxItems
429+ {-# INLINE labelOptic #-}
430+
431+-- #minItems
432+
433+instance
434+ ( a ~ Maybe Integer, b ~ Maybe Integer
435+ ) => LabelOptic "minItems" A_Lens Header Header a b where
436+ labelOptic = #schema % #minItems
437+ {-# INLINE labelOptic #-}
438+
439+instance
440+ ( a ~ Maybe Integer, b ~ Maybe Integer
441+ ) => LabelOptic "minItems" A_Lens Schema Schema a b where
442+ labelOptic = #paramSchema % #minItems
443+ {-# INLINE labelOptic #-}
444+
445+instance
446+ ( a ~ Maybe Integer, b ~ Maybe Integer
447+ ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where
448+ labelOptic = #paramSchema % #minItems
449+ {-# INLINE labelOptic #-}
450+
451+-- #uniqueItems
452+
453+instance
454+ ( a ~ Maybe Bool, b ~ Maybe Bool
455+ ) => LabelOptic "uniqueItems" A_Lens Header Header a b where
456+ labelOptic = #schema % #uniqueItems
457+ {-# INLINE labelOptic #-}
458+
459+instance
460+ ( a ~ Maybe Bool, b ~ Maybe Bool
461+ ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where
462+ labelOptic = #paramSchema % #uniqueItems
463+ {-# INLINE labelOptic #-}
464+
465+instance
466+ ( a ~ Maybe Bool, b ~ Maybe Bool
467+ ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where
468+ labelOptic = #paramSchema % #uniqueItems
469+ {-# INLINE labelOptic #-}
470+
471+-- #enum
472+
473+instance
474+ ( a ~ Maybe [Value], b ~ Maybe [Value]
475+ ) => LabelOptic "enum" A_Lens Header Header a b where
476+ labelOptic = #schema % #enum
477+ {-# INLINE labelOptic #-}
478+
479+instance
480+ ( a ~ Maybe [Value], b ~ Maybe [Value]
481+ ) => LabelOptic "enum" A_Lens Schema Schema a b where
482+ labelOptic = #paramSchema % #enum
483+ {-# INLINE labelOptic #-}
484+
485+instance
486+ ( a ~ Maybe [Value], b ~ Maybe [Value]
487+ ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where
488+ labelOptic = #paramSchema % #enum
489+ {-# INLINE labelOptic #-}
490+
491+-- #multipleOf
492+
493+instance
494+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
495+ ) => LabelOptic "multipleOf" A_Lens Header Header a b where
496+ labelOptic = #schema % #multipleOf
497+ {-# INLINE labelOptic #-}
498+
499+instance
500+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
501+ ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where
502+ labelOptic = #paramSchema % #multipleOf
503+ {-# INLINE labelOptic #-}
504+
505+instance
506+ ( a ~ Maybe Scientific, b ~ Maybe Scientific
507+ ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where
508+ labelOptic = #paramSchema % #multipleOf
509+ {-# INLINE labelOptic #-}
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+19−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
@@ -16,24 +16,20 @@ import Data.Maybe
16import Data.Proxy
16import Data.Proxy
17import Data.Scientific
17import Data.Scientific
18import qualified Data.Set as S
18import qualified Data.Set as S
19−import Data.OpenApi
19+import Data.Swagger
20−import Data.OpenApi.Declare
20+import Data.Swagger.Declare
21−import Data.OpenApi.Internal.Schema.Validation (inferSchemaTypes)
21+import Data.Swagger.Internal.Schema.Validation (inferSchemaTypes)
22import qualified Data.Text as T
22import qualified Data.Text as T
23import qualified Data.Vector as V
23import qualified Data.Vector as V
24import Test.QuickCheck (arbitrary)
24import Test.QuickCheck (arbitrary)
25import Test.QuickCheck.Gen
25import Test.QuickCheck.Gen
26import Test.QuickCheck.Property
26import Test.QuickCheck.Property
27
27
28−import Data.OpenApi.Aeson.Compat (fromInsOrdHashMap)
29−
30-- | Note: 'schemaGen' may 'error', if schema type is not specified,
28-- | Note: 'schemaGen' may 'error', if schema type is not specified,
31-- and cannot be inferred.
29-- and cannot be inferred.
32schemaGen :: Definitions Schema -> Schema -> Gen Value
30schemaGen :: Definitions Schema -> Schema -> Gen Value
33schemaGen _ schema
31schemaGen _ schema
34− | Just cases <- schema ^. enum_ = elements cases
32+ | 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 =
33schemaGen defns schema =
38 case schema ^. type_ of
34 case schema ^. type_ of
39 Nothing ->
35 Nothing ->
@@ -41,25 +37,25 @@ schemaGen defns schema =
41 [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)
37 [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)
42 -- Gen is not MonadFail
38 -- Gen is not MonadFail
43 _ -> error "unable to infer schema type"
39 _ -> error "unable to infer schema type"
44− Just OpenApiBoolean -> Bool <$> elements [True, False]
40+ Just SwaggerBoolean -> Bool <$> elements [True, False]
45− Just OpenApiNull -> pure Null
41+ Just SwaggerNull -> pure Null
46− Just OpenApiNumber
42+ Just SwaggerNumber
47 | Just min <- schema ^. minimum_
43 | Just min <- schema ^. minimum_
48 , Just max <- schema ^. maximum_ ->
44 , Just max <- schema ^. maximum_ ->
49 Number . fromFloatDigits <$>
45 Number . fromFloatDigits <$>
50 choose (toRealFloat min, toRealFloat max :: Double)
46 choose (toRealFloat min, toRealFloat max :: Double)
51 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)
47 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)
52− Just OpenApiInteger
48+ Just SwaggerInteger
53 | Just min <- schema ^. minimum_
49 | Just min <- schema ^. minimum_
54 , Just max <- schema ^. maximum_ ->
50 , Just max <- schema ^. maximum_ ->
55 Number . fromInteger <$>
51 Number . fromInteger <$>
56 choose (truncate min, truncate max)
52 choose (truncate min, truncate max)
57 | otherwise -> Number . fromInteger <$> arbitrary
53 | otherwise -> Number . fromInteger <$> arbitrary
58− Just OpenApiArray
54+ Just SwaggerArray
59 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
55 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
60 | Just items <- schema ^. items ->
56 | Just items <- schema ^. items ->
61 case items of
57 case items of
62− OpenApiItemsObject ref -> do
58+ SwaggerItemsObject ref -> do
63 size <- getSize
59 size <- getSize
64 let itemSchema = dereference defns ref
60 let itemSchema = dereference defns ref
65 minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems
61 minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems
@@ -67,17 +63,17 @@ schemaGen defns schema =
67 arrayLength <- choose (minLength', max minLength' maxLength')
63 arrayLength <- choose (minLength', max minLength' maxLength')
68 generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema
64 generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema
69 return . Array $ V.fromList generatedArray
65 return . Array $ V.fromList generatedArray
70− OpenApiItemsArray refs ->
66+ SwaggerItemsArray refs ->
71 let itemGens = schemaGen defns . dereference defns <$> refs
67 let itemGens = schemaGen defns . dereference defns <$> refs
72 in fmap (Array . V.fromList) $ sequence itemGens
68 in fmap (Array . V.fromList) $ sequence itemGens
73− Just OpenApiString -> do
69+ Just SwaggerString -> do
74 size <- getSize
70 size <- getSize
75 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
71 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
76 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
72 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
77 length <- choose (minLength', max minLength' maxLength')
73 length <- choose (minLength', max minLength' maxLength')
78 str <- vectorOf length arbitrary
74 str <- vectorOf length arbitrary
79 return . String $ T.pack str
75 return . String $ T.pack str
80− Just OpenApiObject -> do
76+ Just SwaggerObject -> do
81 size <- getSize
77 size <- getSize
82 let props = dereference defns <$> schema ^. properties
78 let props = dereference defns <$> schema ^. properties
83 reqKeys = S.fromList $ schema ^. required
79 reqKeys = S.fromList $ schema ^. required
@@ -97,11 +93,11 @@ schemaGen defns schema =
97 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
93 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
98 _ -> return []
94 _ -> return []
99 x <- sequence $ gens <> additionalGens
95 x <- sequence $ gens <> additionalGens
100− return . Object $ fromInsOrdHashMap x
96+ return . Object $ M.toHashMap x
101−
97+ where
102−dereference :: Definitions a -> Referenced a -> a
98+ dereference :: Definitions a -> Referenced a -> a
103−dereference _ (Inline a) = a
99+ dereference _ (Inline a) = a
104−dereference defs (Ref (Reference ref)) = fromJust $ M.lookup ref defs
100+ dereference defs (Ref (Reference ref)) = fromJust $ M.lookup ref defs
105
101
106genValue :: (ToSchema a) => Proxy a -> Gen Value
102genValue :: (ToSchema a) => Proxy a -> Gen Value
107genValue p =
103genValue p =
src/Data/OpenApi/Schema/Validation.hs → src/Data/Swagger/Schema/Validation.hsrenamed+7−7
@@ -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
@@ -29,13 +29,13 @@ module Data.OpenApi.Schema.Validation (
29 validateJSONWithPatternChecker,
29 validateJSONWithPatternChecker,
30) where
30) where
31
31
32−import Data.OpenApi.Internal.Schema.Validation
32+import Data.Swagger.Internal.Schema.Validation
33
33
34-- $setup
34-- $setup
35-- >>> import Control.Lens
35-- >>> import Control.Lens
36-- >>> import Data.Aeson
36-- >>> import Data.Aeson
37-- >>> import Data.Proxy
37-- >>> import Data.Proxy
38−-- >>> import Data.OpenApi
38+-- >>> import Data.Swagger
39-- >>> import GHC.Generics
39-- >>> import GHC.Generics
40-- >>> :set -XDeriveGeneric
40-- >>> :set -XDeriveGeneric
41
41
@@ -71,11 +71,11 @@ import Data.OpenApi.Internal.Schema.Validation
71-- generally fails for @null@ JSON:
71-- generally fails for @null@ JSON:
72--
72--
73-- >>> validateToJSON (Nothing :: Maybe String)
73-- >>> validateToJSON (Nothing :: Maybe String)
74−-- ["expected JSON value of type OpenApiString"]
74+-- ["expected JSON value of type SwaggerString"]
75-- >>> validateToJSON ([Just "hello", Nothing] :: [Maybe String])
75-- >>> validateToJSON ([Just "hello", Nothing] :: [Maybe String])
76−-- ["expected JSON value of type OpenApiString"]
76+-- ["expected JSON value of type SwaggerString"]
77-- >>> validateToJSON (123, Nothing :: Maybe String)
77-- >>> validateToJSON (123, Nothing :: Maybe String)
78−-- ["expected JSON value of type OpenApiString"]
78+-- ["expected JSON value of type SwaggerString"]
79--
79--
80-- However, when @'Maybe' a@ is a type of a record field,
80-- However, when @'Maybe' a@ is a type of a record field,
81-- validation takes @'required'@ property of the @'Schema'@
81-- 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+1−1
@@ -1,4 +1,4 @@
1−resolver: lts-16.31
1+resolver: lts-15.1
2packages:
2packages:
3- '.'
3- '.'
4extra-deps:
4extra-deps:
openapi3.cabal → swagger2.cabalrenamed+57−65
@@ -1,34 +1,34 @@
1cabal-version: >=1.10
1cabal-version: >=1.10
2−name: openapi3
2+name: swagger2
3−version: 3.2.2
3+version: 2.6.1
4
4
5−synopsis: OpenAPI 3.0 data model
5+synopsis: Swagger 2.0 data model
6−category: Web, Swagger, OpenApi
6+category: Web, Swagger
7description:
7description:
8− This library is intended to be used for decoding and encoding OpenAPI 3.0 API
8+ This library is intended to be used for decoding and encoding Swagger 2.0 API
9 specifications as well as manipulating them.
9 specifications as well as manipulating them.
10 .
10 .
11− The original OpenAPI 3.0 specification is available at http://swagger.io/specification/.
11+ The original Swagger 2.0 specification is available at http://swagger.io/specification/.
12
12
13−homepage: https://github.com/biocad/openapi3
13+homepage: https://github.com/GetShopTV/swagger2
14−bug-reports: https://github.com/biocad/openapi3/issues
14+bug-reports: https://github.com/GetShopTV/swagger2/issues
15license: BSD3
15license: BSD3
16license-file: LICENSE
16license-file: LICENSE
17−author: Nickolay Kudasov, Maxim Koltsov
17+author: Nickolay Kudasov
18−maintainer: nickolay@getshoptv.com, kolmax94@gmail.com
18+maintainer: nickolay@getshoptv.com
19−copyright: (c) 2015-2016, GetShopTV, (c) 2020, Biocad
19+copyright: (c) 2015-2016, GetShopTV
20build-type: Custom
20build-type: Custom
21extra-source-files:
21extra-source-files:
22 README.md
22 README.md
23 , CHANGELOG.md
23 , CHANGELOG.md
24 , examples/*.hs
24 , examples/*.hs
25tested-with:
25tested-with:
26− GHC ==8.4.4
26+ GHC ==8.0.2
27+ || ==8.2.2
28+ || ==8.4.4
27 || ==8.6.5
29 || ==8.6.5
28− || ==8.8.4
30+ || ==8.8.1
29− || ==8.10.7
31+ || ==8.10.1
30− || ==9.0.2
31− || ==9.2.2
32
32
33custom-setup
33custom-setup
34 setup-depends:
34 setup-depends:
@@ -37,56 +37,54 @@ custom-setup
37library
37library
38 hs-source-dirs: src
38 hs-source-dirs: src
39 exposed-modules:
39 exposed-modules:
40− Data.OpenApi
40+ Data.Swagger
41− Data.OpenApi.Declare
41+ Data.Swagger.Declare
42− Data.OpenApi.Lens
42+ Data.Swagger.Lens
43− Data.OpenApi.Operation
43+ Data.Swagger.Operation
44− Data.OpenApi.Optics
44+ Data.Swagger.Optics
45− Data.OpenApi.ParamSchema
45+ Data.Swagger.ParamSchema
46− Data.OpenApi.Schema
46+ Data.Swagger.Schema
47− Data.OpenApi.Schema.Generator
47+ Data.Swagger.Schema.Generator
48− Data.OpenApi.Schema.Validation
48+ Data.Swagger.Schema.Validation
49− Data.OpenApi.SchemaOptions
49+ Data.Swagger.SchemaOptions
50
50
51 -- internal modules
51 -- internal modules
52− Data.OpenApi.Internal
52+ Data.Swagger.Internal
53− Data.OpenApi.Internal.Schema
53+ Data.Swagger.Internal.Schema
54− Data.OpenApi.Internal.Schema.Validation
54+ Data.Swagger.Internal.Schema.Validation
55− Data.OpenApi.Internal.ParamSchema
55+ Data.Swagger.Internal.ParamSchema
56− Data.OpenApi.Internal.Utils
56+ Data.Swagger.Internal.Utils
57− Data.OpenApi.Internal.AesonUtils
57+ Data.Swagger.Internal.AesonUtils
58− Data.OpenApi.Internal.TypeShape
58+ Data.Swagger.Internal.TypeShape
59−
60− Data.OpenApi.Aeson.Compat
61
59
62 -- GHC boot libraries
60 -- GHC boot libraries
63 build-depends:
61 build-depends:
64− base >=4.11.1.0 && <4.17
62+ base >=4.9 && <4.15
65− , bytestring >=0.10.8.2 && <0.12
63+ , bytestring >=0.10.8.1 && <0.11
66− , containers >=0.5.11.0 && <0.7
64+ , containers >=0.5.7.1 && <0.7
67− , template-haskell >=2.13.0.0 && <2.19
65+ , template-haskell >=2.11.1.0 && <2.17
68− , time >=1.8.0.2 && <1.14
66+ , time >=1.6.0.1 && <1.10
69− , transformers >=0.5.5.0 && <0.6
67+ , transformers >=0.5.2.0 && <0.6
70
68
71 build-depends:
69 build-depends:
72 mtl >=2.2.2 && <2.3
70 mtl >=2.2.2 && <2.3
73− , text >=1.2.3.1 && <2.1
71+ , text >=1.2.3.0 && <1.3
74
72
75 -- other dependencies
73 -- other dependencies
76 build-depends:
74 build-depends:
77− base-compat-batteries >=0.11.1 && <0.13
75+ base-compat-batteries >=0.11.1 && <0.12
78− , aeson >=1.4.2.0 && <1.6 || >=2.0.1.0 && < 2.1
76+ , aeson >=1.4.2.0 && <1.6
79 , aeson-pretty >=0.8.7 && <0.9
77 , aeson-pretty >=0.8.7 && <0.9
80 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
78 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
81 , cookie >=0.4.3 && <0.5
79 , cookie >=0.4.3 && <0.5
82 , generics-sop >=0.5.1.0 && <0.6
80 , generics-sop >=0.5.1.0 && <0.6
83− , hashable >=1.2.7.0 && <1.5
81+ , hashable >=1.2.7.0 && <1.4
84 , http-media >=0.8.0.0 && <0.9
82 , http-media >=0.8.0.0 && <0.9
85 , insert-ordered-containers >=0.2.3 && <0.3
83 , insert-ordered-containers >=0.2.3 && <0.3
86− , lens >=4.16.1 && <5.2
84+ , lens >=4.16.1 && <4.20
87 , network >=2.6.3.5 && <3.2
85 , network >=2.6.3.5 && <3.2
88− , optics-core >=0.2 && <0.5
86+ , optics-core >=0.2 && <0.4
89− , optics-th >=0.2 && <0.5
87+ , optics-th >=0.2 && <0.4
90 , scientific >=0.3.6.2 && <0.4
88 , scientific >=0.3.6.2 && <0.4
91 , unordered-containers >=0.2.9.0 && <0.3
89 , unordered-containers >=0.2.9.0 && <0.3
92 , uuid-types >=1.0.3 && <1.1
90 , uuid-types >=1.0.3 && <1.1
@@ -104,7 +102,7 @@ test-suite spec
104 -- We need aeson's toEncoding for doctests too
102 -- We need aeson's toEncoding for doctests too
105 build-depends:
103 build-depends:
106 base
104 base
107− , QuickCheck
105+ , swagger2
108 , aeson
106 , aeson
109 , base-compat-batteries
107 , base-compat-batteries
110 , bytestring
108 , bytestring
@@ -113,32 +111,32 @@ test-suite spec
113 , insert-ordered-containers
111 , insert-ordered-containers
114 , lens
112 , lens
115 , mtl
113 , mtl
116− , openapi3
117 , template-haskell
114 , template-haskell
118 , text
115 , text
119 , time
116 , time
120 , unordered-containers
117 , unordered-containers
121 , vector
118 , vector
119+ , QuickCheck
122
120
123 -- test-suite only dependencies
121 -- test-suite only dependencies
124 build-depends:
122 build-depends:
125− hspec >=2.5.5 && <2.10
123+ hspec >=2.5.5 && <2.8
126 , HUnit >=1.6.0.0 && <1.7
124 , HUnit >=1.6.0.0 && <1.7
127 , quickcheck-instances >=0.3.19 && <0.14
125 , quickcheck-instances >=0.3.19 && <0.14
128 , utf8-string >=1.0.1.1 && <1.1
126 , utf8-string >=1.0.1.1 && <1.1
129
127
130 -- https://github.com/haskell/cabal/issues/3708
128 -- https://github.com/haskell/cabal/issues/3708
131 build-tool-depends:
129 build-tool-depends:
132− hspec-discover:hspec-discover >=2.5.5 && <2.10
130+ hspec-discover:hspec-discover >=2.5.5 && <2.8
133
131
134 other-modules:
132 other-modules:
135 SpecCommon
133 SpecCommon
136− Data.OpenApiSpec
134+ Data.SwaggerSpec
137− Data.OpenApi.CommonTestTypes
135+ Data.Swagger.CommonTestTypes
138− Data.OpenApi.ParamSchemaSpec
136+ Data.Swagger.ParamSchemaSpec
139− Data.OpenApi.SchemaSpec
137+ Data.Swagger.SchemaSpec
140− Data.OpenApi.Schema.ValidationSpec
138+ Data.Swagger.Schema.ValidationSpec
141− Data.OpenApi.Schema.GeneratorSpec
139+ Data.Swagger.Schema.GeneratorSpec
142 default-language: Haskell2010
140 default-language: Haskell2010
143
141
144test-suite doctests
142test-suite doctests
@@ -149,12 +147,6 @@ test-suite doctests
149 main-is: doctests.hs
147 main-is: doctests.hs
150 type: exitcode-stdio-1.0
148 type: exitcode-stdio-1.0
151
149
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−
158source-repository head
150source-repository head
159 type: git
151 type: git
160− location: https://github.com/biocad/openapi3.git
152+ location: https://github.com/GetShopTV/swagger2.git
test/Data/OpenApi/CommonTestTypes.hs → test/Data/Swagger/CommonTestTypes.hsrenamed+100−436
@@ -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
@@ -18,7 +18,7 @@ import qualified Data.Text as Text
18import Data.Word
18import Data.Word
19import GHC.Generics
19import GHC.Generics
20
20
21−import Data.OpenApi
21+import Data.Swagger
22
22
23-- ========================================================================
23-- ========================================================================
24-- Unit type
24-- Unit type
@@ -88,7 +88,7 @@ paintSchemaJSON = [aesonQQ|
88 {
88 {
89 "color":
89 "color":
90 {
90 {
91− "$ref": "#/components/schemas/Color"
91+ "$ref": "#/definitions/Color"
92 }
92 }
93 },
93 },
94 "required": ["color"]
94 "required": ["color"]
@@ -181,7 +181,7 @@ userGroupSchemaJSON :: Value
181userGroupSchemaJSON = [aesonQQ|
181userGroupSchemaJSON = [aesonQQ|
182{
182{
183 "type": "array",
183 "type": "array",
184− "items": { "$ref": "#/components/schemas/UserId" },
184+ "items": { "$ref": "#/definitions/UserId" },
185 "uniqueItems": true
185 "uniqueItems": true
186}
186}
187|]
187|]
@@ -228,7 +228,7 @@ playerSchemaJSON = [aesonQQ|
228 {
228 {
229 "position":
229 "position":
230 {
230 {
231− "$ref": "#/components/schemas/Point"
231+ "$ref": "#/definitions/Point"
232 }
232 }
233 },
233 },
234 "required": ["position"]
234 "required": ["position"]
@@ -250,7 +250,7 @@ playersSchemaJSON = [aesonQQ|
250 {
250 {
251 "position":
251 "position":
252 {
252 {
253− "$ref": "#/components/schemas/Point"
253+ "$ref": "#/definitions/Point"
254 }
254 }
255 },
255 },
256 "required": ["position"]
256 "required": ["position"]
@@ -271,192 +271,106 @@ instance ToSchema Character
271characterSchemaJSON :: Value
271characterSchemaJSON :: Value
272characterSchemaJSON = [aesonQQ|
272characterSchemaJSON = [aesonQQ|
273{
273{
274− "oneOf": [
274+ "type": "object",
275+ "properties":
275 {
276 {
276− "required": [
277+ "PC": { "$ref": "#/definitions/Player" },
277− "tag",
278+ "NPC":
278− "contents"
279+ {
279− ],
280− "type": "object",
280+ "type": "object",
281− "properties": {
281+ "properties":
282− "tag": {
282+ {
283− "type": "string",
283+ "npcName": { "type": "string" },
284− "enum": [
284+ "npcPosition": { "$ref": "#/definitions/Point" }
285− "PC"
286− ]
287− },
285+ },
288− "contents": {
286+ "required": ["npcName", "npcPosition"]
289− "$ref": "#/components/schemas/Player"
290 }
287 }
291− }
292 },
288 },
293− {
289+ "maxProperties": 1,
294− "required": [
290+ "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}
291}
318−
319|]
292|]
320
293
321characterInlinedSchemaJSON :: Value
294characterInlinedSchemaJSON :: Value
322characterInlinedSchemaJSON = [aesonQQ|
295characterInlinedSchemaJSON = [aesonQQ|
323{
296{
324− "oneOf": [
297+ "type": "object",
298+ "properties":
325 {
299 {
326− "required": [
327− "tag",
328− "contents"
329− ],
330− "type": "object",
331− "properties": {
332− "tag": {
333− "type": "string",
334− "enum": [
335− "PC"
300+ "PC":
336− ]
301+ {
337− },
338− "contents": {
339− "required": [
340− "position"
341− ],
342 "type": "object",
302 "type": "object",
343− "properties": {
303+ "properties":
304+ {
344− "position": {
305+ "position":
306+ {
307+ "type": "object",
308+ "properties":
309+ {
310+ "x": { "type": "number", "format": "double" },
311+ "y": { "type": "number", "format": "double" }
312+ },
345− "required": [
313+ "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 }
314 }
359− }
360− }
315+ },
361− }
362− }
363− }
364− },
365− {
366− "required": [
316+ "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 },
317 },
379− "npcPosition": {
318+ "NPC":
380− "required": [
319+ {
381− "x",
382− "y"
383− ],
384 "type": "object",
320 "type": "object",
385− "properties": {
321+ "properties":
386− "x": {
322+ {
323+ "npcName": { "type": "string" },
324+ "npcPosition":
325+ {
326+ "type": "object",
327+ "properties":
328+ {
387− "format": "double",
329+ "x": { "type": "number", "format": "double" },
388− "type": "number"
330+ "y": { "type": "number", "format": "double" }
331+ },
332+ "required": ["x", "y"]
333+ }
389 },
334 },
390− "y": {
391− "format": "double",
392− "type": "number"
393− }
394− }
395− },
396− "npcName": {
335+ "required": ["npcName", "npcPosition"]
397− "type": "string"
398 }
336 }
399− }
400− }
337+ },
401− ],
338+ "maxProperties": 1,
402− "type": "object"
339+ "minProperties": 1
403}
340}
404|]
341|]
405
342
406characterInlinedPlayerSchemaJSON :: Value
343characterInlinedPlayerSchemaJSON :: Value
407characterInlinedPlayerSchemaJSON = [aesonQQ|
344characterInlinedPlayerSchemaJSON = [aesonQQ|
408{
345{
409− "oneOf": [
346+ "type": "object",
347+ "properties":
410 {
348 {
411− "required": [
349+ "PC":
412− "tag",
350+ {
413− "contents"
414− ],
415− "type": "object",
351+ "type": "object",
416− "properties": {
352+ "properties":
417− "tag": {
353+ {
418− "type": "string",
354+ "position":
419− "enum": [
355+ {
420− "PC"
356+ "$ref": "#/definitions/Point"
421− ]
357+ }
358+ },
359+ "required": ["position"]
422 },
360 },
423− "contents": {
361+ "NPC":
424− "required": [
362+ {
425− "position"
426− ],
427 "type": "object",
363 "type": "object",
428− "properties": {
364+ "properties":
429− "position": {
365+ {
430− "$ref": "#/components/schemas/Point"
366+ "npcName": { "type": "string" },
367+ "npcPosition": { "$ref": "#/definitions/Point" }
431− }
368+ },
432− }
369+ "required": ["npcName", "npcPosition"]
433 }
370 }
434− }
435 },
371 },
436− {
372+ "maxProperties": 1,
437− "required": [
373+ "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}
374}
461|]
375|]
462
376
@@ -568,7 +482,7 @@ myRoseTreeSchemaJSON = [aesonQQ|
568 "type": "array",
482 "type": "array",
569 "items":
483 "items":
570 {
484 {
571− "$ref": "#/components/schemas/RoseTree"
485+ "$ref": "#/definitions/RoseTree"
572 }
486 }
573 }
487 }
574 },
488 },
@@ -597,7 +511,7 @@ myRoseTreeSchemaJSON' = [aesonQQ|
597 "type": "array",
511 "type": "array",
598 "items":
512 "items":
599 {
513 {
600− "$ref": "#/components/schemas/myrosetree'"
514+ "$ref": "#/definitions/myrosetree'"
601 }
515 }
602 }
516 }
603 },
517 },
@@ -628,169 +542,42 @@ data Light
628 deriving (Generic)
542 deriving (Generic)
629
543
630instance ToSchema Light where
544instance ToSchema Light where
631− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
545+ declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
632 { unwrapUnaryRecords = True }
546 { unwrapUnaryRecords = True }
633
547
634lightSchemaJSON :: Value
548lightSchemaJSON :: Value
635lightSchemaJSON = [aesonQQ|
549lightSchemaJSON = [aesonQQ|
636{
550{
637− "oneOf": [
638− {
639− "required": [
640− "tag"
641− ],
642− "type": "object",
551+ "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": {
552+ "properties":
659− "tag": {
660− "type": "string",
661− "enum": [
662− "LightFreq"
663− ]
664− },
665− "contents": {
666− "format": "double",
667− "type": "number"
668− }
669− }
670− },
671 {
553 {
672− "required": [
554+ "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },
673− "tag",
555+ "LightFreq": { "type": "number", "format": "double" },
674− "contents"
675− ],
676− "type": "object",
677− "properties": {
678− "tag": {
679− "type": "string",
680− "enum": [
681− "LightColor"
556+ "LightColor": { "$ref": "#/definitions/Color" },
682− ]
557+ "LightWaveLength": { "type": "number", "format": "double" }
683− },
684− "contents": {
685− "$ref": "#/components/schemas/Color"
686− }
687− }
688 },
558 },
689− {
559+ "maxProperties": 1,
690− "required": [
560+ "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}
561}
711|]
562|]
712
563
713lightInlinedSchemaJSON :: Value
564lightInlinedSchemaJSON :: Value
714lightInlinedSchemaJSON = [aesonQQ|
565lightInlinedSchemaJSON = [aesonQQ|
715{
566{
716− "oneOf": [
717− {
718− "required": [
719− "tag"
720− ],
721− "type": "object",
567+ "type": "object",
722− "properties": {
723− "tag": {
724− "type": "string",
725− "enum": [
726− "NoLight"
727− ]
728− }
729− }
730− },
731− {
732− "required": [
733− "tag",
734− "contents"
735− ],
736− "type": "object",
737− "properties": {
568+ "properties":
738− "tag": {
739− "type": "string",
740− "enum": [
741− "LightFreq"
742− ]
743− },
744− "contents": {
745− "format": "double",
746− "type": "number"
747− }
748− }
749− },
750 {
569 {
751− "required": [
570+ "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },
752− "tag",
571+ "LightFreq": { "type": "number", "format": "double" },
753− "contents"
572+ "LightColor":
754− ],
573+ {
755− "type": "object",
756− "properties": {
757− "tag": {
758 "type": "string",
574 "type": "string",
759− "enum": [
575+ "enum": ["Red", "Green", "Blue"]
760− "LightColor"
761− ]
762 },
576 },
763− "contents": {
577+ "LightWaveLength": { "type": "number", "format": "double" }
764− "type": "string",
765− "enum": [
766− "Red",
767− "Green",
768− "Blue"
769− ]
770− }
771− }
772 },
578 },
773− {
579+ "maxProperties": 1,
774− "required": [
580+ "minProperties": 1
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}
581}
795|]
582|]
796
583
@@ -863,129 +650,6 @@ singleMaybeFieldSchemaJSON = [aesonQQ|
863}
650}
864|]
651|]
865
652
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
653
990-- ========================================================================
654-- ========================================================================
991-- TimeOfDay
655-- TimeOfDay
test/Data/OpenApi/ParamSchemaSpec.hs → test/Data/Swagger/ParamSchemaSpec.hsrenamed+5−4
@@ -4,7 +4,7 @@
4{-# LANGUAGE TemplateHaskell #-}
4{-# LANGUAGE TemplateHaskell #-}
5{-# LANGUAGE QuasiQuotes #-}
5{-# LANGUAGE QuasiQuotes #-}
6{-# LANGUAGE OverloadedStrings #-}
6{-# LANGUAGE OverloadedStrings #-}
7−module Data.OpenApi.ParamSchemaSpec where
7+module Data.Swagger.ParamSchemaSpec where
8
8
9import Data.Aeson
9import Data.Aeson
10import Data.Aeson.QQ.Simple
10import Data.Aeson.QQ.Simple
@@ -12,9 +12,10 @@ import Data.Char
12import Data.Proxy
12import Data.Proxy
13import GHC.Generics
13import GHC.Generics
14
14
15−import Data.OpenApi
15+import Data.Swagger
16+import Data.Swagger.Internal (SwaggerKind(..))
16
17
17−import Data.OpenApi.CommonTestTypes
18+import Data.Swagger.CommonTestTypes
18import SpecCommon
19import SpecCommon
19import Test.Hspec
20import Test.Hspec
20import Data.Time.LocalTime
21import Data.Time.LocalTime
@@ -22,7 +23,7 @@ import Data.Time.LocalTime
22import qualified Data.HashMap.Strict as HM
23import qualified Data.HashMap.Strict as HM
23
24
24checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec
25checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec
25−checkToParamSchema proxy js = (toParamSchema proxy :: Schema) <=> js
26+checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js
26
27
27spec :: Spec
28spec :: Spec
28spec = do
29spec = do
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−56
@@ -1,18 +1,13 @@
1−{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE PackageImports #-}
2{-# LANGUAGE PackageImports #-}
4{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE RecordWildCards #-}
5{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE ScopedTypeVariables #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
5{-# OPTIONS_GHC -fno-warn-orphans #-}
7−module Data.OpenApi.Schema.ValidationSpec where
6+module Data.Swagger.Schema.ValidationSpec where
8
7
9import Control.Applicative
8import Control.Applicative
10import Control.Lens ((&), (.~), (?~))
9import Control.Lens ((&), (.~), (?~))
11import Data.Aeson
10import 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
11import Data.Aeson.Types
17import Data.Hashable (Hashable)
12import Data.Hashable (Hashable)
18import Data.HashMap.Strict (HashMap)
13import Data.HashMap.Strict (HashMap)
@@ -33,9 +28,8 @@ import Data.Version (Version)
33import Data.Word
28import Data.Word
34import GHC.Generics
29import GHC.Generics
35
30
36−import Data.OpenApi
31+import Data.Swagger
37−import Data.OpenApi.Declare
32+import Data.Swagger.Declare
38−import Data.OpenApi.Aeson.Compat (stringToKey)
39
33
40import Test.Hspec
34import Test.Hspec
41import Test.Hspec.QuickCheck
35import Test.Hspec.QuickCheck
@@ -97,8 +91,6 @@ spec = do
97 prop "Paint" $ shouldValidate (Proxy :: Proxy Paint)
91 prop "Paint" $ shouldValidate (Proxy :: Proxy Paint)
98 prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
92 prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)
99 prop "Light" $ shouldValidate (Proxy :: Proxy Light)
93 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)
94 prop "ButtonImages" $ shouldValidate (Proxy :: Proxy ButtonImages)
103 prop "Version" $ shouldValidate (Proxy :: Proxy Version)
95 prop "Version" $ shouldValidate (Proxy :: Proxy Version)
104 prop "FreeForm" $ shouldValidate (Proxy :: Proxy FreeForm)
96 prop "FreeForm" $ shouldValidate (Proxy :: Proxy FreeForm)
@@ -130,9 +122,9 @@ instance Arbitrary Person where
130
122
131invalidPersonToJSON :: Person -> Value
123invalidPersonToJSON :: Person -> Value
132invalidPersonToJSON Person{..} = object
124invalidPersonToJSON Person{..} = object
133− [ stringToKey "personName" .= toJSON name
125+ [ T.pack "personName" .= toJSON name
134− , stringToKey "personPhone" .= toJSON phone
126+ , T.pack "personPhone" .= toJSON phone
135− , stringToKey "personEmail" .= toJSON email
127+ , T.pack "personEmail" .= toJSON email
136 ]
128 ]
137
129
138-- ========================================================================
130-- ========================================================================
@@ -196,10 +188,10 @@ instance Arbitrary MyRoseTree where
196data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic)
188data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic)
197
189
198instance ToSchema Light where
190instance ToSchema Light where
199− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = ObjectWithSingleField }
191+ declareNamedSchema = genericDeclareNamedSchemaUnrestricted defaultSchemaOptions
200
192
201instance ToJSON Light where
193instance ToJSON Light where
202− toJSON = genericToJSON defaultOptions { Data.Aeson.Types.sumEncoding = ObjectWithSingleField }
194+ toJSON = genericToJSON defaultOptions { sumEncoding = ObjectWithSingleField }
203
195
204instance Arbitrary Light where
196instance Arbitrary Light where
205 arbitrary = oneof
197 arbitrary = oneof
@@ -211,34 +203,6 @@ instance Arbitrary Light where
211invalidLightToJSON :: Light -> Value
203invalidLightToJSON :: Light -> Value
212invalidLightToJSON = genericToJSON defaultOptions
204invalidLightToJSON = genericToJSON defaultOptions
213
205
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-- ========================================================================
206-- ========================================================================
243-- ButtonImages (bounded enum key mapping)
207-- ButtonImages (bounded enum key mapping)
244-- ========================================================================
208-- ========================================================================
@@ -283,7 +247,7 @@ instance ToJSON FreeForm where
283
247
284instance ToSchema FreeForm where
248instance ToSchema FreeForm where
285 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
249 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
286− & type_ ?~ OpenApiObject
250+ & type_ ?~ SwaggerObject
287 & additionalProperties ?~ AdditionalPropertiesAllowed True
251 & additionalProperties ?~ AdditionalPropertiesAllowed True
288
252
289instance Arbitrary FreeForm where
253instance Arbitrary FreeForm where
@@ -301,8 +265,6 @@ instance Eq ZonedTime where
301-- Arbitrary instance for Data.Aeson.Value
265-- Arbitrary instance for Data.Aeson.Value
302-- ========================================================================
266-- ========================================================================
303
267
304−-- These instances were introduces in aeson upstream in 2.0.3
305−#if !MIN_VERSION_aeson(2,0,3)
306instance Arbitrary Value where
268instance Arbitrary Value where
307 -- Weights are almost random
269 -- Weights are almost random
308 -- Uniform oneof tends not to build complex objects cause of recursive call.
270 -- Uniform oneof tends not to build complex objects cause of recursive call.
@@ -313,12 +275,3 @@ instance Arbitrary Value where
313 , (3, Number <$> arbitrary)
275 , (3, Number <$> arbitrary)
314 , (3, Bool <$> arbitrary)
276 , (3, Bool <$> arbitrary)
315 , (1, return Null) ]
277 , (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+4−8
@@ -2,7 +2,7 @@
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
@@ -14,10 +14,10 @@ import Data.Proxy
14import Data.Set (Set)
14import Data.Set (Set)
15import qualified Data.Text as Text
15import qualified Data.Text as Text
16
16
17−import Data.OpenApi
17+import Data.Swagger
18−import Data.OpenApi.Declare
18+import Data.Swagger.Declare
19
19
20−import Data.OpenApi.CommonTestTypes
20+import Data.Swagger.CommonTestTypes
21import SpecCommon
21import SpecCommon
22import Test.Hspec
22import Test.Hspec
23
23
@@ -59,9 +59,6 @@ checkInlinedRecSchema proxy js = inlineNonRecursiveSchemas defs s <=> js
59 where
59 where
60 (defs, s) = runDeclare (declareSchema proxy) mempty
60 (defs, s) = runDeclare (declareSchema proxy) mempty
61
61
62−checkToSchemaDeclare :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
63−checkToSchemaDeclare proxy js = runDeclare (declareSchemaRef proxy) mempty <=> js
64−
65spec :: Spec
62spec :: Spec
66spec = do
63spec = do
67 describe "Generic ToSchema" $ do
64 describe "Generic ToSchema" $ do
@@ -81,7 +78,6 @@ spec = do
81 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON
78 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON
82 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON
79 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON
83 context "SingleMaybeField (unary record with Maybe)" $ checkToSchema (Proxy :: Proxy SingleMaybeField) singleMaybeFieldSchemaJSON
80 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
81 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON
86 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
82 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
87 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
83 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
test/Data/OpenApiSpec.hs → test/Data/SwaggerSpec.hsrenamed+36−52
@@ -2,7 +2,7 @@
2{-# LANGUAGE OverloadedStrings #-}
2{-# LANGUAGE OverloadedStrings #-}
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4{-# LANGUAGE QuasiQuotes #-}
4{-# LANGUAGE QuasiQuotes #-}
5−module Data.OpenApiSpec where
5+module Data.SwaggerSpec where
6
6
7import Prelude ()
7import Prelude ()
8import Prelude.Compat
8import Prelude.Compat
@@ -15,7 +15,7 @@ import Data.HashMap.Strict (HashMap)
15import qualified Data.HashSet.InsOrd as InsOrdHS
15import qualified Data.HashSet.InsOrd as InsOrdHS
16import Data.Text (Text)
16import Data.Text (Text)
17
17
18−import Data.OpenApi
18+import Data.Swagger
19import SpecCommon
19import SpecCommon
20import Test.Hspec hiding (example)
20import Test.Hspec hiding (example)
21
21
@@ -42,13 +42,9 @@ spec = do
42 context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
42 context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
43 context "PetStore Example" $ do
43 context "PetStore Example" $ do
44 it "decodes successfully" $ do
44 it "decodes successfully" $ do
45− fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)
45+ fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: Swagger) -> True; _ -> False)
46 it "roundtrips: fmap toJSON . fromJSON" $ do
46 it "roundtrips: fmap toJSON . fromJSON" $ do
47− (toJSON :: OpenApi -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON
47+ (toJSON :: Swagger -> 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
48
53main :: IO ()
49main :: IO ()
54main = hspec spec
50main = hspec spec
@@ -136,15 +132,15 @@ operationExample = mempty
136 & description ?~ "ID of pet that needs to be updated"
132 & description ?~ "ID of pet that needs to be updated"
137 & required ?~ True
133 & required ?~ True
138 & in_ .~ ParamPath
134 & in_ .~ ParamPath
139− & schema ?~ Inline (mempty & type_ ?~ OpenApiString))]
135+ & schema ?~ Inline (mempty & type_ ?~ SwaggerString))]
140 & requestBody ?~ Inline (
136 & requestBody ?~ Inline (
141 mempty & content . at "application/x-www-form-urlencoded" ?~ (mempty & schema ?~ (Inline (mempty
137 mempty & content . at "application/x-www-form-urlencoded" ?~ (mempty & schema ?~ (Inline (mempty
142 & properties . at "petId" ?~ Inline (mempty
138 & properties . at "petId" ?~ Inline (mempty
143 & description ?~ "Updated name of the pet"
139 & description ?~ "Updated name of the pet"
144− & type_ ?~ OpenApiString)
140+ & type_ ?~ SwaggerString)
145 & properties . at "status" ?~ Inline (mempty
141 & properties . at "status" ?~ Inline (mempty
146 & description ?~ "Updated status of the pet"
142 & description ?~ "Updated status of the pet"
147− & type_ ?~ OpenApiString)))))
143+ & type_ ?~ SwaggerString)))))
148 & at 200 ?~ "Pet updated."
144 & at 200 ?~ "Pet updated."
149 & at 405 ?~ "Invalid input"
145 & at 405 ?~ "Invalid input"
150 & security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]
146 & security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]
@@ -212,7 +208,7 @@ operationExampleJSON = [aesonQQ|
212
208
213schemaPrimitiveExample :: Schema
209schemaPrimitiveExample :: Schema
214schemaPrimitiveExample = mempty
210schemaPrimitiveExample = mempty
215− & type_ ?~ OpenApiString
211+ & type_ ?~ SwaggerString
216 & format ?~ "email"
212 & format ?~ "email"
217
213
218schemaPrimitiveExampleJSON :: Value
214schemaPrimitiveExampleJSON :: Value
@@ -225,14 +221,14 @@ schemaPrimitiveExampleJSON = [aesonQQ|
225
221
226schemaSimpleModelExample :: Schema
222schemaSimpleModelExample :: Schema
227schemaSimpleModelExample = mempty
223schemaSimpleModelExample = mempty
228− & type_ ?~ OpenApiObject
224+ & type_ ?~ SwaggerObject
229 & required .~ [ "name" ]
225 & required .~ [ "name" ]
230 & properties .~
226 & properties .~
231− [ ("name", Inline (mempty & type_ ?~ OpenApiString))
227+ [ ("name", Inline (mempty & type_ ?~ SwaggerString))
232 , ("address", Ref (Reference "Address"))
228 , ("address", Ref (Reference "Address"))
233 , ("age", Inline $ mempty
229 , ("age", Inline $ mempty
234 & minimum_ ?~ 0
230 & minimum_ ?~ 0
235− & type_ ?~ OpenApiInteger
231+ & type_ ?~ SwaggerInteger
236 & format ?~ "int32" ) ]
232 & format ?~ "int32" ) ]
237
233
238schemaSimpleModelExampleJSON :: Value
234schemaSimpleModelExampleJSON :: Value
@@ -257,8 +253,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|
257
253
258schemaModelDictExample :: Schema
254schemaModelDictExample :: Schema
259schemaModelDictExample = mempty
255schemaModelDictExample = mempty
260− & type_ ?~ OpenApiObject
256+ & type_ ?~ SwaggerObject
261− & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ OpenApiString))
257+ & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ SwaggerString))
262
258
263schemaModelDictExampleJSON :: Value
259schemaModelDictExampleJSON :: Value
264schemaModelDictExampleJSON = [aesonQQ|
260schemaModelDictExampleJSON = [aesonQQ|
@@ -272,7 +268,7 @@ schemaModelDictExampleJSON = [aesonQQ|
272
268
273schemaAdditionalExample :: Schema
269schemaAdditionalExample :: Schema
274schemaAdditionalExample = mempty
270schemaAdditionalExample = mempty
275− & type_ ?~ OpenApiObject
271+ & type_ ?~ SwaggerObject
276 & additionalProperties ?~ AdditionalPropertiesAllowed True
272 & additionalProperties ?~ AdditionalPropertiesAllowed True
277
273
278schemaAdditionalExampleJSON :: Value
274schemaAdditionalExampleJSON :: Value
@@ -285,13 +281,13 @@ schemaAdditionalExampleJSON = [aesonQQ|
285
281
286schemaWithExampleExample :: Schema
282schemaWithExampleExample :: Schema
287schemaWithExampleExample = mempty
283schemaWithExampleExample = mempty
288− & type_ ?~ OpenApiObject
284+ & type_ ?~ SwaggerObject
289 & properties .~
285 & properties .~
290 [ ("id", Inline $ mempty
286 [ ("id", Inline $ mempty
291− & type_ ?~ OpenApiInteger
287+ & type_ ?~ SwaggerInteger
292 & format ?~ "int64" )
288 & format ?~ "int64" )
293 , ("name", Inline $ mempty
289 , ("name", Inline $ mempty
294− & type_ ?~ OpenApiString) ]
290+ & type_ ?~ SwaggerString) ]
295 & required .~ [ "name" ]
291 & required .~ [ "name" ]
296 & example ?~ [aesonQQ|
292 & example ?~ [aesonQQ|
297 {
293 {
@@ -330,19 +326,19 @@ schemaWithExampleExampleJSON = [aesonQQ|
330definitionsExample :: HashMap Text Schema
326definitionsExample :: HashMap Text Schema
331definitionsExample =
327definitionsExample =
332 [ ("Category", mempty
328 [ ("Category", mempty
333− & type_ ?~ OpenApiObject
329+ & type_ ?~ SwaggerObject
334 & properties .~
330 & properties .~
335 [ ("id", Inline $ mempty
331 [ ("id", Inline $ mempty
336− & type_ ?~ OpenApiInteger
332+ & type_ ?~ SwaggerInteger
337 & format ?~ "int64")
333 & format ?~ "int64")
338− , ("name", Inline (mempty & type_ ?~ OpenApiString)) ] )
334+ , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] )
339 , ("Tag", mempty
335 , ("Tag", mempty
340− & type_ ?~ OpenApiObject
336+ & type_ ?~ SwaggerObject
341 & properties .~
337 & properties .~
342 [ ("id", Inline $ mempty
338 [ ("id", Inline $ mempty
343− & type_ ?~ OpenApiInteger
339+ & type_ ?~ SwaggerInteger
344 & format ?~ "int64")
340 & format ?~ "int64")
345− , ("name", Inline (mempty & type_ ?~ OpenApiString)) ] ) ]
341+ , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] ) ]
346
342
347definitionsExampleJSON :: Value
343definitionsExampleJSON :: Value
348definitionsExampleJSON = [aesonQQ|
344definitionsExampleJSON = [aesonQQ|
@@ -386,7 +382,7 @@ paramsDefinitionExample =
386 & required ?~ True
382 & required ?~ True
387 & in_ .~ ParamQuery
383 & in_ .~ ParamQuery
388 & schema ?~ Inline (mempty
384 & schema ?~ Inline (mempty
389− & type_ ?~ OpenApiInteger
385+ & type_ ?~ SwaggerInteger
390 & format ?~ "int32" ))
386 & format ?~ "int32" ))
391 , ("limitParam", mempty
387 , ("limitParam", mempty
392 & name .~ "limit"
388 & name .~ "limit"
@@ -394,7 +390,7 @@ paramsDefinitionExample =
394 & required ?~ True
390 & required ?~ True
395 & in_ .~ ParamQuery
391 & in_ .~ ParamQuery
396 & schema ?~ Inline (mempty
392 & schema ?~ Inline (mempty
397− & type_ ?~ OpenApiInteger
393+ & type_ ?~ SwaggerInteger
398 & format ?~ "int32" )) ]
394 & format ?~ "int32" )) ]
399
395
400paramsDefinitionExampleJSON :: Value
396paramsDefinitionExampleJSON :: Value
@@ -445,7 +441,7 @@ responsesDefinitionExampleJSON = [aesonQQ|
445|]
441|]
446
442
447-- =======================================================================
443-- =======================================================================
448−-- Security Definition object
444+-- Responses Definition object
449-- =======================================================================
445-- =======================================================================
450
446
451securityDefinitionsExample :: SecurityDefinitions
447securityDefinitionsExample :: SecurityDefinitions
@@ -531,23 +527,11 @@ oAuth2SecurityDefinitionsExampleJSON = [aesonQQ|
531}
527}
532|]
528|]
533
529
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-- =======================================================================
530-- =======================================================================
547-- Swagger object
531-- Swagger object
548-- =======================================================================
532-- =======================================================================
549
533
550−emptyPathsFieldExample :: OpenApi
534+emptyPathsFieldExample :: Swagger
551emptyPathsFieldExample = mempty
535emptyPathsFieldExample = mempty
552
536
553emptyPathsFieldExampleJSON :: Value
537emptyPathsFieldExampleJSON :: Value
@@ -560,7 +544,7 @@ emptyPathsFieldExampleJSON = [aesonQQ|
560}
544}
561|]
545|]
562
546
563−swaggerExample :: OpenApi
547+swaggerExample :: Swagger
564swaggerExample = mempty
548swaggerExample = mempty
565 -- & basePath ?~ "/"
549 -- & basePath ?~ "/"
566 -- & schemes ?~ [Http]
550 -- & schemes ?~ [Http]
@@ -575,7 +559,7 @@ swaggerExample = mempty
575 & description .~ "OK"
559 & description .~ "OK"
576 & content . at "application/json" ?~ (mempty
560 & content . at "application/json" ?~ (mempty
577 & schema ?~ Inline (mempty
561 & schema ?~ Inline (mempty
578− & type_ ?~ OpenApiObject
562+ & type_ ?~ SwaggerObject
579 & example ?~ [aesonQQ|
563 & example ?~ [aesonQQ|
580 {
564 {
581 "created": 100,
565 "created": 100,
@@ -584,9 +568,9 @@ swaggerExample = mempty
584 & description ?~ "This is some real Todo right here"
568 & description ?~ "This is some real Todo right here"
585 & properties .~
569 & properties .~
586 [ ("created", Inline $ mempty
570 [ ("created", Inline $ mempty
587− & type_ ?~ OpenApiInteger
571+ & type_ ?~ SwaggerInteger
588 & format ?~ "int32")
572 & format ?~ "int32")
589− , ("description", Inline (mempty & type_ ?~ OpenApiString))])))
573+ , ("description", Inline (mempty & type_ ?~ SwaggerString))])))
590 & parameters .~
574 & parameters .~
591 [ Inline $ mempty
575 [ Inline $ mempty
592 & required ?~ True
576 & required ?~ True
@@ -594,7 +578,7 @@ swaggerExample = mempty
594 & description ?~ "TodoId param"
578 & description ?~ "TodoId param"
595 & in_ .~ ParamPath
579 & in_ .~ ParamPath
596 & schema ?~ Inline (mempty
580 & schema ?~ Inline (mempty
597− & type_ ?~ OpenApiString ) ]
581+ & type_ ?~ SwaggerString ) ]
598 & tags .~ InsOrdHS.fromList [ "todo" ] ))
582 & tags .~ InsOrdHS.fromList [ "todo" ] ))
599
583
600swaggerExampleJSON :: Value
584swaggerExampleJSON :: Value
@@ -933,14 +917,14 @@ petstoreExampleJSON = [aesonQQ|
933
917
934compositionSchemaExample :: Schema
918compositionSchemaExample :: Schema
935compositionSchemaExample = mempty
919compositionSchemaExample = mempty
936− & type_ ?~ OpenApiObject
920+ & type_ ?~ SwaggerObject
937− & Data.OpenApi.allOf ?~ [
921+ & Data.Swagger.allOf ?~ [
938 Ref (Reference "Other")
922 Ref (Reference "Other")
939 , Inline (mempty
923 , Inline (mempty
940− & type_ ?~ OpenApiObject
924+ & type_ ?~ SwaggerObject
941 & properties .~
925 & properties .~
942 [ ("greet", Inline $ mempty
926 [ ("greet", Inline $ mempty
943− & type_ ?~ OpenApiString) ])
927+ & type_ ?~ SwaggerString) ])
944 ]
928 ]
945
929
946compositionSchemaExampleJSON :: Value
930compositionSchemaExampleJSON :: Value
test/SpecCommon.hs+8
@@ -8,6 +8,14 @@ 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, HasCallStack) => a -> Value -> Spec
12x <=> js = do
20x <=> js = do
13 it "encodes correctly" $ do
21 it "encodes correctly" $ do