git.iko.soy/typeable/openapi3
on bd9df53 help sign in
340d86f
swap
0 ahead, 42 behind
.github/workflows/haskell-ci.ymldeleted−243
since splitsnapshots
unifiedsplit
@@ -1,243 +0,0 @@
1−# This GitHub workflow config has been generated by a script via
2−#
3−# haskell-ci 'github' 'cabal.project'
4−#
5−# To regenerate the script (for example after adjusting tested-with) run
6−#
7−# haskell-ci regenerate
8−#
9−# For more information, see https://github.com/haskell-CI/haskell-ci
10−#
11−# version: 0.14.3
12−#
13−# REGENDATA ("0.14.3",["github","cabal.project"])
14−#
15−name: Haskell-CI
16−on:
17− push:
18− branches:
19− - master
20− pull_request:
21− branches:
22− - master
23−jobs:
24− linux:
25− name: Haskell-CI - Linux - ${{ matrix.compiler }}
26− runs-on: ubuntu-18.04
27− timeout-minutes:
28− 60
29− container:
30− image: buildpack-deps:focal
31− continue-on-error: ${{ matrix.allow-failure }}
32− strategy:
33− matrix:
34− include:
35− - compiler: ghc-9.2.2
36− compilerKind: ghc
37− compilerVersion: 9.2.2
38− setup-method: ghcup
39− allow-failure: true
40− - compiler: ghc-9.0.2
41− compilerKind: ghc
42− compilerVersion: 9.0.2
43− setup-method: ghcup
44− allow-failure: false
45− - compiler: ghc-8.10.7
46− compilerKind: ghc
47− compilerVersion: 8.10.7
48− setup-method: ghcup
49− allow-failure: false
50− - compiler: ghc-8.8.4
51− compilerKind: ghc
52− compilerVersion: 8.8.4
53− setup-method: hvr-ppa
54− allow-failure: false
55− - compiler: ghc-8.6.5
56− compilerKind: ghc
57− compilerVersion: 8.6.5
58− setup-method: hvr-ppa
59− allow-failure: false
60− - compiler: ghc-8.4.4
61− compilerKind: ghc
62− compilerVersion: 8.4.4
63− setup-method: hvr-ppa
64− allow-failure: false
65− fail-fast: false
66− steps:
67− - name: apt
68− run: |
69− apt-get update
70− apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5
71− if [ "${{ matrix.setup-method }}" = ghcup ]; then
72− mkdir -p "$HOME/.ghcup/bin"
73− curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
74− chmod a+x "$HOME/.ghcup/bin/ghcup"
75− "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER"
76− "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
77− else
78− apt-add-repository -y 'ppa:hvr/ghc'
79− apt-get update
80− apt-get install -y "$HCNAME"
81− mkdir -p "$HOME/.ghcup/bin"
82− curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"
83− chmod a+x "$HOME/.ghcup/bin/ghcup"
84− "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0
85− fi
86− env:
87− HCKIND: ${{ matrix.compilerKind }}
88− HCNAME: ${{ matrix.compiler }}
89− HCVER: ${{ matrix.compilerVersion }}
90− - name: Set PATH and environment variables
91− run: |
92− echo "$HOME/.cabal/bin" >> $GITHUB_PATH
93− echo "LANG=C.UTF-8" >> "$GITHUB_ENV"
94− echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"
95− echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"
96− HCDIR=/opt/$HCKIND/$HCVER
97− if [ "${{ matrix.setup-method }}" = ghcup ]; then
98− HC=$HOME/.ghcup/bin/$HCKIND-$HCVER
99− echo "HC=$HC" >> "$GITHUB_ENV"
100− echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"
101− echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"
102− echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
103− else
104− HC=$HCDIR/bin/$HCKIND
105− echo "HC=$HC" >> "$GITHUB_ENV"
106− echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"
107− echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"
108− echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"
109− fi
110−
111− HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')
112− echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"
113− echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"
114− echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"
115− echo "HEADHACKAGE=false" >> "$GITHUB_ENV"
116− echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"
117− echo "GHCJSARITH=0" >> "$GITHUB_ENV"
118− env:
119− HCKIND: ${{ matrix.compilerKind }}
120− HCNAME: ${{ matrix.compiler }}
121− HCVER: ${{ matrix.compilerVersion }}
122− - name: env
123− run: |
124− env
125− - name: write cabal config
126− run: |
127− mkdir -p $CABAL_DIR
128− cat >> $CABAL_CONFIG <<EOF
129− remote-build-reporting: anonymous
130− write-ghc-environment-files: never
131− remote-repo-cache: $CABAL_DIR/packages
132− logs-dir: $CABAL_DIR/logs
133− world-file: $CABAL_DIR/world
134− extra-prog-path: $CABAL_DIR/bin
135− symlink-bindir: $CABAL_DIR/bin
136− installdir: $CABAL_DIR/bin
137− build-summary: $CABAL_DIR/logs/build.log
138− store-dir: $CABAL_DIR/store
139− install-dirs user
140− prefix: $CABAL_DIR
141− repository hackage.haskell.org
142− url: http://hackage.haskell.org/
143− EOF
144− cat >> $CABAL_CONFIG <<EOF
145− program-default-options
146− ghc-options: $GHCJOBS +RTS -M3G -RTS
147− EOF
148− cat $CABAL_CONFIG
149− - name: versions
150− run: |
151− $HC --version || true
152− $HC --print-project-git-commit-id || true
153− $CABAL --version || true
154− - name: update cabal index
155− run: |
156− $CABAL v2-update -v
157− - name: install cabal-plan
158− run: |
159− mkdir -p $HOME/.cabal/bin
160− curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.6.2.0/cabal-plan-0.6.2.0-x86_64-linux.xz > cabal-plan.xz
161− echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c -
162− xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan
163− rm -f cabal-plan.xz
164− chmod a+x $HOME/.cabal/bin/cabal-plan
165− cabal-plan --version
166− - name: checkout
167− uses: actions/checkout@v2
168− with:
169− path: source
170− - name: initial cabal.project for sdist
171− run: |
172− touch cabal.project
173− echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project
174− cat cabal.project
175− - name: sdist
176− run: |
177− mkdir -p sdist
178− $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist
179− - name: unpack
180− run: |
181− mkdir -p unpacked
182− find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;
183− - name: generate cabal.project
184− run: |
185− PKGDIR_openapi3="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/openapi3-[0-9.]*')"
186− echo "PKGDIR_openapi3=${PKGDIR_openapi3}" >> "$GITHUB_ENV"
187− rm -f cabal.project cabal.project.local
188− touch cabal.project
189− touch cabal.project.local
190− echo "packages: ${PKGDIR_openapi3}" >> cabal.project
191− echo "package openapi3" >> cabal.project
192− echo " ghc-options: -Werror=missing-methods" >> cabal.project
193− cat >> cabal.project <<EOF
194− allow-newer: http-media:base
195− EOF
196− $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(openapi3)$/; }' >> cabal.project.local
197− cat cabal.project
198− cat cabal.project.local
199− - name: dump install plan
200− run: |
201− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all
202− cabal-plan
203− - name: cache
204− uses: actions/cache@v2
205− with:
206− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}
207− path: ~/.cabal/store
208− restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-
209− - name: install dependencies
210− run: |
211− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all
212− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all
213− - name: build w/o tests
214− run: |
215− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
216− - name: build
217− run: |
218− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always
219− - name: tests
220− run: |
221− $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct
222− - name: cabal check
223− run: |
224− cd ${PKGDIR_openapi3} || false
225− ${CABAL} -vnormal check
226− - name: haddock
227− run: |
228− $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all
229− - name: unconstrained build
230− run: |
231− rm -f cabal.project.local
232− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all
233− - name: prepare for constraint sets
234− run: |
235− rm -f cabal.project.local
236− - name: constraint set aeson-2
237− run: |
238− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson >=2.0' --dependencies-only -j2 all
239− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson >=2.0' all
240− - name: constraint set aeson-1
241− run: |
242− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson <2.0' --dependencies-only -j2 all ; fi
243− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson <2.0' all ; fi
.travis.ymlnew file+149
@@ -0,0 +1,149 @@
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' 'openapi3.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 openapi3' >> 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 -- '^(openapi3)$' || 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_openapi3="$(find . -maxdepth 1 -type d -regex '.*/openapi3-[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_openapi3}" >> cabal.project
126+ - echo 'package openapi3' >> 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 -- '^(openapi3)$' || 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_openapi3} && ${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","openapi3.cabal"])
149+# EOF
CHANGELOG.md−47
@@ -1,50 +1,3 @@
1−Unreleased
2−----------
3−
4−3.2.2
5−-----
6−
7−- Fix bug with infinite recursion in GToSchema [#37](https://github.com/biocad/openapi3/pull/37).
8−
9−3.2.1
10−-----
11−
12−- Support aeson-2.0.3.
13−- Support GHC-9.2 (doctests still fail).
14−
15−3.2.0
16−-----
17−
18−- Support aeson-2 [#34](https://github.com/biocad/openapi3/pull/34).
19−- Use `SecurityDefinitions` type for `_componentsSecuritySchemes`
20− [#32](https://github.com/biocad/openapi3/pull/32).
21−
22−3.1.0
23−-----
24−
25−- Use `format: date-time` for `ToParamSchema ZonedTime` instance (see
26− [#20](https://github.com/biocad/openapi3/pull/20)).
27−- Support generating schema for any polymorphic types via `Typeable` (see
28− [#19](https://github.com/biocad/openapi3/pull/19)).
29−- Allow `hashable-1.3.1`, prettify doctests (see [#18](https://github.com/biocad/openapi3/pull/18)).
30−
31−3.0.2.0
32−-------
33−
34−- Fix definition for HTTP security scheme (see [#10](https://github.com/biocad/openapi3/pull/10));
35−- Fix error message in `exclusiveMaximum` / `exclusiveMinimum` validation (see
36− [#15](https://github.com/biocad/openapi3/pull/15));
37−
38−3.0.1.0
39−-------
40−
41−- Support polymorphic types in schema generator.
42−
43−3.0.0
44−-----
45−
46−- Switch to OpenAPI 3.0 specification.
47−
482.6.1
12.6.1
49-----
2-----
50
3
cabal.haskell-cideleted−11
@@ -1,11 +0,0 @@
1−branches: master
2−
3−distribution: focal
4−allow-failures: >=9.2
5−
6−constraint-set aeson-1
7− constraints: aeson <2.0
8− ghc: <9.2
9−
10−constraint-set aeson-2
11− constraints: aeson >=2.0
cabal.project−2
@@ -1,4 +1,2 @@
1packages: .
1packages: .
2tests: true
2tests: true
3−
4−allow-newer: http-media:base
openapi3.cabal+16−20
@@ -1,6 +1,6 @@
1cabal-version: >=1.10
1cabal-version: >=1.10
2name: openapi3
2name: openapi3
3−version: 3.2.2
3+version: 3.0.0
4
4
5synopsis: OpenAPI 3.0 data model
5synopsis: OpenAPI 3.0 data model
6category: Web, Swagger, OpenApi
6category: Web, Swagger, OpenApi
@@ -25,10 +25,8 @@ 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.4
28+ || ==8.8.3
29− || ==8.10.7
29+ || ==8.10.1
30− || ==9.0.2
31− || ==9.2.2
32
30
33custom-setup
31custom-setup
34 setup-depends:
32 setup-depends:
@@ -57,36 +55,34 @@ library
57 Data.OpenApi.Internal.AesonUtils
55 Data.OpenApi.Internal.AesonUtils
58 Data.OpenApi.Internal.TypeShape
56 Data.OpenApi.Internal.TypeShape
59
57
60− Data.OpenApi.Aeson.Compat
61−
62 -- GHC boot libraries
58 -- GHC boot libraries
63 build-depends:
59 build-depends:
64− base >=4.11.1.0 && <4.17
60+ base >=4.11.1.0 && <4.15
65− , bytestring >=0.10.8.2 && <0.12
61+ , bytestring >=0.10.8.2 && <0.11
66 , containers >=0.5.11.0 && <0.7
62 , containers >=0.5.11.0 && <0.7
67− , template-haskell >=2.13.0.0 && <2.19
63+ , template-haskell >=2.13.0.0 && <2.17
68− , time >=1.8.0.2 && <1.14
64+ , time >=1.8.0.2 && <1.10
69 , transformers >=0.5.5.0 && <0.6
65 , transformers >=0.5.5.0 && <0.6
70
66
71 build-depends:
67 build-depends:
72 mtl >=2.2.2 && <2.3
68 mtl >=2.2.2 && <2.3
73− , text >=1.2.3.1 && <2.1
69+ , text >=1.2.3.1 && <1.3
74
70
75 -- other dependencies
71 -- other dependencies
76 build-depends:
72 build-depends:
77− base-compat-batteries >=0.11.1 && <0.13
73+ base-compat-batteries >=0.11.1 && <0.12
78− , aeson >=1.4.2.0 && <1.6 || >=2.0.1.0 && < 2.1
74+ , aeson >=1.4.2.0 && <1.6
79 , aeson-pretty >=0.8.7 && <0.9
75 , aeson-pretty >=0.8.7 && <0.9
80 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
76 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
81 , cookie >=0.4.3 && <0.5
77 , cookie >=0.4.3 && <0.5
82 , generics-sop >=0.5.1.0 && <0.6
78 , generics-sop >=0.5.1.0 && <0.6
83− , hashable >=1.2.7.0 && <1.5
79+ , hashable >=1.2.7.0 && <1.4
84 , http-media >=0.8.0.0 && <0.9
80 , http-media >=0.8.0.0 && <0.9
85 , insert-ordered-containers >=0.2.3 && <0.3
81 , insert-ordered-containers >=0.2.3 && <0.3
86− , lens >=4.16.1 && <5.2
82+ , lens >=4.16.1 && <4.20
87 , network >=2.6.3.5 && <3.2
83 , network >=2.6.3.5 && <3.2
88− , optics-core >=0.2 && <0.5
84+ , optics-core >=0.2 && <0.4
89− , optics-th >=0.2 && <0.5
85+ , optics-th >=0.2 && <0.4
90 , scientific >=0.3.6.2 && <0.4
86 , scientific >=0.3.6.2 && <0.4
91 , unordered-containers >=0.2.9.0 && <0.3
87 , unordered-containers >=0.2.9.0 && <0.3
92 , uuid-types >=1.0.3 && <1.1
88 , uuid-types >=1.0.3 && <1.1
@@ -122,14 +118,14 @@ test-suite spec
122
118
123 -- test-suite only dependencies
119 -- test-suite only dependencies
124 build-depends:
120 build-depends:
125− hspec >=2.5.5 && <2.10
121+ hspec >=2.5.5 && <2.8
126 , HUnit >=1.6.0.0 && <1.7
122 , HUnit >=1.6.0.0 && <1.7
127 , quickcheck-instances >=0.3.19 && <0.14
123 , quickcheck-instances >=0.3.19 && <0.14
128 , utf8-string >=1.0.1.1 && <1.1
124 , utf8-string >=1.0.1.1 && <1.1
129
125
130 -- https://github.com/haskell/cabal/issues/3708
126 -- https://github.com/haskell/cabal/issues/3708
131 build-tool-depends:
127 build-tool-depends:
132− hspec-discover:hspec-discover >=2.5.5 && <2.10
128+ hspec-discover:hspec-discover >=2.5.5 && <2.8
133
129
134 other-modules:
130 other-modules:
135 SpecCommon
131 SpecCommon
src/Data/OpenApi.hs+20−141
@@ -91,7 +91,6 @@ module Data.OpenApi (
91 -- ** Security
91 -- ** Security
92 SecurityScheme(..),
92 SecurityScheme(..),
93 SecuritySchemeType(..),
93 SecuritySchemeType(..),
94− HttpSchemeType(..),
95 SecurityDefinitions(..),
94 SecurityDefinitions(..),
96 SecurityRequirement(..),
95 SecurityRequirement(..),
97
96
@@ -137,7 +136,6 @@ import Data.OpenApi.Internal
137-- >>> import Data.Proxy
136-- >>> import Data.Proxy
138-- >>> import GHC.Generics
137-- >>> import GHC.Generics
139-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
138-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
140−-- >>> import Data.OpenApi.Internal.Utils
141-- >>> :set -XDeriveGeneric
139-- >>> :set -XDeriveGeneric
142-- >>> :set -XOverloadedStrings
140-- >>> :set -XOverloadedStrings
143-- >>> :set -XOverloadedLists
141-- >>> :set -XOverloadedLists
@@ -154,16 +152,8 @@ import Data.OpenApi.Internal
154--
152--
155-- In this library you can use @'mempty'@ for a default/empty value. For instance:
153-- In this library you can use @'mempty'@ for a default/empty value. For instance:
156--
154--
157−-- >>> BSL.putStrLn $ encodePretty (mempty :: OpenApi)
155+-- >>> BSL.putStrLn $ encode (mempty :: OpenApi)
158−-- {
156+-- {"openapi":"3.0.0","info":{"version":"","title":""},"components":{}}
159−-- "components": {},
160−-- "info": {
161−-- "title": "",
162−-- "version": ""
163−-- },
164−-- "openapi": "3.0.0",
165−-- "paths": {}
166−-- }
167--
157--
168-- As you can see some spec properties (e.g. @"version"@) are there even when the spec is empty.
158-- As you can see some spec properties (e.g. @"version"@) are there even when the spec is empty.
169-- That is because these properties are actually required ones.
159-- That is because these properties are actually required ones.
@@ -171,20 +161,13 @@ import Data.OpenApi.Internal
171-- You /should/ always override the default (empty) value for these properties,
161-- You /should/ always override the default (empty) value for these properties,
172-- although it is not strictly necessary:
162-- although it is not strictly necessary:
173--
163--
174−-- >>> BSL.putStrLn $ encodePretty mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
164+-- >>> BSL.putStrLn $ encode mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }
175−-- {
176−-- "title": "Todo API",
177−-- "version": "1.0"
165+-- {"version":"1.0","title":"Todo API"}
178−-- }
179--
166--
180-- You can merge two values using @'mappend'@ or its infix version @('<>')@:
167-- You can merge two values using @'mappend'@ or its infix version @('<>')@:
181--
168--
182−-- >>> BSL.putStrLn $ encodePretty $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
169+-- >>> BSL.putStrLn $ encode $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }
183−-- {
184−-- "title": "Todo API",
185−-- "version": "1.0"
170+-- {"version":"1.0","title":"Todo API"}
186−-- }
187−
188--
171--
189-- This can be useful for combining specifications of endpoints into a whole API specification:
172-- This can be useful for combining specifications of endpoints into a whole API specification:
190--
173--
@@ -210,48 +193,14 @@ import Data.OpenApi.Internal
210-- make it fairly simple to construct/modify any part of the specification:
193-- make it fairly simple to construct/modify any part of the specification:
211--
194--
212-- >>> :{
195-- >>> :{
213−-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
196+-- BSL.putStrLn $ encode $ (mempty :: OpenApi)
214-- & components . schemas .~ [ ("User", mempty & type_ ?~ OpenApiString) ]
197-- & components . schemas .~ [ ("User", mempty & type_ ?~ OpenApiString) ]
215-- & paths .~
198-- & paths .~
216-- [ ("/user", mempty & get ?~ (mempty
199-- [ ("/user", mempty & get ?~ (mempty
217-- & at 200 ?~ ("OK" & _Inline.content.at "application/json" ?~ (mempty & schema ?~ Ref (Reference "User")))
200-- & at 200 ?~ ("OK" & _Inline.content.at "application/json" ?~ (mempty & schema ?~ Ref (Reference "User")))
218-- & at 404 ?~ "User info not found")) ]
201-- & at 404 ?~ "User info not found")) ]
219-- :}
202-- :}
220−-- {
203+-- {"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"}}}}
221−-- "components": {
222−-- "schemas": {
223−-- "User": {
224−-- "type": "string"
225−-- }
226−-- }
227−-- },
228−-- "info": {
229−-- "title": "",
230−-- "version": ""
231−-- },
232−-- "openapi": "3.0.0",
233−-- "paths": {
234−-- "/user": {
235−-- "get": {
236−-- "responses": {
237−-- "200": {
238−-- "content": {
239−-- "application/json": {
240−-- "schema": {
241−-- "$ref": "#/components/schemas/User"
242−-- }
243−-- }
244−-- },
245−-- "description": "OK"
246−-- },
247−-- "404": {
248−-- "description": "User info not found"
249−-- }
250−-- }
251−-- }
252−-- }
253−-- }
254−-- }
255--
204--
256-- In the snippet above we declare an API with a single path @/user@. This path provides method @GET@
205-- In the snippet above we declare an API with a single path @/user@. This path provides method @GET@
257-- which produces @application/json@ output. It should respond with code @200@ and body specified
206-- which produces @application/json@ output. It should respond with code @200@ and body specified
@@ -263,34 +212,23 @@ import Data.OpenApi.Internal
263-- common field is @'description'@. Many components of a Swagger specification
212-- common field is @'description'@. Many components of a Swagger specification
264-- can have descriptions, and you can use the same name for them:
213-- can have descriptions, and you can use the same name for them:
265--
214--
266−-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & description .~ "No content"
215+-- >>> BSL.putStrLn $ encode $ (mempty :: Response) & description .~ "No content"
267−-- {
268−-- "description": "No content"
216+-- {"description":"No content"}
269−-- }
270-- >>> :{
217-- >>> :{
271−-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)
218+-- BSL.putStrLn $ encode $ (mempty :: Schema)
272-- & type_ ?~ OpenApiBoolean
219-- & type_ ?~ OpenApiBoolean
273-- & description ?~ "To be or not to be"
220-- & description ?~ "To be or not to be"
274-- :}
221-- :}
275−-- {
276−-- "description": "To be or not to be",
222+-- {"type":"boolean","description":"To be or not to be"}
277−-- "type": "boolean"
278−-- }
279--
223--
280-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
224-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
281-- have direct access to it via @'at' code@. Example:
225-- have direct access to it via @'at' code@. Example:
282--
226--
283-- >>> :{
227-- >>> :{
284−-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)
228+-- BSL.putStrLn $ encode $ (mempty :: Operation)
285-- & at 404 ?~ "Not found"
229-- & at 404 ?~ "Not found"
286-- :}
230-- :}
287−-- {
288−-- "responses": {
289−-- "404": {
290−-- "description": "Not found"
231+-- {"responses":{"404":{"description":"Not found"}}}
291−-- }
292−-- }
293−-- }
294--
232--
295-- You might've noticed that @'type_'@ has an extra underscore in its name
233-- You might've noticed that @'type_'@ has an extra underscore in its name
296-- compared to, say, @'description'@ field accessor.
234-- compared to, say, @'description'@ field accessor.
@@ -337,27 +275,10 @@ import Data.OpenApi.Internal
337-- >>> data Person = Person { name :: String, age :: Integer } deriving Generic
275-- >>> data Person = Person { name :: String, age :: Integer } deriving Generic
338-- >>> instance ToJSON Person
276-- >>> instance ToJSON Person
339-- >>> instance ToSchema Person
277-- >>> instance ToSchema Person
340−-- >>> BSL.putStrLn $ encodePretty (Person "David" 28)
278+-- >>> BSL.putStrLn $ encode (Person "David" 28)
341−-- {
342−-- "age": 28,
343−-- "name": "David"
279+-- {"age":28,"name":"David"}
344−-- }
345−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Person)
280+-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Person)
346−-- {
281+-- {"required":["name","age"],"type":"object","properties":{"age":{"type":"integer"},"name":{"type":"string"}}}
347−-- "properties": {
348−-- "age": {
349−-- "type": "integer"
350−-- },
351−-- "name": {
352−-- "type": "string"
353−-- }
354−-- },
355−-- "required": [
356−-- "name",
357−-- "age"
358−-- ],
359−-- "type": "object"
360−-- }
361--
282--
362-- This package implements OpenAPI 3.0 spec, which supports @oneOf@ in schemas, allowing any sum types
283-- This package implements OpenAPI 3.0 spec, which supports @oneOf@ in schemas, allowing any sum types
363-- to be faithfully represented. All sum encodings supported by @aeson@ are supported here as well, with
284-- to be faithfully represented. All sum encodings supported by @aeson@ are supported here as well, with
@@ -368,50 +289,8 @@ import Data.OpenApi.Internal
368-- >>> data Error = ErrorNoUser { userId :: Int } | ErrorAccessDenied { requiredPermission :: String } deriving Generic
289-- >>> data Error = ErrorNoUser { userId :: Int } | ErrorAccessDenied { requiredPermission :: String } deriving Generic
369-- >>> instance ToJSON Error
290-- >>> instance ToJSON Error
370-- >>> instance ToSchema Error
291-- >>> instance ToSchema Error
371−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Error)
292+-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Error)
372−-- {
293+-- {"oneOf":[{"required":["userId","tag"],"type":"object","properties":{"tag":{"type":"string","enum":["ErrorNoUser"]},"userId":{"maximum":9223372036854775807,"minimum":-9223372036854775808,"type":"integer"}}},{"required":["requiredPermission","tag"],"type":"object","properties":{"tag":{"type":"string","enum":["ErrorAccessDenied"]},"requiredPermission":{"type":"string"}}}],"type":"object"}
373−-- "oneOf": [
374−-- {
375−-- "properties": {
376−-- "tag": {
377−-- "enum": [
378−-- "ErrorNoUser"
379−-- ],
380−-- "type": "string"
381−-- },
382−-- "userId": {
383−-- "maximum": 9223372036854775807,
384−-- "minimum": -9223372036854775808,
385−-- "type": "integer"
386−-- }
387−-- },
388−-- "required": [
389−-- "userId",
390−-- "tag"
391−-- ],
392−-- "type": "object"
393−-- },
394−-- {
395−-- "properties": {
396−-- "requiredPermission": {
397−-- "type": "string"
398−-- },
399−-- "tag": {
400−-- "enum": [
401−-- "ErrorAccessDenied"
402−-- ],
403−-- "type": "string"
404−-- }
405−-- },
406−-- "required": [
407−-- "requiredPermission",
408−-- "tag"
409−-- ],
410−-- "type": "object"
411−-- }
412−-- ],
413−-- "type": "object"
414−-- }
415
294
416-- $manipulation
295-- $manipulation
417-- Sometimes you have to work with an imported or generated @'Swagger'@.
296-- Sometimes you have to work with an imported or generated @'Swagger'@.
src/Data/OpenApi/Aeson/Compat.hsdeleted−76
@@ -1,76 +0,0 @@
1−{-# LANGUAGE CPP #-}
2−
3−module Data.OpenApi.Aeson.Compat where
4−
5−#if MIN_VERSION_aeson(2,0,0)
6−import Data.Aeson (Key)
7−import qualified Data.Aeson.Key as Key
8−import qualified Data.Aeson.KeyMap as KeyMap
9−#else
10−import qualified Data.HashMap.Strict as HM
11−#endif
12−import Data.Bifunctor (first)
13−import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
14−import qualified Data.Text as T
15−
16−#if MIN_VERSION_aeson(2,0,0)
17−deleteKey :: Key -> KeyMap.KeyMap v -> KeyMap.KeyMap v
18−deleteKey = KeyMap.delete
19−
20−objectToList :: KeyMap.KeyMap v -> [(Key, v)]
21−objectToList = KeyMap.toList
22−
23−objectKeys :: KeyMap.KeyMap v -> [T.Text]
24−objectKeys = map Key.toText . KeyMap.keys
25−
26−stringToKey :: String -> Key
27−stringToKey = Key.fromString
28−
29−keyToString :: Key -> String
30−keyToString = Key.toString
31−
32−keyToText :: Key -> T.Text
33−keyToText = Key.toText
34−
35−toInsOrdHashMap :: KeyMap.KeyMap v -> InsOrdHashMap.InsOrdHashMap T.Text v
36−toInsOrdHashMap = InsOrdHashMap.fromList . fmap (first Key.toText) . KeyMap.toList
37−
38−fromInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap T.Text v -> KeyMap.KeyMap v
39−fromInsOrdHashMap = KeyMap.fromList . fmap (first Key.fromText) . InsOrdHashMap.toList
40−
41−lookupKey :: T.Text -> KeyMap.KeyMap v -> Maybe v
42−lookupKey = KeyMap.lookup . Key.fromText
43−
44−hasKey :: T.Text -> KeyMap.KeyMap a -> Bool
45−hasKey = KeyMap.member . Key.fromText
46−#else
47−deleteKey :: T.Text -> HM.HashMap T.Text v -> HM.HashMap T.Text v
48−deleteKey = HM.delete
49−
50−objectToList :: HM.HashMap T.Text v -> [(T.Text, v)]
51−objectToList = HM.toList
52−
53−objectKeys :: HM.HashMap T.Text v -> [T.Text]
54−objectKeys = HM.keys
55−
56−stringToKey :: String -> T.Text
57−stringToKey = T.pack
58−
59−keyToString :: T.Text -> String
60−keyToString = T.unpack
61−
62−keyToText :: T.Text -> T.Text
63−keyToText = id
64−
65−toInsOrdHashMap :: HM.HashMap T.Text v -> InsOrdHashMap.InsOrdHashMap T.Text v
66−toInsOrdHashMap = InsOrdHashMap.fromHashMap
67−
68−fromInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap T.Text v -> HM.HashMap T.Text v
69−fromInsOrdHashMap = InsOrdHashMap.toHashMap
70−
71−lookupKey :: T.Text -> HM.HashMap T.Text v -> Maybe v
72−lookupKey = HM.lookup
73−
74−hasKey :: T.Text -> HM.HashMap T.Text a -> Bool
75−hasKey = HM.member
76−#endif
src/Data/OpenApi/Internal.hs+21−88
@@ -1,4 +1,3 @@
1−{-# LANGUAGE CPP #-}
2{-# LANGUAGE DataKinds #-}
1{-# LANGUAGE DataKinds #-}
3{-# LANGUAGE DeriveDataTypeable #-}
2{-# LANGUAGE DeriveDataTypeable #-}
4{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE DeriveGeneric #-}
@@ -22,9 +21,6 @@ import Prelude.Compat
22import Control.Applicative
21import Control.Applicative
23import Control.Lens ((&), (.~), (?~))
22import Control.Lens ((&), (.~), (?~))
24import Data.Aeson hiding (Encoding)
23import Data.Aeson hiding (Encoding)
25−#if MIN_VERSION_aeson(2,0,0)
26−import qualified Data.Aeson.KeyMap as KeyMap
27−#endif
28import qualified Data.Aeson.Types as JSON
24import qualified Data.Aeson.Types as JSON
29import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable,
25import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable,
30 constrIndex, mkConstr, mkDataType)
26 constrIndex, mkConstr, mkDataType)
@@ -49,19 +45,21 @@ import Text.Read (readMaybe)
49import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
45import Data.HashMap.Strict.InsOrd (InsOrdHashMap)
50import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
46import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
51
47
52−import Data.OpenApi.Aeson.Compat (deleteKey)
53−import Data.OpenApi.Internal.AesonUtils (AesonDefaultValue (..), HasSwaggerAesonOptions (..),
54− mkSwaggerAesonOptions, saoAdditionalPairs, saoSubObject,
55− sopSwaggerGenericParseJSON, sopSwaggerGenericToEncoding,
56− sopSwaggerGenericToJSON, sopSwaggerGenericToJSONWithOpts)
57−import Data.OpenApi.Internal.Utils
58import Generics.SOP.TH (deriveGeneric)
48import Generics.SOP.TH (deriveGeneric)
49+import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToJSON
50+ ,sopSwaggerGenericToJSONWithOpts
51+ ,sopSwaggerGenericParseJSON
52+ ,HasSwaggerAesonOptions(..)
53+ ,AesonDefaultValue(..)
54+ ,mkSwaggerAesonOptions
55+ ,saoAdditionalPairs
56+ ,saoSubObject)
57+import Data.OpenApi.Internal.Utils
58+import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToEncoding)
59
59
60-- $setup
60-- $setup
61-- >>> :seti -XDataKinds
61-- >>> :seti -XDataKinds
62-- >>> import Data.Aeson
62-- >>> import Data.Aeson
63−-- >>> import Data.ByteString.Lazy.Char8 as BSL
64−-- >>> import Data.OpenApi.Internal.Utils
65
63
66-- | A list of definitions that can be used in references.
64-- | A list of definitions that can be used in references.
67type Definitions = InsOrdHashMap Text
65type Definitions = InsOrdHashMap Text
@@ -196,7 +194,7 @@ data Components = Components
196 , _componentsExamples :: Definitions Example
194 , _componentsExamples :: Definitions Example
197 , _componentsRequestBodies :: Definitions RequestBody
195 , _componentsRequestBodies :: Definitions RequestBody
198 , _componentsHeaders :: Definitions Header
196 , _componentsHeaders :: Definitions Header
199− , _componentsSecuritySchemes :: SecurityDefinitions
197+ , _componentsSecuritySchemes :: Definitions SecurityScheme
200 , _componentsLinks :: Definitions Link
198 , _componentsLinks :: Definitions Link
201 , _componentsCallbacks :: Definitions Callback
199 , _componentsCallbacks :: Definitions Callback
202 } deriving (Eq, Show, Generic, Data, Typeable)
200 } deriving (Eq, Show, Generic, Data, Typeable)
@@ -337,7 +335,7 @@ data RequestBody = RequestBody
337 -- | The content of the request body.
335 -- | The content of the request body.
338 -- The key is a media type or media type range and the value describes it.
336 -- The key is a media type or media type range and the value describes it.
339 -- For requests that match multiple keys, only the most specific key is applicable.
337 -- For requests that match multiple keys, only the most specific key is applicable.
340− -- e.g. @text/plain@ overrides @text/\*@
338+ -- e.g. @text/plain@ overrides @text/*@
341 , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject
339 , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject
342
340
343 -- | Determines if the request body is required in the request.
341 -- | Determines if the request body is required in the request.
@@ -394,7 +392,7 @@ data Encoding = Encoding
394 -- for other primitive types – @text/plain@; for object - @application/json@;
392 -- for other primitive types – @text/plain@; for object - @application/json@;
395 -- for array – the default is defined based on the inner type.
393 -- for array – the default is defined based on the inner type.
396 -- The value can be a specific media type (e.g. @application/json@),
394 -- The value can be a specific media type (e.g. @application/json@),
397− -- a wildcard media type (e.g. @image/\*@), or a comma-separated list of the two types.
395+ -- a wildcard media type (e.g. @image/*@), or a comma-separated list of the two types.
398 _encodingContentType :: Maybe MediaType
396 _encodingContentType :: Maybe MediaType
399
397
400 -- | A map allowing additional information to be provided as headers,
398 -- | A map allowing additional information to be provided as headers,
@@ -734,7 +732,7 @@ data Response = Response
734 -- | A map containing descriptions of potential response payloads.
732 -- | A map containing descriptions of potential response payloads.
735 -- The key is a media type or media type range and the value describes it.
733 -- The key is a media type or media type range and the value describes it.
736 -- For responses that match multiple keys, only the most specific key is applicable.
734 -- For responses that match multiple keys, only the most specific key is applicable.
737− -- e.g. @text/plain@ overrides @text/\*@.
735+ -- e.g. @text/plain@ overrides @text/*@.
738 , _responseContent :: InsOrdHashMap MediaType MediaTypeObject
736 , _responseContent :: InsOrdHashMap MediaType MediaTypeObject
739
737
740 -- | Maps a header name to its definition.
738 -- | Maps a header name to its definition.
@@ -840,50 +838,8 @@ data OAuth2Flows = OAuth2Flows
840 , _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
838 , _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)
841 } deriving (Eq, Show, Generic, Data, Typeable)
839 } deriving (Eq, Show, Generic, Data, Typeable)
842
840
843−type BearerFormat = Text
844−
845−data HttpSchemeType
846− = HttpSchemeBearer (Maybe BearerFormat)
847− | HttpSchemeBasic
848− | HttpSchemeCustom Text
849− deriving (Eq, Show, Generic, Data, Typeable)
850−
851−-- |
852−--
853−-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp (HttpSchemeBearer Nothing))
854−-- {
855−-- "scheme": "bearer",
856−-- "type": "http"
857−-- }
858−--
859−-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp (HttpSchemeBearer (Just "jwt")))
860−-- {
861−-- "bearerFormat": "jwt",
862−-- "scheme": "bearer",
863−-- "type": "http"
864−-- }
865−--
866−-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp HttpSchemeBasic)
867−-- {
868−-- "scheme": "basic",
869−-- "type": "http"
870−-- }
871−--
872−-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeHttp (HttpSchemeCustom "CANARY"))
873−-- {
874−-- "scheme": "CANARY",
875−-- "type": "http"
876−-- }
877−--
878−-- >>> BSL.putStrLn $ encodePretty (SecuritySchemeApiKey (ApiKeyParams "id" ApiKeyCookie))
879−-- {
880−-- "in": "cookie",
881−-- "name": "id",
882−-- "type": "apiKey"
883−-- }
884−--
885data SecuritySchemeType
841data SecuritySchemeType
886− = SecuritySchemeHttp HttpSchemeType
842+ = SecuritySchemeHttp
887 | SecuritySchemeApiKey ApiKeyParams
843 | SecuritySchemeApiKey ApiKeyParams
888 | SecuritySchemeOAuth2 OAuth2Flows
844 | SecuritySchemeOAuth2 OAuth2Flows
889 | SecuritySchemeOpenIdConnect URL
845 | SecuritySchemeOpenIdConnect URL
@@ -1125,7 +1081,6 @@ instance SwaggerMonoid Response
1125instance SwaggerMonoid ExternalDocs
1081instance SwaggerMonoid ExternalDocs
1126instance SwaggerMonoid Operation
1082instance SwaggerMonoid Operation
1127instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
1083instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
1128−instance SwaggerMonoid SecurityDefinitions
1129
1084
1130instance SwaggerMonoid MimeList
1085instance SwaggerMonoid MimeList
1131deriving instance SwaggerMonoid URL
1086deriving instance SwaggerMonoid URL
@@ -1274,19 +1229,8 @@ instance ToJSON OAuth2Flows where
1274 toEncoding = sopSwaggerGenericToEncoding
1229 toEncoding = sopSwaggerGenericToEncoding
1275
1230
1276instance ToJSON SecuritySchemeType where
1231instance ToJSON SecuritySchemeType where
1277− toJSON (SecuritySchemeHttp ty) = case ty of
1232+ toJSON SecuritySchemeHttp
1278− HttpSchemeBearer mFmt ->
1279− object $ [ "type" .= ("http" :: Text)
1280− , "scheme" .= ("bearer" :: Text)
1281− ] <> maybe [] (\t -> ["bearerFormat" .= t]) mFmt
1282− HttpSchemeBasic ->
1283− object [ "type" .= ("http" :: Text)
1284− , "scheme" .= ("basic" :: Text)
1285− ]
1286− HttpSchemeCustom t ->
1287− object [ "type" .= ("http" :: Text)
1233+ = object [ "type" .= ("http" :: Text) ]
1288− , "scheme" .= t
1289− ]
1290 toJSON (SecuritySchemeApiKey params)
1234 toJSON (SecuritySchemeApiKey params)
1291 = toJSON params
1235 = toJSON params
1292 <+> object [ "type" .= ("apiKey" :: Text) ]
1236 <+> object [ "type" .= ("apiKey" :: Text) ]
@@ -1325,12 +1269,8 @@ instance ToJSON Header where
1325-- | As for nullary schema for 0-arity type constructors, see
1269-- | As for nullary schema for 0-arity type constructors, see
1326-- <https://github.com/GetShopTV/swagger2/issues/167>.
1270-- <https://github.com/GetShopTV/swagger2/issues/167>.
1327--
1271--
1328−-- >>> BSL.putStrLn $ encodePretty (OpenApiItemsArray [])
1272+-- >>> encode (OpenApiItemsArray [])
1329−-- {
1330−-- "example": [],
1331−-- "items": {},
1332−-- "maxItems": 0
1273+-- "{\"example\":[],\"items\":{},\"maxItems\":0}"
1333−-- }
1334--
1274--
1335instance ToJSON OpenApiItems where
1275instance ToJSON OpenApiItems where
1336 toJSON (OpenApiItemsObject x) = object [ "items" .= x ]
1276 toJSON (OpenApiItemsObject x) = object [ "items" .= x ]
@@ -1439,12 +1379,7 @@ instance FromJSON SecuritySchemeType where
1439 parseJSON js@(Object o) = do
1379 parseJSON js@(Object o) = do
1440 (t :: Text) <- o .: "type"
1380 (t :: Text) <- o .: "type"
1441 case t of
1381 case t of
1442− "http" -> do
1443− scheme <- o .: "scheme"
1444− SecuritySchemeHttp <$> case scheme of
1382+ "http" -> pure SecuritySchemeHttp
1445− "bearer" -> HttpSchemeBearer <$> (o .:! "bearerFormat")
1446− "basic" -> pure HttpSchemeBasic
1447− t -> pure $ HttpSchemeCustom t
1448 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1383 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js
1449 "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")
1384 "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")
1450 "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")
1385 "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")
@@ -1492,7 +1427,7 @@ instance FromJSON Param where
1492instance FromJSON Responses where
1427instance FromJSON Responses where
1493 parseJSON (Object o) = Responses
1428 parseJSON (Object o) = Responses
1494 <$> o .:? "default"
1429 <$> o .:? "default"
1495− <*> parseJSON (Object (deleteKey "default" o))
1430+ <*> parseJSON (Object (HashMap.delete "default" o))
1496 parseJSON _ = empty
1431 parseJSON _ = empty
1497
1432
1498instance FromJSON Example where
1433instance FromJSON Example where
@@ -1615,5 +1550,3 @@ instance AesonDefaultValue MimeList where defaultValue = Just mempty
1615instance AesonDefaultValue Info
1550instance AesonDefaultValue Info
1616instance AesonDefaultValue ParamLocation
1551instance AesonDefaultValue ParamLocation
1617instance AesonDefaultValue Link
1552instance AesonDefaultValue Link
1618−instance AesonDefaultValue SecurityDefinitions where
1619− defaultValue = Just mempty
src/Data/OpenApi/Internal/AesonUtils.hs+10−11
@@ -36,19 +36,18 @@ import Data.Text (Text)
36import Generics.SOP
36import Generics.SOP
37
37
38import qualified Data.Text as T
38import qualified Data.Text as T
39+import qualified Data.HashMap.Strict as HM
39import qualified Data.Set as Set
40import qualified Data.Set as Set
40import qualified Data.HashMap.Strict.InsOrd as InsOrd
41import qualified Data.HashMap.Strict.InsOrd as InsOrd
41import qualified Data.HashSet.InsOrd as InsOrdHS
42import qualified Data.HashSet.InsOrd as InsOrdHS
42
43
43−import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)
44−
45-------------------------------------------------------------------------------
44-------------------------------------------------------------------------------
46-- SwaggerAesonOptions
45-- SwaggerAesonOptions
47-------------------------------------------------------------------------------
46-------------------------------------------------------------------------------
48
47
49data SwaggerAesonOptions = SwaggerAesonOptions
48data SwaggerAesonOptions = SwaggerAesonOptions
50 { _saoPrefix :: String
49 { _saoPrefix :: String
51− , _saoAdditionalPairs :: [Pair]
50+ , _saoAdditionalPairs :: [(Text, Value)]
52 , _saoSubObject :: Maybe String
51 , _saoSubObject :: Maybe String
53 }
52 }
54
53
@@ -155,14 +154,14 @@ sopSwaggerGenericToJSON'' (SwaggerAesonOptions prefix _ sub) = go
155 go Nil Nil Nil = []
154 go Nil Nil Nil = []
156 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
155 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
157 | Just name' == sub = case json of
156 | Just name' == sub = case json of
158− Object m -> objectToList m ++ rest
157+ Object m -> HM.toList m ++ rest
159 Null -> rest
158 Null -> rest
160 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
159 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json
161 -- If default value: omit it.
160 -- If default value: omit it.
162 | Just x == def =
161 | Just x == def =
163 rest
162 rest
164 | otherwise =
163 | otherwise =
165− (stringToKey name', json) : rest
164+ (T.pack name', json) : rest
166 where
165 where
167 json = toJSON x
166 json = toJSON x
168 name' = fieldNameModifier name
167 name' = fieldNameModifier name
@@ -196,11 +195,11 @@ sopSwaggerGenericParseJSON = withObject "Swagger Record Object" $ \obj ->
196 proxy = Proxy :: Proxy a
195 proxy = Proxy :: Proxy a
197 opts = swaggerAesonOptions proxy
196 opts = swaggerAesonOptions proxy
198
197
199− parseAdditionalField :: Object -> Pair -> Parser ()
198+ parseAdditionalField :: Object -> (Text, Value) -> Parser ()
200 parseAdditionalField obj (k, v) = do
199 parseAdditionalField obj (k, v) = do
201 v' <- obj .: k
200 v' <- obj .: k
202 unless (v == v') $ fail $
201 unless (v == v') $ fail $
203− "Additonal field don't match for key " ++ keyToString k
202+ "Additonal field don't match for key " ++ T.unpack k
204 ++ ": " ++ show v
203 ++ ": " ++ show v
205 ++ " /= " ++ show v'
204 ++ " /= " ++ show v'
206
205
@@ -231,8 +230,8 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go
231 -- Note: we might strip fields of outer structure.
230 -- Note: we might strip fields of outer structure.
232 cons <$> (withDef $ parseJSON $ Object obj) <*> rest
231 cons <$> (withDef $ parseJSON $ Object obj) <*> rest
233 | otherwise = case def of
232 | otherwise = case def of
234− Just def' -> cons <$> obj .:? stringToKey name' .!= def' <*> rest
233+ Just def' -> cons <$> obj .:? T.pack name' .!= def' <*> rest
235− Nothing -> cons <$> obj .: stringToKey name' <*> rest
234+ Nothing -> cons <$> obj .: T.pack name' <*> rest
236 where
235 where
237 cons h t = I h :* t
236 cons h t = I h :* t
238 name' = fieldNameModifier name
237 name' = fieldNameModifier name
@@ -295,14 +294,14 @@ sopSwaggerGenericToEncoding'' (SwaggerAesonOptions prefix _ sub) = go
295 go Nil Nil Nil = mempty
294 go Nil Nil Nil = mempty
296 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
295 go (I x :* xs) (FieldInfo name :* names) (def :* defs)
297 | Just name' == sub = case toJSON x of
296 | Just name' == sub = case toJSON x of
298− Object m -> pairsToSeries (objectToList m) <> rest
297+ Object m -> pairsToSeries (HM.toList m) <> rest
299 Null -> rest
298 Null -> rest
300 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
299 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)
301 -- If default value: omit it.
300 -- If default value: omit it.
302 | Just x == def =
301 | Just x == def =
303 rest
302 rest
304 | otherwise =
303 | otherwise =
305− (stringToKey name' .= x) <> rest
304+ (T.pack name' .= x) <> rest
306 where
305 where
307 name' = fieldNameModifier name
306 name' = fieldNameModifier name
308 rest = go xs names defs
307 rest = go xs names defs
src/Data/OpenApi/Internal/ParamSchema.hs+11−29
@@ -46,7 +46,7 @@ import Data.OpenApi.Lens
46import Data.OpenApi.SchemaOptions
46import Data.OpenApi.SchemaOptions
47
47
48import qualified Data.ByteString as BS
48import qualified Data.ByteString as BS
49−import qualified Data.ByteString.Lazy.Char8 as BSL
49+import qualified Data.ByteString.Lazy as BSL
50import GHC.TypeLits (TypeError, ErrorMessage(..))
50import GHC.TypeLits (TypeError, ErrorMessage(..))
51
51
52-- | Default schema for binary data (any sequence of octets).
52-- | Default schema for binary data (any sequence of octets).
@@ -112,10 +112,8 @@ passwordSchema = mempty
112class ToParamSchema a where
112class ToParamSchema a where
113 -- | Convert a type into a plain parameter schema.
113 -- | Convert a type into a plain parameter schema.
114 --
114 --
115− -- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy Integer)
115+ -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)
116− -- {
117− -- "type": "integer"
116+ -- "{\"type\":\"integer\"}"
118− -- }
119 toParamSchema :: Proxy a -> Schema
117 toParamSchema :: Proxy a -> Schema
120 default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> Schema
118 default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> Schema
121 toParamSchema = genericToParamSchema defaultSchemaOptions
119 toParamSchema = genericToParamSchema defaultSchemaOptions
@@ -157,12 +155,8 @@ instance ToParamSchema Word64 where
157
155
158-- | Default plain schema for @'Bounded'@, @'Integral'@ types.
156-- | Default plain schema for @'Bounded'@, @'Integral'@ types.
159--
157--
160−-- >>> BSL.putStrLn $ encodePretty $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
158+-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)
161−-- {
162−-- "maximum": 127,
163−-- "minimum": -128,
164−-- "type": "integer"
159+-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
165−-- }
166toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> Schema
160toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> Schema
167toParamSchemaBoundedIntegral _ = mempty
161toParamSchemaBoundedIntegral _ = mempty
168 & type_ ?~ OpenApiInteger
162 & type_ ?~ OpenApiInteger
@@ -216,9 +210,9 @@ instance ToParamSchema LocalTime where
216
210
217-- |
211-- |
218-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
212-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format
219−-- Just "date-time"
213+-- Just "yyyy-mm-ddThh:MM:ss+hhMM"
220instance ToParamSchema ZonedTime where
214instance ToParamSchema ZonedTime where
221− toParamSchema _ = timeParamSchema "date-time"
215+ toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+hhMM"
222
216
223-- |
217-- |
224-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format
218-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format
@@ -281,13 +275,8 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
281 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
275 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))
282
276
283-- |
277-- |
284−-- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy ())
278+-- >>> encode $ toParamSchema (Proxy :: Proxy ())
285−-- {
286−-- "enum": [
279+-- "{\"type\":\"string\",\"enum\":[\"_\"]}"
287−-- "_"
288−-- ],
289−-- "type": "string"
290−-- }
291instance ToParamSchema () where
280instance ToParamSchema () where
292 toParamSchema _ = mempty
281 toParamSchema _ = mempty
293 & type_ ?~ OpenApiString
282 & type_ ?~ OpenApiString
@@ -302,14 +291,8 @@ instance ToParamSchema UUID where
302--
291--
303-- >>> :set -XDeriveGeneric
292-- >>> :set -XDeriveGeneric
304-- >>> data Color = Red | Blue deriving Generic
293-- >>> data Color = Red | Blue deriving Generic
305−-- >>> BSL.putStrLn $ encodePretty $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
294+-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)
306−-- {
295+-- "{\"type\":\"string\",\"enum\":[\"Red\",\"Blue\"]}"
307−-- "enum": [
308−-- "Red",
309−-- "Blue"
310−-- ],
311−-- "type": "string"
312−-- }
313genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> Schema
296genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> Schema
314genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
297genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty
315
298
@@ -351,4 +334,3 @@ data Proxy3 a b c = Proxy3
351
334
352-- $setup
335-- $setup
353-- >>> import Data.Aeson (encode)
336-- >>> import Data.Aeson (encode)
354−-- >>> import Data.OpenApi.Internal.Utils
src/Data/OpenApi/Internal/Schema.hs+72−334
@@ -1,17 +1,15 @@
1−{-# LANGUAGE CPP #-}
2{-# LANGUAGE ConstraintKinds #-}
1{-# LANGUAGE ConstraintKinds #-}
3−{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DefaultSignatures #-}
2{-# LANGUAGE DefaultSignatures #-}
5{-# LANGUAGE FlexibleContexts #-}
3{-# LANGUAGE FlexibleContexts #-}
6{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
7{-# LANGUAGE KindSignatures #-}
5{-# LANGUAGE KindSignatures #-}
6+{-# LANGUAGE DataKinds #-}
8{-# LANGUAGE OverloadedLists #-}
7{-# LANGUAGE OverloadedLists #-}
9{-# LANGUAGE OverloadedStrings #-}
8{-# LANGUAGE OverloadedStrings #-}
10{-# LANGUAGE PackageImports #-}
9{-# LANGUAGE PackageImports #-}
11{-# LANGUAGE PolyKinds #-}
10{-# LANGUAGE PolyKinds #-}
12{-# LANGUAGE ScopedTypeVariables #-}
11{-# LANGUAGE ScopedTypeVariables #-}
13{-# LANGUAGE TupleSections #-}
12{-# LANGUAGE TupleSections #-}
14−{-# LANGUAGE TypeApplications #-}
15{-# LANGUAGE TypeFamilies #-}
13{-# LANGUAGE TypeFamilies #-}
16{-# LANGUAGE TypeOperators #-}
14{-# LANGUAGE TypeOperators #-}
17{-# LANGUAGE TypeSynonymInstances #-}
15{-# LANGUAGE TypeSynonymInstances #-}
@@ -42,7 +40,6 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
42import Data.Int
40import Data.Int
43import Data.IntSet (IntSet)
41import Data.IntSet (IntSet)
44import Data.IntMap (IntMap)
42import Data.IntMap (IntMap)
45−import Data.List (sort)
46import Data.List.NonEmpty.Compat (NonEmpty)
43import Data.List.NonEmpty.Compat (NonEmpty)
47import Data.Map (Map)
44import Data.Map (Map)
48import Data.Maybe (fromMaybe)
45import Data.Maybe (fromMaybe)
@@ -62,16 +59,14 @@ import Numeric.Natural.Compat (Natural)
62import Data.Word
59import Data.Word
63import GHC.Generics
60import GHC.Generics
64import qualified Data.UUID.Types as UUID
61import qualified Data.UUID.Types as UUID
65−import Type.Reflection (Typeable, typeRep)
66
62
67−import Data.OpenApi.Aeson.Compat (keyToText, objectKeys, toInsOrdHashMap)
68−import Data.OpenApi.Declare
63+import Data.OpenApi.Declare
69−import Data.OpenApi.Internal
64+import Data.OpenApi.Internal
70−import Data.OpenApi.Internal.ParamSchema (ToParamSchema (..))
65+import Data.OpenApi.Internal.ParamSchema (ToParamSchema(..))
71−import Data.OpenApi.Internal.TypeShape
72−import Data.OpenApi.Lens hiding (name, schema)
66+import Data.OpenApi.Lens hiding (name, schema)
73−import qualified Data.OpenApi.Lens as Swagger
67+import qualified Data.OpenApi.Lens as Swagger
74−import Data.OpenApi.SchemaOptions
68+import Data.OpenApi.SchemaOptions
69+import Data.OpenApi.Internal.TypeShape
75
70
76import qualified Data.ByteString as BS
71import qualified Data.ByteString as BS
77import qualified Data.ByteString.Lazy.Char8 as BSL
72import qualified Data.ByteString.Lazy.Char8 as BSL
@@ -136,7 +131,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
136--
131--
137-- instance ToSchema Coord
132-- instance ToSchema Coord
138-- @
133-- @
139−class Typeable a => ToSchema a where
134+class ToSchema a where
140 -- | Convert a type into an optionally named schema
135 -- | Convert a type into an optionally named schema
141 -- together with all used definitions.
136 -- together with all used definitions.
142 -- Note that the schema itself is included in definitions
137 -- Note that the schema itself is included in definitions
@@ -158,19 +153,13 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema
158--
153--
159-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
154-- >>> toNamedSchema (Proxy :: Proxy String) ^. name
160-- Nothing
155-- Nothing
161−-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy String) ^. schema)
156+-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy String) ^. schema)
162−-- {
163−-- "type": "string"
157+-- {"type":"string"}
164−-- }
165--
158--
166-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
159-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name
167-- Just "Day"
160-- Just "Day"
168−-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy Day) ^. schema)
161+-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)
169−-- {
170−-- "example": "2016-07-22",
162+-- {"example":"2016-07-22","format":"date","type":"string"}
171−-- "format": "date",
172−-- "type": "string"
173−-- }
174toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
163toNamedSchema :: ToSchema a => Proxy a -> NamedSchema
175toNamedSchema = undeclare . declareNamedSchema
164toNamedSchema = undeclare . declareNamedSchema
176
165
@@ -186,35 +175,22 @@ schemaName = _namedSchemaName . toNamedSchema
186
175
187-- | Convert a type into a schema.
176-- | Convert a type into a schema.
188--
177--
189−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Int8)
178+-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Int8)
190−-- {
191−-- "maximum": 127,
192−-- "minimum": -128,
193−-- "type": "integer"
179+-- {"maximum":127,"minimum":-128,"type":"integer"}
194−-- }
195--
180--
196−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy [Day])
181+-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy [Day])
197−-- {
198−-- "items": {
199−-- "$ref": "#/components/schemas/Day"
182+-- {"items":{"$ref":"#/components/schemas/Day"},"type":"array"}
200−-- },
201−-- "type": "array"
202−-- }
203toSchema :: ToSchema a => Proxy a -> Schema
183toSchema :: ToSchema a => Proxy a -> Schema
204toSchema = _namedSchemaSchema . toNamedSchema
184toSchema = _namedSchemaSchema . toNamedSchema
205
185
206-- | Convert a type into a referenced schema if possible.
186-- | Convert a type into a referenced schema if possible.
207-- Only named schemas can be referenced, nameless schemas are inlined.
187-- Only named schemas can be referenced, nameless schemas are inlined.
208--
188--
209−-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Integer)
189+-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Integer)
210−-- {
211−-- "type": "integer"
190+-- {"type":"integer"}
212−-- }
213--
191--
214−-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Day)
192+-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Day)
215−-- {
216−-- "$ref": "#/components/schemas/Day"
193+-- {"$ref":"#/components/schemas/Day"}
217−-- }
218toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
194toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema
219toSchemaRef = undeclare . declareSchemaRef
195toSchemaRef = undeclare . declareSchemaRef
220
196
@@ -282,15 +258,8 @@ inlineAllSchemas = inlineSchemasWhen (const True)
282
258
283-- | Convert a type into a schema without references.
259-- | Convert a type into a schema without references.
284--
260--
285−-- >>> BSL.putStrLn $ encodePretty $ toInlinedSchema (Proxy :: Proxy [Day])
261+-- >>> BSL.putStrLn $ encode $ toInlinedSchema (Proxy :: Proxy [Day])
286−-- {
287−-- "items": {
288−-- "example": "2016-07-22",
262+-- {"items":{"example":"2016-07-22","format":"date","type":"string"},"type":"array"}
289−-- "format": "date",
290−-- "type": "string"
291−-- },
292−-- "type": "array"
293−-- }
294--
263--
295-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
264-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema
296-- when inlining recursive schemas.
265-- when inlining recursive schemas.
@@ -323,64 +292,19 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
323-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
292-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
324-- Produced schema can be used for further refinement.
293-- Produced schema can be used for further refinement.
325--
294--
326−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema "hello"
295+-- >>> BSL.putStrLn $ encode $ sketchSchema "hello"
327−-- {
328−-- "example": "hello",
296+-- {"example":"hello","type":"string"}
329−-- "type": "string"
330−-- }
331--
297--
332−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (1, 2, 3)
298+-- >>> BSL.putStrLn $ encode $ sketchSchema (1, 2, 3)
333−-- {
334−-- "example": [
335−-- 1,
336−-- 2,
337−-- 3
338−-- ],
339−-- "items": {
340−-- "type": "number"
299+-- {"example":[1,2,3],"items":{"type":"number"},"type":"array"}
341−-- },
342−-- "type": "array"
343−-- }
344--
300--
345−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema ("Jack", 25)
301+-- >>> BSL.putStrLn $ encode $ sketchSchema ("Jack", 25)
346−-- {
302+-- {"example":["Jack",25],"items":[{"type":"string"},{"type":"number"}],"type":"array"}
347−-- "example": [
348−-- "Jack",
349−-- 25
350−-- ],
351−-- "items": [
352−-- {
353−-- "type": "string"
354−-- },
355−-- {
356−-- "type": "number"
357−-- }
358−-- ],
359−-- "type": "array"
360−-- }
361--
303--
362-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
304-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
363-- >>> instance ToJSON Person
305-- >>> instance ToJSON Person
364−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (Person "Jack" 25)
306+-- >>> BSL.putStrLn $ encode $ sketchSchema (Person "Jack" 25)
365−-- {
307+-- {"example":{"age":25,"name":"Jack"},"required":["age","name"],"type":"object","properties":{"age":{"type":"number"},"name":{"type":"string"}}}
366−-- "example": {
367−-- "age": 25,
368−-- "name": "Jack"
369−-- },
370−-- "properties": {
371−-- "age": {
372−-- "type": "number"
373−-- },
374−-- "name": {
375−-- "type": "string"
376−-- }
377−-- },
378−-- "required": [
379−-- "age",
380−-- "name"
381−-- ],
382−-- "type": "object"
383−-- }
384sketchSchema :: ToJSON a => a -> Schema
308sketchSchema :: ToJSON a => a -> Schema
385sketchSchema = sketch . toJSON
309sketchSchema = sketch . toJSON
386 where
310 where
@@ -406,139 +330,25 @@ sketchSchema = sketch . toJSON
406 _ -> Nothing
330 _ -> Nothing
407 go (Object o) = mempty
331 go (Object o) = mempty
408 & type_ ?~ OpenApiObject
332 & type_ ?~ OpenApiObject
409− & required .~ sort (objectKeys o)
333+ & required .~ HashMap.keys o
410− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
334+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
411
335
412-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
336-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
413-- Produced schema uses as much constraints as possible.
337-- Produced schema uses as much constraints as possible.
414--
338--
415−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema "hello"
339+-- >>> BSL.putStrLn $ encode $ sketchStrictSchema "hello"
416−-- {
340+-- {"maxLength":5,"pattern":"hello","minLength":5,"type":"string","enum":["hello"]}
417−-- "enum": [
418−-- "hello"
419−-- ],
420−-- "maxLength": 5,
421−-- "minLength": 5,
422−-- "pattern": "hello",
423−-- "type": "string"
424−-- }
425--
341--
426−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (1, 2, 3)
342+-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (1, 2, 3)
427−-- {
343+-- {"minItems":3,"uniqueItems":true,"items":[{"maximum":1,"minimum":1,"multipleOf":1,"type":"number","enum":[1]},{"maximum":2,"minimum":2,"multipleOf":2,"type":"number","enum":[2]},{"maximum":3,"minimum":3,"multipleOf":3,"type":"number","enum":[3]}],"maxItems":3,"type":"array","enum":[[1,2,3]]}
428−-- "enum": [
429−-- [
430−-- 1,
431−-- 2,
432−-- 3
433−-- ]
434−-- ],
435−-- "items": [
436−-- {
437−-- "enum": [
438−-- 1
439−-- ],
440−-- "maximum": 1,
441−-- "minimum": 1,
442−-- "multipleOf": 1,
443−-- "type": "number"
444−-- },
445−-- {
446−-- "enum": [
447−-- 2
448−-- ],
449−-- "maximum": 2,
450−-- "minimum": 2,
451−-- "multipleOf": 2,
452−-- "type": "number"
453−-- },
454−-- {
455−-- "enum": [
456−-- 3
457−-- ],
458−-- "maximum": 3,
459−-- "minimum": 3,
460−-- "multipleOf": 3,
461−-- "type": "number"
462−-- }
463−-- ],
464−-- "maxItems": 3,
465−-- "minItems": 3,
466−-- "type": "array",
467−-- "uniqueItems": true
468−-- }
469--
344--
470−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema ("Jack", 25)
345+-- >>> BSL.putStrLn $ encode $ sketchStrictSchema ("Jack", 25)
471−-- {
346+-- {"minItems":2,"uniqueItems":true,"items":[{"maxLength":4,"pattern":"Jack","minLength":4,"type":"string","enum":["Jack"]},{"maximum":25,"minimum":25,"multipleOf":25,"type":"number","enum":[25]}],"maxItems":2,"type":"array","enum":[["Jack",25]]}
472−-- "enum": [
473−-- [
474−-- "Jack",
475−-- 25
476−-- ]
477−-- ],
478−-- "items": [
479−-- {
480−-- "enum": [
481−-- "Jack"
482−-- ],
483−-- "maxLength": 4,
484−-- "minLength": 4,
485−-- "pattern": "Jack",
486−-- "type": "string"
487−-- },
488−-- {
489−-- "enum": [
490−-- 25
491−-- ],
492−-- "maximum": 25,
493−-- "minimum": 25,
494−-- "multipleOf": 25,
495−-- "type": "number"
496−-- }
497−-- ],
498−-- "maxItems": 2,
499−-- "minItems": 2,
500−-- "type": "array",
501−-- "uniqueItems": true
502−-- }
503--
347--
504-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
348-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)
505-- >>> instance ToJSON Person
349-- >>> instance ToJSON Person
506−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (Person "Jack" 25)
350+-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (Person "Jack" 25)
507−-- {
351+-- {"minProperties":2,"required":["age","name"],"maxProperties":2,"type":"object","enum":[{"age":25,"name":"Jack"}],"properties":{"age":{"maximum":25,"minimum":25,"multipleOf":25,"type":"number","enum":[25]},"name":{"maxLength":4,"pattern":"Jack","minLength":4,"type":"string","enum":["Jack"]}}}
508−-- "enum": [
509−-- {
510−-- "age": 25,
511−-- "name": "Jack"
512−-- }
513−-- ],
514−-- "maxProperties": 2,
515−-- "minProperties": 2,
516−-- "properties": {
517−-- "age": {
518−-- "enum": [
519−-- 25
520−-- ],
521−-- "maximum": 25,
522−-- "minimum": 25,
523−-- "multipleOf": 25,
524−-- "type": "number"
525−-- },
526−-- "name": {
527−-- "enum": [
528−-- "Jack"
529−-- ],
530−-- "maxLength": 4,
531−-- "minLength": 4,
532−-- "pattern": "Jack",
533−-- "type": "string"
534−-- }
535−-- },
536−-- "required": [
537−-- "age",
538−-- "name"
539−-- ],
540−-- "type": "object"
541−-- }
542sketchStrictSchema :: ToJSON a => a -> Schema
352sketchStrictSchema :: ToJSON a => a -> Schema
543sketchStrictSchema = go . toJSON
353sketchStrictSchema = go . toJSON
544 where
354 where
@@ -570,13 +380,13 @@ sketchStrictSchema = go . toJSON
570 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
380 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
571 go js@(Object o) = mempty
381 go js@(Object o) = mempty
572 & type_ ?~ OpenApiObject
382 & type_ ?~ OpenApiObject
573− & required .~ sort names
383+ & required .~ names
574− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)
384+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
575 & maxProperties ?~ fromIntegral (length names)
385 & maxProperties ?~ fromIntegral (length names)
576 & minProperties ?~ fromIntegral (length names)
386 & minProperties ?~ fromIntegral (length names)
577 & enum_ ?~ [js]
387 & enum_ ?~ [js]
578 where
388 where
579− names = objectKeys o
389+ names = HashMap.keys o
580
390
581class GToSchema (f :: * -> *) where
391class GToSchema (f :: * -> *) where
582 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
392 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema
@@ -611,7 +421,7 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc
611instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
421instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema
612instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
422instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema
613
423
614−instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
424+instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema
615
425
616instance ToSchema a => ToSchema (Maybe a) where
426instance ToSchema a => ToSchema (Maybe a) where
617 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
427 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)
@@ -628,18 +438,12 @@ instance ToSchema UUID.UUID where
628 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
438 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p
629 & example ?~ toJSON (UUID.toText UUID.nil)
439 & example ?~ toJSON (UUID.toText UUID.nil)
630
440
631−instance (ToSchema a, ToSchema b) => ToSchema (a, b) where
441+instance (ToSchema a, ToSchema b) => ToSchema (a, b)
632− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
633−instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) where
442+instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)
634− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
635−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d) where
443+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)
636− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
637−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e) where
444+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e)
638− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
639−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f) where
445+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)
640− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
641−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g) where
446+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)
642− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions
643
447
644timeSchema :: T.Text -> Schema
448timeSchema :: T.Text -> Schema
645timeSchema fmt = mempty
449timeSchema fmt = mempty
@@ -658,7 +462,7 @@ instance ToSchema LocalTime where
658 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
462 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"
659 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
463 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))
660
464
661−-- | Format @"date-time"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
465+-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.
662instance ToSchema ZonedTime where
466instance ToSchema ZonedTime where
663 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
467 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"
664 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
468 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))
@@ -690,7 +494,7 @@ instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where
690instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
494instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))
691
495
692-- | NOTE: This schema does not account for the uniqueness of keys.
496-- | NOTE: This schema does not account for the uniqueness of keys.
693−instance (ToSchema a) => ToSchema (IntMap a) where
497+instance ToSchema a => ToSchema (IntMap a) where
694 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
498 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])
695
499
696instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
500instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
@@ -746,12 +550,8 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
746
550
747-- | Default schema for @'Bounded'@, @'Integral'@ types.
551-- | Default schema for @'Bounded'@, @'Integral'@ types.
748--
552--
749−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
553+-- >>> BSL.putStrLn $ encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)
750−-- {
751−-- "maximum": 32767,
554+-- {"maximum":32767,"minimum":-32768,"type":"integer"}
752−-- "minimum": -32768,
753−-- "type": "integer"
754−-- }
755toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
555toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
756toSchemaBoundedIntegral _ = mempty
556toSchemaBoundedIntegral _ = mempty
757 & type_ ?~ OpenApiInteger
557 & type_ ?~ OpenApiInteger
@@ -783,27 +583,8 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>
783-- >>> instance ToSchema ButtonState
583-- >>> instance ToSchema ButtonState
784-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
584-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
785-- >>> type ImageUrl = T.Text
585-- >>> type ImageUrl = T.Text
786−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
586+-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
787−-- {
587+-- {"type":"object","properties":{"Focus":{"type":"string"},"Disabled":{"type":"string"},"Active":{"type":"string"},"Neutral":{"type":"string"},"Hover":{"type":"string"}}}
788−-- "properties": {
789−-- "Active": {
790−-- "type": "string"
791−-- },
792−-- "Disabled": {
793−-- "type": "string"
794−-- },
795−-- "Focus": {
796−-- "type": "string"
797−-- },
798−-- "Hover": {
799−-- "type": "string"
800−-- },
801−-- "Neutral": {
802−-- "type": "string"
803−-- }
804−-- },
805−-- "type": "object"
806−-- }
807--
588--
808-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
589-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
809-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
590-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -811,13 +592,13 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.
811 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
592 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)
812 => Proxy (map key value) -> Declare (Definitions Schema) Schema
593 => Proxy (map key value) -> Declare (Definitions Schema) Schema
813declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
594declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of
814− ToJSONKeyText getKey _ -> objectSchema getKey
595+ ToJSONKeyText keyToText _ -> objectSchema keyToText
815 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
596 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])
816 where
597 where
817− objectSchema getKey = do
598+ objectSchema keyToText = do
818 valueRef <- declareSchemaRef (Proxy :: Proxy value)
599 valueRef <- declareSchemaRef (Proxy :: Proxy value)
819 let allKeys = [minBound..maxBound :: key]
600 let allKeys = [minBound..maxBound :: key]
820− mkPair k = (keyToText $ getKey k, valueRef)
601+ mkPair k = (keyToText k, valueRef)
821 return $ mempty
602 return $ mempty
822 & type_ ?~ OpenApiObject
603 & type_ ?~ OpenApiObject
823 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
604 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
@@ -830,27 +611,8 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
830-- >>> instance ToSchema ButtonState
611-- >>> instance ToSchema ButtonState
831-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
612-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)
832-- >>> type ImageUrl = T.Text
613-- >>> type ImageUrl = T.Text
833−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
614+-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))
834−-- {
615+-- {"type":"object","properties":{"Focus":{"type":"string"},"Disabled":{"type":"string"},"Active":{"type":"string"},"Neutral":{"type":"string"},"Hover":{"type":"string"}}}
835−-- "properties": {
836−-- "Active": {
837−-- "type": "string"
838−-- },
839−-- "Disabled": {
840−-- "type": "string"
841−-- },
842−-- "Focus": {
843−-- "type": "string"
844−-- },
845−-- "Hover": {
846−-- "type": "string"
847−-- },
848−-- "Neutral": {
849−-- "type": "string"
850−-- }
851−-- },
852−-- "type": "object"
853−-- }
854--
616--
855-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
617-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.
856-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
618-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.
@@ -860,7 +622,7 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.
860toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
622toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping
861
623
862-- | A configurable generic @'Schema'@ creator.
624-- | A configurable generic @'Schema'@ creator.
863−genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>
625+genericDeclareSchema :: (Generic a, GToSchema (Rep a)) =>
864 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
626 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema
865genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
627genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy
866
628
@@ -868,24 +630,9 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche
868-- This function applied to @'defaultSchemaOptions'@
630-- This function applied to @'defaultSchemaOptions'@
869-- is used as the default for @'declareNamedSchema'@
631-- is used as the default for @'declareNamedSchema'@
870-- when the type is an instance of @'Generic'@.
632-- 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"
879−genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a), Typeable a) =>
633+genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a)) =>
880 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
634 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema
881−genericDeclareNamedSchema opts _ =
882− rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
635+genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty
883− where
884− unspace ' ' = '_'
885− unspace x = x
886− orig = fmap unspace $ show $ typeRep @a
887− name = datatypeNameModifier opts orig
888−
889
636
890-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
637-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.
891genericNameSchema :: forall a d f.
638genericNameSchema :: forall a d f.
@@ -945,13 +692,10 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s
945 case schema ^. items of
692 case schema ^. items of
946 Just (OpenApiItemsArray [_]) -> fieldSchema
693 Just (OpenApiItemsArray [_]) -> fieldSchema
947 _ -> do
694 _ -> do
948− -- We have to run recordSchema instead of just using its defs,
695+ declare defs
949− -- since those can be recursive and will lead to infinite loop,
950− -- see https://github.com/biocad/openapi3/pull/37
951− NamedSchema _ schema' <- recordSchema
952− return (unnamed schema')
696+ return (unnamed schema)
953 where
697 where
954− (_, NamedSchema _ schema) = runDeclare recordSchema mempty
698+ (defs, NamedSchema _ schema) = runDeclare recordSchema mempty
955 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
699 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s
956 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
700 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s
957
701
@@ -1114,13 +858,7 @@ data Proxy2 a b = Proxy2
1114
858
1115data Proxy3 a b c = Proxy3
859data Proxy3 a b c = Proxy3
1116
860
1117−{- $setup
861+-- $setup
1118−>>> import Data.OpenApi
862+-- >>> import Data.OpenApi
1119−>>> import Data.Aeson (encode)
863+-- >>> import Data.Aeson (encode)
1120−>>> import Data.Aeson.Types (toJSONKeyText)
864+-- >>> import Data.Aeson.Types (toJSONKeyText)
1121−>>> import Data.OpenApi.Internal.Utils
1122−>>> :set -XScopedTypeVariables
1123−>>> :set -XDeriveAnyClass
1124−>>> :set -XStandaloneDeriving
1125−>>> :set -XTypeApplications
1126−-}
src/Data/OpenApi/Internal/Schema/Validation.hs+27−39
@@ -1,5 +1,4 @@
1{-# OPTIONS_GHC -Wall #-}
1{-# OPTIONS_GHC -Wall #-}
2−{-# LANGUAGE CPP #-}
3{-# LANGUAGE DataKinds #-}
2{-# LANGUAGE DataKinds #-}
4{-# LANGUAGE DeriveFunctor #-}
3{-# LANGUAGE DeriveFunctor #-}
5{-# LANGUAGE FlexibleInstances #-}
4{-# LANGUAGE FlexibleInstances #-}
@@ -32,14 +31,11 @@ import Control.Lens hiding (allOf)
32import Control.Monad (forM, forM_, when)
31import Control.Monad (forM, forM_, when)
33
32
34import Data.Aeson hiding (Result)
33import Data.Aeson hiding (Result)
35−#if MIN_VERSION_aeson(2,0,0)
34+import Data.Aeson.Encode.Pretty (encodePretty)
36−import qualified Data.Aeson.KeyMap as KeyMap
37−#endif
38import Data.Foldable (for_, sequenceA_,
35import Data.Foldable (for_, sequenceA_,
39 traverse_)
36 traverse_)
40−#if !MIN_VERSION_aeson(2,0,0)
41import Data.HashMap.Strict (HashMap)
37import Data.HashMap.Strict (HashMap)
42−#endif
38+import qualified Data.HashMap.Strict as HashMap
43import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
39import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap
44import qualified "unordered-containers" Data.HashSet as HashSet
40import qualified "unordered-containers" Data.HashSet as HashSet
45import Data.Maybe (fromMaybe)
41import Data.Maybe (fromMaybe)
@@ -52,12 +48,10 @@ import qualified Data.Text.Lazy.Encoding as TL
52import Data.Vector (Vector)
48import Data.Vector (Vector)
53import qualified Data.Vector as Vector
49import qualified Data.Vector as Vector
54
50
55−import Data.OpenApi.Aeson.Compat (hasKey, keyToText, lookupKey, objectToList)
56−import Data.OpenApi.Declare
51+import Data.OpenApi.Declare
57−import Data.OpenApi.Internal
52+import Data.OpenApi.Internal
58−import Data.OpenApi.Internal.Schema
53+import Data.OpenApi.Internal.Schema
59−import Data.OpenApi.Internal.Utils
60−import Data.OpenApi.Lens
54+import Data.OpenApi.Lens
61
55
62-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
56-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.
63-- This can be used with QuickCheck to ensure those instances are coherent:
57-- This can be used with QuickCheck to ensure those instances are coherent:
@@ -109,33 +103,33 @@ validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checke
109-- <BLANKLINE>
103-- <BLANKLINE>
110-- Swagger Schema:
104-- Swagger Schema:
111-- {
105-- {
112−-- "properties": {
113−-- "name": {
114−-- "type": "string"
115−-- },
116−-- "phone": {
117−-- "$ref": "#/components/schemas/Phone"
118−-- }
119−-- },
120-- "required": [
106-- "required": [
121-- "name",
107-- "name",
122-- "phone"
108-- "phone"
123-- ],
109-- ],
124−-- "type": "object"
110+-- "type": "object",
111+-- "properties": {
112+-- "phone": {
113+-- "$ref": "#/components/schemas/Phone"
114+-- },
115+-- "name": {
116+-- "type": "string"
117+-- }
118+-- }
125-- }
119-- }
126-- <BLANKLINE>
120-- <BLANKLINE>
127-- Swagger Description Context:
121-- Swagger Description Context:
128-- {
122-- {
129-- "Phone": {
123-- "Phone": {
124+-- "required": [
125+-- "value"
126+-- ],
127+-- "type": "object",
130-- "properties": {
128-- "properties": {
131-- "value": {
129-- "value": {
132-- "type": "string"
130-- "type": "string"
133-- }
131-- }
134−-- },
132+-- }
135−-- "required": [
136−-- "value"
137−-- ],
138−-- "type": "object"
139-- }
133-- }
140-- }
134-- }
141-- <BLANKLINE>
135-- <BLANKLINE>
@@ -321,11 +315,11 @@ validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do
321
315
322 check maximum_ $ \m ->
316 check maximum_ $ \m ->
323 when (if exMax then (n >= m) else (n > m)) $
317 when (if exMax then (n >= m) else (n > m)) $
324− invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ (if exMax then "<" else "<=") ++ show m ++ ")")
318+ invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ if exMax then "<" else "<=" ++ show m ++ ")")
325
319
326 check minimum_ $ \m ->
320 check minimum_ $ \m ->
327 when (if exMin then (n <= m) else (n < m)) $
321 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 ++ ")")
322+ invalid ("value " ++ show n ++ " falls below minimum (should be " ++ if exMin then ">" else ">=" ++ show m ++ ")")
329
323
330 check multipleOf $ \k ->
324 check multipleOf $ \k ->
331 when (not (isInteger (n / k))) $
325 when (not (isInteger (n / k))) $
@@ -372,16 +366,10 @@ validateArray xs = do
372 len = Vector.length xs
366 len = Vector.length xs
373 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))
367 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))
374
368
375−validateObject ::
376−#if MIN_VERSION_aeson(2,0,0)
377− KeyMap.KeyMap Value
378−#else
379− HashMap Text Value
369+validateObject :: HashMap Text Value -> Validation Schema ()
380−#endif
381− -> Validation Schema ()
382validateObject o = withSchema $ \sch ->
370validateObject o = withSchema $ \sch ->
383 case sch ^. discriminator of
371 case sch ^. discriminator of
384− Just (Discriminator pname types) -> case fromJSON <$> lookupKey pname o of
372+ Just (Discriminator pname types) -> case fromJSON <$> HashMap.lookup pname o of
385 Just (Success pvalue) ->
373 Just (Success pvalue) ->
386 let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types
374 let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types
387 -- TODO ref may be name or reference
375 -- TODO ref may be name or reference
@@ -400,15 +388,15 @@ validateObject o = withSchema $ \sch ->
400 validateRequired
388 validateRequired
401 validateProps
389 validateProps
402 where
390 where
403− size = fromIntegral (length o)
391+ size = fromIntegral (HashMap.size o)
404
392
405 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)
393 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)
406 validateReq n =
394 validateReq n =
407− when (not (hasKey n o)) $
395+ when (not (HashMap.member n o)) $
408 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))
396 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))
409
397
410 validateProps = withSchema $ \sch -> do
398 validateProps = withSchema $ \sch -> do
411− for_ (objectToList o) $ \(keyToText -> k, v) ->
399+ for_ (HashMap.toList o) $ \(k, v) ->
412 case v of
400 case v of
413 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property
401 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property
414 _ ->
402 _ ->
src/Data/OpenApi/Internal/Utils.hs−5
@@ -13,8 +13,6 @@ import Control.Lens ((&), (%~))
13import Control.Lens.TH
13import Control.Lens.TH
14import Data.Aeson
14import Data.Aeson
15import Data.Aeson.Types
15import Data.Aeson.Types
16−import qualified Data.Aeson.Encode.Pretty as P
17−import qualified Data.ByteString.Lazy as BSL
18import Data.Char
16import Data.Char
19import Data.Data
17import Data.Data
20import Data.Hashable (Hashable)
18import Data.Hashable (Hashable)
@@ -134,6 +132,3 @@ instance SwaggerMonoid (Maybe a) where
134 swaggerMempty = Nothing
132 swaggerMempty = Nothing
135 swaggerMappend x Nothing = x
133 swaggerMappend x Nothing = x
136 swaggerMappend _ y = y
134 swaggerMappend _ y = y
137−
138−encodePretty :: ToJSON a => a -> BSL.ByteString
139−encodePretty = P.encodePretty' $ P.defConfig { P.confCompare = P.compare }
src/Data/OpenApi/Operation.hs+10−117
@@ -55,16 +55,13 @@ import qualified Data.HashSet.InsOrd as InsOrdHS
55-- >>> import Data.Proxy
55-- >>> import Data.Proxy
56-- >>> import Data.Time
56-- >>> import Data.Time
57-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
57-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL
58−-- >>> import Data.OpenApi.Internal.Utils
59
58
60-- | Prepend path piece to all operations of the spec.
59-- | Prepend path piece to all operations of the spec.
61-- Leading and trailing slashes are trimmed/added automatically.
60-- Leading and trailing slashes are trimmed/added automatically.
62--
61--
63-- >>> let api = (mempty :: OpenApi) & paths .~ [("/info", mempty)]
62-- >>> let api = (mempty :: OpenApi) & paths .~ [("/info", mempty)]
64−-- >>> BSL.putStrLn $ encodePretty $ prependPath "user/{user_id}" api ^. paths
63+-- >>> BSL.putStrLn $ encode $ prependPath "user/{user_id}" api ^. paths
65−-- {
66−-- "/user/{user_id}/info": {}
64+-- {"/user/{user_id}/info":{}}
67−-- }
68prependPath :: FilePath -> OpenApi -> OpenApi
65prependPath :: FilePath -> OpenApi -> OpenApi
69prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
66prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)
70 where
67 where
@@ -85,63 +82,10 @@ allOperations = paths.traverse.template
85-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
82-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"
86-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
83-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]
87-- >>> let sub = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]
84-- >>> let sub = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]
88−-- >>> BSL.putStrLn $ encodePretty api
85+-- >>> BSL.putStrLn $ encode api
89−-- {
86+-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"200":{"description":"OK"}}},"post":{"responses":{"200":{"description":"OK"}}}}},"components":{}}
90−-- "components": {},
91−-- "info": {
92−-- "title": "",
93−-- "version": ""
94−-- },
95−-- "openapi": "3.0.0",
96−-- "paths": {
97−-- "/user": {
98−-- "get": {
99−-- "responses": {
100−-- "200": {
101−-- "description": "OK"
102−-- }
103−-- }
104−-- },
105−-- "post": {
106−-- "responses": {
107−-- "200": {
108−-- "description": "OK"
109−-- }
110−-- }
111−-- }
112−-- }
113−-- }
114−-- }
115−-- >>> BSL.putStrLn $ encodePretty $ api & operationsOf sub . at 404 ?~ "Not found"
87+-- >>> BSL.putStrLn $ encode $ api & operationsOf sub . at 404 ?~ "Not found"
116−-- {
88+-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"404":{"description":"Not found"},"200":{"description":"OK"}}},"post":{"responses":{"200":{"description":"OK"}}}}},"components":{}}
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−-- }
145operationsOf :: OpenApi -> Traversal' OpenApi Operation
89operationsOf :: OpenApi -> Traversal' OpenApi Operation
146operationsOf sub = paths.itraversed.withIndex.subops
90operationsOf sub = paths.itraversed.withIndex.subops
147 where
91 where
@@ -179,26 +123,8 @@ applyTagsFor ops ts swag = swag
179--
123--
180-- FIXME doc
124-- FIXME doc
181--
125--
182−-- >>> BSL.putStrLn $ encodePretty $ runDeclare (declareResponse "application/json" (Proxy :: Proxy Day)) mempty
126+-- >>> BSL.putStrLn $ encode $ runDeclare (declareResponse "application/json" (Proxy :: Proxy Day)) mempty
183−-- [
127+-- [{"Day":{"example":"2016-07-22","format":"date","type":"string"}},{"description":"","content":{"application/json":{"schema":{"$ref":"#/components/schemas/Day"}}}}]
184−-- {
185−-- "Day": {
186−-- "example": "2016-07-22",
187−-- "format": "date",
188−-- "type": "string"
189−-- }
190−-- },
191−-- {
192−-- "content": {
193−-- "application/json": {
194−-- "schema": {
195−-- "$ref": "#/components/schemas/Day"
196−-- }
197−-- }
198−-- },
199−-- "description": ""
200−-- }
201−-- ]
202declareResponse :: ToSchema a => MediaType -> Proxy a -> Declare (Definitions Schema) Response
128declareResponse :: ToSchema a => MediaType -> Proxy a -> Declare (Definitions Schema) Response
203declareResponse cType proxy = do
129declareResponse cType proxy = do
204 s <- declareSchemaRef proxy
130 s <- declareSchemaRef proxy
@@ -217,41 +143,8 @@ declareResponse cType proxy = do
217--
143--
218-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]
144-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]
219-- >>> let res = declareResponse "application/json" (Proxy :: Proxy Day)
145-- >>> let res = declareResponse "application/json" (Proxy :: Proxy Day)
220−-- >>> BSL.putStrLn $ encodePretty $ api & setResponse 200 res
146+-- >>> BSL.putStrLn $ encode $ api & setResponse 200 res
221−-- {
147+-- {"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"}}}}
222−-- "components": {
223−-- "schemas": {
224−-- "Day": {
225−-- "example": "2016-07-22",
226−-- "format": "date",
227−-- "type": "string"
228−-- }
229−-- }
230−-- },
231−-- "info": {
232−-- "title": "",
233−-- "version": ""
234−-- },
235−-- "openapi": "3.0.0",
236−-- "paths": {
237−-- "/user": {
238−-- "get": {
239−-- "responses": {
240−-- "200": {
241−-- "content": {
242−-- "application/json": {
243−-- "schema": {
244−-- "$ref": "#/components/schemas/Day"
245−-- }
246−-- }
247−-- },
248−-- "description": ""
249−-- }
250−-- }
251−-- }
252−-- }
253−-- }
254−-- }
255--
148--
256-- See also @'setResponseWith'@.
149-- See also @'setResponseWith'@.
257setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
150setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi
src/Data/OpenApi/Optics.hs+9−54
@@ -22,88 +22,43 @@
22-- Example from the "Data.OpenApi" module using @optics@:
22-- Example from the "Data.OpenApi" module using @optics@:
23--
23--
24-- >>> :{
24-- >>> :{
25−-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)
25+-- BSL.putStrLn $ encode $ (mempty :: OpenApi)
26-- & #components % #schemas .~ [ ("User", mempty & #type ?~ OpenApiString) ]
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−-- {
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"}}}}
33−-- "components": {
34−-- "schemas": {
35−-- "User": {
36−-- "type": "string"
37−-- }
38−-- }
39−-- },
40−-- "info": {
41−-- "title": "",
42−-- "version": ""
43−-- },
44−-- "openapi": "3.0.0",
45−-- "paths": {
46−-- "/user": {
47−-- "get": {
48−-- "responses": {
49−-- "200": {
50−-- "content": {
51−-- "application/json": {
52−-- "schema": {
53−-- "$ref": "#/components/schemas/User"
54−-- }
55−-- }
56−-- },
57−-- "description": "OK"
58−-- },
59−-- "404": {
60−-- "description": "User info not found"
61−-- }
62−-- }
63−-- }
64−-- }
65−-- }
66−-- }
67--
33--
68-- For convenience optics are defined as /labels/. It means that field accessor
34-- For convenience optics are defined as /labels/. It means that field accessor
69-- names can be overloaded for different types. One such common field is
35-- names can be overloaded for different types. One such common field is
70-- @#description@. Many components of a Swagger specification can have
36-- @#description@. Many components of a Swagger specification can have
71-- descriptions, and you can use the same name for them:
37-- descriptions, and you can use the same name for them:
72--
38--
73−-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & #description .~ "No content"
39+-- >>> BSL.putStrLn $ encode $ (mempty :: Response) & #description .~ "No content"
74−-- {
75−-- "description": "No content"
40+-- {"description":"No content"}
76−-- }
77-- >>> :{
41-- >>> :{
78−-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)
42+-- BSL.putStrLn $ encode $ (mempty :: Schema)
79-- & #type ?~ OpenApiBoolean
43-- & #type ?~ OpenApiBoolean
80-- & #description ?~ "To be or not to be"
44-- & #description ?~ "To be or not to be"
81-- :}
45-- :}
82−-- {
83−-- "description": "To be or not to be",
46+-- {"type":"boolean","description":"To be or not to be"}
84−-- "type": "boolean"
85−-- }
86--
47--
87-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and
48-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and
88-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:
49-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:
89--
50--
90-- >>> :{
51-- >>> :{
91−-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)
52+-- BSL.putStrLn $ encode $ (mempty :: Operation)
92-- & at 404 ?~ "Not found"
53-- & at 404 ?~ "Not found"
93-- :}
54-- :}
94−-- {
95−-- "responses": {
96−-- "404": {
97−-- "description": "Not found"
55+-- {"responses":{"404":{"description":"Not found"}}}
98−-- }
99−-- }
100−-- }
56+--
101module Data.OpenApi.Optics () where
57module Data.OpenApi.Optics () where
102
58
103import Data.Aeson (Value)
59import Data.Aeson (Value)
104import Data.Scientific (Scientific)
60import Data.Scientific (Scientific)
105import Data.OpenApi.Internal
61import Data.OpenApi.Internal
106−import Data.OpenApi.Internal.Utils
107import Data.Text (Text)
62import Data.Text (Text)
108import Optics.Core
63import Optics.Core
109import Optics.TH
64import Optics.TH
src/Data/OpenApi/Schema/Generator.hs+1−3
@@ -25,8 +25,6 @@ import Test.QuickCheck (arbitrary)
25import Test.QuickCheck.Gen
25import Test.QuickCheck.Gen
26import Test.QuickCheck.Property
26import Test.QuickCheck.Property
27
27
28−import Data.OpenApi.Aeson.Compat (fromInsOrdHashMap)
29−
30-- | Note: 'schemaGen' may 'error', if schema type is not specified,
28-- | Note: 'schemaGen' may 'error', if schema type is not specified,
31-- and cannot be inferred.
29-- and cannot be inferred.
32schemaGen :: Definitions Schema -> Schema -> Gen Value
30schemaGen :: Definitions Schema -> Schema -> Gen Value
@@ -97,7 +95,7 @@ schemaGen defns schema =
97 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
95 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)
98 _ -> return []
96 _ -> return []
99 x <- sequence $ gens <> additionalGens
97 x <- sequence $ gens <> additionalGens
100− return . Object $ fromInsOrdHashMap x
98+ return . Object $ M.toHashMap x
101
99
102dereference :: Definitions a -> Referenced a -> a
100dereference :: Definitions a -> Referenced a -> a
103dereference _ (Inline a) = a
101dereference _ (Inline a) = a
stack.yaml+1−1
@@ -1,4 +1,4 @@
1−resolver: lts-16.31
1+resolver: lts-16.8
2packages:
2packages:
3- '.'
3- '.'
4extra-deps:
4extra-deps:
test/Data/OpenApi/CommonTestTypes.hs−123
@@ -863,129 +863,6 @@ 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−|]
989
866
990-- ========================================================================
867-- ========================================================================
991-- TimeOfDay
868-- TimeOfDay
test/Data/OpenApi/Schema/ValidationSpec.hs+3−20
@@ -1,4 +1,3 @@
1−{-# LANGUAGE CPP #-}
2{-# LANGUAGE DeriveGeneric #-}
1{-# LANGUAGE DeriveGeneric #-}
3{-# LANGUAGE PackageImports #-}
2{-# LANGUAGE PackageImports #-}
4{-# LANGUAGE RecordWildCards #-}
3{-# LANGUAGE RecordWildCards #-}
@@ -9,10 +8,6 @@ module Data.OpenApi.Schema.ValidationSpec where
9import Control.Applicative
8import Control.Applicative
10import Control.Lens ((&), (.~), (?~))
9import Control.Lens ((&), (.~), (?~))
11import Data.Aeson
10import Data.Aeson
12−#if MIN_VERSION_aeson(2,0,0)
13−import qualified Data.Aeson.Key as Key
14−import qualified Data.Aeson.KeyMap as KeyMap
15−#endif
16import Data.Aeson.Types
11import Data.Aeson.Types
17import Data.Hashable (Hashable)
12import Data.Hashable (Hashable)
18import Data.HashMap.Strict (HashMap)
13import Data.HashMap.Strict (HashMap)
@@ -35,7 +30,6 @@ import GHC.Generics
35
30
36import Data.OpenApi
31import Data.OpenApi
37import Data.OpenApi.Declare
32import Data.OpenApi.Declare
38−import Data.OpenApi.Aeson.Compat (stringToKey)
39
33
40import Test.Hspec
34import Test.Hspec
41import Test.Hspec.QuickCheck
35import Test.Hspec.QuickCheck
@@ -130,9 +124,9 @@ instance Arbitrary Person where
130
124
131invalidPersonToJSON :: Person -> Value
125invalidPersonToJSON :: Person -> Value
132invalidPersonToJSON Person{..} = object
126invalidPersonToJSON Person{..} = object
133− [ stringToKey "personName" .= toJSON name
127+ [ T.pack "personName" .= toJSON name
134− , stringToKey "personPhone" .= toJSON phone
128+ , T.pack "personPhone" .= toJSON phone
135− , stringToKey "personEmail" .= toJSON email
129+ , T.pack "personEmail" .= toJSON email
136 ]
130 ]
137
131
138-- ========================================================================
132-- ========================================================================
@@ -301,8 +295,6 @@ instance Eq ZonedTime where
301-- Arbitrary instance for Data.Aeson.Value
295-- Arbitrary instance for Data.Aeson.Value
302-- ========================================================================
296-- ========================================================================
303
297
304−-- These instances were introduces in aeson upstream in 2.0.3
305−#if !MIN_VERSION_aeson(2,0,3)
306instance Arbitrary Value where
298instance Arbitrary Value where
307 -- Weights are almost random
299 -- Weights are almost random
308 -- Uniform oneof tends not to build complex objects cause of recursive call.
300 -- Uniform oneof tends not to build complex objects cause of recursive call.
@@ -313,12 +305,3 @@ instance Arbitrary Value where
313 , (3, Number <$> arbitrary)
305 , (3, Number <$> arbitrary)
314 , (3, Bool <$> arbitrary)
306 , (3, Bool <$> arbitrary)
315 , (1, return Null) ]
307 , (1, return Null) ]
316−
317−#if MIN_VERSION_aeson(2,0,0)
318−instance Arbitrary v => Arbitrary (KeyMap.KeyMap v) where
319− arbitrary = KeyMap.fromList <$> arbitrary
320−
321−instance Arbitrary Key.Key where
322− arbitrary = Key.fromText <$> arbitrary
323−#endif
324−#endif
test/Data/OpenApi/SchemaSpec.hs−4
@@ -59,9 +59,6 @@ checkInlinedRecSchema proxy js = inlineNonRecursiveSchemas defs s <=> js
59 where
59 where
60 (defs, s) = runDeclare (declareSchema proxy) mempty
60 (defs, s) = runDeclare (declareSchema proxy) mempty
61
61
62−checkToSchemaDeclare :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec
63−checkToSchemaDeclare proxy js = runDeclare (declareSchemaRef proxy) mempty <=> js
64−
65spec :: Spec
62spec :: Spec
66spec = do
63spec = do
67 describe "Generic ToSchema" $ do
64 describe "Generic ToSchema" $ do
@@ -81,7 +78,6 @@ spec = do
81 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON
78 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON
82 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON
79 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON
83 context "SingleMaybeField (unary record with Maybe)" $ checkToSchema (Proxy :: Proxy SingleMaybeField) singleMaybeFieldSchemaJSON
80 context "SingleMaybeField (unary record with Maybe)" $ checkToSchema (Proxy :: Proxy SingleMaybeField) singleMaybeFieldSchemaJSON
84− context "Natural Language (single field data with recursive fields)" $ checkToSchemaDeclare (Proxy :: Proxy Predicate) predicateSchemaDeclareJSON
85 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON
81 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON
86 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
82 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON
87 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
83 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'
test/Data/OpenApiSpec.hs+1−17
@@ -45,10 +45,6 @@ spec = do
45 fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> 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 :: OpenApi -> 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
52
48
53main :: IO ()
49main :: IO ()
54main = hspec spec
50main = hspec spec
@@ -445,7 +441,7 @@ responsesDefinitionExampleJSON = [aesonQQ|
445|]
441|]
446
442
447-- =======================================================================
443-- =======================================================================
448−-- Security Definition object
444+-- Responses Definition object
449-- =======================================================================
445-- =======================================================================
450
446
451securityDefinitionsExample :: SecurityDefinitions
447securityDefinitionsExample :: SecurityDefinitions
@@ -531,18 +527,6 @@ oAuth2SecurityDefinitionsExampleJSON = [aesonQQ|
531}
527}
532|]
528|]
533
529
534−oAuth2SecurityDefinitionsReadOpenApi :: OpenApi
535−oAuth2SecurityDefinitionsReadOpenApi =
536− mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsReadExample
537−
538−oAuth2SecurityDefinitionsWriteOpenApi :: OpenApi
539−oAuth2SecurityDefinitionsWriteOpenApi =
540− mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsWriteExample
541−
542−oAuth2SecurityDefinitionsOpenApi :: OpenApi
543−oAuth2SecurityDefinitionsOpenApi =
544− mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsExample
545−
546-- =======================================================================
530-- =======================================================================
547-- Swagger object
531-- Swagger object
548-- =======================================================================
532-- =======================================================================
test/SpecCommon.hs+8
@@ -8,6 +8,14 @@ import qualified Data.Vector as Vector
8
8
9import Test.Hspec
9import Test.Hspec
10
10
11+isSubJSON :: Value -> Value -> Bool
12+isSubJSON Null _ = True
13+isSubJSON (Object x) (Object y) = HashMap.keys x == HashMap.keys i && F.and i
14+ where
15+ i = HashMap.intersectionWith isSubJSON x y
16+isSubJSON (Array xs) (Array ys) = Vector.length xs == Vector.length ys && F.and (Vector.zipWith isSubJSON xs ys)
17+isSubJSON x y = x == y
18+
11(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec
19(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec
12x <=> js = do
20x <=> js = do
13 it "encodes correctly" $ do
21 it "encodes correctly" $ do