git.iko.soy/typeable/openapi3
on master help sign in
.github/workflows/haskell-ci.ymlnew file+243
since splitsnapshots
unifiedsplit
@@ -0,0 +1,243 @@
1+# This GitHub workflow config has been generated by a script via
2+#
3+# haskell-ci 'github' 'cabal.project'
4+#
5+# To regenerate the script (for example after adjusting tested-with) run
6+#
7+# haskell-ci regenerate
8+#
9+# For more information, see https://github.com/haskell-CI/haskell-ci
10+#
11+# version: 0.14.3
12+#
13+# REGENDATA ("0.14.3",["github","cabal.project"])
14+#
15+name: Haskell-CI
16+on:
17+ push:
18+ branches:
19+ - master
20+ pull_request:
21+ branches:
22+ - master
23+jobs:
24+ linux:
25+ name: Haskell-CI - Linux - ${{ matrix.compiler }}
26+ runs-on: ubuntu-18.04
27+ timeout-minutes:
28+ 60
29+ container:
30+ image: buildpack-deps:focal
31+ continue-on-error: ${{ matrix.allow-failure }}
32+ strategy:
33+ matrix:
34+ include:
35+ - compiler: ghc-9.2.2
36+ compilerKind: ghc
37+ compilerVersion: 9.2.2
38+ setup-method: ghcup
39+ allow-failure: true
40+ - compiler: ghc-9.0.2
41+ compilerKind: ghc
42+ compilerVersion: 9.0.2
43+ setup-method: ghcup
44+ allow-failure: false
45+ - compiler: ghc-8.10.7
46+ compilerKind: ghc
47+ compilerVersion: 8.10.7
48+ setup-method: ghcup
49+ allow-failure: false
50+ - compiler: ghc-8.8.4
51+ compilerKind: ghc
52+ compilerVersion: 8.8.4
53+ setup-method: hvr-ppa
54+ allow-failure: false
55+ - compiler: ghc-8.6.5
56+ compilerKind: ghc
57+ compilerVersion: 8.6.5
58+ setup-method: hvr-ppa
59+ allow-failure: false
60+ - compiler: ghc-8.4.4
61+ compilerKind: ghc
62+ compilerVersion: 8.4.4
63+ setup-method: hvr-ppa
64+ allow-failure: false
65+ fail-fast: false
66+ steps:
67+ - name: apt
68+ run: |
69+ apt-get update
70+ apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
71+ if [ "${{ matrix.setup-method }}" = ghcup ]; then
72+ mkdir -p "$HOME/.ghcup/bin"
73+ curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
74+ chmod a+x "$HOME/.ghcup/bin/ghcup"
75+ "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER"
76+ "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
77+ else
78+ apt-add-repository -y 'ppa:hvr/ghc'
79+ apt-get update
80+ apt-get install -y "$HCNAME"
81+ mkdir -p "$HOME/.ghcup/bin"
82+ curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
83+ chmod a+x "$HOME/.ghcup/bin/ghcup"
84+ "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
85+ fi
86+ env:
87+ HCKIND: ${{ matrix.compilerKind }}
88+ HCNAME: ${{ matrix.compiler }}
89+ HCVER: ${{ matrix.compilerVersion }}
90+ - name: Set PATH and environment variables
91+ run: |
92+ echo "$HOME/.cabal/bin" >> $GITHUB_PATH
93+ echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
94+ echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
95+ echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
96+ HCDIR=/opt/$HCKIND/$HCVER
97+ if [ "${{ matrix.setup-method }}" = ghcup ]; then
98+ HC=$HOME/.ghcup/bin/$HCKIND-$HCVER
99+ echo "HC=$HC" >> "$GITHUB_ENV"
100+ echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"
101+ echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"
102+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
103+ else
104+ HC=$HCDIR/bin/$HCKIND
105+ echo "HC=$HC" >> "$GITHUB_ENV"
106+ echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
107+ echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
108+ echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
109+ fi
110+
111+ HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
112+ echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
113+ echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
114+ echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
115+ echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
116+ echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
117+ echo "GHCJSARITH=0" >> "$GITHUB_ENV"
118+ env:
119+ HCKIND: ${{ matrix.compilerKind }}
120+ HCNAME: ${{ matrix.compiler }}
121+ HCVER: ${{ matrix.compilerVersion }}
122+ - name: env
123+ run: |
124+ env
125+ - name: write cabal config
126+ run: |
127+ mkdir -p $CABAL_DIR
128+ cat >> $CABAL_CONFIG <<EOF
129+ remote-build-reporting: anonymous
130+ write-ghc-environment-files: never
131+ remote-repo-cache: $CABAL_DIR/packages
132+ logs-dir: $CABAL_DIR/logs
133+ world-file: $CABAL_DIR/world
134+ extra-prog-path: $CABAL_DIR/bin
135+ symlink-bindir: $CABAL_DIR/bin
136+ installdir: $CABAL_DIR/bin
137+ build-summary: $CABAL_DIR/logs/build.log
138+ store-dir: $CABAL_DIR/store
139+ install-dirs user
140+ prefix: $CABAL_DIR
141+ repository hackage.haskell.org
142+ url: http://hackage.haskell.org/
143+ EOF
144+ cat >> $CABAL_CONFIG <<EOF
145+ program-default-options
146+ ghc-options: $GHCJOBS +RTS -M3G -RTS
147+ EOF
148+ cat $CABAL_CONFIG
149+ - name: versions
150+ run: |
151+ $HC --version || true
152+ $HC --print-project-git-commit-id || true
153+ $CABAL --version || true
154+ - name: update cabal index
155+ run: |
156+ $CABAL v2-update -v
157+ - name: install cabal-plan
158+ run: |
159+ mkdir -p $HOME/.cabal/bin
160+ curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.6.2.0/cabal-plan-0.6.2.0-x86_64-linux.xz > cabal-plan.xz
161+ echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c -
162+ xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
163+ rm -f cabal-plan.xz
164+ chmod a+x $HOME/.cabal/bin/cabal-plan
165+ cabal-plan --version
166+ - name: checkout
167+ uses: actions/checkout@v2
168+ with:
169+ path: source
170+ - name: initial cabal.project for sdist
171+ run: |
172+ touch cabal.project
173+ echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project
174+ cat cabal.project
175+ - name: sdist
176+ run: |
177+ mkdir -p sdist
178+ $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
179+ - name: unpack
180+ run: |
181+ mkdir -p unpacked
182+ find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
183+ - name: generate cabal.project
184+ run: |
185+ PKGDIR_openapi3="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/openapi3-[0-9.]*')"
186+ echo "PKGDIR_openapi3=${PKGDIR_openapi3}" >> "$GITHUB_ENV"
187+ rm -f cabal.project cabal.project.local
188+ touch cabal.project
189+ touch cabal.project.local
190+ echo "packages: ${PKGDIR_openapi3}" >> cabal.project
191+ echo "package openapi3" >> cabal.project
192+ echo " ghc-options: -Werror=missing-methods" >> cabal.project
193+ cat >> cabal.project <<EOF
194+ allow-newer: http-media:base
195+ EOF
196+ $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(openapi3)$/; }' >> cabal.project.local
197+ cat cabal.project
198+ cat cabal.project.local
199+ - name: dump install plan
200+ run: |
201+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
202+ cabal-plan
203+ - name: cache
204+ uses: actions/cache@v2
205+ with:
206+ key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
207+ path: ~/.cabal/store
208+ restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
209+ - name: install dependencies
210+ run: |
211+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
212+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
213+ - name: build w/o tests
214+ run: |
215+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
216+ - name: build
217+ run: |
218+ $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
219+ - name: tests
220+ run: |
221+ $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
222+ - name: cabal check
223+ run: |
224+ cd ${PKGDIR_openapi3} || false
225+ ${CABAL} -vnormal check
226+ - name: haddock
227+ run: |
228+ $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
229+ - name: unconstrained build
230+ run: |
231+ rm -f cabal.project.local
232+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
233+ - name: prepare for constraint sets
234+ run: |
235+ rm -f cabal.project.local
236+ - name: constraint set aeson-2
237+ run: |
238+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson >=2.0' --dependencies-only -j2 all
239+ $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson >=2.0' all
240+ - name: constraint set aeson-1
241+ run: |
242+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson <2.0' --dependencies-only -j2 all ; fi
243+ if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson <2.0' all ; fi
.travis.ymldeleted−149
@@ -1,149 +0,0 @@
1−# This Travis job script has been generated by a script via
2−#
3−# haskell-ci '--branches' 'master' '--haddock-jobs=>=8.4' '--output' '.travis.yml' 'swagger2.cabal'
4−#
5−# To regenerate the script (for example after adjusting tested-with) run
6−#
7−# haskell-ci regenerate
8−#
9−# For more information, see https://github.com/haskell-CI/haskell-ci
10−#
11−# version: 0.10.1
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.3
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.3","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−before_install:
52− - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')
53− - WITHCOMPILER="-w $HC"
54− - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')
55− - HCPKG="$HC-pkg"
56− - unset CC
57− - CABAL=/opt/ghc/bin/cabal
58− - CABALHOME=$HOME/.cabal
59− - export PATH="$CABALHOME/bin:$PATH"
60− - TOP=$(pwd)
61− - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"
62− - echo $HCNUMVER
63− - CABAL="$CABAL -vnormal+nowrap"
64− - set -o pipefail
65− - TEST=--enable-tests
66− - BENCH=--enable-benchmarks
67− - HEADHACKAGE=false
68− - rm -f $CABALHOME/config
69− - |
70− echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config
71− echo "remote-build-reporting: anonymous" >> $CABALHOME/config
72− echo "write-ghc-environment-files: always" >> $CABALHOME/config
73− echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config
74− echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config
75− echo "world-file: $CABALHOME/world" >> $CABALHOME/config
76− echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config
77− echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config
78− echo "installdir: $CABALHOME/bin" >> $CABALHOME/config
79− echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config
80− echo "store-dir: $CABALHOME/store" >> $CABALHOME/config
81− echo "install-dirs user" >> $CABALHOME/config
82− echo " prefix: $CABALHOME" >> $CABALHOME/config
83− echo "repository hackage.haskell.org" >> $CABALHOME/config
84− echo " url: http://hackage.haskell.org/" >> $CABALHOME/config
85−install:
86− - ${CABAL} --version
87− - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
88− - |
89− echo "program-default-options" >> $CABALHOME/config
90− echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config
91− - cat $CABALHOME/config
92− - rm -fv cabal.project cabal.project.local cabal.project.freeze
93− - travis_retry ${CABAL} v2-update -v
94− # Generate cabal.project
95− - rm -rf cabal.project cabal.project.local cabal.project.freeze
96− - touch cabal.project
97− - |
98− echo "packages: ." >> cabal.project
99− - echo 'package swagger2' >> cabal.project
100− - "echo ' ghc-options: -Werror=missing-methods' >> cabal.project"
101− - |
102− - "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"
103− - cat cabal.project || true
104− - cat cabal.project.local || true
105− - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi
106− - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}
107− - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
108− - rm cabal.project.freeze
109− - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all
110− - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all
111−script:
112− - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)
113− # Packaging...
114− - ${CABAL} v2-sdist all
115− # Unpacking...
116− - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/
117− - cd ${DISTDIR} || false
118− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;
119− - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;
120− - PKGDIR_swagger2="$(find . -maxdepth 1 -type d -regex '.*/swagger2-[0-9.]*')"
121− # Generate cabal.project
122− - rm -rf cabal.project cabal.project.local cabal.project.freeze
123− - touch cabal.project
124− - |
125− echo "packages: ${PKGDIR_swagger2}" >> cabal.project
126− - echo 'package swagger2' >> cabal.project
127− - "echo ' ghc-options: -Werror=missing-methods' >> cabal.project"
128− - |
129− - "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"
130− - cat cabal.project || true
131− - cat cabal.project.local || true
132− # Building...
133− # this builds all libraries and executables (without tests/benchmarks)
134− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
135− # Building with tests and benchmarks...
136− # build & run tests, build benchmarks
137− - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all
138− # Testing...
139− - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all
140− # cabal check...
141− - (cd ${PKGDIR_swagger2} && ${CABAL} -vnormal check)
142− # haddock...
143− - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all
144− # Building without installed constraints for packages in global-db...
145− - rm -f cabal.project.local
146− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all
147−
148−# REGENDATA ("0.10.1",["--branches","master","--haddock-jobs=>=8.4","--output",".travis.yml","swagger2.cabal"])
149−# EOF
CHANGELOG.md+47
@@ -1,3 +1,50 @@
1+Unreleased
2+----------
3+
4+3.2.2
5+-----
6+
7+- Fix bug with infinite recursion in GToSchema [#37](https://github.com/biocad/openapi3/pull/37).
8+
9+3.2.1
10+-----
11+
12+- Support aeson-2.0.3.
13+- Support GHC-9.2 (doctests still fail).
14+
15+3.2.0
16+-----
17+
18+- Support aeson-2 [#34](https://github.com/biocad/openapi3/pull/34).
19+- Use `SecurityDefinitions` type for `_componentsSecuritySchemes`
20+ [#32](https://github.com/biocad/openapi3/pull/32).
21+
22+3.1.0
23+-----
24+
25+- Use `format: date-time` for `ToParamSchema ZonedTime` instance (see
26+ [#20](https://github.com/biocad/openapi3/pull/20)).
27+- Support generating schema for any polymorphic types via `Typeable` (see
28+ [#19](https://github.com/biocad/openapi3/pull/19)).
29+- Allow `hashable-1.3.1`, prettify doctests (see [#18](https://github.com/biocad/openapi3/pull/18)).
30+
31+3.0.2.0
32+-------
33+
34+- Fix definition for HTTP security scheme (see [#10](https://github.com/biocad/openapi3/pull/10));
35+- Fix error message in `exclusiveMaximum` / `exclusiveMinimum` validation (see
36+ [#15](https://github.com/biocad/openapi3/pull/15));
37+
38+3.0.1.0
39+-------
40+
41+- Support polymorphic types in schema generator.
42+
43+3.0.0
44+-----
45+
46+- Switch to OpenAPI 3.0 specification.
47+
12.6.1
482.6.1
2-----
49-----
3
50
README.md+13−11
@@ -1,21 +1,22 @@
1−# swagger2
1+# OpenApi 3
2
2
3−[![Join the chat at https://gitter.im/haskell-swagger2/Lobby](https://badges.gitter.im/haskell-swagger2/Lobby.svg)](https://gitter.im/haskell-swagger2/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)
3+[![Hackage](https://img.shields.io/hackage/v/openapi3.svg)](http://hackage.haskell.org/package/openapi3)
4+[![Build Status](https://travis-ci.org/biocad/openapi3.svg?branch=master)](https://travis-ci.org/biocad/openapi3)
5+[![Stackage LTS](http://stackage.org/package/openapi3/badge/lts)](http://stackage.org/lts/package/opeopenapi3)
6+[![Stackage Nightly](http://stackage.org/package/openapi3/badge/nightly)](http://stackage.org/nightly/package/openapi3)
4
7
5−[![Hackage](https://img.shields.io/hackage/v/swagger2.svg)](http://hackage.haskell.org/package/swagger2)
8+OpenAPI 3.0 data model.
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−Swagger 2.0 data model.
10+The original OpenAPI 3.0 specification is available at http://swagger.io/specification/.
11
11
12−The original Swagger 2.0 specification is available at http://swagger.io/specification/.
12+This package is heavily based on excellent work on Swagger 2.0 at
13+https://github.com/GetShopTV/swagger2.
13
14
14## Usage
15## Usage
15
16
16−This library is intended to be used for decoding and encoding Swagger 2.0 API specifications as well as manipulating them.
17+This library is intended to be used for decoding and encoding OpenApi 3.0.3 specifications as well as manipulating them.
17
18
18−Please refer to [haddock documentation](http://hackage.haskell.org/package/swagger2).
19+Please refer to [haddock documentation](http://hackage.haskell.org/package/openapi3).
19
20
20Some examples can be found in [`examples/` directory](/examples).
21Some examples can be found in [`examples/` directory](/examples).
21
22
@@ -33,7 +34,8 @@ Many Swagger tools, including server and client code generation for many languag
33
34
34We are happy to receive bug reports, fixes, documentation enhancements, and other improvements.
35We are happy to receive bug reports, fixes, documentation enhancements, and other improvements.
35
36
36−Please report bugs via the [github issue tracker](https://github.com/GetShopTV/swagger2/issues).
37+Please report bugs via the [github issue tracker](https://github.com/biocad/openapi3/issues).
37
38
38*GetShopTV Team*
39*GetShopTV Team*
39
40
41+*Biocad Team*
cabal.haskell-cinew file+11
@@ -0,0 +1,11 @@
1+branches: master
2+
3+distribution: focal
4+allow-failures: >=9.2
5+
6+constraint-set aeson-1
7+ constraints: aeson <2.0
8+ ghc: <9.2
9+
10+constraint-set aeson-2
11+ constraints: aeson >=2.0
cabal.project+2
@@ -1,2 +1,4 @@
1packages: .
1packages: .
2tests: true
2tests: true
3+
4+allow-newer: http-media:base
examples/hackage.hs+16−20
@@ -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.Swagger
13+import Data.OpenApi
14−import Data.Swagger.Declare
14+import Data.OpenApi.Declare
15−import Data.Swagger.Lens
15+import Data.OpenApi.Lens
16−import Data.Swagger.Operation
16+import Data.OpenApi.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_ ?~ SwaggerObject
30+ & type_ ?~ OpenApiObject
31 & properties .~
31 & properties .~
32 [ ("summaryUsername", usernameSchema )
32 [ ("summaryUsername", usernameSchema )
33 , ("summaryUserid" , useridSchema )
33 , ("summaryUserid" , useridSchema )
@@ -47,40 +47,36 @@ data UserDetailed = UserDetailed
47newtype Package = Package { packageName :: Text }
47newtype Package = Package { packageName :: Text }
48 deriving (Generic, ToSchema)
48 deriving (Generic, ToSchema)
49
49
50−hackageSwagger :: Swagger
50+hackageOpenApi :: OpenApi
51−hackageSwagger = spec & definitions .~ defs
51+hackageOpenApi = spec & components.schemas .~ defs
52 where
52 where
53− (defs, spec) = runDeclare declareHackageSwagger mempty
53+ (defs, spec) = runDeclare declareHackageOpenApi mempty
54
54
55−declareHackageSwagger :: Declare (Definitions Schema) Swagger
55+declareHackageOpenApi :: Declare (Definitions Schema) OpenApi
56−declareHackageSwagger = do
56+declareHackageOpenApi = 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 (Proxy :: Proxy UserSummary)
61+ userSummaryResponse <- declareResponse "application/json" (Proxy :: Proxy UserSummary)
62− userDetailedResponse <- declareResponse (Proxy :: Proxy UserDetailed)
62+ userDetailedResponse <- declareResponse "application/json" (Proxy :: Proxy UserDetailed)
63− packagesResponse <- declareResponse (Proxy :: Proxy [Package])
63+ packagesResponse <- declareResponse "application/json" (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"]
69 & at 200 ?~ Inline userSummaryResponse))
68 & at 200 ?~ Inline userSummaryResponse))
70 , ("/user/{username}", mempty & get ?~ (mempty
69 , ("/user/{username}", mempty & get ?~ (mempty
71− & produces ?~ MimeList ["application/json"]
72 & parameters .~ [ Inline $ mempty
70 & parameters .~ [ Inline $ mempty
73 & name .~ "username"
71 & name .~ "username"
74 & required ?~ True
72 & required ?~ True
75− & schema .~ ParamOther (mempty
76− & in_ .~ ParamPath
73+ & in_ .~ ParamPath
77− & paramSchema .~ usernameParamSchema) ]
74+ & schema ?~ Inline usernameParamSchema ]
78 & at 200 ?~ Inline userDetailedResponse))
75 & at 200 ?~ Inline userDetailedResponse))
79 , ("/packages", mempty & get ?~ (mempty
76 , ("/packages", mempty & get ?~ (mempty
80− & produces ?~ MimeList ["application/json"]
81 & at 200 ?~ Inline packagesResponse))
77 & at 200 ?~ Inline packagesResponse))
82 ]
78 ]
83
79
84main :: IO ()
80main :: IO ()
85−main = putStrLn . read . show . encode $ hackageSwagger
81+main = putStrLn . read . show . encode $ hackageOpenApi
86
82
swagger2.cabal → openapi3.cabalrenamed+62−52
@@ -1,22 +1,22 @@
1cabal-version: >=1.10
1cabal-version: >=1.10
2−name: swagger2
2+name: openapi3
3−version: 2.6.1
3+version: 3.2.2
4
4
5−synopsis: Swagger 2.0 data model
5+synopsis: OpenAPI 3.0 data model
6−category: Web, Swagger
6+category: Web, Swagger, OpenApi
7description:
7description:
8− This library is intended to be used for decoding and encoding Swagger 2.0 API
8+ This library is intended to be used for decoding and encoding OpenAPI 3.0 API
9 specifications as well as manipulating them.
9 specifications as well as manipulating them.
10 .
10 .
11− The original Swagger 2.0 specification is available at http://swagger.io/specification/.
11+ The original OpenAPI 3.0 specification is available at http://swagger.io/specification/.
12
12
13−homepage: https://github.com/GetShopTV/swagger2
13+homepage: https://github.com/biocad/openapi3
14−bug-reports: https://github.com/GetShopTV/swagger2/issues
14+bug-reports: https://github.com/biocad/openapi3/issues
15license: BSD3
15license: BSD3
16license-file: LICENSE
16license-file: LICENSE
17−author: Nickolay Kudasov
17+author: Nickolay Kudasov, Maxim Koltsov
18−maintainer: nickolay@getshoptv.com
18+maintainer: nickolay@getshoptv.com, kolmax94@gmail.com
19−copyright: (c) 2015-2016, GetShopTV
19+copyright: (c) 2015-2016, GetShopTV, (c) 2020, Biocad
20build-type: Custom
20build-type: Custom
21extra-source-files:
21extra-source-files:
22 README.md
22 README.md
@@ -25,8 +25,10 @@ extra-source-files:
25tested-with:
25tested-with:
26 GHC ==8.4.4
26 GHC ==8.4.4
27 || ==8.6.5
27 || ==8.6.5
28− || ==8.8.3
28+ || ==8.8.4
29− || ==8.10.1
29+ || ==8.10.7
30+ || ==9.0.2
31+ || ==9.2.2
30
32
31custom-setup
33custom-setup
32 setup-depends:
34 setup-depends:
@@ -35,54 +37,56 @@ custom-setup
35library
37library
36 hs-source-dirs: src
38 hs-source-dirs: src
37 exposed-modules:
39 exposed-modules:
38− Data.Swagger
40+ Data.OpenApi
39− Data.Swagger.Declare
41+ Data.OpenApi.Declare
40− Data.Swagger.Lens
42+ Data.OpenApi.Lens
41− Data.Swagger.Operation
43+ Data.OpenApi.Operation
42− Data.Swagger.Optics
44+ Data.OpenApi.Optics
43− Data.Swagger.ParamSchema
45+ Data.OpenApi.ParamSchema
44− Data.Swagger.Schema
46+ Data.OpenApi.Schema
45− Data.Swagger.Schema.Generator
47+ Data.OpenApi.Schema.Generator
46− Data.Swagger.Schema.Validation
48+ Data.OpenApi.Schema.Validation
47− Data.Swagger.SchemaOptions
49+ Data.OpenApi.SchemaOptions
48
50
49 -- internal modules
51 -- internal modules
50− Data.Swagger.Internal
52+ Data.OpenApi.Internal
51− Data.Swagger.Internal.Schema
53+ Data.OpenApi.Internal.Schema
52− Data.Swagger.Internal.Schema.Validation
54+ Data.OpenApi.Internal.Schema.Validation
53− Data.Swagger.Internal.ParamSchema
55+ Data.OpenApi.Internal.ParamSchema
54− Data.Swagger.Internal.Utils
56+ Data.OpenApi.Internal.Utils
55− Data.Swagger.Internal.AesonUtils
57+ Data.OpenApi.Internal.AesonUtils
56− Data.Swagger.Internal.TypeShape
58+ Data.OpenApi.Internal.TypeShape
59+
60+ Data.OpenApi.Aeson.Compat
57
61
58 -- GHC boot libraries
62 -- GHC boot libraries
59 build-depends:
63 build-depends:
60− base >=4.11.1.0 && <4.15
64+ base >=4.11.1.0 && <4.17
61− , bytestring >=0.10.8.2 && <0.11
65+ , bytestring >=0.10.8.2 && <0.12
62 , containers >=0.5.11.0 && <0.7
66 , containers >=0.5.11.0 && <0.7
63− , template-haskell >=2.13.0.0 && <2.17
67+ , template-haskell >=2.13.0.0 && <2.19
64− , time >=1.8.0.2 && <1.10
68+ , time >=1.8.0.2 && <1.14
65 , transformers >=0.5.5.0 && <0.6
69 , transformers >=0.5.5.0 && <0.6
66
70
67 build-depends:
71 build-depends:
68 mtl >=2.2.2 && <2.3
72 mtl >=2.2.2 && <2.3
69− , text >=1.2.3.1 && <1.3
73+ , text >=1.2.3.1 && <2.1
70
74
71 -- other dependencies
75 -- other dependencies
72 build-depends:
76 build-depends:
73− base-compat-batteries >=0.11.1 && <0.12
77+ base-compat-batteries >=0.11.1 && <0.13
74− , aeson >=1.4.2.0 && <1.6
78+ , aeson >=1.4.2.0 && <1.6 || >=2.0.1.0 && < 2.1
75 , aeson-pretty >=0.8.7 && <0.9
79 , aeson-pretty >=0.8.7 && <0.9
76 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
80 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
77 , cookie >=0.4.3 && <0.5
81 , cookie >=0.4.3 && <0.5
78 , generics-sop >=0.5.1.0 && <0.6
82 , generics-sop >=0.5.1.0 && <0.6
79− , hashable >=1.2.7.0 && <1.4
83+ , hashable >=1.2.7.0 && <1.5
80 , http-media >=0.8.0.0 && <0.9
84 , http-media >=0.8.0.0 && <0.9
81 , insert-ordered-containers >=0.2.3 && <0.3
85 , insert-ordered-containers >=0.2.3 && <0.3
82− , lens >=4.16.1 && <4.20
86+ , lens >=4.16.1 && <5.2
83 , network >=2.6.3.5 && <3.2
87 , network >=2.6.3.5 && <3.2
84− , optics-core >=0.2 && <0.4
88+ , optics-core >=0.2 && <0.5
85− , optics-th >=0.2 && <0.4
89+ , optics-th >=0.2 && <0.5
86 , scientific >=0.3.6.2 && <0.4
90 , scientific >=0.3.6.2 && <0.4
87 , unordered-containers >=0.2.9.0 && <0.3
91 , unordered-containers >=0.2.9.0 && <0.3
88 , uuid-types >=1.0.3 && <1.1
92 , uuid-types >=1.0.3 && <1.1
@@ -100,7 +104,7 @@ test-suite spec
100 -- We need aeson's toEncoding for doctests too
104 -- We need aeson's toEncoding for doctests too
101 build-depends:
105 build-depends:
102 base
106 base
103− , swagger2
107+ , QuickCheck
104 , aeson
108 , aeson
105 , base-compat-batteries
109 , base-compat-batteries
106 , bytestring
110 , bytestring
@@ -109,32 +113,32 @@ test-suite spec
109 , insert-ordered-containers
113 , insert-ordered-containers
110 , lens
114 , lens
111 , mtl
115 , mtl
116+ , openapi3
112 , template-haskell
117 , template-haskell
113 , text
118 , text
114 , time
119 , time
115 , unordered-containers
120 , unordered-containers
116 , vector
121 , vector
117− , QuickCheck
118
122
119 -- test-suite only dependencies
123 -- test-suite only dependencies
120 build-depends:
124 build-depends:
121− hspec >=2.5.5 && <2.8
125+ hspec >=2.5.5 && <2.10
122 , HUnit >=1.6.0.0 && <1.7
126 , HUnit >=1.6.0.0 && <1.7
123 , quickcheck-instances >=0.3.19 && <0.14
127 , quickcheck-instances >=0.3.19 && <0.14
124 , utf8-string >=1.0.1.1 && <1.1
128 , utf8-string >=1.0.1.1 && <1.1
125
129
126 -- https://github.com/haskell/cabal/issues/3708
130 -- https://github.com/haskell/cabal/issues/3708
127 build-tool-depends:
131 build-tool-depends:
128− hspec-discover:hspec-discover >=2.5.5 && <2.8
132+ hspec-discover:hspec-discover >=2.5.5 && <2.10
129
133
130 other-modules:
134 other-modules:
131 SpecCommon
135 SpecCommon
132− Data.SwaggerSpec
136+ Data.OpenApiSpec
133− Data.Swagger.CommonTestTypes
137+ Data.OpenApi.CommonTestTypes
134− Data.Swagger.ParamSchemaSpec
138+ Data.OpenApi.ParamSchemaSpec
135− Data.Swagger.SchemaSpec
139+ Data.OpenApi.SchemaSpec
136− Data.Swagger.Schema.ValidationSpec
140+ Data.OpenApi.Schema.ValidationSpec
137− Data.Swagger.Schema.GeneratorSpec
141+ Data.OpenApi.Schema.GeneratorSpec
138 default-language: Haskell2010
142 default-language: Haskell2010
139
143
140test-suite doctests
144test-suite doctests
@@ -145,6 +149,12 @@ test-suite doctests
145 main-is: doctests.hs
149 main-is: doctests.hs
146 type: exitcode-stdio-1.0
150 type: exitcode-stdio-1.0
147
151
152+executable example
153+ hs-source-dirs: examples
154+ main-is: hackage.hs
155+ default-language: Haskell2010
156+ build-depends: base, aeson, lens, openapi3, text
157+
148source-repository head
158source-repository head
149 type: git
159 type: git
150− location: https://github.com/GetShopTV/swagger2.git
160+ location: https://github.com/biocad/openapi3.git
src/Data/Swagger.hs → src/Data/OpenApi.hsrenamed+180−49
@@ -1,5 +1,5 @@
1-- |
1-- |
2−-- Module: Data.Swagger
2+-- Module: Data.OpenApi
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.Swagger (
12+module Data.OpenApi (
13 -- * How to use this library
13 -- * How to use this library
14 -- $howto
14 -- $howto
15
15
@@ -29,15 +29,15 @@ module Data.Swagger (
29 -- $validation
29 -- $validation
30
30
31 -- * Re-exports
31 -- * Re-exports
32− module Data.Swagger.Lens,
32+ module Data.OpenApi.Lens,
33− module Data.Swagger.Optics,
33+ module Data.OpenApi.Optics,
34− module Data.Swagger.Operation,
34+ module Data.OpenApi.Operation,
35− module Data.Swagger.ParamSchema,
35+ module Data.OpenApi.ParamSchema,
36− module Data.Swagger.Schema,
36+ module Data.OpenApi.Schema,
37− module Data.Swagger.Schema.Validation,
37+ module Data.OpenApi.Schema.Validation,
38
38
39 -- * Swagger specification
39 -- * Swagger specification
40− Swagger(..),
40+ OpenApi(..),
41 Server(..),
41 Server(..),
42 ServerVariable(..),
42 ServerVariable(..),
43 Components(..),
43 Components(..),
@@ -56,7 +56,7 @@ module Data.Swagger (
56 TagName,
56 TagName,
57
57
58 -- ** Types and formats
58 -- ** Types and formats
59− SwaggerType(..),
59+ OpenApiType(..),
60 Format,
60 Format,
61 Definitions,
61 Definitions,
62 Style(..),
62 Style(..),
@@ -73,10 +73,9 @@ module Data.Swagger (
73 Encoding(..),
73 Encoding(..),
74
74
75 -- ** Schemas
75 -- ** Schemas
76− ParamSchema(..),
77 Schema(..),
76 Schema(..),
78 NamedSchema(..),
77 NamedSchema(..),
79− SwaggerItems(..),
78+ OpenApiItems(..),
80 Xml(..),
79 Xml(..),
81 Pattern,
80 Pattern,
82 AdditionalProperties(..),
81 AdditionalProperties(..),
@@ -86,10 +85,13 @@ module Data.Swagger (
86 Responses(..),
85 Responses(..),
87 Response(..),
86 Response(..),
88 HttpStatusCode,
87 HttpStatusCode,
88+ Link(..),
89+ Callback(..),
89
90
90 -- ** Security
91 -- ** Security
91 SecurityScheme(..),
92 SecurityScheme(..),
92 SecuritySchemeType(..),
93 SecuritySchemeType(..),
94+ HttpSchemeType(..),
93 SecurityDefinitions(..),
95 SecurityDefinitions(..),
94 SecurityRequirement(..),
96 SecurityRequirement(..),
95
97
@@ -119,14 +121,14 @@ module Data.Swagger (
119 URL(..),
121 URL(..),
120) where
122) where
121
123
122−import Data.Swagger.Lens
124+import Data.OpenApi.Lens
123−import Data.Swagger.Optics ()
125+import Data.OpenApi.Optics ()
124−import Data.Swagger.Operation
126+import Data.OpenApi.Operation
125−import Data.Swagger.ParamSchema
127+import Data.OpenApi.ParamSchema
126−import Data.Swagger.Schema
128+import Data.OpenApi.Schema
127−import Data.Swagger.Schema.Validation
129+import Data.OpenApi.Schema.Validation
128
130
129−import Data.Swagger.Internal
131+import Data.OpenApi.Internal
130
132
131-- $setup
133-- $setup
132-- >>> import Control.Lens
134-- >>> import Control.Lens
@@ -135,6 +137,7 @@ import Data.Swagger.Internal
135-- >>> import Data.Proxy
137-- >>> import Data.Proxy
136-- >>> import GHC.Generics
138-- >>> import GHC.Generics
137-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
139-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
140+-- >>> import Data.OpenApi.Internal.Utils
138-- >>> :set -XDeriveGeneric
141-- >>> :set -XDeriveGeneric
139-- >>> :set -XOverloadedStrings
142-- >>> :set -XOverloadedStrings
140-- >>> :set -XOverloadedLists
143-- >>> :set -XOverloadedLists
@@ -151,8 +154,16 @@ import Data.Swagger.Internal
151--
154--
152-- In this library you can use @'mempty'@ for a default/empty value. For instance:
155-- In this library you can use @'mempty'@ for a default/empty value. For instance:
153--
156--
154−-- >>> BSL.putStrLn $ encode (mempty :: Swagger)
157+-- >>> BSL.putStrLn $ encodePretty (mempty :: OpenApi)
158+-- {
159+-- "components": {},
160+-- "info": {
161+-- "title": "",
162+-- "version": ""
163+-- },
155−-- {"openapi":"3.0.0","info":{"version":"","title":""},"components":{}}
164+-- "openapi": "3.0.0",
165+-- "paths": {}
166+-- }
156--
167--
157-- As you can see some spec properties (e.g. @"version"@) are there even when the spec is empty.
168-- As you can see some spec properties (e.g. @"version"@) are there even when the spec is empty.
158-- That is because these properties are actually required ones.
169-- That is because these properties are actually required ones.
@@ -160,46 +171,87 @@ import Data.Swagger.Internal
160-- You /should/ always override the default (empty) value for these properties,
171-- You /should/ always override the default (empty) value for these properties,
161-- although it is not strictly necessary:
172-- although it is not strictly necessary:
162--
173--
163−-- >>> BSL.putStrLn $ encode mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
174+-- >>> BSL.putStrLn $ encodePretty mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
175+-- {
176+-- "title": "Todo API",
164−-- {"version":"1.0","title":"Todo API"}
177+-- "version": "1.0"
178+-- }
165--
179--
166-- You can merge two values using @'mappend'@ or its infix version @('<>')@:
180-- You can merge two values using @'mappend'@ or its infix version @('<>')@:
167--
181--
168−-- >>> BSL.putStrLn $ encode $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
182+-- >>> BSL.putStrLn $ encodePretty $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
169−-- {"version":"1.0","title":"Todo API"}
183+-- {
184+-- "title": "Todo API",
185+-- "version": "1.0"
186+-- }
187+
170--
188--
171-- This can be useful for combining specifications of endpoints into a whole API specification:
189-- This can be useful for combining specifications of endpoints into a whole API specification:
172--
190--
173-- @
191-- @
174-- \-\- /account subAPI specification
192-- \-\- /account subAPI specification
175−-- accountAPI :: Swagger
193+-- accountAPI :: OpenApi
176--
194--
177-- \-\- /task subAPI specification
195-- \-\- /task subAPI specification
178−-- taskAPI :: Swagger
196+-- taskAPI :: OpenApi
179--
197--
180-- \-\- while API specification is just a combination
198-- \-\- while API specification is just a combination
181-- \-\- of subAPIs' specifications
199-- \-\- of subAPIs' specifications
182−-- api :: Swagger
200+-- api :: OpenApi
183-- api = accountAPI <> taskAPI
201-- api = accountAPI <> taskAPI
184-- @
202-- @
185
203
186-- $lens
204-- $lens
187--
205--
188−-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.Swagger.Optics".
206+-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.OpenApi.Optics".
189--
207--
190-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
208-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
191-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses
209-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses
192-- make it fairly simple to construct/modify any part of the specification:
210-- make it fairly simple to construct/modify any part of the specification:
193--
211--
194-- >>> :{
212-- >>> :{
195−-- BSL.putStrLn $ encode $ (mempty :: Swagger)
213+-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
196−-- & components . schemas .~ [ ("User", mempty & type_ ?~ SwaggerString) ]
214+-- & components . schemas .~ [ ("User", mempty & type_ ?~ OpenApiString) ]
197-- & paths .~
215-- & paths .~
198-- [ ("/user", mempty & get ?~ (mempty
216-- [ ("/user", mempty & get ?~ (mempty
199-- & at 200 ?~ ("OK" & _Inline.content.at "application/json" ?~ (mempty & schema ?~ Ref (Reference "User")))
217-- & at 200 ?~ ("OK" & _Inline.content.at "application/json" ?~ (mempty & schema ?~ Ref (Reference "User")))
200-- & at 404 ?~ "User info not found")) ]
218-- & at 404 ?~ "User info not found")) ]
201-- :}
219-- :}
202−-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"404":{"description":"User info not found"},"200":{"content":{"application/json":{"schema":{"$ref":"#/components/schemas/User"}}},"description":"OK"}}}}},"components":{"schemas":{"User":{"type":"string"}}}}
220+-- {
221+-- "components": {
222+-- "schemas": {
223+-- "User": {
224+-- "type": "string"
225+-- }
226+-- }
227+-- },
228+-- "info": {
229+-- "title": "",
230+-- "version": ""
231+-- },
232+-- "openapi": "3.0.0",
233+-- "paths": {
234+-- "/user": {
235+-- "get": {
236+-- "responses": {
237+-- "200": {
238+-- "content": {
239+-- "application/json": {
240+-- "schema": {
241+-- "$ref": "#/components/schemas/User"
242+-- }
243+-- }
244+-- },
245+-- "description": "OK"
246+-- },
247+-- "404": {
248+-- "description": "User info not found"
249+-- }
250+-- }
251+-- }
252+-- }
253+-- }
254+-- }
203--
255--
204-- In the snippet above we declare an API with a single path @/user@. This path provides method @GET@
256-- In the snippet above we declare an API with a single path @/user@. This path provides method @GET@
205-- which produces @application/json@ output. It should respond with code @200@ and body specified
257-- which produces @application/json@ output. It should respond with code @200@ and body specified
@@ -211,23 +263,34 @@ import Data.Swagger.Internal
211-- common field is @'description'@. Many components of a Swagger specification
263-- common field is @'description'@. Many components of a Swagger specification
212-- can have descriptions, and you can use the same name for them:
264-- can have descriptions, and you can use the same name for them:
213--
265--
214−-- >>> BSL.putStrLn $ encode $ (mempty :: Response) & description .~ "No content"
266+-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & description .~ "No content"
267+-- {
215−-- {"description":"No content"}
268+-- "description": "No content"
269+-- }
216-- >>> :{
270-- >>> :{
217−-- BSL.putStrLn $ encode $ (mempty :: Schema)
271+-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)
218−-- & type_ ?~ SwaggerBoolean
272+-- & type_ ?~ OpenApiBoolean
219-- & description ?~ "To be or not to be"
273-- & description ?~ "To be or not to be"
220-- :}
274-- :}
275+-- {
221−-- {"description":"To be or not to be","type":"boolean"}
276+-- "description": "To be or not to be",
277+-- "type": "boolean"
278+-- }
222--
279--
223-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
280-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
224-- have direct access to it via @'at' code@. Example:
281-- have direct access to it via @'at' code@. Example:
225--
282--
226-- >>> :{
283-- >>> :{
227−-- BSL.putStrLn $ encode $ (mempty :: Operation)
284+-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)
228-- & at 404 ?~ "Not found"
285-- & at 404 ?~ "Not found"
229-- :}
286-- :}
287+-- {
288+-- "responses": {
289+-- "404": {
230−-- {"responses":{"404":{"description":"Not found"}}}
290+-- "description": "Not found"
291+-- }
292+-- }
293+-- }
231--
294--
232-- You might've noticed that @'type_'@ has an extra underscore in its name
295-- You might've noticed that @'type_'@ has an extra underscore in its name
233-- compared to, say, @'description'@ field accessor.
296-- compared to, say, @'description'@ field accessor.
@@ -243,7 +306,7 @@ import Data.Swagger.Internal
243-- @'ParamSchema'@ and @'Schema'@ are the two core types for data model specification.
306-- @'ParamSchema'@ and @'Schema'@ are the two core types for data model specification.
244--
307--
245-- @'ParamSchema' t@ specifies all the common properties, available for every data schema.
308-- @'ParamSchema' t@ specifies all the common properties, available for every data schema.
246−-- The @t@ parameter imposes some restrictions on @type@ and @items@ properties (see @'SwaggerType'@ and @'SwaggerItems'@).
309+-- The @t@ parameter imposes some restrictions on @type@ and @items@ properties (see @'OpenApiType'@ and @'OpenApiItems'@).
247--
310--
248-- @'Schema'@ is used for request and response bodies and allows specifying objects
311-- @'Schema'@ is used for request and response bodies and allows specifying objects
249-- with properties in addition to what @'ParamSchema'@ provides.
312-- with properties in addition to what @'ParamSchema'@ provides.
@@ -274,13 +337,81 @@ import Data.Swagger.Internal
274-- >>> data Person = Person { name :: String, age :: Integer } deriving Generic
337-- >>> data Person = Person { name :: String, age :: Integer } deriving Generic
275-- >>> instance ToJSON Person
338-- >>> instance ToJSON Person
276-- >>> instance ToSchema Person
339-- >>> instance ToSchema Person
277−-- >>> BSL.putStrLn $ encode (Person "David" 28)
340+-- >>> BSL.putStrLn $ encodePretty (Person "David" 28)
341+-- {
342+-- "age": 28,
278−-- {"age":28,"name":"David"}
343+-- "name": "David"
344+-- }
279−-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Person)
345+-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Person)
280−-- {"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"type":"integer"}},"type":"object"}
346+-- {
347+-- "properties": {
348+-- "age": {
349+-- "type": "integer"
350+-- },
351+-- "name": {
352+-- "type": "string"
353+-- }
354+-- },
355+-- "required": [
356+-- "name",
357+-- "age"
358+-- ],
359+-- "type": "object"
360+-- }
281−--
361+--
282−-- TODO mention oneOf
362+-- This package implements OpenAPI 3.0 spec, which supports @oneOf@ in schemas, allowing any sum types
283−--
363+-- to be faithfully represented. All sum encodings supported by @aeson@ are supported here as well, with
364+-- an exception of 'Data.Aeson.TwoElemArray', since OpenAPI spec does not support heterogeneous arrays.
365+--
366+-- An example with 'Data.Aeson.TaggedObject' encoding:
367+--
368+-- >>> data Error = ErrorNoUser { userId :: Int } | ErrorAccessDenied { requiredPermission :: String } deriving Generic
369+-- >>> instance ToJSON Error
370+-- >>> instance ToSchema Error
371+-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Error)
372+-- {
373+-- "oneOf": [
374+-- {
375+-- "properties": {
376+-- "tag": {
377+-- "enum": [
378+-- "ErrorNoUser"
379+-- ],
380+-- "type": "string"
381+-- },
382+-- "userId": {
383+-- "maximum": 9223372036854775807,
384+-- "minimum": -9223372036854775808,
385+-- "type": "integer"
386+-- }
387+-- },
388+-- "required": [
389+-- "userId",
390+-- "tag"
391+-- ],
392+-- "type": "object"
393+-- },
394+-- {
395+-- "properties": {
396+-- "requiredPermission": {
397+-- "type": "string"
398+-- },
399+-- "tag": {
400+-- "enum": [
401+-- "ErrorAccessDenied"
402+-- ],
403+-- "type": "string"
404+-- }
405+-- },
406+-- "required": [
407+-- "requiredPermission",
408+-- "tag"
409+-- ],
410+-- "type": "object"
411+-- }
412+-- ],
413+-- "type": "object"
414+-- }
284
415
285-- $manipulation
416-- $manipulation
286-- Sometimes you have to work with an imported or generated @'Swagger'@.
417-- Sometimes you have to work with an imported or generated @'Swagger'@.
@@ -288,10 +419,10 @@ import Data.Swagger.Internal
288-- for a type-level servant API.
419-- for a type-level servant API.
289--
420--
290-- Lenses and prisms can be used to manipulate such specification to add additional information, tags, extra responses, etc.
421-- Lenses and prisms can be used to manipulate such specification to add additional information, tags, extra responses, etc.
291−-- To facilitate common needs, @"Data.Swagger.Operation"@ module provides useful helpers.
422+-- To facilitate common needs, @"Data.OpenApi.Operation"@ module provides useful helpers.
292
423
293-- $validation
424-- $validation
294-- While @'ToParamSchema'@ and @'ToSchema'@ provide means to easily obtain schemas for Haskell types,
425-- While @'ToParamSchema'@ and @'ToSchema'@ provide means to easily obtain schemas for Haskell types,
295-- there is no static mechanism to ensure those instances correspond to the @'ToHttpApiData'@ or @'ToJSON'@ instances.
426-- there is no static mechanism to ensure those instances correspond to the @'ToHttpApiData'@ or @'ToJSON'@ instances.
296--
427--
297−-- @"Data.Swagger.Schema.Validation"@ addresses @'ToJSON'@/@'ToSchema'@ validation.
428+-- @"Data.OpenApi.Schema.Validation"@ addresses @'ToJSON'@/@'ToSchema'@ validation.
src/Data/OpenApi/Aeson/Compat.hsnew file+76
@@ -0,0 +1,76 @@
1+{-# LANGUAGE CPP #-}
2+
3+module Data.OpenApi.Aeson.Compat where
4+
5+#if MIN_VERSION_aeson(2,0,0)
6+import Data.Aeson (Key)
7+import qualified Data.Aeson.Key as Key
8+import qualified Data.Aeson.KeyMap as KeyMap
9+#else
10+import qualified Data.HashMap.Strict as HM
11+#endif
12+import Data.Bifunctor (first)
13+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
14+import qualified Data.Text as T
15+
16+#if MIN_VERSION_aeson(2,0,0)
17+deleteKey :: Key -> KeyMap.KeyMap v -> KeyMap.KeyMap v
18+deleteKey = KeyMap.delete
19+
20+objectToList :: KeyMap.KeyMap v -> [(Key, v)]
21+objectToList = KeyMap.toList
22+
23+objectKeys :: KeyMap.KeyMap v -> [T.Text]
24+objectKeys = map Key.toText . KeyMap.keys
25+
26+stringToKey :: String -> Key
27+stringToKey = Key.fromString
28+
29+keyToString :: Key -> String
30+keyToString = Key.toString
31+
32+keyToText :: Key -> T.Text
33+keyToText = Key.toText
34+
35+toInsOrdHashMap :: KeyMap.KeyMap v -> InsOrdHashMap.InsOrdHashMap T.Text v
36+toInsOrdHashMap = InsOrdHashMap.fromList . fmap (first Key.toText) . KeyMap.toList
37+
38+fromInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap T.Text v -> KeyMap.KeyMap v
39+fromInsOrdHashMap = KeyMap.fromList . fmap (first Key.fromText) . InsOrdHashMap.toList
40+
41+lookupKey :: T.Text -> KeyMap.KeyMap v -> Maybe v
42+lookupKey = KeyMap.lookup . Key.fromText
43+
44+hasKey :: T.Text -> KeyMap.KeyMap a -> Bool
45+hasKey = KeyMap.member . Key.fromText
46+#else
47+deleteKey :: T.Text -> HM.HashMap T.Text v -> HM.HashMap T.Text v
48+deleteKey = HM.delete
49+
50+objectToList :: HM.HashMap T.Text v -> [(T.Text, v)]
51+objectToList = HM.toList
52+
53+objectKeys :: HM.HashMap T.Text v -> [T.Text]
54+objectKeys = HM.keys
55+
56+stringToKey :: String -> T.Text
57+stringToKey = T.pack
58+
59+keyToString :: T.Text -> String
60+keyToString = T.unpack
61+
62+keyToText :: T.Text -> T.Text
63+keyToText = id
64+
65+toInsOrdHashMap :: HM.HashMap T.Text v -> InsOrdHashMap.InsOrdHashMap T.Text v
66+toInsOrdHashMap = InsOrdHashMap.fromHashMap
67+
68+fromInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap T.Text v -> HM.HashMap T.Text v
69+fromInsOrdHashMap = InsOrdHashMap.toHashMap
70+
71+lookupKey :: T.Text -> HM.HashMap T.Text v -> Maybe v
72+lookupKey = HM.lookup
73+
74+hasKey :: T.Text -> HM.HashMap T.Text a -> Bool
75+hasKey = HM.member
76+#endif
src/Data/Swagger/Declare.hs → src/Data/OpenApi/Declare.hsrenamed+2−2
@@ -4,12 +4,12 @@
4{-# LANGUAGE MultiParamTypeClasses #-}
4{-# LANGUAGE MultiParamTypeClasses #-}
5{-# LANGUAGE UndecidableInstances #-}
5{-# LANGUAGE UndecidableInstances #-}
6-- |
6-- |
7−-- Module: Data.Swagger.Declare
7+-- Module: Data.OpenApi.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.Swagger.Declare where
12+module Data.OpenApi.Declare where
13
13
14import Prelude ()
14import Prelude ()
15import Prelude.Compat
15import Prelude.Compat
src/Data/Swagger/Internal.hs → src/Data/OpenApi/Internal.hsrenamed+345−169
@@ -1,6 +1,6 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DeriveDataTypeable #-}
3{-# LANGUAGE DeriveDataTypeable #-}
3−{-# LANGUAGE DeriveFunctor #-}
4{-# LANGUAGE DeriveGeneric #-}
4{-# LANGUAGE DeriveGeneric #-}
5{-# LANGUAGE DeriveTraversable #-}
5{-# LANGUAGE DeriveTraversable #-}
6{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleContexts #-}
@@ -14,87 +14,91 @@
14{-# LANGUAGE TemplateHaskell #-}
14{-# LANGUAGE TemplateHaskell #-}
15{-# LANGUAGE TypeFamilies #-}
15{-# LANGUAGE TypeFamilies #-}
16{-# LANGUAGE UndecidableInstances #-}
16{-# LANGUAGE UndecidableInstances #-}
17−module Data.Swagger.Internal where
17+module Data.OpenApi.Internal where
18
18
19import Prelude ()
19import Prelude ()
20import Prelude.Compat
20import Prelude.Compat
21
21
22−import Control.Lens ((&), (.~), (?~))
23import Control.Applicative
22import 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
25−import qualified Data.Aeson.Types as JSON
28+import qualified Data.Aeson.Types as JSON
26−import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)
29+import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable,
30+ constrIndex, mkConstr, mkDataType)
27−import Data.Hashable (Hashable)
31+import Data.Hashable (Hashable (..))
28−import qualified Data.HashMap.Strict as HashMap
32+import qualified Data.HashMap.Strict as HashMap
29−import Data.HashSet.InsOrd (InsOrdHashSet)
33+import Data.HashSet.InsOrd (InsOrdHashSet)
30−import Data.Map (Map)
34+import Data.Map (Map)
31−import qualified Data.Map as Map
35+import qualified Data.Map as Map
32−import Data.Monoid (Monoid (..))
36+import Data.Monoid (Monoid (..))
37+import Data.Scientific (Scientific)
33−import Data.Semigroup.Compat (Semigroup (..))
38+import Data.Semigroup.Compat (Semigroup (..))
34−import Data.Scientific (Scientific)
35−import Data.String (IsString(..))
39+import Data.String (IsString (..))
36−import Data.Text (Text)
40+import Data.Text (Text)
37−import qualified Data.Text as Text
41+import qualified Data.Text as Text
42+import Data.Text.Encoding (encodeUtf8)
38−import GHC.Generics (Generic)
43+import GHC.Generics (Generic)
44+import Network.HTTP.Media (MediaType, mainType, parameters, parseAccept, subType, (//),
45+ (/:))
39−import Network.Socket (HostName, PortNumber)
46+import Network.Socket (HostName, PortNumber)
40−import Network.HTTP.Media (MediaType)
41−import Text.Read (readMaybe)
47+import Text.Read (readMaybe)
42
48
43import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
49import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
44import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
50import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
45
51
52+import Data.OpenApi.Aeson.Compat (deleteKey)
53+import Data.OpenApi.Internal.AesonUtils (AesonDefaultValue (..), HasSwaggerAesonOptions (..),
54+ mkSwaggerAesonOptions, saoAdditionalPairs, saoSubObject,
55+ sopSwaggerGenericParseJSON, sopSwaggerGenericToEncoding,
56+ sopSwaggerGenericToJSON, sopSwaggerGenericToJSONWithOpts)
57+import Data.OpenApi.Internal.Utils
46import Generics.SOP.TH (deriveGeneric)
58import 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)
57
59
58-- $setup
60-- $setup
59-- >>> :seti -XDataKinds
61-- >>> :seti -XDataKinds
60-- >>> import Data.Aeson
62-- >>> import Data.Aeson
63+-- >>> import Data.ByteString.Lazy.Char8 as BSL
64+-- >>> import Data.OpenApi.Internal.Utils
61
65
62-- | A list of definitions that can be used in references.
66-- | A list of definitions that can be used in references.
63type Definitions = InsOrdHashMap Text
67type Definitions = InsOrdHashMap Text
64
68
65-- | This is the root document object for the API specification.
69-- | This is the root document object for the API specification.
66−data Swagger = Swagger
70+data OpenApi = OpenApi
67 { -- | Provides metadata about the API.
71 { -- | Provides metadata about the API.
68 -- The metadata can be used by the clients if needed.
72 -- The metadata can be used by the clients if needed.
69− _swaggerInfo :: Info
73+ _openApiInfo :: Info
70
74
71 -- | An array of Server Objects, which provide connectivity information
75 -- | An array of Server Objects, which provide connectivity information
72 -- to a target server. If the servers property is not provided, or is an empty array,
76 -- to a target server. If the servers property is not provided, or is an empty array,
73 -- the default value would be a 'Server' object with a url value of @/@.
77 -- the default value would be a 'Server' object with a url value of @/@.
74− , _swaggerServers :: [Server]
78+ , _openApiServers :: [Server]
75
79
76 -- | The available paths and operations for the API.
80 -- | The available paths and operations for the API.
77− , _swaggerPaths :: InsOrdHashMap FilePath PathItem
81+ , _openApiPaths :: InsOrdHashMap FilePath PathItem
78
82
79 -- | An element to hold various schemas for the specification.
83 -- | An element to hold various schemas for the specification.
80− , _swaggerComponents :: Components
84+ , _openApiComponents :: Components
81
85
82 -- | A declaration of which security mechanisms can be used across the API.
86 -- | A declaration of which security mechanisms can be used across the API.
83 -- The list of values includes alternative security requirement objects that can be used.
87 -- The list of values includes alternative security requirement objects that can be used.
84 -- Only one of the security requirement objects need to be satisfied to authorize a request.
88 -- Only one of the security requirement objects need to be satisfied to authorize a request.
85 -- Individual operations can override this definition.
89 -- Individual operations can override this definition.
86 -- To make security optional, an empty security requirement can be included in the array.
90 -- To make security optional, an empty security requirement can be included in the array.
87− , _swaggerSecurity :: [SecurityRequirement]
91+ , _openApiSecurity :: [SecurityRequirement]
88
92
89 -- | A list of tags used by the specification with additional metadata.
93 -- | A list of tags used by the specification with additional metadata.
90 -- The order of the tags can be used to reflect on their order by the parsing tools.
94 -- The order of the tags can be used to reflect on their order by the parsing tools.
91 -- Not all tags that are used by the 'Operation' Object must be declared.
95 -- Not all tags that are used by the 'Operation' Object must be declared.
92 -- The tags that are not declared MAY be organized randomly or based on the tools' logic.
96 -- The tags that are not declared MAY be organized randomly or based on the tools' logic.
93 -- Each tag name in the list MUST be unique.
97 -- Each tag name in the list MUST be unique.
94− , _swaggerTags :: InsOrdHashSet Tag
98+ , _openApiTags :: InsOrdHashSet Tag
95
99
96 -- | Additional external documentation.
100 -- | Additional external documentation.
97− , _swaggerExternalDocs :: Maybe ExternalDocs
101+ , _openApiExternalDocs :: Maybe ExternalDocs
98 } deriving (Eq, Show, Generic, Data, Typeable)
102 } deriving (Eq, Show, Generic, Data, Typeable)
99
103
100-- | The object provides metadata about the API.
104-- | The object provides metadata about the API.
@@ -191,10 +195,10 @@ data Components = Components
191 , _componentsParameters :: Definitions Param
195 , _componentsParameters :: Definitions Param
192 , _componentsExamples :: Definitions Example
196 , _componentsExamples :: Definitions Example
193 , _componentsRequestBodies :: Definitions RequestBody
197 , _componentsRequestBodies :: Definitions RequestBody
194− , _componentsHeader :: Definitions Header
198+ , _componentsHeaders :: Definitions Header
195− , _componentsSecuritySchemes :: Definitions SecurityScheme
199+ , _componentsSecuritySchemes :: SecurityDefinitions
196−-- , _componentsLinks
200+ , _componentsLinks :: Definitions Link
197−-- , _componentsCallbacks
201+ , _componentsCallbacks :: Definitions Callback
198 } deriving (Eq, Show, Generic, Data, Typeable)
202 } deriving (Eq, Show, Generic, Data, Typeable)
199
203
200-- | Describes the operations available on a single path.
204-- | Describes the operations available on a single path.
@@ -284,7 +288,11 @@ data Operation = Operation
284 -- | The list of possible responses as they are returned from executing this operation.
288 -- | The list of possible responses as they are returned from executing this operation.
285 , _operationResponses :: Responses
289 , _operationResponses :: Responses
286
290
287− -- TODO callbacks
291+ -- | A map of possible out-of band callbacks related to the parent operation.
292+ -- The key is a unique identifier for the 'Callback' Object.
293+ -- Each value in the map is a 'Callback' Object that describes a request
294+ -- that may be initiated by the API provider and the expected responses.
295+ , _operationCallbacks :: InsOrdHashMap Text (Referenced Callback)
288
296
289 -- | Declares this operation to be deprecated.
297 -- | Declares this operation to be deprecated.
290 -- Usage of the declared operation should be refrained.
298 -- Usage of the declared operation should be refrained.
@@ -304,6 +312,22 @@ data Operation = Operation
304 , _operationServers :: [Server]
312 , _operationServers :: [Server]
305 } deriving (Eq, Show, Generic, Data, Typeable)
313 } deriving (Eq, Show, Generic, Data, Typeable)
306
314
315+-- This instance should be in @http-media@.
316+instance Data MediaType where
317+ gunfold k z c = case constrIndex c of
318+ 1 -> k (k (k (z (\main sub params -> foldl (/:) (main // sub) (Map.toList params)))))
319+ _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MediaType."
320+
321+ toConstr _ = mediaTypeConstr
322+
323+ dataTypeOf _ = mediaTypeData
324+
325+mediaTypeConstr = mkConstr mediaTypeData "MediaType" [] Prefix
326+mediaTypeData = mkDataType "MediaType" [mediaTypeConstr]
327+
328+instance Hashable MediaType where
329+ hashWithSalt salt mt = salt `hashWithSalt` show mt
330+
307-- | Describes a single request body.
331-- | Describes a single request body.
308data RequestBody = RequestBody
332data RequestBody = RequestBody
309 { -- | A brief description of the request body. This could contain examples of use.
333 { -- | A brief description of the request body. This could contain examples of use.
@@ -313,9 +337,11 @@ data RequestBody = RequestBody
313 -- | The content of the request body.
337 -- | The content of the request body.
314 -- The key is a media type or media type range and the value describes it.
338 -- The key is a media type or media type range and the value describes it.
315 -- For requests that match multiple keys, only the most specific key is applicable.
339 -- For requests that match multiple keys, only the most specific key is applicable.
316− -- e.g. @text/plain@ overrides @text/*@
340+ -- e.g. @text/plain@ overrides @text/\*@
317− , _requestBodyContent :: InsOrdHashMap {-MediaType-} Text MediaTypeObject -- FIXME Data MediaType
341+ , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject
318
342
343+ -- | Determines if the request body is required in the request.
344+ -- Defaults to 'False'.
319 , _requestBodyRequired :: Maybe Bool
345 , _requestBodyRequired :: Maybe Bool
320 } deriving (Eq, Show, Generic, Data, Typeable)
346 } deriving (Eq, Show, Generic, Data, Typeable)
321
347
@@ -368,8 +394,8 @@ data Encoding = Encoding
368 -- for other primitive types – @text/plain@; for object - @application/json@;
394 -- for other primitive types – @text/plain@; for object - @application/json@;
369 -- for array – the default is defined based on the inner type.
395 -- for array – the default is defined based on the inner type.
370 -- The value can be a specific media type (e.g. @application/json@),
396 -- The value can be a specific media type (e.g. @application/json@),
371− -- a wildcard media type (e.g. @image/*@), or a comma-separated list of the two types.
397+ -- a wildcard media type (e.g. @image/\*@), or a comma-separated list of the two types.
372− _encodingContentType :: Maybe Text
398+ _encodingContentType :: Maybe MediaType
373
399
374 -- | A map allowing additional information to be provided as headers,
400 -- | A map allowing additional information to be provided as headers,
375 -- for example @Content-Disposition@. @Content-Type@ is described separately
401 -- for example @Content-Disposition@. @Content-Type@ is described separately
@@ -408,18 +434,15 @@ mimeListConstr :: Constr
408mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
434mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix
409
435
410mimeListDataType :: DataType
436mimeListDataType :: DataType
411−mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]
437+mimeListDataType = mkDataType "Data.OpenApi.MimeList" [mimeListConstr]
412
438
413instance Data MimeList where
439instance Data MimeList where
414 gunfold k z c = case constrIndex c of
440 gunfold k z c = case constrIndex c of
415− 1 -> k (z (\xs -> MimeList (map fromString xs)))
441+ 1 -> k (z (MimeList . map fromString))
416 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
442 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."
417 toConstr (MimeList _) = mimeListConstr
443 toConstr (MimeList _) = mimeListConstr
418 dataTypeOf _ = mimeListDataType
444 dataTypeOf _ = mimeListDataType
419
445
420−-- TODO style
421−-- TODO example
422−
423-- | Describes a single operation parameter.
446-- | Describes a single operation parameter.
424-- A unique parameter is defined by a combination of a name and location.
447-- A unique parameter is defined by a combination of a name and location.
425data Param = Param
448data Param = Param
@@ -429,7 +452,7 @@ data Param = Param
429
452
430 -- | A brief description of the parameter.
453 -- | A brief description of the parameter.
431 -- This could contain examples of use.
454 -- This could contain examples of use.
432− -- GFM syntax can be used for rich text representation.
455+ -- CommonMark syntax MAY be used for rich text representation.
433 , _paramDescription :: Maybe Text
456 , _paramDescription :: Maybe Text
434
457
435 -- | Determines whether this parameter is mandatory.
458 -- | Determines whether this parameter is mandatory.
@@ -449,6 +472,13 @@ data Param = Param
449 -- a parameter with an empty value. Default value is @false@.
472 -- a parameter with an empty value. Default value is @false@.
450 , _paramAllowEmptyValue :: Maybe Bool
473 , _paramAllowEmptyValue :: Maybe Bool
451
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+
452 -- | Parameter schema.
482 -- | Parameter schema.
453 , _paramSchema :: Maybe (Referenced Schema)
483 , _paramSchema :: Maybe (Referenced Schema)
454
484
@@ -479,6 +509,10 @@ data Param = Param
479 -- Furthermore, if referencing a schema that contains an example,
509 -- Furthermore, if referencing a schema that contains an example,
480 -- the examples value SHALL override the example provided by the schema.
510 -- the examples value SHALL override the example provided by the schema.
481 , _paramExamples :: InsOrdHashMap Text (Referenced Example)
511 , _paramExamples :: InsOrdHashMap Text (Referenced Example)
512+
513+ -- TODO
514+ -- _paramContent :: InsOrdHashMap MediaType MediaTypeObject
515+ -- should be singleton. mutually exclusive with _paramSchema.
482 } deriving (Eq, Show, Generic, Data, Typeable)
516 } deriving (Eq, Show, Generic, Data, Typeable)
483
517
484data Example = Example
518data Example = Example
@@ -503,27 +537,63 @@ data Example = Example
503 , _exampleExternalValue :: Maybe URL
537 , _exampleExternalValue :: Maybe URL
504 } deriving (Eq, Show, Generic, Typeable, Data)
538 } deriving (Eq, Show, Generic, Typeable, Data)
505
539
540+data ExpressionOrValue
541+ = Expression Text
542+ | Value Value
543+ deriving (Eq, Show, Generic, Typeable, Data)
544+
545+-- | The Link object represents a possible design-time link for a response.
546+-- The presence of a link does not guarantee the caller's ability to successfully invoke it,
547+-- rather it provides a known relationship and traversal mechanism between responses and other operations.
548+data Link = Link
549+ { -- | A relative or absolute URI reference to an OAS operation.
550+ -- This field is mutually exclusive of the '_linkOperationId' field,
551+ -- and MUST point to an 'Operation' Object. Relative '_linkOperationRef'
552+ -- values MAY be used to locate an existing 'Operation' Object in the OpenAPI definition.
553+ _linkOperationRef :: Maybe Text
554+
555+ -- | The name of an /existing/, resolvable OAS operation, as defined with a unique
556+ -- '_operationOperationId'. This field is mutually exclusive of the '_linkOperationRef' field.
557+ , _linkOperationId :: Maybe Text
558+
559+ -- | A map representing parameters to pass to an operation as specified with '_linkOperationId'
560+ -- or identified via '_linkOperationRef'. The key is the parameter name to be used, whereas
561+ -- the value can be a constant or an expression to be evaluated and passed to the linked operation.
562+ -- The parameter name can be qualified using the parameter location @[{in}.]{name}@
563+ -- for operations that use the same parameter name in different locations (e.g. path.id).
564+ , _linkParameters :: InsOrdHashMap Text ExpressionOrValue
565+
566+ -- | A literal value or @{expression}@ to use as a request body when calling the target operation.
567+ , _linkRequestBody :: Maybe ExpressionOrValue
568+
569+ -- | A description of the link.
570+ , _linkDescription :: Maybe Text
571+
572+ -- | A server object to be used by the target operation.
573+ , _linkServer :: Maybe Server
574+ } deriving (Eq, Show, Generic, Typeable, Data)
575+
506−-- | Items for @'SwaggerArray'@ schemas.
576+-- | Items for @'OpenApiArray'@ schemas.
507--
577--
508-- __Warning__: OpenAPI 3.0 does not support tuple arrays. However, OpenAPI 3.1 will, as
578-- __Warning__: OpenAPI 3.0 does not support tuple arrays. However, OpenAPI 3.1 will, as
509-- it will incorporate Json Schema mostly verbatim.
579-- it will incorporate Json Schema mostly verbatim.
510--
580--
511−-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.
581+-- @'OpenApiItemsObject'@ should be used to specify homogenous array @'Schema'@s.
512--
582--
513−-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.
583+-- @'OpenApiItemsArray'@ should be used to specify tuple @'Schema'@s.
514−data SwaggerItems where
584+data OpenApiItems where
515− SwaggerItemsObject :: Referenced Schema -> SwaggerItems
585+ OpenApiItemsObject :: Referenced Schema -> OpenApiItems
516− SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems
586+ OpenApiItemsArray :: [Referenced Schema] -> OpenApiItems
517 deriving (Eq, Show, Typeable, Data)
587 deriving (Eq, Show, Typeable, Data)
518
588
519−data SwaggerType where
589+data OpenApiType where
520− SwaggerString :: SwaggerType
590+ OpenApiString :: OpenApiType
521− SwaggerNumber :: SwaggerType
591+ OpenApiNumber :: OpenApiType
522− SwaggerInteger :: SwaggerType
592+ OpenApiInteger :: OpenApiType
523− SwaggerBoolean :: SwaggerType
593+ OpenApiBoolean :: OpenApiType
524− SwaggerArray :: SwaggerType
594+ OpenApiArray :: OpenApiType
525− SwaggerNull :: SwaggerType
595+ OpenApiNull :: OpenApiType
526− SwaggerObject :: SwaggerType
596+ OpenApiObject :: OpenApiType
527 deriving (Eq, Show, Typeable, Generic, Data)
597 deriving (Eq, Show, Typeable, Generic, Data)
528
598
529data ParamLocation
599data ParamLocation
@@ -568,9 +638,33 @@ data Schema = Schema
568 , _schemaMaxProperties :: Maybe Integer
638 , _schemaMaxProperties :: Maybe Integer
569 , _schemaMinProperties :: Maybe Integer
639 , _schemaMinProperties :: Maybe Integer
570
640
571− , _schemaParamSchema :: ParamSchema
641+ , -- | Declares the value of the parameter that the server will use if none is provided,
642+ -- for example a @"count"@ to control the number of results per page might default to @100@
643+ -- if not supplied by the client in the request.
644+ -- (Note: "default" has no meaning for required parameters.)
645+ -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
646+ _schemaDefault :: Maybe Value
647+
648+ , _schemaType :: Maybe OpenApiType
649+ , _schemaFormat :: Maybe Format
650+ , _schemaItems :: Maybe OpenApiItems
651+ , _schemaMaximum :: Maybe Scientific
652+ , _schemaExclusiveMaximum :: Maybe Bool
653+ , _schemaMinimum :: Maybe Scientific
654+ , _schemaExclusiveMinimum :: Maybe Bool
655+ , _schemaMaxLength :: Maybe Integer
656+ , _schemaMinLength :: Maybe Integer
657+ , _schemaPattern :: Maybe Pattern
658+ , _schemaMaxItems :: Maybe Integer
659+ , _schemaMinItems :: Maybe Integer
660+ , _schemaUniqueItems :: Maybe Bool
661+ , _schemaEnum :: Maybe [Value]
662+ , _schemaMultipleOf :: Maybe Scientific
572 } deriving (Eq, Show, Generic, Data, Typeable)
663 } deriving (Eq, Show, Generic, Data, Typeable)
573
664
665+-- | Regex pattern for @string@ type.
666+type Pattern = Text
667+
574data Discriminator = Discriminator
668data Discriminator = Discriminator
575 { -- | The name of the property in the payload that will hold the discriminator value.
669 { -- | The name of the property in the payload that will hold the discriminator value.
576 _discriminatorPropertyName :: Text
670 _discriminatorPropertyName :: Text
@@ -586,37 +680,9 @@ data NamedSchema = NamedSchema
586 , _namedSchemaSchema :: Schema
680 , _namedSchemaSchema :: Schema
587 } deriving (Eq, Show, Generic, Data, Typeable)
681 } deriving (Eq, Show, Generic, Data, Typeable)
588
682
589−-- | Regex pattern for @string@ type.
590−type Pattern = Text
591−
592−data ParamSchema = ParamSchema
593− { -- | Declares the value of the parameter that the server will use if none is provided,
594− -- for example a @"count"@ to control the number of results per page might default to @100@
595− -- if not supplied by the client in the request.
596− -- (Note: "default" has no meaning for required parameters.)
597− -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
598− _paramSchemaDefault :: Maybe Value
599−
600− , _paramSchemaType :: Maybe SwaggerType
601− , _paramSchemaFormat :: Maybe Format
602− , _paramSchemaItems :: Maybe SwaggerItems
603− , _paramSchemaMaximum :: Maybe Scientific
604− , _paramSchemaExclusiveMaximum :: Maybe Bool
605− , _paramSchemaMinimum :: Maybe Scientific
606− , _paramSchemaExclusiveMinimum :: Maybe Bool
607− , _paramSchemaMaxLength :: Maybe Integer
608− , _paramSchemaMinLength :: Maybe Integer
609− , _paramSchemaPattern :: Maybe Pattern
610− , _paramSchemaMaxItems :: Maybe Integer
611− , _paramSchemaMinItems :: Maybe Integer
612− , _paramSchemaUniqueItems :: Maybe Bool
613− , _paramSchemaEnum :: Maybe [Value]
614− , _paramSchemaMultipleOf :: Maybe Scientific
615− } deriving (Eq, Show, Generic, Typeable, Data)
616−
617data Xml = Xml
683data Xml = Xml
618 { -- | Replaces the name of the element/attribute used for the described schema property.
684 { -- | Replaces the name of the element/attribute used for the described schema property.
619− -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.
685+ -- When defined within the @'OpenApiItems'@ (items), it will affect the name of the individual XML elements within the list.
620 -- When defined alongside type being array (outside the items),
686 -- When defined alongside type being array (outside the items),
621 -- it will affect the wrapping element and only if wrapped is true.
687 -- it will affect the wrapping element and only if wrapped is true.
622 -- If wrapped is false, it will be ignored.
688 -- If wrapped is false, it will be ignored.
@@ -668,25 +734,44 @@ data Response = Response
668 -- | A map containing descriptions of potential response payloads.
734 -- | A map containing descriptions of potential response payloads.
669 -- The key is a media type or media type range and the value describes it.
735 -- The key is a media type or media type range and the value describes it.
670 -- For responses that match multiple keys, only the most specific key is applicable.
736 -- For responses that match multiple keys, only the most specific key is applicable.
671− -- e.g. @text/plain@ overrides @text/*@.
737+ -- e.g. @text/plain@ overrides @text/\*@.
672− , _responseContent :: InsOrdHashMap Text MediaTypeObject
738+ , _responseContent :: InsOrdHashMap MediaType MediaTypeObject
673
739
674 -- | Maps a header name to its definition.
740 -- | Maps a header name to its definition.
675 , _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)
741 , _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)
676
742
677− -- TODO links
743+ -- | A map of operations links that can be followed from the response.
744+ -- The key of the map is a short name for the link, following the naming
745+ -- constraints of the names for 'Component' Objects.
746+ , _responseLinks :: InsOrdHashMap Text (Referenced Link)
678 } deriving (Eq, Show, Generic, Data, Typeable)
747 } deriving (Eq, Show, Generic, Data, Typeable)
679
748
680instance IsString Response where
749instance IsString Response where
681− fromString s = Response (fromString s) mempty mempty
750+ fromString s = Response (fromString s) mempty mempty mempty
751+
752+-- | A map of possible out-of band callbacks related to the parent operation.
753+-- Each value in the map is a 'PathItem' Object that describes a set of requests that
754+-- may be initiated by the API provider and the expected responses.
755+-- The key value used to identify the path item object is an expression, evaluated at runtime,
756+-- that identifies a URL to use for the callback operation.
757+newtype Callback = Callback (InsOrdHashMap Text PathItem)
758+ deriving (Eq, Show, Generic, Data, Typeable)
682
759
683type HeaderName = Text
760type HeaderName = Text
684
761
685−
762+-- | Header fields have the same meaning as for 'Param'.
686−-- TODO this is mostly a copy of 'Param'.
763+--
764+-- Style is always treated as 'StyleSimple', as it is the only value allowed for headers.
687data Header = Header
765data Header = Header
688 { -- | A short description of the header.
766 { -- | A short description of the header.
689− _headerDescription :: Maybe Text
767+ _headerDescription :: Maybe HeaderName
768+
769+ , _headerRequired :: Maybe Bool
770+ , _headerDeprecated :: Maybe Bool
771+ , _headerAllowEmptyValue :: Maybe Bool
772+ , _headerExplode :: Maybe Bool
773+ , _headerExample :: Maybe Value
774+ , _headerExamples :: InsOrdHashMap Text (Referenced Example)
690
775
691 , _headerSchema :: Maybe (Referenced Schema)
776 , _headerSchema :: Maybe (Referenced Schema)
692 } deriving (Eq, Show, Generic, Data, Typeable)
777 } deriving (Eq, Show, Generic, Data, Typeable)
@@ -712,17 +797,17 @@ type AuthorizationURL = Text
712-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
797-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.
713type TokenURL = Text
798type TokenURL = Text
714
799
715−data OAuth2ImplicitFlow = OAuth2ImplicitFlow
800+newtype OAuth2ImplicitFlow
716− { _oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL
801+ = OAuth2ImplicitFlow {_oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL}
717− } deriving (Eq, Show, Generic, Data, Typeable)
802+ deriving (Eq, Show, Generic, Data, Typeable)
718
803
719−data OAuth2PasswordFlow = OAuth2PasswordFlow
804+newtype OAuth2PasswordFlow
720− { _oAuth2PasswordFlowTokenUrl :: TokenURL
805+ = OAuth2PasswordFlow {_oAuth2PasswordFlowTokenUrl :: TokenURL}
721− } deriving (Eq, Show, Generic, Data, Typeable)
806+ deriving (Eq, Show, Generic, Data, Typeable)
722
807
723−data OAuth2ClientCredentialsFlow = OAuth2ClientCredentialsFlow
808+newtype OAuth2ClientCredentialsFlow
724− { _oAuth2ClientCredentialsFlowTokenUrl :: TokenURL
809+ = OAuth2ClientCredentialsFlow {_oAuth2ClientCredentialsFlowTokenUrl :: TokenURL}
725− } deriving (Eq, Show, Generic, Data, Typeable)
810+ deriving (Eq, Show, Generic, Data, Typeable)
726
811
727data OAuth2AuthorizationCodeFlow = OAuth2AuthorizationCodeFlow
812data OAuth2AuthorizationCodeFlow = OAuth2AuthorizationCodeFlow
728 { _oAuth2AuthorizationCodeFlowAuthorizationUrl :: AuthorizationURL
813 { _oAuth2AuthorizationCodeFlowAuthorizationUrl :: AuthorizationURL
@@ -755,8 +840,50 @@ data OAuth2Flows = OAuth2Flows
755 , _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
840 , _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
756 } deriving (Eq, Show, Generic, Data, Typeable)
841 } deriving (Eq, Show, Generic, Data, Typeable)
757
842
843+type BearerFormat = Text
844+
845+data HttpSchemeType
846+ = HttpSchemeBearer (Maybe BearerFormat)
847+ | HttpSchemeBasic
848+ | HttpSchemeCustom Text
849+ deriving (Eq, Show, Generic, Data, Typeable)
850+
851+-- |
852+--
853+-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp (HttpSchemeBearer Nothing))
854+-- {
855+-- "scheme": "bearer",
856+-- "type": "http"
857+-- }
858+--
859+-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp (HttpSchemeBearer (Just "jwt")))
860+-- {
861+-- "bearerFormat": "jwt",
862+-- "scheme": "bearer",
863+-- "type": "http"
864+-- }
865+--
866+-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp HttpSchemeBasic)
867+-- {
868+-- "scheme": "basic",
869+-- "type": "http"
870+-- }
871+--
872+-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp (HttpSchemeCustom "CANARY"))
873+-- {
874+-- "scheme": "CANARY",
875+-- "type": "http"
876+-- }
877+--
878+-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeApiKey (ApiKeyParams "id" ApiKeyCookie))
879+-- {
880+-- "in": "cookie",
881+-- "name": "id",
882+-- "type": "apiKey"
883+-- }
884+--
758data SecuritySchemeType
885data SecuritySchemeType
759− = SecuritySchemeHttp
886+ = SecuritySchemeHttp HttpSchemeType
760 | SecuritySchemeApiKey ApiKeyParams
887 | SecuritySchemeApiKey ApiKeyParams
761 | SecuritySchemeOAuth2 OAuth2Flows
888 | SecuritySchemeOAuth2 OAuth2Flows
762 | SecuritySchemeOpenIdConnect URL
889 | SecuritySchemeOpenIdConnect URL
@@ -791,7 +918,7 @@ data Tag = Tag
791 _tagName :: TagName
918 _tagName :: TagName
792
919
793 -- | A short description for the tag.
920 -- | A short description for the tag.
794− -- GFM syntax can be used for rich text representation.
921+ -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
795 , _tagDescription :: Maybe Text
922 , _tagDescription :: Maybe Text
796
923
797 -- | Additional external documentation for this tag.
924 -- | Additional external documentation for this tag.
@@ -806,7 +933,7 @@ instance IsString Tag where
806-- | Allows referencing an external resource for extended documentation.
933-- | Allows referencing an external resource for extended documentation.
807data ExternalDocs = ExternalDocs
934data ExternalDocs = ExternalDocs
808 { -- | A short description of the target documentation.
935 { -- | A short description of the target documentation.
809− -- GFM syntax can be used for rich text representation.
936+ -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.
810 _externalDocsDescription :: Maybe Text
937 _externalDocsDescription :: Maybe Text
811
938
812 -- | The URL for the target documentation.
939 -- | The URL for the target documentation.
@@ -853,18 +980,18 @@ deriveGeneric ''MediaTypeObject
853deriveGeneric ''Responses
980deriveGeneric ''Responses
854deriveGeneric ''SecurityScheme
981deriveGeneric ''SecurityScheme
855deriveGeneric ''Schema
982deriveGeneric ''Schema
856−deriveGeneric ''ParamSchema
983+deriveGeneric ''OpenApi
857−deriveGeneric ''Swagger
858deriveGeneric ''Example
984deriveGeneric ''Example
859deriveGeneric ''Encoding
985deriveGeneric ''Encoding
986+deriveGeneric ''Link
860
987
861-- =======================================================================
988-- =======================================================================
862-- Monoid instances
989-- Monoid instances
863-- =======================================================================
990-- =======================================================================
864
991
865−instance Semigroup Swagger where
992+instance Semigroup OpenApi where
866 (<>) = genericMappend
993 (<>) = genericMappend
867−instance Monoid Swagger where
994+instance Monoid OpenApi where
868 mempty = genericMempty
995 mempty = genericMempty
869 mappend = (<>)
996 mappend = (<>)
870
997
@@ -898,12 +1025,6 @@ instance Monoid Schema where
898 mempty = genericMempty
1025 mempty = genericMempty
899 mappend = (<>)
1026 mappend = (<>)
900
1027
901−instance Semigroup ParamSchema where
902− (<>) = genericMappend
903−instance Monoid ParamSchema where
904− mempty = genericMempty
905− mappend = (<>)
906−
907instance Semigroup Param where
1028instance Semigroup Param where
908 (<>) = genericMappend
1029 (<>) = genericMappend
909instance Monoid Param where
1030instance Monoid Param where
@@ -998,19 +1119,19 @@ instance SwaggerMonoid Info
998instance SwaggerMonoid Components
1119instance SwaggerMonoid Components
999instance SwaggerMonoid PathItem
1120instance SwaggerMonoid PathItem
1000instance SwaggerMonoid Schema
1121instance SwaggerMonoid Schema
1001−instance SwaggerMonoid ParamSchema
1002instance SwaggerMonoid Param
1122instance SwaggerMonoid Param
1003instance SwaggerMonoid Responses
1123instance SwaggerMonoid Responses
1004instance SwaggerMonoid Response
1124instance SwaggerMonoid Response
1005instance SwaggerMonoid ExternalDocs
1125instance SwaggerMonoid ExternalDocs
1006instance SwaggerMonoid Operation
1126instance SwaggerMonoid Operation
1007instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
1127instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
1128+instance SwaggerMonoid SecurityDefinitions
1008
1129
1009instance SwaggerMonoid MimeList
1130instance SwaggerMonoid MimeList
1010deriving instance SwaggerMonoid URL
1131deriving instance SwaggerMonoid URL
1011
1132
1012−instance SwaggerMonoid SwaggerType where
1133+instance SwaggerMonoid OpenApiType where
1013− swaggerMempty = SwaggerString
1134+ swaggerMempty = OpenApiString
1014 swaggerMappend _ y = y
1135 swaggerMappend _ y = y
1015
1136
1016instance SwaggerMonoid ParamLocation where
1137instance SwaggerMonoid ParamLocation where
@@ -1033,7 +1154,7 @@ instance Monoid a => SwaggerMonoid (Referenced a) where
1033instance ToJSON Style where
1154instance ToJSON Style where
1034 toJSON = genericToJSON (jsonPrefix "Style")
1155 toJSON = genericToJSON (jsonPrefix "Style")
1035
1156
1036−instance ToJSON SwaggerType where
1157+instance ToJSON OpenApiType where
1037 toJSON = genericToJSON (jsonPrefix "Swagger")
1158 toJSON = genericToJSON (jsonPrefix "Swagger")
1038
1159
1039instance ToJSON ParamLocation where
1160instance ToJSON ParamLocation where
@@ -1088,7 +1209,7 @@ instance ToJSON OAuth2AuthorizationCodeFlow where
1088instance FromJSON Style where
1209instance FromJSON Style where
1089 parseJSON = genericParseJSON (jsonPrefix "Style")
1210 parseJSON = genericParseJSON (jsonPrefix "Style")
1090
1211
1091−instance FromJSON SwaggerType where
1212+instance FromJSON OpenApiType where
1092 parseJSON = genericParseJSON (jsonPrefix "Swagger")
1213 parseJSON = genericParseJSON (jsonPrefix "Swagger")
1093
1214
1094instance FromJSON ParamLocation where
1215instance FromJSON ParamLocation where
@@ -1137,7 +1258,14 @@ instance FromJSON OAuth2AuthorizationCodeFlow where
1137-- Manual ToJSON instances
1258-- Manual ToJSON instances
1138-- =======================================================================
1259-- =======================================================================
1139
1260
1261+instance ToJSON MediaType where
1262+ toJSON = toJSON . show
1263+ toEncoding = toEncoding . show
1264+
1265+instance ToJSONKey MediaType where
1266+ toJSONKey = JSON.toJSONKeyText (Text.pack . show)
1267+
1140−instance (Eq p, ToJSON p, AesonDefaultValue p) =>ToJSON (OAuth2Flow p) where
1268+instance (Eq p, ToJSON p, AesonDefaultValue p) => ToJSON (OAuth2Flow p) where
1141 toJSON = sopSwaggerGenericToJSON
1269 toJSON = sopSwaggerGenericToJSON
1142 toEncoding = sopSwaggerGenericToEncoding
1270 toEncoding = sopSwaggerGenericToEncoding
1143
1271
@@ -1146,8 +1274,19 @@ instance ToJSON OAuth2Flows where
1146 toEncoding = sopSwaggerGenericToEncoding
1274 toEncoding = sopSwaggerGenericToEncoding
1147
1275
1148instance ToJSON SecuritySchemeType where
1276instance ToJSON SecuritySchemeType where
1149− toJSON SecuritySchemeHttp
1277+ toJSON (SecuritySchemeHttp ty) = case ty of
1278+ HttpSchemeBearer mFmt ->
1279+ object $ [ "type" .= ("http" :: Text)
1280+ , "scheme" .= ("bearer" :: Text)
1281+ ] <> maybe [] (\t -> ["bearerFormat" .= t]) mFmt
1282+ HttpSchemeBasic ->
1283+ object [ "type" .= ("http" :: Text)
1284+ , "scheme" .= ("basic" :: Text)
1285+ ]
1286+ HttpSchemeCustom t ->
1150− = object [ "type" .= ("http" :: Text) ]
1287+ object [ "type" .= ("http" :: Text)
1288+ , "scheme" .= t
1289+ ]
1151 toJSON (SecuritySchemeApiKey params)
1290 toJSON (SecuritySchemeApiKey params)
1152 = toJSON params
1291 = toJSON params
1153 <+> object [ "type" .= ("apiKey" :: Text) ]
1292 <+> object [ "type" .= ("apiKey" :: Text) ]
@@ -1160,9 +1299,9 @@ instance ToJSON SecuritySchemeType where
1160 , "openIdConnectUrl" .= url
1299 , "openIdConnectUrl" .= url
1161 ]
1300 ]
1162
1301
1163−instance ToJSON Swagger where
1302+instance ToJSON OpenApi where
1164 toJSON a = sopSwaggerGenericToJSON a &
1303 toJSON a = sopSwaggerGenericToJSON a &
1165− if InsOrdHashMap.null (_swaggerPaths a)
1304+ if InsOrdHashMap.null (_openApiPaths a)
1166 then (<+> object ["paths" .= object []])
1305 then (<+> object ["paths" .= object []])
1167 else id
1306 else id
1168 toEncoding = sopSwaggerGenericToEncoding
1307 toEncoding = sopSwaggerGenericToEncoding
@@ -1176,8 +1315,8 @@ instance ToJSON SecurityScheme where
1176 toEncoding = sopSwaggerGenericToEncoding
1315 toEncoding = sopSwaggerGenericToEncoding
1177
1316
1178instance ToJSON Schema where
1317instance ToJSON Schema where
1179− toJSON = sopSwaggerGenericToJSON
1318+ toJSON = sopSwaggerGenericToJSONWithOpts $
1180− toEncoding = sopSwaggerGenericToEncoding
1319+ mkSwaggerAesonOptions "schema" & saoSubObject ?~ "items"
1181
1320
1182instance ToJSON Header where
1321instance ToJSON Header where
1183 toJSON = sopSwaggerGenericToJSON
1322 toJSON = sopSwaggerGenericToJSON
@@ -1186,17 +1325,21 @@ instance ToJSON Header where
1186-- | As for nullary schema for 0-arity type constructors, see
1325-- | As for nullary schema for 0-arity type constructors, see
1187-- <https://github.com/GetShopTV/swagger2/issues/167>.
1326-- <https://github.com/GetShopTV/swagger2/issues/167>.
1188--
1327--
1189−-- >>> encode (SwaggerItemsArray [])
1328+-- >>> BSL.putStrLn $ encodePretty (OpenApiItemsArray [])
1329+-- {
1330+-- "example": [],
1331+-- "items": {},
1190−-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1332+-- "maxItems": 0
1333+-- }
1191--
1334--
1192−instance ToJSON SwaggerItems where
1335+instance ToJSON OpenApiItems where
1193− toJSON (SwaggerItemsObject x) = object [ "items" .= x ]
1336+ toJSON (OpenApiItemsObject x) = object [ "items" .= x ]
1194− toJSON (SwaggerItemsArray []) = object
1337+ toJSON (OpenApiItemsArray []) = object
1195 [ "items" .= object []
1338 [ "items" .= object []
1196 , "maxItems" .= (0 :: Int)
1339 , "maxItems" .= (0 :: Int)
1197 , "example" .= Array mempty
1340 , "example" .= Array mempty
1198 ]
1341 ]
1199− toJSON (SwaggerItemsArray x) = object [ "items" .= x ]
1342+ toJSON (OpenApiItemsArray x) = object [ "items" .= x ]
1200
1343
1201instance ToJSON Components where
1344instance ToJSON Components where
1202 toJSON = sopSwaggerGenericToJSON
1345 toJSON = sopSwaggerGenericToJSON
@@ -1241,6 +1384,10 @@ instance ToJSON Encoding where
1241 toJSON = sopSwaggerGenericToJSON
1384 toJSON = sopSwaggerGenericToJSON
1242 toEncoding = sopSwaggerGenericToEncoding
1385 toEncoding = sopSwaggerGenericToEncoding
1243
1386
1387+instance ToJSON Link where
1388+ toJSON = sopSwaggerGenericToJSON
1389+ toEncoding = sopSwaggerGenericToEncoding
1390+
1244instance ToJSON SecurityDefinitions where
1391instance ToJSON SecurityDefinitions where
1245 toJSON (SecurityDefinitions sd) = toJSON sd
1392 toJSON (SecurityDefinitions sd) = toJSON sd
1246
1393
@@ -1257,20 +1404,31 @@ instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/compone
1257instance ToJSON (Referenced RequestBody) where toJSON = referencedToJSON "#/components/requestBodies/"
1404instance ToJSON (Referenced RequestBody) where toJSON = referencedToJSON "#/components/requestBodies/"
1258instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/components/examples/"
1405instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/components/examples/"
1259instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"
1406instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"
1260−
1407+instance ToJSON (Referenced Link) where toJSON = referencedToJSON "#/components/links/"
1261−instance ToJSON ParamSchema where
1408+instance ToJSON (Referenced Callback) where toJSON = referencedToJSON "#/components/callbacks/"
1262− -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?
1263− toJSON = sopSwaggerGenericToJSONWithOpts $
1264− mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"
1265
1409
1266instance ToJSON AdditionalProperties where
1410instance ToJSON AdditionalProperties where
1267 toJSON (AdditionalPropertiesAllowed b) = toJSON b
1411 toJSON (AdditionalPropertiesAllowed b) = toJSON b
1268 toJSON (AdditionalPropertiesSchema s) = toJSON s
1412 toJSON (AdditionalPropertiesSchema s) = toJSON s
1269
1413
1414+instance ToJSON ExpressionOrValue where
1415+ toJSON (Expression expr) = toJSON expr
1416+ toJSON (Value val) = toJSON val
1417+
1418+instance ToJSON Callback where
1419+ toJSON (Callback ps) = toJSON ps
1420+
1270-- =======================================================================
1421-- =======================================================================
1271-- Manual FromJSON instances
1422-- Manual FromJSON instances
1272-- =======================================================================
1423-- =======================================================================
1273
1424
1425+instance FromJSON MediaType where
1426+ parseJSON = withText "MediaType" $ \str ->
1427+ maybe (fail $ "Invalid media type literal " <> Text.unpack str) pure $ parseAccept $ encodeUtf8 str
1428+
1429+instance FromJSONKey MediaType where
1430+ fromJSONKey = FromJSONKeyTextParser (parseJSON . String)
1431+
1274instance (Eq p, FromJSON p, AesonDefaultValue p) => FromJSON (OAuth2Flow p) where
1432instance (Eq p, FromJSON p, AesonDefaultValue p) => FromJSON (OAuth2Flow p) where
1275 parseJSON = sopSwaggerGenericParseJSON
1433 parseJSON = sopSwaggerGenericParseJSON
1276
1434
@@ -1281,14 +1439,19 @@ instance FromJSON SecuritySchemeType where
1281 parseJSON js@(Object o) = do
1439 parseJSON js@(Object o) = do
1282 (t :: Text) <- o .: "type"
1440 (t :: Text) <- o .: "type"
1283 case t of
1441 case t of
1442+ "http" -> do
1443+ scheme <- o .: "scheme"
1284− "http" -> pure SecuritySchemeHttp
1444+ SecuritySchemeHttp <$> case scheme of
1445+ "bearer" -> HttpSchemeBearer <$> (o .:! "bearerFormat")
1446+ "basic" -> pure HttpSchemeBasic
1447+ t -> pure $ HttpSchemeCustom t
1285 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1448 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1286 "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")
1449 "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")
1287 "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")
1450 "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")
1288 _ -> empty
1451 _ -> empty
1289 parseJSON _ = empty
1452 parseJSON _ = empty
1290
1453
1291−instance FromJSON Swagger where
1454+instance FromJSON OpenApi where
1292 parseJSON = sopSwaggerGenericParseJSON
1455 parseJSON = sopSwaggerGenericParseJSON
1293
1456
1294instance FromJSON Server where
1457instance FromJSON Server where
@@ -1300,27 +1463,28 @@ instance FromJSON SecurityScheme where
1300instance FromJSON Schema where
1463instance FromJSON Schema where
1301 parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1464 parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON
1302 where nullaryCleanup :: Schema -> Schema
1465 where nullaryCleanup :: Schema -> Schema
1303− nullaryCleanup s@Schema{_schemaParamSchema=ps} =
1466+ nullaryCleanup s =
1304− if _paramSchemaItems ps == Just (SwaggerItemsArray [])
1467+ if _schemaItems s == Just (OpenApiItemsArray [])
1305 then s { _schemaExample = Nothing
1468 then s { _schemaExample = Nothing
1306− , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }
1469+ , _schemaMaxItems = Nothing
1470+ }
1307 else s
1471 else s
1308
1472
1309instance FromJSON Header where
1473instance FromJSON Header where
1310 parseJSON = sopSwaggerGenericParseJSON
1474 parseJSON = sopSwaggerGenericParseJSON
1311
1475
1312−instance FromJSON SwaggerItems where
1476+instance FromJSON OpenApiItems where
1313 parseJSON js@(Object obj)
1477 parseJSON js@(Object obj)
1314− | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.
1478+ | null obj = pure $ OpenApiItemsArray [] -- Nullary schema.
1315− | otherwise = SwaggerItemsObject <$> parseJSON js
1479+ | otherwise = OpenApiItemsObject <$> parseJSON js
1316− parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js
1480+ parseJSON js@(Array _) = OpenApiItemsArray <$> parseJSON js
1317 parseJSON _ = empty
1481 parseJSON _ = empty
1318
1482
1319instance FromJSON Components where
1483instance FromJSON Components where
1320 parseJSON = sopSwaggerGenericParseJSON
1484 parseJSON = sopSwaggerGenericParseJSON
1321
1485
1322instance FromJSON MimeList where
1486instance FromJSON MimeList where
1323− parseJSON js = (MimeList . map fromString) <$> parseJSON js
1487+ parseJSON js = MimeList . map fromString <$> parseJSON js
1324
1488
1325instance FromJSON Param where
1489instance FromJSON Param where
1326 parseJSON = sopSwaggerGenericParseJSON
1490 parseJSON = sopSwaggerGenericParseJSON
@@ -1328,7 +1492,7 @@ instance FromJSON Param where
1328instance FromJSON Responses where
1492instance FromJSON Responses where
1329 parseJSON (Object o) = Responses
1493 parseJSON (Object o) = Responses
1330 <$> o .:? "default"
1494 <$> o .:? "default"
1331− <*> (parseJSON (Object (HashMap.delete "default" o)))
1495+ <*> parseJSON (Object (deleteKey "default" o))
1332 parseJSON _ = empty
1496 parseJSON _ = empty
1333
1497
1334instance FromJSON Example where
1498instance FromJSON Example where
@@ -1355,6 +1519,9 @@ instance FromJSON MediaTypeObject where
1355instance FromJSON Encoding where
1519instance FromJSON Encoding where
1356 parseJSON = sopSwaggerGenericParseJSON
1520 parseJSON = sopSwaggerGenericParseJSON
1357
1521
1522+instance FromJSON Link where
1523+ parseJSON = sopSwaggerGenericParseJSON
1524+
1358instance FromJSON Reference where
1525instance FromJSON Reference where
1359 parseJSON (Object o) = Reference <$> o .: "$ref"
1526 parseJSON (Object o) = Reference <$> o .: "$ref"
1360 parseJSON _ = empty
1527 parseJSON _ = empty
@@ -1378,17 +1545,24 @@ instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#
1378instance FromJSON (Referenced RequestBody) where parseJSON = referencedParseJSON "#/components/requestBodies/"
1545instance FromJSON (Referenced RequestBody) where parseJSON = referencedParseJSON "#/components/requestBodies/"
1379instance FromJSON (Referenced Example) where parseJSON = referencedParseJSON "#/components/examples/"
1546instance FromJSON (Referenced Example) where parseJSON = referencedParseJSON "#/components/examples/"
1380instance FromJSON (Referenced Header) where parseJSON = referencedParseJSON "#/components/headers/"
1547instance 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/"
1381
1550
1382instance FromJSON Xml where
1551instance FromJSON Xml where
1383 parseJSON = genericParseJSON (jsonPrefix "xml")
1552 parseJSON = genericParseJSON (jsonPrefix "xml")
1384
1553
1385−instance FromJSON ParamSchema where
1386− parseJSON = sopSwaggerGenericParseJSON
1387−
1388instance FromJSON AdditionalProperties where
1554instance FromJSON AdditionalProperties where
1389 parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1555 parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b
1390 parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1556 parseJSON js = AdditionalPropertiesSchema <$> parseJSON js
1391
1557
1558+-- | All strings are parsed as expressions
1559+instance FromJSON ExpressionOrValue where
1560+ parseJSON (String expr) = pure $ Expression expr
1561+ parseJSON v = pure $ Value v
1562+
1563+instance FromJSON Callback where
1564+ parseJSON = fmap Callback . parseJSON
1565+
1392instance HasSwaggerAesonOptions Server where
1566instance HasSwaggerAesonOptions Server where
1393 swaggerAesonOptions _ = mkSwaggerAesonOptions "server"
1567 swaggerAesonOptions _ = mkSwaggerAesonOptions "server"
1394instance HasSwaggerAesonOptions Components where
1568instance HasSwaggerAesonOptions Components where
@@ -1417,19 +1591,18 @@ instance HasSwaggerAesonOptions SecurityScheme where
1417 swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1591 swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"
1418instance HasSwaggerAesonOptions Schema where
1592instance HasSwaggerAesonOptions Schema where
1419 swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1593 swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"
1420−instance HasSwaggerAesonOptions Swagger where
1594+instance HasSwaggerAesonOptions OpenApi where
1421 swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")]
1595 swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")]
1422instance HasSwaggerAesonOptions Example where
1596instance HasSwaggerAesonOptions Example where
1423 swaggerAesonOptions _ = mkSwaggerAesonOptions "example"
1597 swaggerAesonOptions _ = mkSwaggerAesonOptions "example"
1424instance HasSwaggerAesonOptions Encoding where
1598instance HasSwaggerAesonOptions Encoding where
1425 swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding"
1599 swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding"
1426
1600
1427−instance HasSwaggerAesonOptions ParamSchema where
1601+instance HasSwaggerAesonOptions Link where
1428− swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"
1602+ swaggerAesonOptions _ = mkSwaggerAesonOptions "link"
1429
1603
1430instance AesonDefaultValue Server
1604instance AesonDefaultValue Server
1431instance AesonDefaultValue Components
1605instance AesonDefaultValue Components
1432−instance AesonDefaultValue ParamSchema
1433instance AesonDefaultValue OAuth2ImplicitFlow
1606instance AesonDefaultValue OAuth2ImplicitFlow
1434instance AesonDefaultValue OAuth2PasswordFlow
1607instance AesonDefaultValue OAuth2PasswordFlow
1435instance AesonDefaultValue OAuth2ClientCredentialsFlow
1608instance AesonDefaultValue OAuth2ClientCredentialsFlow
@@ -1437,7 +1610,10 @@ instance AesonDefaultValue OAuth2AuthorizationCodeFlow
1437instance AesonDefaultValue p => AesonDefaultValue (OAuth2Flow p)
1610instance AesonDefaultValue p => AesonDefaultValue (OAuth2Flow p)
1438instance AesonDefaultValue Responses
1611instance AesonDefaultValue Responses
1439instance AesonDefaultValue SecuritySchemeType
1612instance AesonDefaultValue SecuritySchemeType
1440−instance AesonDefaultValue SwaggerType
1613+instance AesonDefaultValue OpenApiType
1441instance AesonDefaultValue MimeList where defaultValue = Just mempty
1614instance AesonDefaultValue MimeList where defaultValue = Just mempty
1442instance AesonDefaultValue Info
1615instance AesonDefaultValue Info
1443instance AesonDefaultValue ParamLocation
1616instance AesonDefaultValue ParamLocation
1617+instance AesonDefaultValue Link
1618+instance AesonDefaultValue SecurityDefinitions where
1619+ defaultValue = Just mempty
src/Data/Swagger/Internal/AesonUtils.hs → src/Data/OpenApi/Internal/AesonUtils.hsrenamed+12−13
@@ -5,7 +5,7 @@
5{-# LANGUAGE ExplicitForAll #-}
5{-# LANGUAGE ExplicitForAll #-}
6{-# LANGUAGE TemplateHaskell #-}
6{-# LANGUAGE TemplateHaskell #-}
7{-# LANGUAGE UndecidableSuperClasses #-}
7{-# LANGUAGE UndecidableSuperClasses #-}
8−module Data.Swagger.Internal.AesonUtils (
8+module Data.OpenApi.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)
30+import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), Object, object, (.:), (.:?), (.!=), withObject, Encoding, pairs, (.=), Series)
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,12 +36,11 @@ 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
40import qualified Data.Set as Set
39import qualified Data.Set as Set
41import qualified Data.HashMap.Strict.InsOrd as InsOrd
40import qualified Data.HashMap.Strict.InsOrd as InsOrd
42import qualified Data.HashSet.InsOrd as InsOrdHS
41import qualified Data.HashSet.InsOrd as InsOrdHS
43
42
44−import Data.Aeson (Encoding, pairs, (.=), Series)
43+import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)
45
44
46-------------------------------------------------------------------------------
45-------------------------------------------------------------------------------
47-- SwaggerAesonOptions
46-- SwaggerAesonOptions
@@ -49,7 +48,7 @@ import Data.Aeson (Encoding, pairs, (.=), Series)
49
48
50data SwaggerAesonOptions = SwaggerAesonOptions
49data SwaggerAesonOptions = SwaggerAesonOptions
51 { _saoPrefix :: String
50 { _saoPrefix :: String
52− , _saoAdditionalPairs :: [(Text, Value)]
51+ , _saoAdditionalPairs :: [Pair]
53 , _saoSubObject :: Maybe String
52 , _saoSubObject :: Maybe String
54 }
53 }
55
54
@@ -156,14 +155,14 @@ sopSwaggerGenericToJSON'' (SwaggerAesonOptions prefix _ sub) = go
156 go Nil Nil Nil = []
155 go Nil Nil Nil = []
157 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
156 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
158 | Just name' == sub = case json of
157 | Just name' == sub = case json of
159− Object m -> HM.toList m ++ rest
158+ Object m -> objectToList m ++ rest
160 Null -> rest
159 Null -> rest
161 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
160 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
162 -- If default value: omit it.
161 -- If default value: omit it.
163 | Just x == def =
162 | Just x == def =
164 rest
163 rest
165 | otherwise =
164 | otherwise =
166− (T.pack name', json) : rest
165+ (stringToKey name', json) : rest
167 where
166 where
168 json = toJSON x
167 json = toJSON x
169 name' = fieldNameModifier name
168 name' = fieldNameModifier name
@@ -197,11 +196,11 @@ sopSwaggerGenericParseJSON = withObject "Swagger Record Object" $ \obj ->
197 proxy = Proxy :: Proxy a
196 proxy = Proxy :: Proxy a
198 opts = swaggerAesonOptions proxy
197 opts = swaggerAesonOptions proxy
199
198
200− parseAdditionalField :: Object -> (Text, Value) -> Parser ()
199+ parseAdditionalField :: Object -> Pair -> Parser ()
201 parseAdditionalField obj (k, v) = do
200 parseAdditionalField obj (k, v) = do
202 v' <- obj .: k
201 v' <- obj .: k
203 unless (v == v') $ fail $
202 unless (v == v') $ fail $
204− "Additonal field don't match for key " ++ T.unpack k
203+ "Additonal field don't match for key " ++ keyToString k
205 ++ ": " ++ show v
204 ++ ": " ++ show v
206 ++ " /= " ++ show v'
205 ++ " /= " ++ show v'
207
206
@@ -232,8 +231,8 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
232 -- Note: we might strip fields of outer structure.
231 -- Note: we might strip fields of outer structure.
233 cons <$> (withDef $ parseJSON $ Object obj) <*> rest
232 cons <$> (withDef $ parseJSON $ Object obj) <*> rest
234 | otherwise = case def of
233 | otherwise = case def of
235− Just def' -> cons <$> obj .:? T.pack name' .!= def' <*> rest
234+ Just def' -> cons <$> obj .:? stringToKey name' .!= def' <*> rest
236− Nothing -> cons <$> obj .: T.pack name' <*> rest
235+ Nothing -> cons <$> obj .: stringToKey name' <*> rest
237 where
236 where
238 cons h t = I h :* t
237 cons h t = I h :* t
239 name' = fieldNameModifier name
238 name' = fieldNameModifier name
@@ -296,14 +295,14 @@ sopSwaggerGenericToEncoding'' (SwaggerAesonOptions prefix _ sub) = go
296 go Nil Nil Nil = mempty
295 go Nil Nil Nil = mempty
297 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
296 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
298 | Just name' == sub = case toJSON x of
297 | Just name' == sub = case toJSON x of
299− Object m -> pairsToSeries (HM.toList m) <> rest
298+ Object m -> pairsToSeries (objectToList m) <> rest
300 Null -> rest
299 Null -> rest
301 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
300 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
302 -- If default value: omit it.
301 -- If default value: omit it.
303 | Just x == def =
302 | Just x == def =
304 rest
303 rest
305 | otherwise =
304 | otherwise =
306− (T.pack name' .= x) <> rest
305+ (stringToKey name' .= x) <> rest
307 where
306 where
308 name' = fieldNameModifier name
307 name' = fieldNameModifier name
309 rest = go xs names defs
308 rest = go xs names defs
src/Data/Swagger/Internal/ParamSchema.hs → src/Data/OpenApi/Internal/ParamSchema.hsrenamed+76−52
@@ -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.Swagger.Internal.ParamSchema where
18+module Data.OpenApi.Internal.ParamSchema where
19
19
20import Control.Lens
20import Control.Lens
21import Data.Aeson (ToJSON (..))
21import Data.Aeson (ToJSON (..))
@@ -41,34 +41,40 @@ 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.Swagger.Internal
44+import Data.OpenApi.Internal
45−import Data.Swagger.Lens
45+import Data.OpenApi.Lens
46−import Data.Swagger.SchemaOptions
46+import Data.OpenApi.SchemaOptions
47
47
48import qualified Data.ByteString as BS
48import qualified Data.ByteString as BS
49−import qualified Data.ByteString.Lazy as BSL
49+import qualified Data.ByteString.Lazy.Char8 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−binaryParamSchema :: ParamSchema
53+binarySchema :: Schema
54−binaryParamSchema = mempty
54+binarySchema = mempty
55− & type_ ?~ SwaggerString
55+ & type_ ?~ OpenApiString
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−byteParamSchema :: ParamSchema
59+byteSchema :: Schema
60−byteParamSchema = mempty
60+byteSchema = mempty
61− & type_ ?~ SwaggerString
61+ & type_ ?~ OpenApiString
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−passwordParamSchema :: ParamSchema
66+passwordSchema :: Schema
67−passwordParamSchema = mempty
67+passwordSchema = mempty
68− & type_ ?~ SwaggerString
68+ & type_ ?~ OpenApiString
69 & format ?~ "password"
69 & format ?~ "password"
70
70
71−-- | Convert a type into a plain @'ParamSchema'@.
71+-- | Convert a type into a plain @'Schema'@.
72+--
73+-- In previous versions of the package there was a separate type called @ParamSchema@, which was
74+-- included in a greater 'Schema'. Now this is a single class, but distinction for schema generators
75+-- for "simple" types is preserved.
76+--
77+-- 'ToParamSchema' is suited only for primitive-like types without nested fields and such.
72--
78--
73-- An example type and instance:
79-- An example type and instance:
74--
80--
@@ -81,7 +87,7 @@ passwordParamSchema = mempty
81--
87--
82-- instance ToParamSchema Direction where
88-- instance ToParamSchema Direction where
83-- toParamSchema _ = mempty
89-- toParamSchema _ = mempty
84−-- & type_ ?~ SwaggerString
90+-- & type_ ?~ OpenApiString
85-- & enum_ ?~ [ \"Up\", \"Down\" ]
91-- & enum_ ?~ [ \"Up\", \"Down\" ]
86-- @
92-- @
87--
93--
@@ -106,24 +112,26 @@ passwordParamSchema = mempty
106class ToParamSchema a where
112class ToParamSchema a where
107 -- | Convert a type into a plain parameter schema.
113 -- | Convert a type into a plain parameter schema.
108 --
114 --
109− -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)
115+ -- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy Integer)
116+ -- {
110− -- "{\"type\":\"integer\"}"
117+ -- "type": "integer"
118+ -- }
111− toParamSchema :: Proxy a -> ParamSchema
119+ toParamSchema :: Proxy a -> Schema
112− default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema
120+ default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> Schema
113 toParamSchema = genericToParamSchema defaultSchemaOptions
121 toParamSchema = genericToParamSchema defaultSchemaOptions
114
122
115instance {-# OVERLAPPING #-} ToParamSchema String where
123instance {-# OVERLAPPING #-} ToParamSchema String where
116− toParamSchema _ = mempty & type_ ?~ SwaggerString
124+ toParamSchema _ = mempty & type_ ?~ OpenApiString
117
125
118instance ToParamSchema Bool where
126instance ToParamSchema Bool where
119− toParamSchema _ = mempty & type_ ?~ SwaggerBoolean
127+ toParamSchema _ = mempty & type_ ?~ OpenApiBoolean
120
128
121instance ToParamSchema Integer where
129instance ToParamSchema Integer where
122− toParamSchema _ = mempty & type_ ?~ SwaggerInteger
130+ toParamSchema _ = mempty & type_ ?~ OpenApiInteger
123
131
124instance ToParamSchema Natural where
132instance ToParamSchema Natural where
125 toParamSchema _ = mempty
133 toParamSchema _ = mempty
126− & type_ ?~ SwaggerInteger
134+ & type_ ?~ OpenApiInteger
127 & minimum_ ?~ 0
135 & minimum_ ?~ 0
128 & exclusiveMinimum ?~ False
136 & exclusiveMinimum ?~ False
129
137
@@ -149,41 +157,45 @@ instance ToParamSchema Word64 where
149
157
150-- | Default plain schema for @'Bounded'@, @'Integral'@ types.
158-- | Default plain schema for @'Bounded'@, @'Integral'@ types.
151--
159--
152−-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
160+-- >>> BSL.putStrLn $ encodePretty $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
161+-- {
162+-- "maximum": 127,
163+-- "minimum": -128,
153−-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
164+-- "type": "integer"
165+-- }
154−toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema
166+toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> Schema
155toParamSchemaBoundedIntegral _ = mempty
167toParamSchemaBoundedIntegral _ = mempty
156− & type_ ?~ SwaggerInteger
168+ & type_ ?~ OpenApiInteger
157 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
169 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
158 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
170 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
159
171
160instance ToParamSchema Char where
172instance ToParamSchema Char where
161 toParamSchema _ = mempty
173 toParamSchema _ = mempty
162− & type_ ?~ SwaggerString
174+ & type_ ?~ OpenApiString
163 & maxLength ?~ 1
175 & maxLength ?~ 1
164 & minLength ?~ 1
176 & minLength ?~ 1
165
177
166instance ToParamSchema Scientific where
178instance ToParamSchema Scientific where
167− toParamSchema _ = mempty & type_ ?~ SwaggerNumber
179+ toParamSchema _ = mempty & type_ ?~ OpenApiNumber
168
180
169instance HasResolution a => ToParamSchema (Fixed a) where
181instance HasResolution a => ToParamSchema (Fixed a) where
170 toParamSchema _ = mempty
182 toParamSchema _ = mempty
171− & type_ ?~ SwaggerNumber
183+ & type_ ?~ OpenApiNumber
172 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
184 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
173
185
174instance ToParamSchema Double where
186instance ToParamSchema Double where
175 toParamSchema _ = mempty
187 toParamSchema _ = mempty
176− & type_ ?~ SwaggerNumber
188+ & type_ ?~ OpenApiNumber
177 & format ?~ "double"
189 & format ?~ "double"
178
190
179instance ToParamSchema Float where
191instance ToParamSchema Float where
180 toParamSchema _ = mempty
192 toParamSchema _ = mempty
181− & type_ ?~ SwaggerNumber
193+ & type_ ?~ OpenApiNumber
182 & format ?~ "float"
194 & format ?~ "float"
183
195
184−timeParamSchema :: String -> ParamSchema
196+timeParamSchema :: String -> Schema
185timeParamSchema fmt = mempty
197timeParamSchema fmt = mempty
186− & type_ ?~ SwaggerString
198+ & type_ ?~ OpenApiString
187 & format ?~ T.pack fmt
199 & format ?~ T.pack fmt
188
200
189-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
201-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -204,9 +216,9 @@ instance ToParamSchema LocalTime where
204
216
205-- |
217-- |
206-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
218-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
207−-- Just "yyyy-mm-ddThh:MM:ss+hhMM"
219+-- Just "date-time"
208instance ToParamSchema ZonedTime where
220instance ToParamSchema ZonedTime where
209− toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+hhMM"
221+ toParamSchema _ = timeParamSchema "date-time"
210
222
211-- |
223-- |
212-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format
224-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format
@@ -225,12 +237,12 @@ instance ToParamSchema TL.Text where
225
237
226instance ToParamSchema Version where
238instance ToParamSchema Version where
227 toParamSchema _ = mempty
239 toParamSchema _ = mempty
228− & type_ ?~ SwaggerString
240+ & type_ ?~ OpenApiString
229 & pattern ?~ "^\\d+(\\.\\d+)*$"
241 & pattern ?~ "^\\d+(\\.\\d+)*$"
230
242
231instance ToParamSchema SetCookie where
243instance ToParamSchema SetCookie where
232 toParamSchema _ = mempty
244 toParamSchema _ = mempty
233− & type_ ?~ SwaggerString
245+ & type_ ?~ OpenApiString
234
246
235type family ToParamSchemaByteStringError bs where
247type family ToParamSchemaByteStringError bs where
236 ToParamSchemaByteStringError bs = TypeError
248 ToParamSchemaByteStringError bs = TypeError
@@ -253,8 +265,8 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t
253
265
254instance ToParamSchema a => ToParamSchema [a] where
266instance ToParamSchema a => ToParamSchema [a] where
255 toParamSchema _ = mempty
267 toParamSchema _ = mempty
256− & type_ ?~ SwaggerArray
268+ & type_ ?~ OpenApiArray
257− & items ?~ SwaggerItemsObject (Inline $ mempty & paramSchema .~ toParamSchema (Proxy :: Proxy a))
269+ & items ?~ OpenApiItemsObject (Inline $ toParamSchema (Proxy :: Proxy a))
258
270
259instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
271instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
260instance ToParamSchema a => ToParamSchema (VP.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
272instance ToParamSchema a => ToParamSchema (VP.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
@@ -269,29 +281,40 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
269 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
281 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
270
282
271-- |
283-- |
272−-- >>> encode $ toParamSchema (Proxy :: Proxy ())
284+-- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy ())
285+-- {
273−-- "{\"type\":\"string\",\"enum\":[\"_\"]}"
286+-- "enum": [
287+-- "_"
288+-- ],
289+-- "type": "string"
290+-- }
274instance ToParamSchema () where
291instance ToParamSchema () where
275 toParamSchema _ = mempty
292 toParamSchema _ = mempty
276− & type_ ?~ SwaggerString
293+ & type_ ?~ OpenApiString
277 & enum_ ?~ ["_"]
294 & enum_ ?~ ["_"]
278
295
279instance ToParamSchema UUID where
296instance ToParamSchema UUID where
280 toParamSchema _ = mempty
297 toParamSchema _ = mempty
281− & type_ ?~ SwaggerString
298+ & type_ ?~ OpenApiString
282 & format ?~ "uuid"
299 & format ?~ "uuid"
283
300
284−-- | A configurable generic @'ParamSchema'@ creator.
301+-- | A configurable generic @'Schema'@ creator.
285--
302--
286-- >>> :set -XDeriveGeneric
303-- >>> :set -XDeriveGeneric
287-- >>> data Color = Red | Blue deriving Generic
304-- >>> data Color = Red | Blue deriving Generic
288−-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
305+-- >>> BSL.putStrLn $ encodePretty $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
289−-- "{\"type\":\"string\",\"enum\":[\"Red\",\"Blue\"]}"
306+-- {
307+-- "enum": [
308+-- "Red",
309+-- "Blue"
310+-- ],
311+-- "type": "string"
312+-- }
290−genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> ParamSchema
313+genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> Schema
291genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
314genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
292
315
293class GToParamSchema (f :: * -> *) where
316class GToParamSchema (f :: * -> *) where
294− gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema -> ParamSchema
317+ gtoParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
295
318
296instance GToParamSchema f => GToParamSchema (D1 d f) where
319instance GToParamSchema f => GToParamSchema (D1 d f) where
297 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
320 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)
@@ -309,14 +332,14 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) wh
309 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
332 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))
310
333
311class GEnumParamSchema (f :: * -> *) where
334class GEnumParamSchema (f :: * -> *) where
312− genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema -> ParamSchema
335+ genumParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema
313
336
314instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
337instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where
315 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)
338 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)
316
339
317instance Constructor c => GEnumParamSchema (C1 c U1) where
340instance Constructor c => GEnumParamSchema (C1 c U1) where
318 genumParamSchema opts _ s = s
341 genumParamSchema opts _ s = s
319− & type_ ?~ SwaggerString
342+ & type_ ?~ OpenApiString
320 & enum_ %~ addEnumValue tag
343 & enum_ %~ addEnumValue tag
321 where
344 where
322 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
345 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
@@ -328,3 +351,4 @@ data Proxy3 a b c = Proxy3
328
351
329-- $setup
352-- $setup
330-- >>> import Data.Aeson (encode)
353-- >>> import Data.Aeson (encode)
354+-- >>> import Data.OpenApi.Internal.Utils
src/Data/Swagger/Internal/Schema.hs → src/Data/OpenApi/Internal/Schema.hsrenamed+383−140
@@ -1,15 +1,17 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE ConstraintKinds #-}
2{-# LANGUAGE ConstraintKinds #-}
3+{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DefaultSignatures #-}
4{-# LANGUAGE DefaultSignatures #-}
3{-# LANGUAGE FlexibleContexts #-}
5{-# LANGUAGE FlexibleContexts #-}
4{-# LANGUAGE FlexibleInstances #-}
6{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE KindSignatures #-}
7{-# LANGUAGE KindSignatures #-}
6−{-# LANGUAGE DataKinds #-}
7{-# LANGUAGE OverloadedLists #-}
8{-# LANGUAGE OverloadedLists #-}
8{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE OverloadedStrings #-}
9{-# LANGUAGE PackageImports #-}
10{-# LANGUAGE PackageImports #-}
10{-# LANGUAGE PolyKinds #-}
11{-# LANGUAGE PolyKinds #-}
11{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE ScopedTypeVariables #-}
12{-# LANGUAGE TupleSections #-}
13{-# LANGUAGE TupleSections #-}
14+{-# LANGUAGE TypeApplications #-}
13{-# LANGUAGE TypeFamilies #-}
15{-# LANGUAGE TypeFamilies #-}
14{-# LANGUAGE TypeOperators #-}
16{-# LANGUAGE TypeOperators #-}
15{-# LANGUAGE TypeSynonymInstances #-}
17{-# LANGUAGE TypeSynonymInstances #-}
@@ -17,7 +19,7 @@
17{-# OPTIONS_GHC -Wno-redundant-constraints #-}
19{-# OPTIONS_GHC -Wno-redundant-constraints #-}
18-- For TypeErrors
20-- For TypeErrors
19{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
21{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}
20−module Data.Swagger.Internal.Schema where
22+module Data.OpenApi.Internal.Schema where
21
23
22import Prelude ()
24import Prelude ()
23import Prelude.Compat
25import Prelude.Compat
@@ -40,6 +42,7 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
40import Data.Int
42import Data.Int
41import Data.IntSet (IntSet)
43import Data.IntSet (IntSet)
42import Data.IntMap (IntMap)
44import Data.IntMap (IntMap)
45+import Data.List (sort)
43import Data.List.NonEmpty.Compat (NonEmpty)
46import Data.List.NonEmpty.Compat (NonEmpty)
44import Data.Map (Map)
47import Data.Map (Map)
45import Data.Maybe (fromMaybe)
48import Data.Maybe (fromMaybe)
@@ -59,14 +62,16 @@ import Numeric.Natural.Compat (Natural)
59import Data.Word
62import Data.Word
60import GHC.Generics
63import GHC.Generics
61import qualified Data.UUID.Types as UUID
64import qualified Data.UUID.Types as UUID
65+import Type.Reflection (Typeable, typeRep)
62
66
67+import Data.OpenApi.Aeson.Compat (keyToText, objectKeys, toInsOrdHashMap)
63−import Data.Swagger.Declare
68+import Data.OpenApi.Declare
64−import Data.Swagger.Internal
69+import Data.OpenApi.Internal
65−import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))
70+import Data.OpenApi.Internal.ParamSchema (ToParamSchema (..))
71+import Data.OpenApi.Internal.TypeShape
66−import Data.Swagger.Lens hiding (name, schema)
72+import Data.OpenApi.Lens hiding (name, schema)
67−import qualified Data.Swagger.Lens as Swagger
73+import qualified Data.OpenApi.Lens as Swagger
68−import Data.Swagger.SchemaOptions
74+import Data.OpenApi.SchemaOptions
69−import Data.Swagger.Internal.TypeShape
70
75
71import qualified Data.ByteString as BS
76import qualified Data.ByteString as BS
72import qualified Data.ByteString.Lazy.Char8 as BSL
77import qualified Data.ByteString.Lazy.Char8 as BSL
@@ -97,7 +102,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
97--
102--
98-- import Control.Lens
103-- import Control.Lens
99-- import Data.Proxy
104-- import Data.Proxy
100−-- import Data.Swagger
105+-- import Data.OpenApi
101--
106--
102-- data Coord = Coord { x :: Double, y :: Double }
107-- data Coord = Coord { x :: Double, y :: Double }
103--
108--
@@ -105,7 +110,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
105-- declareNamedSchema _ = do
110-- declareNamedSchema _ = do
106-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
111-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
107-- return $ NamedSchema (Just \"Coord\") $ mempty
112-- return $ NamedSchema (Just \"Coord\") $ mempty
108−-- & type_ ?~ SwaggerObject
113+-- & type_ ?~ OpenApiObject
109-- & properties .~
114-- & properties .~
110-- [ (\"x\", doubleSchema)
115-- [ (\"x\", doubleSchema)
111-- , (\"y\", doubleSchema)
116-- , (\"y\", doubleSchema)
@@ -131,7 +136,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
131--
136--
132-- instance ToSchema Coord
137-- instance ToSchema Coord
133-- @
138-- @
134−class ToSchema a where
139+class Typeable a => ToSchema a where
135 -- | Convert a type into an optionally named schema
140 -- | Convert a type into an optionally named schema
136 -- together with all used definitions.
141 -- together with all used definitions.
137 -- Note that the schema itself is included in definitions
142 -- Note that the schema itself is included in definitions
@@ -153,13 +158,19 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
153--
158--
154-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
159-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
155-- Nothing
160-- Nothing
156−-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
161+-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy String) ^. schema)
162+-- {
157−-- {"type":"string"}
163+-- "type": "string"
164+-- }
158--
165--
159-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
166-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
160-- Just "Day"
167-- Just "Day"
161−-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
168+-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy Day) ^. schema)
169+-- {
162−-- {"example":"2016-07-22","format":"date","type":"string"}
170+-- "example": "2016-07-22",
171+-- "format": "date",
172+-- "type": "string"
173+-- }
163toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
174toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
164toNamedSchema = undeclare . declareNamedSchema
175toNamedSchema = undeclare . declareNamedSchema
165
176
@@ -175,22 +186,35 @@ schemaName = _namedSchemaName . toNamedSchema
175
186
176-- | Convert a type into a schema.
187-- | Convert a type into a schema.
177--
188--
178−-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Int8)
189+-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Int8)
190+-- {
191+-- "maximum": 127,
192+-- "minimum": -128,
179−-- {"maximum":127,"minimum":-128,"type":"integer"}
193+-- "type": "integer"
194+-- }
180--
195--
181−-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy [Day])
196+-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy [Day])
197+-- {
198+-- "items": {
182−-- {"items":{"$ref":"#/components/schemas/Day"},"type":"array"}
199+-- "$ref": "#/components/schemas/Day"
200+-- },
201+-- "type": "array"
202+-- }
183toSchema :: ToSchema a => Proxy a -> Schema
203toSchema :: ToSchema a => Proxy a -> Schema
184toSchema = _namedSchemaSchema . toNamedSchema
204toSchema = _namedSchemaSchema . toNamedSchema
185
205
186-- | Convert a type into a referenced schema if possible.
206-- | Convert a type into a referenced schema if possible.
187-- Only named schemas can be referenced, nameless schemas are inlined.
207-- Only named schemas can be referenced, nameless schemas are inlined.
188--
208--
189−-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Integer)
209+-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Integer)
210+-- {
190−-- {"type":"integer"}
211+-- "type": "integer"
212+-- }
191--
213--
192−-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Day)
214+-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Day)
215+-- {
193−-- {"$ref":"#/components/schemas/Day"}
216+-- "$ref": "#/components/schemas/Day"
217+-- }
194toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
218toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
195toSchemaRef = undeclare . declareSchemaRef
219toSchemaRef = undeclare . declareSchemaRef
196
220
@@ -258,8 +282,15 @@ inlineAllSchemas = inlineSchemasWhen (const True)
258
282
259-- | Convert a type into a schema without references.
283-- | Convert a type into a schema without references.
260--
284--
261−-- >>> BSL.putStrLn $ encode $ toInlinedSchema (Proxy :: Proxy [Day])
285+-- >>> BSL.putStrLn $ encodePretty $ toInlinedSchema (Proxy :: Proxy [Day])
286+-- {
287+-- "items": {
262−-- {"items":{"example":"2016-07-22","format":"date","type":"string"},"type":"array"}
288+-- "example": "2016-07-22",
289+-- "format": "date",
290+-- "type": "string"
291+-- },
292+-- "type": "array"
293+-- }
263--
294--
264-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
295-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
265-- when inlining recursive schemas.
296-- when inlining recursive schemas.
@@ -289,41 +320,67 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
289 traverse_ usedNames (InsOrdHashMap.lookup name defs)
320 traverse_ usedNames (InsOrdHashMap.lookup name defs)
290 Inline subschema -> usedNames subschema
321 Inline subschema -> usedNames subschema
291
322
292−-- | Default schema for binary data (any sequence of octets).
293−binarySchema :: Schema
294−binarySchema = mempty
295− & type_ ?~ SwaggerString
296− & format ?~ "binary"
297−
298−-- | Default schema for binary data (base64 encoded).
299−byteSchema :: Schema
300−byteSchema = mempty
301− & type_ ?~ SwaggerString
302− & format ?~ "byte"
303−
304−-- | Default schema for password string.
305−-- @"password"@ format is used to hint UIs the input needs to be obscured.
306−passwordSchema :: Schema
307−passwordSchema = mempty
308− & type_ ?~ SwaggerString
309− & format ?~ "password"
310−
311-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
323-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
312-- Produced schema can be used for further refinement.
324-- Produced schema can be used for further refinement.
313--
325--
314−-- >>> BSL.putStrLn $ encode $ sketchSchema "hello"
326+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema "hello"
327+-- {
315−-- {"example":"hello","type":"string"}
328+-- "example": "hello",
329+-- "type": "string"
330+-- }
316--
331--
317−-- >>> BSL.putStrLn $ encode $ sketchSchema (1, 2, 3)
332+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (1, 2, 3)
333+-- {
334+-- "example": [
335+-- 1,
336+-- 2,
337+-- 3
338+-- ],
339+-- "items": {
318−-- {"example":[1,2,3],"items":{"type":"number"},"type":"array"}
340+-- "type": "number"
341+-- },
342+-- "type": "array"
343+-- }
319--
344--
320−-- >>> BSL.putStrLn $ encode $ sketchSchema ("Jack", 25)
345+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema ("Jack", 25)
321−-- {"example":["Jack",25],"items":[{"type":"string"},{"type":"number"}],"type":"array"}
346+-- {
347+-- "example": [
348+-- "Jack",
349+-- 25
350+-- ],
351+-- "items": [
352+-- {
353+-- "type": "string"
354+-- },
355+-- {
356+-- "type": "number"
357+-- }
358+-- ],
359+-- "type": "array"
360+-- }
322--
361--
323-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
362-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
324-- >>> instance ToJSON Person
363-- >>> instance ToJSON Person
325−-- >>> BSL.putStrLn $ encode $ sketchSchema (Person "Jack" 25)
364+-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (Person "Jack" 25)
326−-- {"required":["age","name"],"properties":{"age":{"type":"number"},"name":{"type":"string"}},"example":{"age":25,"name":"Jack"},"type":"object"}
365+-- {
366+-- "example": {
367+-- "age": 25,
368+-- "name": "Jack"
369+-- },
370+-- "properties": {
371+-- "age": {
372+-- "type": "number"
373+-- },
374+-- "name": {
375+-- "type": "string"
376+-- }
377+-- },
378+-- "required": [
379+-- "age",
380+-- "name"
381+-- ],
382+-- "type": "object"
383+-- }
327sketchSchema :: ToJSON a => a -> Schema
384sketchSchema :: ToJSON a => a -> Schema
328sketchSchema = sketch . toJSON
385sketchSchema = sketch . toJSON
329 where
386 where
@@ -331,15 +388,15 @@ sketchSchema = sketch . toJSON
331 sketch js@(Bool _) = go js
388 sketch js@(Bool _) = go js
332 sketch js = go js & example ?~ js
389 sketch js = go js & example ?~ js
333
390
334− go Null = mempty & type_ ?~ SwaggerNull
391+ go Null = mempty & type_ ?~ OpenApiNull
335− go (Bool _) = mempty & type_ ?~ SwaggerBoolean
392+ go (Bool _) = mempty & type_ ?~ OpenApiBoolean
336− go (String _) = mempty & type_ ?~ SwaggerString
393+ go (String _) = mempty & type_ ?~ OpenApiString
337− go (Number _) = mempty & type_ ?~ SwaggerNumber
394+ go (Number _) = mempty & type_ ?~ OpenApiNumber
338 go (Array xs) = mempty
395 go (Array xs) = mempty
339− & type_ ?~ SwaggerArray
396+ & type_ ?~ OpenApiArray
340 & items ?~ case ischema of
397 & items ?~ case ischema of
341− Just s -> SwaggerItemsObject (Inline s)
398+ Just s -> OpenApiItemsObject (Inline s)
342− _ -> SwaggerItemsArray (map Inline ys)
399+ _ -> OpenApiItemsArray (map Inline ys)
343 where
400 where
344 ys = map go (V.toList xs)
401 ys = map go (V.toList xs)
345 allSame = and ((zipWith (==)) ys (tail ys))
402 allSame = and ((zipWith (==)) ys (tail ys))
@@ -348,64 +405,178 @@ sketchSchema = sketch . toJSON
348 (z:_) | allSame -> Just z
405 (z:_) | allSame -> Just z
349 _ -> Nothing
406 _ -> Nothing
350 go (Object o) = mempty
407 go (Object o) = mempty
351− & type_ ?~ SwaggerObject
408+ & type_ ?~ OpenApiObject
352− & required .~ HashMap.keys o
409+ & required .~ sort (objectKeys o)
353− & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
410+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
354
411
355-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
412-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
356-- Produced schema uses as much constraints as possible.
413-- Produced schema uses as much constraints as possible.
357--
414--
358−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema "hello"
415+-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema "hello"
359−-- {"maxLength":5,"pattern":"hello","minLength":5,"type":"string","enum":["hello"]}
416+-- {
417+-- "enum": [
418+-- "hello"
419+-- ],
420+-- "maxLength": 5,
421+-- "minLength": 5,
422+-- "pattern": "hello",
423+-- "type": "string"
424+-- }
360--
425--
361−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (1, 2, 3)
426+-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (1, 2, 3)
362−-- {"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]]}
427+-- {
428+-- "enum": [
429+-- [
430+-- 1,
431+-- 2,
432+-- 3
433+-- ]
434+-- ],
435+-- "items": [
436+-- {
437+-- "enum": [
438+-- 1
439+-- ],
440+-- "maximum": 1,
441+-- "minimum": 1,
442+-- "multipleOf": 1,
443+-- "type": "number"
444+-- },
445+-- {
446+-- "enum": [
447+-- 2
448+-- ],
449+-- "maximum": 2,
450+-- "minimum": 2,
451+-- "multipleOf": 2,
452+-- "type": "number"
453+-- },
454+-- {
455+-- "enum": [
456+-- 3
457+-- ],
458+-- "maximum": 3,
459+-- "minimum": 3,
460+-- "multipleOf": 3,
461+-- "type": "number"
462+-- }
463+-- ],
464+-- "maxItems": 3,
465+-- "minItems": 3,
466+-- "type": "array",
467+-- "uniqueItems": true
468+-- }
363--
469--
364−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema ("Jack", 25)
470+-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema ("Jack", 25)
365−-- {"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]]}
471+-- {
472+-- "enum": [
473+-- [
474+-- "Jack",
475+-- 25
476+-- ]
477+-- ],
478+-- "items": [
479+-- {
480+-- "enum": [
481+-- "Jack"
482+-- ],
483+-- "maxLength": 4,
484+-- "minLength": 4,
485+-- "pattern": "Jack",
486+-- "type": "string"
487+-- },
488+-- {
489+-- "enum": [
490+-- 25
491+-- ],
492+-- "maximum": 25,
493+-- "minimum": 25,
494+-- "multipleOf": 25,
495+-- "type": "number"
496+-- }
497+-- ],
498+-- "maxItems": 2,
499+-- "minItems": 2,
500+-- "type": "array",
501+-- "uniqueItems": true
502+-- }
366--
503--
367-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
504-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
368-- >>> instance ToJSON Person
505-- >>> instance ToJSON Person
369−-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (Person "Jack" 25)
506+-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (Person "Jack" 25)
370−-- {"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"}]}
507+-- {
508+-- "enum": [
509+-- {
510+-- "age": 25,
511+-- "name": "Jack"
512+-- }
513+-- ],
514+-- "maxProperties": 2,
515+-- "minProperties": 2,
516+-- "properties": {
517+-- "age": {
518+-- "enum": [
519+-- 25
520+-- ],
521+-- "maximum": 25,
522+-- "minimum": 25,
523+-- "multipleOf": 25,
524+-- "type": "number"
525+-- },
526+-- "name": {
527+-- "enum": [
528+-- "Jack"
529+-- ],
530+-- "maxLength": 4,
531+-- "minLength": 4,
532+-- "pattern": "Jack",
533+-- "type": "string"
534+-- }
535+-- },
536+-- "required": [
537+-- "age",
538+-- "name"
539+-- ],
540+-- "type": "object"
541+-- }
371sketchStrictSchema :: ToJSON a => a -> Schema
542sketchStrictSchema :: ToJSON a => a -> Schema
372sketchStrictSchema = go . toJSON
543sketchStrictSchema = go . toJSON
373 where
544 where
374− go Null = mempty & type_ ?~ SwaggerNull
545+ go Null = mempty & type_ ?~ OpenApiNull
375 go js@(Bool _) = mempty
546 go js@(Bool _) = mempty
376− & type_ ?~ SwaggerBoolean
547+ & type_ ?~ OpenApiBoolean
377 & enum_ ?~ [js]
548 & enum_ ?~ [js]
378 go js@(String s) = mempty
549 go js@(String s) = mempty
379− & type_ ?~ SwaggerString
550+ & type_ ?~ OpenApiString
380 & maxLength ?~ fromIntegral (T.length s)
551 & maxLength ?~ fromIntegral (T.length s)
381 & minLength ?~ fromIntegral (T.length s)
552 & minLength ?~ fromIntegral (T.length s)
382 & pattern ?~ s
553 & pattern ?~ s
383 & enum_ ?~ [js]
554 & enum_ ?~ [js]
384 go js@(Number n) = mempty
555 go js@(Number n) = mempty
385− & type_ ?~ SwaggerNumber
556+ & type_ ?~ OpenApiNumber
386 & maximum_ ?~ n
557 & maximum_ ?~ n
387 & minimum_ ?~ n
558 & minimum_ ?~ n
388 & multipleOf ?~ n
559 & multipleOf ?~ n
389 & enum_ ?~ [js]
560 & enum_ ?~ [js]
390 go js@(Array xs) = mempty
561 go js@(Array xs) = mempty
391− & type_ ?~ SwaggerArray
562+ & type_ ?~ OpenApiArray
392 & maxItems ?~ fromIntegral sz
563 & maxItems ?~ fromIntegral sz
393 & minItems ?~ fromIntegral sz
564 & minItems ?~ fromIntegral sz
394− & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
565+ & items ?~ OpenApiItemsArray (map (Inline . go) (V.toList xs))
395 & uniqueItems ?~ allUnique
566 & uniqueItems ?~ allUnique
396 & enum_ ?~ [js]
567 & enum_ ?~ [js]
397 where
568 where
398 sz = length xs
569 sz = length xs
399 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
570 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
400 go js@(Object o) = mempty
571 go js@(Object o) = mempty
401− & type_ ?~ SwaggerObject
572+ & type_ ?~ OpenApiObject
402− & required .~ names
573+ & required .~ sort names
403− & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
574+ & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
404 & maxProperties ?~ fromIntegral (length names)
575 & maxProperties ?~ fromIntegral (length names)
405 & minProperties ?~ fromIntegral (length names)
576 & minProperties ?~ fromIntegral (length names)
406 & enum_ ?~ [js]
577 & enum_ ?~ [js]
407 where
578 where
408− names = HashMap.keys o
579+ names = objectKeys o
409
580
410class GToSchema (f :: * -> *) where
581class GToSchema (f :: * -> *) where
411 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
582 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
@@ -414,8 +585,8 @@ instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where
414 declareNamedSchema _ = do
585 declareNamedSchema _ = do
415 ref <- declareSchemaRef (Proxy :: Proxy a)
586 ref <- declareSchemaRef (Proxy :: Proxy a)
416 return $ unnamed $ mempty
587 return $ unnamed $ mempty
417− & type_ ?~ SwaggerArray
588+ & type_ ?~ OpenApiArray
418− & items ?~ SwaggerItemsObject ref
589+ & items ?~ OpenApiItemsObject ref
419
590
420instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
591instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
421instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
592instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema
@@ -440,7 +611,7 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
440instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
611instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
441instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
612instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
442
613
443−instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
614+instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
444
615
445instance ToSchema a => ToSchema (Maybe a) where
616instance ToSchema a => ToSchema (Maybe a) where
446 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
617 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
@@ -457,16 +628,22 @@ instance ToSchema UUID.UUID where
457 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
628 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
458 & example ?~ toJSON (UUID.toText UUID.nil)
629 & example ?~ toJSON (UUID.toText UUID.nil)
459
630
460−instance (ToSchema a, ToSchema b) => ToSchema (a, b)
631+instance (ToSchema a, ToSchema b) => ToSchema (a, b) where
632+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
461−instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
633+instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) where
634+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
462−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
635+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d) where
636+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
463−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e)
637+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e) where
638+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
464−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
639+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f) where
640+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
465−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
641+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g) where
642+ declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
466
643
467timeSchema :: T.Text -> Schema
644timeSchema :: T.Text -> Schema
468timeSchema fmt = mempty
645timeSchema fmt = mempty
469− & type_ ?~ SwaggerString
646+ & type_ ?~ OpenApiString
470 & format ?~ fmt
647 & format ?~ fmt
471
648
472-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
649-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -481,7 +658,7 @@ instance ToSchema LocalTime where
481 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
658 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
482 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
659 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
483
660
484−-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
661+-- | Format @"date-time"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
485instance ToSchema ZonedTime where
662instance ToSchema ZonedTime where
486 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
663 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
487 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
664 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
@@ -513,7 +690,7 @@ instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where
513instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
690instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
514
691
515-- | NOTE: This schema does not account for the uniqueness of keys.
692-- | NOTE: This schema does not account for the uniqueness of keys.
516−instance ToSchema a => ToSchema (IntMap a) where
693+instance (ToSchema a) => ToSchema (IntMap a) where
517 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
694 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
518
695
519instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
696instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
@@ -524,7 +701,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
524 declareObjectMapSchema = do
701 declareObjectMapSchema = do
525 schema <- declareSchemaRef (Proxy :: Proxy v)
702 schema <- declareSchemaRef (Proxy :: Proxy v)
526 return $ unnamed $ mempty
703 return $ unnamed $ mempty
527− & type_ ?~ SwaggerObject
704+ & type_ ?~ OpenApiObject
528 & additionalProperties ?~ AdditionalPropertiesSchema schema
705 & additionalProperties ?~ AdditionalPropertiesSchema schema
529
706
530instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
707instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
@@ -532,7 +709,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
532
709
533instance {-# OVERLAPPING #-} ToSchema Object where
710instance {-# OVERLAPPING #-} ToSchema Object where
534 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
711 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
535− & type_ ?~ SwaggerObject
712+ & type_ ?~ OpenApiObject
536 & description ?~ "Arbitrary JSON object."
713 & description ?~ "Arbitrary JSON object."
537 & additionalProperties ?~ AdditionalPropertiesAllowed True
714 & additionalProperties ?~ AdditionalPropertiesAllowed True
538
715
@@ -569,11 +746,15 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
569
746
570-- | Default schema for @'Bounded'@, @'Integral'@ types.
747-- | Default schema for @'Bounded'@, @'Integral'@ types.
571--
748--
572−-- >>> BSL.putStrLn $ encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
749+-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
750+-- {
573−-- {"maximum":32767,"minimum":-32768,"type":"integer"}
751+-- "maximum": 32767,
752+-- "minimum": -32768,
753+-- "type": "integer"
754+-- }
574toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
755toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
575toSchemaBoundedIntegral _ = mempty
756toSchemaBoundedIntegral _ = mempty
576− & type_ ?~ SwaggerInteger
757+ & type_ ?~ OpenApiInteger
577 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
758 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
578 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
759 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
579
760
@@ -602,8 +783,27 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
602-- >>> instance ToSchema ButtonState
783-- >>> instance ToSchema ButtonState
603-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
784-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
604-- >>> type ImageUrl = T.Text
785-- >>> type ImageUrl = T.Text
605−-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
786+-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
606−-- {"properties":{"Neutral":{"type":"string"},"Focus":{"type":"string"},"Active":{"type":"string"},"Hover":{"type":"string"},"Disabled":{"type":"string"}},"type":"object"}
787+-- {
788+-- "properties": {
789+-- "Active": {
790+-- "type": "string"
791+-- },
792+-- "Disabled": {
793+-- "type": "string"
794+-- },
795+-- "Focus": {
796+-- "type": "string"
797+-- },
798+-- "Hover": {
799+-- "type": "string"
800+-- },
801+-- "Neutral": {
802+-- "type": "string"
803+-- }
804+-- },
805+-- "type": "object"
806+-- }
607--
807--
608-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
808-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
609-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
809-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -611,15 +811,15 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.
611 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
811 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
612 => Proxy (map key value) -> Declare (Definitions Schema) Schema
812 => Proxy (map key value) -> Declare (Definitions Schema) Schema
613declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
813declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
614− ToJSONKeyText keyToText _ -> objectSchema keyToText
814+ ToJSONKeyText getKey _ -> objectSchema getKey
615 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
815 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
616 where
816 where
617− objectSchema keyToText = do
817+ objectSchema getKey = do
618 valueRef <- declareSchemaRef (Proxy :: Proxy value)
818 valueRef <- declareSchemaRef (Proxy :: Proxy value)
619 let allKeys = [minBound..maxBound :: key]
819 let allKeys = [minBound..maxBound :: key]
620− mkPair k = (keyToText k, valueRef)
820+ mkPair k = (keyToText $ getKey k, valueRef)
621 return $ mempty
821 return $ mempty
622− & type_ ?~ SwaggerObject
822+ & type_ ?~ OpenApiObject
623 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
823 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
624
824
625-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
825-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -630,8 +830,27 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
630-- >>> instance ToSchema ButtonState
830-- >>> instance ToSchema ButtonState
631-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
831-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
632-- >>> type ImageUrl = T.Text
832-- >>> type ImageUrl = T.Text
633−-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
833+-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
634−-- {"properties":{"Neutral":{"type":"string"},"Focus":{"type":"string"},"Active":{"type":"string"},"Hover":{"type":"string"},"Disabled":{"type":"string"}},"type":"object"}
834+-- {
835+-- "properties": {
836+-- "Active": {
837+-- "type": "string"
838+-- },
839+-- "Disabled": {
840+-- "type": "string"
841+-- },
842+-- "Focus": {
843+-- "type": "string"
844+-- },
845+-- "Hover": {
846+-- "type": "string"
847+-- },
848+-- "Neutral": {
849+-- "type": "string"
850+-- }
851+-- },
852+-- "type": "object"
853+-- }
635--
854--
636-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
855-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
637-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
856-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -641,7 +860,7 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.
641toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
860toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
642
861
643-- | A configurable generic @'Schema'@ creator.
862-- | A configurable generic @'Schema'@ creator.
644−genericDeclareSchema :: (Generic a, GToSchema (Rep a)) =>
863+genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
645 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
864 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
646genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
865genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
647
866
@@ -649,9 +868,24 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche
649-- This function applied to @'defaultSchemaOptions'@
868-- This function applied to @'defaultSchemaOptions'@
650-- is used as the default for @'declareNamedSchema'@
869-- is used as the default for @'declareNamedSchema'@
651-- when the type is an instance of @'Generic'@.
870-- when the type is an instance of @'Generic'@.
871+--
872+-- Default implementation will use the name from 'Typeable' instance, including concrete
873+-- instantioations of type variables.
874+--
875+-- For example:
876+--
877+-- >>> _namedSchemaName $ undeclare $ genericDeclareNamedSchema defaultSchemaOptions (Proxy :: Proxy (Either Int Bool))
878+-- Just "Either_Int_Bool"
652−genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a)) =>
879+genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>
653 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
880 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
881+genericDeclareNamedSchema opts _ =
654−genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
882+ rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
883+ where
884+ unspace ' ' = '_'
885+ unspace x = x
886+ orig = fmap unspace $ show $ typeRep @a
887+ name = datatypeNameModifier opts orig
888+
655
889
656-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
890-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
657genericNameSchema :: forall a d f.
891genericNameSchema :: forall a d f.
@@ -667,19 +901,19 @@ gdatatypeSchemaName opts _ = case orig of
667 orig = datatypeName (Proxy3 :: Proxy3 d f a)
901 orig = datatypeName (Proxy3 :: Proxy3 d f a)
668 name = datatypeNameModifier opts orig
902 name = datatypeNameModifier opts orig
669
903
670−-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.
904+-- | Construct 'NamedSchema' usinng 'ToParamSchema'.
671paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
905paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>
672 SchemaOptions -> Proxy a -> NamedSchema
906 SchemaOptions -> Proxy a -> NamedSchema
673paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
907paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)
674
908
675−-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.
909+-- | Construct 'Schema' usinng 'ToParamSchema'.
676paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
910paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema
677−paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
911+paramSchemaToSchema = toParamSchema
678
912
679nullarySchema :: Schema
913nullarySchema :: Schema
680nullarySchema = mempty
914nullarySchema = mempty
681− & type_ ?~ SwaggerArray
915+ & type_ ?~ OpenApiArray
682− & items ?~ SwaggerItemsArray []
916+ & items ?~ OpenApiItemsArray []
683
917
684gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
918gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
685gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
919gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty
@@ -709,12 +943,15 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
709 | unwrapUnaryRecords opts = fieldSchema
943 | unwrapUnaryRecords opts = fieldSchema
710 | otherwise =
944 | otherwise =
711 case schema ^. items of
945 case schema ^. items of
712− Just (SwaggerItemsArray [_]) -> fieldSchema
946+ Just (OpenApiItemsArray [_]) -> fieldSchema
713 _ -> do
947 _ -> do
714− declare defs
948+ -- We have to run recordSchema instead of just using its defs,
949+ -- since those can be recursive and will lead to infinite loop,
950+ -- see https://github.com/biocad/openapi3/pull/37
951+ NamedSchema _ schema' <- recordSchema
715− return (unnamed schema)
952+ return (unnamed schema')
716 where
953 where
717− (defs, NamedSchema _ schema) = runDeclare recordSchema mempty
954+ (_, NamedSchema _ schema) = runDeclare recordSchema mempty
718 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
955 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
719 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
956 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
720
957
@@ -737,10 +974,10 @@ gdeclareSchemaRef opts proxy = do
737 return $ Ref (Reference name)
974 return $ Ref (Reference name)
738 _ -> Inline <$> gdeclareSchema opts proxy
975 _ -> Inline <$> gdeclareSchema opts proxy
739
976
740−appendItem :: Referenced Schema -> Maybe SwaggerItems -> Maybe SwaggerItems
977+appendItem :: Referenced Schema -> Maybe OpenApiItems -> Maybe OpenApiItems
741−appendItem x Nothing = Just (SwaggerItemsArray [x])
978+appendItem x Nothing = Just (OpenApiItemsArray [x])
742−appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))
979+appendItem x (Just (OpenApiItemsArray xs)) = Just (OpenApiItemsArray (xs ++ [x]))
743−appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"
980+appendItem _ _ = error "GToSchema.appendItem: cannot append to OpenApiItemsObject"
744
981
745withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
982withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>
746 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
983 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema
@@ -749,12 +986,12 @@ withFieldSchema opts _ isRequiredField schema = do
749 return $
986 return $
750 if T.null fname
987 if T.null fname
751 then schema
988 then schema
752− & type_ ?~ SwaggerArray
989+ & type_ ?~ OpenApiArray
753 & items %~ appendItem ref
990 & items %~ appendItem ref
754 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
991 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
755 & minItems %~ Just . maybe 1 (+1) -- increment minItems
992 & minItems %~ Just . maybe 1 (+1) -- increment minItems
756 else schema
993 else schema
757− & type_ ?~ SwaggerObject
994+ & type_ ?~ OpenApiObject
758 & properties . at fname ?~ ref
995 & properties . at fname ?~ ref
759 & if isRequiredField
996 & if isRequiredField
760 then required %~ (++ [fname])
997 then required %~ (++ [fname])
@@ -789,14 +1026,14 @@ gdeclareNamedSumSchema opts proxy _
789 | otherwise = do
1026 | otherwise = do
790 (schemas, _) <- runWriterT declareSumSchema
1027 (schemas, _) <- runWriterT declareSumSchema
791 return $ unnamed $ mempty
1028 return $ unnamed $ mempty
792− & type_ ?~ SwaggerObject
1029+ & type_ ?~ OpenApiObject
793 & oneOf ?~ (snd <$> schemas)
1030 & oneOf ?~ (snd <$> schemas)
794 where
1031 where
795 declareSumSchema = gsumToSchema opts proxy
1032 declareSumSchema = gsumToSchema opts proxy
796 (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
1033 (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)
797
1034
798 toStringTag schemas = mempty
1035 toStringTag schemas = mempty
799− & type_ ?~ SwaggerString
1036+ & type_ ?~ OpenApiString
800 & enum_ ?~ map (String . fst) sumSchemas
1037 & enum_ ?~ map (String . fst) sumSchemas
801
1038
802type AllNullary = All
1039type AllNullary = All
@@ -818,15 +1055,15 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
818 case ref of
1055 case ref of
819 -- If subschema is an object and constructor is a record, we add tag directly
1056 -- If subschema is an object and constructor is a record, we add tag directly
820 -- to the record, as Aeson does it.
1057 -- to the record, as Aeson does it.
821− Just (Inline sub) | sub ^. type_ == Just SwaggerObject && isRecord -> Inline $ sub
1058+ Just (Inline sub) | sub ^. type_ == Just OpenApiObject && isRecord -> Inline $ sub
822 & required <>~ [T.pack tagField]
1059 & required <>~ [T.pack tagField]
823− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])
1060+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
824
1061
825 -- If it is not a record, we need to put subschema into "contents" field.
1062 -- If it is not a record, we need to put subschema into "contents" field.
826 _ | not isRecord -> Inline $ mempty
1063 _ | not isRecord -> Inline $ mempty
827− & type_ ?~ SwaggerObject
1064+ & type_ ?~ OpenApiObject
828 & required .~ [T.pack tagField]
1065 & required .~ [T.pack tagField]
829− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])
1066+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])
830 -- If constructor is nullary, there is no content.
1067 -- If constructor is nullary, there is no content.
831 & case ref of
1068 & case ref of
832 Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField])
1069 Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField])
@@ -834,17 +1071,17 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
834
1071
835 -- In the remaining cases we combine "tag" object and "contents" object using allOf.
1072 -- In the remaining cases we combine "tag" object and "contents" object using allOf.
836 _ -> Inline $ mempty
1073 _ -> Inline $ mempty
837− & type_ ?~ SwaggerObject
1074+ & type_ ?~ OpenApiObject
838 & allOf ?~ [Inline $ mempty
1075 & allOf ?~ [Inline $ mempty
839− & type_ ?~ SwaggerObject
1076+ & type_ ?~ OpenApiObject
840 & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])
1077 & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])
841− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])]
1078+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])]
842 & if isRecord
1079 & if isRecord
843 then allOf . _Just <>~ [refOrNullary]
1080 then allOf . _Just <>~ [refOrNullary]
844− else allOf . _Just <>~ [Inline $ mempty & type_ ?~ SwaggerObject & properties . at (T.pack contentsField) ?~ refOrNullary]
1081+ else allOf . _Just <>~ [Inline $ mempty & type_ ?~ OpenApiObject & properties . at (T.pack contentsField) ?~ refOrNullary]
845 UntaggedValue -> refOrEnum -- Aeson encodes nullary constructors as strings in this case.
1082 UntaggedValue -> refOrEnum -- Aeson encodes nullary constructors as strings in this case.
846 ObjectWithSingleField -> Inline $ mempty
1083 ObjectWithSingleField -> Inline $ mempty
847− & type_ ?~ SwaggerObject
1084+ & type_ ?~ OpenApiObject
848 & required .~ [tag]
1085 & required .~ [tag]
849 & properties . at tag ?~ refOrNullary
1086 & properties . at tag ?~ refOrNullary
850 TwoElemArray -> error "unrepresentable in OpenAPI 3"
1087 TwoElemArray -> error "unrepresentable in OpenAPI 3"
@@ -852,7 +1089,7 @@ gsumConToSchemaWith ref opts _ = (tag, schema)
852 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
1089 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
853 isRecord = conIsRecord (Proxy3 :: Proxy3 c f p)
1090 isRecord = conIsRecord (Proxy3 :: Proxy3 c f p)
854 refOrNullary = fromMaybe (Inline nullarySchema) ref
1091 refOrNullary = fromMaybe (Inline nullarySchema) ref
855− refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag]) ref
1092+ refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) ref
856
1093
857gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
1094gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>
858 SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
1095 SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]
@@ -877,7 +1114,13 @@ data Proxy2 a b = Proxy2
877
1114
878data Proxy3 a b c = Proxy3
1115data Proxy3 a b c = Proxy3
879
1116
880−-- $setup
1117+{- $setup
881−-- >>> import Data.Swagger
1118+>>> import Data.OpenApi
882−-- >>> import Data.Aeson (encode)
1119+>>> import Data.Aeson (encode)
883−-- >>> import Data.Aeson.Types (toJSONKeyText)
1120+>>> import Data.Aeson.Types (toJSONKeyText)
1121+>>> import Data.OpenApi.Internal.Utils
1122+>>> :set -XScopedTypeVariables
1123+>>> :set -XDeriveAnyClass
1124+>>> :set -XStandaloneDeriving
1125+>>> :set -XTypeApplications
1126+-}
src/Data/Swagger/Internal/Schema/Validation.hs → src/Data/OpenApi/Internal/Schema/Validation.hsrenamed+85−79
@@ -1,4 +1,5 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2+{-# LANGUAGE CPP #-}
2{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DeriveFunctor #-}
4{-# LANGUAGE DeriveFunctor #-}
4{-# LANGUAGE FlexibleInstances #-}
5{-# LANGUAGE FlexibleInstances #-}
@@ -14,14 +15,14 @@
14{-# LANGUAGE UndecidableInstances #-}
15{-# LANGUAGE UndecidableInstances #-}
15{-# LANGUAGE ViewPatterns #-}
16{-# LANGUAGE ViewPatterns #-}
16-- |
17-- |
17−-- Module: Data.Swagger.Internal.Schema.Validation
18+-- Module: Data.OpenApi.Internal.Schema.Validation
18-- Copyright: (c) 2015 GetShopTV
19-- Copyright: (c) 2015 GetShopTV
19-- License: BSD3
20-- License: BSD3
20-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
21-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
21-- Stability: experimental
22-- Stability: experimental
22--
23--
23-- Validate JSON values with Swagger Schema.
24-- Validate JSON values with Swagger Schema.
24−module Data.Swagger.Internal.Schema.Validation where
25+module Data.OpenApi.Internal.Schema.Validation where
25
26
26import Prelude ()
27import Prelude ()
27import Prelude.Compat
28import Prelude.Compat
@@ -31,11 +32,14 @@ import Control.Lens hiding (allOf)
31import Control.Monad (forM, forM_, when)
32import Control.Monad (forM, forM_, when)
32
33
33import Data.Aeson hiding (Result)
34import Data.Aeson hiding (Result)
34−import Data.Aeson.Encode.Pretty (encodePretty)
35+#if MIN_VERSION_aeson(2,0,0)
36+import qualified Data.Aeson.KeyMap as KeyMap
37+#endif
35import Data.Foldable (for_, sequenceA_,
38import Data.Foldable (for_, sequenceA_,
36 traverse_)
39 traverse_)
40+#if !MIN_VERSION_aeson(2,0,0)
37import Data.HashMap.Strict (HashMap)
41import Data.HashMap.Strict (HashMap)
38−import qualified Data.HashMap.Strict as HashMap
42+#endif
39import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
43import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
40import qualified "unordered-containers" Data.HashSet as HashSet
44import qualified "unordered-containers" Data.HashSet as HashSet
41import Data.Maybe (fromMaybe)
45import Data.Maybe (fromMaybe)
@@ -48,10 +52,12 @@ import qualified Data.Text.Lazy.Encoding as TL
48import Data.Vector (Vector)
52import Data.Vector (Vector)
49import qualified Data.Vector as Vector
53import qualified Data.Vector as Vector
50
54
51−import Data.Swagger.Declare
55+import Data.OpenApi.Aeson.Compat (hasKey, keyToText, lookupKey, objectToList)
56+import Data.OpenApi.Declare
52−import Data.Swagger.Internal
57+import Data.OpenApi.Internal
53−import Data.Swagger.Internal.Schema
58+import Data.OpenApi.Internal.Schema
54−import Data.Swagger.Lens
59+import Data.OpenApi.Internal.Utils
60+import Data.OpenApi.Lens
55
61
56-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
62-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
57-- This can be used with QuickCheck to ensure those instances are coherent:
63-- This can be used with QuickCheck to ensure those instances are coherent:
@@ -103,33 +109,33 @@ validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checke
103-- <BLANKLINE>
109-- <BLANKLINE>
104-- Swagger Schema:
110-- Swagger Schema:
105-- {
111-- {
106−-- "required": [
107−-- "name",
108−-- "phone"
109−-- ],
110−-- "type": "object",
111-- "properties": {
112-- "properties": {
112−-- "phone": {
113−-- "$ref": "#/components/schemas/Phone"
114−-- },
115-- "name": {
113-- "name": {
116-- "type": "string"
114-- "type": "string"
115+-- },
116+-- "phone": {
117+-- "$ref": "#/components/schemas/Phone"
117-- }
118-- }
118−-- }
119+-- },
120+-- "required": [
121+-- "name",
122+-- "phone"
123+-- ],
124+-- "type": "object"
119-- }
125-- }
120-- <BLANKLINE>
126-- <BLANKLINE>
121-- Swagger Description Context:
127-- Swagger Description Context:
122-- {
128-- {
123-- "Phone": {
129-- "Phone": {
124−-- "required": [
125−-- "value"
126−-- ],
127−-- "type": "object",
128-- "properties": {
130-- "properties": {
129-- "value": {
131-- "value": {
130-- "type": "string"
132-- "type": "string"
131-- }
133-- }
132−-- }
134+-- },
135+-- "required": [
136+-- "value"
137+-- ],
138+-- "type": "object"
133-- }
139-- }
134-- }
140-- }
135-- <BLANKLINE>
141-- <BLANKLINE>
@@ -205,7 +211,7 @@ instance Monad Result where
205
211
206-- | Validation configuration.
212-- | Validation configuration.
207data Config = Config
213data Config = Config
208− { -- | Pattern checker for @'_paramSchemaPattern'@ validation.
214+ { -- | Pattern checker for @'_schemaPattern'@ validation.
209 configPatternChecker :: Pattern -> Text -> Bool
215 configPatternChecker :: Pattern -> Text -> Bool
210 -- | Schema definitions in scope to resolve references.
216 -- | Schema definitions in scope to resolve references.
211 , configDefinitions :: Definitions Schema
217 , configDefinitions :: Definitions Schema
@@ -300,38 +306,32 @@ validateWithSchemaRef (Inline s) js = sub s (validateWithSchema js)
300validateWithSchema :: Value -> Validation Schema ()
306validateWithSchema :: Value -> Validation Schema ()
301validateWithSchema val = do
307validateWithSchema val = do
302 validateSchemaType val
308 validateSchemaType val
303− sub_ paramSchema $ validateEnum val
304−
305−-- | Validate JSON @'Value'@ with Swagger @'ParamSchema'@.
306−validateWithParamSchema :: Value -> Validation ParamSchema ()
307−validateWithParamSchema val = do
308− validateParamSchemaType val
309 validateEnum val
309 validateEnum val
310
310
311−validateInteger :: Scientific -> Validation ParamSchema ()
311+validateInteger :: Scientific -> Validation Schema ()
312validateInteger n = do
312validateInteger n = do
313 when (not (isInteger n)) $
313 when (not (isInteger n)) $
314 invalid ("not an integer")
314 invalid ("not an integer")
315 validateNumber n
315 validateNumber n
316
316
317−validateNumber :: Scientific -> Validation ParamSchema ()
317+validateNumber :: Scientific -> Validation Schema ()
318validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do
318validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do
319 let exMax = Just True == sch ^. exclusiveMaximum
319 let exMax = Just True == sch ^. exclusiveMaximum
320 exMin = Just True == sch ^. exclusiveMinimum
320 exMin = Just True == sch ^. exclusiveMinimum
321
321
322 check maximum_ $ \m ->
322 check maximum_ $ \m ->
323 when (if exMax then (n >= m) else (n > m)) $
323 when (if exMax then (n >= m) else (n > m)) $
324− invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ if exMax then "<" else "<=" ++ show m ++ ")")
324+ invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ (if exMax then "<" else "<=") ++ show m ++ ")")
325
325
326 check minimum_ $ \m ->
326 check minimum_ $ \m ->
327 when (if exMin then (n <= m) else (n < m)) $
327 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 ++ ")")
328+ invalid ("value " ++ show n ++ " falls below minimum (should be " ++ (if exMin then ">" else ">=") ++ show m ++ ")")
329
329
330 check multipleOf $ \k ->
330 check multipleOf $ \k ->
331 when (not (isInteger (n / k))) $
331 when (not (isInteger (n / k))) $
332 invalid ("expected a multiple of " ++ show k ++ " but got " ++ show n)
332 invalid ("expected a multiple of " ++ show k ++ " but got " ++ show n)
333
333
334−validateString :: Text -> Validation ParamSchema ()
334+validateString :: Text -> Validation Schema ()
335validateString s = do
335validateString s = do
336 check maxLength $ \n ->
336 check maxLength $ \n ->
337 when (len > fromInteger n) $
337 when (len > fromInteger n) $
@@ -348,7 +348,7 @@ validateString s = do
348 where
348 where
349 len = Text.length s
349 len = Text.length s
350
350
351−validateArray :: Vector Value -> Validation ParamSchema ()
351+validateArray :: Vector Value -> Validation Schema ()
352validateArray xs = do
352validateArray xs = do
353 check maxItems $ \n ->
353 check maxItems $ \n ->
354 when (len > fromInteger n) $
354 when (len > fromInteger n) $
@@ -359,8 +359,8 @@ validateArray xs = do
359 invalid ("array is too short (size should be >=" ++ show n ++ ")")
359 invalid ("array is too short (size should be >=" ++ show n ++ ")")
360
360
361 check items $ \case
361 check items $ \case
362− SwaggerItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs
362+ OpenApiItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs
363− SwaggerItemsArray itemSchemas -> do
363+ OpenApiItemsArray 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,10 +372,16 @@ 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
375−validateObject :: HashMap Text Value -> Validation Schema ()
379+ HashMap Text Value
380+#endif
381+ -> Validation Schema ()
376validateObject o = withSchema $ \sch ->
382validateObject o = withSchema $ \sch ->
377 case sch ^. discriminator of
383 case sch ^. discriminator of
378− Just (Discriminator pname types) -> case fromJSON <$> HashMap.lookup pname o of
384+ Just (Discriminator pname types) -> case fromJSON <$> lookupKey pname o of
379 Just (Success pvalue) ->
385 Just (Success pvalue) ->
380 let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types
386 let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types
381 -- TODO ref may be name or reference
387 -- TODO ref may be name or reference
@@ -394,15 +400,15 @@ validateObject o = withSchema $ \sch ->
394 validateRequired
400 validateRequired
395 validateProps
401 validateProps
396 where
402 where
397− size = fromIntegral (HashMap.size o)
403+ size = fromIntegral (length o)
398
404
399 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)
405 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)
400 validateReq n =
406 validateReq n =
401− when (not (HashMap.member n o)) $
407+ when (not (hasKey n o)) $
402 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))
408 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))
403
409
404 validateProps = withSchema $ \sch -> do
410 validateProps = withSchema $ \sch -> do
405− for_ (HashMap.toList o) $ \(k, v) ->
411+ for_ (objectToList o) $ \(keyToText -> k, v) ->
406 case v of
412 case v of
407 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property
413 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property
408 _ ->
414 _ ->
@@ -418,7 +424,7 @@ validateObject o = withSchema $ \sch ->
418 unknownProperty pname = invalid $
424 unknownProperty pname = invalid $
419 "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"
425 "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"
420
426
421−validateEnum :: Value -> Validation ParamSchema ()
427+validateEnum :: Value -> Validation Schema ()
422validateEnum val = do
428validateEnum val = do
423 check enum_ $ \xs ->
429 check enum_ $ \xs ->
424 when (val `notElem` xs) $
430 when (val `notElem` xs) $
@@ -429,10 +435,10 @@ validateEnum val = do
429-- This is like 'inferParamSchemaTypes', but also works for objects:
435-- This is like 'inferParamSchemaTypes', but also works for objects:
430--
436--
431-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"
437-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"
432−-- Just [SwaggerObject]
438+-- Just [OpenApiObject]
433−inferSchemaTypes :: Schema -> [SwaggerType]
439+inferSchemaTypes :: Schema -> [OpenApiType]
434−inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++
440+inferSchemaTypes sch = inferParamSchemaTypes sch ++
435− [ SwaggerObject | any ($ sch)
441+ [ OpenApiObject | any ($ sch)
436 [ has (additionalProperties._Just)
442 [ has (additionalProperties._Just)
437 , has (maxProperties._Just)
443 , has (maxProperties._Just)
438 , has (minProperties._Just)
444 , has (minProperties._Just)
@@ -442,30 +448,30 @@ inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++
442-- | Infer schema type based on used properties.
448-- | Infer schema type based on used properties.
443--
449--
444-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"
450-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"
445−-- Just [SwaggerString]
451+-- Just [OpenApiString]
446--
452--
447-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"
453-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"
448−-- Just [SwaggerArray]
454+-- Just [OpenApiArray]
449--
455--
450−-- From numeric properties 'SwaggerInteger' type is inferred.
456+-- From numeric properties 'OpenApiInteger' type is inferred.
451−-- If you want 'SwaggerNumber' instead, you must specify it explicitly.
457+-- If you want 'OpenApiNumber' instead, you must specify it explicitly.
452--
458--
453-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"
459-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"
454−-- Just [SwaggerInteger]
460+-- Just [OpenApiInteger]
455−inferParamSchemaTypes :: ParamSchema -> [SwaggerType]
461+inferParamSchemaTypes :: Schema -> [OpenApiType]
456inferParamSchemaTypes sch = concat
462inferParamSchemaTypes sch = concat
457− [ [ SwaggerArray | any ($ sch)
463+ [ [ OpenApiArray | any ($ sch)
458 [ has (items._Just)
464 [ has (items._Just)
459 , has (maxItems._Just)
465 , has (maxItems._Just)
460 , has (minItems._Just)
466 , has (minItems._Just)
461 , has (uniqueItems._Just) ] ]
467 , has (uniqueItems._Just) ] ]
462− , [ SwaggerInteger | any ($ sch)
468+ , [ OpenApiInteger | any ($ sch)
463 [ has (exclusiveMaximum._Just)
469 [ has (exclusiveMaximum._Just)
464 , has (exclusiveMinimum._Just)
470 , has (exclusiveMinimum._Just)
465 , has (maximum_._Just)
471 , has (maximum_._Just)
466 , has (minimum_._Just)
472 , has (minimum_._Just)
467 , has (multipleOf._Just) ] ]
473 , has (multipleOf._Just) ] ]
468− , [ SwaggerString | any ($ sch)
474+ , [ OpenApiString | any ($ sch)
469 [ has (maxLength._Just)
475 [ has (maxLength._Just)
470 , has (minLength._Just)
476 , has (minLength._Just)
471 , has (pattern._Just) ] ]
477 , has (pattern._Just) ] ]
@@ -489,30 +495,30 @@ validateSchemaType val = withSchema $ \sch ->
489
495
490 _ ->
496 _ ->
491 case (sch ^. type_, val) of
497 case (sch ^. type_, val) of
492− (Just SwaggerNull, Null) -> valid
498+ (Just OpenApiNull, Null) -> valid
493− (Just SwaggerBoolean, Bool _) -> valid
499+ (Just OpenApiBoolean, Bool _) -> valid
494− (Just SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)
500+ (Just OpenApiInteger, Number n) -> validateInteger n
495− (Just SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)
501+ (Just OpenApiNumber, Number n) -> validateNumber n
496− (Just SwaggerString, String s) -> sub_ paramSchema (validateString s)
502+ (Just OpenApiString, String s) -> validateString s
497− (Just SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)
503+ (Just OpenApiArray, Array xs) -> validateArray xs
498− (Just SwaggerObject, Object o) -> validateObject o
504+ (Just OpenApiObject, Object o) -> validateObject o
499 (Nothing, Null) -> valid
505 (Nothing, Null) -> valid
500 (Nothing, Bool _) -> valid
506 (Nothing, Bool _) -> valid
501 -- Number by default
507 -- Number by default
502− (Nothing, Number n) -> sub_ paramSchema (validateNumber n)
508+ (Nothing, Number n) -> validateNumber n
503− (Nothing, String s) -> sub_ paramSchema (validateString s)
509+ (Nothing, String s) -> validateString s
504− (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)
510+ (Nothing, Array xs) -> validateArray xs
505 (Nothing, Object o) -> validateObject o
511 (Nothing, Object o) -> validateObject o
506 bad -> invalid $ "expected JSON value of type " ++ showType bad
512 bad -> invalid $ "expected JSON value of type " ++ showType bad
507
513
508−validateParamSchemaType :: Value -> Validation ParamSchema ()
514+validateParamSchemaType :: Value -> Validation Schema ()
509validateParamSchemaType val = withSchema $ \sch ->
515validateParamSchemaType val = withSchema $ \sch ->
510 case (sch ^. type_, val) of
516 case (sch ^. type_, val) of
511− (Just SwaggerBoolean, Bool _) -> valid
517+ (Just OpenApiBoolean, Bool _) -> valid
512− (Just SwaggerInteger, Number n) -> validateInteger n
518+ (Just OpenApiInteger, Number n) -> validateInteger n
513− (Just SwaggerNumber, Number n) -> validateNumber n
519+ (Just OpenApiNumber, Number n) -> validateNumber n
514− (Just SwaggerString, String s) -> validateString s
520+ (Just OpenApiString, String s) -> validateString s
515− (Just SwaggerArray, Array xs) -> validateArray xs
521+ (Just OpenApiArray, Array xs) -> validateArray xs
516 (Nothing, Bool _) -> valid
522 (Nothing, Bool _) -> valid
517 -- Number by default
523 -- Number by default
518 (Nothing, Number n) -> validateNumber n
524 (Nothing, Number n) -> validateNumber n
@@ -520,11 +526,11 @@ validateParamSchemaType val = withSchema $ \sch ->
520 (Nothing, Array xs) -> validateArray xs
526 (Nothing, Array xs) -> validateArray xs
521 bad -> invalid $ "expected JSON value of type " ++ showType bad
527 bad -> invalid $ "expected JSON value of type " ++ showType bad
522
528
523−showType :: (Maybe SwaggerType, Value) -> String
529+showType :: (Maybe OpenApiType, Value) -> String
524showType (Just ty, _) = show ty
530showType (Just ty, _) = show ty
525−showType (Nothing, Null) = "SwaggerNull"
531+showType (Nothing, Null) = "OpenApiNull"
526−showType (Nothing, Bool _) = "SwaggerBoolean"
532+showType (Nothing, Bool _) = "OpenApiBoolean"
527−showType (Nothing, Number _) = "SwaggerNumber"
533+showType (Nothing, Number _) = "OpenApiNumber"
528−showType (Nothing, String _) = "SwaggerString"
534+showType (Nothing, String _) = "OpenApiString"
529−showType (Nothing, Array _) = "SwaggerArray"
535+showType (Nothing, Array _) = "OpenApiArray"
530−showType (Nothing, Object _) = "SwaggerObject"
536+showType (Nothing, Object _) = "OpenApiObject"
src/Data/Swagger/Internal/TypeShape.hs → src/Data/OpenApi/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.Swagger.Internal.TypeShape where
7+module Data.OpenApi.Internal.TypeShape where
8
8
9import Data.Proxy
9import Data.Proxy
10import GHC.Generics
10import GHC.Generics
src/Data/Swagger/Internal/Utils.hs → src/Data/OpenApi/Internal/Utils.hsrenamed+6−1
@@ -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.Swagger.Internal.Utils where
7+module Data.OpenApi.Internal.Utils where
8
8
9import Prelude ()
9import Prelude ()
10import Prelude.Compat
10import Prelude.Compat
@@ -13,6 +13,8 @@ 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
16import Data.Char
18import Data.Char
17import Data.Data
19import Data.Data
18import Data.Hashable (Hashable)
20import Data.Hashable (Hashable)
@@ -132,3 +134,6 @@ instance SwaggerMonoid (Maybe a) where
132 swaggerMempty = Nothing
134 swaggerMempty = Nothing
133 swaggerMappend x Nothing = x
135 swaggerMappend x Nothing = x
134 swaggerMappend _ y = y
136 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.hs → src/Data/OpenApi/Lens.hsrenamed+49−58
@@ -10,27 +10,25 @@
10{-# LANGUAGE UndecidableInstances #-}
10{-# LANGUAGE UndecidableInstances #-}
11{-# OPTIONS_GHC -fno-warn-orphans #-}
11{-# OPTIONS_GHC -fno-warn-orphans #-}
12-- |
12-- |
13−-- Module: Data.Swagger.Lens
13+-- Module: Data.OpenApi.Lens
14-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
14-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>
15-- Stability: experimental
15-- Stability: experimental
16--
16--
17-- Lenses and prisms for Swagger.
17-- Lenses and prisms for Swagger.
18−module Data.Swagger.Lens where
18+module Data.OpenApi.Lens where
19
19
20import Control.Lens
20import Control.Lens
21import Data.Aeson (Value)
21import Data.Aeson (Value)
22import Data.Scientific (Scientific)
22import Data.Scientific (Scientific)
23−import Data.Swagger.Internal
23+import Data.OpenApi.Internal
24−import Data.Swagger.Internal.Utils
24+import Data.OpenApi.Internal.Utils
25import Data.Text (Text)
25import Data.Text (Text)
26
26
27-- * Classy lenses
27-- * Classy lenses
28
28
29−makeFields ''Swagger
29+makeFields ''OpenApi
30makeFields ''Components
30makeFields ''Components
31makeFields ''Server
31makeFields ''Server
32−-- conflict with enum of ParamSchema
33−--makeLensesWith swaggerFieldRules ''ServerVariable
34makeFields ''RequestBody
32makeFields ''RequestBody
35makeFields ''MediaTypeObject
33makeFields ''MediaTypeObject
36makeFields ''Info
34makeFields ''Info
@@ -43,7 +41,6 @@ makeLensesWith swaggerFieldRules ''Param
43makeFields ''Header
41makeFields ''Header
44makeLensesWith swaggerFieldRules ''Schema
42makeLensesWith swaggerFieldRules ''Schema
45makeFields ''NamedSchema
43makeFields ''NamedSchema
46−makeLensesWith swaggerFieldRules ''ParamSchema
47makeFields ''Xml
44makeFields ''Xml
48makeLensesWith swaggerFieldRules ''Responses
45makeLensesWith swaggerFieldRules ''Responses
49makeFields ''Response
46makeFields ''Response
@@ -59,6 +56,7 @@ makeFields ''ExternalDocs
59makeFields ''Encoding
56makeFields ''Encoding
60makeFields ''Example
57makeFields ''Example
61makeFields ''Discriminator
58makeFields ''Discriminator
59+makeFields ''Link
62
60
63-- * Prisms
61-- * Prisms
64-- ** 'SecuritySchemeType' prisms
62-- ** 'SecuritySchemeType' prisms
@@ -66,24 +64,24 @@ makePrisms ''SecuritySchemeType
66-- ** 'Referenced' prisms
64-- ** 'Referenced' prisms
67makePrisms ''Referenced
65makePrisms ''Referenced
68
66
69−-- ** 'SwaggerItems' prisms
67+-- ** 'OpenApiItems' prisms
70
68
71−_SwaggerItemsArray :: Review SwaggerItems [Referenced Schema]
69+_OpenApiItemsArray :: Review OpenApiItems [Referenced Schema]
72−_SwaggerItemsArray
70+_OpenApiItemsArray
73− = unto (\x -> SwaggerItemsArray x)
71+ = unto (\x -> OpenApiItemsArray x)
74{- \x -> case x of
72{- \x -> case x of
75− SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)
73+ OpenApiItemsPrimitive c p -> Left (OpenApiItemsPrimitive c p)
76− SwaggerItemsObject o -> Left (SwaggerItemsObject o)
74+ OpenApiItemsObject o -> Left (OpenApiItemsObject o)
77− SwaggerItemsArray a -> Right a
75+ OpenApiItemsArray a -> Right a
78-}
76-}
79
77
80−_SwaggerItemsObject :: Review SwaggerItems (Referenced Schema)
78+_OpenApiItemsObject :: Review OpenApiItems (Referenced Schema)
81−_SwaggerItemsObject
79+_OpenApiItemsObject
82− = unto (\x -> SwaggerItemsObject x)
80+ = unto (\x -> OpenApiItemsObject x)
83{- \x -> case x of
81{- \x -> case x of
84− SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)
82+ OpenApiItemsPrimitive c p -> Left (OpenApiItemsPrimitive c p)
85− SwaggerItemsObject o -> Right o
83+ OpenApiItemsObject o -> Right o
86− SwaggerItemsArray a -> Left (SwaggerItemsArray a)
84+ OpenApiItemsArray a -> Left (OpenApiItemsArray a)
87-}
85-}
88
86
89-- =============================================================
87-- =============================================================
@@ -101,75 +99,68 @@ instance At Responses where at n = responses . at n
101instance Ixed Operation where ix n = responses . ix n
99instance Ixed Operation where ix n = responses . ix n
102instance At Operation where at n = responses . at n
100instance At Operation where at n = responses . at n
103
101
104−instance HasParamSchema NamedSchema ParamSchema where paramSchema = schema.paramSchema
102+instance HasType NamedSchema (Maybe OpenApiType) where type_ = schema.type_
105−
106−-- HasType instances
107−instance HasType Schema (Maybe SwaggerType) where type_ = paramSchema.type_
108−instance HasType NamedSchema (Maybe SwaggerType) where type_ = paramSchema.type_
109−
110−-- HasDefault instances
111−instance HasDefault Schema (Maybe Value) where default_ = paramSchema.default_
112
103
113-- OVERLAPPABLE instances
104-- OVERLAPPABLE instances
114
105
115instance
106instance
116 {-# OVERLAPPABLE #-}
107 {-# OVERLAPPABLE #-}
117− HasParamSchema s ParamSchema
108+ HasSchema s Schema
118 => HasFormat s (Maybe Format) where
109 => HasFormat s (Maybe Format) where
119− format = paramSchema.format
110+ format = schema.format
120
111
121instance
112instance
122 {-# OVERLAPPABLE #-}
113 {-# OVERLAPPABLE #-}
123− HasParamSchema s ParamSchema
114+ HasSchema s Schema
124− => HasItems s (Maybe SwaggerItems) where
115+ => HasItems s (Maybe OpenApiItems) where
125− items = paramSchema.items
116+ items = schema.items
126
117
127instance
118instance
128 {-# OVERLAPPABLE #-}
119 {-# OVERLAPPABLE #-}
129− HasParamSchema s ParamSchema
120+ HasSchema s Schema
130 => HasMaximum s (Maybe Scientific) where
121 => HasMaximum s (Maybe Scientific) where
131− maximum_ = paramSchema.maximum_
122+ maximum_ = schema.maximum_
132
123
133−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
124+instance {-# OVERLAPPABLE #-} HasSchema s Schema
134 => HasExclusiveMaximum s (Maybe Bool) where
125 => HasExclusiveMaximum s (Maybe Bool) where
135− exclusiveMaximum = paramSchema.exclusiveMaximum
126+ exclusiveMaximum = schema.exclusiveMaximum
136
127
137−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
128+instance {-# OVERLAPPABLE #-} HasSchema s Schema
138 => HasMinimum s (Maybe Scientific) where
129 => HasMinimum s (Maybe Scientific) where
139− minimum_ = paramSchema.minimum_
130+ minimum_ = schema.minimum_
140
131
141−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
132+instance {-# OVERLAPPABLE #-} HasSchema s Schema
142 => HasExclusiveMinimum s (Maybe Bool) where
133 => HasExclusiveMinimum s (Maybe Bool) where
143− exclusiveMinimum = paramSchema.exclusiveMinimum
134+ exclusiveMinimum = schema.exclusiveMinimum
144
135
145−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
136+instance {-# OVERLAPPABLE #-} HasSchema s Schema
146 => HasMaxLength s (Maybe Integer) where
137 => HasMaxLength s (Maybe Integer) where
147− maxLength = paramSchema.maxLength
138+ maxLength = schema.maxLength
148
139
149−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
140+instance {-# OVERLAPPABLE #-} HasSchema s Schema
150 => HasMinLength s (Maybe Integer) where
141 => HasMinLength s (Maybe Integer) where
151− minLength = paramSchema.minLength
142+ minLength = schema.minLength
152
143
153−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
144+instance {-# OVERLAPPABLE #-} HasSchema s Schema
154 => HasPattern s (Maybe Text) where
145 => HasPattern s (Maybe Text) where
155− pattern = paramSchema.pattern
146+ pattern = schema.pattern
156
147
157−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
148+instance {-# OVERLAPPABLE #-} HasSchema s Schema
158 => HasMaxItems s (Maybe Integer) where
149 => HasMaxItems s (Maybe Integer) where
159− maxItems = paramSchema.maxItems
150+ maxItems = schema.maxItems
160
151
161−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
152+instance {-# OVERLAPPABLE #-} HasSchema s Schema
162 => HasMinItems s (Maybe Integer) where
153 => HasMinItems s (Maybe Integer) where
163− minItems = paramSchema.minItems
154+ minItems = schema.minItems
164
155
165−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
156+instance {-# OVERLAPPABLE #-} HasSchema s Schema
166 => HasUniqueItems s (Maybe Bool) where
157 => HasUniqueItems s (Maybe Bool) where
167− uniqueItems = paramSchema.uniqueItems
158+ uniqueItems = schema.uniqueItems
168
159
169−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
160+instance {-# OVERLAPPABLE #-} HasSchema s Schema
170 => HasEnum s (Maybe [Value]) where
161 => HasEnum s (Maybe [Value]) where
171− enum_ = paramSchema.enum_
162+ enum_ = schema.enum_
172
163
173−instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema
164+instance {-# OVERLAPPABLE #-} HasSchema s Schema
174 => HasMultipleOf s (Maybe Scientific) where
165 => HasMultipleOf s (Maybe Scientific) where
175− multipleOf = paramSchema.multipleOf
166+ multipleOf = schema.multipleOf
src/Data/Swagger/Operation.hs → src/Data/OpenApi/Operation.hsrenamed+138−30
@@ -1,13 +1,13 @@
1{-# LANGUAGE RankNTypes #-}
1{-# LANGUAGE RankNTypes #-}
2-- |
2-- |
3−-- Module: Data.Swagger.Operation
3+-- Module: Data.OpenApi.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.Swagger.Operation (
10+module Data.OpenApi.Operation (
11 -- * Operation traversals
11 -- * Operation traversals
12 allOperations,
12 allOperations,
13 operationsOf,
13 operationsOf,
@@ -40,11 +40,12 @@ 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)
43
44
44−import Data.Swagger.Declare
45+import Data.OpenApi.Declare
45−import Data.Swagger.Internal
46+import Data.OpenApi.Internal
46−import Data.Swagger.Lens
47+import Data.OpenApi.Lens
47−import Data.Swagger.Schema
48+import Data.OpenApi.Schema
48
49
49import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
50import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
50import qualified Data.HashSet.InsOrd as InsOrdHS
51import qualified Data.HashSet.InsOrd as InsOrdHS
@@ -54,14 +55,17 @@ import qualified Data.HashSet.InsOrd as InsOrdHS
54-- >>> import Data.Proxy
55-- >>> import Data.Proxy
55-- >>> import Data.Time
56-- >>> import Data.Time
56-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
57-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
58+-- >>> import Data.OpenApi.Internal.Utils
57
59
58-- | Prepend path piece to all operations of the spec.
60-- | Prepend path piece to all operations of the spec.
59-- Leading and trailing slashes are trimmed/added automatically.
61-- Leading and trailing slashes are trimmed/added automatically.
60--
62--
61−-- >>> let api = (mempty :: Swagger) & paths .~ [("/info", mempty)]
63+-- >>> let api = (mempty :: OpenApi) & paths .~ [("/info", mempty)]
62−-- >>> BSL.putStrLn $ encode $ prependPath "user/{user_id}" api ^. paths
64+-- >>> BSL.putStrLn $ encodePretty $ prependPath "user/{user_id}" api ^. paths
65+-- {
63−-- {"/user/{user_id}/info":{}}
66+-- "/user/{user_id}/info": {}
67+-- }
64−prependPath :: FilePath -> Swagger -> Swagger
68+prependPath :: FilePath -> OpenApi -> OpenApi
65prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
69prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
66 where
70 where
67 x </> y = case trim y of
71 x </> y = case trim y of
@@ -71,7 +75,7 @@ prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
71 trim = dropWhile (== '/') . dropWhileEnd (== '/')
75 trim = dropWhile (== '/') . dropWhileEnd (== '/')
72
76
73-- | All operations of a Swagger spec.
77-- | All operations of a Swagger spec.
74−allOperations :: Traversal' Swagger Operation
78+allOperations :: Traversal' OpenApi Operation
75allOperations = paths.traverse.template
79allOperations = paths.traverse.template
76
80
77-- | @'operationsOf' sub@ will traverse only those operations
81-- | @'operationsOf' sub@ will traverse only those operations
@@ -79,13 +83,66 @@ allOperations = paths.traverse.template
79-- by both path and method.
83-- by both path and method.
80--
84--
81-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
85-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
82−-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
86+-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
83−-- >>> let sub = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
87+-- >>> let sub = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]
84−-- >>> BSL.putStrLn $ encode api
88+-- >>> BSL.putStrLn $ encodePretty api
85−-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"200":{"description":"OK"}}},"post":{"responses":{"200":{"description":"OK"}}}}},"components":{}}
89+-- {
90+-- "components": {},
91+-- "info": {
92+-- "title": "",
93+-- "version": ""
94+-- },
95+-- "openapi": "3.0.0",
96+-- "paths": {
97+-- "/user": {
98+-- "get": {
99+-- "responses": {
100+-- "200": {
101+-- "description": "OK"
102+-- }
103+-- }
104+-- },
105+-- "post": {
106+-- "responses": {
107+-- "200": {
108+-- "description": "OK"
109+-- }
110+-- }
111+-- }
112+-- }
113+-- }
114+-- }
86−-- >>> BSL.putStrLn $ encode $ api & operationsOf sub . at 404 ?~ "Not found"
115+-- >>> BSL.putStrLn $ encodePretty $ api & operationsOf sub . at 404 ?~ "Not found"
87−-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"404":{"description":"Not found"},"200":{"description":"OK"}}},"post":{"responses":{"200":{"description":"OK"}}}}},"components":{}}
116+-- {
117+-- "components": {},
118+-- "info": {
119+-- "title": "",
120+-- "version": ""
121+-- },
122+-- "openapi": "3.0.0",
123+-- "paths": {
124+-- "/user": {
125+-- "get": {
126+-- "responses": {
127+-- "200": {
128+-- "description": "OK"
129+-- },
130+-- "404": {
131+-- "description": "Not found"
132+-- }
133+-- }
134+-- },
135+-- "post": {
136+-- "responses": {
137+-- "200": {
138+-- "description": "OK"
139+-- }
140+-- }
141+-- }
142+-- }
143+-- }
144+-- }
88−operationsOf :: Swagger -> Traversal' Swagger Operation
145+operationsOf :: OpenApi -> Traversal' OpenApi Operation
89operationsOf sub = paths.itraversed.withIndex.subops
146operationsOf sub = paths.itraversed.withIndex.subops
90 where
147 where
91 -- | Traverse operations that correspond to paths and methods of the sub API.
148 -- | Traverse operations that correspond to paths and methods of the sub API.
@@ -107,12 +164,12 @@ operationsOf sub = paths.itraversed.withIndex.subops
107-- @
164-- @
108-- 'applyTags' = 'applyTagsFor' 'allOperations'
165-- 'applyTags' = 'applyTagsFor' 'allOperations'
109-- @
166-- @
110−applyTags :: [Tag] -> Swagger -> Swagger
167+applyTags :: [Tag] -> OpenApi -> OpenApi
111applyTags = applyTagsFor allOperations
168applyTags = applyTagsFor allOperations
112
169
113-- | Apply tags to a part of Swagger spec and update the global
170-- | Apply tags to a part of Swagger spec and update the global
114-- list of tags.
171-- list of tags.
115−applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger
172+applyTagsFor :: Traversal' OpenApi Operation -> [Tag] -> OpenApi -> OpenApi
116applyTagsFor ops ts swag = swag
173applyTagsFor ops ts swag = swag
117 & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))
174 & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))
118 & tags %~ (<> InsOrdHS.fromList ts)
175 & tags %~ (<> InsOrdHS.fromList ts)
@@ -122,9 +179,27 @@ applyTagsFor ops ts swag = swag
122--
179--
123-- FIXME doc
180-- FIXME doc
124--
181--
125−-- >>> BSL.putStrLn $ encode $ runDeclare (declareResponse "application/json" (Proxy :: Proxy Day)) mempty
182+-- >>> BSL.putStrLn $ encodePretty $ runDeclare (declareResponse "application/json" (Proxy :: Proxy Day)) mempty
126−-- [{"Day":{"example":"2016-07-22","format":"date","type":"string"}},{"description":"","content":{"application/json":{"schema":{"$ref":"#/components/schemas/Day"}}}}]
183+-- [
184+-- {
185+-- "Day": {
186+-- "example": "2016-07-22",
187+-- "format": "date",
188+-- "type": "string"
189+-- }
190+-- },
191+-- {
192+-- "content": {
193+-- "application/json": {
194+-- "schema": {
195+-- "$ref": "#/components/schemas/Day"
196+-- }
197+-- }
198+-- },
199+-- "description": ""
200+-- }
201+-- ]
127−declareResponse :: ToSchema a => Text -> Proxy a -> Declare (Definitions Schema) Response
202+declareResponse :: ToSchema a => MediaType -> Proxy a -> Declare (Definitions Schema) Response
128declareResponse cType proxy = do
203declareResponse cType proxy = do
129 s <- declareSchemaRef proxy
204 s <- declareSchemaRef proxy
130 return (mempty & content.at cType ?~ (mempty & schema ?~ s))
205 return (mempty & content.at cType ?~ (mempty & schema ?~ s))
@@ -140,13 +215,46 @@ declareResponse cType proxy = do
140--
215--
141-- Example:
216-- Example:
142--
217--
143−-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]
218+-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]
144-- >>> let res = declareResponse "application/json" (Proxy :: Proxy Day)
219-- >>> let res = declareResponse "application/json" (Proxy :: Proxy Day)
145−-- >>> BSL.putStrLn $ encode $ api & setResponse 200 res
220+-- >>> BSL.putStrLn $ encodePretty $ api & setResponse 200 res
146−-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"200":{"content":{"application/json":{"schema":{"$ref":"#/components/schemas/Day"}}},"description":""}}}}},"components":{"schemas":{"Day":{"example":"2016-07-22","format":"date","type":"string"}}}}
221+-- {
222+-- "components": {
223+-- "schemas": {
224+-- "Day": {
225+-- "example": "2016-07-22",
226+-- "format": "date",
227+-- "type": "string"
228+-- }
229+-- }
230+-- },
231+-- "info": {
232+-- "title": "",
233+-- "version": ""
234+-- },
235+-- "openapi": "3.0.0",
236+-- "paths": {
237+-- "/user": {
238+-- "get": {
239+-- "responses": {
240+-- "200": {
241+-- "content": {
242+-- "application/json": {
243+-- "schema": {
244+-- "$ref": "#/components/schemas/Day"
245+-- }
246+-- }
247+-- },
248+-- "description": ""
249+-- }
250+-- }
251+-- }
252+-- }
253+-- }
254+-- }
147--
255--
148-- See also @'setResponseWith'@.
256-- See also @'setResponseWith'@.
149−setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
257+setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
150setResponse = setResponseFor allOperations
258setResponse = setResponseFor allOperations
151
259
152-- | Set or update response for all operations.
260-- | Set or update response for all operations.
@@ -160,7 +268,7 @@ setResponse = setResponseFor allOperations
160-- @
268-- @
161--
269--
162-- See also @'setResponse'@.
270-- See also @'setResponse'@.
163−setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
271+setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
164setResponseWith = setResponseForWith allOperations
272setResponseWith = setResponseForWith allOperations
165
273
166-- | Set response for specified operations.
274-- | Set response for specified operations.
@@ -169,7 +277,7 @@ setResponseWith = setResponseForWith allOperations
169-- If the response already exists it will be overwritten.
277-- If the response already exists it will be overwritten.
170--
278--
171-- See also @'setResponseForWith'@.
279-- See also @'setResponseForWith'@.
172−setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
280+setResponseFor :: Traversal' OpenApi Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
173setResponseFor ops code dres swag = swag
281setResponseFor ops code dres swag = swag
174 & components.schemas %~ (<> defs)
282 & components.schemas %~ (<> defs)
175 & ops . at code ?~ Inline res
283 & ops . at code ?~ Inline res
@@ -183,7 +291,7 @@ setResponseFor ops code dres swag = swag
183-- then just the new response is used.
291-- then just the new response is used.
184--
292--
185-- See also @'setResponseFor'@.
293-- See also @'setResponseFor'@.
186−setResponseForWith :: Traversal' Swagger Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger
294+setResponseForWith :: Traversal' OpenApi Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
187setResponseForWith ops f code dres swag = swag
295setResponseForWith ops f code dres swag = swag
188 & components.schemas %~ (<> defs)
296 & components.schemas %~ (<> defs)
189 & ops . at code %~ Just . Inline . combine
297 & ops . at code %~ Just . Inline . combine
src/Data/Swagger/Optics.hs → src/Data/OpenApi/Optics.hsrenamed+91−153
@@ -7,7 +7,7 @@
7{-# LANGUAGE UndecidableInstances #-}
7{-# LANGUAGE UndecidableInstances #-}
8{-# OPTIONS_GHC -fno-warn-orphans #-}
8{-# OPTIONS_GHC -fno-warn-orphans #-}
9-- |
9-- |
10−-- Module: Data.Swagger.Optics
10+-- Module: Data.OpenApi.Optics
11-- Maintainer: Andrzej Rybczak <andrzej@rybczak.net>
11-- Maintainer: Andrzej Rybczak <andrzej@rybczak.net>
12-- Stability: experimental
12-- Stability: experimental
13--
13--
@@ -19,53 +19,98 @@
19-- >>> :set -XOverloadedLabels
19-- >>> :set -XOverloadedLabels
20-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
20-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
21--
21--
22−-- Example from the "Data.Swagger" module using @optics@:
22+-- Example from the "Data.OpenApi" module using @optics@:
23--
23--
24-- >>> :{
24-- >>> :{
25−-- BSL.putStrLn $ encode $ (mempty :: Swagger)
25+-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
26−-- & #components % #schemas .~ [ ("User", mempty & #type ?~ SwaggerString) ]
26+-- & #components % #schemas .~ [ ("User", mempty & #type ?~ OpenApiString) ]
27-- & #paths .~
27-- & #paths .~
28-- [ ("/user", mempty & #get ?~ (mempty
28-- [ ("/user", mempty & #get ?~ (mempty
29-- & at 200 ?~ ("OK" & #_Inline % #content % at "application/json" ?~ (mempty & #schema ?~ Ref (Reference "User")))
29-- & at 200 ?~ ("OK" & #_Inline % #content % at "application/json" ?~ (mempty & #schema ?~ Ref (Reference "User")))
30-- & at 404 ?~ "User info not found")) ]
30-- & at 404 ?~ "User info not found")) ]
31-- :}
31-- :}
32−-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"404":{"description":"User info not found"},"200":{"content":{"application/json":{"schema":{"$ref":"#/components/schemas/User"}}},"description":"OK"}}}}},"components":{"schemas":{"User":{"type":"string"}}}}
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+-- }
33--
67--
34-- For convenience optics are defined as /labels/. It means that field accessor
68-- 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
69-- names can be overloaded for different types. One such common field is
36-- @#description@. Many components of a Swagger specification can have
70-- @#description@. Many components of a Swagger specification can have
37-- descriptions, and you can use the same name for them:
71-- descriptions, and you can use the same name for them:
38--
72--
39−-- >>> BSL.putStrLn $ encode $ (mempty :: Response) & #description .~ "No content"
73+-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & #description .~ "No content"
74+-- {
40−-- {"description":"No content"}
75+-- "description": "No content"
76+-- }
41-- >>> :{
77-- >>> :{
42−-- BSL.putStrLn $ encode $ (mempty :: Schema)
78+-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)
43−-- & #type ?~ SwaggerBoolean
79+-- & #type ?~ OpenApiBoolean
44-- & #description ?~ "To be or not to be"
80-- & #description ?~ "To be or not to be"
45-- :}
81-- :}
82+-- {
46−-- {"description":"To be or not to be","type":"boolean"}
83+-- "description": "To be or not to be",
84+-- "type": "boolean"
85+-- }
47--
86--
48-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and
87-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and
49-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:
88-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:
50--
89--
51-- >>> :{
90-- >>> :{
52−-- BSL.putStrLn $ encode $ (mempty :: Operation)
91+-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)
53-- & at 404 ?~ "Not found"
92-- & at 404 ?~ "Not found"
54-- :}
93-- :}
94+-- {
95+-- "responses": {
96+-- "404": {
55−-- {"responses":{"404":{"description":"Not found"}}}
97+-- "description": "Not found"
98+-- }
99+-- }
56−--
100+-- }
57−module Data.Swagger.Optics () where
101+module Data.OpenApi.Optics () where
58
102
59import Data.Aeson (Value)
103import Data.Aeson (Value)
60import Data.Scientific (Scientific)
104import Data.Scientific (Scientific)
61−import Data.Swagger.Internal
105+import Data.OpenApi.Internal
106+import Data.OpenApi.Internal.Utils
62import Data.Text (Text)
107import Data.Text (Text)
63import Optics.Core
108import Optics.Core
64import Optics.TH
109import Optics.TH
65
110
66-- Lenses
111-- Lenses
67
112
68−makeFieldLabels ''Swagger
113+makeFieldLabels ''OpenApi
69makeFieldLabels ''Components
114makeFieldLabels ''Components
70makeFieldLabels ''Server
115makeFieldLabels ''Server
71makeFieldLabels ''ServerVariable
116makeFieldLabels ''ServerVariable
@@ -81,7 +126,6 @@ makeFieldLabels ''Param
81makeFieldLabels ''Header
126makeFieldLabels ''Header
82makeFieldLabels ''Schema
127makeFieldLabels ''Schema
83makeFieldLabels ''NamedSchema
128makeFieldLabels ''NamedSchema
84−makeFieldLabels ''ParamSchema
85makeFieldLabels ''Xml
129makeFieldLabels ''Xml
86makeFieldLabels ''Responses
130makeFieldLabels ''Responses
87makeFieldLabels ''Response
131makeFieldLabels ''Response
@@ -97,36 +141,37 @@ makeFieldLabels ''ExternalDocs
97makeFieldLabels ''Encoding
141makeFieldLabels ''Encoding
98makeFieldLabels ''Example
142makeFieldLabels ''Example
99makeFieldLabels ''Discriminator
143makeFieldLabels ''Discriminator
144+makeFieldLabels ''Link
100
145
101-- Prisms
146-- Prisms
102
147
103makePrismLabels ''SecuritySchemeType
148makePrismLabels ''SecuritySchemeType
104makePrismLabels ''Referenced
149makePrismLabels ''Referenced
105
150
106−-- SwaggerItems prisms
151+-- OpenApiItems prisms
107
152
108instance
153instance
109 ( a ~ [Referenced Schema]
154 ( a ~ [Referenced Schema]
110 , b ~ [Referenced Schema]
155 , b ~ [Referenced Schema]
111− ) => LabelOptic "_SwaggerItemsArray"
156+ ) => LabelOptic "_OpenApiItemsArray"
112 A_Review
157 A_Review
113− SwaggerItems
158+ OpenApiItems
114− SwaggerItems
159+ OpenApiItems
115 a
160 a
116 b where
161 b where
117− labelOptic = unto (\x -> SwaggerItemsArray x)
162+ labelOptic = unto (\x -> OpenApiItemsArray x)
118 {-# INLINE labelOptic #-}
163 {-# INLINE labelOptic #-}
119
164
120instance
165instance
121 ( a ~ Referenced Schema
166 ( a ~ Referenced Schema
122 , b ~ Referenced Schema
167 , b ~ Referenced Schema
123− ) => LabelOptic "_SwaggerItemsObject"
168+ ) => LabelOptic "_OpenApiItemsObject"
124 A_Review
169 A_Review
125− SwaggerItems
170+ OpenApiItems
126− SwaggerItems
171+ OpenApiItems
127 a
172 a
128 b where
173 b where
129− labelOptic = unto (\x -> SwaggerItemsObject x)
174+ labelOptic = unto (\x -> OpenApiItemsObject x)
130 {-# INLINE labelOptic #-}
175 {-# INLINE labelOptic #-}
131
176
132-- =============================================================
177-- =============================================================
@@ -152,239 +197,132 @@ instance At Operation where
152 at n = #responses % at n
197 at n = #responses % at n
153 {-# INLINE at #-}
198 {-# INLINE at #-}
154
199
155−-- #paramSchema
156−
157−instance
158− ( a ~ ParamSchema
159− , b ~ ParamSchema
160− ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where
161− labelOptic = #schema % #paramSchema
162− {-# INLINE labelOptic #-}
163−
164-- #type
200-- #type
165
201
166instance
202instance
167− ( a ~ Maybe SwaggerType
203+ ( a ~ Maybe OpenApiType
168− , b ~ Maybe SwaggerType
204+ , b ~ Maybe OpenApiType
169− ) => LabelOptic "type" A_Lens Schema Schema a b where
170− labelOptic = #paramSchema % #type
171− {-# INLINE labelOptic #-}
172−
173−instance
174− ( a ~ Maybe SwaggerType
175− , b ~ Maybe SwaggerType
176 ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where
205 ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where
177− labelOptic = #paramSchema % #type
206+ labelOptic = #schema % #type
178 {-# INLINE labelOptic #-}
207 {-# INLINE labelOptic #-}
179
208
180-- #default
209-- #default
181
210
182−instance
183− ( a ~ Maybe Value, b ~ Maybe Value
184− ) => LabelOptic "default" A_Lens Schema Schema a b where
185− labelOptic = #paramSchema % #default
186− {-# INLINE labelOptic #-}
187−
188instance
211instance
189 ( a ~ Maybe Value, b ~ Maybe Value
212 ( a ~ Maybe Value, b ~ Maybe Value
190 ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where
213 ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where
191− labelOptic = #paramSchema % #default
214+ labelOptic = #schema % #default
192 {-# INLINE labelOptic #-}
215 {-# INLINE labelOptic #-}
193
216
194-- #format
217-- #format
195
218
196−instance
197− ( a ~ Maybe Format, b ~ Maybe Format
198− ) => LabelOptic "format" A_Lens Schema Schema a b where
199− labelOptic = #paramSchema % #format
200− {-# INLINE labelOptic #-}
201−
202instance
219instance
203 ( a ~ Maybe Format, b ~ Maybe Format
220 ( a ~ Maybe Format, b ~ Maybe Format
204 ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where
221 ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where
205− labelOptic = #paramSchema % #format
222+ labelOptic = #schema % #format
206 {-# INLINE labelOptic #-}
223 {-# INLINE labelOptic #-}
207
224
208-- #items
225-- #items
209
226
210instance
227instance
211− ( a ~ Maybe SwaggerItems
228+ ( a ~ Maybe OpenApiItems
212− , b ~ Maybe SwaggerItems
229+ , b ~ Maybe OpenApiItems
213− ) => LabelOptic "items" A_Lens Schema Schema a b where
214− labelOptic = #paramSchema % #items
215− {-# INLINE labelOptic #-}
216−
217−instance
218− ( a ~ Maybe SwaggerItems
219− , b ~ Maybe SwaggerItems
220 ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where
230 ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where
221− labelOptic = #paramSchema % #items
231+ labelOptic = #schema % #items
222 {-# INLINE labelOptic #-}
232 {-# INLINE labelOptic #-}
223
233
224-- #maximum
234-- #maximum
225
235
226−instance
227− ( a ~ Maybe Scientific, b ~ Maybe Scientific
228− ) => LabelOptic "maximum" A_Lens Schema Schema a b where
229− labelOptic = #paramSchema % #maximum
230− {-# INLINE labelOptic #-}
231−
232instance
236instance
233 ( a ~ Maybe Scientific, b ~ Maybe Scientific
237 ( a ~ Maybe Scientific, b ~ Maybe Scientific
234 ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where
238 ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where
235− labelOptic = #paramSchema % #maximum
239+ labelOptic = #schema % #maximum
236 {-# INLINE labelOptic #-}
240 {-# INLINE labelOptic #-}
237
241
238-- #exclusiveMaximum
242-- #exclusiveMaximum
239
243
240−instance
241− ( a ~ Maybe Bool, b ~ Maybe Bool
242− ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where
243− labelOptic = #paramSchema % #exclusiveMaximum
244− {-# INLINE labelOptic #-}
245−
246instance
244instance
247 ( a ~ Maybe Bool, b ~ Maybe Bool
245 ( a ~ Maybe Bool, b ~ Maybe Bool
248 ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where
246 ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where
249− labelOptic = #paramSchema % #exclusiveMaximum
247+ labelOptic = #schema % #exclusiveMaximum
250 {-# INLINE labelOptic #-}
248 {-# INLINE labelOptic #-}
251
249
252-- #minimum
250-- #minimum
253
251
254−instance
255− ( a ~ Maybe Scientific, b ~ Maybe Scientific
256− ) => LabelOptic "minimum" A_Lens Schema Schema a b where
257− labelOptic = #paramSchema % #minimum
258− {-# INLINE labelOptic #-}
259−
260instance
252instance
261 ( a ~ Maybe Scientific, b ~ Maybe Scientific
253 ( a ~ Maybe Scientific, b ~ Maybe Scientific
262 ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where
254 ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where
263− labelOptic = #paramSchema % #minimum
255+ labelOptic = #schema % #minimum
264 {-# INLINE labelOptic #-}
256 {-# INLINE labelOptic #-}
265
257
266-- #exclusiveMinimum
258-- #exclusiveMinimum
267
259
268−instance
269− ( a ~ Maybe Bool, b ~ Maybe Bool
270− ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where
271− labelOptic = #paramSchema % #exclusiveMinimum
272− {-# INLINE labelOptic #-}
273−
274instance
260instance
275 ( a ~ Maybe Bool, b ~ Maybe Bool
261 ( a ~ Maybe Bool, b ~ Maybe Bool
276 ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where
262 ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where
277− labelOptic = #paramSchema % #exclusiveMinimum
263+ labelOptic = #schema % #exclusiveMinimum
278 {-# INLINE labelOptic #-}
264 {-# INLINE labelOptic #-}
279
265
280-- #maxLength
266-- #maxLength
281
267
282−instance
283− ( a ~ Maybe Integer, b ~ Maybe Integer
284− ) => LabelOptic "maxLength" A_Lens Schema Schema a b where
285− labelOptic = #paramSchema % #maxLength
286− {-# INLINE labelOptic #-}
287−
288instance
268instance
289 ( a ~ Maybe Integer, b ~ Maybe Integer
269 ( a ~ Maybe Integer, b ~ Maybe Integer
290 ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where
270 ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where
291− labelOptic = #paramSchema % #maxLength
271+ labelOptic = #schema % #maxLength
292 {-# INLINE labelOptic #-}
272 {-# INLINE labelOptic #-}
293
273
294-- #minLength
274-- #minLength
295
275
296−instance
297− ( a ~ Maybe Integer, b ~ Maybe Integer
298− ) => LabelOptic "minLength" A_Lens Schema Schema a b where
299− labelOptic = #paramSchema % #minLength
300− {-# INLINE labelOptic #-}
301−
302instance
276instance
303 ( a ~ Maybe Integer, b ~ Maybe Integer
277 ( a ~ Maybe Integer, b ~ Maybe Integer
304 ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where
278 ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where
305− labelOptic = #paramSchema % #minLength
279+ labelOptic = #schema % #minLength
306 {-# INLINE labelOptic #-}
280 {-# INLINE labelOptic #-}
307
281
308-- #pattern
282-- #pattern
309
283
310−instance
311− ( a ~ Maybe Text, b ~ Maybe Text
312− ) => LabelOptic "pattern" A_Lens Schema Schema a b where
313− labelOptic = #paramSchema % #pattern
314− {-# INLINE labelOptic #-}
315−
316instance
284instance
317 ( a ~ Maybe Text, b ~ Maybe Text
285 ( a ~ Maybe Text, b ~ Maybe Text
318 ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where
286 ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where
319− labelOptic = #paramSchema % #pattern
287+ labelOptic = #schema % #pattern
320 {-# INLINE labelOptic #-}
288 {-# INLINE labelOptic #-}
321
289
322-- #maxItems
290-- #maxItems
323
291
324−instance
325− ( a ~ Maybe Integer, b ~ Maybe Integer
326− ) => LabelOptic "maxItems" A_Lens Schema Schema a b where
327− labelOptic = #paramSchema % #maxItems
328− {-# INLINE labelOptic #-}
329−
330instance
292instance
331 ( a ~ Maybe Integer, b ~ Maybe Integer
293 ( a ~ Maybe Integer, b ~ Maybe Integer
332 ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where
294 ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where
333− labelOptic = #paramSchema % #maxItems
295+ labelOptic = #schema % #maxItems
334 {-# INLINE labelOptic #-}
296 {-# INLINE labelOptic #-}
335
297
336-- #minItems
298-- #minItems
337
299
338−instance
339− ( a ~ Maybe Integer, b ~ Maybe Integer
340− ) => LabelOptic "minItems" A_Lens Schema Schema a b where
341− labelOptic = #paramSchema % #minItems
342− {-# INLINE labelOptic #-}
343−
344instance
300instance
345 ( a ~ Maybe Integer, b ~ Maybe Integer
301 ( a ~ Maybe Integer, b ~ Maybe Integer
346 ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where
302 ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where
347− labelOptic = #paramSchema % #minItems
303+ labelOptic = #schema % #minItems
348 {-# INLINE labelOptic #-}
304 {-# INLINE labelOptic #-}
349
305
350-- #uniqueItems
306-- #uniqueItems
351
307
352−instance
353− ( a ~ Maybe Bool, b ~ Maybe Bool
354− ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where
355− labelOptic = #paramSchema % #uniqueItems
356− {-# INLINE labelOptic #-}
357−
358instance
308instance
359 ( a ~ Maybe Bool, b ~ Maybe Bool
309 ( a ~ Maybe Bool, b ~ Maybe Bool
360 ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where
310 ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where
361− labelOptic = #paramSchema % #uniqueItems
311+ labelOptic = #schema % #uniqueItems
362 {-# INLINE labelOptic #-}
312 {-# INLINE labelOptic #-}
363
313
364-- #enum
314-- #enum
365
315
366−instance
367− ( a ~ Maybe [Value], b ~ Maybe [Value]
368− ) => LabelOptic "enum" A_Lens Schema Schema a b where
369− labelOptic = #paramSchema % #enum
370− {-# INLINE labelOptic #-}
371−
372instance
316instance
373 ( a ~ Maybe [Value], b ~ Maybe [Value]
317 ( a ~ Maybe [Value], b ~ Maybe [Value]
374 ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where
318 ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where
375− labelOptic = #paramSchema % #enum
319+ labelOptic = #schema % #enum
376 {-# INLINE labelOptic #-}
320 {-# INLINE labelOptic #-}
377
321
378-- #multipleOf
322-- #multipleOf
379
323
380−instance
381− ( a ~ Maybe Scientific, b ~ Maybe Scientific
382− ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where
383− labelOptic = #paramSchema % #multipleOf
384− {-# INLINE labelOptic #-}
385−
386instance
324instance
387 ( a ~ Maybe Scientific, b ~ Maybe Scientific
325 ( a ~ Maybe Scientific, b ~ Maybe Scientific
388 ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where
326 ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where
389− labelOptic = #paramSchema % #multipleOf
327+ labelOptic = #schema % #multipleOf
390 {-# INLINE labelOptic #-}
328 {-# INLINE labelOptic #-}
src/Data/Swagger/ParamSchema.hs → src/Data/OpenApi/ParamSchema.hsrenamed+7−7
@@ -1,10 +1,10 @@
1-- |
1-- |
2−-- Module: Data.Swagger.ParamSchema
2+-- Module: Data.OpenApi.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.Swagger.ParamSchema (
7+module Data.OpenApi.ParamSchema (
8 -- * Encoding
8 -- * Encoding
9 ToParamSchema(..),
9 ToParamSchema(..),
10
10
@@ -13,14 +13,14 @@ module Data.Swagger.ParamSchema (
13 toParamSchemaBoundedIntegral,
13 toParamSchemaBoundedIntegral,
14
14
15 -- * Schema templates
15 -- * Schema templates
16− passwordParamSchema,
16+ passwordSchema,
17− binaryParamSchema,
17+ binarySchema,
18− byteParamSchema,
18+ byteSchema,
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.Swagger.Internal.ParamSchema
25+import Data.OpenApi.Internal.ParamSchema
26−import Data.Swagger.SchemaOptions
26+import Data.OpenApi.SchemaOptions
src/Data/Swagger/Schema.hs → src/Data/OpenApi/Schema.hsrenamed+4−9
@@ -1,10 +1,10 @@
1-- |
1-- |
2−-- Module: Data.Swagger.Schema
2+-- Module: Data.OpenApi.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.Swagger.Schema (
7+module Data.OpenApi.Schema (
8 -- * Encoding
8 -- * Encoding
9 ToSchema(..),
9 ToSchema(..),
10 declareSchema,
10 declareSchema,
@@ -32,11 +32,6 @@ module Data.Swagger.Schema (
32 paramSchemaToNamedSchema,
32 paramSchemaToNamedSchema,
33 paramSchemaToSchema,
33 paramSchemaToSchema,
34
34
35− -- * Schema templates
36− passwordSchema,
37− binarySchema,
38− byteSchema,
39−
40 -- * Sketching @'Schema'@s using @'ToJSON'@
35 -- * Sketching @'Schema'@s using @'ToJSON'@
41 sketchSchema,
36 sketchSchema,
42 sketchStrictSchema,
37 sketchStrictSchema,
@@ -53,5 +48,5 @@ module Data.Swagger.Schema (
53 fromAesonOptions,
48 fromAesonOptions,
54) where
49) where
55
50
56−import Data.Swagger.Internal.Schema
51+import Data.OpenApi.Internal.Schema
57−import Data.Swagger.SchemaOptions
52+import Data.OpenApi.SchemaOptions
src/Data/Swagger/Schema/Generator.hs → src/Data/OpenApi/Schema/Generator.hsrenamed+17−15
@@ -2,7 +2,7 @@
2{-# LANGUAGE OverloadedLists #-}
2{-# LANGUAGE OverloadedLists #-}
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4
4
5−module Data.Swagger.Schema.Generator where
5+module Data.OpenApi.Schema.Generator where
6
6
7import Prelude ()
7import Prelude ()
8import Prelude.Compat
8import Prelude.Compat
@@ -16,20 +16,22 @@ 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.Swagger
19+import Data.OpenApi
20−import Data.Swagger.Declare
20+import Data.OpenApi.Declare
21−import Data.Swagger.Internal.Schema.Validation (inferSchemaTypes)
21+import Data.OpenApi.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+
28-- | Note: 'schemaGen' may 'error', if schema type is not specified,
30-- | Note: 'schemaGen' may 'error', if schema type is not specified,
29-- and cannot be inferred.
31-- and cannot be inferred.
30schemaGen :: Definitions Schema -> Schema -> Gen Value
32schemaGen :: Definitions Schema -> Schema -> Gen Value
31schemaGen _ schema
33schemaGen _ schema
32− | Just cases <- schema ^. paramSchema . enum_ = elements cases
34+ | Just cases <- schema ^. enum_ = elements cases
33schemaGen defns schema
35schemaGen defns schema
34 | Just variants <- schema ^. oneOf = schemaGen defns =<< elements (dereference defns <$> variants)
36 | Just variants <- schema ^. oneOf = schemaGen defns =<< elements (dereference defns <$> variants)
35schemaGen defns schema =
37schemaGen defns schema =
@@ -39,25 +41,25 @@ schemaGen defns schema =
39 [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)
41 [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)
40 -- Gen is not MonadFail
42 -- Gen is not MonadFail
41 _ -> error "unable to infer schema type"
43 _ -> error "unable to infer schema type"
42− Just SwaggerBoolean -> Bool <$> elements [True, False]
44+ Just OpenApiBoolean -> Bool <$> elements [True, False]
43− Just SwaggerNull -> pure Null
45+ Just OpenApiNull -> pure Null
44− Just SwaggerNumber
46+ Just OpenApiNumber
45 | Just min <- schema ^. minimum_
47 | Just min <- schema ^. minimum_
46 , Just max <- schema ^. maximum_ ->
48 , Just max <- schema ^. maximum_ ->
47 Number . fromFloatDigits <$>
49 Number . fromFloatDigits <$>
48 choose (toRealFloat min, toRealFloat max :: Double)
50 choose (toRealFloat min, toRealFloat max :: Double)
49 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)
51 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)
50− Just SwaggerInteger
52+ Just OpenApiInteger
51 | Just min <- schema ^. minimum_
53 | Just min <- schema ^. minimum_
52 , Just max <- schema ^. maximum_ ->
54 , Just max <- schema ^. maximum_ ->
53 Number . fromInteger <$>
55 Number . fromInteger <$>
54 choose (truncate min, truncate max)
56 choose (truncate min, truncate max)
55 | otherwise -> Number . fromInteger <$> arbitrary
57 | otherwise -> Number . fromInteger <$> arbitrary
56− Just SwaggerArray
58+ Just OpenApiArray
57 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
59 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
58 | Just items <- schema ^. items ->
60 | Just items <- schema ^. items ->
59 case items of
61 case items of
60− SwaggerItemsObject ref -> do
62+ OpenApiItemsObject ref -> do
61 size <- getSize
63 size <- getSize
62 let itemSchema = dereference defns ref
64 let itemSchema = dereference defns ref
63 minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems
65 minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems
@@ -65,17 +67,17 @@ schemaGen defns schema =
65 arrayLength <- choose (minLength', max minLength' maxLength')
67 arrayLength <- choose (minLength', max minLength' maxLength')
66 generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema
68 generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema
67 return . Array $ V.fromList generatedArray
69 return . Array $ V.fromList generatedArray
68− SwaggerItemsArray refs ->
70+ OpenApiItemsArray refs ->
69 let itemGens = schemaGen defns . dereference defns <$> refs
71 let itemGens = schemaGen defns . dereference defns <$> refs
70 in fmap (Array . V.fromList) $ sequence itemGens
72 in fmap (Array . V.fromList) $ sequence itemGens
71− Just SwaggerString -> do
73+ Just OpenApiString -> do
72 size <- getSize
74 size <- getSize
73 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
75 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
74 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
76 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
75 length <- choose (minLength', max minLength' maxLength')
77 length <- choose (minLength', max minLength' maxLength')
76 str <- vectorOf length arbitrary
78 str <- vectorOf length arbitrary
77 return . String $ T.pack str
79 return . String $ T.pack str
78− Just SwaggerObject -> do
80+ Just OpenApiObject -> do
79 size <- getSize
81 size <- getSize
80 let props = dereference defns <$> schema ^. properties
82 let props = dereference defns <$> schema ^. properties
81 reqKeys = S.fromList $ schema ^. required
83 reqKeys = S.fromList $ schema ^. required
@@ -95,7 +97,7 @@ schemaGen defns schema =
95 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
97 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
96 _ -> return []
98 _ -> return []
97 x <- sequence $ gens <> additionalGens
99 x <- sequence $ gens <> additionalGens
98− return . Object $ M.toHashMap x
100+ return . Object $ fromInsOrdHashMap x
99
101
100dereference :: Definitions a -> Referenced a -> a
102dereference :: Definitions a -> Referenced a -> a
101dereference _ (Inline a) = a
103dereference _ (Inline a) = a
src/Data/Swagger/Schema/Validation.hs → src/Data/OpenApi/Schema/Validation.hsrenamed+7−7
@@ -1,10 +1,10 @@
1-- |
1-- |
2−-- Module: Data.Swagger.Schema.Validation
2+-- Module: Data.OpenApi.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.Swagger.Schema.Validation (
7+module Data.OpenApi.Schema.Validation (
8 -- * How to use validation
8 -- * How to use validation
9 -- $howto
9 -- $howto
10
10
@@ -29,13 +29,13 @@ module Data.Swagger.Schema.Validation (
29 validateJSONWithPatternChecker,
29 validateJSONWithPatternChecker,
30) where
30) where
31
31
32−import Data.Swagger.Internal.Schema.Validation
32+import Data.OpenApi.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.Swagger
38+-- >>> import Data.OpenApi
39-- >>> import GHC.Generics
39-- >>> import GHC.Generics
40-- >>> :set -XDeriveGeneric
40-- >>> :set -XDeriveGeneric
41
41
@@ -71,11 +71,11 @@ import Data.Swagger.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 SwaggerString"]
74+-- ["expected JSON value of type OpenApiString"]
75-- >>> validateToJSON ([Just "hello", Nothing] :: [Maybe String])
75-- >>> validateToJSON ([Just "hello", Nothing] :: [Maybe String])
76−-- ["expected JSON value of type SwaggerString"]
76+-- ["expected JSON value of type OpenApiString"]
77-- >>> validateToJSON (123, Nothing :: Maybe String)
77-- >>> validateToJSON (123, Nothing :: Maybe String)
78−-- ["expected JSON value of type SwaggerString"]
78+-- ["expected JSON value of type OpenApiString"]
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/Swagger/SchemaOptions.hs → src/Data/OpenApi/SchemaOptions.hsrenamed+2−2
@@ -1,11 +1,11 @@
1{-# LANGUAGE RecordWildCards #-}
1{-# LANGUAGE RecordWildCards #-}
2-- |
2-- |
3−-- Module: Data.Swagger.SchemaOptions
3+-- Module: Data.OpenApi.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.Swagger.SchemaOptions where
8+module Data.OpenApi.SchemaOptions where
9
9
10import qualified Data.Aeson.Types as Aeson
10import qualified Data.Aeson.Types as Aeson
11
11
stack.yaml+1−1
@@ -1,4 +1,4 @@
1−resolver: lts-15.1
1+resolver: lts-16.31
2packages:
2packages:
3- '.'
3- '.'
4extra-deps:
4extra-deps:
test/Data/Swagger/CommonTestTypes.hs → test/Data/OpenApi/CommonTestTypes.hsrenamed+125−2
@@ -2,7 +2,7 @@
2{-# LANGUAGE QuasiQuotes #-}
2{-# LANGUAGE QuasiQuotes #-}
3{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE ScopedTypeVariables #-}
4
4
5−module Data.Swagger.CommonTestTypes where
5+module Data.OpenApi.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.Swagger
21+import Data.OpenApi
22
22
23-- ========================================================================
23-- ========================================================================
24-- Unit type
24-- Unit type
@@ -863,6 +863,129 @@ singleMaybeFieldSchemaJSON = [aesonQQ|
863}
863}
864|]
864|]
865
865
866+-- ========================================================================
867+-- Natural Language (single field data with recursive fields)
868+-- ========================================================================
869+
870+data Predicate
871+ = PredicateNoun Noun
872+ | PredicateOmitted Omitted
873+ deriving (Eq, Ord, Read, Show, Generic)
874+instance ToJSON Predicate
875+instance ToSchema Predicate
876+
877+data Noun
878+ = Noun
879+ { nounSurf :: LangWord
880+ , nounModify :: [Modifier]
881+ }
882+ deriving (Eq, Ord, Read, Show, Generic)
883+instance ToJSON Noun
884+instance ToSchema Noun
885+
886+data LangWord
887+ = LangWord
888+ { langWordSurf :: String
889+ , langWordBase :: String
890+ }
891+ deriving (Eq, Ord, Read, Show, Generic)
892+instance ToJSON LangWord
893+instance ToSchema LangWord
894+
895+data Modifier
896+ = ModifierNoun Noun
897+ | ModifierOmitted Omitted
898+ deriving (Eq, Ord, Read, Show, Generic)
899+instance ToJSON Modifier
900+instance ToSchema Modifier
901+
902+newtype Omitted
903+ = Omitted
904+ { omittedModify :: [Modifier]
905+ }
906+ deriving (Eq, Ord, Read, Show, Generic)
907+instance ToJSON Omitted
908+instance ToSchema Omitted
909+
910+predicateSchemaDeclareJSON :: Value
911+predicateSchemaDeclareJSON = [aesonQQ|
912+[
913+ {
914+ "Predicate": {
915+ "oneOf": [
916+ {
917+ "properties": {
918+ "contents": { "$ref": "#/components/schemas/Noun" },
919+ "tag": { "enum": ["PredicateNoun"], "type": "string" }
920+ },
921+ "required": ["tag", "contents"],
922+ "type": "object"
923+ },
924+ {
925+ "properties": {
926+ "contents": { "$ref": "#/components/schemas/Omitted" },
927+ "tag": { "enum": ["PredicateOmitted"], "type": "string" }
928+ },
929+ "required": ["tag", "contents"],
930+ "type": "object"
931+ }
932+ ],
933+ "type": "object"
934+ },
935+ "Noun": {
936+ "properties": {
937+ "nounModify": {
938+ "items": { "$ref": "#/components/schemas/Modifier" },
939+ "type": "array"
940+ },
941+ "nounSurf": { "$ref": "#/components/schemas/LangWord" }
942+ },
943+ "required": ["nounSurf", "nounModify"],
944+ "type": "object"
945+ },
946+ "LangWord": {
947+ "properties": {
948+ "langWordBase": { "type": "string" },
949+ "langWordSurf": { "type": "string" }
950+ },
951+ "required": ["langWordSurf", "langWordBase"],
952+ "type": "object"
953+ },
954+ "Modifier": {
955+ "oneOf": [
956+ {
957+ "properties": {
958+ "contents": { "$ref": "#/components/schemas/Noun" },
959+ "tag": { "enum": ["ModifierNoun"], "type": "string" }
960+ },
961+ "required": ["tag", "contents"],
962+ "type": "object"
963+ },
964+ {
965+ "properties": {
966+ "contents": { "$ref": "#/components/schemas/Omitted" },
967+ "tag": { "enum": ["ModifierOmitted"], "type": "string" }
968+ },
969+ "required": ["tag", "contents"],
970+ "type": "object"
971+ }
972+ ],
973+ "type": "object"
974+ },
975+ "Omitted": {
976+ "properties": {
977+ "omittedModify": {
978+ "items": { "$ref": "#/components/schemas/Modifier" },
979+ "type": "array"
980+ }
981+ },
982+ "required": ["omittedModify"],
983+ "type": "object"
984+ }
985+ },
986+ { "$ref": "#/components/schemas/Predicate" }
987+]
988+|]
866
989
867-- ========================================================================
990-- ========================================================================
868-- TimeOfDay
991-- TimeOfDay
test/Data/Swagger/ParamSchemaSpec.hs → test/Data/OpenApi/ParamSchemaSpec.hsrenamed+4−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.Swagger.ParamSchemaSpec where
7+module Data.OpenApi.ParamSchemaSpec where
8
8
9import Data.Aeson
9import Data.Aeson
10import Data.Aeson.QQ.Simple
10import Data.Aeson.QQ.Simple
@@ -12,9 +12,9 @@ import Data.Char
12import Data.Proxy
12import Data.Proxy
13import GHC.Generics
13import GHC.Generics
14
14
15−import Data.Swagger
15+import Data.OpenApi
16
16
17−import Data.Swagger.CommonTestTypes
17+import Data.OpenApi.CommonTestTypes
18import SpecCommon
18import SpecCommon
19import Test.Hspec
19import Test.Hspec
20import Data.Time.LocalTime
20import Data.Time.LocalTime
@@ -22,7 +22,7 @@ import Data.Time.LocalTime
22import qualified Data.HashMap.Strict as HM
22import qualified Data.HashMap.Strict as HM
23
23
24checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec
24checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec
25−checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema) <=> js
25+checkToParamSchema proxy js = (toParamSchema proxy :: Schema) <=> js
26
26
27spec :: Spec
27spec :: Spec
28spec = do
28spec = do
test/Data/Swagger/Schema/GeneratorSpec.hs → test/Data/OpenApi/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.Swagger.Schema.GeneratorSpec where
4+module Data.OpenApi.Schema.GeneratorSpec where
5
5
6import Prelude ()
6import Prelude ()
7import Prelude.Compat
7import Prelude.Compat
8
8
9−import Data.Swagger
9+import Data.OpenApi
10−import Data.Swagger.Schema.Generator
10+import Data.OpenApi.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_ ?~ SwaggerObject
106+ & type_ ?~ OpenApiObject
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_ ?~ SwaggerObject
126+ & type_ ?~ OpenApiObject
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_ ?~ SwaggerObject
148+ & type_ ?~ OpenApiObject
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_ ?~ SwaggerObject
166+ & type_ ?~ OpenApiObject
167 & properties .~ [("propE", boolSchema)]
167 & properties .~ [("propE", boolSchema)]
168 & required .~ ["propE"]
168 & required .~ ["propE"]
test/Data/Swagger/Schema/ValidationSpec.hs → test/Data/OpenApi/Schema/ValidationSpec.hsrenamed+27−10
@@ -1,13 +1,18 @@
1+{-# LANGUAGE CPP #-}
1{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE DeriveGeneric #-}
2{-# LANGUAGE PackageImports #-}
3{-# LANGUAGE PackageImports #-}
3{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE RecordWildCards #-}
4{-# LANGUAGE ScopedTypeVariables #-}
5{-# LANGUAGE ScopedTypeVariables #-}
5{-# OPTIONS_GHC -fno-warn-orphans #-}
6{-# OPTIONS_GHC -fno-warn-orphans #-}
6−module Data.Swagger.Schema.ValidationSpec where
7+module Data.OpenApi.Schema.ValidationSpec where
7
8
8import Control.Applicative
9import Control.Applicative
9import Control.Lens ((&), (.~), (?~))
10import Control.Lens ((&), (.~), (?~))
10import Data.Aeson
11import Data.Aeson
12+#if MIN_VERSION_aeson(2,0,0)
13+import qualified Data.Aeson.Key as Key
14+import qualified Data.Aeson.KeyMap as KeyMap
15+#endif
11import Data.Aeson.Types
16import Data.Aeson.Types
12import Data.Hashable (Hashable)
17import Data.Hashable (Hashable)
13import Data.HashMap.Strict (HashMap)
18import Data.HashMap.Strict (HashMap)
@@ -28,8 +33,9 @@ import Data.Version (Version)
28import Data.Word
33import Data.Word
29import GHC.Generics
34import GHC.Generics
30
35
31−import Data.Swagger
36+import Data.OpenApi
32−import Data.Swagger.Declare
37+import Data.OpenApi.Declare
38+import Data.OpenApi.Aeson.Compat (stringToKey)
33
39
34import Test.Hspec
40import Test.Hspec
35import Test.Hspec.QuickCheck
41import Test.Hspec.QuickCheck
@@ -124,9 +130,9 @@ instance Arbitrary Person where
124
130
125invalidPersonToJSON :: Person -> Value
131invalidPersonToJSON :: Person -> Value
126invalidPersonToJSON Person{..} = object
132invalidPersonToJSON Person{..} = object
127− [ T.pack "personName" .= toJSON name
133+ [ stringToKey "personName" .= toJSON name
128− , T.pack "personPhone" .= toJSON phone
134+ , stringToKey "personPhone" .= toJSON phone
129− , T.pack "personEmail" .= toJSON email
135+ , stringToKey "personEmail" .= toJSON email
130 ]
136 ]
131
137
132-- ========================================================================
138-- ========================================================================
@@ -190,7 +196,7 @@ instance Arbitrary MyRoseTree where
190data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic)
196data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic)
191
197
192instance ToSchema Light where
198instance ToSchema Light where
193− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { Data.Swagger.sumEncoding = ObjectWithSingleField }
199+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = ObjectWithSingleField }
194
200
195instance ToJSON Light where
201instance ToJSON Light where
196 toJSON = genericToJSON defaultOptions { Data.Aeson.Types.sumEncoding = ObjectWithSingleField }
202 toJSON = genericToJSON defaultOptions { Data.Aeson.Types.sumEncoding = ObjectWithSingleField }
@@ -215,7 +221,7 @@ instance ToJSON LightTaggedObject where
215
221
216instance ToSchema LightTaggedObject where
222instance ToSchema LightTaggedObject where
217 declareNamedSchema _ =
223 declareNamedSchema _ =
218− genericDeclareNamedSchema defaultSchemaOptions { Data.Swagger.sumEncoding = defaultTaggedObject } (Proxy :: Proxy Light)
224+ genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = defaultTaggedObject } (Proxy :: Proxy Light)
219
225
220instance Arbitrary LightTaggedObject where
226instance Arbitrary LightTaggedObject where
221 arbitrary = LightTaggedObject <$> arbitrary
227 arbitrary = LightTaggedObject <$> arbitrary
@@ -228,7 +234,7 @@ instance ToJSON LightUntaggedValue where
228
234
229instance ToSchema LightUntaggedValue where
235instance ToSchema LightUntaggedValue where
230 declareNamedSchema _ =
236 declareNamedSchema _ =
231− genericDeclareNamedSchema defaultSchemaOptions { Data.Swagger.sumEncoding = UntaggedValue } (Proxy :: Proxy Light)
237+ genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = UntaggedValue } (Proxy :: Proxy Light)
232
238
233instance Arbitrary LightUntaggedValue where
239instance Arbitrary LightUntaggedValue where
234 arbitrary = LightUntaggedValue <$> arbitrary
240 arbitrary = LightUntaggedValue <$> arbitrary
@@ -277,7 +283,7 @@ instance ToJSON FreeForm where
277
283
278instance ToSchema FreeForm where
284instance ToSchema FreeForm where
279 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
285 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
280− & type_ ?~ SwaggerObject
286+ & type_ ?~ OpenApiObject
281 & additionalProperties ?~ AdditionalPropertiesAllowed True
287 & additionalProperties ?~ AdditionalPropertiesAllowed True
282
288
283instance Arbitrary FreeForm where
289instance Arbitrary FreeForm where
@@ -295,6 +301,8 @@ instance Eq ZonedTime where
295-- Arbitrary instance for Data.Aeson.Value
301-- Arbitrary instance for Data.Aeson.Value
296-- ========================================================================
302-- ========================================================================
297
303
304+-- These instances were introduces in aeson upstream in 2.0.3
305+#if !MIN_VERSION_aeson(2,0,3)
298instance Arbitrary Value where
306instance Arbitrary Value where
299 -- Weights are almost random
307 -- Weights are almost random
300 -- Uniform oneof tends not to build complex objects cause of recursive call.
308 -- Uniform oneof tends not to build complex objects cause of recursive call.
@@ -305,3 +313,12 @@ instance Arbitrary Value where
305 , (3, Number <$> arbitrary)
313 , (3, Number <$> arbitrary)
306 , (3, Bool <$> arbitrary)
314 , (3, Bool <$> arbitrary)
307 , (1, return Null) ]
315 , (1, return Null) ]
316+
317+#if MIN_VERSION_aeson(2,0,0)
318+instance Arbitrary v => Arbitrary (KeyMap.KeyMap v) where
319+ arbitrary = KeyMap.fromList <$> arbitrary
320+
321+instance Arbitrary Key.Key where
322+ arbitrary = Key.fromText <$> arbitrary
323+#endif
324+#endif
test/Data/Swagger/SchemaSpec.hs → test/Data/OpenApi/SchemaSpec.hsrenamed+8−4
@@ -2,7 +2,7 @@
2{-# LANGUAGE ScopedTypeVariables #-}
2{-# LANGUAGE ScopedTypeVariables #-}
3{-# LANGUAGE TemplateHaskell #-}
3{-# LANGUAGE TemplateHaskell #-}
4{-# LANGUAGE QuasiQuotes #-}
4{-# LANGUAGE QuasiQuotes #-}
5−module Data.Swagger.SchemaSpec where
5+module Data.OpenApi.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.Swagger
17+import Data.OpenApi
18−import Data.Swagger.Declare
18+import Data.OpenApi.Declare
19
19
20−import Data.Swagger.CommonTestTypes
20+import Data.OpenApi.CommonTestTypes
21import SpecCommon
21import SpecCommon
22import Test.Hspec
22import Test.Hspec
23
23
@@ -59,6 +59,9 @@ 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+
62spec :: Spec
65spec :: Spec
63spec = do
66spec = do
64 describe "Generic ToSchema" $ do
67 describe "Generic ToSchema" $ do
@@ -78,6 +81,7 @@ spec = do
78 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON
81 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON
79 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON
82 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON
80 context "SingleMaybeField (unary record with Maybe)" $ checkToSchema (Proxy :: Proxy SingleMaybeField) singleMaybeFieldSchemaJSON
83 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
81 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON
85 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON
82 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
86 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
83 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
87 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
test/Data/SwaggerSpec.hs → test/Data/OpenApiSpec.hsrenamed+52−36
@@ -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.SwaggerSpec where
5+module Data.OpenApiSpec 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.Swagger
18+import Data.OpenApi
19import SpecCommon
19import SpecCommon
20import Test.Hspec hiding (example)
20import Test.Hspec hiding (example)
21
21
@@ -42,9 +42,13 @@ 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 (_ :: Swagger) -> True; _ -> False)
45+ fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)
46 it "roundtrips: fmap toJSON . fromJSON" $ do
46 it "roundtrips: fmap toJSON . fromJSON" $ do
47− (toJSON :: Swagger -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON
47+ (toJSON :: OpenApi -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON
48+ context "Security schemes" $ do
49+ it "merged correctly" $ do
50+ let merged = oAuth2SecurityDefinitionsReadOpenApi <> oAuth2SecurityDefinitionsWriteOpenApi
51+ merged `shouldBe` oAuth2SecurityDefinitionsOpenApi
48
52
49main :: IO ()
53main :: IO ()
50main = hspec spec
54main = hspec spec
@@ -132,15 +136,15 @@ operationExample = mempty
132 & description ?~ "ID of pet that needs to be updated"
136 & description ?~ "ID of pet that needs to be updated"
133 & required ?~ True
137 & required ?~ True
134 & in_ .~ ParamPath
138 & in_ .~ ParamPath
135− & schema ?~ Inline (mempty & type_ ?~ SwaggerString))]
139+ & schema ?~ Inline (mempty & type_ ?~ OpenApiString))]
136 & requestBody ?~ Inline (
140 & requestBody ?~ Inline (
137 mempty & content . at "application/x-www-form-urlencoded" ?~ (mempty & schema ?~ (Inline (mempty
141 mempty & content . at "application/x-www-form-urlencoded" ?~ (mempty & schema ?~ (Inline (mempty
138 & properties . at "petId" ?~ Inline (mempty
142 & properties . at "petId" ?~ Inline (mempty
139 & description ?~ "Updated name of the pet"
143 & description ?~ "Updated name of the pet"
140− & type_ ?~ SwaggerString)
144+ & type_ ?~ OpenApiString)
141 & properties . at "status" ?~ Inline (mempty
145 & properties . at "status" ?~ Inline (mempty
142 & description ?~ "Updated status of the pet"
146 & description ?~ "Updated status of the pet"
143− & type_ ?~ SwaggerString)))))
147+ & type_ ?~ OpenApiString)))))
144 & at 200 ?~ "Pet updated."
148 & at 200 ?~ "Pet updated."
145 & at 405 ?~ "Invalid input"
149 & at 405 ?~ "Invalid input"
146 & security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]
150 & security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]
@@ -208,7 +212,7 @@ operationExampleJSON = [aesonQQ|
208
212
209schemaPrimitiveExample :: Schema
213schemaPrimitiveExample :: Schema
210schemaPrimitiveExample = mempty
214schemaPrimitiveExample = mempty
211− & type_ ?~ SwaggerString
215+ & type_ ?~ OpenApiString
212 & format ?~ "email"
216 & format ?~ "email"
213
217
214schemaPrimitiveExampleJSON :: Value
218schemaPrimitiveExampleJSON :: Value
@@ -221,14 +225,14 @@ schemaPrimitiveExampleJSON = [aesonQQ|
221
225
222schemaSimpleModelExample :: Schema
226schemaSimpleModelExample :: Schema
223schemaSimpleModelExample = mempty
227schemaSimpleModelExample = mempty
224− & type_ ?~ SwaggerObject
228+ & type_ ?~ OpenApiObject
225 & required .~ [ "name" ]
229 & required .~ [ "name" ]
226 & properties .~
230 & properties .~
227− [ ("name", Inline (mempty & type_ ?~ SwaggerString))
231+ [ ("name", Inline (mempty & type_ ?~ OpenApiString))
228 , ("address", Ref (Reference "Address"))
232 , ("address", Ref (Reference "Address"))
229 , ("age", Inline $ mempty
233 , ("age", Inline $ mempty
230 & minimum_ ?~ 0
234 & minimum_ ?~ 0
231− & type_ ?~ SwaggerInteger
235+ & type_ ?~ OpenApiInteger
232 & format ?~ "int32" ) ]
236 & format ?~ "int32" ) ]
233
237
234schemaSimpleModelExampleJSON :: Value
238schemaSimpleModelExampleJSON :: Value
@@ -253,8 +257,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|
253
257
254schemaModelDictExample :: Schema
258schemaModelDictExample :: Schema
255schemaModelDictExample = mempty
259schemaModelDictExample = mempty
256− & type_ ?~ SwaggerObject
260+ & type_ ?~ OpenApiObject
257− & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ SwaggerString))
261+ & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ OpenApiString))
258
262
259schemaModelDictExampleJSON :: Value
263schemaModelDictExampleJSON :: Value
260schemaModelDictExampleJSON = [aesonQQ|
264schemaModelDictExampleJSON = [aesonQQ|
@@ -268,7 +272,7 @@ schemaModelDictExampleJSON = [aesonQQ|
268
272
269schemaAdditionalExample :: Schema
273schemaAdditionalExample :: Schema
270schemaAdditionalExample = mempty
274schemaAdditionalExample = mempty
271− & type_ ?~ SwaggerObject
275+ & type_ ?~ OpenApiObject
272 & additionalProperties ?~ AdditionalPropertiesAllowed True
276 & additionalProperties ?~ AdditionalPropertiesAllowed True
273
277
274schemaAdditionalExampleJSON :: Value
278schemaAdditionalExampleJSON :: Value
@@ -281,13 +285,13 @@ schemaAdditionalExampleJSON = [aesonQQ|
281
285
282schemaWithExampleExample :: Schema
286schemaWithExampleExample :: Schema
283schemaWithExampleExample = mempty
287schemaWithExampleExample = mempty
284− & type_ ?~ SwaggerObject
288+ & type_ ?~ OpenApiObject
285 & properties .~
289 & properties .~
286 [ ("id", Inline $ mempty
290 [ ("id", Inline $ mempty
287− & type_ ?~ SwaggerInteger
291+ & type_ ?~ OpenApiInteger
288 & format ?~ "int64" )
292 & format ?~ "int64" )
289 , ("name", Inline $ mempty
293 , ("name", Inline $ mempty
290− & type_ ?~ SwaggerString) ]
294+ & type_ ?~ OpenApiString) ]
291 & required .~ [ "name" ]
295 & required .~ [ "name" ]
292 & example ?~ [aesonQQ|
296 & example ?~ [aesonQQ|
293 {
297 {
@@ -326,19 +330,19 @@ schemaWithExampleExampleJSON = [aesonQQ|
326definitionsExample :: HashMap Text Schema
330definitionsExample :: HashMap Text Schema
327definitionsExample =
331definitionsExample =
328 [ ("Category", mempty
332 [ ("Category", mempty
329− & type_ ?~ SwaggerObject
333+ & type_ ?~ OpenApiObject
330 & properties .~
334 & properties .~
331 [ ("id", Inline $ mempty
335 [ ("id", Inline $ mempty
332− & type_ ?~ SwaggerInteger
336+ & type_ ?~ OpenApiInteger
333 & format ?~ "int64")
337 & format ?~ "int64")
334− , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] )
338+ , ("name", Inline (mempty & type_ ?~ OpenApiString)) ] )
335 , ("Tag", mempty
339 , ("Tag", mempty
336− & type_ ?~ SwaggerObject
340+ & type_ ?~ OpenApiObject
337 & properties .~
341 & properties .~
338 [ ("id", Inline $ mempty
342 [ ("id", Inline $ mempty
339− & type_ ?~ SwaggerInteger
343+ & type_ ?~ OpenApiInteger
340 & format ?~ "int64")
344 & format ?~ "int64")
341− , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] ) ]
345+ , ("name", Inline (mempty & type_ ?~ OpenApiString)) ] ) ]
342
346
343definitionsExampleJSON :: Value
347definitionsExampleJSON :: Value
344definitionsExampleJSON = [aesonQQ|
348definitionsExampleJSON = [aesonQQ|
@@ -382,7 +386,7 @@ paramsDefinitionExample =
382 & required ?~ True
386 & required ?~ True
383 & in_ .~ ParamQuery
387 & in_ .~ ParamQuery
384 & schema ?~ Inline (mempty
388 & schema ?~ Inline (mempty
385− & type_ ?~ SwaggerInteger
389+ & type_ ?~ OpenApiInteger
386 & format ?~ "int32" ))
390 & format ?~ "int32" ))
387 , ("limitParam", mempty
391 , ("limitParam", mempty
388 & name .~ "limit"
392 & name .~ "limit"
@@ -390,7 +394,7 @@ paramsDefinitionExample =
390 & required ?~ True
394 & required ?~ True
391 & in_ .~ ParamQuery
395 & in_ .~ ParamQuery
392 & schema ?~ Inline (mempty
396 & schema ?~ Inline (mempty
393− & type_ ?~ SwaggerInteger
397+ & type_ ?~ OpenApiInteger
394 & format ?~ "int32" )) ]
398 & format ?~ "int32" )) ]
395
399
396paramsDefinitionExampleJSON :: Value
400paramsDefinitionExampleJSON :: Value
@@ -441,7 +445,7 @@ responsesDefinitionExampleJSON = [aesonQQ|
441|]
445|]
442
446
443-- =======================================================================
447-- =======================================================================
444−-- Responses Definition object
448+-- Security Definition object
445-- =======================================================================
449-- =======================================================================
446
450
447securityDefinitionsExample :: SecurityDefinitions
451securityDefinitionsExample :: SecurityDefinitions
@@ -527,11 +531,23 @@ oAuth2SecurityDefinitionsExampleJSON = [aesonQQ|
527}
531}
528|]
532|]
529
533
534+oAuth2SecurityDefinitionsReadOpenApi :: OpenApi
535+oAuth2SecurityDefinitionsReadOpenApi =
536+ mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsReadExample
537+
538+oAuth2SecurityDefinitionsWriteOpenApi :: OpenApi
539+oAuth2SecurityDefinitionsWriteOpenApi =
540+ mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsWriteExample
541+
542+oAuth2SecurityDefinitionsOpenApi :: OpenApi
543+oAuth2SecurityDefinitionsOpenApi =
544+ mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsExample
545+
530-- =======================================================================
546-- =======================================================================
531-- Swagger object
547-- Swagger object
532-- =======================================================================
548-- =======================================================================
533
549
534−emptyPathsFieldExample :: Swagger
550+emptyPathsFieldExample :: OpenApi
535emptyPathsFieldExample = mempty
551emptyPathsFieldExample = mempty
536
552
537emptyPathsFieldExampleJSON :: Value
553emptyPathsFieldExampleJSON :: Value
@@ -544,7 +560,7 @@ emptyPathsFieldExampleJSON = [aesonQQ|
544}
560}
545|]
561|]
546
562
547−swaggerExample :: Swagger
563+swaggerExample :: OpenApi
548swaggerExample = mempty
564swaggerExample = mempty
549 -- & basePath ?~ "/"
565 -- & basePath ?~ "/"
550 -- & schemes ?~ [Http]
566 -- & schemes ?~ [Http]
@@ -559,7 +575,7 @@ swaggerExample = mempty
559 & description .~ "OK"
575 & description .~ "OK"
560 & content . at "application/json" ?~ (mempty
576 & content . at "application/json" ?~ (mempty
561 & schema ?~ Inline (mempty
577 & schema ?~ Inline (mempty
562− & type_ ?~ SwaggerObject
578+ & type_ ?~ OpenApiObject
563 & example ?~ [aesonQQ|
579 & example ?~ [aesonQQ|
564 {
580 {
565 "created": 100,
581 "created": 100,
@@ -568,9 +584,9 @@ swaggerExample = mempty
568 & description ?~ "This is some real Todo right here"
584 & description ?~ "This is some real Todo right here"
569 & properties .~
585 & properties .~
570 [ ("created", Inline $ mempty
586 [ ("created", Inline $ mempty
571− & type_ ?~ SwaggerInteger
587+ & type_ ?~ OpenApiInteger
572 & format ?~ "int32")
588 & format ?~ "int32")
573− , ("description", Inline (mempty & type_ ?~ SwaggerString))])))
589+ , ("description", Inline (mempty & type_ ?~ OpenApiString))])))
574 & parameters .~
590 & parameters .~
575 [ Inline $ mempty
591 [ Inline $ mempty
576 & required ?~ True
592 & required ?~ True
@@ -578,7 +594,7 @@ swaggerExample = mempty
578 & description ?~ "TodoId param"
594 & description ?~ "TodoId param"
579 & in_ .~ ParamPath
595 & in_ .~ ParamPath
580 & schema ?~ Inline (mempty
596 & schema ?~ Inline (mempty
581− & type_ ?~ SwaggerString ) ]
597+ & type_ ?~ OpenApiString ) ]
582 & tags .~ InsOrdHS.fromList [ "todo" ] ))
598 & tags .~ InsOrdHS.fromList [ "todo" ] ))
583
599
584swaggerExampleJSON :: Value
600swaggerExampleJSON :: Value
@@ -917,14 +933,14 @@ petstoreExampleJSON = [aesonQQ|
917
933
918compositionSchemaExample :: Schema
934compositionSchemaExample :: Schema
919compositionSchemaExample = mempty
935compositionSchemaExample = mempty
920− & type_ ?~ SwaggerObject
936+ & type_ ?~ OpenApiObject
921− & Data.Swagger.allOf ?~ [
937+ & Data.OpenApi.allOf ?~ [
922 Ref (Reference "Other")
938 Ref (Reference "Other")
923 , Inline (mempty
939 , Inline (mempty
924− & type_ ?~ SwaggerObject
940+ & type_ ?~ OpenApiObject
925 & properties .~
941 & properties .~
926 [ ("greet", Inline $ mempty
942 [ ("greet", Inline $ mempty
927− & type_ ?~ SwaggerString) ])
943+ & type_ ?~ OpenApiString) ])
928 ]
944 ]
929
945
930compositionSchemaExampleJSON :: Value
946compositionSchemaExampleJSON :: Value
test/SpecCommon.hs−8
@@ -8,14 +8,6 @@ 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−
19(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec
11(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec
20x <=> js = do
12x <=> js = do
21 it "encodes correctly" $ do
13 it "encodes correctly" $ do