master..c9830de · typeable/openapi3

git.iko.soy/typeable/openapi3

34 files changed+1064−2041

unifiedsplit

.github/workflows/haskell-ci.ymldeleted−243

@@ -1,243 +0,0 @@

1−# This GitHub workflow config has been generated by a script via

2−#

3−# haskell-ci 'github' 'cabal.project'

4−#

5−# To regenerate the script (for example after adjusting tested-with) run

6−#

7−# haskell-ci regenerate

8−#

9−# For more information, see https://github.com/haskell-CI/haskell-ci

10−#

11−# version: 0.14.3

12−#

13−# REGENDATA ("0.14.3",["github","cabal.project"])

14−#

15−name: Haskell-CI

16−on:

17− push:

18− branches:

19− - master

20− pull_request:

21− branches:

22− - master

23−jobs:

24− linux:

25− name: Haskell-CI - Linux - ${{ matrix.compiler }}

26− runs-on: ubuntu-18.04

27− timeout-minutes:

28− 60

29− container:

30− image: buildpack-deps:focal

31− continue-on-error: ${{ matrix.allow-failure }}

32− strategy:

33− matrix:

34− include:

35− - compiler: ghc-9.2.2

36− compilerKind: ghc

37− compilerVersion: 9.2.2

38− setup-method: ghcup

39− allow-failure: true

40− - compiler: ghc-9.0.2

41− compilerKind: ghc

42− compilerVersion: 9.0.2

43− setup-method: ghcup

44− allow-failure: false

45− - compiler: ghc-8.10.7

46− compilerKind: ghc

47− compilerVersion: 8.10.7

48− setup-method: ghcup

49− allow-failure: false

50− - compiler: ghc-8.8.4

51− compilerKind: ghc

52− compilerVersion: 8.8.4

53− setup-method: hvr-ppa

54− allow-failure: false

55− - compiler: ghc-8.6.5

56− compilerKind: ghc

57− compilerVersion: 8.6.5

58− setup-method: hvr-ppa

59− allow-failure: false

60− - compiler: ghc-8.4.4

61− compilerKind: ghc

62− compilerVersion: 8.4.4

63− setup-method: hvr-ppa

64− allow-failure: false

65− fail-fast: false

66− steps:

67− - name: apt

68− run: |

69− apt-get update

70− apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common libtinfo5

71− if [ "${{ matrix.setup-method }}" = ghcup ]; then

72− mkdir -p "$HOME/.ghcup/bin"

73− curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"

74− chmod a+x "$HOME/.ghcup/bin/ghcup"

75− "$HOME/.ghcup/bin/ghcup" install ghc "$HCVER"

76− "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0

77− else

78− apt-add-repository -y 'ppa:hvr/ghc'

79− apt-get update

80− apt-get install -y "$HCNAME"

81− mkdir -p "$HOME/.ghcup/bin"

82− curl -sL https://downloads.haskell.org/ghcup/0.1.17.5/x86_64-linux-ghcup-0.1.17.5 > "$HOME/.ghcup/bin/ghcup"

83− chmod a+x "$HOME/.ghcup/bin/ghcup"

84− "$HOME/.ghcup/bin/ghcup" install cabal 3.6.2.0

85− fi

86− env:

87− HCKIND: ${{ matrix.compilerKind }}

88− HCNAME: ${{ matrix.compiler }}

89− HCVER: ${{ matrix.compilerVersion }}

90− - name: Set PATH and environment variables

91− run: |

92− echo "$HOME/.cabal/bin" >> $GITHUB_PATH

93− echo "LANG=C.UTF-8" >> "$GITHUB_ENV"

94− echo "CABAL_DIR=$HOME/.cabal" >> "$GITHUB_ENV"

95− echo "CABAL_CONFIG=$HOME/.cabal/config" >> "$GITHUB_ENV"

96− HCDIR=/opt/$HCKIND/$HCVER

97− if [ "${{ matrix.setup-method }}" = ghcup ]; then

98− HC=$HOME/.ghcup/bin/$HCKIND-$HCVER

99− echo "HC=$HC" >> "$GITHUB_ENV"

100− echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$GITHUB_ENV"

101− echo "HADDOCK=$HOME/.ghcup/bin/haddock-$HCVER" >> "$GITHUB_ENV"

102− echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"

103− else

104− HC=$HCDIR/bin/$HCKIND

105− echo "HC=$HC" >> "$GITHUB_ENV"

106− echo "HCPKG=$HCDIR/bin/$HCKIND-pkg" >> "$GITHUB_ENV"

107− echo "HADDOCK=$HCDIR/bin/haddock" >> "$GITHUB_ENV"

108− echo "CABAL=$HOME/.ghcup/bin/cabal-3.6.2.0 -vnormal+nowrap" >> "$GITHUB_ENV"

109− fi

110−

111− HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\d+)\.(\d+)\.(\d+)(\.(\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')

112− echo "HCNUMVER=$HCNUMVER" >> "$GITHUB_ENV"

113− echo "ARG_TESTS=--enable-tests" >> "$GITHUB_ENV"

114− echo "ARG_BENCH=--enable-benchmarks" >> "$GITHUB_ENV"

115− echo "HEADHACKAGE=false" >> "$GITHUB_ENV"

116− echo "ARG_COMPILER=--$HCKIND --with-compiler=$HC" >> "$GITHUB_ENV"

117− echo "GHCJSARITH=0" >> "$GITHUB_ENV"

118− env:

119− HCKIND: ${{ matrix.compilerKind }}

120− HCNAME: ${{ matrix.compiler }}

121− HCVER: ${{ matrix.compilerVersion }}

122− - name: env

123− run: |

124− env

125− - name: write cabal config

126− run: |

127− mkdir -p $CABAL_DIR

128− cat >> $CABAL_CONFIG <<EOF

129− remote-build-reporting: anonymous

130− write-ghc-environment-files: never

131− remote-repo-cache: $CABAL_DIR/packages

132− logs-dir: $CABAL_DIR/logs

133− world-file: $CABAL_DIR/world

134− extra-prog-path: $CABAL_DIR/bin

135− symlink-bindir: $CABAL_DIR/bin

136− installdir: $CABAL_DIR/bin

137− build-summary: $CABAL_DIR/logs/build.log

138− store-dir: $CABAL_DIR/store

139− install-dirs user

140− prefix: $CABAL_DIR

141− repository hackage.haskell.org

142− url: http://hackage.haskell.org/

143− EOF

144− cat >> $CABAL_CONFIG <<EOF

145− program-default-options

146− ghc-options: $GHCJOBS +RTS -M3G -RTS

147− EOF

148− cat $CABAL_CONFIG

149− - name: versions

150− run: |

151− $HC --version || true

152− $HC --print-project-git-commit-id || true

153− $CABAL --version || true

154− - name: update cabal index

155− run: |

156− $CABAL v2-update -v

157− - name: install cabal-plan

158− run: |

159− mkdir -p $HOME/.cabal/bin

160− curl -sL https://github.com/haskell-hvr/cabal-plan/releases/download/v0.6.2.0/cabal-plan-0.6.2.0-x86_64-linux.xz > cabal-plan.xz

161− echo 'de73600b1836d3f55e32d80385acc055fd97f60eaa0ab68a755302685f5d81bc cabal-plan.xz' | sha256sum -c -

162− xz -d < cabal-plan.xz > $HOME/.cabal/bin/cabal-plan

163− rm -f cabal-plan.xz

164− chmod a+x $HOME/.cabal/bin/cabal-plan

165− cabal-plan --version

166− - name: checkout

167− uses: actions/checkout@v2

168− with:

169− path: source

170− - name: initial cabal.project for sdist

171− run: |

172− touch cabal.project

173− echo "packages: $GITHUB_WORKSPACE/source/." >> cabal.project

174− cat cabal.project

175− - name: sdist

176− run: |

177− mkdir -p sdist

178− $CABAL sdist all --output-dir $GITHUB_WORKSPACE/sdist

179− - name: unpack

180− run: |

181− mkdir -p unpacked

182− find sdist -maxdepth 1 -type f -name '*.tar.gz' -exec tar -C $GITHUB_WORKSPACE/unpacked -xzvf {} \;

183− - name: generate cabal.project

184− run: |

185− PKGDIR_openapi3="$(find "$GITHUB_WORKSPACE/unpacked" -maxdepth 1 -type d -regex '.*/openapi3-[0-9.]*')"

186− echo "PKGDIR_openapi3=${PKGDIR_openapi3}" >> "$GITHUB_ENV"

187− rm -f cabal.project cabal.project.local

188− touch cabal.project

189− touch cabal.project.local

190− echo "packages: ${PKGDIR_openapi3}" >> cabal.project

191− echo "package openapi3" >> cabal.project

192− echo " ghc-options: -Werror=missing-methods" >> cabal.project

193− cat >> cabal.project <<EOF

194− allow-newer: http-media:base

195− EOF

196− $HCPKG list --simple-output --names-only | perl -ne 'for (split /\s+/) { print "constraints: $_ installed\n" unless /^(openapi3)$/; }' >> cabal.project.local

197− cat cabal.project

198− cat cabal.project.local

199− - name: dump install plan

200− run: |

201− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dry-run all

202− cabal-plan

203− - name: cache

204− uses: actions/cache@v2

205− with:

206− key: ${{ runner.os }}-${{ matrix.compiler }}-${{ github.sha }}

207− path: ~/.cabal/store

208− restore-keys: ${{ runner.os }}-${{ matrix.compiler }}-

209− - name: install dependencies

210− run: |

211− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --dependencies-only -j2 all

212− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH --dependencies-only -j2 all

213− - name: build w/o tests

214− run: |

215− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all

216− - name: build

217− run: |

218− $CABAL v2-build $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --write-ghc-environment-files=always

219− - name: tests

220− run: |

221− $CABAL v2-test $ARG_COMPILER $ARG_TESTS $ARG_BENCH all --test-show-details=direct

222− - name: cabal check

223− run: |

224− cd ${PKGDIR_openapi3} || false

225− ${CABAL} -vnormal check

226− - name: haddock

227− run: |

228− $CABAL v2-haddock $ARG_COMPILER --with-haddock $HADDOCK $ARG_TESTS $ARG_BENCH all

229− - name: unconstrained build

230− run: |

231− rm -f cabal.project.local

232− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all

233− - name: prepare for constraint sets

234− run: |

235− rm -f cabal.project.local

236− - name: constraint set aeson-2

237− run: |

238− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson >=2.0' --dependencies-only -j2 all

239− $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson >=2.0' all

240− - name: constraint set aeson-1

241− run: |

242− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson <2.0' --dependencies-only -j2 all ; fi

243− if [ $((HCNUMVER < 90200)) -ne 0 ] ; then $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks --constraint='aeson <2.0' all ; fi

.travis.ymlnew file+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' 'swagger2.cabal'

4+#

5+# To regenerate the script (for example after adjusting tested-with) run

6+#

7+# haskell-ci regenerate

8+#

9+# For more information, see https://github.com/haskell-CI/haskell-ci

10+#

11+# version: 0.10.1

12+#

13+version: ~> 1.0

14+language: c

15+os: linux

16+dist: xenial

17+git:

18+ # whether to recursively clone submodules

19+ submodules: false

20+branches:

21+ only:

22+ - master

23+cache:

24+ directories:

25+ - $HOME/.cabal/packages

26+ - $HOME/.cabal/store

27+ - $HOME/.hlint

28+before_cache:

29+ - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log

30+ # remove files that are regenerated by 'cabal update'

31+ - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*

32+ - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json

33+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache

34+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar

35+ - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx

36+ - rm -rfv $CABALHOME/packages/head.hackage

37+jobs:

38+ include:

39+ - compiler: ghc-8.10.1

40+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.10.1","cabal-install-3.2"]}}

41+ os: linux

42+ - compiler: ghc-8.8.3

43+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.8.3","cabal-install-3.2"]}}

44+ os: linux

45+ - compiler: ghc-8.6.5

46+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.6.5","cabal-install-3.2"]}}

47+ os: linux

48+ - compiler: ghc-8.4.4

49+ addons: {"apt":{"sources":[{"sourceline":"deb http://ppa.launchpad.net/hvr/ghc/ubuntu xenial main","key_url":"https://keyserver.ubuntu.com/pks/lookup?op=get&search=0x063dab2bdc0b3f9fcebc378bff3aeacef6f88286"}],"packages":["ghc-8.4.4","cabal-install-3.2"]}}

50+ os: linux

51+before_install:

52+ - HC=$(echo "/opt/$CC/bin/ghc" | sed 's/-/\//')

53+ - WITHCOMPILER="-w $HC"

54+ - HADDOCK=$(echo "/opt/$CC/bin/haddock" | sed 's/-/\//')

55+ - HCPKG="$HC-pkg"

56+ - unset CC

57+ - CABAL=/opt/ghc/bin/cabal

58+ - CABALHOME=$HOME/.cabal

59+ - export PATH="$CABALHOME/bin:$PATH"

60+ - TOP=$(pwd)

61+ - "HCNUMVER=$(${HC} --numeric-version|perl -ne '/^(\\d+)\\.(\\d+)\\.(\\d+)(\\.(\\d+))?$/; print(10000 * $1 + 100 * $2 + ($3 == 0 ? $5 != 1 : $3))')"

62+ - echo $HCNUMVER

63+ - CABAL="$CABAL -vnormal+nowrap"

64+ - set -o pipefail

65+ - TEST=--enable-tests

66+ - BENCH=--enable-benchmarks

67+ - HEADHACKAGE=false

68+ - rm -f $CABALHOME/config

69+ - |

70+ echo "verbose: normal +nowrap +markoutput" >> $CABALHOME/config

71+ echo "remote-build-reporting: anonymous" >> $CABALHOME/config

72+ echo "write-ghc-environment-files: always" >> $CABALHOME/config

73+ echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config

74+ echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config

75+ echo "world-file: $CABALHOME/world" >> $CABALHOME/config

76+ echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config

77+ echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config

78+ echo "installdir: $CABALHOME/bin" >> $CABALHOME/config

79+ echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config

80+ echo "store-dir: $CABALHOME/store" >> $CABALHOME/config

81+ echo "install-dirs user" >> $CABALHOME/config

82+ echo " prefix: $CABALHOME" >> $CABALHOME/config

83+ echo "repository hackage.haskell.org" >> $CABALHOME/config

84+ echo " url: http://hackage.haskell.org/" >> $CABALHOME/config

85+install:

86+ - ${CABAL} --version

87+ - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"

88+ - |

89+ echo "program-default-options" >> $CABALHOME/config

90+ echo " ghc-options: $GHCJOBS +RTS -M6G -RTS" >> $CABALHOME/config

91+ - cat $CABALHOME/config

92+ - rm -fv cabal.project cabal.project.local cabal.project.freeze

93+ - travis_retry ${CABAL} v2-update -v

94+ # Generate cabal.project

95+ - rm -rf cabal.project cabal.project.local cabal.project.freeze

96+ - touch cabal.project

97+ - |

98+ echo "packages: ." >> cabal.project

99+ - echo 'package swagger2' >> cabal.project

100+ - "echo ' ghc-options: -Werror=missing-methods' >> cabal.project"

101+ - |

102+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(swagger2)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"

103+ - cat cabal.project || true

104+ - cat cabal.project.local || true

105+ - if [ -f "./configure.ac" ]; then (cd "." && autoreconf -i); fi

106+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH}

107+ - "cat cabal.project.freeze | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"

108+ - rm cabal.project.freeze

109+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all

110+ - travis_wait 40 ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all

111+script:

112+ - DISTDIR=$(mktemp -d /tmp/dist-test.XXXX)

113+ # Packaging...

114+ - ${CABAL} v2-sdist all

115+ # Unpacking...

116+ - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/

117+ - cd ${DISTDIR} || false

118+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec tar -xvf '{}' \;

119+ - find . -maxdepth 1 -type f -name '*.tar.gz' -exec rm '{}' \;

120+ - PKGDIR_swagger2="$(find . -maxdepth 1 -type d -regex '.*/swagger2-[0-9.]*')"

121+ # Generate cabal.project

122+ - rm -rf cabal.project cabal.project.local cabal.project.freeze

123+ - touch cabal.project

124+ - |

125+ echo "packages: ${PKGDIR_swagger2}" >> cabal.project

126+ - echo 'package swagger2' >> cabal.project

127+ - "echo ' ghc-options: -Werror=missing-methods' >> cabal.project"

128+ - |

129+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | (grep -vE -- '^(swagger2)$' || true) | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"

130+ - cat cabal.project || true

131+ - cat cabal.project.local || true

132+ # Building...

133+ # this builds all libraries and executables (without tests/benchmarks)

134+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all

135+ # Building with tests and benchmarks...

136+ # build & run tests, build benchmarks

137+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all

138+ # Testing...

139+ - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all

140+ # cabal check...

141+ - (cd ${PKGDIR_swagger2} && ${CABAL} -vnormal check)

142+ # haddock...

143+ - ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all

144+ # Building without installed constraints for packages in global-db...

145+ - rm -f cabal.project.local

146+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all

147+

148+# REGENDATA ("0.10.1",["--branches","master","--haddock-jobs=>=8.4","--output",".travis.yml","swagger2.cabal"])

149+# EOF

CHANGELOG.md−47

@@ -1,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−

4812.6.1

492-----

503

README.md+11−13

@@ -1,22 +1,21 @@

1−# OpenApi 3

1+# swagger2

3−[![Hackage](https://img.shields.io/hackage/v/openapi3.svg)](http://hackage.haskell.org/package/openapi3)

4−[![Build Status](https://travis-ci.org/biocad/openapi3.svg?branch=master)](https://travis-ci.org/biocad/openapi3)

5−[![Stackage LTS](http://stackage.org/package/openapi3/badge/lts)](http://stackage.org/lts/package/opeopenapi3)

6−[![Stackage Nightly](http://stackage.org/package/openapi3/badge/nightly)](http://stackage.org/nightly/package/openapi3)

3+[![Join the chat at https://gitter.im/haskell-swagger2/Lobby](https://badges.gitter.im/haskell-swagger2/Lobby.svg)](https://gitter.im/haskell-swagger2/Lobby?utm_source=badge&utm_medium=badge&utm_campaign=pr-badge&utm_content=badge)

8−OpenAPI 3.0 data model.

5+[![Hackage](https://img.shields.io/hackage/v/swagger2.svg)](http://hackage.haskell.org/package/swagger2)

6+[![Build Status](https://travis-ci.org/GetShopTV/swagger2.svg?branch=master)](https://travis-ci.org/GetShopTV/swagger2)

7+[![Stackage LTS](http://stackage.org/package/swagger2/badge/lts)](http://stackage.org/lts/package/swagger2)

8+[![Stackage Nightly](http://stackage.org/package/swagger2/badge/nightly)](http://stackage.org/nightly/package/swagger2)

10−The original OpenAPI 3.0 specification is available at http://swagger.io/specification/.

10+Swagger 2.0 data model.

1111

12−This package is heavily based on excellent work on Swagger 2.0 at

13−https://github.com/GetShopTV/swagger2.

12+The original Swagger 2.0 specification is available at http://swagger.io/specification/.

1413

1514## Usage

1615

17−This library is intended to be used for decoding and encoding OpenApi 3.0.3 specifications as well as manipulating them.

16+This library is intended to be used for decoding and encoding Swagger 2.0 API specifications as well as manipulating them.

1817

19−Please refer to [haddock documentation](http://hackage.haskell.org/package/openapi3).

18+Please refer to [haddock documentation](http://hackage.haskell.org/package/swagger2).

2019

2120Some examples can be found in [`examples/` directory](/examples).

2221

@@ -34,8 +33,7 @@ Many Swagger tools, including server and client code generation for many languag

3433

3534We are happy to receive bug reports, fixes, documentation enhancements, and other improvements.

3635

37−Please report bugs via the [github issue tracker](https://github.com/biocad/openapi3/issues).

36+Please report bugs via the [github issue tracker](https://github.com/GetShopTV/swagger2/issues).

3837

3938*GetShopTV Team*

4039

41−*Biocad Team*

cabal.haskell-cideleted−11

@@ -1,11 +0,0 @@

1−branches: master

2−

3−distribution: focal

4−allow-failures: >=9.2

5−

6−constraint-set aeson-1

7− constraints: aeson <2.0

8− ghc: <9.2

9−

10−constraint-set aeson-2

11− constraints: aeson >=2.0

cabal.project−2

@@ -1,4 +1,2 @@

11packages: .

22tests: true

3−

4−allow-newer: http-media:base

examples/hackage.hs+20−16

@@ -10,10 +10,10 @@ import Data.Proxy

1010import Data.Text (Text)

1111import GHC.Generics

1212

13−import Data.OpenApi

14−import Data.OpenApi.Declare

15−import Data.OpenApi.Lens

16−import Data.OpenApi.Operation

13+import Data.Swagger

14+import Data.Swagger.Declare

15+import Data.Swagger.Lens

16+import Data.Swagger.Operation

1717

1818type Username = Text

1919

@@ -27,7 +27,7 @@ instance ToSchema UserSummary where

2727 usernameSchema <- declareSchemaRef (Proxy :: Proxy Username)

2828 useridSchema <- declareSchemaRef (Proxy :: Proxy Int)

2929 return $ NamedSchema (Just "UserSummary") $ mempty

30− & type_ ?~ OpenApiObject

30+ & type_ ?~ SwaggerObject

3131 & properties .~

3232 [ ("summaryUsername", usernameSchema )

3333 , ("summaryUserid" , useridSchema )

@@ -47,36 +47,40 @@ data UserDetailed = UserDetailed

4747newtype Package = Package { packageName :: Text }

4848 deriving (Generic, ToSchema)

4949

50−hackageOpenApi :: OpenApi

51−hackageOpenApi = spec & components.schemas .~ defs

50+hackageSwagger :: Swagger

51+hackageSwagger = spec & definitions .~ defs

5252 where

53− (defs, spec) = runDeclare declareHackageOpenApi mempty

53+ (defs, spec) = runDeclare declareHackageSwagger mempty

5454

55−declareHackageOpenApi :: Declare (Definitions Schema) OpenApi

56−declareHackageOpenApi = do

55+declareHackageSwagger :: Declare (Definitions Schema) Swagger

56+declareHackageSwagger = do

5757 -- param schemas

5858 let usernameParamSchema = toParamSchema (Proxy :: Proxy Username)

5959

6060 -- responses

61− userSummaryResponse <- declareResponse "application/json" (Proxy :: Proxy UserSummary)

62− userDetailedResponse <- declareResponse "application/json" (Proxy :: Proxy UserDetailed)

63− packagesResponse <- declareResponse "application/json" (Proxy :: Proxy [Package])

61+ userSummaryResponse <- declareResponse (Proxy :: Proxy UserSummary)

62+ userDetailedResponse <- declareResponse (Proxy :: Proxy UserDetailed)

63+ packagesResponse <- declareResponse (Proxy :: Proxy [Package])

6464

6565 return $ mempty

6666 & paths .~

6767 [ ("/users", mempty & get ?~ (mempty

68+ & produces ?~ MimeList ["application/json"]

6869 & at 200 ?~ Inline userSummaryResponse))

6970 , ("/user/{username}", mempty & get ?~ (mempty

71+ & produces ?~ MimeList ["application/json"]

7072 & parameters .~ [ Inline $ mempty

7173 & name .~ "username"

7274 & required ?~ True

73− & in_ .~ ParamPath

74− & schema ?~ Inline usernameParamSchema ]

75+ & schema .~ ParamOther (mempty

76+ & in_ .~ ParamPath

77+ & paramSchema .~ usernameParamSchema) ]

7578 & at 200 ?~ Inline userDetailedResponse))

7679 , ("/packages", mempty & get ?~ (mempty

80+ & produces ?~ MimeList ["application/json"]

7781 & at 200 ?~ Inline packagesResponse))

7882 ]

7983

8084main :: IO ()

81−main = putStrLn . read . show . encode $ hackageOpenApi

85+main = putStrLn . read . show . encode $ hackageSwagger

8286

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.hs → src/Data/Swagger.hsrenamed+49−180

@@ -1,5 +1,5 @@

11-- |

2−-- Module: Data.OpenApi

2+-- Module: Data.Swagger

33-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>

44-- Stability: experimental

55--

@@ -9,7 +9,7 @@

99-- These files can then be used by the Swagger-UI project to display the API

1010-- and Swagger-Codegen to generate clients in various languages.

1111-- Additional utilities can also take advantage of the resulting files, such as testing tools.

12−module Data.OpenApi (

12+module Data.Swagger (

1313 -- * How to use this library

1414 -- $howto

1515

@@ -29,15 +29,15 @@ module Data.OpenApi (

2929 -- $validation

3030

3131 -- * Re-exports

32− module Data.OpenApi.Lens,

33− module Data.OpenApi.Optics,

34− module Data.OpenApi.Operation,

35− module Data.OpenApi.ParamSchema,

36− module Data.OpenApi.Schema,

37− module Data.OpenApi.Schema.Validation,

32+ module Data.Swagger.Lens,

33+ module Data.Swagger.Optics,

34+ module Data.Swagger.Operation,

35+ module Data.Swagger.ParamSchema,

36+ module Data.Swagger.Schema,

37+ module Data.Swagger.Schema.Validation,

3838

3939 -- * Swagger specification

40− OpenApi(..),

40+ Swagger(..),

4141 Server(..),

4242 ServerVariable(..),

4343 Components(..),

@@ -56,7 +56,7 @@ module Data.OpenApi (

5656 TagName,

5757

5858 -- ** Types and formats

59− OpenApiType(..),

59+ SwaggerType(..),

6060 Format,

6161 Definitions,

6262 Style(..),

@@ -73,9 +73,10 @@ module Data.OpenApi (

7373 Encoding(..),

7474

7575 -- ** Schemas

76+ ParamSchema(..),

7677 Schema(..),

7778 NamedSchema(..),

78− OpenApiItems(..),

79+ SwaggerItems(..),

7980 Xml(..),

8081 Pattern,

8182 AdditionalProperties(..),

@@ -85,13 +86,10 @@ module Data.OpenApi (

8586 Responses(..),

8687 Response(..),

8788 HttpStatusCode,

88− Link(..),

89− Callback(..),

9089

9190 -- ** Security

9291 SecurityScheme(..),

9392 SecuritySchemeType(..),

94− HttpSchemeType(..),

9593 SecurityDefinitions(..),

9694 SecurityRequirement(..),

9795

@@ -121,14 +119,14 @@ module Data.OpenApi (

121119 URL(..),

122120) where

123121

124−import Data.OpenApi.Lens

125−import Data.OpenApi.Optics ()

126−import Data.OpenApi.Operation

127−import Data.OpenApi.ParamSchema

128−import Data.OpenApi.Schema

129−import Data.OpenApi.Schema.Validation

122+import Data.Swagger.Lens

123+import Data.Swagger.Optics ()

124+import Data.Swagger.Operation

125+import Data.Swagger.ParamSchema

126+import Data.Swagger.Schema

127+import Data.Swagger.Schema.Validation

130128

131−import Data.OpenApi.Internal

129+import Data.Swagger.Internal

132130

133131-- $setup

134132-- >>> import Control.Lens

@@ -137,7 +135,6 @@ import Data.OpenApi.Internal

137135-- >>> import Data.Proxy

138136-- >>> import GHC.Generics

139137-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL

140−-- >>> import Data.OpenApi.Internal.Utils

141138-- >>> :set -XDeriveGeneric

142139-- >>> :set -XOverloadedStrings

143140-- >>> :set -XOverloadedLists

@@ -154,16 +151,8 @@ import Data.OpenApi.Internal

154151--

155152-- In this library you can use @'mempty'@ for a default/empty value. For instance:

156153--

157−-- >>> BSL.putStrLn $ encodePretty (mempty :: OpenApi)

158−-- {

159−-- "components": {},

160−-- "info": {

161−-- "title": "",

162−-- "version": ""

163−-- },

164−-- "openapi": "3.0.0",

165−-- "paths": {}

166−-- }

154+-- >>> BSL.putStrLn $ encode (mempty :: Swagger)

155+-- {"openapi":"3.0.0","info":{"version":"","title":""},"components":{}}

167156--

168157-- As you can see some spec properties (e.g. @"version"@) are there even when the spec is empty.

169158-- That is because these properties are actually required ones.

@@ -171,87 +160,46 @@ import Data.OpenApi.Internal

171160-- You /should/ always override the default (empty) value for these properties,

172161-- although it is not strictly necessary:

173162--

174−-- >>> BSL.putStrLn $ encodePretty mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }

175−-- {

176−-- "title": "Todo API",

177−-- "version": "1.0"

178−-- }

163+-- >>> BSL.putStrLn $ encode mempty { _infoTitle = "Todo API", _infoVersion = "1.0" }

164+-- {"version":"1.0","title":"Todo API"}

179165--

180166-- You can merge two values using @'mappend'@ or its infix version @('<>')@:

181167--

182−-- >>> BSL.putStrLn $ encodePretty $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }

183−-- {

184−-- "title": "Todo API",

185−-- "version": "1.0"

186−-- }

187−

168+-- >>> BSL.putStrLn $ encode $ mempty { _infoTitle = "Todo API" } <> mempty { _infoVersion = "1.0" }

169+-- {"version":"1.0","title":"Todo API"}

188170--

189171-- This can be useful for combining specifications of endpoints into a whole API specification:

190172--

191173-- @

192174-- \-\- /account subAPI specification

193−-- accountAPI :: OpenApi

175+-- accountAPI :: Swagger

194176--

195177-- \-\- /task subAPI specification

196−-- taskAPI :: OpenApi

178+-- taskAPI :: Swagger

197179--

198180-- \-\- while API specification is just a combination

199181-- \-\- of subAPIs' specifications

200−-- api :: OpenApi

182+-- api :: Swagger

201183-- api = accountAPI <> taskAPI

202184-- @

203185

204186-- $lens

205187--

206−-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.OpenApi.Optics".

188+-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.Swagger.Optics".

207189--

208190-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used

209191-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses

210192-- make it fairly simple to construct/modify any part of the specification:

211193--

212194-- >>> :{

213−-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)

214−-- & components . schemas .~ [ ("User", mempty & type_ ?~ OpenApiString) ]

195+-- BSL.putStrLn $ encode $ (mempty :: Swagger)

196+-- & components . schemas .~ [ ("User", mempty & type_ ?~ SwaggerString) ]

215197-- & paths .~

216198-- [ ("/user", mempty & get ?~ (mempty

217199-- & at 200 ?~ ("OK" & _Inline.content.at "application/json" ?~ (mempty & schema ?~ Ref (Reference "User")))

218200-- & at 404 ?~ "User info not found")) ]

219201-- :}

220−-- {

221−-- "components": {

222−-- "schemas": {

223−-- "User": {

224−-- "type": "string"

225−-- }

226−-- }

227−-- },

228−-- "info": {

229−-- "title": "",

230−-- "version": ""

231−-- },

232−-- "openapi": "3.0.0",

233−-- "paths": {

234−-- "/user": {

235−-- "get": {

236−-- "responses": {

237−-- "200": {

238−-- "content": {

239−-- "application/json": {

240−-- "schema": {

241−-- "$ref": "#/components/schemas/User"

242−-- }

243−-- }

244−-- },

245−-- "description": "OK"

246−-- },

247−-- "404": {

248−-- "description": "User info not found"

249−-- }

250−-- }

251−-- }

252−-- }

253−-- }

254−-- }

202+-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"404":{"description":"User info not found"},"200":{"content":{"application/json":{"schema":{"$ref":"#/components/schemas/User"}}},"description":"OK"}}}}},"components":{"schemas":{"User":{"type":"string"}}}}

255203--

256204-- In the snippet above we declare an API with a single path @/user@. This path provides method @GET@

257205-- which produces @application/json@ output. It should respond with code @200@ and body specified

@@ -263,34 +211,23 @@ import Data.OpenApi.Internal

263211-- common field is @'description'@. Many components of a Swagger specification

264212-- can have descriptions, and you can use the same name for them:

265213--

266−-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & description .~ "No content"

267−-- {

268−-- "description": "No content"

269−-- }

214+-- >>> BSL.putStrLn $ encode $ (mempty :: Response) & description .~ "No content"

215+-- {"description":"No content"}

270216-- >>> :{

271−-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)

272−-- & type_ ?~ OpenApiBoolean

217+-- BSL.putStrLn $ encode $ (mempty :: Schema)

218+-- & type_ ?~ SwaggerBoolean

273219-- & description ?~ "To be or not to be"

274220-- :}

275−-- {

276−-- "description": "To be or not to be",

277−-- "type": "boolean"

278−-- }

221+-- {"description":"To be or not to be","type":"boolean"}

279222--

280223-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@

281224-- have direct access to it via @'at' code@. Example:

282225--

283226-- >>> :{

284−-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)

227+-- BSL.putStrLn $ encode $ (mempty :: Operation)

285228-- & at 404 ?~ "Not found"

286229-- :}

287−-- {

288−-- "responses": {

289−-- "404": {

290−-- "description": "Not found"

291−-- }

292−-- }

293−-- }

230+-- {"responses":{"404":{"description":"Not found"}}}

294231--

295232-- You might've noticed that @'type_'@ has an extra underscore in its name

296233-- compared to, say, @'description'@ field accessor.

@@ -306,7 +243,7 @@ import Data.OpenApi.Internal

306243-- @'ParamSchema'@ and @'Schema'@ are the two core types for data model specification.

307244--

308245-- @'ParamSchema' t@ specifies all the common properties, available for every data schema.

309−-- The @t@ parameter imposes some restrictions on @type@ and @items@ properties (see @'OpenApiType'@ and @'OpenApiItems'@).

246+-- The @t@ parameter imposes some restrictions on @type@ and @items@ properties (see @'SwaggerType'@ and @'SwaggerItems'@).

310247--

311248-- @'Schema'@ is used for request and response bodies and allows specifying objects

312249-- with properties in addition to what @'ParamSchema'@ provides.

@@ -337,81 +274,13 @@ import Data.OpenApi.Internal

337274-- >>> data Person = Person { name :: String, age :: Integer } deriving Generic

338275-- >>> instance ToJSON Person

339276-- >>> instance ToSchema Person

340−-- >>> BSL.putStrLn $ encodePretty (Person "David" 28)

341−-- {

342−-- "age": 28,

343−-- "name": "David"

344−-- }

345−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Person)

346−-- {

347−-- "properties": {

348−-- "age": {

349−-- "type": "integer"

350−-- },

351−-- "name": {

352−-- "type": "string"

353−-- }

354−-- },

355−-- "required": [

356−-- "name",

357−-- "age"

358−-- ],

359−-- "type": "object"

360−-- }

361−--

362−-- This package implements OpenAPI 3.0 spec, which supports @oneOf@ in schemas, allowing any sum types

363−-- to be faithfully represented. All sum encodings supported by @aeson@ are supported here as well, with

364−-- an exception of 'Data.Aeson.TwoElemArray', since OpenAPI spec does not support heterogeneous arrays.

365−--

366−-- An example with 'Data.Aeson.TaggedObject' encoding:

367−--

368−-- >>> data Error = ErrorNoUser { userId :: Int } | ErrorAccessDenied { requiredPermission :: String } deriving Generic

369−-- >>> instance ToJSON Error

370−-- >>> instance ToSchema Error

371−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Error)

372−-- {

373−-- "oneOf": [

374−-- {

375−-- "properties": {

376−-- "tag": {

377−-- "enum": [

378−-- "ErrorNoUser"

379−-- ],

380−-- "type": "string"

381−-- },

382−-- "userId": {

383−-- "maximum": 9223372036854775807,

384−-- "minimum": -9223372036854775808,

385−-- "type": "integer"

386−-- }

387−-- },

388−-- "required": [

389−-- "userId",

390−-- "tag"

391−-- ],

392−-- "type": "object"

393−-- },

394−-- {

395−-- "properties": {

396−-- "requiredPermission": {

397−-- "type": "string"

398−-- },

399−-- "tag": {

400−-- "enum": [

401−-- "ErrorAccessDenied"

402−-- ],

403−-- "type": "string"

404−-- }

405−-- },

406−-- "required": [

407−-- "requiredPermission",

408−-- "tag"

409−-- ],

410−-- "type": "object"

411−-- }

412−-- ],

413−-- "type": "object"

414−-- }

277+-- >>> BSL.putStrLn $ encode (Person "David" 28)

278+-- {"age":28,"name":"David"}

279+-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Person)

280+-- {"required":["name","age"],"properties":{"name":{"type":"string"},"age":{"type":"integer"}},"type":"object"}

281+--

282+-- TODO mention oneOf

283+--

415284

416285-- $manipulation

417286-- Sometimes you have to work with an imported or generated @'Swagger'@.

@@ -419,10 +288,10 @@ import Data.OpenApi.Internal

419288-- for a type-level servant API.

420289--

421290-- Lenses and prisms can be used to manipulate such specification to add additional information, tags, extra responses, etc.

422−-- To facilitate common needs, @"Data.OpenApi.Operation"@ module provides useful helpers.

291+-- To facilitate common needs, @"Data.Swagger.Operation"@ module provides useful helpers.

423292

424293-- $validation

425294-- While @'ToParamSchema'@ and @'ToSchema'@ provide means to easily obtain schemas for Haskell types,

426295-- there is no static mechanism to ensure those instances correspond to the @'ToHttpApiData'@ or @'ToJSON'@ instances.

427296--

428−-- @"Data.OpenApi.Schema.Validation"@ addresses @'ToJSON'@/@'ToSchema'@ validation.

297+-- @"Data.Swagger.Schema.Validation"@ addresses @'ToJSON'@/@'ToSchema'@ validation.

src/Data/OpenApi/Declare.hs → src/Data/Swagger/Declare.hsrenamed+2−2

@@ -4,12 +4,12 @@

44{-# LANGUAGE MultiParamTypeClasses #-}

55{-# LANGUAGE UndecidableInstances #-}

66-- |

7−-- Module: Data.OpenApi.Declare

7+-- Module: Data.Swagger.Declare

88-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>

99-- Stability: experimental

1010--

1111-- Declare monad transformer and associated functions.

12−module Data.OpenApi.Declare where

12+module Data.Swagger.Declare where

1313

1414import Prelude ()

1515import Prelude.Compat

src/Data/OpenApi/Internal.hs → src/Data/Swagger/Internal.hsrenamed+143−289

@@ -1,6 +1,6 @@

1−{-# LANGUAGE CPP #-}

21{-# LANGUAGE DataKinds #-}

32{-# LANGUAGE DeriveDataTypeable #-}

3+{-# LANGUAGE DeriveFunctor #-}

44{-# LANGUAGE DeriveGeneric #-}

55{-# LANGUAGE DeriveTraversable #-}

66{-# LANGUAGE FlexibleContexts #-}

@@ -14,7 +14,7 @@

1414{-# LANGUAGE TemplateHaskell #-}

1515{-# LANGUAGE TypeFamilies #-}

1616{-# LANGUAGE UndecidableInstances #-}

17−module Data.OpenApi.Internal where

17+module Data.Swagger.Internal where

1818

1919import Prelude ()

2020import Prelude.Compat

@@ -22,9 +22,6 @@ import Prelude.Compat

2222import Control.Applicative

2323import Control.Lens ((&), (.~), (?~))

2424import Data.Aeson hiding (Encoding)

25−#if MIN_VERSION_aeson(2,0,0)

26−import qualified Data.Aeson.KeyMap as KeyMap

27−#endif

2825import qualified Data.Aeson.Types as JSON

2926import Data.Data (Constr, Data (..), DataType, Fixity (..), Typeable,

3027 constrIndex, mkConstr, mkDataType)

@@ -49,56 +46,58 @@ import Text.Read (readMaybe)

4946import Data.HashMap.Strict.InsOrd (InsOrdHashMap)

5047import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

5148

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

5849import Generics.SOP.TH (deriveGeneric)

50+import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToJSON

51+ ,sopSwaggerGenericToJSONWithOpts

52+ ,sopSwaggerGenericParseJSON

53+ ,HasSwaggerAesonOptions(..)

54+ ,AesonDefaultValue(..)

55+ ,mkSwaggerAesonOptions

56+ ,saoAdditionalPairs

57+ ,saoSubObject)

58+import Data.Swagger.Internal.Utils

59+import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)

5960

6061-- $setup

6162-- >>> :seti -XDataKinds

6263-- >>> import Data.Aeson

63−-- >>> import Data.ByteString.Lazy.Char8 as BSL

64−-- >>> import Data.OpenApi.Internal.Utils

6564

6665-- | A list of definitions that can be used in references.

6766type Definitions = InsOrdHashMap Text

6867

6968-- | This is the root document object for the API specification.

70−data OpenApi = OpenApi

69+data Swagger = Swagger

7170 { -- | Provides metadata about the API.

7271 -- The metadata can be used by the clients if needed.

73− _openApiInfo :: Info

72+ _swaggerInfo :: Info

7473

7574 -- | An array of Server Objects, which provide connectivity information

7675 -- to a target server. If the servers property is not provided, or is an empty array,

7776 -- the default value would be a 'Server' object with a url value of @/@.

78− , _openApiServers :: [Server]

77+ , _swaggerServers :: [Server]

7978

8079 -- | The available paths and operations for the API.

81− , _openApiPaths :: InsOrdHashMap FilePath PathItem

80+ , _swaggerPaths :: InsOrdHashMap FilePath PathItem

8281

8382 -- | An element to hold various schemas for the specification.

84− , _openApiComponents :: Components

83+ , _swaggerComponents :: Components

8584

8685 -- | A declaration of which security mechanisms can be used across the API.

8786 -- The list of values includes alternative security requirement objects that can be used.

8887 -- Only one of the security requirement objects need to be satisfied to authorize a request.

8988 -- Individual operations can override this definition.

9089 -- To make security optional, an empty security requirement can be included in the array.

91− , _openApiSecurity :: [SecurityRequirement]

90+ , _swaggerSecurity :: [SecurityRequirement]

9291

9392 -- | A list of tags used by the specification with additional metadata.

9493 -- The order of the tags can be used to reflect on their order by the parsing tools.

9594 -- Not all tags that are used by the 'Operation' Object must be declared.

9695 -- The tags that are not declared MAY be organized randomly or based on the tools' logic.

9796 -- Each tag name in the list MUST be unique.

98− , _openApiTags :: InsOrdHashSet Tag

97+ , _swaggerTags :: InsOrdHashSet Tag

9998

10099 -- | Additional external documentation.

101− , _openApiExternalDocs :: Maybe ExternalDocs

100+ , _swaggerExternalDocs :: Maybe ExternalDocs

102101 } deriving (Eq, Show, Generic, Data, Typeable)

103102

104103-- | The object provides metadata about the API.

@@ -195,10 +194,10 @@ data Components = Components

195194 , _componentsParameters :: Definitions Param

196195 , _componentsExamples :: Definitions Example

197196 , _componentsRequestBodies :: Definitions RequestBody

198− , _componentsHeaders :: Definitions Header

199− , _componentsSecuritySchemes :: SecurityDefinitions

200− , _componentsLinks :: Definitions Link

201− , _componentsCallbacks :: Definitions Callback

197+ , _componentsHeader :: Definitions Header

198+ , _componentsSecuritySchemes :: Definitions SecurityScheme

199+-- , _componentsLinks

200+-- , _componentsCallbacks

202201 } deriving (Eq, Show, Generic, Data, Typeable)

203202

204203-- | Describes the operations available on a single path.

@@ -288,11 +287,7 @@ data Operation = Operation

288287 -- | The list of possible responses as they are returned from executing this operation.

289288 , _operationResponses :: Responses

290289

291− -- | A map of possible out-of band callbacks related to the parent operation.

292− -- The key is a unique identifier for the 'Callback' Object.

293− -- Each value in the map is a 'Callback' Object that describes a request

294− -- that may be initiated by the API provider and the expected responses.

295− , _operationCallbacks :: InsOrdHashMap Text (Referenced Callback)

290+ -- TODO callbacks

296291

297292 -- | Declares this operation to be deprecated.

298293 -- Usage of the declared operation should be refrained.

@@ -337,11 +332,9 @@ data RequestBody = RequestBody

337332 -- | The content of the request body.

338333 -- The key is a media type or media type range and the value describes it.

339334 -- For requests that match multiple keys, only the most specific key is applicable.

340− -- e.g. @text/plain@ overrides @text/\*@

335+ -- e.g. @text/plain@ overrides @text/*@

341336 , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject

342337

343− -- | Determines if the request body is required in the request.

344− -- Defaults to 'False'.

345338 , _requestBodyRequired :: Maybe Bool

346339 } deriving (Eq, Show, Generic, Data, Typeable)

347340

@@ -394,7 +387,7 @@ data Encoding = Encoding

394387 -- for other primitive types – @text/plain@; for object - @application/json@;

395388 -- for array – the default is defined based on the inner type.

396389 -- 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.

390+ -- a wildcard media type (e.g. @image/*@), or a comma-separated list of the two types.

398391 _encodingContentType :: Maybe MediaType

399392

400393 -- | A map allowing additional information to be provided as headers,

@@ -434,11 +427,11 @@ mimeListConstr :: Constr

434427mimeListConstr = mkConstr mimeListDataType "MimeList" ["getMimeList"] Prefix

435428

436429mimeListDataType :: DataType

437−mimeListDataType = mkDataType "Data.OpenApi.MimeList" [mimeListConstr]

430+mimeListDataType = mkDataType "Data.Swagger.MimeList" [mimeListConstr]

438431

439432instance Data MimeList where

440433 gunfold k z c = case constrIndex c of

441− 1 -> k (z (MimeList . map fromString))

434+ 1 -> k (z (\xs -> MimeList (map fromString xs)))

442435 _ -> error $ "Data.Data.gunfold: Constructor " ++ show c ++ " is not of type MimeList."

443436 toConstr (MimeList _) = mimeListConstr

444437 dataTypeOf _ = mimeListDataType

@@ -452,7 +445,7 @@ data Param = Param

452445

453446 -- | A brief description of the parameter.

454447 -- This could contain examples of use.

455− -- CommonMark syntax MAY be used for rich text representation.

448+ -- GFM syntax can be used for rich text representation.

456449 , _paramDescription :: Maybe Text

457450

458451 -- | Determines whether this parameter is mandatory.

@@ -472,13 +465,6 @@ data Param = Param

472465 -- a parameter with an empty value. Default value is @false@.

473466 , _paramAllowEmptyValue :: Maybe Bool

474467

475− -- | Determines whether the parameter value SHOULD allow reserved characters,

476− -- as defined by [RFC3986](https://tools.ietf.org/html/rfc3986#section-2.2)

477− -- @:/?#[]@!$&'()*+,;=@ to be included without percent-encoding.

478− -- This property only applies to parameters with an '_paramIn' value of 'ParamQuery'.

479− -- The default value is 'False'.

480− , _paramAllowReserved :: Maybe Bool

481−

482468 -- | Parameter schema.

483469 , _paramSchema :: Maybe (Referenced Schema)

484470

@@ -509,10 +495,6 @@ data Param = Param

509495 -- Furthermore, if referencing a schema that contains an example,

510496 -- the examples value SHALL override the example provided by the schema.

511497 , _paramExamples :: InsOrdHashMap Text (Referenced Example)

512−

513− -- TODO

514− -- _paramContent :: InsOrdHashMap MediaType MediaTypeObject

515− -- should be singleton. mutually exclusive with _paramSchema.

516498 } deriving (Eq, Show, Generic, Data, Typeable)

517499

518500data Example = Example

@@ -537,63 +519,27 @@ data Example = Example

537519 , _exampleExternalValue :: Maybe URL

538520 } deriving (Eq, Show, Generic, Typeable, Data)

539521

540−data ExpressionOrValue

541− = Expression Text

542− | Value Value

543− deriving (Eq, Show, Generic, Typeable, Data)

544−

545−-- | The Link object represents a possible design-time link for a response.

546−-- The presence of a link does not guarantee the caller's ability to successfully invoke it,

547−-- rather it provides a known relationship and traversal mechanism between responses and other operations.

548−data Link = Link

549− { -- | A relative or absolute URI reference to an OAS operation.

550− -- This field is mutually exclusive of the '_linkOperationId' field,

551− -- and MUST point to an 'Operation' Object. Relative '_linkOperationRef'

552− -- values MAY be used to locate an existing 'Operation' Object in the OpenAPI definition.

553− _linkOperationRef :: Maybe Text

554−

555− -- | The name of an /existing/, resolvable OAS operation, as defined with a unique

556− -- '_operationOperationId'. This field is mutually exclusive of the '_linkOperationRef' field.

557− , _linkOperationId :: Maybe Text

558−

559− -- | A map representing parameters to pass to an operation as specified with '_linkOperationId'

560− -- or identified via '_linkOperationRef'. The key is the parameter name to be used, whereas

561− -- the value can be a constant or an expression to be evaluated and passed to the linked operation.

562− -- The parameter name can be qualified using the parameter location @[{in}.]{name}@

563− -- for operations that use the same parameter name in different locations (e.g. path.id).

564− , _linkParameters :: InsOrdHashMap Text ExpressionOrValue

565−

566− -- | A literal value or @{expression}@ to use as a request body when calling the target operation.

567− , _linkRequestBody :: Maybe ExpressionOrValue

568−

569− -- | A description of the link.

570− , _linkDescription :: Maybe Text

571−

572− -- | A server object to be used by the target operation.

573− , _linkServer :: Maybe Server

574− } deriving (Eq, Show, Generic, Typeable, Data)

575−

576−-- | Items for @'OpenApiArray'@ schemas.

522+-- | Items for @'SwaggerArray'@ schemas.

577523--

578524-- __Warning__: OpenAPI 3.0 does not support tuple arrays. However, OpenAPI 3.1 will, as

579525-- it will incorporate Json Schema mostly verbatim.

580526--

581−-- @'OpenApiItemsObject'@ should be used to specify homogenous array @'Schema'@s.

527+-- @'SwaggerItemsObject'@ should be used to specify homogenous array @'Schema'@s.

582528--

583−-- @'OpenApiItemsArray'@ should be used to specify tuple @'Schema'@s.

584−data OpenApiItems where

585− OpenApiItemsObject :: Referenced Schema -> OpenApiItems

586− OpenApiItemsArray :: [Referenced Schema] -> OpenApiItems

529+-- @'SwaggerItemsArray'@ should be used to specify tuple @'Schema'@s.

530+data SwaggerItems where

531+ SwaggerItemsObject :: Referenced Schema -> SwaggerItems

532+ SwaggerItemsArray :: [Referenced Schema] -> SwaggerItems

587533 deriving (Eq, Show, Typeable, Data)

588534

589−data OpenApiType where

590− OpenApiString :: OpenApiType

591− OpenApiNumber :: OpenApiType

592− OpenApiInteger :: OpenApiType

593− OpenApiBoolean :: OpenApiType

594− OpenApiArray :: OpenApiType

595− OpenApiNull :: OpenApiType

596− OpenApiObject :: OpenApiType

535+data SwaggerType where

536+ SwaggerString :: SwaggerType

537+ SwaggerNumber :: SwaggerType

538+ SwaggerInteger :: SwaggerType

539+ SwaggerBoolean :: SwaggerType

540+ SwaggerArray :: SwaggerType

541+ SwaggerNull :: SwaggerType

542+ SwaggerObject :: SwaggerType

597543 deriving (Eq, Show, Typeable, Generic, Data)

598544

599545data ParamLocation

@@ -638,33 +584,9 @@ data Schema = Schema

638584 , _schemaMaxProperties :: Maybe Integer

639585 , _schemaMinProperties :: Maybe Integer

640586

641− , -- | Declares the value of the parameter that the server will use if none is provided,

642− -- for example a @"count"@ to control the number of results per page might default to @100@

643− -- if not supplied by the client in the request.

644− -- (Note: "default" has no meaning for required parameters.)

645− -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.

646− _schemaDefault :: Maybe Value

647−

648− , _schemaType :: Maybe OpenApiType

649− , _schemaFormat :: Maybe Format

650− , _schemaItems :: Maybe OpenApiItems

651− , _schemaMaximum :: Maybe Scientific

652− , _schemaExclusiveMaximum :: Maybe Bool

653− , _schemaMinimum :: Maybe Scientific

654− , _schemaExclusiveMinimum :: Maybe Bool

655− , _schemaMaxLength :: Maybe Integer

656− , _schemaMinLength :: Maybe Integer

657− , _schemaPattern :: Maybe Pattern

658− , _schemaMaxItems :: Maybe Integer

659− , _schemaMinItems :: Maybe Integer

660− , _schemaUniqueItems :: Maybe Bool

661− , _schemaEnum :: Maybe [Value]

662− , _schemaMultipleOf :: Maybe Scientific

587+ , _schemaParamSchema :: ParamSchema

663588 } deriving (Eq, Show, Generic, Data, Typeable)

664589

665−-- | Regex pattern for @string@ type.

666−type Pattern = Text

667−

668590data Discriminator = Discriminator

669591 { -- | The name of the property in the payload that will hold the discriminator value.

670592 _discriminatorPropertyName :: Text

@@ -680,9 +602,37 @@ data NamedSchema = NamedSchema

680602 , _namedSchemaSchema :: Schema

681603 } deriving (Eq, Show, Generic, Data, Typeable)

682604

605+-- | Regex pattern for @string@ type.

606+type Pattern = Text

607+

608+data ParamSchema = ParamSchema

609+ { -- | Declares the value of the parameter that the server will use if none is provided,

610+ -- for example a @"count"@ to control the number of results per page might default to @100@

611+ -- if not supplied by the client in the request.

612+ -- (Note: "default" has no meaning for required parameters.)

613+ -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.

614+ _paramSchemaDefault :: Maybe Value

615+

616+ , _paramSchemaType :: Maybe SwaggerType

617+ , _paramSchemaFormat :: Maybe Format

618+ , _paramSchemaItems :: Maybe SwaggerItems

619+ , _paramSchemaMaximum :: Maybe Scientific

620+ , _paramSchemaExclusiveMaximum :: Maybe Bool

621+ , _paramSchemaMinimum :: Maybe Scientific

622+ , _paramSchemaExclusiveMinimum :: Maybe Bool

623+ , _paramSchemaMaxLength :: Maybe Integer

624+ , _paramSchemaMinLength :: Maybe Integer

625+ , _paramSchemaPattern :: Maybe Pattern

626+ , _paramSchemaMaxItems :: Maybe Integer

627+ , _paramSchemaMinItems :: Maybe Integer

628+ , _paramSchemaUniqueItems :: Maybe Bool

629+ , _paramSchemaEnum :: Maybe [Value]

630+ , _paramSchemaMultipleOf :: Maybe Scientific

631+ } deriving (Eq, Show, Generic, Typeable, Data)

632+

683633data Xml = Xml

684634 { -- | Replaces the name of the element/attribute used for the described schema property.

685− -- When defined within the @'OpenApiItems'@ (items), it will affect the name of the individual XML elements within the list.

635+ -- When defined within the @'SwaggerItems'@ (items), it will affect the name of the individual XML elements within the list.

686636 -- When defined alongside type being array (outside the items),

687637 -- it will affect the wrapping element and only if wrapped is true.

688638 -- If wrapped is false, it will be ignored.

@@ -734,44 +684,25 @@ data Response = Response

734684 -- | A map containing descriptions of potential response payloads.

735685 -- The key is a media type or media type range and the value describes it.

736686 -- For responses that match multiple keys, only the most specific key is applicable.

737− -- e.g. @text/plain@ overrides @text/\*@.

687+ -- e.g. @text/plain@ overrides @text/*@.

738688 , _responseContent :: InsOrdHashMap MediaType MediaTypeObject

739689

740690 -- | Maps a header name to its definition.

741691 , _responseHeaders :: InsOrdHashMap HeaderName (Referenced Header)

742692

743− -- | A map of operations links that can be followed from the response.

744− -- The key of the map is a short name for the link, following the naming

745− -- constraints of the names for 'Component' Objects.

746− , _responseLinks :: InsOrdHashMap Text (Referenced Link)

693+ -- TODO links

747694 } deriving (Eq, Show, Generic, Data, Typeable)

748695

749696instance IsString Response where

750− fromString s = Response (fromString s) mempty mempty mempty

751−

752−-- | A map of possible out-of band callbacks related to the parent operation.

753−-- Each value in the map is a 'PathItem' Object that describes a set of requests that

754−-- may be initiated by the API provider and the expected responses.

755−-- The key value used to identify the path item object is an expression, evaluated at runtime,

756−-- that identifies a URL to use for the callback operation.

757−newtype Callback = Callback (InsOrdHashMap Text PathItem)

758− deriving (Eq, Show, Generic, Data, Typeable)

697+ fromString s = Response (fromString s) mempty mempty

759698

760699type HeaderName = Text

761700

762−-- | Header fields have the same meaning as for 'Param'.

763−--

764−-- Style is always treated as 'StyleSimple', as it is the only value allowed for headers.

701+

702+-- TODO this is mostly a copy of 'Param'.

765703data Header = Header

766704 { -- | A short description of the header.

767− _headerDescription :: Maybe HeaderName

768−

769− , _headerRequired :: Maybe Bool

770− , _headerDeprecated :: Maybe Bool

771− , _headerAllowEmptyValue :: Maybe Bool

772− , _headerExplode :: Maybe Bool

773− , _headerExample :: Maybe Value

774− , _headerExamples :: InsOrdHashMap Text (Referenced Example)

705+ _headerDescription :: Maybe Text

775706

776707 , _headerSchema :: Maybe (Referenced Schema)

777708 } deriving (Eq, Show, Generic, Data, Typeable)

@@ -797,17 +728,17 @@ type AuthorizationURL = Text

797728-- | The token URL to be used for OAuth2 flow. This SHOULD be in the form of a URL.

798729type TokenURL = Text

799730

800−newtype OAuth2ImplicitFlow

801− = OAuth2ImplicitFlow {_oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL}

802− deriving (Eq, Show, Generic, Data, Typeable)

731+data OAuth2ImplicitFlow = OAuth2ImplicitFlow

732+ { _oAuth2ImplicitFlowAuthorizationUrl :: AuthorizationURL

733+ } deriving (Eq, Show, Generic, Data, Typeable)

803734

804−newtype OAuth2PasswordFlow

805− = OAuth2PasswordFlow {_oAuth2PasswordFlowTokenUrl :: TokenURL}

806− deriving (Eq, Show, Generic, Data, Typeable)

735+data OAuth2PasswordFlow = OAuth2PasswordFlow

736+ { _oAuth2PasswordFlowTokenUrl :: TokenURL

737+ } deriving (Eq, Show, Generic, Data, Typeable)

807738

808−newtype OAuth2ClientCredentialsFlow

809− = OAuth2ClientCredentialsFlow {_oAuth2ClientCredentialsFlowTokenUrl :: TokenURL}

810− deriving (Eq, Show, Generic, Data, Typeable)

739+data OAuth2ClientCredentialsFlow = OAuth2ClientCredentialsFlow

740+ { _oAuth2ClientCredentialsFlowTokenUrl :: TokenURL

741+ } deriving (Eq, Show, Generic, Data, Typeable)

811742

812743data OAuth2AuthorizationCodeFlow = OAuth2AuthorizationCodeFlow

813744 { _oAuth2AuthorizationCodeFlowAuthorizationUrl :: AuthorizationURL

@@ -840,50 +771,8 @@ data OAuth2Flows = OAuth2Flows

840771 , _oAuth2FlowsAuthorizationCode :: Maybe (OAuth2Flow OAuth2AuthorizationCodeFlow)

841772 } deriving (Eq, Show, Generic, Data, Typeable)

842773

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−--

885774data SecuritySchemeType

886− = SecuritySchemeHttp HttpSchemeType

775+ = SecuritySchemeHttp

887776 | SecuritySchemeApiKey ApiKeyParams

888777 | SecuritySchemeOAuth2 OAuth2Flows

889778 | SecuritySchemeOpenIdConnect URL

@@ -918,7 +807,7 @@ data Tag = Tag

918807 _tagName :: TagName

919808

920809 -- | A short description for the tag.

921− -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.

810+ -- GFM syntax can be used for rich text representation.

922811 , _tagDescription :: Maybe Text

923812

924813 -- | Additional external documentation for this tag.

@@ -933,7 +822,7 @@ instance IsString Tag where

933822-- | Allows referencing an external resource for extended documentation.

934823data ExternalDocs = ExternalDocs

935824 { -- | A short description of the target documentation.

936− -- [CommonMark syntax](https://spec.commonmark.org/) MAY be used for rich text representation.

825+ -- GFM syntax can be used for rich text representation.

937826 _externalDocsDescription :: Maybe Text

938827

939828 -- | The URL for the target documentation.

@@ -980,18 +869,18 @@ deriveGeneric ''MediaTypeObject

980869deriveGeneric ''Responses

981870deriveGeneric ''SecurityScheme

982871deriveGeneric ''Schema

983−deriveGeneric ''OpenApi

872+deriveGeneric ''ParamSchema

873+deriveGeneric ''Swagger

984874deriveGeneric ''Example

985875deriveGeneric ''Encoding

986−deriveGeneric ''Link

987876

988877-- =======================================================================

989878-- Monoid instances

990879-- =======================================================================

991880

992−instance Semigroup OpenApi where

881+instance Semigroup Swagger where

993882 (<>) = genericMappend

994−instance Monoid OpenApi where

883+instance Monoid Swagger where

995884 mempty = genericMempty

996885 mappend = (<>)

997886

@@ -1025,6 +914,12 @@ instance Monoid Schema where

1025914 mempty = genericMempty

1026915 mappend = (<>)

1027916

917+instance Semigroup ParamSchema where

918+ (<>) = genericMappend

919+instance Monoid ParamSchema where

920+ mempty = genericMempty

921+ mappend = (<>)

922+

1028923instance Semigroup Param where

1029924 (<>) = genericMappend

1030925instance Monoid Param where

@@ -1119,19 +1014,19 @@ instance SwaggerMonoid Info

11191014instance SwaggerMonoid Components

11201015instance SwaggerMonoid PathItem

11211016instance SwaggerMonoid Schema

1017+instance SwaggerMonoid ParamSchema

11221018instance SwaggerMonoid Param

11231019instance SwaggerMonoid Responses

11241020instance SwaggerMonoid Response

11251021instance SwaggerMonoid ExternalDocs

11261022instance SwaggerMonoid Operation

11271023instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)

1128−instance SwaggerMonoid SecurityDefinitions

11291024

11301025instance SwaggerMonoid MimeList

11311026deriving instance SwaggerMonoid URL

11321027

1133−instance SwaggerMonoid OpenApiType where

1134− swaggerMempty = OpenApiString

1028+instance SwaggerMonoid SwaggerType where

1029+ swaggerMempty = SwaggerString

11351030 swaggerMappend _ y = y

11361031

11371032instance SwaggerMonoid ParamLocation where

@@ -1154,7 +1049,7 @@ instance Monoid a => SwaggerMonoid (Referenced a) where

11541049instance ToJSON Style where

11551050 toJSON = genericToJSON (jsonPrefix "Style")

11561051

1157−instance ToJSON OpenApiType where

1052+instance ToJSON SwaggerType where

11581053 toJSON = genericToJSON (jsonPrefix "Swagger")

11591054

11601055instance ToJSON ParamLocation where

@@ -1209,7 +1104,7 @@ instance ToJSON OAuth2AuthorizationCodeFlow where

12091104instance FromJSON Style where

12101105 parseJSON = genericParseJSON (jsonPrefix "Style")

12111106

1212−instance FromJSON OpenApiType where

1107+instance FromJSON SwaggerType where

12131108 parseJSON = genericParseJSON (jsonPrefix "Swagger")

12141109

12151110instance FromJSON ParamLocation where

@@ -1274,19 +1169,8 @@ instance ToJSON OAuth2Flows where

12741169 toEncoding = sopSwaggerGenericToEncoding

12751170

12761171instance ToJSON SecuritySchemeType where

1277− toJSON (SecuritySchemeHttp ty) = case ty of

1278− HttpSchemeBearer mFmt ->

1279− object $ [ "type" .= ("http" :: Text)

1280− , "scheme" .= ("bearer" :: Text)

1281− ] <> maybe [] (\t -> ["bearerFormat" .= t]) mFmt

1282− HttpSchemeBasic ->

1283− object [ "type" .= ("http" :: Text)

1284− , "scheme" .= ("basic" :: Text)

1285− ]

1286− HttpSchemeCustom t ->

1287− object [ "type" .= ("http" :: Text)

1288− , "scheme" .= t

1289− ]

1172+ toJSON SecuritySchemeHttp

1173+ = object [ "type" .= ("http" :: Text) ]

12901174 toJSON (SecuritySchemeApiKey params)

12911175 = toJSON params

12921176 <+> object [ "type" .= ("apiKey" :: Text) ]

@@ -1299,9 +1183,9 @@ instance ToJSON SecuritySchemeType where

12991183 , "openIdConnectUrl" .= url

13001184 ]

13011185

1302−instance ToJSON OpenApi where

1186+instance ToJSON Swagger where

13031187 toJSON a = sopSwaggerGenericToJSON a &

1304− if InsOrdHashMap.null (_openApiPaths a)

1188+ if InsOrdHashMap.null (_swaggerPaths a)

13051189 then (<+> object ["paths" .= object []])

13061190 else id

13071191 toEncoding = sopSwaggerGenericToEncoding

@@ -1315,8 +1199,8 @@ instance ToJSON SecurityScheme where

13151199 toEncoding = sopSwaggerGenericToEncoding

13161200

13171201instance ToJSON Schema where

1318− toJSON = sopSwaggerGenericToJSONWithOpts $

1319− mkSwaggerAesonOptions "schema" & saoSubObject ?~ "items"

1202+ toJSON = sopSwaggerGenericToJSON

1203+ toEncoding = sopSwaggerGenericToEncoding

13201204

13211205instance ToJSON Header where

13221206 toJSON = sopSwaggerGenericToJSON

@@ -1325,21 +1209,17 @@ instance ToJSON Header where

13251209-- | As for nullary schema for 0-arity type constructors, see

13261210-- <https://github.com/GetShopTV/swagger2/issues/167>.

13271211--

1328−-- >>> BSL.putStrLn $ encodePretty (OpenApiItemsArray [])

1329−-- {

1330−-- "example": [],

1331−-- "items": {},

1332−-- "maxItems": 0

1333−-- }

1212+-- >>> encode (SwaggerItemsArray [])

1213+-- "{\"example\":[],\"items\":{},\"maxItems\":0}"

13341214--

1335−instance ToJSON OpenApiItems where

1336− toJSON (OpenApiItemsObject x) = object [ "items" .= x ]

1337− toJSON (OpenApiItemsArray []) = object

1215+instance ToJSON SwaggerItems where

1216+ toJSON (SwaggerItemsObject x) = object [ "items" .= x ]

1217+ toJSON (SwaggerItemsArray []) = object

13381218 [ "items" .= object []

13391219 , "maxItems" .= (0 :: Int)

13401220 , "example" .= Array mempty

13411221 ]

1342− toJSON (OpenApiItemsArray x) = object [ "items" .= x ]

1222+ toJSON (SwaggerItemsArray x) = object [ "items" .= x ]

13431223

13441224instance ToJSON Components where

13451225 toJSON = sopSwaggerGenericToJSON

@@ -1384,10 +1264,6 @@ instance ToJSON Encoding where

13841264 toJSON = sopSwaggerGenericToJSON

13851265 toEncoding = sopSwaggerGenericToEncoding

13861266

1387−instance ToJSON Link where

1388− toJSON = sopSwaggerGenericToJSON

1389− toEncoding = sopSwaggerGenericToEncoding

1390−

13911267instance ToJSON SecurityDefinitions where

13921268 toJSON (SecurityDefinitions sd) = toJSON sd

13931269

@@ -1404,20 +1280,16 @@ instance ToJSON (Referenced Response) where toJSON = referencedToJSON "#/compone

14041280instance ToJSON (Referenced RequestBody) where toJSON = referencedToJSON "#/components/requestBodies/"

14051281instance ToJSON (Referenced Example) where toJSON = referencedToJSON "#/components/examples/"

14061282instance ToJSON (Referenced Header) where toJSON = referencedToJSON "#/components/headers/"

1407−instance ToJSON (Referenced Link) where toJSON = referencedToJSON "#/components/links/"

1408−instance ToJSON (Referenced Callback) where toJSON = referencedToJSON "#/components/callbacks/"

1283+

1284+instance ToJSON ParamSchema where

1285+ -- TODO: this is a bit fishy, why we need sub object only in `ToJSON`?

1286+ toJSON = sopSwaggerGenericToJSONWithOpts $

1287+ mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"

14091288

14101289instance ToJSON AdditionalProperties where

14111290 toJSON (AdditionalPropertiesAllowed b) = toJSON b

14121291 toJSON (AdditionalPropertiesSchema s) = toJSON s

14131292

1414−instance ToJSON ExpressionOrValue where

1415− toJSON (Expression expr) = toJSON expr

1416− toJSON (Value val) = toJSON val

1417−

1418−instance ToJSON Callback where

1419− toJSON (Callback ps) = toJSON ps

1420−

14211293-- =======================================================================

14221294-- Manual FromJSON instances

14231295-- =======================================================================

@@ -1439,19 +1311,14 @@ instance FromJSON SecuritySchemeType where

14391311 parseJSON js@(Object o) = do

14401312 (t :: Text) <- o .: "type"

14411313 case t of

1442− "http" -> do

1443− scheme <- o .: "scheme"

1444− SecuritySchemeHttp <$> case scheme of

1445− "bearer" -> HttpSchemeBearer <$> (o .:! "bearerFormat")

1446− "basic" -> pure HttpSchemeBasic

1447− t -> pure $ HttpSchemeCustom t

1314+ "http" -> pure SecuritySchemeHttp

14481315 "apiKey" -> SecuritySchemeApiKey <$> parseJSON js

14491316 "oauth2" -> SecuritySchemeOAuth2 <$> (o .: "flows")

14501317 "openIdConnect" -> SecuritySchemeOpenIdConnect <$> (o .: "openIdConnectUrl")

14511318 _ -> empty

14521319 parseJSON _ = empty

14531320

1454−instance FromJSON OpenApi where

1321+instance FromJSON Swagger where

14551322 parseJSON = sopSwaggerGenericParseJSON

14561323

14571324instance FromJSON Server where

@@ -1463,28 +1330,27 @@ instance FromJSON SecurityScheme where

14631330instance FromJSON Schema where

14641331 parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON

14651332 where nullaryCleanup :: Schema -> Schema

1466− nullaryCleanup s =

1467− if _schemaItems s == Just (OpenApiItemsArray [])

1333+ nullaryCleanup s@Schema{_schemaParamSchema=ps} =

1334+ if _paramSchemaItems ps == Just (SwaggerItemsArray [])

14681335 then s { _schemaExample = Nothing

1469− , _schemaMaxItems = Nothing

1470− }

1336+ , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }

14711337 else s

14721338

14731339instance FromJSON Header where

14741340 parseJSON = sopSwaggerGenericParseJSON

14751341

1476−instance FromJSON OpenApiItems where

1342+instance FromJSON SwaggerItems where

14771343 parseJSON js@(Object obj)

1478− | null obj = pure $ OpenApiItemsArray [] -- Nullary schema.

1479− | otherwise = OpenApiItemsObject <$> parseJSON js

1480− parseJSON js@(Array _) = OpenApiItemsArray <$> parseJSON js

1344+ | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.

1345+ | otherwise = SwaggerItemsObject <$> parseJSON js

1346+ parseJSON js@(Array _) = SwaggerItemsArray <$> parseJSON js

14811347 parseJSON _ = empty

14821348

14831349instance FromJSON Components where

14841350 parseJSON = sopSwaggerGenericParseJSON

14851351

14861352instance FromJSON MimeList where

1487− parseJSON js = MimeList . map fromString <$> parseJSON js

1353+ parseJSON js = (MimeList . map fromString) <$> parseJSON js

14881354

14891355instance FromJSON Param where

14901356 parseJSON = sopSwaggerGenericParseJSON

@@ -1492,7 +1358,7 @@ instance FromJSON Param where

14921358instance FromJSON Responses where

14931359 parseJSON (Object o) = Responses

14941360 <$> o .:? "default"

1495− <*> parseJSON (Object (deleteKey "default" o))

1361+ <*> (parseJSON (Object (HashMap.delete "default" o)))

14961362 parseJSON _ = empty

14971363

14981364instance FromJSON Example where

@@ -1519,9 +1385,6 @@ instance FromJSON MediaTypeObject where

15191385instance FromJSON Encoding where

15201386 parseJSON = sopSwaggerGenericParseJSON

15211387

1522−instance FromJSON Link where

1523− parseJSON = sopSwaggerGenericParseJSON

1524−

15251388instance FromJSON Reference where

15261389 parseJSON (Object o) = Reference <$> o .: "$ref"

15271390 parseJSON _ = empty

@@ -1545,24 +1408,17 @@ instance FromJSON (Referenced Response) where parseJSON = referencedParseJSON "#

15451408instance FromJSON (Referenced RequestBody) where parseJSON = referencedParseJSON "#/components/requestBodies/"

15461409instance FromJSON (Referenced Example) where parseJSON = referencedParseJSON "#/components/examples/"

15471410instance FromJSON (Referenced Header) where parseJSON = referencedParseJSON "#/components/headers/"

1548−instance FromJSON (Referenced Link) where parseJSON = referencedParseJSON "#/components/links/"

1549−instance FromJSON (Referenced Callback) where parseJSON = referencedParseJSON "#/components/callbacks/"

15501411

15511412instance FromJSON Xml where

15521413 parseJSON = genericParseJSON (jsonPrefix "xml")

15531414

1415+instance FromJSON ParamSchema where

1416+ parseJSON = sopSwaggerGenericParseJSON

1417+

15541418instance FromJSON AdditionalProperties where

15551419 parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b

15561420 parseJSON js = AdditionalPropertiesSchema <$> parseJSON js

15571421

1558−-- | All strings are parsed as expressions

1559−instance FromJSON ExpressionOrValue where

1560− parseJSON (String expr) = pure $ Expression expr

1561− parseJSON v = pure $ Value v

1562−

1563−instance FromJSON Callback where

1564− parseJSON = fmap Callback . parseJSON

1565−

15661422instance HasSwaggerAesonOptions Server where

15671423 swaggerAesonOptions _ = mkSwaggerAesonOptions "server"

15681424instance HasSwaggerAesonOptions Components where

@@ -1591,18 +1447,19 @@ instance HasSwaggerAesonOptions SecurityScheme where

15911447 swaggerAesonOptions _ = mkSwaggerAesonOptions "securityScheme" & saoSubObject ?~ "type"

15921448instance HasSwaggerAesonOptions Schema where

15931449 swaggerAesonOptions _ = mkSwaggerAesonOptions "schema" & saoSubObject ?~ "paramSchema"

1594−instance HasSwaggerAesonOptions OpenApi where

1450+instance HasSwaggerAesonOptions Swagger where

15951451 swaggerAesonOptions _ = mkSwaggerAesonOptions "swagger" & saoAdditionalPairs .~ [("openapi", "3.0.0")]

15961452instance HasSwaggerAesonOptions Example where

15971453 swaggerAesonOptions _ = mkSwaggerAesonOptions "example"

15981454instance HasSwaggerAesonOptions Encoding where

15991455 swaggerAesonOptions _ = mkSwaggerAesonOptions "encoding"

16001456

1601−instance HasSwaggerAesonOptions Link where

1602− swaggerAesonOptions _ = mkSwaggerAesonOptions "link"

1457+instance HasSwaggerAesonOptions ParamSchema where

1458+ swaggerAesonOptions _ = mkSwaggerAesonOptions "paramSchema"

16031459

16041460instance AesonDefaultValue Server

16051461instance AesonDefaultValue Components

1462+instance AesonDefaultValue ParamSchema

16061463instance AesonDefaultValue OAuth2ImplicitFlow

16071464instance AesonDefaultValue OAuth2PasswordFlow

16081465instance AesonDefaultValue OAuth2ClientCredentialsFlow

@@ -1610,10 +1467,7 @@ instance AesonDefaultValue OAuth2AuthorizationCodeFlow

16101467instance AesonDefaultValue p => AesonDefaultValue (OAuth2Flow p)

16111468instance AesonDefaultValue Responses

16121469instance AesonDefaultValue SecuritySchemeType

1613−instance AesonDefaultValue OpenApiType

1470+instance AesonDefaultValue SwaggerType

16141471instance AesonDefaultValue MimeList where defaultValue = Just mempty

16151472instance AesonDefaultValue Info

16161473instance AesonDefaultValue ParamLocation

1617−instance AesonDefaultValue Link

1618−instance AesonDefaultValue SecurityDefinitions where

1619− defaultValue = Just mempty

src/Data/OpenApi/Internal/AesonUtils.hs → src/Data/Swagger/Internal/AesonUtils.hsrenamed+13−12

@@ -5,7 +5,7 @@

55{-# LANGUAGE ExplicitForAll #-}

66{-# LANGUAGE TemplateHaskell #-}

77{-# LANGUAGE UndecidableSuperClasses #-}

8−module Data.OpenApi.Internal.AesonUtils (

8+module Data.Swagger.Internal.AesonUtils (

99 -- * Generic functions

1010 AesonDefaultValue(..),

1111 sopSwaggerGenericToJSON,

@@ -27,7 +27,7 @@ import Prelude.Compat

2727import Control.Applicative ((<|>))

2828import Control.Lens (makeLenses, (^.))

2929import Control.Monad (unless)

30−import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), Object, object, (.:), (.:?), (.!=), withObject, Encoding, pairs, (.=), Series)

30+import Data.Aeson (ToJSON(..), FromJSON(..), Value(..), Object, object, (.:), (.:?), (.!=), withObject)

3131import Data.Aeson.Types (Parser, Pair)

3232import Data.Char (toLower, isUpper)

3333import Data.Foldable (traverse_)

@@ -36,11 +36,12 @@ import Data.Text (Text)

3636import Generics.SOP

3737

3838import qualified Data.Text as T

39+import qualified Data.HashMap.Strict as HM

3940import qualified Data.Set as Set

4041import qualified Data.HashMap.Strict.InsOrd as InsOrd

4142import qualified Data.HashSet.InsOrd as InsOrdHS

4243

43−import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)

44+import Data.Aeson (Encoding, pairs, (.=), Series)

4445

4546-------------------------------------------------------------------------------

4647-- SwaggerAesonOptions

@@ -48,7 +49,7 @@ import Data.OpenApi.Aeson.Compat (keyToString, objectToList, stringToKey)

4849

4950data SwaggerAesonOptions = SwaggerAesonOptions

5051 { _saoPrefix :: String

51− , _saoAdditionalPairs :: [Pair]

52+ , _saoAdditionalPairs :: [(Text, Value)]

5253 , _saoSubObject :: Maybe String

5354 }

5455

@@ -155,14 +156,14 @@ sopSwaggerGenericToJSON'' (SwaggerAesonOptions prefix _ sub) = go

155156 go Nil Nil Nil = []

156157 go (I x :* xs) (FieldInfo name :* names) (def :* defs)

157158 | Just name' == sub = case json of

158− Object m -> objectToList m ++ rest

159+ Object m -> HM.toList m ++ rest

159160 Null -> rest

160161 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show json

161162 -- If default value: omit it.

162163 | Just x == def =

163164 rest

164165 | otherwise =

165− (stringToKey name', json) : rest

166+ (T.pack name', json) : rest

166167 where

167168 json = toJSON x

168169 name' = fieldNameModifier name

@@ -196,11 +197,11 @@ sopSwaggerGenericParseJSON = withObject "Swagger Record Object" $ \obj ->

196197 proxy = Proxy :: Proxy a

197198 opts = swaggerAesonOptions proxy

198199

199− parseAdditionalField :: Object -> Pair -> Parser ()

200+ parseAdditionalField :: Object -> (Text, Value) -> Parser ()

200201 parseAdditionalField obj (k, v) = do

201202 v' <- obj .: k

202203 unless (v == v') $ fail $

203− "Additonal field don't match for key " ++ keyToString k

204+ "Additonal field don't match for key " ++ T.unpack k

204205 ++ ": " ++ show v

205206 ++ " /= " ++ show v'

206207

@@ -231,8 +232,8 @@ sopSwaggerGenericParseJSON'' (SwaggerAesonOptions prefix _ sub) obj = go

231232 -- Note: we might strip fields of outer structure.

232233 cons <$> (withDef $ parseJSON $ Object obj) <*> rest

233234 | otherwise = case def of

234− Just def' -> cons <$> obj .:? stringToKey name' .!= def' <*> rest

235− Nothing -> cons <$> obj .: stringToKey name' <*> rest

235+ Just def' -> cons <$> obj .:? T.pack name' .!= def' <*> rest

236+ Nothing -> cons <$> obj .: T.pack name' <*> rest

236237 where

237238 cons h t = I h :* t

238239 name' = fieldNameModifier name

@@ -295,14 +296,14 @@ sopSwaggerGenericToEncoding'' (SwaggerAesonOptions prefix _ sub) = go

295296 go Nil Nil Nil = mempty

296297 go (I x :* xs) (FieldInfo name :* names) (def :* defs)

297298 | Just name' == sub = case toJSON x of

298− Object m -> pairsToSeries (objectToList m) <> rest

299+ Object m -> pairsToSeries (HM.toList m) <> rest

299300 Null -> rest

300301 _ -> error $ "sopSwaggerGenericToJSON: subjson is not an object: " ++ show (toJSON x)

301302 -- If default value: omit it.

302303 | Just x == def =

303304 rest

304305 | otherwise =

305− (stringToKey name' .= x) <> rest

306+ (T.pack name' .= x) <> rest

306307 where

307308 name' = fieldNameModifier name

308309 rest = go xs names defs

src/Data/OpenApi/Internal/ParamSchema.hs → src/Data/Swagger/Internal/ParamSchema.hsrenamed+52−76

@@ -15,7 +15,7 @@

1515{-# OPTIONS_GHC -Wno-redundant-constraints #-}

1616-- For TypeErrors

1717{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

18−module Data.OpenApi.Internal.ParamSchema where

18+module Data.Swagger.Internal.ParamSchema where

1919

2020import Control.Lens

2121import Data.Aeson (ToJSON (..))

@@ -41,40 +41,34 @@ import Data.Word

4141import Data.UUID.Types (UUID)

4242import Web.Cookie (SetCookie)

4343

44−import Data.OpenApi.Internal

45−import Data.OpenApi.Lens

46−import Data.OpenApi.SchemaOptions

44+import Data.Swagger.Internal

45+import Data.Swagger.Lens

46+import Data.Swagger.SchemaOptions

4747

4848import qualified Data.ByteString as BS

49−import qualified Data.ByteString.Lazy.Char8 as BSL

49+import qualified Data.ByteString.Lazy as BSL

5050import GHC.TypeLits (TypeError, ErrorMessage(..))

5151

5252-- | Default schema for binary data (any sequence of octets).

53−binarySchema :: Schema

54−binarySchema = mempty

55− & type_ ?~ OpenApiString

53+binaryParamSchema :: ParamSchema

54+binaryParamSchema = mempty

55+ & type_ ?~ SwaggerString

5656 & format ?~ "binary"

5757

5858-- | Default schema for binary data (base64 encoded).

59−byteSchema :: Schema

60−byteSchema = mempty

61− & type_ ?~ OpenApiString

59+byteParamSchema :: ParamSchema

60+byteParamSchema = mempty

61+ & type_ ?~ SwaggerString

6262 & format ?~ "byte"

6363

6464-- | Default schema for password string.

6565-- @"password"@ format is used to hint UIs the input needs to be obscured.

66−passwordSchema :: Schema

67−passwordSchema = mempty

68− & type_ ?~ OpenApiString

66+passwordParamSchema :: ParamSchema

67+passwordParamSchema = mempty

68+ & type_ ?~ SwaggerString

6969 & format ?~ "password"

7070

71−-- | Convert a type into a plain @'Schema'@.

72−--

73−-- In previous versions of the package there was a separate type called @ParamSchema@, which was

74−-- included in a greater 'Schema'. Now this is a single class, but distinction for schema generators

75−-- for "simple" types is preserved.

76−--

77−-- 'ToParamSchema' is suited only for primitive-like types without nested fields and such.

71+-- | Convert a type into a plain @'ParamSchema'@.

7872--

7973-- An example type and instance:

8074--

@@ -87,7 +81,7 @@ passwordSchema = mempty

8781--

8882-- instance ToParamSchema Direction where

8983-- toParamSchema _ = mempty

90−-- & type_ ?~ OpenApiString

84+-- & type_ ?~ SwaggerString

9185-- & enum_ ?~ [ \"Up\", \"Down\" ]

9286-- @

9387--

@@ -112,26 +106,24 @@ passwordSchema = mempty

112106class ToParamSchema a where

113107 -- | Convert a type into a plain parameter schema.

114108 --

115− -- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy Integer)

116− -- {

117− -- "type": "integer"

118− -- }

119− toParamSchema :: Proxy a -> Schema

120− default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> Schema

109+ -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)

110+ -- "{\"type\":\"integer\"}"

111+ toParamSchema :: Proxy a -> ParamSchema

112+ default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema

121113 toParamSchema = genericToParamSchema defaultSchemaOptions

122114

123115instance {-# OVERLAPPING #-} ToParamSchema String where

124− toParamSchema _ = mempty & type_ ?~ OpenApiString

116+ toParamSchema _ = mempty & type_ ?~ SwaggerString

125117

126118instance ToParamSchema Bool where

127− toParamSchema _ = mempty & type_ ?~ OpenApiBoolean

119+ toParamSchema _ = mempty & type_ ?~ SwaggerBoolean

128120

129121instance ToParamSchema Integer where

130− toParamSchema _ = mempty & type_ ?~ OpenApiInteger

122+ toParamSchema _ = mempty & type_ ?~ SwaggerInteger

131123

132124instance ToParamSchema Natural where

133125 toParamSchema _ = mempty

134− & type_ ?~ OpenApiInteger

126+ & type_ ?~ SwaggerInteger

135127 & minimum_ ?~ 0

136128 & exclusiveMinimum ?~ False

137129

@@ -157,45 +149,41 @@ instance ToParamSchema Word64 where

157149

158150-- | Default plain schema for @'Bounded'@, @'Integral'@ types.

159151--

160−-- >>> BSL.putStrLn $ encodePretty $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)

161−-- {

162−-- "maximum": 127,

163−-- "minimum": -128,

164−-- "type": "integer"

165−-- }

166−toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> Schema

152+-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)

153+-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"

154+toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema

167155toParamSchemaBoundedIntegral _ = mempty

168− & type_ ?~ OpenApiInteger

156+ & type_ ?~ SwaggerInteger

169157 & minimum_ ?~ fromInteger (toInteger (minBound :: a))

170158 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))

171159

172160instance ToParamSchema Char where

173161 toParamSchema _ = mempty

174− & type_ ?~ OpenApiString

162+ & type_ ?~ SwaggerString

175163 & maxLength ?~ 1

176164 & minLength ?~ 1

177165

178166instance ToParamSchema Scientific where

179− toParamSchema _ = mempty & type_ ?~ OpenApiNumber

167+ toParamSchema _ = mempty & type_ ?~ SwaggerNumber

180168

181169instance HasResolution a => ToParamSchema (Fixed a) where

182170 toParamSchema _ = mempty

183− & type_ ?~ OpenApiNumber

171+ & type_ ?~ SwaggerNumber

184172 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))

185173

186174instance ToParamSchema Double where

187175 toParamSchema _ = mempty

188− & type_ ?~ OpenApiNumber

176+ & type_ ?~ SwaggerNumber

189177 & format ?~ "double"

190178

191179instance ToParamSchema Float where

192180 toParamSchema _ = mempty

193− & type_ ?~ OpenApiNumber

181+ & type_ ?~ SwaggerNumber

194182 & format ?~ "float"

195183

196−timeParamSchema :: String -> Schema

184+timeParamSchema :: String -> ParamSchema

197185timeParamSchema fmt = mempty

198− & type_ ?~ OpenApiString

186+ & type_ ?~ SwaggerString

199187 & format ?~ T.pack fmt

200188

201189-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.

@@ -216,9 +204,9 @@ instance ToParamSchema LocalTime where

216204

217205-- |

218206-- >>> toParamSchema (Proxy :: Proxy ZonedTime) ^. format

219−-- Just "date-time"

207+-- Just "yyyy-mm-ddThh:MM:ss+hhMM"

220208instance ToParamSchema ZonedTime where

221− toParamSchema _ = timeParamSchema "date-time"

209+ toParamSchema _ = timeParamSchema "yyyy-mm-ddThh:MM:ss+hhMM"

222210

223211-- |

224212-- >>> toParamSchema (Proxy :: Proxy UTCTime) ^. format

@@ -237,12 +225,12 @@ instance ToParamSchema TL.Text where

237225

238226instance ToParamSchema Version where

239227 toParamSchema _ = mempty

240− & type_ ?~ OpenApiString

228+ & type_ ?~ SwaggerString

241229 & pattern ?~ "^\\d+(\\.\\d+)*$"

242230

243231instance ToParamSchema SetCookie where

244232 toParamSchema _ = mempty

245− & type_ ?~ OpenApiString

233+ & type_ ?~ SwaggerString

246234

247235type family ToParamSchemaByteStringError bs where

248236 ToParamSchemaByteStringError bs = TypeError

@@ -265,8 +253,8 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t

265253

266254instance ToParamSchema a => ToParamSchema [a] where

267255 toParamSchema _ = mempty

268− & type_ ?~ OpenApiArray

269− & items ?~ OpenApiItemsObject (Inline $ toParamSchema (Proxy :: Proxy a))

256+ & type_ ?~ SwaggerArray

257+ & items ?~ SwaggerItemsObject (Inline $ mempty & paramSchema .~ toParamSchema (Proxy :: Proxy a))

270258

271259instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])

272260instance ToParamSchema a => ToParamSchema (VP.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])

@@ -281,40 +269,29 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where

281269 toParamSchema _ = toParamSchema (Proxy :: Proxy (Set a))

282270

283271-- |

284−-- >>> BSL.putStrLn $ encodePretty $ toParamSchema (Proxy :: Proxy ())

285−-- {

286−-- "enum": [

287−-- "_"

288−-- ],

289−-- "type": "string"

290−-- }

272+-- >>> encode $ toParamSchema (Proxy :: Proxy ())

273+-- "{\"type\":\"string\",\"enum\":[\"_\"]}"

291274instance ToParamSchema () where

292275 toParamSchema _ = mempty

293− & type_ ?~ OpenApiString

276+ & type_ ?~ SwaggerString

294277 & enum_ ?~ ["_"]

295278

296279instance ToParamSchema UUID where

297280 toParamSchema _ = mempty

298− & type_ ?~ OpenApiString

281+ & type_ ?~ SwaggerString

299282 & format ?~ "uuid"

300283

301−-- | A configurable generic @'Schema'@ creator.

284+-- | A configurable generic @'ParamSchema'@ creator.

302285--

303286-- >>> :set -XDeriveGeneric

304287-- >>> data Color = Red | Blue deriving Generic

305−-- >>> BSL.putStrLn $ encodePretty $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)

306−-- {

307−-- "enum": [

308−-- "Red",

309−-- "Blue"

310−-- ],

311−-- "type": "string"

312−-- }

313−genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> Schema

288+-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)

289+-- "{\"type\":\"string\",\"enum\":[\"Red\",\"Blue\"]}"

290+genericToParamSchema :: forall a t. (Generic a, GToParamSchema (Rep a)) => SchemaOptions -> Proxy a -> ParamSchema

314291genericToParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy (Rep a)) mempty

315292

316293class GToParamSchema (f :: * -> *) where

317− gtoParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema

294+ gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema -> ParamSchema

318295

319296instance GToParamSchema f => GToParamSchema (D1 d f) where

320297 gtoParamSchema opts _ = gtoParamSchema opts (Proxy :: Proxy f)

@@ -332,14 +309,14 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GToParamSchema (f :+: g) wh

332309 gtoParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy (f :+: g))

333310

334311class GEnumParamSchema (f :: * -> *) where

335− genumParamSchema :: SchemaOptions -> Proxy f -> Schema -> Schema

312+ genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema -> ParamSchema

336313

337314instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g) where

338315 genumParamSchema opts _ = genumParamSchema opts (Proxy :: Proxy f) . genumParamSchema opts (Proxy :: Proxy g)

339316

340317instance Constructor c => GEnumParamSchema (C1 c U1) where

341318 genumParamSchema opts _ s = s

342− & type_ ?~ OpenApiString

319+ & type_ ?~ SwaggerString

343320 & enum_ %~ addEnumValue tag

344321 where

345322 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))

@@ -351,4 +328,3 @@ data Proxy3 a b c = Proxy3

351328

352329-- $setup

353330-- >>> import Data.Aeson (encode)

354−-- >>> import Data.OpenApi.Internal.Utils

src/Data/OpenApi/Internal/Schema.hs → src/Data/Swagger/Internal/Schema.hsrenamed+140−383

@@ -1,17 +1,15 @@

1−{-# LANGUAGE CPP #-}

21{-# LANGUAGE ConstraintKinds #-}

3−{-# LANGUAGE DataKinds #-}

42{-# LANGUAGE DefaultSignatures #-}

53{-# LANGUAGE FlexibleContexts #-}

64{-# LANGUAGE FlexibleInstances #-}

75{-# LANGUAGE KindSignatures #-}

6+{-# LANGUAGE DataKinds #-}

87{-# LANGUAGE OverloadedLists #-}

98{-# LANGUAGE OverloadedStrings #-}

109{-# LANGUAGE PackageImports #-}

1110{-# LANGUAGE PolyKinds #-}

1211{-# LANGUAGE ScopedTypeVariables #-}

1312{-# LANGUAGE TupleSections #-}

14−{-# LANGUAGE TypeApplications #-}

1513{-# LANGUAGE TypeFamilies #-}

1614{-# LANGUAGE TypeOperators #-}

1715{-# LANGUAGE TypeSynonymInstances #-}

@@ -19,7 +17,7 @@

1917{-# OPTIONS_GHC -Wno-redundant-constraints #-}

2018-- For TypeErrors

2119{-# OPTIONS_GHC -Wno-unticked-promoted-constructors #-}

22−module Data.OpenApi.Internal.Schema where

20+module Data.Swagger.Internal.Schema where

2321

2422import Prelude ()

2523import Prelude.Compat

@@ -42,7 +40,6 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

4240import Data.Int

4341import Data.IntSet (IntSet)

4442import Data.IntMap (IntMap)

45−import Data.List (sort)

4643import Data.List.NonEmpty.Compat (NonEmpty)

4744import Data.Map (Map)

4845import Data.Maybe (fromMaybe)

@@ -62,16 +59,14 @@ import Numeric.Natural.Compat (Natural)

6259import Data.Word

6360import GHC.Generics

6461import qualified Data.UUID.Types as UUID

65−import Type.Reflection (Typeable, typeRep)

6662

67−import Data.OpenApi.Aeson.Compat (keyToText, objectKeys, toInsOrdHashMap)

68−import Data.OpenApi.Declare

69−import Data.OpenApi.Internal

70−import Data.OpenApi.Internal.ParamSchema (ToParamSchema (..))

71−import Data.OpenApi.Internal.TypeShape

72−import Data.OpenApi.Lens hiding (name, schema)

73−import qualified Data.OpenApi.Lens as Swagger

74−import Data.OpenApi.SchemaOptions

63+import Data.Swagger.Declare

64+import Data.Swagger.Internal

65+import Data.Swagger.Internal.ParamSchema (ToParamSchema(..))

66+import Data.Swagger.Lens hiding (name, schema)

67+import qualified Data.Swagger.Lens as Swagger

68+import Data.Swagger.SchemaOptions

69+import Data.Swagger.Internal.TypeShape

7570

7671import qualified Data.ByteString as BS

7772import qualified Data.ByteString.Lazy.Char8 as BSL

@@ -102,7 +97,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema

10297--

10398-- import Control.Lens

10499-- import Data.Proxy

105−-- import Data.OpenApi

100+-- import Data.Swagger

106101--

107102-- data Coord = Coord { x :: Double, y :: Double }

108103--

@@ -110,7 +105,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema

110105-- declareNamedSchema _ = do

111106-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)

112107-- return $ NamedSchema (Just \"Coord\") $ mempty

113−-- & type_ ?~ OpenApiObject

108+-- & type_ ?~ SwaggerObject

114109-- & properties .~

115110-- [ (\"x\", doubleSchema)

116111-- , (\"y\", doubleSchema)

@@ -136,7 +131,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema

136131--

137132-- instance ToSchema Coord

138133-- @

139−class Typeable a => ToSchema a where

134+class ToSchema a where

140135 -- | Convert a type into an optionally named schema

141136 -- together with all used definitions.

142137 -- Note that the schema itself is included in definitions

@@ -158,19 +153,13 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema

158153--

159154-- >>> toNamedSchema (Proxy :: Proxy String) ^. name

160155-- Nothing

161−-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy String) ^. schema)

162−-- {

163−-- "type": "string"

164−-- }

156+-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy String) ^. schema)

157+-- {"type":"string"}

165158--

166159-- >>> toNamedSchema (Proxy :: Proxy Day) ^. name

167160-- Just "Day"

168−-- >>> BSL.putStrLn $ encodePretty (toNamedSchema (Proxy :: Proxy Day) ^. schema)

169−-- {

170−-- "example": "2016-07-22",

171−-- "format": "date",

172−-- "type": "string"

173−-- }

161+-- >>> BSL.putStrLn $ encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)

162+-- {"example":"2016-07-22","format":"date","type":"string"}

174163toNamedSchema :: ToSchema a => Proxy a -> NamedSchema

175164toNamedSchema = undeclare . declareNamedSchema

176165

@@ -186,35 +175,22 @@ schemaName = _namedSchemaName . toNamedSchema

186175

187176-- | Convert a type into a schema.

188177--

189−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy Int8)

190−-- {

191−-- "maximum": 127,

192−-- "minimum": -128,

193−-- "type": "integer"

194−-- }

178+-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy Int8)

179+-- {"maximum":127,"minimum":-128,"type":"integer"}

195180--

196−-- >>> BSL.putStrLn $ encodePretty $ toSchema (Proxy :: Proxy [Day])

197−-- {

198−-- "items": {

199−-- "$ref": "#/components/schemas/Day"

200−-- },

201−-- "type": "array"

202−-- }

181+-- >>> BSL.putStrLn $ encode $ toSchema (Proxy :: Proxy [Day])

182+-- {"items":{"$ref":"#/components/schemas/Day"},"type":"array"}

203183toSchema :: ToSchema a => Proxy a -> Schema

204184toSchema = _namedSchemaSchema . toNamedSchema

205185

206186-- | Convert a type into a referenced schema if possible.

207187-- Only named schemas can be referenced, nameless schemas are inlined.

208188--

209−-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Integer)

210−-- {

211−-- "type": "integer"

212−-- }

189+-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Integer)

190+-- {"type":"integer"}

213191--

214−-- >>> BSL.putStrLn $ encodePretty $ toSchemaRef (Proxy :: Proxy Day)

215−-- {

216−-- "$ref": "#/components/schemas/Day"

217−-- }

192+-- >>> BSL.putStrLn $ encode $ toSchemaRef (Proxy :: Proxy Day)

193+-- {"$ref":"#/components/schemas/Day"}

218194toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema

219195toSchemaRef = undeclare . declareSchemaRef

220196

@@ -282,15 +258,8 @@ inlineAllSchemas = inlineSchemasWhen (const True)

282258

283259-- | Convert a type into a schema without references.

284260--

285−-- >>> BSL.putStrLn $ encodePretty $ toInlinedSchema (Proxy :: Proxy [Day])

286−-- {

287−-- "items": {

288−-- "example": "2016-07-22",

289−-- "format": "date",

290−-- "type": "string"

291−-- },

292−-- "type": "array"

293−-- }

261+-- >>> BSL.putStrLn $ encode $ toInlinedSchema (Proxy :: Proxy [Day])

262+-- {"items":{"example":"2016-07-22","format":"date","type":"string"},"type":"array"}

294263--

295264-- __WARNING:__ @'toInlinedSchema'@ will produce infinite schema

296265-- when inlining recursive schemas.

@@ -320,67 +289,41 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs

320289 traverse_ usedNames (InsOrdHashMap.lookup name defs)

321290 Inline subschema -> usedNames subschema

322291

292+-- | Default schema for binary data (any sequence of octets).

293+binarySchema :: Schema

294+binarySchema = mempty

295+ & type_ ?~ SwaggerString

296+ & format ?~ "binary"

297+

298+-- | Default schema for binary data (base64 encoded).

299+byteSchema :: Schema

300+byteSchema = mempty

301+ & type_ ?~ SwaggerString

302+ & format ?~ "byte"

303+

304+-- | Default schema for password string.

305+-- @"password"@ format is used to hint UIs the input needs to be obscured.

306+passwordSchema :: Schema

307+passwordSchema = mempty

308+ & type_ ?~ SwaggerString

309+ & format ?~ "password"

310+

323311-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.

324312-- Produced schema can be used for further refinement.

325313--

326−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema "hello"

327−-- {

328−-- "example": "hello",

329−-- "type": "string"

330−-- }

314+-- >>> BSL.putStrLn $ encode $ sketchSchema "hello"

315+-- {"example":"hello","type":"string"}

331316--

332−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (1, 2, 3)

333−-- {

334−-- "example": [

335−-- 1,

336−-- 2,

337−-- 3

338−-- ],

339−-- "items": {

340−-- "type": "number"

341−-- },

342−-- "type": "array"

343−-- }

317+-- >>> BSL.putStrLn $ encode $ sketchSchema (1, 2, 3)

318+-- {"example":[1,2,3],"items":{"type":"number"},"type":"array"}

344319--

345−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema ("Jack", 25)

346−-- {

347−-- "example": [

348−-- "Jack",

349−-- 25

350−-- ],

351−-- "items": [

352−-- {

353−-- "type": "string"

354−-- },

355−-- {

356−-- "type": "number"

357−-- }

358−-- ],

359−-- "type": "array"

360−-- }

320+-- >>> BSL.putStrLn $ encode $ sketchSchema ("Jack", 25)

321+-- {"example":["Jack",25],"items":[{"type":"string"},{"type":"number"}],"type":"array"}

361322--

362323-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)

363324-- >>> instance ToJSON Person

364−-- >>> BSL.putStrLn $ encodePretty $ sketchSchema (Person "Jack" 25)

365−-- {

366−-- "example": {

367−-- "age": 25,

368−-- "name": "Jack"

369−-- },

370−-- "properties": {

371−-- "age": {

372−-- "type": "number"

373−-- },

374−-- "name": {

375−-- "type": "string"

376−-- }

377−-- },

378−-- "required": [

379−-- "age",

380−-- "name"

381−-- ],

382−-- "type": "object"

383−-- }

325+-- >>> BSL.putStrLn $ encode $ sketchSchema (Person "Jack" 25)

326+-- {"required":["age","name"],"properties":{"age":{"type":"number"},"name":{"type":"string"}},"example":{"age":25,"name":"Jack"},"type":"object"}

384327sketchSchema :: ToJSON a => a -> Schema

385328sketchSchema = sketch . toJSON

386329 where

@@ -388,15 +331,15 @@ sketchSchema = sketch . toJSON

388331 sketch js@(Bool _) = go js

389332 sketch js = go js & example ?~ js

390333

391− go Null = mempty & type_ ?~ OpenApiNull

392− go (Bool _) = mempty & type_ ?~ OpenApiBoolean

393− go (String _) = mempty & type_ ?~ OpenApiString

394− go (Number _) = mempty & type_ ?~ OpenApiNumber

334+ go Null = mempty & type_ ?~ SwaggerNull

335+ go (Bool _) = mempty & type_ ?~ SwaggerBoolean

336+ go (String _) = mempty & type_ ?~ SwaggerString

337+ go (Number _) = mempty & type_ ?~ SwaggerNumber

395338 go (Array xs) = mempty

396− & type_ ?~ OpenApiArray

339+ & type_ ?~ SwaggerArray

397340 & items ?~ case ischema of

398− Just s -> OpenApiItemsObject (Inline s)

399− _ -> OpenApiItemsArray (map Inline ys)

341+ Just s -> SwaggerItemsObject (Inline s)

342+ _ -> SwaggerItemsArray (map Inline ys)

400343 where

401344 ys = map go (V.toList xs)

402345 allSame = and ((zipWith (==)) ys (tail ys))

@@ -405,178 +348,64 @@ sketchSchema = sketch . toJSON

405348 (z:_) | allSame -> Just z

406349 _ -> Nothing

407350 go (Object o) = mempty

408− & type_ ?~ OpenApiObject

409− & required .~ sort (objectKeys o)

410− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)

351+ & type_ ?~ SwaggerObject

352+ & required .~ HashMap.keys o

353+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)

411354

412355-- | Make a restrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.

413356-- Produced schema uses as much constraints as possible.

414357--

415−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema "hello"

416−-- {

417−-- "enum": [

418−-- "hello"

419−-- ],

420−-- "maxLength": 5,

421−-- "minLength": 5,

422−-- "pattern": "hello",

423−-- "type": "string"

424−-- }

358+-- >>> BSL.putStrLn $ encode $ sketchStrictSchema "hello"

359+-- {"maxLength":5,"pattern":"hello","minLength":5,"type":"string","enum":["hello"]}

425360--

426−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (1, 2, 3)

427−-- {

428−-- "enum": [

429−-- [

430−-- 1,

431−-- 2,

432−-- 3

433−-- ]

434−-- ],

435−-- "items": [

436−-- {

437−-- "enum": [

438−-- 1

439−-- ],

440−-- "maximum": 1,

441−-- "minimum": 1,

442−-- "multipleOf": 1,

443−-- "type": "number"

444−-- },

445−-- {

446−-- "enum": [

447−-- 2

448−-- ],

449−-- "maximum": 2,

450−-- "minimum": 2,

451−-- "multipleOf": 2,

452−-- "type": "number"

453−-- },

454−-- {

455−-- "enum": [

456−-- 3

457−-- ],

458−-- "maximum": 3,

459−-- "minimum": 3,

460−-- "multipleOf": 3,

461−-- "type": "number"

462−-- }

463−-- ],

464−-- "maxItems": 3,

465−-- "minItems": 3,

466−-- "type": "array",

467−-- "uniqueItems": true

468−-- }

361+-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (1, 2, 3)

362+-- {"minItems":3,"uniqueItems":true,"items":[{"maximum":1,"minimum":1,"multipleOf":1,"type":"number","enum":[1]},{"maximum":2,"minimum":2,"multipleOf":2,"type":"number","enum":[2]},{"maximum":3,"minimum":3,"multipleOf":3,"type":"number","enum":[3]}],"maxItems":3,"type":"array","enum":[[1,2,3]]}

469363--

470−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema ("Jack", 25)

471−-- {

472−-- "enum": [

473−-- [

474−-- "Jack",

475−-- 25

476−-- ]

477−-- ],

478−-- "items": [

479−-- {

480−-- "enum": [

481−-- "Jack"

482−-- ],

483−-- "maxLength": 4,

484−-- "minLength": 4,

485−-- "pattern": "Jack",

486−-- "type": "string"

487−-- },

488−-- {

489−-- "enum": [

490−-- 25

491−-- ],

492−-- "maximum": 25,

493−-- "minimum": 25,

494−-- "multipleOf": 25,

495−-- "type": "number"

496−-- }

497−-- ],

498−-- "maxItems": 2,

499−-- "minItems": 2,

500−-- "type": "array",

501−-- "uniqueItems": true

502−-- }

364+-- >>> BSL.putStrLn $ encode $ sketchStrictSchema ("Jack", 25)

365+-- {"minItems":2,"uniqueItems":true,"items":[{"maxLength":4,"pattern":"Jack","minLength":4,"type":"string","enum":["Jack"]},{"maximum":25,"minimum":25,"multipleOf":25,"type":"number","enum":[25]}],"maxItems":2,"type":"array","enum":[["Jack",25]]}

503366--

504367-- >>> data Person = Person { name :: String, age :: Int } deriving (Generic)

505368-- >>> instance ToJSON Person

506−-- >>> BSL.putStrLn $ encodePretty $ sketchStrictSchema (Person "Jack" 25)

507−-- {

508−-- "enum": [

509−-- {

510−-- "age": 25,

511−-- "name": "Jack"

512−-- }

513−-- ],

514−-- "maxProperties": 2,

515−-- "minProperties": 2,

516−-- "properties": {

517−-- "age": {

518−-- "enum": [

519−-- 25

520−-- ],

521−-- "maximum": 25,

522−-- "minimum": 25,

523−-- "multipleOf": 25,

524−-- "type": "number"

525−-- },

526−-- "name": {

527−-- "enum": [

528−-- "Jack"

529−-- ],

530−-- "maxLength": 4,

531−-- "minLength": 4,

532−-- "pattern": "Jack",

533−-- "type": "string"

534−-- }

535−-- },

536−-- "required": [

537−-- "age",

538−-- "name"

539−-- ],

540−-- "type": "object"

541−-- }

369+-- >>> BSL.putStrLn $ encode $ sketchStrictSchema (Person "Jack" 25)

370+-- {"required":["age","name"],"properties":{"age":{"maximum":25,"minimum":25,"multipleOf":25,"type":"number","enum":[25]},"name":{"maxLength":4,"pattern":"Jack","minLength":4,"type":"string","enum":["Jack"]}},"maxProperties":2,"minProperties":2,"type":"object","enum":[{"age":25,"name":"Jack"}]}

542371sketchStrictSchema :: ToJSON a => a -> Schema

543372sketchStrictSchema = go . toJSON

544373 where

545− go Null = mempty & type_ ?~ OpenApiNull

374+ go Null = mempty & type_ ?~ SwaggerNull

546375 go js@(Bool _) = mempty

547− & type_ ?~ OpenApiBoolean

376+ & type_ ?~ SwaggerBoolean

548377 & enum_ ?~ [js]

549378 go js@(String s) = mempty

550− & type_ ?~ OpenApiString

379+ & type_ ?~ SwaggerString

551380 & maxLength ?~ fromIntegral (T.length s)

552381 & minLength ?~ fromIntegral (T.length s)

553382 & pattern ?~ s

554383 & enum_ ?~ [js]

555384 go js@(Number n) = mempty

556− & type_ ?~ OpenApiNumber

385+ & type_ ?~ SwaggerNumber

557386 & maximum_ ?~ n

558387 & minimum_ ?~ n

559388 & multipleOf ?~ n

560389 & enum_ ?~ [js]

561390 go js@(Array xs) = mempty

562− & type_ ?~ OpenApiArray

391+ & type_ ?~ SwaggerArray

563392 & maxItems ?~ fromIntegral sz

564393 & minItems ?~ fromIntegral sz

565− & items ?~ OpenApiItemsArray (map (Inline . go) (V.toList xs))

394+ & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))

566395 & uniqueItems ?~ allUnique

567396 & enum_ ?~ [js]

568397 where

569398 sz = length xs

570399 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))

571400 go js@(Object o) = mempty

572− & type_ ?~ OpenApiObject

573− & required .~ sort names

574− & properties .~ fmap (Inline . go) (toInsOrdHashMap o)

401+ & type_ ?~ SwaggerObject

402+ & required .~ names

403+ & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)

575404 & maxProperties ?~ fromIntegral (length names)

576405 & minProperties ?~ fromIntegral (length names)

577406 & enum_ ?~ [js]

578407 where

579− names = objectKeys o

408+ names = HashMap.keys o

580409

581410class GToSchema (f :: * -> *) where

582411 gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema

@@ -585,8 +414,8 @@ instance {-# OVERLAPPABLE #-} ToSchema a => ToSchema [a] where

585414 declareNamedSchema _ = do

586415 ref <- declareSchemaRef (Proxy :: Proxy a)

587416 return $ unnamed $ mempty

588− & type_ ?~ OpenApiArray

589− & items ?~ OpenApiItemsObject ref

417+ & type_ ?~ SwaggerArray

418+ & items ?~ SwaggerItemsObject ref

590419

591420instance {-# OVERLAPPING #-} ToSchema String where declareNamedSchema = plain . paramSchemaToSchema

592421instance ToSchema Bool where declareNamedSchema = plain . paramSchemaToSchema

@@ -611,7 +440,7 @@ instance ToSchema Scientific where declareNamedSchema = plain . paramSchemaToSc

611440instance ToSchema Double where declareNamedSchema = plain . paramSchemaToSchema

612441instance ToSchema Float where declareNamedSchema = plain . paramSchemaToSchema

613442

614−instance (Typeable (Fixed a), HasResolution a) => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema

443+instance HasResolution a => ToSchema (Fixed a) where declareNamedSchema = plain . paramSchemaToSchema

615444

616445instance ToSchema a => ToSchema (Maybe a) where

617446 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy a)

@@ -628,22 +457,16 @@ instance ToSchema UUID.UUID where

628457 declareNamedSchema p = pure $ named "UUID" $ paramSchemaToSchema p

629458 & example ?~ toJSON (UUID.toText UUID.nil)

630459

631−instance (ToSchema a, ToSchema b) => ToSchema (a, b) where

632− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions

633−instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c) where

634− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions

635−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d) where

636− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions

637−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e) where

638− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions

639−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f) where

640− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions

641−instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g) where

642− declareNamedSchema = fmap unname . genericDeclareNamedSchema defaultSchemaOptions

460+instance (ToSchema a, ToSchema b) => ToSchema (a, b)

461+instance (ToSchema a, ToSchema b, ToSchema c) => ToSchema (a, b, c)

462+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d) => ToSchema (a, b, c, d)

463+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e) => ToSchema (a, b, c, d, e)

464+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f) => ToSchema (a, b, c, d, e, f)

465+instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f, ToSchema g) => ToSchema (a, b, c, d, e, f, g)

643466

644467timeSchema :: T.Text -> Schema

645468timeSchema fmt = mempty

646− & type_ ?~ OpenApiString

469+ & type_ ?~ SwaggerString

647470 & format ?~ fmt

648471

649472-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.

@@ -658,7 +481,7 @@ instance ToSchema LocalTime where

658481 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"

659482 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))

660483

661−-- | Format @"date-time"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.

484+-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.

662485instance ToSchema ZonedTime where

663486 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"

664487 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))

@@ -690,7 +513,7 @@ instance ToSchemaByteStringError BSL.ByteString => ToSchema BSL.ByteString where

690513instance ToSchema IntSet where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Set Int))

691514

692515-- | NOTE: This schema does not account for the uniqueness of keys.

693−instance (ToSchema a) => ToSchema (IntMap a) where

516+instance ToSchema a => ToSchema (IntMap a) where

694517 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [(Int, a)])

695518

696519instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where

@@ -701,7 +524,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where

701524 declareObjectMapSchema = do

702525 schema <- declareSchemaRef (Proxy :: Proxy v)

703526 return $ unnamed $ mempty

704− & type_ ?~ OpenApiObject

527+ & type_ ?~ SwaggerObject

705528 & additionalProperties ?~ AdditionalPropertiesSchema schema

706529

707530instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where

@@ -709,7 +532,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where

709532

710533instance {-# OVERLAPPING #-} ToSchema Object where

711534 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty

712− & type_ ?~ OpenApiObject

535+ & type_ ?~ SwaggerObject

713536 & description ?~ "Arbitrary JSON object."

714537 & additionalProperties ?~ AdditionalPropertiesAllowed True

715538

@@ -746,15 +569,11 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar

746569

747570-- | Default schema for @'Bounded'@, @'Integral'@ types.

748571--

749−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)

750−-- {

751−-- "maximum": 32767,

752−-- "minimum": -32768,

753−-- "type": "integer"

754−-- }

572+-- >>> BSL.putStrLn $ encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)

573+-- {"maximum":32767,"minimum":-32768,"type":"integer"}

755574toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema

756575toSchemaBoundedIntegral _ = mempty

757− & type_ ?~ OpenApiInteger

576+ & type_ ?~ SwaggerInteger

758577 & minimum_ ?~ fromInteger (toInteger (minBound :: a))

759578 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))

760579

@@ -783,27 +602,8 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>

783602-- >>> instance ToSchema ButtonState

784603-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)

785604-- >>> type ImageUrl = T.Text

786−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))

787−-- {

788−-- "properties": {

789−-- "Active": {

790−-- "type": "string"

791−-- },

792−-- "Disabled": {

793−-- "type": "string"

794−-- },

795−-- "Focus": {

796−-- "type": "string"

797−-- },

798−-- "Hover": {

799−-- "type": "string"

800−-- },

801−-- "Neutral": {

802−-- "type": "string"

803−-- }

804−-- },

805−-- "type": "object"

806−-- }

605+-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))

606+-- {"properties":{"Neutral":{"type":"string"},"Focus":{"type":"string"},"Active":{"type":"string"},"Hover":{"type":"string"},"Disabled":{"type":"string"}},"type":"object"}

807607--

808608-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.

809609-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.

@@ -811,15 +611,15 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.

811611 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)

812612 => Proxy (map key value) -> Declare (Definitions Schema) Schema

813613declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of

814− ToJSONKeyText getKey _ -> objectSchema getKey

614+ ToJSONKeyText keyToText _ -> objectSchema keyToText

815615 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])

816616 where

817− objectSchema getKey = do

617+ objectSchema keyToText = do

818618 valueRef <- declareSchemaRef (Proxy :: Proxy value)

819619 let allKeys = [minBound..maxBound :: key]

820− mkPair k = (keyToText $ getKey k, valueRef)

620+ mkPair k = (keyToText k, valueRef)

821621 return $ mempty

822− & type_ ?~ OpenApiObject

622+ & type_ ?~ SwaggerObject

823623 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)

824624

825625-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.

@@ -830,27 +630,8 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o

830630-- >>> instance ToSchema ButtonState

831631-- >>> instance ToJSONKey ButtonState where toJSONKey = toJSONKeyText (T.pack . show)

832632-- >>> type ImageUrl = T.Text

833−-- >>> BSL.putStrLn $ encodePretty $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))

834−-- {

835−-- "properties": {

836−-- "Active": {

837−-- "type": "string"

838−-- },

839−-- "Disabled": {

840−-- "type": "string"

841−-- },

842−-- "Focus": {

843−-- "type": "string"

844−-- },

845−-- "Hover": {

846−-- "type": "string"

847−-- },

848−-- "Neutral": {

849−-- "type": "string"

850−-- }

851−-- },

852−-- "type": "object"

853−-- }

633+-- >>> BSL.putStrLn $ encode $ toSchemaBoundedEnumKeyMapping (Proxy :: Proxy (Map ButtonState ImageUrl))

634+-- {"properties":{"Neutral":{"type":"string"},"Focus":{"type":"string"},"Active":{"type":"string"},"Hover":{"type":"string"},"Disabled":{"type":"string"}},"type":"object"}

854635--

855636-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.

856637-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.

@@ -860,7 +641,7 @@ toSchemaBoundedEnumKeyMapping :: forall map key value.

860641toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping

861642

862643-- | A configurable generic @'Schema'@ creator.

863−genericDeclareSchema :: (Generic a, GToSchema (Rep a), Typeable a) =>

644+genericDeclareSchema :: (Generic a, GToSchema (Rep a)) =>

864645 SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema

865646genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchema opts proxy

866647

@@ -868,24 +649,9 @@ genericDeclareSchema opts proxy = _namedSchemaSchema <$> genericDeclareNamedSche

868649-- This function applied to @'defaultSchemaOptions'@

869650-- is used as the default for @'declareNamedSchema'@

870651-- 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) =>

652+genericDeclareNamedSchema :: forall a. (Generic a, GToSchema (Rep a)) =>

880653 SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema

881−genericDeclareNamedSchema opts _ =

882− rename (Just $ T.pack name) <$> gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty

883− where

884− unspace ' ' = '_'

885− unspace x = x

886− orig = fmap unspace $ show $ typeRep @a

887− name = datatypeNameModifier opts orig

888−

654+genericDeclareNamedSchema opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty

889655

890656-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.

891657genericNameSchema :: forall a d f.

@@ -901,19 +667,19 @@ gdatatypeSchemaName opts _ = case orig of

901667 orig = datatypeName (Proxy3 :: Proxy3 d f a)

902668 name = datatypeNameModifier opts orig

903669

904−-- | Construct 'NamedSchema' usinng 'ToParamSchema'.

670+-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.

905671paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>

906672 SchemaOptions -> Proxy a -> NamedSchema

907673paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)

908674

909−-- | Construct 'Schema' usinng 'ToParamSchema'.

675+-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.

910676paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema

911−paramSchemaToSchema = toParamSchema

677+paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy

912678

913679nullarySchema :: Schema

914680nullarySchema = mempty

915− & type_ ?~ OpenApiArray

916− & items ?~ OpenApiItemsArray []

681+ & type_ ?~ SwaggerArray

682+ & items ?~ SwaggerItemsArray []

917683

918684gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema

919685gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty

@@ -943,15 +709,12 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s

943709 | unwrapUnaryRecords opts = fieldSchema

944710 | otherwise =

945711 case schema ^. items of

946− Just (OpenApiItemsArray [_]) -> fieldSchema

712+ Just (SwaggerItemsArray [_]) -> fieldSchema

947713 _ -> do

948− -- We have to run recordSchema instead of just using its defs,

949− -- since those can be recursive and will lead to infinite loop,

950− -- see https://github.com/biocad/openapi3/pull/37

951− NamedSchema _ schema' <- recordSchema

952− return (unnamed schema')

714+ declare defs

715+ return (unnamed schema)

953716 where

954− (_, NamedSchema _ schema) = runDeclare recordSchema mempty

717+ (defs, NamedSchema _ schema) = runDeclare recordSchema mempty

955718 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s

956719 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s

957720

@@ -974,10 +737,10 @@ gdeclareSchemaRef opts proxy = do

974737 return $ Ref (Reference name)

975738 _ -> Inline <$> gdeclareSchema opts proxy

976739

977−appendItem :: Referenced Schema -> Maybe OpenApiItems -> Maybe OpenApiItems

978−appendItem x Nothing = Just (OpenApiItemsArray [x])

979−appendItem x (Just (OpenApiItemsArray xs)) = Just (OpenApiItemsArray (xs ++ [x]))

980−appendItem _ _ = error "GToSchema.appendItem: cannot append to OpenApiItemsObject"

740+appendItem :: Referenced Schema -> Maybe SwaggerItems -> Maybe SwaggerItems

741+appendItem x Nothing = Just (SwaggerItemsArray [x])

742+appendItem x (Just (SwaggerItemsArray xs)) = Just (SwaggerItemsArray (xs ++ [x]))

743+appendItem _ _ = error "GToSchema.appendItem: cannot append to SwaggerItemsObject"

981744

982745withFieldSchema :: forall proxy s f. (Selector s, GToSchema f) =>

983746 SchemaOptions -> proxy s f -> Bool -> Schema -> Declare (Definitions Schema) Schema

@@ -986,12 +749,12 @@ withFieldSchema opts _ isRequiredField schema = do

986749 return $

987750 if T.null fname

988751 then schema

989− & type_ ?~ OpenApiArray

752+ & type_ ?~ SwaggerArray

990753 & items %~ appendItem ref

991754 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems

992755 & minItems %~ Just . maybe 1 (+1) -- increment minItems

993756 else schema

994− & type_ ?~ OpenApiObject

757+ & type_ ?~ SwaggerObject

995758 & properties . at fname ?~ ref

996759 & if isRequiredField

997760 then required %~ (++ [fname])

@@ -1026,14 +789,14 @@ gdeclareNamedSumSchema opts proxy _

1026789 | otherwise = do

1027790 (schemas, _) <- runWriterT declareSumSchema

1028791 return $ unnamed $ mempty

1029− & type_ ?~ OpenApiObject

792+ & type_ ?~ SwaggerObject

1030793 & oneOf ?~ (snd <$> schemas)

1031794 where

1032795 declareSumSchema = gsumToSchema opts proxy

1033796 (sumSchemas, All allNullary) = undeclare (runWriterT declareSumSchema)

1034797

1035798 toStringTag schemas = mempty

1036− & type_ ?~ OpenApiString

799+ & type_ ?~ SwaggerString

1037800 & enum_ ?~ map (String . fst) sumSchemas

1038801

1039802type AllNullary = All

@@ -1055,15 +818,15 @@ gsumConToSchemaWith ref opts _ = (tag, schema)

1055818 case ref of

1056819 -- If subschema is an object and constructor is a record, we add tag directly

1057820 -- to the record, as Aeson does it.

1058− Just (Inline sub) | sub ^. type_ == Just OpenApiObject && isRecord -> Inline $ sub

821+ Just (Inline sub) | sub ^. type_ == Just SwaggerObject && isRecord -> Inline $ sub

1059822 & required <>~ [T.pack tagField]

1060− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])

823+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])

1061824

1062825 -- If it is not a record, we need to put subschema into "contents" field.

1063826 _ | not isRecord -> Inline $ mempty

1064− & type_ ?~ OpenApiObject

827+ & type_ ?~ SwaggerObject

1065828 & required .~ [T.pack tagField]

1066− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])

829+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])

1067830 -- If constructor is nullary, there is no content.

1068831 & case ref of

1069832 Just r -> (properties . at (T.pack contentsField) ?~ r) . (required <>~ [T.pack contentsField])

@@ -1071,17 +834,17 @@ gsumConToSchemaWith ref opts _ = (tag, schema)

1071834

1072835 -- In the remaining cases we combine "tag" object and "contents" object using allOf.

1073836 _ -> Inline $ mempty

1074− & type_ ?~ OpenApiObject

837+ & type_ ?~ SwaggerObject

1075838 & allOf ?~ [Inline $ mempty

1076− & type_ ?~ OpenApiObject

839+ & type_ ?~ SwaggerObject

1077840 & required .~ (T.pack tagField : if isRecord then [] else [T.pack contentsField])

1078− & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag])]

841+ & properties . at (T.pack tagField) ?~ (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag])]

1079842 & if isRecord

1080843 then allOf . _Just <>~ [refOrNullary]

1081− else allOf . _Just <>~ [Inline $ mempty & type_ ?~ OpenApiObject & properties . at (T.pack contentsField) ?~ refOrNullary]

844+ else allOf . _Just <>~ [Inline $ mempty & type_ ?~ SwaggerObject & properties . at (T.pack contentsField) ?~ refOrNullary]

1082845 UntaggedValue -> refOrEnum -- Aeson encodes nullary constructors as strings in this case.

1083846 ObjectWithSingleField -> Inline $ mempty

1084− & type_ ?~ OpenApiObject

847+ & type_ ?~ SwaggerObject

1085848 & required .~ [tag]

1086849 & properties . at tag ?~ refOrNullary

1087850 TwoElemArray -> error "unrepresentable in OpenAPI 3"

@@ -1089,7 +852,7 @@ gsumConToSchemaWith ref opts _ = (tag, schema)

1089852 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))

1090853 isRecord = conIsRecord (Proxy3 :: Proxy3 c f p)

1091854 refOrNullary = fromMaybe (Inline nullarySchema) ref

1092− refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ OpenApiString & enum_ ?~ [String tag]) ref

855+ refOrEnum = fromMaybe (Inline $ mempty & type_ ?~ SwaggerString & enum_ ?~ [String tag]) ref

1093856

1094857gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>

1095858 SchemaOptions -> Proxy (C1 c f) -> Declare (Definitions Schema) [(T.Text, Referenced Schema)]

@@ -1114,13 +877,7 @@ data Proxy2 a b = Proxy2

1114877

1115878data Proxy3 a b c = Proxy3

1116879

1117−{- $setup

1118−>>> import Data.OpenApi

1119−>>> import Data.Aeson (encode)

1120−>>> import Data.Aeson.Types (toJSONKeyText)

1121−>>> import Data.OpenApi.Internal.Utils

1122−>>> :set -XScopedTypeVariables

1123−>>> :set -XDeriveAnyClass

1124−>>> :set -XStandaloneDeriving

1125−>>> :set -XTypeApplications

1126−-}

880+-- $setup

881+-- >>> import Data.Swagger

882+-- >>> import Data.Aeson (encode)

883+-- >>> import Data.Aeson.Types (toJSONKeyText)

src/Data/OpenApi/Internal/Schema/Validation.hs → src/Data/Swagger/Internal/Schema/Validation.hsrenamed+79−85

@@ -1,5 +1,4 @@

11{-# OPTIONS_GHC -Wall #-}

2−{-# LANGUAGE CPP #-}

32{-# LANGUAGE DataKinds #-}

43{-# LANGUAGE DeriveFunctor #-}

54{-# LANGUAGE FlexibleInstances #-}

@@ -15,14 +14,14 @@

1514{-# LANGUAGE UndecidableInstances #-}

1615{-# LANGUAGE ViewPatterns #-}

1716-- |

18−-- Module: Data.OpenApi.Internal.Schema.Validation

17+-- Module: Data.Swagger.Internal.Schema.Validation

2019-- License: BSD3

2120-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>

2221-- Stability: experimental

2322--

2423-- Validate JSON values with Swagger Schema.

25−module Data.OpenApi.Internal.Schema.Validation where

24+module Data.Swagger.Internal.Schema.Validation where

2625

2726import Prelude ()

2827import Prelude.Compat

@@ -32,14 +31,11 @@ import Control.Lens hiding (allOf)

3231import Control.Monad (forM, forM_, when)

3332

3433import Data.Aeson hiding (Result)

35−#if MIN_VERSION_aeson(2,0,0)

36−import qualified Data.Aeson.KeyMap as KeyMap

37−#endif

34+import Data.Aeson.Encode.Pretty (encodePretty)

3835import Data.Foldable (for_, sequenceA_,

3936 traverse_)

40−#if !MIN_VERSION_aeson(2,0,0)

4137import Data.HashMap.Strict (HashMap)

42−#endif

38+import qualified Data.HashMap.Strict as HashMap

4339import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

4440import qualified "unordered-containers" Data.HashSet as HashSet

4541import Data.Maybe (fromMaybe)

@@ -52,12 +48,10 @@ import qualified Data.Text.Lazy.Encoding as TL

5248import Data.Vector (Vector)

5349import qualified Data.Vector as Vector

5450

55−import Data.OpenApi.Aeson.Compat (hasKey, keyToText, lookupKey, objectToList)

56−import Data.OpenApi.Declare

57−import Data.OpenApi.Internal

58−import Data.OpenApi.Internal.Schema

59−import Data.OpenApi.Internal.Utils

60−import Data.OpenApi.Lens

51+import Data.Swagger.Declare

52+import Data.Swagger.Internal

53+import Data.Swagger.Internal.Schema

54+import Data.Swagger.Lens

6155

6256-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.

6357-- This can be used with QuickCheck to ensure those instances are coherent:

@@ -109,33 +103,33 @@ validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checke

109103-- <BLANKLINE>

110104-- Swagger Schema:

111105-- {

112−-- "properties": {

113−-- "name": {

114−-- "type": "string"

115−-- },

116−-- "phone": {

117−-- "$ref": "#/components/schemas/Phone"

118−-- }

119−-- },

120106-- "required": [

121107-- "name",

122108-- "phone"

123109-- ],

124−-- "type": "object"

110+-- "type": "object",

111+-- "properties": {

112+-- "phone": {

113+-- "$ref": "#/components/schemas/Phone"

114+-- },

115+-- "name": {

116+-- "type": "string"

117+-- }

118+-- }

125119-- }

126120-- <BLANKLINE>

127121-- Swagger Description Context:

128122-- {

129123-- "Phone": {

124+-- "required": [

125+-- "value"

126+-- ],

127+-- "type": "object",

130128-- "properties": {

131129-- "value": {

132130-- "type": "string"

133131-- }

134−-- },

135−-- "required": [

136−-- "value"

137−-- ],

138−-- "type": "object"

132+-- }

139133-- }

140134-- }

141135-- <BLANKLINE>

@@ -211,7 +205,7 @@ instance Monad Result where

211205

212206-- | Validation configuration.

213207data Config = Config

214− { -- | Pattern checker for @'_schemaPattern'@ validation.

208+ { -- | Pattern checker for @'_paramSchemaPattern'@ validation.

215209 configPatternChecker :: Pattern -> Text -> Bool

216210 -- | Schema definitions in scope to resolve references.

217211 , configDefinitions :: Definitions Schema

@@ -306,32 +300,38 @@ validateWithSchemaRef (Inline s) js = sub s (validateWithSchema js)

306300validateWithSchema :: Value -> Validation Schema ()

307301validateWithSchema val = do

308302 validateSchemaType val

303+ sub_ paramSchema $ validateEnum val

304+

305+-- | Validate JSON @'Value'@ with Swagger @'ParamSchema'@.

306+validateWithParamSchema :: Value -> Validation ParamSchema ()

307+validateWithParamSchema val = do

308+ validateParamSchemaType val

309309 validateEnum val

310310

311−validateInteger :: Scientific -> Validation Schema ()

311+validateInteger :: Scientific -> Validation ParamSchema ()

312312validateInteger n = do

313313 when (not (isInteger n)) $

314314 invalid ("not an integer")

315315 validateNumber n

316316

317−validateNumber :: Scientific -> Validation Schema ()

317+validateNumber :: Scientific -> Validation ParamSchema ()

318318validateNumber n = withConfig $ \_cfg -> withSchema $ \sch -> do

319319 let exMax = Just True == sch ^. exclusiveMaximum

320320 exMin = Just True == sch ^. exclusiveMinimum

321321

322322 check maximum_ $ \m ->

323323 when (if exMax then (n >= m) else (n > m)) $

324− invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ (if exMax then "<" else "<=") ++ show m ++ ")")

324+ invalid ("value " ++ show n ++ " exceeds maximum (should be " ++ if exMax then "<" else "<=" ++ show m ++ ")")

325325

326326 check minimum_ $ \m ->

327327 when (if exMin then (n <= m) else (n < m)) $

328− invalid ("value " ++ show n ++ " falls below minimum (should be " ++ (if exMin then ">" else ">=") ++ show m ++ ")")

328+ invalid ("value " ++ show n ++ " falls below minimum (should be " ++ if exMin then ">" else ">=" ++ show m ++ ")")

329329

330330 check multipleOf $ \k ->

331331 when (not (isInteger (n / k))) $

332332 invalid ("expected a multiple of " ++ show k ++ " but got " ++ show n)

333333

334−validateString :: Text -> Validation Schema ()

334+validateString :: Text -> Validation ParamSchema ()

335335validateString s = do

336336 check maxLength $ \n ->

337337 when (len > fromInteger n) $

@@ -348,7 +348,7 @@ validateString s = do

348348 where

349349 len = Text.length s

350350

351−validateArray :: Vector Value -> Validation Schema ()

351+validateArray :: Vector Value -> Validation ParamSchema ()

352352validateArray xs = do

353353 check maxItems $ \n ->

354354 when (len > fromInteger n) $

@@ -359,8 +359,8 @@ validateArray xs = do

359359 invalid ("array is too short (size should be >=" ++ show n ++ ")")

360360

361361 check items $ \case

362− OpenApiItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs

363− OpenApiItemsArray itemSchemas -> do

362+ SwaggerItemsObject itemSchema -> traverse_ (validateWithSchemaRef itemSchema) xs

363+ SwaggerItemsArray itemSchemas -> do

364364 when (len /= length itemSchemas) $

365365 invalid ("array size is invalid (should be exactly " ++ show (length itemSchemas) ++ ")")

366366 sequenceA_ (zipWith validateWithSchemaRef itemSchemas (Vector.toList xs))

@@ -372,16 +372,10 @@ validateArray xs = do

372372 len = Vector.length xs

373373 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))

374374

375−validateObject ::

376−#if MIN_VERSION_aeson(2,0,0)

377− KeyMap.KeyMap Value

378−#else

379− HashMap Text Value

380−#endif

381− -> Validation Schema ()

375+validateObject :: HashMap Text Value -> Validation Schema ()

382376validateObject o = withSchema $ \sch ->

383377 case sch ^. discriminator of

384− Just (Discriminator pname types) -> case fromJSON <$> lookupKey pname o of

378+ Just (Discriminator pname types) -> case fromJSON <$> HashMap.lookup pname o of

385379 Just (Success pvalue) ->

386380 let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types

387381 -- TODO ref may be name or reference

@@ -400,15 +394,15 @@ validateObject o = withSchema $ \sch ->

400394 validateRequired

401395 validateProps

402396 where

403− size = fromIntegral (length o)

397+ size = fromIntegral (HashMap.size o)

404398

405399 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)

406400 validateReq n =

407− when (not (hasKey n o)) $

401+ when (not (HashMap.member n o)) $

408402 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))

409403

410404 validateProps = withSchema $ \sch -> do

411− for_ (objectToList o) $ \(keyToText -> k, v) ->

405+ for_ (HashMap.toList o) $ \(k, v) ->

412406 case v of

413407 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property

414408 _ ->

@@ -424,7 +418,7 @@ validateObject o = withSchema $ \sch ->

424418 unknownProperty pname = invalid $

425419 "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"

426420

427−validateEnum :: Value -> Validation Schema ()

421+validateEnum :: Value -> Validation ParamSchema ()

428422validateEnum val = do

429423 check enum_ $ \xs ->

430424 when (val `notElem` xs) $

@@ -435,10 +429,10 @@ validateEnum val = do

435429-- This is like 'inferParamSchemaTypes', but also works for objects:

436430--

437431-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"

438−-- Just [OpenApiObject]

439−inferSchemaTypes :: Schema -> [OpenApiType]

440−inferSchemaTypes sch = inferParamSchemaTypes sch ++

441− [ OpenApiObject | any ($ sch)

432+-- Just [SwaggerObject]

433+inferSchemaTypes :: Schema -> [SwaggerType]

434+inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++

435+ [ SwaggerObject | any ($ sch)

442436 [ has (additionalProperties._Just)

443437 , has (maxProperties._Just)

444438 , has (minProperties._Just)

@@ -448,30 +442,30 @@ inferSchemaTypes sch = inferParamSchemaTypes sch ++

448442-- | Infer schema type based on used properties.

449443--

450444-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"

451−-- Just [OpenApiString]

445+-- Just [SwaggerString]

452446--

453447-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"

454−-- Just [OpenApiArray]

448+-- Just [SwaggerArray]

455449--

456−-- From numeric properties 'OpenApiInteger' type is inferred.

457−-- If you want 'OpenApiNumber' instead, you must specify it explicitly.

450+-- From numeric properties 'SwaggerInteger' type is inferred.

451+-- If you want 'SwaggerNumber' instead, you must specify it explicitly.

458452--

459453-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"

460−-- Just [OpenApiInteger]

461−inferParamSchemaTypes :: Schema -> [OpenApiType]

454+-- Just [SwaggerInteger]

455+inferParamSchemaTypes :: ParamSchema -> [SwaggerType]

462456inferParamSchemaTypes sch = concat

463− [ [ OpenApiArray | any ($ sch)

457+ [ [ SwaggerArray | any ($ sch)

464458 [ has (items._Just)

465459 , has (maxItems._Just)

466460 , has (minItems._Just)

467461 , has (uniqueItems._Just) ] ]

468− , [ OpenApiInteger | any ($ sch)

462+ , [ SwaggerInteger | any ($ sch)

469463 [ has (exclusiveMaximum._Just)

470464 , has (exclusiveMinimum._Just)

471465 , has (maximum_._Just)

472466 , has (minimum_._Just)

473467 , has (multipleOf._Just) ] ]

474− , [ OpenApiString | any ($ sch)

468+ , [ SwaggerString | any ($ sch)

475469 [ has (maxLength._Just)

476470 , has (minLength._Just)

477471 , has (pattern._Just) ] ]

@@ -495,30 +489,30 @@ validateSchemaType val = withSchema $ \sch ->

495489

496490 _ ->

497491 case (sch ^. type_, val) of

498− (Just OpenApiNull, Null) -> valid

499− (Just OpenApiBoolean, Bool _) -> valid

500− (Just OpenApiInteger, Number n) -> validateInteger n

501− (Just OpenApiNumber, Number n) -> validateNumber n

502− (Just OpenApiString, String s) -> validateString s

503− (Just OpenApiArray, Array xs) -> validateArray xs

504− (Just OpenApiObject, Object o) -> validateObject o

492+ (Just SwaggerNull, Null) -> valid

493+ (Just SwaggerBoolean, Bool _) -> valid

494+ (Just SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)

495+ (Just SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)

496+ (Just SwaggerString, String s) -> sub_ paramSchema (validateString s)

497+ (Just SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)

498+ (Just SwaggerObject, Object o) -> validateObject o

505499 (Nothing, Null) -> valid

506500 (Nothing, Bool _) -> valid

507501 -- Number by default

508− (Nothing, Number n) -> validateNumber n

509− (Nothing, String s) -> validateString s

510− (Nothing, Array xs) -> validateArray xs

502+ (Nothing, Number n) -> sub_ paramSchema (validateNumber n)

503+ (Nothing, String s) -> sub_ paramSchema (validateString s)

504+ (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)

511505 (Nothing, Object o) -> validateObject o

512506 bad -> invalid $ "expected JSON value of type " ++ showType bad

513507

514−validateParamSchemaType :: Value -> Validation Schema ()

508+validateParamSchemaType :: Value -> Validation ParamSchema ()

515509validateParamSchemaType val = withSchema $ \sch ->

516510 case (sch ^. type_, val) of

517− (Just OpenApiBoolean, Bool _) -> valid

518− (Just OpenApiInteger, Number n) -> validateInteger n

519− (Just OpenApiNumber, Number n) -> validateNumber n

520− (Just OpenApiString, String s) -> validateString s

521− (Just OpenApiArray, Array xs) -> validateArray xs

511+ (Just SwaggerBoolean, Bool _) -> valid

512+ (Just SwaggerInteger, Number n) -> validateInteger n

513+ (Just SwaggerNumber, Number n) -> validateNumber n

514+ (Just SwaggerString, String s) -> validateString s

515+ (Just SwaggerArray, Array xs) -> validateArray xs

522516 (Nothing, Bool _) -> valid

523517 -- Number by default

524518 (Nothing, Number n) -> validateNumber n

@@ -526,11 +520,11 @@ validateParamSchemaType val = withSchema $ \sch ->

526520 (Nothing, Array xs) -> validateArray xs

527521 bad -> invalid $ "expected JSON value of type " ++ showType bad

528522

529−showType :: (Maybe OpenApiType, Value) -> String

523+showType :: (Maybe SwaggerType, Value) -> String

530524showType (Just ty, _) = show ty

531−showType (Nothing, Null) = "OpenApiNull"

532−showType (Nothing, Bool _) = "OpenApiBoolean"

533−showType (Nothing, Number _) = "OpenApiNumber"

534−showType (Nothing, String _) = "OpenApiString"

535−showType (Nothing, Array _) = "OpenApiArray"

536−showType (Nothing, Object _) = "OpenApiObject"

525+showType (Nothing, Null) = "SwaggerNull"

526+showType (Nothing, Bool _) = "SwaggerBoolean"

527+showType (Nothing, Number _) = "SwaggerNumber"

528+showType (Nothing, String _) = "SwaggerString"

529+showType (Nothing, Array _) = "SwaggerArray"

530+showType (Nothing, Object _) = "SwaggerObject"

src/Data/OpenApi/Internal/TypeShape.hs → src/Data/Swagger/Internal/TypeShape.hsrenamed+1−1

@@ -4,7 +4,7 @@

44{-# LANGUAGE TypeOperators #-}

55{-# LANGUAGE UndecidableInstances #-}

7−module Data.OpenApi.Internal.TypeShape where

7+module Data.Swagger.Internal.TypeShape where

99import Data.Proxy

1010import GHC.Generics

src/Data/OpenApi/Internal/Utils.hs → src/Data/Swagger/Internal/Utils.hsrenamed+1−6

@@ -4,7 +4,7 @@

44{-# LANGUAGE OverloadedStrings #-}

55{-# LANGUAGE RankNTypes #-}

66{-# LANGUAGE TypeOperators #-}

7−module Data.OpenApi.Internal.Utils where

7+module Data.Swagger.Internal.Utils where

99import Prelude ()

1010import Prelude.Compat

@@ -13,8 +13,6 @@ import Control.Lens ((&), (%~))

1313import Control.Lens.TH

1414import Data.Aeson

1515import Data.Aeson.Types

16−import qualified Data.Aeson.Encode.Pretty as P

17−import qualified Data.ByteString.Lazy as BSL

1816import Data.Char

1917import Data.Data

2018import Data.Hashable (Hashable)

@@ -134,6 +132,3 @@ instance SwaggerMonoid (Maybe a) where

134132 swaggerMempty = Nothing

135133 swaggerMappend x Nothing = x

136134 swaggerMappend _ y = y

137−

138−encodePretty :: ToJSON a => a -> BSL.ByteString

139−encodePretty = P.encodePretty' $ P.defConfig { P.confCompare = P.compare }

src/Data/OpenApi/Lens.hs → src/Data/Swagger/Lens.hsrenamed+58−49

@@ -10,25 +10,27 @@

1010{-# LANGUAGE UndecidableInstances #-}

1111{-# OPTIONS_GHC -fno-warn-orphans #-}

1212-- |

13−-- Module: Data.OpenApi.Lens

13+-- Module: Data.Swagger.Lens

1414-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>

1515-- Stability: experimental

1616--

1717-- Lenses and prisms for Swagger.

18−module Data.OpenApi.Lens where

18+module Data.Swagger.Lens where

1919

2020import Control.Lens

2121import Data.Aeson (Value)

2222import Data.Scientific (Scientific)

23−import Data.OpenApi.Internal

24−import Data.OpenApi.Internal.Utils

23+import Data.Swagger.Internal

24+import Data.Swagger.Internal.Utils

2525import Data.Text (Text)

2626

2727-- * Classy lenses

2828

29−makeFields ''OpenApi

29+makeFields ''Swagger

3030makeFields ''Components

3131makeFields ''Server

32+-- conflict with enum of ParamSchema

33+--makeLensesWith swaggerFieldRules ''ServerVariable

3234makeFields ''RequestBody

3335makeFields ''MediaTypeObject

3436makeFields ''Info

@@ -41,6 +43,7 @@ makeLensesWith swaggerFieldRules ''Param

4143makeFields ''Header

4244makeLensesWith swaggerFieldRules ''Schema

4345makeFields ''NamedSchema

46+makeLensesWith swaggerFieldRules ''ParamSchema

4447makeFields ''Xml

4548makeLensesWith swaggerFieldRules ''Responses

4649makeFields ''Response

@@ -56,7 +59,6 @@ makeFields ''ExternalDocs

5659makeFields ''Encoding

5760makeFields ''Example

5861makeFields ''Discriminator

59−makeFields ''Link

6062

6163-- * Prisms

6264-- ** 'SecuritySchemeType' prisms

@@ -64,24 +66,24 @@ makePrisms ''SecuritySchemeType

6466-- ** 'Referenced' prisms

6567makePrisms ''Referenced

6668

67−-- ** 'OpenApiItems' prisms

69+-- ** 'SwaggerItems' prisms

6870

69−_OpenApiItemsArray :: Review OpenApiItems [Referenced Schema]

70−_OpenApiItemsArray

71− = unto (\x -> OpenApiItemsArray x)

71+_SwaggerItemsArray :: Review SwaggerItems [Referenced Schema]

72+_SwaggerItemsArray

73+ = unto (\x -> SwaggerItemsArray x)

7274{- \x -> case x of

73− OpenApiItemsPrimitive c p -> Left (OpenApiItemsPrimitive c p)

74− OpenApiItemsObject o -> Left (OpenApiItemsObject o)

75− OpenApiItemsArray a -> Right a

75+ SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)

76+ SwaggerItemsObject o -> Left (SwaggerItemsObject o)

77+ SwaggerItemsArray a -> Right a

7678-}

7779

78−_OpenApiItemsObject :: Review OpenApiItems (Referenced Schema)

79−_OpenApiItemsObject

80− = unto (\x -> OpenApiItemsObject x)

80+_SwaggerItemsObject :: Review SwaggerItems (Referenced Schema)

81+_SwaggerItemsObject

82+ = unto (\x -> SwaggerItemsObject x)

8183{- \x -> case x of

82− OpenApiItemsPrimitive c p -> Left (OpenApiItemsPrimitive c p)

83− OpenApiItemsObject o -> Right o

84− OpenApiItemsArray a -> Left (OpenApiItemsArray a)

84+ SwaggerItemsPrimitive c p -> Left (SwaggerItemsPrimitive c p)

85+ SwaggerItemsObject o -> Right o

86+ SwaggerItemsArray a -> Left (SwaggerItemsArray a)

8587-}

8688

8789-- =============================================================

@@ -99,68 +101,75 @@ instance At Responses where at n = responses . at n

99101instance Ixed Operation where ix n = responses . ix n

100102instance At Operation where at n = responses . at n

101103

102−instance HasType NamedSchema (Maybe OpenApiType) where type_ = schema.type_

104+instance HasParamSchema NamedSchema ParamSchema where paramSchema = schema.paramSchema

105+

106+-- HasType instances

107+instance HasType Schema (Maybe SwaggerType) where type_ = paramSchema.type_

108+instance HasType NamedSchema (Maybe SwaggerType) where type_ = paramSchema.type_

109+

110+-- HasDefault instances

111+instance HasDefault Schema (Maybe Value) where default_ = paramSchema.default_

103112

104113-- OVERLAPPABLE instances

105114

106115instance

107116 {-# OVERLAPPABLE #-}

108− HasSchema s Schema

117+ HasParamSchema s ParamSchema

109118 => HasFormat s (Maybe Format) where

110− format = schema.format

119+ format = paramSchema.format

111120

112121instance

113122 {-# OVERLAPPABLE #-}

114− HasSchema s Schema

115− => HasItems s (Maybe OpenApiItems) where

116− items = schema.items

123+ HasParamSchema s ParamSchema

124+ => HasItems s (Maybe SwaggerItems) where

125+ items = paramSchema.items

117126

118127instance

119128 {-# OVERLAPPABLE #-}

120− HasSchema s Schema

129+ HasParamSchema s ParamSchema

121130 => HasMaximum s (Maybe Scientific) where

122− maximum_ = schema.maximum_

131+ maximum_ = paramSchema.maximum_

123132

124−instance {-# OVERLAPPABLE #-} HasSchema s Schema

133+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

125134 => HasExclusiveMaximum s (Maybe Bool) where

126− exclusiveMaximum = schema.exclusiveMaximum

135+ exclusiveMaximum = paramSchema.exclusiveMaximum

127136

128−instance {-# OVERLAPPABLE #-} HasSchema s Schema

137+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

129138 => HasMinimum s (Maybe Scientific) where

130− minimum_ = schema.minimum_

139+ minimum_ = paramSchema.minimum_

131140

132−instance {-# OVERLAPPABLE #-} HasSchema s Schema

141+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

133142 => HasExclusiveMinimum s (Maybe Bool) where

134− exclusiveMinimum = schema.exclusiveMinimum

143+ exclusiveMinimum = paramSchema.exclusiveMinimum

135144

136−instance {-# OVERLAPPABLE #-} HasSchema s Schema

145+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

137146 => HasMaxLength s (Maybe Integer) where

138− maxLength = schema.maxLength

147+ maxLength = paramSchema.maxLength

139148

140−instance {-# OVERLAPPABLE #-} HasSchema s Schema

149+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

141150 => HasMinLength s (Maybe Integer) where

142− minLength = schema.minLength

151+ minLength = paramSchema.minLength

143152

144−instance {-# OVERLAPPABLE #-} HasSchema s Schema

153+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

145154 => HasPattern s (Maybe Text) where

146− pattern = schema.pattern

155+ pattern = paramSchema.pattern

147156

148−instance {-# OVERLAPPABLE #-} HasSchema s Schema

157+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

149158 => HasMaxItems s (Maybe Integer) where

150− maxItems = schema.maxItems

159+ maxItems = paramSchema.maxItems

151160

152−instance {-# OVERLAPPABLE #-} HasSchema s Schema

161+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

153162 => HasMinItems s (Maybe Integer) where

154− minItems = schema.minItems

163+ minItems = paramSchema.minItems

155164

156−instance {-# OVERLAPPABLE #-} HasSchema s Schema

165+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

157166 => HasUniqueItems s (Maybe Bool) where

158− uniqueItems = schema.uniqueItems

167+ uniqueItems = paramSchema.uniqueItems

159168

160−instance {-# OVERLAPPABLE #-} HasSchema s Schema

169+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

161170 => HasEnum s (Maybe [Value]) where

162− enum_ = schema.enum_

171+ enum_ = paramSchema.enum_

163172

164−instance {-# OVERLAPPABLE #-} HasSchema s Schema

173+instance {-# OVERLAPPABLE #-} HasParamSchema s ParamSchema

165174 => HasMultipleOf s (Maybe Scientific) where

166− multipleOf = schema.multipleOf

175+ multipleOf = paramSchema.multipleOf

src/Data/OpenApi/Operation.hs → src/Data/Swagger/Operation.hsrenamed+29−136

@@ -1,13 +1,13 @@

11{-# LANGUAGE RankNTypes #-}

22-- |

3−-- Module: Data.OpenApi.Operation

3+-- Module: Data.Swagger.Operation

44-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>

55-- Stability: experimental

66--

77-- Helper traversals and functions for Swagger operations manipulations.

88-- These might be useful when you already have Swagger specification

99-- generated by something else.

10−module Data.OpenApi.Operation (

10+module Data.Swagger.Operation (

1111 -- * Operation traversals

1212 allOperations,

1313 operationsOf,

@@ -42,10 +42,10 @@ import qualified Data.Set as Set

4242import Data.Text (Text)

4343import Network.HTTP.Media (MediaType)

4444

45−import Data.OpenApi.Declare

46−import Data.OpenApi.Internal

47−import Data.OpenApi.Lens

48−import Data.OpenApi.Schema

45+import Data.Swagger.Declare

46+import Data.Swagger.Internal

47+import Data.Swagger.Lens

48+import Data.Swagger.Schema

4949

5050import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

5151import qualified Data.HashSet.InsOrd as InsOrdHS

@@ -55,17 +55,14 @@ import qualified Data.HashSet.InsOrd as InsOrdHS

5555-- >>> import Data.Proxy

5656-- >>> import Data.Time

5757-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL

58−-- >>> import Data.OpenApi.Internal.Utils

5958

6059-- | Prepend path piece to all operations of the spec.

6160-- Leading and trailing slashes are trimmed/added automatically.

6261--

63−-- >>> let api = (mempty :: OpenApi) & paths .~ [("/info", mempty)]

64−-- >>> BSL.putStrLn $ encodePretty $ prependPath "user/{user_id}" api ^. paths

65−-- {

66−-- "/user/{user_id}/info": {}

67−-- }

68−prependPath :: FilePath -> OpenApi -> OpenApi

62+-- >>> let api = (mempty :: Swagger) & paths .~ [("/info", mempty)]

63+-- >>> BSL.putStrLn $ encode $ prependPath "user/{user_id}" api ^. paths

64+-- {"/user/{user_id}/info":{}}

65+prependPath :: FilePath -> Swagger -> Swagger

6966prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)

7067 where

7168 x </> y = case trim y of

@@ -75,7 +72,7 @@ prependPath path = paths %~ InsOrdHashMap.mapKeys (path </>)

7572 trim = dropWhile (== '/') . dropWhileEnd (== '/')

7673

7774-- | All operations of a Swagger spec.

78−allOperations :: Traversal' OpenApi Operation

75+allOperations :: Traversal' Swagger Operation

7976allOperations = paths.traverse.template

8077

8178-- | @'operationsOf' sub@ will traverse only those operations

@@ -83,66 +80,13 @@ allOperations = paths.traverse.template

8380-- by both path and method.

8481--

8582-- >>> let ok = (mempty :: Operation) & at 200 ?~ "OK"

86−-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]

87−-- >>> let sub = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]

88−-- >>> BSL.putStrLn $ encodePretty api

89−-- {

90−-- "components": {},

91−-- "info": {

92−-- "title": "",

93−-- "version": ""

94−-- },

95−-- "openapi": "3.0.0",

96−-- "paths": {

97−-- "/user": {

98−-- "get": {

99−-- "responses": {

100−-- "200": {

101−-- "description": "OK"

102−-- }

103−-- }

104−-- },

105−-- "post": {

106−-- "responses": {

107−-- "200": {

108−-- "description": "OK"

109−-- }

110−-- }

111−-- }

112−-- }

113−-- }

114−-- }

115−-- >>> BSL.putStrLn $ encodePretty $ api & operationsOf sub . at 404 ?~ "Not found"

116−-- {

117−-- "components": {},

118−-- "info": {

119−-- "title": "",

120−-- "version": ""

121−-- },

122−-- "openapi": "3.0.0",

123−-- "paths": {

124−-- "/user": {

125−-- "get": {

126−-- "responses": {

127−-- "200": {

128−-- "description": "OK"

129−-- },

130−-- "404": {

131−-- "description": "Not found"

132−-- }

133−-- }

134−-- },

135−-- "post": {

136−-- "responses": {

137−-- "200": {

138−-- "description": "OK"

139−-- }

140−-- }

141−-- }

142−-- }

143−-- }

144−-- }

145−operationsOf :: OpenApi -> Traversal' OpenApi Operation

83+-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ ok & post ?~ ok)]

84+-- >>> let sub = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]

85+-- >>> BSL.putStrLn $ encode api

86+-- {"openapi":"3.0.0","info":{"version":"","title":""},"paths":{"/user":{"get":{"responses":{"200":{"description":"OK"}}},"post":{"responses":{"200":{"description":"OK"}}}}},"components":{}}

87+-- >>> BSL.putStrLn $ encode $ api & operationsOf sub . at 404 ?~ "Not found"

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":{}}

89+operationsOf :: Swagger -> Traversal' Swagger Operation

14690operationsOf sub = paths.itraversed.withIndex.subops

14791 where

14892 -- | Traverse operations that correspond to paths and methods of the sub API.

@@ -164,12 +108,12 @@ operationsOf sub = paths.itraversed.withIndex.subops

164108-- @

165109-- 'applyTags' = 'applyTagsFor' 'allOperations'

166110-- @

167−applyTags :: [Tag] -> OpenApi -> OpenApi

111+applyTags :: [Tag] -> Swagger -> Swagger

168112applyTags = applyTagsFor allOperations

169113

170114-- | Apply tags to a part of Swagger spec and update the global

171115-- list of tags.

172−applyTagsFor :: Traversal' OpenApi Operation -> [Tag] -> OpenApi -> OpenApi

116+applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger

173117applyTagsFor ops ts swag = swag

174118 & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))

175119 & tags %~ (<> InsOrdHS.fromList ts)

@@ -179,26 +123,8 @@ applyTagsFor ops ts swag = swag

179123--

180124-- FIXME doc

181125--

182−-- >>> BSL.putStrLn $ encodePretty $ runDeclare (declareResponse "application/json" (Proxy :: Proxy Day)) mempty

183−-- [

184−-- {

185−-- "Day": {

186−-- "example": "2016-07-22",

187−-- "format": "date",

188−-- "type": "string"

189−-- }

190−-- },

191−-- {

192−-- "content": {

193−-- "application/json": {

194−-- "schema": {

195−-- "$ref": "#/components/schemas/Day"

196−-- }

197−-- }

198−-- },

199−-- "description": ""

200−-- }

201−-- ]

126+-- >>> BSL.putStrLn $ encode $ runDeclare (declareResponse "application/json" (Proxy :: Proxy Day)) mempty

127+-- [{"Day":{"example":"2016-07-22","format":"date","type":"string"}},{"description":"","content":{"application/json":{"schema":{"$ref":"#/components/schemas/Day"}}}}]

202128declareResponse :: ToSchema a => MediaType -> Proxy a -> Declare (Definitions Schema) Response

203129declareResponse cType proxy = do

204130 s <- declareSchemaRef proxy

@@ -215,46 +141,13 @@ declareResponse cType proxy = do

215141--

216142-- Example:

217143--

218−-- >>> let api = (mempty :: OpenApi) & paths .~ [("/user", mempty & get ?~ mempty)]

144+-- >>> let api = (mempty :: Swagger) & paths .~ [("/user", mempty & get ?~ mempty)]

219145-- >>> let res = declareResponse "application/json" (Proxy :: Proxy Day)

220−-- >>> BSL.putStrLn $ encodePretty $ api & setResponse 200 res

221−-- {

222−-- "components": {

223−-- "schemas": {

224−-- "Day": {

225−-- "example": "2016-07-22",

226−-- "format": "date",

227−-- "type": "string"

228−-- }

229−-- }

230−-- },

231−-- "info": {

232−-- "title": "",

233−-- "version": ""

234−-- },

235−-- "openapi": "3.0.0",

236−-- "paths": {

237−-- "/user": {

238−-- "get": {

239−-- "responses": {

240−-- "200": {

241−-- "content": {

242−-- "application/json": {

243−-- "schema": {

244−-- "$ref": "#/components/schemas/Day"

245−-- }

246−-- }

247−-- },

248−-- "description": ""

249−-- }

250−-- }

251−-- }

252−-- }

253−-- }

254−-- }

146+-- >>> BSL.putStrLn $ encode $ api & setResponse 200 res

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"}}}}

255148--

256149-- See also @'setResponseWith'@.

257−setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi

150+setResponse :: HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger

258151setResponse = setResponseFor allOperations

259152

260153-- | Set or update response for all operations.

@@ -268,7 +161,7 @@ setResponse = setResponseFor allOperations

268161-- @

269162--

270163-- See also @'setResponse'@.

271−setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi

164+setResponseWith :: (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger

272165setResponseWith = setResponseForWith allOperations

273166

274167-- | Set response for specified operations.

@@ -277,7 +170,7 @@ setResponseWith = setResponseForWith allOperations

277170-- If the response already exists it will be overwritten.

278171--

279172-- See also @'setResponseForWith'@.

280−setResponseFor :: Traversal' OpenApi Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi

173+setResponseFor :: Traversal' Swagger Operation -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger

281174setResponseFor ops code dres swag = swag

282175 & components.schemas %~ (<> defs)

283176 & ops . at code ?~ Inline res

@@ -291,7 +184,7 @@ setResponseFor ops code dres swag = swag

291184-- then just the new response is used.

292185--

293186-- See also @'setResponseFor'@.

294−setResponseForWith :: Traversal' OpenApi Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> OpenApi -> OpenApi

187+setResponseForWith :: Traversal' Swagger Operation -> (Response -> Response -> Response) -> HttpStatusCode -> Declare (Definitions Schema) Response -> Swagger -> Swagger

295188setResponseForWith ops f code dres swag = swag

296189 & components.schemas %~ (<> defs)

297190 & ops . at code %~ Just . Inline . combine

src/Data/OpenApi/Optics.hs → src/Data/Swagger/Optics.hsrenamed+153−91

@@ -7,7 +7,7 @@

77{-# LANGUAGE UndecidableInstances #-}

88{-# OPTIONS_GHC -fno-warn-orphans #-}

99-- |

10−-- Module: Data.OpenApi.Optics

10+-- Module: Data.Swagger.Optics

1111-- Maintainer: Andrzej Rybczak <andrzej@rybczak.net>

1212-- Stability: experimental

1313--

@@ -19,98 +19,53 @@

1919-- >>> :set -XOverloadedLabels

2020-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL

2121--

22−-- Example from the "Data.OpenApi" module using @optics@:

22+-- Example from the "Data.Swagger" module using @optics@:

2323--

2424-- >>> :{

25−-- BSL.putStrLn $ encodePretty $ (mempty :: OpenApi)

26−-- & #components % #schemas .~ [ ("User", mempty & #type ?~ OpenApiString) ]

25+-- BSL.putStrLn $ encode $ (mempty :: Swagger)

26+-- & #components % #schemas .~ [ ("User", mempty & #type ?~ SwaggerString) ]

2727-- & #paths .~

2828-- [ ("/user", mempty & #get ?~ (mempty

2929-- & at 200 ?~ ("OK" & #_Inline % #content % at "application/json" ?~ (mempty & #schema ?~ Ref (Reference "User")))

3030-- & at 404 ?~ "User info not found")) ]

3131-- :}

32−-- {

33−-- "components": {

34−-- "schemas": {

35−-- "User": {

36−-- "type": "string"

37−-- }

38−-- }

39−-- },

40−-- "info": {

41−-- "title": "",

42−-- "version": ""

43−-- },

44−-- "openapi": "3.0.0",

45−-- "paths": {

46−-- "/user": {

47−-- "get": {

48−-- "responses": {

49−-- "200": {

50−-- "content": {

51−-- "application/json": {

52−-- "schema": {

53−-- "$ref": "#/components/schemas/User"

54−-- }

55−-- }

56−-- },

57−-- "description": "OK"

58−-- },

59−-- "404": {

60−-- "description": "User info not found"

61−-- }

62−-- }

63−-- }

64−-- }

65−-- }

66−-- }

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"}}}}

6733--

6834-- For convenience optics are defined as /labels/. It means that field accessor

6935-- names can be overloaded for different types. One such common field is

7036-- @#description@. Many components of a Swagger specification can have

7137-- descriptions, and you can use the same name for them:

7238--

73−-- >>> BSL.putStrLn $ encodePretty $ (mempty :: Response) & #description .~ "No content"

74−-- {

75−-- "description": "No content"

76−-- }

39+-- >>> BSL.putStrLn $ encode $ (mempty :: Response) & #description .~ "No content"

40+-- {"description":"No content"}

7741-- >>> :{

78−-- BSL.putStrLn $ encodePretty $ (mempty :: Schema)

79−-- & #type ?~ OpenApiBoolean

42+-- BSL.putStrLn $ encode $ (mempty :: Schema)

43+-- & #type ?~ SwaggerBoolean

8044-- & #description ?~ "To be or not to be"

8145-- :}

82−-- {

83−-- "description": "To be or not to be",

84−-- "type": "boolean"

85−-- }

46+-- {"description":"To be or not to be","type":"boolean"}

8647--

8748-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and

8849-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:

8950--

9051-- >>> :{

91−-- BSL.putStrLn $ encodePretty $ (mempty :: Operation)

52+-- BSL.putStrLn $ encode $ (mempty :: Operation)

9253-- & at 404 ?~ "Not found"

9354-- :}

94−-- {

95−-- "responses": {

96−-- "404": {

97−-- "description": "Not found"

98−-- }

99−-- }

100−-- }

101−module Data.OpenApi.Optics () where

55+-- {"responses":{"404":{"description":"Not found"}}}

56+--

57+module Data.Swagger.Optics () where

10258

10359import Data.Aeson (Value)

10460import Data.Scientific (Scientific)

105−import Data.OpenApi.Internal

106−import Data.OpenApi.Internal.Utils

61+import Data.Swagger.Internal

10762import Data.Text (Text)

10863import Optics.Core

10964import Optics.TH

11065

11166-- Lenses

11267

113−makeFieldLabels ''OpenApi

68+makeFieldLabels ''Swagger

11469makeFieldLabels ''Components

11570makeFieldLabels ''Server

11671makeFieldLabels ''ServerVariable

@@ -126,6 +81,7 @@ makeFieldLabels ''Param

12681makeFieldLabels ''Header

12782makeFieldLabels ''Schema

12883makeFieldLabels ''NamedSchema

84+makeFieldLabels ''ParamSchema

12985makeFieldLabels ''Xml

13086makeFieldLabels ''Responses

13187makeFieldLabels ''Response

@@ -141,37 +97,36 @@ makeFieldLabels ''ExternalDocs

14197makeFieldLabels ''Encoding

14298makeFieldLabels ''Example

14399makeFieldLabels ''Discriminator

144−makeFieldLabels ''Link

145100

146101-- Prisms

147102

148103makePrismLabels ''SecuritySchemeType

149104makePrismLabels ''Referenced

150105

151−-- OpenApiItems prisms

106+-- SwaggerItems prisms

152107

153108instance

154109 ( a ~ [Referenced Schema]

155110 , b ~ [Referenced Schema]

156− ) => LabelOptic "_OpenApiItemsArray"

111+ ) => LabelOptic "_SwaggerItemsArray"

157112 A_Review

158− OpenApiItems

159− OpenApiItems

113+ SwaggerItems

114+ SwaggerItems

160115 a

161116 b where

162− labelOptic = unto (\x -> OpenApiItemsArray x)

117+ labelOptic = unto (\x -> SwaggerItemsArray x)

163118 {-# INLINE labelOptic #-}

164119

165120instance

166121 ( a ~ Referenced Schema

167122 , b ~ Referenced Schema

168− ) => LabelOptic "_OpenApiItemsObject"

123+ ) => LabelOptic "_SwaggerItemsObject"

169124 A_Review

170− OpenApiItems

171− OpenApiItems

125+ SwaggerItems

126+ SwaggerItems

172127 a

173128 b where

174− labelOptic = unto (\x -> OpenApiItemsObject x)

129+ labelOptic = unto (\x -> SwaggerItemsObject x)

175130 {-# INLINE labelOptic #-}

176131

177132-- =============================================================

@@ -197,132 +152,239 @@ instance At Operation where

197152 at n = #responses % at n

198153 {-# INLINE at #-}

199154

155+-- #paramSchema

156+

157+instance

158+ ( a ~ ParamSchema

159+ , b ~ ParamSchema

160+ ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where

161+ labelOptic = #schema % #paramSchema

162+ {-# INLINE labelOptic #-}

163+

200164-- #type

201165

202166instance

203− ( a ~ Maybe OpenApiType

204− , b ~ Maybe OpenApiType

167+ ( a ~ Maybe SwaggerType

168+ , b ~ Maybe SwaggerType

169+ ) => LabelOptic "type" A_Lens Schema Schema a b where

170+ labelOptic = #paramSchema % #type

171+ {-# INLINE labelOptic #-}

172+

173+instance

174+ ( a ~ Maybe SwaggerType

175+ , b ~ Maybe SwaggerType

205176 ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where

206− labelOptic = #schema % #type

177+ labelOptic = #paramSchema % #type

207178 {-# INLINE labelOptic #-}

208179

209180-- #default

210181

182+instance

183+ ( a ~ Maybe Value, b ~ Maybe Value

184+ ) => LabelOptic "default" A_Lens Schema Schema a b where

185+ labelOptic = #paramSchema % #default

186+ {-# INLINE labelOptic #-}

187+

211188instance

212189 ( a ~ Maybe Value, b ~ Maybe Value

213190 ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where

214− labelOptic = #schema % #default

191+ labelOptic = #paramSchema % #default

215192 {-# INLINE labelOptic #-}

216193

217194-- #format

218195

196+instance

197+ ( a ~ Maybe Format, b ~ Maybe Format

198+ ) => LabelOptic "format" A_Lens Schema Schema a b where

199+ labelOptic = #paramSchema % #format

200+ {-# INLINE labelOptic #-}

201+

219202instance

220203 ( a ~ Maybe Format, b ~ Maybe Format

221204 ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where

222− labelOptic = #schema % #format

205+ labelOptic = #paramSchema % #format

223206 {-# INLINE labelOptic #-}

224207

225208-- #items

226209

227210instance

228− ( a ~ Maybe OpenApiItems

229− , b ~ Maybe OpenApiItems

211+ ( a ~ Maybe SwaggerItems

212+ , b ~ Maybe SwaggerItems

213+ ) => LabelOptic "items" A_Lens Schema Schema a b where

214+ labelOptic = #paramSchema % #items

215+ {-# INLINE labelOptic #-}

216+

217+instance

218+ ( a ~ Maybe SwaggerItems

219+ , b ~ Maybe SwaggerItems

230220 ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where

231− labelOptic = #schema % #items

221+ labelOptic = #paramSchema % #items

232222 {-# INLINE labelOptic #-}

233223

234224-- #maximum

235225

226+instance

227+ ( a ~ Maybe Scientific, b ~ Maybe Scientific

228+ ) => LabelOptic "maximum" A_Lens Schema Schema a b where

229+ labelOptic = #paramSchema % #maximum

230+ {-# INLINE labelOptic #-}

231+

236232instance

237233 ( a ~ Maybe Scientific, b ~ Maybe Scientific

238234 ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where

239− labelOptic = #schema % #maximum

235+ labelOptic = #paramSchema % #maximum

240236 {-# INLINE labelOptic #-}

241237

242238-- #exclusiveMaximum

243239

240+instance

241+ ( a ~ Maybe Bool, b ~ Maybe Bool

242+ ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where

243+ labelOptic = #paramSchema % #exclusiveMaximum

244+ {-# INLINE labelOptic #-}

245+

244246instance

245247 ( a ~ Maybe Bool, b ~ Maybe Bool

246248 ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where

247− labelOptic = #schema % #exclusiveMaximum

249+ labelOptic = #paramSchema % #exclusiveMaximum

248250 {-# INLINE labelOptic #-}

249251

250252-- #minimum

251253

254+instance

255+ ( a ~ Maybe Scientific, b ~ Maybe Scientific

256+ ) => LabelOptic "minimum" A_Lens Schema Schema a b where

257+ labelOptic = #paramSchema % #minimum

258+ {-# INLINE labelOptic #-}

259+

252260instance

253261 ( a ~ Maybe Scientific, b ~ Maybe Scientific

254262 ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where

255− labelOptic = #schema % #minimum

263+ labelOptic = #paramSchema % #minimum

256264 {-# INLINE labelOptic #-}

257265

258266-- #exclusiveMinimum

259267

268+instance

269+ ( a ~ Maybe Bool, b ~ Maybe Bool

270+ ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where

271+ labelOptic = #paramSchema % #exclusiveMinimum

272+ {-# INLINE labelOptic #-}

273+

260274instance

261275 ( a ~ Maybe Bool, b ~ Maybe Bool

262276 ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where

263− labelOptic = #schema % #exclusiveMinimum

277+ labelOptic = #paramSchema % #exclusiveMinimum

264278 {-# INLINE labelOptic #-}

265279

266280-- #maxLength

267281

282+instance

283+ ( a ~ Maybe Integer, b ~ Maybe Integer

284+ ) => LabelOptic "maxLength" A_Lens Schema Schema a b where

285+ labelOptic = #paramSchema % #maxLength

286+ {-# INLINE labelOptic #-}

287+

268288instance

269289 ( a ~ Maybe Integer, b ~ Maybe Integer

270290 ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where

271− labelOptic = #schema % #maxLength

291+ labelOptic = #paramSchema % #maxLength

272292 {-# INLINE labelOptic #-}

273293

274294-- #minLength

275295

296+instance

297+ ( a ~ Maybe Integer, b ~ Maybe Integer

298+ ) => LabelOptic "minLength" A_Lens Schema Schema a b where

299+ labelOptic = #paramSchema % #minLength

300+ {-# INLINE labelOptic #-}

301+

276302instance

277303 ( a ~ Maybe Integer, b ~ Maybe Integer

278304 ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where

279− labelOptic = #schema % #minLength

305+ labelOptic = #paramSchema % #minLength

280306 {-# INLINE labelOptic #-}

281307

282308-- #pattern

283309

310+instance

311+ ( a ~ Maybe Text, b ~ Maybe Text

312+ ) => LabelOptic "pattern" A_Lens Schema Schema a b where

313+ labelOptic = #paramSchema % #pattern

314+ {-# INLINE labelOptic #-}

315+

284316instance

285317 ( a ~ Maybe Text, b ~ Maybe Text

286318 ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where

287− labelOptic = #schema % #pattern

319+ labelOptic = #paramSchema % #pattern

288320 {-# INLINE labelOptic #-}

289321

290322-- #maxItems

291323

324+instance

325+ ( a ~ Maybe Integer, b ~ Maybe Integer

326+ ) => LabelOptic "maxItems" A_Lens Schema Schema a b where

327+ labelOptic = #paramSchema % #maxItems

328+ {-# INLINE labelOptic #-}

329+

292330instance

293331 ( a ~ Maybe Integer, b ~ Maybe Integer

294332 ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where

295− labelOptic = #schema % #maxItems

333+ labelOptic = #paramSchema % #maxItems

296334 {-# INLINE labelOptic #-}

297335

298336-- #minItems

299337

338+instance

339+ ( a ~ Maybe Integer, b ~ Maybe Integer

340+ ) => LabelOptic "minItems" A_Lens Schema Schema a b where

341+ labelOptic = #paramSchema % #minItems

342+ {-# INLINE labelOptic #-}

343+

300344instance

301345 ( a ~ Maybe Integer, b ~ Maybe Integer

302346 ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where

303− labelOptic = #schema % #minItems

347+ labelOptic = #paramSchema % #minItems

304348 {-# INLINE labelOptic #-}

305349

306350-- #uniqueItems

307351

352+instance

353+ ( a ~ Maybe Bool, b ~ Maybe Bool

354+ ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where

355+ labelOptic = #paramSchema % #uniqueItems

356+ {-# INLINE labelOptic #-}

357+

308358instance

309359 ( a ~ Maybe Bool, b ~ Maybe Bool

310360 ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where

311− labelOptic = #schema % #uniqueItems

361+ labelOptic = #paramSchema % #uniqueItems

312362 {-# INLINE labelOptic #-}

313363

314364-- #enum

315365

366+instance

367+ ( a ~ Maybe [Value], b ~ Maybe [Value]

368+ ) => LabelOptic "enum" A_Lens Schema Schema a b where

369+ labelOptic = #paramSchema % #enum

370+ {-# INLINE labelOptic #-}

371+

316372instance

317373 ( a ~ Maybe [Value], b ~ Maybe [Value]

318374 ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where

319− labelOptic = #schema % #enum

375+ labelOptic = #paramSchema % #enum

320376 {-# INLINE labelOptic #-}

321377

322378-- #multipleOf

323379

380+instance

381+ ( a ~ Maybe Scientific, b ~ Maybe Scientific

382+ ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where

383+ labelOptic = #paramSchema % #multipleOf

384+ {-# INLINE labelOptic #-}

385+

324386instance

325387 ( a ~ Maybe Scientific, b ~ Maybe Scientific

326388 ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where

327− labelOptic = #schema % #multipleOf

389+ labelOptic = #paramSchema % #multipleOf

328390 {-# INLINE labelOptic #-}

src/Data/OpenApi/ParamSchema.hs → src/Data/Swagger/ParamSchema.hsrenamed+7−7

@@ -1,10 +1,10 @@

11-- |

2−-- Module: Data.OpenApi.ParamSchema

2+-- Module: Data.Swagger.ParamSchema

33-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>

44-- Stability: experimental

55--

66-- Types and functions for working with Swagger parameter schema.

7−module Data.OpenApi.ParamSchema (

7+module Data.Swagger.ParamSchema (

88 -- * Encoding

99 ToParamSchema(..),

1010

@@ -13,14 +13,14 @@ module Data.OpenApi.ParamSchema (

1313 toParamSchemaBoundedIntegral,

1414

1515 -- * Schema templates

16− passwordSchema,

17− binarySchema,

18− byteSchema,

16+ passwordParamSchema,

17+ binaryParamSchema,

18+ byteParamSchema,

1919

2020 -- * Generic encoding configuration

2121 SchemaOptions(..),

2222 defaultSchemaOptions,

2323) where

2424

25−import Data.OpenApi.Internal.ParamSchema

26−import Data.OpenApi.SchemaOptions

25+import Data.Swagger.Internal.ParamSchema

26+import Data.Swagger.SchemaOptions

src/Data/OpenApi/Schema.hs → src/Data/Swagger/Schema.hsrenamed+9−4

@@ -1,10 +1,10 @@

11-- |

2−-- Module: Data.OpenApi.Schema

2+-- Module: Data.Swagger.Schema

33-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>

44-- Stability: experimental

55--

66-- Types and functions for working with Swagger schema.

7−module Data.OpenApi.Schema (

7+module Data.Swagger.Schema (

88 -- * Encoding

99 ToSchema(..),

1010 declareSchema,

@@ -32,6 +32,11 @@ module Data.OpenApi.Schema (

3232 paramSchemaToNamedSchema,

3333 paramSchemaToSchema,

3434

35+ -- * Schema templates

36+ passwordSchema,

37+ binarySchema,

38+ byteSchema,

39+

3540 -- * Sketching @'Schema'@s using @'ToJSON'@

3641 sketchSchema,

3742 sketchStrictSchema,

@@ -48,5 +53,5 @@ module Data.OpenApi.Schema (

4853 fromAesonOptions,

4954) where

5055

51−import Data.OpenApi.Internal.Schema

52−import Data.OpenApi.SchemaOptions

56+import Data.Swagger.Internal.Schema

57+import Data.Swagger.SchemaOptions

src/Data/OpenApi/Schema/Generator.hs → src/Data/Swagger/Schema/Generator.hsrenamed+15−17

@@ -2,7 +2,7 @@

22{-# LANGUAGE OverloadedLists #-}

33{-# LANGUAGE ScopedTypeVariables #-}

5−module Data.OpenApi.Schema.Generator where

5+module Data.Swagger.Schema.Generator where

77import Prelude ()

88import Prelude.Compat

@@ -16,22 +16,20 @@ import Data.Maybe

1616import Data.Proxy

1717import Data.Scientific

1818import qualified Data.Set as S

19−import Data.OpenApi

20−import Data.OpenApi.Declare

21−import Data.OpenApi.Internal.Schema.Validation (inferSchemaTypes)

19+import Data.Swagger

20+import Data.Swagger.Declare

21+import Data.Swagger.Internal.Schema.Validation (inferSchemaTypes)

2222import qualified Data.Text as T

2323import qualified Data.Vector as V

2424import Test.QuickCheck (arbitrary)

2525import Test.QuickCheck.Gen

2626import Test.QuickCheck.Property

2727

28−import Data.OpenApi.Aeson.Compat (fromInsOrdHashMap)

29−

3028-- | Note: 'schemaGen' may 'error', if schema type is not specified,

3129-- and cannot be inferred.

3230schemaGen :: Definitions Schema -> Schema -> Gen Value

3331schemaGen _ schema

34− | Just cases <- schema ^. enum_ = elements cases

32+ | Just cases <- schema ^. paramSchema . enum_ = elements cases

3533schemaGen defns schema

3634 | Just variants <- schema ^. oneOf = schemaGen defns =<< elements (dereference defns <$> variants)

3735schemaGen defns schema =

@@ -41,25 +39,25 @@ schemaGen defns schema =

4139 [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)

4240 -- Gen is not MonadFail

4341 _ -> error "unable to infer schema type"

44− Just OpenApiBoolean -> Bool <$> elements [True, False]

45− Just OpenApiNull -> pure Null

46− Just OpenApiNumber

42+ Just SwaggerBoolean -> Bool <$> elements [True, False]

43+ Just SwaggerNull -> pure Null

44+ Just SwaggerNumber

4745 | Just min <- schema ^. minimum_

4846 , Just max <- schema ^. maximum_ ->

4947 Number . fromFloatDigits <$>

5048 choose (toRealFloat min, toRealFloat max :: Double)

5149 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)

52− Just OpenApiInteger

50+ Just SwaggerInteger

5351 | Just min <- schema ^. minimum_

5452 , Just max <- schema ^. maximum_ ->

5553 Number . fromInteger <$>

5654 choose (truncate min, truncate max)

5755 | otherwise -> Number . fromInteger <$> arbitrary

58− Just OpenApiArray

56+ Just SwaggerArray

5957 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty

6058 | Just items <- schema ^. items ->

6159 case items of

62− OpenApiItemsObject ref -> do

60+ SwaggerItemsObject ref -> do

6361 size <- getSize

6462 let itemSchema = dereference defns ref

6563 minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems

@@ -67,17 +65,17 @@ schemaGen defns schema =

6765 arrayLength <- choose (minLength', max minLength' maxLength')

6866 generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema

6967 return . Array $ V.fromList generatedArray

70− OpenApiItemsArray refs ->

68+ SwaggerItemsArray refs ->

7169 let itemGens = schemaGen defns . dereference defns <$> refs

7270 in fmap (Array . V.fromList) $ sequence itemGens

73− Just OpenApiString -> do

71+ Just SwaggerString -> do

7472 size <- getSize

7573 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength

7674 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength

7775 length <- choose (minLength', max minLength' maxLength')

7876 str <- vectorOf length arbitrary

7977 return . String $ T.pack str

80− Just OpenApiObject -> do

78+ Just SwaggerObject -> do

8179 size <- getSize

8280 let props = dereference defns <$> schema ^. properties

8381 reqKeys = S.fromList $ schema ^. required

@@ -97,7 +95,7 @@ schemaGen defns schema =

9795 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)

9896 _ -> return []

9997 x <- sequence $ gens <> additionalGens

100− return . Object $ fromInsOrdHashMap x

98+ return . Object $ M.toHashMap x

10199

102100dereference :: Definitions a -> Referenced a -> a

103101dereference _ (Inline a) = a

src/Data/OpenApi/Schema/Validation.hs → src/Data/Swagger/Schema/Validation.hsrenamed+7−7

@@ -1,10 +1,10 @@

11-- |

2−-- Module: Data.OpenApi.Schema.Validation

2+-- Module: Data.Swagger.Schema.Validation

33-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>

44-- Stability: experimental

55--

66-- Validate JSON values with Swagger Schema.

7−module Data.OpenApi.Schema.Validation (

7+module Data.Swagger.Schema.Validation (

88 -- * How to use validation

99 -- $howto

1010

@@ -29,13 +29,13 @@ module Data.OpenApi.Schema.Validation (

2929 validateJSONWithPatternChecker,

3030) where

3131

32−import Data.OpenApi.Internal.Schema.Validation

32+import Data.Swagger.Internal.Schema.Validation

3333

3434-- $setup

3535-- >>> import Control.Lens

3636-- >>> import Data.Aeson

3737-- >>> import Data.Proxy

38−-- >>> import Data.OpenApi

38+-- >>> import Data.Swagger

3939-- >>> import GHC.Generics

4040-- >>> :set -XDeriveGeneric

4141

@@ -71,11 +71,11 @@ import Data.OpenApi.Internal.Schema.Validation

7171-- generally fails for @null@ JSON:

7272--

7373-- >>> validateToJSON (Nothing :: Maybe String)

74−-- ["expected JSON value of type OpenApiString"]

74+-- ["expected JSON value of type SwaggerString"]

7575-- >>> validateToJSON ([Just "hello", Nothing] :: [Maybe String])

76−-- ["expected JSON value of type OpenApiString"]

76+-- ["expected JSON value of type SwaggerString"]

7777-- >>> validateToJSON (123, Nothing :: Maybe String)

78−-- ["expected JSON value of type OpenApiString"]

78+-- ["expected JSON value of type SwaggerString"]

7979--

8080-- However, when @'Maybe' a@ is a type of a record field,

8181-- validation takes @'required'@ property of the @'Schema'@

src/Data/OpenApi/SchemaOptions.hs → src/Data/Swagger/SchemaOptions.hsrenamed+2−2

@@ -1,11 +1,11 @@

11{-# LANGUAGE RecordWildCards #-}

22-- |

3−-- Module: Data.OpenApi.SchemaOptions

3+-- Module: Data.Swagger.SchemaOptions

44-- Maintainer: Nickolay Kudasov <nickolay@getshoptv.com>

55-- Stability: experimental

66--

77-- Generic deriving options for @'ToParamSchema'@ and @'ToSchema'@.

8−module Data.OpenApi.SchemaOptions where

8+module Data.Swagger.SchemaOptions where

1010import qualified Data.Aeson.Types as Aeson

1111

stack.yaml+1−1

@@ -1,4 +1,4 @@

1−resolver: lts-16.31

1+resolver: lts-15.1

22packages:

33- '.'

44extra-deps:

openapi3.cabal → swagger2.cabalrenamed+52−62

@@ -1,22 +1,22 @@

11cabal-version: >=1.10

2−name: openapi3

3−version: 3.2.2

2+name: swagger2

3+version: 2.6.1

5−synopsis: OpenAPI 3.0 data model

6−category: Web, Swagger, OpenApi

5+synopsis: Swagger 2.0 data model

6+category: Web, Swagger

77description:

8− This library is intended to be used for decoding and encoding OpenAPI 3.0 API

8+ This library is intended to be used for decoding and encoding Swagger 2.0 API

99 specifications as well as manipulating them.

1010 .

11− The original OpenAPI 3.0 specification is available at http://swagger.io/specification/.

11+ The original Swagger 2.0 specification is available at http://swagger.io/specification/.

1212

13−homepage: https://github.com/biocad/openapi3

14−bug-reports: https://github.com/biocad/openapi3/issues

13+homepage: https://github.com/GetShopTV/swagger2

14+bug-reports: https://github.com/GetShopTV/swagger2/issues

1515license: BSD3

1616license-file: LICENSE

17−author: Nickolay Kudasov, Maxim Koltsov

18−maintainer: nickolay@getshoptv.com, kolmax94@gmail.com

17+author: Nickolay Kudasov

18+maintainer: nickolay@getshoptv.com

2020build-type: Custom

2121extra-source-files:

2222 README.md

@@ -25,10 +25,8 @@ extra-source-files:

2525tested-with:

2626 GHC ==8.4.4

2727 || ==8.6.5

28− || ==8.8.4

29− || ==8.10.7

30− || ==9.0.2

31− || ==9.2.2

28+ || ==8.8.3

29+ || ==8.10.1

3230

3331custom-setup

3432 setup-depends:

@@ -37,56 +35,54 @@ custom-setup

3735library

3836 hs-source-dirs: src

3937 exposed-modules:

40− Data.OpenApi

41− Data.OpenApi.Declare

42− Data.OpenApi.Lens

43− Data.OpenApi.Operation

44− Data.OpenApi.Optics

45− Data.OpenApi.ParamSchema

46− Data.OpenApi.Schema

47− Data.OpenApi.Schema.Generator

48− Data.OpenApi.Schema.Validation

49− Data.OpenApi.SchemaOptions

38+ Data.Swagger

39+ Data.Swagger.Declare

40+ Data.Swagger.Lens

41+ Data.Swagger.Operation

42+ Data.Swagger.Optics

43+ Data.Swagger.ParamSchema

44+ Data.Swagger.Schema

45+ Data.Swagger.Schema.Generator

46+ Data.Swagger.Schema.Validation

47+ Data.Swagger.SchemaOptions

5048

5149 -- internal modules

52− Data.OpenApi.Internal

53− Data.OpenApi.Internal.Schema

54− Data.OpenApi.Internal.Schema.Validation

55− Data.OpenApi.Internal.ParamSchema

56− Data.OpenApi.Internal.Utils

57− Data.OpenApi.Internal.AesonUtils

58− Data.OpenApi.Internal.TypeShape

59−

60− Data.OpenApi.Aeson.Compat

50+ Data.Swagger.Internal

51+ Data.Swagger.Internal.Schema

52+ Data.Swagger.Internal.Schema.Validation

53+ Data.Swagger.Internal.ParamSchema

54+ Data.Swagger.Internal.Utils

55+ Data.Swagger.Internal.AesonUtils

56+ Data.Swagger.Internal.TypeShape

6157

6258 -- GHC boot libraries

6359 build-depends:

64− base >=4.11.1.0 && <4.17

65− , bytestring >=0.10.8.2 && <0.12

60+ base >=4.11.1.0 && <4.15

61+ , bytestring >=0.10.8.2 && <0.11

6662 , containers >=0.5.11.0 && <0.7

67− , template-haskell >=2.13.0.0 && <2.19

68− , time >=1.8.0.2 && <1.14

63+ , template-haskell >=2.13.0.0 && <2.17

64+ , time >=1.8.0.2 && <1.10

6965 , transformers >=0.5.5.0 && <0.6

7066

7167 build-depends:

7268 mtl >=2.2.2 && <2.3

73− , text >=1.2.3.1 && <2.1

69+ , text >=1.2.3.1 && <1.3

7470

7571 -- other dependencies

7672 build-depends:

77− base-compat-batteries >=0.11.1 && <0.13

78− , aeson >=1.4.2.0 && <1.6 || >=2.0.1.0 && < 2.1

73+ base-compat-batteries >=0.11.1 && <0.12

74+ , aeson >=1.4.2.0 && <1.6

7975 , aeson-pretty >=0.8.7 && <0.9

8076 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint

8177 , cookie >=0.4.3 && <0.5

8278 , generics-sop >=0.5.1.0 && <0.6

83− , hashable >=1.2.7.0 && <1.5

79+ , hashable >=1.2.7.0 && <1.4

8480 , http-media >=0.8.0.0 && <0.9

8581 , insert-ordered-containers >=0.2.3 && <0.3

86− , lens >=4.16.1 && <5.2

82+ , lens >=4.16.1 && <4.20

8783 , network >=2.6.3.5 && <3.2

88− , optics-core >=0.2 && <0.5

89− , optics-th >=0.2 && <0.5

84+ , optics-core >=0.2 && <0.4

85+ , optics-th >=0.2 && <0.4

9086 , scientific >=0.3.6.2 && <0.4

9187 , unordered-containers >=0.2.9.0 && <0.3

9288 , uuid-types >=1.0.3 && <1.1

@@ -104,7 +100,7 @@ test-suite spec

104100 -- We need aeson's toEncoding for doctests too

105101 build-depends:

106102 base

107− , QuickCheck

103+ , swagger2

108104 , aeson

109105 , base-compat-batteries

110106 , bytestring

@@ -113,32 +109,32 @@ test-suite spec

113109 , insert-ordered-containers

114110 , lens

115111 , mtl

116− , openapi3

117112 , template-haskell

118113 , text

119114 , time

120115 , unordered-containers

121116 , vector

117+ , QuickCheck

122118

123119 -- test-suite only dependencies

124120 build-depends:

125− hspec >=2.5.5 && <2.10

121+ hspec >=2.5.5 && <2.8

126122 , HUnit >=1.6.0.0 && <1.7

127123 , quickcheck-instances >=0.3.19 && <0.14

128124 , utf8-string >=1.0.1.1 && <1.1

129125

130126 -- https://github.com/haskell/cabal/issues/3708

131127 build-tool-depends:

132− hspec-discover:hspec-discover >=2.5.5 && <2.10

128+ hspec-discover:hspec-discover >=2.5.5 && <2.8

133129

134130 other-modules:

135131 SpecCommon

136− Data.OpenApiSpec

137− Data.OpenApi.CommonTestTypes

138− Data.OpenApi.ParamSchemaSpec

139− Data.OpenApi.SchemaSpec

140− Data.OpenApi.Schema.ValidationSpec

141− Data.OpenApi.Schema.GeneratorSpec

132+ Data.SwaggerSpec

133+ Data.Swagger.CommonTestTypes

134+ Data.Swagger.ParamSchemaSpec

135+ Data.Swagger.SchemaSpec

136+ Data.Swagger.Schema.ValidationSpec

137+ Data.Swagger.Schema.GeneratorSpec

142138 default-language: Haskell2010

143139

144140test-suite doctests

@@ -149,12 +145,6 @@ test-suite doctests

149145 main-is: doctests.hs

150146 type: exitcode-stdio-1.0

151147

152−executable example

153− hs-source-dirs: examples

154− main-is: hackage.hs

155− default-language: Haskell2010

156− build-depends: base, aeson, lens, openapi3, text

157−

158148source-repository head

159149 type: git

160− location: https://github.com/biocad/openapi3.git

150+ location: https://github.com/GetShopTV/swagger2.git

test/Data/OpenApi/CommonTestTypes.hs → test/Data/Swagger/CommonTestTypes.hsrenamed+2−125

@@ -2,7 +2,7 @@

22{-# LANGUAGE QuasiQuotes #-}

33{-# LANGUAGE ScopedTypeVariables #-}

5−module Data.OpenApi.CommonTestTypes where

5+module Data.Swagger.CommonTestTypes where

77import Prelude ()

88import Prelude.Compat

@@ -18,7 +18,7 @@ import qualified Data.Text as Text

1818import Data.Word

1919import GHC.Generics

2020

21−import Data.OpenApi

21+import Data.Swagger

2222

2323-- ========================================================================

2424-- Unit type

@@ -863,129 +863,6 @@ singleMaybeFieldSchemaJSON = [aesonQQ|

863863}

864864|]

865865

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−|]

989866

990867-- ========================================================================

991868-- TimeOfDay

test/Data/OpenApi/ParamSchemaSpec.hs → test/Data/Swagger/ParamSchemaSpec.hsrenamed+4−4

@@ -4,7 +4,7 @@

44{-# LANGUAGE TemplateHaskell #-}

55{-# LANGUAGE QuasiQuotes #-}

66{-# LANGUAGE OverloadedStrings #-}

7−module Data.OpenApi.ParamSchemaSpec where

7+module Data.Swagger.ParamSchemaSpec where

99import Data.Aeson

1010import Data.Aeson.QQ.Simple

@@ -12,9 +12,9 @@ import Data.Char

1212import Data.Proxy

1313import GHC.Generics

1414

15−import Data.OpenApi

15+import Data.Swagger

1616

17−import Data.OpenApi.CommonTestTypes

17+import Data.Swagger.CommonTestTypes

1818import SpecCommon

1919import Test.Hspec

2020import Data.Time.LocalTime

@@ -22,7 +22,7 @@ import Data.Time.LocalTime

2222import qualified Data.HashMap.Strict as HM

2323

2424checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec

25−checkToParamSchema proxy js = (toParamSchema proxy :: Schema) <=> js

25+checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema) <=> js

2626

2727spec :: Spec

2828spec = do

test/Data/OpenApi/Schema/GeneratorSpec.hs → test/Data/Swagger/Schema/GeneratorSpec.hsrenamed+7−7

@@ -1,13 +1,13 @@

11{-# LANGUAGE OverloadedLists #-}

22{-# LANGUAGE OverloadedStrings #-}

33{-# LANGUAGE PackageImports #-}

4−module Data.OpenApi.Schema.GeneratorSpec where

4+module Data.Swagger.Schema.GeneratorSpec where

66import Prelude ()

77import Prelude.Compat

9−import Data.OpenApi

10−import Data.OpenApi.Schema.Generator

9+import Data.Swagger

10+import Data.Swagger.Schema.Generator

1111

1212import Control.Lens.Operators

1313import Data.Aeson

@@ -103,7 +103,7 @@ instance FromJSON WrongType where

103103instance ToSchema WrongType where

104104 declareNamedSchema _ = return . NamedSchema (Just "WrongType") $

105105 mempty

106− & type_ ?~ OpenApiObject

106+ & type_ ?~ SwaggerObject

107107

108108

109109data MissingRequired = MissingRequired

@@ -123,7 +123,7 @@ instance ToSchema MissingRequired where

123123 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)

124124 return . NamedSchema (Just "MissingRequired") $

125125 mempty

126− & type_ ?~ OpenApiObject

126+ & type_ ?~ SwaggerObject

127127 & properties .~ [("propA", stringSchema)

128128 ,("propB", boolSchema)

129129 ]

@@ -145,7 +145,7 @@ instance ToSchema MissingProperty where

145145 stringSchema <- declareSchemaRef (Proxy :: Proxy String)

146146 return . NamedSchema (Just "MissingProperty") $

147147 mempty

148− & type_ ?~ OpenApiObject

148+ & type_ ?~ SwaggerObject

149149 & properties .~ [("propC", stringSchema)]

150150 & required .~ ["propC"]

151151

@@ -163,6 +163,6 @@ instance ToSchema WrongPropType where

163163 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)

164164 return . NamedSchema (Just "WrongPropType") $

165165 mempty

166− & type_ ?~ OpenApiObject

166+ & type_ ?~ SwaggerObject

167167 & properties .~ [("propE", boolSchema)]

168168 & required .~ ["propE"]

test/Data/OpenApi/Schema/ValidationSpec.hs → test/Data/Swagger/Schema/ValidationSpec.hsrenamed+10−27

@@ -1,18 +1,13 @@

1−{-# LANGUAGE CPP #-}

21{-# LANGUAGE DeriveGeneric #-}

32{-# LANGUAGE PackageImports #-}

43{-# LANGUAGE RecordWildCards #-}

54{-# LANGUAGE ScopedTypeVariables #-}

65{-# OPTIONS_GHC -fno-warn-orphans #-}

7−module Data.OpenApi.Schema.ValidationSpec where

6+module Data.Swagger.Schema.ValidationSpec where

98import Control.Applicative

109import Control.Lens ((&), (.~), (?~))

1110import 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

1611import Data.Aeson.Types

1712import Data.Hashable (Hashable)

1813import Data.HashMap.Strict (HashMap)

@@ -33,9 +28,8 @@ import Data.Version (Version)

3328import Data.Word

3429import GHC.Generics

3530

36−import Data.OpenApi

37−import Data.OpenApi.Declare

38−import Data.OpenApi.Aeson.Compat (stringToKey)

31+import Data.Swagger

32+import Data.Swagger.Declare

3933

4034import Test.Hspec

4135import Test.Hspec.QuickCheck

@@ -130,9 +124,9 @@ instance Arbitrary Person where

130124

131125invalidPersonToJSON :: Person -> Value

132126invalidPersonToJSON Person{..} = object

133− [ stringToKey "personName" .= toJSON name

134− , stringToKey "personPhone" .= toJSON phone

135− , stringToKey "personEmail" .= toJSON email

127+ [ T.pack "personName" .= toJSON name

128+ , T.pack "personPhone" .= toJSON phone

129+ , T.pack "personEmail" .= toJSON email

136130 ]

137131

138132-- ========================================================================

@@ -196,7 +190,7 @@ instance Arbitrary MyRoseTree where

196190data Light = NoLight | LightFreq Double | LightColor Color deriving (Show, Generic)

197191

198192instance ToSchema Light where

199− declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = ObjectWithSingleField }

193+ declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions { Data.Swagger.sumEncoding = ObjectWithSingleField }

200194

201195instance ToJSON Light where

202196 toJSON = genericToJSON defaultOptions { Data.Aeson.Types.sumEncoding = ObjectWithSingleField }

@@ -221,7 +215,7 @@ instance ToJSON LightTaggedObject where

221215

222216instance ToSchema LightTaggedObject where

223217 declareNamedSchema _ =

224− genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = defaultTaggedObject } (Proxy :: Proxy Light)

218+ genericDeclareNamedSchema defaultSchemaOptions { Data.Swagger.sumEncoding = defaultTaggedObject } (Proxy :: Proxy Light)

225219

226220instance Arbitrary LightTaggedObject where

227221 arbitrary = LightTaggedObject <$> arbitrary

@@ -234,7 +228,7 @@ instance ToJSON LightUntaggedValue where

234228

235229instance ToSchema LightUntaggedValue where

236230 declareNamedSchema _ =

237− genericDeclareNamedSchema defaultSchemaOptions { Data.OpenApi.sumEncoding = UntaggedValue } (Proxy :: Proxy Light)

231+ genericDeclareNamedSchema defaultSchemaOptions { Data.Swagger.sumEncoding = UntaggedValue } (Proxy :: Proxy Light)

238232

239233instance Arbitrary LightUntaggedValue where

240234 arbitrary = LightUntaggedValue <$> arbitrary

@@ -283,7 +277,7 @@ instance ToJSON FreeForm where

283277

284278instance ToSchema FreeForm where

285279 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty

286− & type_ ?~ OpenApiObject

280+ & type_ ?~ SwaggerObject

287281 & additionalProperties ?~ AdditionalPropertiesAllowed True

288282

289283instance Arbitrary FreeForm where

@@ -301,8 +295,6 @@ instance Eq ZonedTime where

301295-- Arbitrary instance for Data.Aeson.Value

302296-- ========================================================================

303297

304−-- These instances were introduces in aeson upstream in 2.0.3

305−#if !MIN_VERSION_aeson(2,0,3)

306298instance Arbitrary Value where

307299 -- Weights are almost random

308300 -- Uniform oneof tends not to build complex objects cause of recursive call.

@@ -313,12 +305,3 @@ instance Arbitrary Value where

313305 , (3, Number <$> arbitrary)

314306 , (3, Bool <$> arbitrary)

315307 , (1, return Null) ]

316−

317−#if MIN_VERSION_aeson(2,0,0)

318−instance Arbitrary v => Arbitrary (KeyMap.KeyMap v) where

319− arbitrary = KeyMap.fromList <$> arbitrary

320−

321−instance Arbitrary Key.Key where

322− arbitrary = Key.fromText <$> arbitrary

323−#endif

324−#endif

test/Data/OpenApi/SchemaSpec.hs → test/Data/Swagger/SchemaSpec.hsrenamed+4−8

@@ -2,7 +2,7 @@

22{-# LANGUAGE ScopedTypeVariables #-}

33{-# LANGUAGE TemplateHaskell #-}

44{-# LANGUAGE QuasiQuotes #-}

5−module Data.OpenApi.SchemaSpec where

5+module Data.Swagger.SchemaSpec where

77import Prelude ()

88import Prelude.Compat

@@ -14,10 +14,10 @@ import Data.Proxy

1414import Data.Set (Set)

1515import qualified Data.Text as Text

1616

17−import Data.OpenApi

18−import Data.OpenApi.Declare

17+import Data.Swagger

18+import Data.Swagger.Declare

1919

20−import Data.OpenApi.CommonTestTypes

20+import Data.Swagger.CommonTestTypes

2121import SpecCommon

2222import Test.Hspec

2323

@@ -59,9 +59,6 @@ checkInlinedRecSchema proxy js = inlineNonRecursiveSchemas defs s <=> js

5959 where

6060 (defs, s) = runDeclare (declareSchema proxy) mempty

6161

62−checkToSchemaDeclare :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec

63−checkToSchemaDeclare proxy js = runDeclare (declareSchemaRef proxy) mempty <=> js

64−

6562spec :: Spec

6663spec = do

6764 describe "Generic ToSchema" $ do

@@ -81,7 +78,6 @@ spec = do

8178 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON

8279 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON

8380 context "SingleMaybeField (unary record with Maybe)" $ checkToSchema (Proxy :: Proxy SingleMaybeField) singleMaybeFieldSchemaJSON

84− context "Natural Language (single field data with recursive fields)" $ checkToSchemaDeclare (Proxy :: Proxy Predicate) predicateSchemaDeclareJSON

8581 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON

8682 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON

8783 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'

test/Data/OpenApiSpec.hs → test/Data/SwaggerSpec.hsrenamed+36−52

@@ -2,7 +2,7 @@

22{-# LANGUAGE OverloadedStrings #-}

33{-# LANGUAGE ScopedTypeVariables #-}

44{-# LANGUAGE QuasiQuotes #-}

5−module Data.OpenApiSpec where

5+module Data.SwaggerSpec where

77import Prelude ()

88import Prelude.Compat

@@ -15,7 +15,7 @@ import Data.HashMap.Strict (HashMap)

1515import qualified Data.HashSet.InsOrd as InsOrdHS

1616import Data.Text (Text)

1717

18−import Data.OpenApi

18+import Data.Swagger

1919import SpecCommon

2020import Test.Hspec hiding (example)

2121

@@ -42,13 +42,9 @@ spec = do

4242 context "Todo Example" $ swaggerExample <=> swaggerExampleJSON

4343 context "PetStore Example" $ do

4444 it "decodes successfully" $ do

45− fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)

45+ fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: Swagger) -> True; _ -> False)

4646 it "roundtrips: fmap toJSON . fromJSON" $ do

47− (toJSON :: OpenApi -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON

48− context "Security schemes" $ do

49− it "merged correctly" $ do

50− let merged = oAuth2SecurityDefinitionsReadOpenApi <> oAuth2SecurityDefinitionsWriteOpenApi

51− merged `shouldBe` oAuth2SecurityDefinitionsOpenApi

47+ (toJSON :: Swagger -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON

5248

5349main :: IO ()

5450main = hspec spec

@@ -136,15 +132,15 @@ operationExample = mempty

136132 & description ?~ "ID of pet that needs to be updated"

137133 & required ?~ True

138134 & in_ .~ ParamPath

139− & schema ?~ Inline (mempty & type_ ?~ OpenApiString))]

135+ & schema ?~ Inline (mempty & type_ ?~ SwaggerString))]

140136 & requestBody ?~ Inline (

141137 mempty & content . at "application/x-www-form-urlencoded" ?~ (mempty & schema ?~ (Inline (mempty

142138 & properties . at "petId" ?~ Inline (mempty

143139 & description ?~ "Updated name of the pet"

144− & type_ ?~ OpenApiString)

140+ & type_ ?~ SwaggerString)

145141 & properties . at "status" ?~ Inline (mempty

146142 & description ?~ "Updated status of the pet"

147− & type_ ?~ OpenApiString)))))

143+ & type_ ?~ SwaggerString)))))

148144 & at 200 ?~ "Pet updated."

149145 & at 405 ?~ "Invalid input"

150146 & security .~ [SecurityRequirement [("petstore_auth", ["write:pets", "read:pets"])]]

@@ -212,7 +208,7 @@ operationExampleJSON = [aesonQQ|

212208

213209schemaPrimitiveExample :: Schema

214210schemaPrimitiveExample = mempty

215− & type_ ?~ OpenApiString

211+ & type_ ?~ SwaggerString

216212 & format ?~ "email"

217213

218214schemaPrimitiveExampleJSON :: Value

@@ -225,14 +221,14 @@ schemaPrimitiveExampleJSON = [aesonQQ|

225221

226222schemaSimpleModelExample :: Schema

227223schemaSimpleModelExample = mempty

228− & type_ ?~ OpenApiObject

224+ & type_ ?~ SwaggerObject

229225 & required .~ [ "name" ]

230226 & properties .~

231− [ ("name", Inline (mempty & type_ ?~ OpenApiString))

227+ [ ("name", Inline (mempty & type_ ?~ SwaggerString))

232228 , ("address", Ref (Reference "Address"))

233229 , ("age", Inline $ mempty

234230 & minimum_ ?~ 0

235− & type_ ?~ OpenApiInteger

231+ & type_ ?~ SwaggerInteger

236232 & format ?~ "int32" ) ]

237233

238234schemaSimpleModelExampleJSON :: Value

@@ -257,8 +253,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|

257253

258254schemaModelDictExample :: Schema

259255schemaModelDictExample = mempty

260− & type_ ?~ OpenApiObject

261− & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ OpenApiString))

256+ & type_ ?~ SwaggerObject

257+ & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ SwaggerString))

262258

263259schemaModelDictExampleJSON :: Value

264260schemaModelDictExampleJSON = [aesonQQ|

@@ -272,7 +268,7 @@ schemaModelDictExampleJSON = [aesonQQ|

272268

273269schemaAdditionalExample :: Schema

274270schemaAdditionalExample = mempty

275− & type_ ?~ OpenApiObject

271+ & type_ ?~ SwaggerObject

276272 & additionalProperties ?~ AdditionalPropertiesAllowed True

277273

278274schemaAdditionalExampleJSON :: Value

@@ -285,13 +281,13 @@ schemaAdditionalExampleJSON = [aesonQQ|

285281

286282schemaWithExampleExample :: Schema

287283schemaWithExampleExample = mempty

288− & type_ ?~ OpenApiObject

284+ & type_ ?~ SwaggerObject

289285 & properties .~

290286 [ ("id", Inline $ mempty

291− & type_ ?~ OpenApiInteger

287+ & type_ ?~ SwaggerInteger

292288 & format ?~ "int64" )

293289 , ("name", Inline $ mempty

294− & type_ ?~ OpenApiString) ]

290+ & type_ ?~ SwaggerString) ]

295291 & required .~ [ "name" ]

296292 & example ?~ [aesonQQ|

297293 {

@@ -330,19 +326,19 @@ schemaWithExampleExampleJSON = [aesonQQ|

330326definitionsExample :: HashMap Text Schema

331327definitionsExample =

332328 [ ("Category", mempty

333− & type_ ?~ OpenApiObject

329+ & type_ ?~ SwaggerObject

334330 & properties .~

335331 [ ("id", Inline $ mempty

336− & type_ ?~ OpenApiInteger

332+ & type_ ?~ SwaggerInteger

337333 & format ?~ "int64")

338− , ("name", Inline (mempty & type_ ?~ OpenApiString)) ] )

334+ , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] )

339335 , ("Tag", mempty

340− & type_ ?~ OpenApiObject

336+ & type_ ?~ SwaggerObject

341337 & properties .~

342338 [ ("id", Inline $ mempty

343− & type_ ?~ OpenApiInteger

339+ & type_ ?~ SwaggerInteger

344340 & format ?~ "int64")

345− , ("name", Inline (mempty & type_ ?~ OpenApiString)) ] ) ]

341+ , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] ) ]

346342

347343definitionsExampleJSON :: Value

348344definitionsExampleJSON = [aesonQQ|

@@ -386,7 +382,7 @@ paramsDefinitionExample =

386382 & required ?~ True

387383 & in_ .~ ParamQuery

388384 & schema ?~ Inline (mempty

389− & type_ ?~ OpenApiInteger

385+ & type_ ?~ SwaggerInteger

390386 & format ?~ "int32" ))

391387 , ("limitParam", mempty

392388 & name .~ "limit"

@@ -394,7 +390,7 @@ paramsDefinitionExample =

394390 & required ?~ True

395391 & in_ .~ ParamQuery

396392 & schema ?~ Inline (mempty

397− & type_ ?~ OpenApiInteger

393+ & type_ ?~ SwaggerInteger

398394 & format ?~ "int32" )) ]

399395

400396paramsDefinitionExampleJSON :: Value

@@ -445,7 +441,7 @@ responsesDefinitionExampleJSON = [aesonQQ|

445441|]

446442

447443-- =======================================================================

448−-- Security Definition object

444+-- Responses Definition object

449445-- =======================================================================

450446

451447securityDefinitionsExample :: SecurityDefinitions

@@ -531,23 +527,11 @@ oAuth2SecurityDefinitionsExampleJSON = [aesonQQ|

531527}

532528|]

533529

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−

546530-- =======================================================================

547531-- Swagger object

548532-- =======================================================================

549533

550−emptyPathsFieldExample :: OpenApi

534+emptyPathsFieldExample :: Swagger

551535emptyPathsFieldExample = mempty

552536

553537emptyPathsFieldExampleJSON :: Value

@@ -560,7 +544,7 @@ emptyPathsFieldExampleJSON = [aesonQQ|

560544}

561545|]

562546

563−swaggerExample :: OpenApi

547+swaggerExample :: Swagger

564548swaggerExample = mempty

565549 -- & basePath ?~ "/"

566550 -- & schemes ?~ [Http]

@@ -575,7 +559,7 @@ swaggerExample = mempty

575559 & description .~ "OK"

576560 & content . at "application/json" ?~ (mempty

577561 & schema ?~ Inline (mempty

578− & type_ ?~ OpenApiObject

562+ & type_ ?~ SwaggerObject

579563 & example ?~ [aesonQQ|

580564 {

581565 "created": 100,

@@ -584,9 +568,9 @@ swaggerExample = mempty

584568 & description ?~ "This is some real Todo right here"

585569 & properties .~

586570 [ ("created", Inline $ mempty

587− & type_ ?~ OpenApiInteger

571+ & type_ ?~ SwaggerInteger

588572 & format ?~ "int32")

589− , ("description", Inline (mempty & type_ ?~ OpenApiString))])))

573+ , ("description", Inline (mempty & type_ ?~ SwaggerString))])))

590574 & parameters .~

591575 [ Inline $ mempty

592576 & required ?~ True

@@ -594,7 +578,7 @@ swaggerExample = mempty

594578 & description ?~ "TodoId param"

595579 & in_ .~ ParamPath

596580 & schema ?~ Inline (mempty

597− & type_ ?~ OpenApiString ) ]

581+ & type_ ?~ SwaggerString ) ]

598582 & tags .~ InsOrdHS.fromList [ "todo" ] ))

599583

600584swaggerExampleJSON :: Value

@@ -933,14 +917,14 @@ petstoreExampleJSON = [aesonQQ|

933917

934918compositionSchemaExample :: Schema

935919compositionSchemaExample = mempty

936− & type_ ?~ OpenApiObject

937− & Data.OpenApi.allOf ?~ [

920+ & type_ ?~ SwaggerObject

921+ & Data.Swagger.allOf ?~ [

938922 Ref (Reference "Other")

939923 , Inline (mempty

940− & type_ ?~ OpenApiObject

924+ & type_ ?~ SwaggerObject

941925 & properties .~

942926 [ ("greet", Inline $ mempty

943− & type_ ?~ OpenApiString) ])

927+ & type_ ?~ SwaggerString) ])

944928 ]

945929

946930compositionSchemaExampleJSON :: Value

test/SpecCommon.hs+8

@@ -8,6 +8,14 @@ import qualified Data.Vector as Vector

99import Test.Hspec

1010

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+

1119(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec

1220x <=> js = do

1321 it "encodes correctly" $ do