master..af7392f · typeable/swagger2

git.iko.soy/typeable/swagger2

29 files changed+447−1880

unifiedsplit

.ghci−1 .travis.yml+87−134 CHANGELOG.md−67 aeson-0.11.cabal.config+1 cabal.project−2 examples/hackage.hs+1−1 src/Data/Swagger.hs+4−10 src/Data/Swagger/Declare.hs+5−4 src/Data/Swagger/Internal.hs+12−100 src/Data/Swagger/Internal/AesonUtils.hs+3−16 src/Data/Swagger/Internal/ParamSchema.hs+26−44 src/Data/Swagger/Internal/Schema.hs+73−85 src/Data/Swagger/Internal/Schema/Validation.hs+50−212 src/Data/Swagger/Internal/Utils.hs+1 src/Data/Swagger/Lens.hs+4−10 src/Data/Swagger/Operation.hs+5−5 src/Data/Swagger/Optics.hs−597 src/Data/Swagger/Schema/Generator.hs−114 src/Data/Swagger/Schema/Validation.hs−2 stack-ghc-8.0.yaml+5 stack-lts-2.yaml+22 stack.yaml+2−6 swagger2.cabal+55−82 test/Data/Swagger/CommonTestTypes.hs+18−45 test/Data/Swagger/ParamSchemaSpec.hs+2−7 test/Data/Swagger/Schema/GeneratorSpec.hs−168 test/Data/Swagger/Schema/ValidationSpec.hs+34−77 test/Data/Swagger/SchemaSpec.hs+6−5 test/Data/SwaggerSpec.hs+31−86

.ghci−1

@@ -1,2 +1 @@

11:set -itest -isrc -optP-include -optP.stack-work/dist/x86_64-linux/Cabal-1.24.2.0/build/autogen/cabal_macros.h -optP-I -optPinclude

2−:set -hide-package base-compat-0.10.4

.travis.yml+87−134

@@ -1,162 +1,115 @@

11# This Travis job script has been generated by a script via

22#

3−# haskell-ci '--branches' 'master' '--haddock-jobs=>=8.4' '--output' '.travis.yml' 'swagger2.cabal'

3+# runghc make_travis_yml_2.hs '--branch' 'master' '--output' '.travis.yml' 'swagger2.cabal'

44#

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

6−#

7−# version: 0.5.20191020

5+# For more information, see https://github.com/hvr/multi-ghc-travis

86#

97language: c

10−dist: xenial

8+sudo: false

1110git:

12− # whether to recursively clone submodules

13− submodules: false

11+ submodules: false # whether to recursively clone submodules

12+

1413branches:

1514 only:

1615 - master

16+

1717cache:

1818 directories:

1919 - $HOME/.cabal/packages

2020 - $HOME/.cabal/store

21+

2122before_cache:

22− - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log

23+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/build-reports.log

2324 # remove files that are regenerated by 'cabal update'

24− - rm -fv $CABALHOME/packages/hackage.haskell.org/00-index.*

25− - rm -fv $CABALHOME/packages/hackage.haskell.org/*.json

26− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache

27− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar

28− - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx

29− - rm -rfv $CABALHOME/packages/head.hackage

25+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/00-index.*

26+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/*.json

27+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.cache

28+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar

29+ - rm -fv $HOME/.cabal/packages/hackage.haskell.org/01-index.tar.idx

30+

31+ - rm -rfv $HOME/.cabal/packages/head.hackage

32+

3033matrix:

3134 include:

32− - compiler: ghc-8.8.1

33− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.8.1","cabal-install-3.0"]}}

34− - compiler: ghc-8.6.5

35− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.6.5","cabal-install-3.0"]}}

36− - compiler: ghc-8.4.4

37− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.4.4","cabal-install-3.0"]}}

38− - compiler: ghc-8.2.2

39− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.2.2","cabal-install-3.0"]}}

40− - compiler: ghc-8.0.2

41− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-8.0.2","cabal-install-3.0"]}}

35+ - compiler: "ghc-7.8.4"

36+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

37+ env: HADDOCK=false

38+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.8.4], sources: [hvr-ghc]}}

39+ - compiler: "ghc-7.10.3"

40+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

41+ env: HADDOCK=false

42+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-7.10.3], sources: [hvr-ghc]}}

43+ - compiler: "ghc-8.0.2"

44+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

45+ env: HADDOCK=false

46+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.0.2], sources: [hvr-ghc]}}

47+ - compiler: "ghc-8.2.2"

48+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

49+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.2.2], sources: [hvr-ghc]}}

50+ - compiler: "ghc-8.4.1"

51+ # env: TEST=--disable-tests BENCH=--disable-benchmarks

52+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-head,ghc-8.4.1], sources: [hvr-ghc]}}

53+

4254before_install:

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

44− - WITHCOMPILER="-w $HC"

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

46− - HCPKG="$HC-pkg"

55+ - HC=${CC}

56+ - HCPKG=${HC/ghc/ghc-pkg}

4757 - unset CC

48− - CABAL=/opt/ghc/bin/cabal

49− - CABALHOME=$HOME/.cabal

50− - export PATH="$CABALHOME/bin:$PATH"

51− - TOP=$(pwd)

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

58+ - ROOTDIR=$(pwd)

59+ - mkdir -p $HOME/.local/bin

60+ - "PATH=/opt/ghc/bin:/opt/ghc-ppa-tools/bin:$HOME/local/bin:$PATH"

61+ - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))

5362 - echo $HCNUMVER

54− - CABAL="$CABAL -vnormal+nowrap+markoutput"

55− - set -o pipefail

56− - |

57− echo 'function blue(s) { printf "\033[0;34m" s "\033[0m " }' >> .colorful.awk

58− echo 'BEGIN { state = "output"; }' >> .colorful.awk

59− echo '/^-----BEGIN CABAL OUTPUT-----$/ { state = "cabal" }' >> .colorful.awk

60− echo '/^-----END CABAL OUTPUT-----$/ { state = "output" }' >> .colorful.awk

61− echo '!/^(-----BEGIN CABAL OUTPUT-----|-----END CABAL OUTPUT-----)/ {' >> .colorful.awk

62− echo ' if (state == "cabal") {' >> .colorful.awk

63− echo ' print blue($0)' >> .colorful.awk

64− echo ' } else {' >> .colorful.awk

65− echo ' print $0' >> .colorful.awk

66− echo ' }' >> .colorful.awk

67− echo '}' >> .colorful.awk

68− - cat .colorful.awk

69− - |

70− color_cabal_output () {

71− awk -f $TOP/.colorful.awk

72− }

73− - echo text | color_cabal_output

63+

7464install:

75− - ${CABAL} --version

65+ - cabal --version

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

77− - TEST=--enable-tests

78− - BENCH=--enable-benchmarks

79− - HEADHACKAGE=false

80− - rm -f $CABALHOME/config

81− - |

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

83− echo "remote-build-reporting: anonymous" >> $CABALHOME/config

84− echo "write-ghc-environment-files: always" >> $CABALHOME/config

85− echo "remote-repo-cache: $CABALHOME/packages" >> $CABALHOME/config

86− echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config

87− echo "world-file: $CABALHOME/world" >> $CABALHOME/config

88− echo "extra-prog-path: $CABALHOME/bin" >> $CABALHOME/config

89− echo "symlink-bindir: $CABALHOME/bin" >> $CABALHOME/config

90− echo "installdir: $CABALHOME/bin" >> $CABALHOME/config

91− echo "build-summary: $CABALHOME/logs/build.log" >> $CABALHOME/config

92− echo "store-dir: $CABALHOME/store" >> $CABALHOME/config

93− echo "install-dirs user" >> $CABALHOME/config

94− echo " prefix: $CABALHOME" >> $CABALHOME/config

95− echo "repository hackage.haskell.org" >> $CABALHOME/config

96− echo " url: http://hackage.haskell.org/" >> $CABALHOME/config

97− echo " secure: True" >> $CABALHOME/config

98− echo " key-threshold: 3" >> $CABALHOME/config

99− echo " root-keys:" >> $CABALHOME/config

100− echo " fe331502606802feac15e514d9b9ea83fee8b6ffef71335479a2e68d84adc6b0" >> $CABALHOME/config

101− echo " 1ea9ba32c526d1cc91ab5e5bd364ec5e9e8cb67179a471872f6e26f0ae773d42" >> $CABALHOME/config

102− echo " 2c6c3627bd6c982990239487f1abd02e08a02e6cf16edb105a8012d444d870c3" >> $CABALHOME/config

103− echo " 0a5c7ea47cd1b15f01f5f51a33adda7e655bc0f0b0615baa8e271f4c3351e21d" >> $CABALHOME/config

104− echo " 51f0161b906011b52c6613376b1ae937670da69322113a246a09f807c62f6921" >> $CABALHOME/config

105− - |

106− echo "program-default-options" >> $CABALHOME/config

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

108− - cat $CABALHOME/config

109− - rm -fv cabal.project cabal.project.local cabal.project.freeze

110− - travis_retry ${CABAL} v2-update -v

111− # Generate cabal.project

112− - rm -rf cabal.project cabal.project.local cabal.project.freeze

113− - touch cabal.project

114− - |

115− echo "packages: ." >> cabal.project

116− - |

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

118− - cat cabal.project || true

119− - cat cabal.project.local || true

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

121− - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output

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

123− - rm cabal.project.freeze

124− - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output

125− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output

126−script:

67+ - BENCH=${BENCH---enable-benchmarks}

68+ - TEST=${TEST---enable-tests}

69+ - HADDOCK=${HADDOCK-true}

70+ - INSTALLED=${INSTALLED-true}

71+ - GHCHEAD=${GHCHEAD-false}

72+ - travis_retry cabal update -v

73+ - "sed -i.bak 's/^jobs:/-- jobs:/' ${HOME}/.cabal/config"

74+ - rm -fv cabal.project cabal.project.local

75+ - grep -Ev -- '^\s*--' ${HOME}/.cabal/config | grep -Ev '^\s*$'

76+ - "printf 'packages: \".\"\\n' > cabal.project"

77+ - cat cabal.project

78+ - if [ -f "./configure.ac" ]; then

79+ (cd "." && autoreconf -i);

80+ fi

81+ - rm -f cabal.project.freeze

82+ - cabal new-build -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dep -j2 all

83+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks --project-file="cabal.project" --dep -j2 all

84+ - rm -rf .ghc.environment.* "."/dist

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

128− # Packaging...

129− - ${CABAL} v2-sdist all | color_cabal_output

130− # Unpacking...

131− - mv dist-newstyle/sdist/*.tar.gz ${DISTDIR}/

86+

87+# Here starts the actual work to be performed for the package under test;

88+# any command which exits with a non-zero exit code causes the build to fail.

89+script:

90+ # test that source-distributions can be generated

91+ - (cd "." && cabal sdist)

92+ - mv "."/dist/swagger2-*.tar.gz ${DISTDIR}/

13293 - cd ${DISTDIR} || false

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

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

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

136− # Generate cabal.project

137− - rm -rf cabal.project cabal.project.local cabal.project.freeze

138− - touch cabal.project

139− - |

140− echo "packages: ${PKGDIR_swagger2}" >> cabal.project

141− - |

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

143− - cat cabal.project || true

144− - cat cabal.project.local || true

145− # Building...

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

95+ - "printf 'packages: swagger2-*/*.cabal\\n' > cabal.project"

96+ - cat cabal.project

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

147− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output

148− # Building with tests and benchmarks...

98+ - cabal new-build -w ${HC} --disable-tests --disable-benchmarks all

99+

100+ # Build with installed constraints for packages in global-db

101+ - if $INSTALLED; then echo cabal new-build -w ${HC} --disable-tests --disable-benchmarks $(${HCPKG} list --global --simple-output --names-only | sed 's/$[a-zA-Z0-9-]\{1,\}$ */--constraint="\1 installed" /g') all | sh; else echo "Not building with installed constraints"; fi

102+

149103 # build & run tests, build benchmarks

150− - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output

151− # Testing...

152− - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output

153− # cabal check...

154− - (cd ${PKGDIR_swagger2} && ${CABAL} -vnormal check)

155− # haddock...

156− - if [ $HCNUMVER -ge 80400 ] ; then ${CABAL} v2-haddock $WITHCOMPILER --with-haddock $HADDOCK ${TEST} ${BENCH} all | color_cabal_output ; fi

157− # Building without installed constraints for packages in global-db...

158− - rm -f cabal.project.local

159− - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output

104+ - cabal new-build -w ${HC} ${TEST} ${BENCH} all

105+ - if [ "x$TEST" = "x--enable-tests" ]; then cabal new-test -w ${HC} ${TEST} ${BENCH} all; fi

106+

107+ # cabal check

108+ - (cd swagger2-* && cabal check)

109+

110+ # haddock

111+ - rm -rf ./dist-newstyle

112+ - if $HADDOCK; then cabal new-haddock -w ${HC} ${TEST} ${BENCH} all; else echo "Skipping haddock generation";fi

160113

161−# REGENDATA ("0.5.20191020",["--branches","master","--haddock-jobs=>=8.4","--output",".travis.yml","swagger2.cabal"])

114+# REGENDATA ["--branch","master","--output",".travis.yml","swagger2.cabal"]

162115# EOF

CHANGELOG.md−67

@@ -1,70 +1,3 @@

1−2.5

2−---

3−

4−Highlights:

5−- Add instance for `TimeOfDay` (see [#196]( https://github.com/GetShopTV/swagger2/pull/196 ));

6−- Add support for [`optics`](https://hackage.haskell.org/package/optics) (see [#200]( https://github.com/GetShopTV/swagger2/pull/200 ));

7−- Slightly better validation errors (see [#195]( https://github.com/GetShopTV/swagger2/pull/195 ));

8−

9−Fixes and minor changes:

10−- Minor cleanup (see [#194]( https://github.com/GetShopTV/swagger2/pull/194 ));

11−- Allow base-4.13 and other GHC-8.8 related stuff (see [#198]( https://github.com/GetShopTV/swagger2/pull/198 ));

12−- Fix `stack.yaml` (see [#201]( https://github.com/GetShopTV/swagger2/pull/201 ));

13−

14−2.4

15−---

16−

17−- Allow hashable-1.3, semigroups-0.19, network-3.1, time-1.9, generics-sop-0.5

18−- Tags aren't sorted

19− (see [#165](https://github.com/GetShopTV/swagger2/issues/165))

20−- Schema type is optional

21− (see [#138](https://github.com/GetShopTV/swagger2/issues/138), [#164](https://github.com/GetShopTV/swagger2/pull/164))

22−- Take concrete 'Proxy' as argument

23− (see [#180](https://github.com/GetShopTV/swagger2/pull/180))

24−- GHC-8.8 preparations

25−

26−2.3.1.1

27−-------

28−

29−- Allow `network-3.0`

30−

31−2.3.1

32−-----

33−

34−- Add a quickcheck generator for aeson Values that match a swagger schema

35− (see [#162](https://github.com/GetShopTV/swagger2/pull/162))

36−- Add `ToParamSchema` instance for `SetCookie`

37− (see [#173](https://github.com/GetShopTV/swagger2/pull/173))

38−- Make nullary schemas valid

39− (see [#168](https://github.com/GetShopTV/swagger2/pull/168))

40−

41−2.3.0.1

42−-------

43−

44−- Support GHC-8.6

45−

46−2.3

47−---

48−

49−Major changes:

50−

51−- Add support for `additionalProperties` with `Bool` value (see [#159](https://github.com/GetShopTV/swagger2/pull/159));

52−- Add `ToSchema` `Object` instance (for aeson's `Object`) (see [`d72466a`](https://github.com/GetShopTV/swagger2/commit/d72466a));

53−

54−Dependencies and CI:

55−

56−- Aeson 1.4 (see [#158](https://github.com/GetShopTV/swagger2/pull/158));

57−- Update .travis.yml (see [#160](https://github.com/GetShopTV/swagger2/pull/160));

58−- Allow network 2.7 (see [#155](https://github.com/GetShopTV/swagger2/pull/155));

59−- Allow lens-4.17 (see [#161](https://github.com/GetShopTV/swagger2/pull/161));

60−

61−2.2.2

62−-----

63−

64−* Add `ToSchema Version` instance

65−* Use base-compat-batteries (0.10)

66−* PVP bounds

67−

6812.2.1

692-----

703

aeson-0.11.cabal.confignew file+1

@@ -0,0 +1 @@

1+constraints: aeson ==0.11.*

cabal.projectdeleted−2

@@ -1,2 +0,0 @@

1−packages: .

2−tests: true

examples/hackage.hs+1−1

@@ -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_ ?~ SwaggerObject

30+ & type_ .~ SwaggerObject

3131 & properties .~

3232 [ ("summaryUsername", usernameSchema )

3333 , ("summaryUserid" , useridSchema )

src/Data/Swagger.hs+4−10

@@ -31,7 +31,6 @@ module Data.Swagger (

3131

3232 -- * Re-exports

3333 module Data.Swagger.Lens,

34− module Data.Swagger.Optics,

3534 module Data.Swagger.Operation,

3635 module Data.Swagger.ParamSchema,

3736 module Data.Swagger.Schema,

@@ -78,7 +77,6 @@ module Data.Swagger (

7877 SwaggerItems(..),

7978 Xml(..),

8079 Pattern,

81− AdditionalProperties(..),

8280

8381 -- ** Responses

8482 Responses(..),

@@ -89,7 +87,6 @@ module Data.Swagger (

8987 SecurityScheme(..),

9088 SecuritySchemeType(..),

9189 SecurityRequirement(..),

92− SecurityDefinitions(..),

9390

9491 -- *** API key

9592 ApiKeyParams(..),

@@ -114,7 +111,6 @@ module Data.Swagger (

114111) where

115112

116113import Data.Swagger.Lens

117−import Data.Swagger.Optics ()

118114import Data.Swagger.Operation

119115import Data.Swagger.ParamSchema

120116import Data.Swagger.Schema

@@ -178,15 +174,13 @@ import Data.Swagger.Internal

178174

179175-- $lens

180176--

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

182−--

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

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

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

186180--

187181-- >>> :{

188182-- encode $ (mempty :: Swagger)

189−-- & definitions .~ [ ("User", mempty & type_ ?~ SwaggerString) ]

183+-- & definitions .~ [ ("User", mempty & type_ .~ SwaggerString) ]

190184-- & paths .~

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

192186-- & produces ?~ MimeList ["application/json"]

@@ -209,7 +203,7 @@ import Data.Swagger.Internal

209203-- "{\"description\":\"No content\"}"

210204-- >>> :{

211205-- encode $ (mempty :: Schema)

212−-- & type_ ?~ SwaggerBoolean

206+-- & type_ .~ SwaggerBoolean

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

214208-- :}

215209-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"

@@ -218,7 +212,7 @@ import Data.Swagger.Internal

218212-- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.

219213-- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:

220214--

221−-- >>> encode $ (mempty :: Header) & type_ ?~ SwaggerNumber

215+-- >>> encode $ (mempty :: Header) & type_ .~ SwaggerNumber

222216-- "{\"type\":\"number\"}"

223217--

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

@@ -280,7 +274,7 @@ import Data.Swagger.Internal

280274-- >>> encode $ toSchema (Proxy :: Proxy Person)

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

282276--

283−-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a

277+-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a

284278-- schema for basic enums like

285279--

286280-- >>> data SampleEnum = ChoiceOne | ChoiceTwo deriving Generic

src/Data/Swagger/Declare.hs+5−4

@@ -29,6 +29,7 @@ import Control.Monad.Trans.RWS.Strict as Strict

2929import Control.Monad.Trans.Writer.Lazy as Lazy

3030import Control.Monad.Trans.Writer.Strict as Strict

3131import Data.Functor.Identity

32+import Data.Monoid

3233

3334-- | A declare monad transformer parametrized by:

3435--

@@ -49,15 +50,15 @@ instance (Applicative m, Monad m, Monoid d) => Applicative (DeclareT d m) where

4950 pure x = DeclareT (\_ -> pure (mempty, x))

5051 DeclareT df <*> DeclareT dx = DeclareT $ \d -> do

5152 ~(d', f) <- df d

52− ~(d'', x) <- dx (mappend d d')

53− return (mappend d' d'', f x)

53+ ~(d'', x) <- dx (d <> d')

54+ return (d' <> d'', f x)

5455

5556instance (Applicative m, Monad m, Monoid d) => Monad (DeclareT d m) where

5657 return x = DeclareT (\_ -> pure (mempty, x))

5758 DeclareT dx >>= f = DeclareT $ \d -> do

5859 ~(d', x) <- dx d

59− ~(d'', y) <- runDeclareT (f x) (mappend d d')

60− return (mappend d' d'', y)

60+ ~(d'', y) <- runDeclareT (f x) (d <> d')

61+ return (d' <> d'', y)

6162

6263instance Monoid d => MonadTrans (DeclareT d) where

6364 lift m = DeclareT (\_ -> (,) mempty `liftM` m)

src/Data/Swagger/Internal.hs+12−100

@@ -29,19 +29,18 @@ import Control.Applicative

2929import Data.Aeson

3030import qualified Data.Aeson.Types as JSON

3131import Data.Data (Data(..), Typeable, mkConstr, mkDataType, Fixity(..), Constr, DataType, constrIndex)

32−import Data.Hashable (Hashable)

3332import qualified Data.HashMap.Strict as HashMap

34−import Data.HashSet.InsOrd (InsOrdHashSet)

3533import Data.Map (Map)

3634import qualified Data.Map as Map

3735import Data.Monoid (Monoid (..))

38−import Data.Semigroup.Compat (Semigroup (..))

36+import Data.Semigroup (Semigroup (..))

3937import Data.Scientific (Scientific)

38+import Data.Set (Set)

4039import Data.String (IsString(..))

4140import Data.Text (Text)

4241import qualified Data.Text as Text

4342import GHC.Generics (Generic)

44−import Network.Socket (HostName, PortNumber)

43+import Network (HostName, PortNumber)

4544import Network.HTTP.Media (MediaType)

4645import Text.Read (readMaybe)

4746

@@ -66,10 +65,6 @@ import Data.Swagger.Internal.AesonUtils (sopSwaggerGenericToEncoding)

6665#define DEFINE_TOENCODING

6766#endif

6867

69−-- $setup

70−-- >>> :seti -XDataKinds

71−-- >>> import Data.Aeson

72−

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

7469type Definitions = InsOrdHashMap Text

7570

@@ -117,7 +112,7 @@ data Swagger = Swagger

117112 , _swaggerResponses :: Definitions Response

118113

119114 -- | Security scheme definitions that can be used across the specification.

120− , _swaggerSecurityDefinitions :: SecurityDefinitions

115+ , _swaggerSecurityDefinitions :: Definitions SecurityScheme

121116

122117 -- | A declaration of which security schemes are applied for the API as a whole.

123118 -- The list of values describes alternative security schemes that can be used

@@ -130,7 +125,7 @@ data Swagger = Swagger

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

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

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

133− , _swaggerTags :: InsOrdHashSet Tag

128+ , _swaggerTags :: Set Tag

134129

135130 -- | Additional external documentation.

136131 , _swaggerExternalDocs :: Maybe ExternalDocs

@@ -252,7 +247,7 @@ data PathItem = PathItem

252247data Operation = Operation

253248 { -- | A list of tags for API documentation control.

254249 -- Tags can be used for logical grouping of operations by resources or any other qualifier.

255− _operationTags :: InsOrdHashSet TagName

250+ _operationTags :: Set TagName

256251

257252 -- | A short summary of what the operation does.

258253 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.

@@ -562,7 +557,7 @@ data Schema = Schema

562557

563558 , _schemaAllOf :: Maybe [Referenced Schema]

564559 , _schemaProperties :: InsOrdHashMap Text (Referenced Schema)

565− , _schemaAdditionalProperties :: Maybe AdditionalProperties

560+ , _schemaAdditionalProperties :: Maybe (Referenced Schema)

566561

567562 , _schemaDiscriminator :: Maybe Text

568563 , _schemaReadOnly :: Maybe Bool

@@ -594,7 +589,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema

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

595590 _paramSchemaDefault :: Maybe Value

596591

597− , _paramSchemaType :: Maybe (SwaggerType t)

592+ , _paramSchemaType :: SwaggerType t

598593 , _paramSchemaFormat :: Maybe Format

599594 , _paramSchemaItems :: Maybe (SwaggerItems t)

600595 , _paramSchemaMaximum :: Maybe Scientific

@@ -611,7 +606,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema

611606 , _paramSchemaMultipleOf :: Maybe Scientific

612607 } deriving (Eq, Show, Generic, Typeable)

613608

614−deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)

609+deriving instance (Typeable k, Data (SwaggerType k), Data (SwaggerItems k)) => Data (ParamSchema k)

615610

616611data Xml = Xml

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

@@ -755,22 +750,6 @@ data SecurityScheme = SecurityScheme

755750 , _securitySchemeDescription :: Maybe Text

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

757752

758−

759−-- | merge scopes of two OAuth2 security schemes when their flows are identical.

760−-- In other case returns first security scheme

761−mergeSecurityScheme :: SecurityScheme -> SecurityScheme -> SecurityScheme

762−mergeSecurityScheme s1@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 scopes1)) desc)

763− s2@(SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow2 scopes2)) _)

764− = if flow1 == flow2 then

765− SecurityScheme (SecuritySchemeOAuth2 (OAuth2Params flow1 (scopes1 <> scopes2))) desc

766− else

767− s1

768−mergeSecurityScheme s1 _ = s1

769−

770−newtype SecurityDefinitions

771− = SecurityDefinitions (Definitions SecurityScheme)

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

773−

774753-- | Lists the required security schemes to execute this operation.

775754-- The object can have multiple security schemes declared in it which are all required

776755-- (that is, there is a logical AND between the schemes).

@@ -795,8 +774,6 @@ data Tag = Tag

795774 , _tagExternalDocs :: Maybe ExternalDocs

796775 } deriving (Eq, Ord, Show, Generic, Data, Typeable)

797776

798−instance Hashable Tag

799−

800777instance IsString Tag where

801778 fromString s = Tag (fromString s) Nothing Nothing

802779

@@ -810,8 +787,6 @@ data ExternalDocs = ExternalDocs

810787 , _externalDocsUrl :: URL

811788 } deriving (Eq, Ord, Show, Generic, Data, Typeable)

812789

813−instance Hashable ExternalDocs

814−

815790-- | A simple object to allow referencing other definitions in the specification.

816791-- It can be used to reference parameters and responses that are defined at the top level for reuse.

817792newtype Reference = Reference { getReference :: Text }

@@ -825,12 +800,7 @@ data Referenced a

825800instance IsString a => IsString (Referenced a) where

826801 fromString = Inline . fromString

827802

828−newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)

829−

830−data AdditionalProperties

831− = AdditionalPropertiesAllowed Bool

832− | AdditionalPropertiesSchema (Referenced Schema)

833− deriving (Eq, Show, Data, Typeable)

803+newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, ToJSON, FromJSON, Data, Typeable)

834804

835805-- =======================================================================

836806-- Monoid instances

@@ -920,17 +890,6 @@ instance Monoid Example where

920890 mempty = genericMempty

921891 mappend = (<>)

922892

923−instance Semigroup SecurityScheme where

924− (<>) = mergeSecurityScheme

925−

926−instance Semigroup SecurityDefinitions where

927− (SecurityDefinitions sd1) <> (SecurityDefinitions sd2) =

928− SecurityDefinitions $ InsOrdHashMap.unionWith (<>) sd1 sd2

929−

930−instance Monoid SecurityDefinitions where

931− mempty = SecurityDefinitions $ InsOrdHashMap.empty

932− mappend = (<>)

933−

934893-- =======================================================================

935894-- SwaggerMonoid helper instances

936895-- =======================================================================

@@ -945,8 +904,6 @@ instance SwaggerMonoid Responses

945904instance SwaggerMonoid Response

946905instance SwaggerMonoid ExternalDocs

947906instance SwaggerMonoid Operation

948−instance SwaggerMonoid SecurityDefinitions

949−instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)

950907

951908instance SwaggerMonoid MimeList

952909deriving instance SwaggerMonoid URL

@@ -1088,22 +1045,11 @@ instance ToJSON Header where

10881045 toJSON = sopSwaggerGenericToJSON

10891046 DEFINE_TOENCODING

10901047

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

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

1093−--

1094−-- >>> encode (SwaggerItemsArray [])

1095−-- "{\"example\":[],\"items\":{},\"maxItems\":0}"

1096−--

10971048instance ToJSON (ParamSchema t) => ToJSON (SwaggerItems t) where

10981049 toJSON (SwaggerItemsPrimitive fmt schema) = object

10991050 [ "collectionFormat" .= fmt

11001051 , "items" .= schema ]

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

1102− toJSON (SwaggerItemsArray []) = object

1103− [ "items" .= object []

1104− , "maxItems" .= (0 :: Int)

1105− , "example" .= Array mempty

1106− ]

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

11081054

11091055instance ToJSON Host where

@@ -1146,9 +1092,6 @@ instance ToJSON PathItem where

11461092instance ToJSON Example where

11471093 toJSON = toJSON . Map.mapKeys show . getExample

11481094

1149−instance ToJSON SecurityDefinitions where

1150− toJSON (SecurityDefinitions sd) = toJSON sd

1151−

11521095instance ToJSON Reference where

11531096 toJSON (Reference ref) = object [ "$ref" .= ref ]

11541097

@@ -1182,10 +1125,6 @@ instance ToJSON (ParamSchema k) where

11821125 toJSON = sopSwaggerGenericToJSONWithOpts $

11831126 mkSwaggerAesonOptions "paramSchema" & saoSubObject ?~ "items"

11841127

1185−instance ToJSON AdditionalProperties where

1186− toJSON (AdditionalPropertiesAllowed b) = toJSON b

1187− toJSON (AdditionalPropertiesSchema s) = toJSON s

1188−

11891128-- =======================================================================

11901129-- Manual FromJSON instances

11911130-- =======================================================================

@@ -1223,13 +1162,7 @@ instance FromJSON SecurityScheme where

12231162 parseJSON = sopSwaggerGenericParseJSON

12241163

12251164instance FromJSON Schema where

1226− parseJSON = fmap nullaryCleanup . sopSwaggerGenericParseJSON

1227− where nullaryCleanup :: Schema -> Schema

1228− nullaryCleanup s@Schema{_schemaParamSchema=ps} =

1229− if _paramSchemaItems ps == Just (SwaggerItemsArray [])

1230− then s { _schemaExample = Nothing

1231− , _schemaParamSchema = ps { _paramSchemaMaxItems = Nothing } }

1232− else s

1165+ parseJSON = sopSwaggerGenericParseJSON

12331166

12341167instance FromJSON Header where

12351168 parseJSON = sopSwaggerGenericParseJSON

@@ -1244,21 +1177,8 @@ instance FromJSON (SwaggerItems 'SwaggerKindParamOtherSchema) where

12441177 <$> o .:? "collectionFormat"

12451178 <*> ((o .: "items" >>= parseJSON) <|> fail ("foo" ++ show o))

12461179

1247−-- |

1248−--

1249−-- >>> decode "{}" :: Maybe (SwaggerItems 'SwaggerKindSchema)

1250−-- Just (SwaggerItemsArray [])

1251−--

1252−-- >>> eitherDecode "{\"$ref\":\"#/definitions/example\"}" :: Either String (SwaggerItems 'SwaggerKindSchema)

1253−-- Right (SwaggerItemsObject (Ref (Reference {getReference = "example"})))

1254−--

1255−-- >>> eitherDecode "[{\"$ref\":\"#/definitions/example\"}]" :: Either String (SwaggerItems 'SwaggerKindSchema)

1256−-- Right (SwaggerItemsArray [Ref (Reference {getReference = "example"})])

1257−--

12581180instance FromJSON (SwaggerItems 'SwaggerKindSchema) where

1259− parseJSON js@(Object obj)

1260− | null obj = pure $ SwaggerItemsArray [] -- Nullary schema.

1261− | otherwise = SwaggerItemsObject <$> parseJSON js

1181+ parseJSON js@(Object _) = SwaggerItemsObject <$> parseJSON js

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

12631183 parseJSON _ = empty

12641184

@@ -1310,9 +1230,6 @@ instance FromJSON Operation where

13101230instance FromJSON PathItem where

13111231 parseJSON = sopSwaggerGenericParseJSON

13121232

1313−instance FromJSON SecurityDefinitions where

1314− parseJSON js = SecurityDefinitions <$> parseJSON js

1315−

13161233instance FromJSON Reference where

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

13181235 parseJSON _ = empty

@@ -1363,10 +1280,6 @@ instance FromJSON (ParamSchema 'SwaggerKindParamOtherSchema) where

13631280instance FromJSON (ParamSchema 'SwaggerKindSchema) where

13641281 parseJSON = sopSwaggerGenericParseJSON

13651282

1366−instance FromJSON AdditionalProperties where

1367− parseJSON (Bool b) = pure $ AdditionalPropertiesAllowed b

1368− parseJSON js = AdditionalPropertiesSchema <$> parseJSON js

1369−

13701283-------------------------------------------------------------------------------

13711284-- TH splices

13721285-------------------------------------------------------------------------------

@@ -1424,4 +1337,3 @@ instance AesonDefaultValue (SwaggerType a)

14241337instance AesonDefaultValue MimeList where defaultValue = Just mempty

14251338instance AesonDefaultValue Info

14261339instance AesonDefaultValue ParamLocation

1427−instance AesonDefaultValue SecurityDefinitions where defaultValue = Just $ SecurityDefinitions mempty

src/Data/Swagger/Internal/AesonUtils.hs+3−16

@@ -44,10 +44,10 @@ import qualified Data.Text as T

4444import qualified Data.HashMap.Strict as HM

4545import qualified Data.Set as Set

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

47−import qualified Data.HashSet.InsOrd as InsOrdHS

4847

4948#if MIN_VERSION_aeson(0,10,0)

5049import Data.Aeson (Encoding, pairs, (.=), Series)

50+import Data.Monoid ((<>))

5151#endif

5252

5353-------------------------------------------------------------------------------

@@ -68,10 +68,10 @@ mkSwaggerAesonOptions pfx = SwaggerAesonOptions pfx [] Nothing

6868makeLenses ''SwaggerAesonOptions

6969

7070class (Generic a, All2 AesonDefaultValue (Code a)) => HasSwaggerAesonOptions a where

71− swaggerAesonOptions :: Proxy a -> SwaggerAesonOptions

71+ swaggerAesonOptions :: proxy a -> SwaggerAesonOptions

7272

7373 -- So far we use only default definitions

74− aesonDefaults :: Proxy a -> POP Maybe (Code a)

74+ aesonDefaults :: proxy a -> POP Maybe (Code a)

7575 aesonDefaults _ = hcpure (Proxy :: Proxy AesonDefaultValue) defaultValue

7676

7777-------------------------------------------------------------------------------

@@ -86,7 +86,6 @@ instance AesonDefaultValue Text where defaultValue = Nothing

8686instance AesonDefaultValue (Maybe a) where defaultValue = Just Nothing

8787instance AesonDefaultValue [a] where defaultValue = Just []

8888instance AesonDefaultValue (Set.Set a) where defaultValue = Just Set.empty

89−instance AesonDefaultValue (InsOrdHS.InsOrdHashSet k) where defaultValue = Just InsOrdHS.empty

9089instance AesonDefaultValue (InsOrd.InsOrdHashMap k v) where defaultValue = Just InsOrd.empty

9190

9291-------------------------------------------------------------------------------

@@ -146,11 +145,7 @@ sopSwaggerGenericToJSON'

146145 -> DatatypeInfo '[xs]

147146 -> POP Maybe '[xs]

148147 -> [Pair]

149−#if MIN_VERSION_generics_sop(0,5,0)

150−sopSwaggerGenericToJSON' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =

151−#else

152148sopSwaggerGenericToJSON' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

153−#endif

154149 sopSwaggerGenericToJSON'' opts fields fieldsInfo defs

155150sopSwaggerGenericToJSON' _ _ _ _ = error "sopSwaggerGenericToJSON: unsupported type"

156151

@@ -226,11 +221,7 @@ sopSwaggerGenericParseJSON'

226221 -> DatatypeInfo '[xs]

227222 -> POP Maybe '[xs]

228223 -> Parser (SOP I '[xs])

229−#if MIN_VERSION_generics_sop(0,5,0)

230−sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =

231−#else

232224sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

233−#endif

234225 SOP . Z <$> sopSwaggerGenericParseJSON'' opts obj fieldsInfo defs

235226sopSwaggerGenericParseJSON' _ _ _ _ = error "sopSwaggerGenericParseJSON: unsupported type"

236227

@@ -302,11 +293,7 @@ sopSwaggerGenericToEncoding'

302293 -> DatatypeInfo '[xs]

303294 -> POP Maybe '[xs]

304295 -> Series

305−#if MIN_VERSION_generics_sop(0,5,0)

306−sopSwaggerGenericToEncoding' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil) _) (POP (defs :* Nil)) =

307−#else

308296sopSwaggerGenericToEncoding' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =

309−#endif

310297 sopSwaggerGenericToEncoding'' opts fields fieldsInfo defs

311298sopSwaggerGenericToEncoding' _ _ _ _ = error "sopSwaggerGenericToEncoding: unsupported type"

312299

src/Data/Swagger/Internal/ParamSchema.hs+26−44

@@ -39,11 +39,9 @@ import qualified Data.Vector as V

3939import qualified Data.Vector.Primitive as VP

4040import qualified Data.Vector.Storable as VS

4141import qualified Data.Vector.Unboxed as VU

42−import Data.Version (Version)

43−import Numeric.Natural.Compat (Natural)

42+import Numeric.Natural

4443import Data.Word

4544import Data.UUID.Types (UUID)

46−import Web.Cookie (SetCookie)

4745

4846import Data.Swagger.Internal

4947import Data.Swagger.Lens

@@ -59,20 +57,20 @@ import GHC.TypeLits (TypeError, ErrorMessage(..))

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

6058binaryParamSchema :: ParamSchema t

6159binaryParamSchema = mempty

62− & type_ ?~ SwaggerString

60+ & type_ .~ SwaggerString

6361 & format ?~ "binary"

6462

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

6664byteParamSchema :: ParamSchema t

6765byteParamSchema = mempty

68− & type_ ?~ SwaggerString

66+ & type_ .~ SwaggerString

6967 & format ?~ "byte"

7068

7169-- | Default schema for password string.

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

7371passwordParamSchema :: ParamSchema t

7472passwordParamSchema = mempty

75− & type_ ?~ SwaggerString

73+ & type_ .~ SwaggerString

7674 & format ?~ "password"

7775

7876-- | Convert a type into a plain @'ParamSchema'@.

@@ -88,7 +86,7 @@ passwordParamSchema = mempty

8886--

8987-- instance ToParamSchema Direction where

9088-- toParamSchema _ = mempty

91−-- & type_ ?~ SwaggerString

89+-- & type_ .~ SwaggerString

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

9391-- @

9492--

@@ -115,22 +113,22 @@ class ToParamSchema a where

115113 --

116114 -- >>> encode $ toParamSchema (Proxy :: Proxy Integer)

117115 -- "{\"type\":\"integer\"}"

118− toParamSchema :: Proxy a -> ParamSchema t

119− default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => Proxy a -> ParamSchema t

116+ toParamSchema :: proxy a -> ParamSchema t

117+ default toParamSchema :: (Generic a, GToParamSchema (Rep a)) => proxy a -> ParamSchema t

120118 toParamSchema = genericToParamSchema defaultSchemaOptions

121119

122120instance OVERLAPPING_ ToParamSchema String where

123− toParamSchema _ = mempty & type_ ?~ SwaggerString

121+ toParamSchema _ = mempty & type_ .~ SwaggerString

124122

125123instance ToParamSchema Bool where

126− toParamSchema _ = mempty & type_ ?~ SwaggerBoolean

124+ toParamSchema _ = mempty & type_ .~ SwaggerBoolean

127125

128126instance ToParamSchema Integer where

129− toParamSchema _ = mempty & type_ ?~ SwaggerInteger

127+ toParamSchema _ = mempty & type_ .~ SwaggerInteger

130128

131129instance ToParamSchema Natural where

132130 toParamSchema _ = mempty

133− & type_ ?~ SwaggerInteger

131+ & type_ .~ SwaggerInteger

134132 & minimum_ ?~ 0

135133 & exclusiveMinimum ?~ False

136134

@@ -154,51 +152,45 @@ instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral

154152--

155153-- >>> encode $ toParamSchemaBoundedIntegral (Proxy :: Proxy Int8)

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

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

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

158156toParamSchemaBoundedIntegral _ = mempty

159− & type_ ?~ SwaggerInteger

157+ & type_ .~ SwaggerInteger

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

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

162160

163161instance ToParamSchema Char where

164162 toParamSchema _ = mempty

165− & type_ ?~ SwaggerString

163+ & type_ .~ SwaggerString

166164 & maxLength ?~ 1

167165 & minLength ?~ 1

168166

169167instance ToParamSchema Scientific where

170− toParamSchema _ = mempty & type_ ?~ SwaggerNumber

168+ toParamSchema _ = mempty & type_ .~ SwaggerNumber

171169

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

173171 toParamSchema _ = mempty

174− & type_ ?~ SwaggerNumber

172+ & type_ .~ SwaggerNumber

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

176174

177175instance ToParamSchema Double where

178176 toParamSchema _ = mempty

179− & type_ ?~ SwaggerNumber

177+ & type_ .~ SwaggerNumber

180178 & format ?~ "double"

181179

182180instance ToParamSchema Float where

183181 toParamSchema _ = mempty

184− & type_ ?~ SwaggerNumber

182+ & type_ .~ SwaggerNumber

185183 & format ?~ "float"

186184

187185timeParamSchema :: String -> ParamSchema t

188186timeParamSchema fmt = mempty

189− & type_ ?~ SwaggerString

187+ & type_ .~ SwaggerString

190188 & format ?~ T.pack fmt

191189

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

193191instance ToParamSchema Day where

194192 toParamSchema _ = timeParamSchema "date"

195193

196−-- |

197−-- >>> toParamSchema (Proxy :: Proxy TimeOfDay) ^. format

198−-- Just "hh:MM:ss"

199−instance ToParamSchema TimeOfDay where

200− toParamSchema _ = timeParamSchema "hh:MM:ss"

201−

202194-- |

203195-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. format

204196-- Just "yyyy-mm-ddThh:MM:ss"

@@ -226,16 +218,6 @@ instance ToParamSchema T.Text where

226218instance ToParamSchema TL.Text where

227219 toParamSchema _ = toParamSchema (Proxy :: Proxy String)

228220

229−instance ToParamSchema Version where

230− toParamSchema _ = mempty

231− & type_ ?~ SwaggerString

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

233−

234−instance ToParamSchema SetCookie where

235− toParamSchema _ = mempty

236− & type_ ?~ SwaggerString

237−

238−

239221#if __GLASGOW_HASKELL__ < 800

240222#else

241223type family ToParamSchemaByteStringError bs where

@@ -260,7 +242,7 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t

260242

261243instance ToParamSchema a => ToParamSchema [a] where

262244 toParamSchema _ = mempty

263− & type_ ?~ SwaggerArray

245+ & type_ .~ SwaggerArray

264246 & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))

265247

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

@@ -280,12 +262,12 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where

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

281263instance ToParamSchema () where

282264 toParamSchema _ = mempty

283− & type_ ?~ SwaggerString

265+ & type_ .~ SwaggerString

284266 & enum_ ?~ ["_"]

285267

286268instance ToParamSchema UUID where

287269 toParamSchema _ = mempty

288− & type_ ?~ SwaggerString

270+ & type_ .~ SwaggerString

289271 & format ?~ "uuid"

290272

291273-- | A configurable generic @'ParamSchema'@ creator.

@@ -294,11 +276,11 @@ instance ToParamSchema UUID where

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

295277-- >>> encode $ genericToParamSchema defaultSchemaOptions (Proxy :: Proxy Color)

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

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

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

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

299281

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

301− gtoParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t

283+ gtoParamSchema :: SchemaOptions -> proxy f -> ParamSchema t -> ParamSchema t

302284

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

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

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

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

317299

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

319− genumParamSchema :: SchemaOptions -> Proxy f -> ParamSchema t -> ParamSchema t

301+ genumParamSchema :: SchemaOptions -> proxy f -> ParamSchema t -> ParamSchema t

320302

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

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

323305

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

325307 genumParamSchema opts _ s = s

326− & type_ ?~ SwaggerString

308+ & type_ .~ SwaggerString

327309 & enum_ %~ addEnumValue tag

328310 where

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

src/Data/Swagger/Internal/Schema.hs+73−85

@@ -32,7 +32,7 @@ import Data.Data.Lens (template)

3232

3333import Control.Monad

3434import Control.Monad.Writer

35−import Data.Aeson (ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..), Value (..), Object(..))

35+import Data.Aeson (ToJSON (..), ToJSONKey (..), ToJSONKeyFunction (..), Value (..))

3636import Data.Char

3737import Data.Data (Data)

3838import Data.Foldable (traverse_)

@@ -44,7 +44,7 @@ import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

4444import Data.Int

4545import Data.IntSet (IntSet)

4646import Data.IntMap (IntMap)

47−import Data.List.NonEmpty.Compat (NonEmpty)

47+import Data.List.NonEmpty (NonEmpty)

4848import Data.Map (Map)

4949import Data.Proxy

5050import Data.Scientific (Scientific)

@@ -57,8 +57,7 @@ import qualified Data.Vector as V

5757import qualified Data.Vector.Primitive as VP

5858import qualified Data.Vector.Storable as VS

5959import qualified Data.Vector.Unboxed as VU

60−import Data.Version (Version)

61−import Numeric.Natural.Compat (Natural)

60+import Numeric.Natural

6261import Data.Word

6362import GHC.Generics

6463import qualified Data.UUID.Types as UUID

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

111110-- declareNamedSchema _ = do

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

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

114−-- & type_ ?~ SwaggerObject

113+-- & type_ .~ SwaggerObject

115114-- & properties .~

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

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

@@ -142,17 +141,13 @@ class ToSchema a where

142141 -- together with all used definitions.

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

144143 -- only if it is recursive (and thus needs its definition in scope).

145− declareNamedSchema :: Proxy a -> Declare (Definitions Schema) NamedSchema

144+ declareNamedSchema :: proxy a -> Declare (Definitions Schema) NamedSchema

146145 default declareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>

147− Proxy a -> Declare (Definitions Schema) NamedSchema

146+ proxy a -> Declare (Definitions Schema) NamedSchema

148147 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions

149148

150−instance ToSchema TimeOfDay where

151− declareNamedSchema _ = pure $ named "TimeOfDay" $ timeSchema "hh:MM:ss"

152− & example ?~ toJSON (TimeOfDay 12 33 15)

153−

154149-- | Convert a type into a schema and declare all used schema definitions.

155−declareSchema :: ToSchema a => Proxy a -> Declare (Definitions Schema) Schema

150+declareSchema :: ToSchema a => proxy a -> Declare (Definitions Schema) Schema

156151declareSchema = fmap _namedSchemaSchema . declareNamedSchema

157152

158153-- | Convert a type into an optionally named schema.

@@ -166,7 +161,7 @@ declareSchema = fmap _namedSchemaSchema . declareNamedSchema

166161-- Just "Day"

167162-- >>> encode (toNamedSchema (Proxy :: Proxy Day) ^. schema)

168163-- "{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}"

169−toNamedSchema :: ToSchema a => Proxy a -> NamedSchema

164+toNamedSchema :: ToSchema a => proxy a -> NamedSchema

170165toNamedSchema = undeclare . declareNamedSchema

171166

172167-- | Get type's schema name according to its @'ToSchema'@ instance.

@@ -176,7 +171,7 @@ toNamedSchema = undeclare . declareNamedSchema

176171--

177172-- >>> schemaName (Proxy :: Proxy UTCTime)

178173-- Just "UTCTime"

179−schemaName :: ToSchema a => Proxy a -> Maybe T.Text

174+schemaName :: ToSchema a => proxy a -> Maybe T.Text

180175schemaName = _namedSchemaName . toNamedSchema

181176

182177-- | Convert a type into a schema.

@@ -186,7 +181,7 @@ schemaName = _namedSchemaName . toNamedSchema

186181--

187182-- >>> encode $ toSchema (Proxy :: Proxy [Day])

188183-- "{\"items\":{\"$ref\":\"#/definitions/Day\"},\"type\":\"array\"}"

189−toSchema :: ToSchema a => Proxy a -> Schema

184+toSchema :: ToSchema a => proxy a -> Schema

190185toSchema = _namedSchemaSchema . toNamedSchema

191186

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

@@ -197,7 +192,7 @@ toSchema = _namedSchemaSchema . toNamedSchema

197192--

198193-- >>> encode $ toSchemaRef (Proxy :: Proxy Day)

199194-- "{\"$ref\":\"#/definitions/Day\"}"

200−toSchemaRef :: ToSchema a => Proxy a -> Referenced Schema

195+toSchemaRef :: ToSchema a => proxy a -> Referenced Schema

201196toSchemaRef = undeclare . declareSchemaRef

202197

203198-- | Convert a type into a referenced schema if possible

@@ -207,7 +202,7 @@ toSchemaRef = undeclare . declareSchemaRef

207202-- Schema definitions are typically declared for every referenced schema.

208203-- If @'declareSchemaRef'@ returns a reference, a corresponding schema

209204-- will be declared (regardless of whether it is recusive or not).

210−declareSchemaRef :: ToSchema a => Proxy a -> Declare (Definitions Schema) (Referenced Schema)

205+declareSchemaRef :: ToSchema a => proxy a -> Declare (Definitions Schema) (Referenced Schema)

211206declareSchemaRef proxy = do

212207 case toNamedSchema proxy of

213208 NamedSchema (Just name) schema -> do

@@ -269,7 +264,7 @@ inlineAllSchemas = inlineSchemasWhen (const True)

269264--

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

271266-- when inlining recursive schemas.

272−toInlinedSchema :: ToSchema a => Proxy a -> Schema

267+toInlinedSchema :: ToSchema a => proxy a -> Schema

273268toInlinedSchema proxy = inlineAllSchemas defs schema

274269 where

275270 (defs, schema) = runDeclare (declareSchema proxy) mempty

@@ -298,20 +293,20 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs

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

299294binarySchema :: Schema

300295binarySchema = mempty

301− & type_ ?~ SwaggerString

296+ & type_ .~ SwaggerString

302297 & format ?~ "binary"

303298

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

305300byteSchema :: Schema

306301byteSchema = mempty

307− & type_ ?~ SwaggerString

302+ & type_ .~ SwaggerString

308303 & format ?~ "byte"

309304

310305-- | Default schema for password string.

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

312307passwordSchema :: Schema

313308passwordSchema = mempty

314− & type_ ?~ SwaggerString

309+ & type_ .~ SwaggerString

315310 & format ?~ "password"

316311

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

@@ -337,12 +332,12 @@ sketchSchema = sketch . toJSON

337332 sketch js@(Bool _) = go js

338333 sketch js = go js & example ?~ js

339334

340− go Null = mempty & type_ ?~ SwaggerNull

341− go (Bool _) = mempty & type_ ?~ SwaggerBoolean

342− go (String _) = mempty & type_ ?~ SwaggerString

343− go (Number _) = mempty & type_ ?~ SwaggerNumber

335+ go Null = mempty & type_ .~ SwaggerNull

336+ go (Bool _) = mempty & type_ .~ SwaggerBoolean

337+ go (String _) = mempty & type_ .~ SwaggerString

338+ go (Number _) = mempty & type_ .~ SwaggerNumber

344339 go (Array xs) = mempty

345− & type_ ?~ SwaggerArray

340+ & type_ .~ SwaggerArray

346341 & items ?~ case ischema of

347342 Just s -> SwaggerItemsObject (Inline s)

348343 _ -> SwaggerItemsArray (map Inline ys)

@@ -354,7 +349,7 @@ sketchSchema = sketch . toJSON

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

355350 _ -> Nothing

356351 go (Object o) = mempty

357− & type_ ?~ SwaggerObject

352+ & type_ .~ SwaggerObject

358353 & required .~ HashMap.keys o

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

360355

@@ -377,24 +372,24 @@ sketchSchema = sketch . toJSON

377372sketchStrictSchema :: ToJSON a => a -> Schema

378373sketchStrictSchema = go . toJSON

379374 where

380− go Null = mempty & type_ ?~ SwaggerNull

375+ go Null = mempty & type_ .~ SwaggerNull

381376 go js@(Bool _) = mempty

382− & type_ ?~ SwaggerBoolean

377+ & type_ .~ SwaggerBoolean

383378 & enum_ ?~ [js]

384379 go js@(String s) = mempty

385− & type_ ?~ SwaggerString

380+ & type_ .~ SwaggerString

386381 & maxLength ?~ fromIntegral (T.length s)

387382 & minLength ?~ fromIntegral (T.length s)

388383 & pattern ?~ s

389384 & enum_ ?~ [js]

390385 go js@(Number n) = mempty

391− & type_ ?~ SwaggerNumber

386+ & type_ .~ SwaggerNumber

392387 & maximum_ ?~ n

393388 & minimum_ ?~ n

394389 & multipleOf ?~ n

395390 & enum_ ?~ [js]

396391 go js@(Array xs) = mempty

397− & type_ ?~ SwaggerArray

392+ & type_ .~ SwaggerArray

398393 & maxItems ?~ fromIntegral sz

399394 & minItems ?~ fromIntegral sz

400395 & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))

@@ -404,7 +399,7 @@ sketchStrictSchema = go . toJSON

404399 sz = length xs

405400 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))

406401 go js@(Object o) = mempty

407− & type_ ?~ SwaggerObject

402+ & type_ .~ SwaggerObject

408403 & required .~ names

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

410405 & maxProperties ?~ fromIntegral (length names)

@@ -414,13 +409,13 @@ sketchStrictSchema = go . toJSON

414409 names = HashMap.keys o

415410

416411class GToSchema (f :: * -> *) where

417− gdeclareNamedSchema :: SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema

412+ gdeclareNamedSchema :: SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema

418413

419414instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where

420415 declareNamedSchema _ = do

421416 ref <- declareSchemaRef (Proxy :: Proxy a)

422417 return $ unnamed $ mempty

423− & type_ ?~ SwaggerArray

418+ & type_ .~ SwaggerArray

424419 & items ?~ SwaggerItemsObject ref

425420

426421instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema

@@ -470,7 +465,7 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f

470465

471466timeSchema :: T.Text -> Schema

472467timeSchema fmt = mempty

473− & type_ ?~ SwaggerString

468+ & type_ .~ SwaggerString

474469 & format ?~ fmt

475470

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

@@ -503,8 +498,6 @@ instance ToSchema UTCTime where

503498instance ToSchema T.Text where declareNamedSchema = plain . paramSchemaToSchema

504499instance ToSchema TL.Text where declareNamedSchema = plain . paramSchemaToSchema

505500

506−instance ToSchema Version where declareNamedSchema = plain . paramSchemaToSchema

507−

508501#if __GLASGOW_HASKELL__ < 800

509502#else

510503type family ToSchemaByteStringError bs where

@@ -532,8 +525,8 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where

532525 declareObjectMapSchema = do

533526 schema <- declareSchemaRef (Proxy :: Proxy v)

534527 return $ unnamed $ mempty

535− & type_ ?~ SwaggerObject

536− & additionalProperties ?~ AdditionalPropertiesSchema schema

528+ & type_ .~ SwaggerObject

529+ & additionalProperties ?~ schema

537530

538531instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where

539532 declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map k v))

@@ -544,7 +537,7 @@ instance ToSchema a => ToSchema (Map String a) where

544537 declareNamedSchema _ = do

545538 schema <- declareSchemaRef (Proxy :: Proxy a)

546539 return $ unnamed $ mempty

547− & type_ ?~ SwaggerObject

540+ & type_ .~ SwaggerObject

548541 & additionalProperties ?~ schema

549542

550543instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))

@@ -556,12 +549,6 @@ instance ToSchema a => ToSchema (HashMap TL.Text a) where declareNamedSchema _ =

556549

557550#endif

558551

559−instance OVERLAPPING_ ToSchema Object where

560− declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty

561− & type_ ?~ SwaggerObject

562− & description ?~ "Arbitrary JSON object."

563− & additionalProperties ?~ AdditionalPropertiesAllowed True

564−

565552instance ToSchema a => ToSchema (V.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])

566553instance ToSchema a => ToSchema (VU.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])

567554instance ToSchema a => ToSchema (VS.Vector a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy [a])

@@ -597,26 +584,26 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar

597584--

598585-- >>> encode $ toSchemaBoundedIntegral (Proxy :: Proxy Int16)

599586-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"

600−toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema

587+toSchemaBoundedIntegral :: forall a proxy. (Bounded a, Integral a) => proxy a -> Schema

601588toSchemaBoundedIntegral _ = mempty

602− & type_ ?~ SwaggerInteger

589+ & type_ .~ SwaggerInteger

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

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

605592

606593-- | Default generic named schema for @'Bounded'@, @'Integral'@ types.

607−genericToNamedSchemaBoundedIntegral :: forall a d f.

594+genericToNamedSchemaBoundedIntegral :: forall a d f proxy.

608595 ( Bounded a, Integral a

609596 , Generic a, Rep a ~ D1 d f, Datatype d)

610− => SchemaOptions -> Proxy a -> NamedSchema

597+ => SchemaOptions -> proxy a -> NamedSchema

611598genericToNamedSchemaBoundedIntegral opts proxy

612599 = genericNameSchema opts proxy (toSchemaBoundedIntegral proxy)

613600

614601-- | Declare a named schema for a @newtype@ wrapper.

615−genericDeclareNamedSchemaNewtype :: forall a d c s i inner.

602+genericDeclareNamedSchemaNewtype :: forall proxy a d c s i inner.

616603 (Generic a, Datatype d, Rep a ~ D1 d (C1 c (S1 s (K1 i inner))))

617604 => SchemaOptions -- ^ How to derive the name.

618605 -> (Proxy inner -> Declare (Definitions Schema) Schema) -- ^ How to create a schema for the wrapped type.

619− -> Proxy a

606+ -> proxy a

620607 -> Declare (Definitions Schema) NamedSchema

621608genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$> f (Proxy :: Proxy inner)

622609

@@ -633,9 +620,9 @@ genericDeclareNamedSchemaNewtype opts f proxy = genericNameSchema opts proxy <$>

633620--

634621-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.

635622-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.

636−declareSchemaBoundedEnumKeyMapping :: forall map key value.

623+declareSchemaBoundedEnumKeyMapping :: forall map key value proxy.

637624 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)

638− => Proxy (map key value) -> Declare (Definitions Schema) Schema

625+ => proxy (map key value) -> Declare (Definitions Schema) Schema

639626declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of

640627 ToJSONKeyText keyToText _ -> objectSchema keyToText

641628 ToJSONKeyValue _ _ -> declareSchema (Proxy :: Proxy [(key, value)])

@@ -645,7 +632,7 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o

645632 let allKeys = [minBound..maxBound :: key]

646633 mkPair k = (keyToText k, valueRef)

647634 return $ mempty

648− & type_ ?~ SwaggerObject

635+ & type_ .~ SwaggerObject

649636 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)

650637

651638-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.

@@ -661,46 +648,46 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o

661648--

662649-- Note: this is only useful when @key@ is encoded with 'ToJSONKeyText'.

663650-- If it is encoded with 'ToJSONKeyValue' then a regular schema for @[(key, value)]@ is used.

664−toSchemaBoundedEnumKeyMapping :: forall map key value.

651+toSchemaBoundedEnumKeyMapping :: forall map key value proxy.

665652 (Bounded key, Enum key, ToJSONKey key, ToSchema key, ToSchema value)

666− => Proxy (map key value) -> Schema

653+ => proxy (map key value) -> Schema

667654toSchemaBoundedEnumKeyMapping = flip evalDeclare mempty . declareSchemaBoundedEnumKeyMapping

668655

669656-- | A configurable generic @'Schema'@ creator.

670657genericDeclareSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareSchemaUnrestricted") =>

671− SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema

658+ SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema

672659genericDeclareSchema = genericDeclareSchemaUnrestricted

673660

674661-- | A configurable generic @'NamedSchema'@ creator.

675662-- This function applied to @'defaultSchemaOptions'@

676663-- is used as the default for @'declareNamedSchema'@

677664-- when the type is an instance of @'Generic'@.

678−genericDeclareNamedSchema :: (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>

679− SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema

665+genericDeclareNamedSchema :: forall a proxy. (Generic a, GToSchema (Rep a), TypeHasSimpleShape a "genericDeclareNamedSchemaUnrestricted") =>

666+ SchemaOptions -> proxy a -> Declare (Definitions Schema) NamedSchema

680667genericDeclareNamedSchema = genericDeclareNamedSchemaUnrestricted

681668

682669-- | A configurable generic @'Schema'@ creator.

683670--

684671-- Unlike 'genericDeclareSchema' also works for mixed sum types.

685672-- Use with care since some Swagger tools do not support well schemas for mixed sum types.

686−genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> Proxy a -> Declare (Definitions Schema) Schema

673+genericDeclareSchemaUnrestricted :: (Generic a, GToSchema (Rep a)) => SchemaOptions -> proxy a -> Declare (Definitions Schema) Schema

687674genericDeclareSchemaUnrestricted opts proxy = _namedSchemaSchema <$> genericDeclareNamedSchemaUnrestricted opts proxy

688675

689676-- | A configurable generic @'NamedSchema'@ creator.

690677--

691678-- Unlike 'genericDeclareNamedSchema' also works for mixed sum types.

692679-- Use with care since some Swagger tools do not support well schemas for mixed sum types.

693−genericDeclareNamedSchemaUnrestricted :: forall a. (Generic a, GToSchema (Rep a)) =>

694− SchemaOptions -> Proxy a -> Declare (Definitions Schema) NamedSchema

680+genericDeclareNamedSchemaUnrestricted :: forall a proxy. (Generic a, GToSchema (Rep a)) =>

681+ SchemaOptions -> proxy a -> Declare (Definitions Schema) NamedSchema

695682genericDeclareNamedSchemaUnrestricted opts _ = gdeclareNamedSchema opts (Proxy :: Proxy (Rep a)) mempty

696683

697684-- | Derive a 'Generic'-based name for a datatype and assign it to a given 'Schema'.

698−genericNameSchema :: forall a d f.

685+genericNameSchema :: forall a d f proxy.

699686 (Generic a, Rep a ~ D1 d f, Datatype d)

700− => SchemaOptions -> Proxy a -> Schema -> NamedSchema

687+ => SchemaOptions -> proxy a -> Schema -> NamedSchema

701688genericNameSchema opts _ = NamedSchema (gdatatypeSchemaName opts (Proxy :: Proxy d))

702689

703−gdatatypeSchemaName :: forall d. Datatype d => SchemaOptions -> Proxy d -> Maybe T.Text

690+gdatatypeSchemaName :: forall proxy d. Datatype d => SchemaOptions -> proxy d -> Maybe T.Text

704691gdatatypeSchemaName opts _ = case orig of

705692 (c:_) | isAlpha c && isUpper c -> Just (T.pack name)

706693 _ -> Nothing

@@ -709,23 +696,24 @@ gdatatypeSchemaName opts _ = case orig of

709696 name = datatypeNameModifier opts orig

710697

711698-- | Lift a plain @'ParamSchema'@ into a model @'NamedSchema'@.

712−paramSchemaToNamedSchema :: (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d) =>

713− SchemaOptions -> Proxy a -> NamedSchema

699+paramSchemaToNamedSchema :: forall a d f proxy.

700+ (ToParamSchema a, Generic a, Rep a ~ D1 d f, Datatype d)

701+ => SchemaOptions -> proxy a -> NamedSchema

714702paramSchemaToNamedSchema opts proxy = genericNameSchema opts proxy (paramSchemaToSchema proxy)

715703

716704-- | Lift a plain @'ParamSchema'@ into a model @'Schema'@.

717−paramSchemaToSchema :: ToParamSchema a => Proxy a -> Schema

718−paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy

705+paramSchemaToSchema :: forall a proxy. ToParamSchema a => proxy a -> Schema

706+paramSchemaToSchema _ = mempty & paramSchema .~ toParamSchema (Proxy :: Proxy a)

719707

720708nullarySchema :: Schema

721709nullarySchema = mempty

722− & type_ ?~ SwaggerArray

710+ & type_ .~ SwaggerArray

723711 & items ?~ SwaggerItemsArray []

724712

725−gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema

713+gtoNamedSchema :: GToSchema f => SchemaOptions -> proxy f -> NamedSchema

726714gtoNamedSchema opts proxy = undeclare $ gdeclareNamedSchema opts proxy mempty

727715

728−gdeclareSchema :: GToSchema f => SchemaOptions -> Proxy f -> Declare (Definitions Schema) Schema

716+gdeclareSchema :: GToSchema f => SchemaOptions -> proxy f -> Declare (Definitions Schema) Schema

729717gdeclareSchema opts proxy = _namedSchemaSchema <$> gdeclareNamedSchema opts proxy mempty

730718

731719instance (GToSchema f, GToSchema g) => GToSchema (f :*: g) where

@@ -759,7 +747,7 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s

759747 recordSchema = gdeclareNamedSchema opts (Proxy :: Proxy (S1 s f)) s

760748 fieldSchema = gdeclareNamedSchema opts (Proxy :: Proxy f) s

761749

762−gdeclareSchemaRef :: GToSchema a => SchemaOptions -> Proxy a -> Declare (Definitions Schema) (Referenced Schema)

750+gdeclareSchemaRef :: GToSchema a => SchemaOptions -> proxy a -> Declare (Definitions Schema) (Referenced Schema)

763751gdeclareSchemaRef opts proxy = do

764752 case gtoNamedSchema opts proxy of

765753 NamedSchema (Just name) schema -> do

@@ -790,12 +778,12 @@ withFieldSchema opts _ isRequiredField schema = do

790778 return $

791779 if T.null fname

792780 then schema

793− & type_ ?~ SwaggerArray

781+ & type_ .~ SwaggerArray

794782 & items %~ appendItem ref

795783 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems

796784 & minItems %~ Just . maybe 1 (+1) -- increment minItems

797785 else schema

798− & type_ ?~ SwaggerObject

786+ & type_ .~ SwaggerObject

799787 & properties . at fname ?~ ref

800788 & if isRequiredField

801789 then required %~ (++ [fname])

@@ -823,7 +811,7 @@ instance ( GSumToSchema f

823811 where

824812 gdeclareNamedSchema = gdeclareNamedSumSchema

825813

826−gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> Proxy f -> Schema -> Declare (Definitions Schema) NamedSchema

814+gdeclareNamedSumSchema :: GSumToSchema f => SchemaOptions -> proxy f -> Schema -> Declare (Definitions Schema) NamedSchema

827815gdeclareNamedSumSchema opts proxy s

828816 | allNullaryToStringTag opts && allNullary = pure $ unnamed (toStringTag sumSchema)

829817 | otherwise = (unnamed . fst) <$> runWriterT declareSumSchema

@@ -832,29 +820,29 @@ gdeclareNamedSumSchema opts proxy s

832820 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)

833821

834822 toStringTag schema = mempty

835− & type_ ?~ SwaggerString

823+ & type_ .~ SwaggerString

836824 & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)

837825

838826type AllNullary = All

839827

840828class GSumToSchema (f :: * -> *) where

841− gsumToSchema :: SchemaOptions -> Proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema

829+ gsumToSchema :: SchemaOptions -> proxy f -> Schema -> WriterT AllNullary (Declare (Definitions Schema)) Schema

842830

843831instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where

844832 gsumToSchema opts _ = gsumToSchema opts (Proxy :: Proxy f) >=> gsumToSchema opts (Proxy :: Proxy g)

845833

846−gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>

847− Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema

834+gsumConToSchemaWith :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>

835+ Referenced Schema -> SchemaOptions -> proxy (C1 c f) -> Schema -> Schema

848836gsumConToSchemaWith ref opts _ schema = schema

849− & type_ ?~ SwaggerObject

837+ & type_ .~ SwaggerObject

850838 & properties . at tag ?~ ref

851839 & maxProperties ?~ 1

852840 & minProperties ?~ 1

853841 where

854842 tag = T.pack (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))

855843

856−gsumConToSchema :: (GToSchema (C1 c f), Constructor c) =>

857− SchemaOptions -> Proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema

844+gsumConToSchema :: forall c f proxy. (GToSchema (C1 c f), Constructor c) =>

845+ SchemaOptions -> proxy (C1 c f) -> Schema -> Declare (Definitions Schema) Schema

858846gsumConToSchema opts proxy schema = do

859847 ref <- gdeclareSchemaRef opts proxy

860848 return $ gsumConToSchemaWith ref opts proxy schema

src/Data/Swagger/Internal/Schema/Validation.hs+50−212

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

1−{-# OPTIONS_GHC -Wall #-}

2−{-# LANGUAGE DataKinds #-}

3−{-# LANGUAGE DeriveFunctor #-}

4−{-# LANGUAGE FlexibleInstances #-}

5−{-# LANGUAGE FunctionalDependencies #-}

6−{-# LANGUAGE GADTs #-}

1+{-# LANGUAGE DeriveFunctor #-}

2+{-# LANGUAGE FlexibleInstances #-}

3+{-# LANGUAGE FunctionalDependencies #-}

4+{-# LANGUAGE GADTs #-}

75{-# LANGUAGE GeneralizedNewtypeDeriving #-}

8−{-# LANGUAGE LambdaCase #-}

9−{-# LANGUAGE MultiParamTypeClasses #-}

10−{-# LANGUAGE PackageImports #-}

11−{-# LANGUAGE RankNTypes #-}

12−{-# LANGUAGE ScopedTypeVariables #-}

13−{-# LANGUAGE TemplateHaskell #-}

14−{-# LANGUAGE UndecidableInstances #-}

6+{-# LANGUAGE LambdaCase #-}

7+{-# LANGUAGE MultiParamTypeClasses #-}

8+{-# LANGUAGE PackageImports #-}

9+{-# LANGUAGE RankNTypes #-}

10+{-# LANGUAGE ScopedTypeVariables #-}

11+{-# LANGUAGE TemplateHaskell #-}

12+{-# LANGUAGE UndecidableInstances #-}

1513-- |

1614-- Module: Data.Swagger.Internal.Schema.Validation

@@ -22,34 +20,28 @@

2220-- Validate JSON values with Swagger Schema.

2321module Data.Swagger.Internal.Schema.Validation where

2422

25−import Prelude ()

26−import Prelude.Compat

23+import Control.Applicative

24+import Control.Lens

25+import Control.Monad (when)

2726

28−import Control.Applicative

29−import Control.Lens

30−import Control.Monad (when)

31−

32−import Data.Aeson hiding (Result)

33−import Data.Aeson.Encode.Pretty (encodePretty)

34−import Data.Foldable (for_, sequenceA_,

35− traverse_)

36−import Data.HashMap.Strict (HashMap)

37−import qualified Data.HashMap.Strict as HashMap

38−import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

27+import Data.Aeson hiding (Result)

28+import Data.Foldable (traverse_, for_, sequenceA_)

29+import Data.HashMap.Strict (HashMap)

30+import qualified Data.HashMap.Strict as HashMap

3931import qualified "unordered-containers" Data.HashSet as HashSet

40−import Data.Proxy

41−import Data.Scientific (Scientific, isInteger)

42−import Data.Text (Text)

43−import qualified Data.Text as Text

44−import qualified Data.Text.Lazy as TL

45−import qualified Data.Text.Lazy.Encoding as TL

46−import Data.Vector (Vector)

47−import qualified Data.Vector as Vector

48−

49−import Data.Swagger.Declare

50−import Data.Swagger.Internal

51−import Data.Swagger.Internal.Schema

52−import Data.Swagger.Lens

32+import qualified Data.HashMap.Strict.InsOrd as InsOrdHashMap

33+import Data.Monoid

34+import Data.Proxy

35+import Data.Scientific (Scientific, isInteger)

36+import Data.Text (Text)

37+import qualified Data.Text as Text

38+import Data.Vector (Vector)

39+import qualified Data.Vector as Vector

40+

41+import Data.Swagger.Declare

42+import Data.Swagger.Internal

43+import Data.Swagger.Internal.Schema

44+import Data.Swagger.Lens

5345

5446-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value.

5547-- This can be used with QuickCheck to ensure those instances are coherent:

@@ -58,101 +50,18 @@ import Data.Swagger.Lens

5850--

5951-- /NOTE:/ @'validateToJSON'@ does not perform string pattern validation.

6052-- See @'validateToJSONWithPatternChecker'@.

61−--

62−-- See 'renderValidationErrors' on how the output is structured.

63−validatePrettyToJSON :: forall a. (ToJSON a, ToSchema a) => a -> Maybe String

64−validatePrettyToJSON = renderValidationErrors validateToJSON

65−

66−-- | Variant of 'validatePrettyToJSON' with typed output.

6753validateToJSON :: forall a. (ToJSON a, ToSchema a) => a -> [ValidationError]

6854validateToJSON = validateToJSONWithPatternChecker (\_pattern _str -> True)

6955

7056-- | Validate @'ToJSON'@ instance matches @'ToSchema'@ for a given value and pattern checker.

7157-- This can be used with QuickCheck to ensure those instances are coherent.

7258--

73−-- For validation without patterns see @'validateToJSON'@. See also:

74−-- 'renderValidationErrors'.

59+-- For validation without patterns see @'validateToJSON'@.

7560validateToJSONWithPatternChecker :: forall a. (ToJSON a, ToSchema a) => (Pattern -> Text -> Bool) -> a -> [ValidationError]

7661validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checker defs sch . toJSON

7762 where

7863 (defs, sch) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty

7964

80−-- | Pretty print validation errors

81−-- together with actual JSON and Swagger Schema

82−-- (using 'encodePretty').

83−--

84−-- >>> import Data.Aeson as Aeson

85−-- >>> import Data.Foldable (traverse_)

86−-- >>> import GHC.Generics

87−-- >>> data Phone = Phone { value :: String } deriving (Generic)

88−-- >>> data Person = Person { name :: String, phone :: Phone } deriving (Generic)

89−-- >>> instance ToJSON Person where toJSON p = object [ "name" Aeson..= name p ]

90−-- >>> instance ToSchema Phone

91−-- >>> instance ToSchema Person

92−-- >>> let person = Person { name = "John", phone = Phone "123456" }

93−-- >>> traverse_ putStrLn $ renderValidationErrors validateToJSON person

94−-- Validation against the schema fails:

95−-- * property "phone" is required, but not found in "{\"name\":\"John\"}"

96−-- <BLANKLINE>

97−-- JSON value:

98−-- {

99−-- "name": "John"

100−-- }

101−-- <BLANKLINE>

102−-- Swagger Schema:

103−-- {

104−-- "required": [

105−-- "name",

106−-- "phone"

107−-- ],

108−-- "type": "object",

109−-- "properties": {

110−-- "phone": {

111−-- "$ref": "#/definitions/Phone"

112−-- },

113−-- "name": {

114−-- "type": "string"

115−-- }

116−-- }

117−-- }

118−-- <BLANKLINE>

119−-- Swagger Description Context:

120−-- {

121−-- "Phone": {

122−-- "required": [

123−-- "value"

124−-- ],

125−-- "type": "object",

126−-- "properties": {

127−-- "value": {

128−-- "type": "string"

129−-- }

130−-- }

131−-- }

132−-- }

133−-- <BLANKLINE>

134−renderValidationErrors

135− :: forall a. (ToJSON a, ToSchema a)

136− => (a -> [ValidationError]) -> a -> Maybe String

137−renderValidationErrors f x =

138− case f x of

139− [] -> Nothing

140− errors -> Just $ unlines

141− [ "Validation against the schema fails:"

142− , unlines (map (" * " ++) errors)

143− , "JSON value:"

144− , ppJSONString (toJSON x)

145− , ""

146− , "Swagger Schema:"

147− , ppJSONString (toJSON schema_)

148− , ""

149− , "Swagger Description Context:"

150− , ppJSONString (toJSON refs_)

151− ]

152− where

153− ppJSONString = TL.unpack . TL.decodeUtf8 . encodePretty

154− (refs_, schema_) = runDeclare (declareSchema (Proxy :: Proxy a)) mempty

155−

15665-- | Validate JSON @'Value'@ against Swagger @'Schema'@.

15766--

15867-- prop> validateJSON mempty (toSchema (Proxy :: Proxy Int)) (toJSON (x :: Int)) == []

@@ -403,16 +312,12 @@ validateObject o = withSchema $ \sch ->

403312 Null | not (k `elem` (sch ^. required)) -> valid -- null is fine for non-required property

404313 _ ->

405314 case InsOrdHashMap.lookup k (sch ^. properties) of

406− Nothing -> checkMissing (unknownProperty k) additionalProperties $ validateAdditional k v

315+ Nothing -> checkMissing (unknownProperty k) additionalProperties $ \s -> validateWithSchemaRef s v

407316 Just s -> validateWithSchemaRef s v

408317

409− validateAdditional _ _ (AdditionalPropertiesAllowed True) = valid

410− validateAdditional k _ (AdditionalPropertiesAllowed False) = invalid $ "additionalProperties=false but extra property " <> show k <> " found"

411− validateAdditional _ v (AdditionalPropertiesSchema s) = validateWithSchemaRef s v

412−

413318 unknownProperty :: Text -> Validation s a

414− unknownProperty pname = invalid $

415− "property " <> show pname <> " is found in JSON value, but it is not mentioned in Swagger schema"

319+ unknownProperty name = invalid $

320+ "property " <> show name <> " is found in JSON value, but it is not mentioned in Swagger schema"

416321

417322validateEnum :: Value -> Validation (ParamSchema t) ()

418323validateEnum value = do

@@ -420,92 +325,25 @@ validateEnum value = do

420325 when (value `notElem` xs) $

421326 invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)

422327

423−-- | Infer schema type based on used properties.

424−--

425−-- This is like 'inferParamSchemaTypes', but also works for objects:

426−--

427−-- >>> inferSchemaTypes <$> decode "{\"minProperties\": 1}"

428−-- Just [SwaggerObject]

429−inferSchemaTypes :: Schema -> [SwaggerType 'SwaggerKindSchema]

430−inferSchemaTypes sch = inferParamSchemaTypes (sch ^. paramSchema) ++

431− [ SwaggerObject | any ($ sch)

432− [ has (additionalProperties._Just)

433− , has (maxProperties._Just)

434− , has (minProperties._Just)

435− , has (properties.folded)

436− , has (required.folded) ] ]

437−

438−-- | Infer schema type based on used properties.

439−--

440−-- >>> inferSchemaTypes <$> decode "{\"minLength\": 2}"

441−-- Just [SwaggerString]

442−--

443−-- >>> inferSchemaTypes <$> decode "{\"maxItems\": 0}"

444−-- Just [SwaggerArray]

445−--

446−-- From numeric properties 'SwaggerInteger' type is inferred.

447−-- If you want 'SwaggerNumber' instead, you must specify it explicitly.

448−--

449−-- >>> inferSchemaTypes <$> decode "{\"minimum\": 1}"

450−-- Just [SwaggerInteger]

451−inferParamSchemaTypes :: ParamSchema t -> [SwaggerType t]

452−inferParamSchemaTypes sch = concat

453− [ [ SwaggerArray | any ($ sch)

454− [ has (items._Just)

455− , has (maxItems._Just)

456− , has (minItems._Just)

457− , has (uniqueItems._Just) ] ]

458− , [ SwaggerInteger | any ($ sch)

459− [ has (exclusiveMaximum._Just)

460− , has (exclusiveMinimum._Just)

461− , has (maximum_._Just)

462− , has (minimum_._Just)

463− , has (multipleOf._Just) ] ]

464− , [ SwaggerString | any ($ sch)

465− [ has (maxLength._Just)

466− , has (minLength._Just)

467− , has (pattern._Just) ] ]

468− ]

469−

470328validateSchemaType :: Value -> Validation Schema ()

471329validateSchemaType value = withSchema $ \sch ->

472330 case (sch ^. type_, value) of

473− (Just SwaggerNull, Null) -> valid

474− (Just SwaggerBoolean, Bool _) -> valid

475− (Just SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)

476− (Just SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)

477− (Just SwaggerString, String s) -> sub_ paramSchema (validateString s)

478− (Just SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)

479− (Just SwaggerObject, Object o) -> validateObject o

480− (Nothing, Null) -> valid

481− (Nothing, Bool _) -> valid

482− -- Number by default

483− (Nothing, Number n) -> sub_ paramSchema (validateNumber n)

484− (Nothing, String s) -> sub_ paramSchema (validateString s)

485− (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)

486− (Nothing, Object o) -> validateObject o

487− bad -> invalid $ "expected JSON value of type " ++ showType bad

331+ (SwaggerNull, Null) -> valid

332+ (SwaggerBoolean, Bool _) -> valid

333+ (SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)

334+ (SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)

335+ (SwaggerString, String s) -> sub_ paramSchema (validateString s)

336+ (SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)

337+ (SwaggerObject, Object o) -> validateObject o

338+ (t, _) -> invalid $ "expected JSON value of type " ++ show t

488339

489340validateParamSchemaType :: Value -> Validation (ParamSchema t) ()

490341validateParamSchemaType value = withSchema $ \sch ->

491342 case (sch ^. type_, value) of

492− (Just SwaggerBoolean, Bool _) -> valid

493− (Just SwaggerInteger, Number n) -> validateInteger n

494− (Just SwaggerNumber, Number n) -> validateNumber n

495− (Just SwaggerString, String s) -> validateString s

496− (Just SwaggerArray, Array xs) -> validateArray xs

497− (Nothing, Bool _) -> valid

498− -- Number by default

499− (Nothing, Number n) -> validateNumber n

500− (Nothing, String s) -> validateString s

501− (Nothing, Array xs) -> validateArray xs

502− bad -> invalid $ "expected JSON value of type " ++ showType bad

503−

504−showType :: (Maybe (SwaggerType t), Value) -> String

505−showType (Just type_, _) = show type_

506−showType (Nothing, Null) = "SwaggerNull"

507−showType (Nothing, Bool _) = "SwaggerBoolean"

508−showType (Nothing, Number _) = "SwaggerNumber"

509−showType (Nothing, String _) = "SwaggerString"

510−showType (Nothing, Array _) = "SwaggerArray"

511−showType (Nothing, Object _) = "SwaggerObject"

343+ (SwaggerBoolean, Bool _) -> valid

344+ (SwaggerInteger, Number n) -> validateInteger n

345+ (SwaggerNumber, Number n) -> validateNumber n

346+ (SwaggerString, String s) -> validateString s

347+ (SwaggerArray, Array xs) -> validateArray xs

348+ (t, _) -> invalid $ "expected JSON value of type " ++ show t

349+

src/Data/Swagger/Internal/Utils.hs+1

@@ -21,6 +21,7 @@ import qualified Data.HashMap.Strict as HashMap

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

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

2323import Data.Map (Map)

24+import Data.Monoid

2425import Data.Set (Set)

2526import Data.Text (Text)

2627import GHC.Generics

src/Data/Swagger/Lens.hs+4−10

@@ -96,19 +96,13 @@ instance At Responses where at n = responses . at n

9696instance Ixed Operation where ix n = responses . ix n

9797instance At Operation where at n = responses . at n

9898

99−type instance Index SecurityDefinitions = Text

100−type instance IxValue SecurityDefinitions = SecurityScheme

101−

102−instance Ixed SecurityDefinitions where ix n = (coerced :: Lens' SecurityDefinitions (Definitions SecurityScheme)). ix n

103−instance At SecurityDefinitions where at n = (coerced :: Lens' SecurityDefinitions (Definitions SecurityScheme)). at n

104−

10599instance HasParamSchema NamedSchema (ParamSchema 'SwaggerKindSchema) where paramSchema = schema.paramSchema

106100

107101-- HasType instances

108−instance HasType Header (Maybe (SwaggerType ('SwaggerKindNormal Header))) where type_ = paramSchema.type_

109−instance HasType Schema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_

110−instance HasType NamedSchema (Maybe (SwaggerType 'SwaggerKindSchema)) where type_ = paramSchema.type_

111−instance HasType ParamOtherSchema (Maybe (SwaggerType 'SwaggerKindParamOtherSchema)) where type_ = paramSchema.type_

102+instance HasType Header (SwaggerType ('SwaggerKindNormal Header)) where type_ = paramSchema.type_

103+instance HasType Schema (SwaggerType 'SwaggerKindSchema) where type_ = paramSchema.type_

104+instance HasType NamedSchema (SwaggerType 'SwaggerKindSchema) where type_ = paramSchema.type_

105+instance HasType ParamOtherSchema (SwaggerType 'SwaggerKindParamOtherSchema) where type_ = paramSchema.type_

112106

113107-- HasDefault instances

114108instance HasDefault Header (Maybe Value) where default_ = paramSchema.default_

src/Data/Swagger/Operation.hs+5−5

@@ -37,7 +37,7 @@ import Control.Lens

3737import Data.Data.Lens

3838import Data.List.Compat

3939import Data.Maybe (mapMaybe)

40−import Data.Proxy

40+import Data.Monoid

4141import qualified Data.Set as Set

4242

4343import Data.Swagger.Declare

@@ -46,7 +46,6 @@ import Data.Swagger.Lens

4646import Data.Swagger.Schema

4747

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

49−import qualified Data.HashSet.InsOrd as InsOrdHS

5049

5150-- $setup

5251-- >>> import Data.Aeson

@@ -112,15 +111,15 @@ applyTags = applyTagsFor allOperations

112111-- list of tags.

113112applyTagsFor :: Traversal' Swagger Operation -> [Tag] -> Swagger -> Swagger

114113applyTagsFor ops ts swag = swag

115− & ops . tags %~ (<> InsOrdHS.fromList (map _tagName ts))

116− & tags %~ (<> InsOrdHS.fromList ts)

114+ & ops . tags %~ (<> Set.fromList (map _tagName ts))

115+ & tags %~ (<> Set.fromList ts)

117116

118117-- | Construct a response with @'Schema'@ while declaring all

119118-- necessary schema definitions.

120119--

121120-- >>> encode $ runDeclare (declareResponse (Proxy :: Proxy Day)) mempty

122121-- "[{\"Day\":{\"example\":\"2016-07-22\",\"format\":\"date\",\"type\":\"string\"}},{\"description\":\"\",\"schema\":{\"$ref\":\"#/definitions/Day\"}}]"

123−declareResponse :: ToSchema a => Proxy a -> Declare (Definitions Schema) Response

122+declareResponse :: ToSchema a => proxy a -> Declare (Definitions Schema) Response

124123declareResponse proxy = do

125124 s <- declareSchemaRef proxy

126125 return (mempty & schema ?~ s)

@@ -191,3 +190,4 @@ setResponseForWith ops f code dres swag = swag

191190 Nothing -> new -- response name can't be dereferenced, replacing with new response

192191 combine (Just (Inline old)) = f old new

193192 combine Nothing = new

193+

src/Data/Swagger/Optics.hsdeleted−597

@@ -1,597 +0,0 @@

1−{-# LANGUAGE DataKinds #-}

2−{-# LANGUAGE FlexibleInstances #-}

3−{-# LANGUAGE MultiParamTypeClasses #-}

4−{-# LANGUAGE OverloadedLabels #-}

5−{-# LANGUAGE TemplateHaskell #-}

6−{-# LANGUAGE TypeFamilies #-}

7−{-# LANGUAGE UndecidableInstances #-}

8−{-# OPTIONS_GHC -fno-warn-orphans #-}

9−-- |

10−-- Module: Data.Swagger.Optics

11−-- Maintainer: Andrzej Rybczak <andrzej@rybczak.net>

12−-- Stability: experimental

13−--

14−-- Lenses and prisms for the <https://hackage.haskell.org/package/optics optics>

15−-- library.

16−--

17−-- >>> import Data.Aeson

18−-- >>> import Optics.Core

19−-- >>> :set -XOverloadedLabels

20−--

21−-- Example from the "Data.Swagger" module using @optics@:

22−--

23−-- >>> :{

24−-- encode $ (mempty :: Swagger)

25−-- & #definitions .~ [ ("User", mempty & #type ?~ SwaggerString) ]

26−-- & #paths .~

27−-- [ ("/user", mempty & #get ?~ (mempty

28−-- & #produces ?~ MimeList ["application/json"]

29−-- & at 200 ?~ ("OK" & #_Inline % #schema ?~ Ref (Reference "User"))

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

31−-- :}

32−-- "{\"swagger\":\"2.0\",\"info\":{\"version\":\"\",\"title\":\"\"},\"paths\":{\"/user\":{\"get\":{\"produces\":[\"application/json\"],\"responses\":{\"404\":{\"description\":\"User info not found\"},\"200\":{\"schema\":{\"$ref\":\"#/definitions/User\"},\"description\":\"OK\"}}}}},\"definitions\":{\"User\":{\"type\":\"string\"}}}"

33−--

34−-- For convenience optics are defined as /labels/. It means that field accessor

35−-- names can be overloaded for different types. One such common field is

36−-- @#description@. Many components of a Swagger specification can have

37−-- descriptions, and you can use the same name for them:

38−--

39−-- >>> encode $ (mempty :: Response) & #description .~ "No content"

40−-- "{\"description\":\"No content\"}"

41−-- >>> :{

42−-- encode $ (mempty :: Schema)

43−-- & #type ?~ SwaggerBoolean

44−-- & #description ?~ "To be or not to be"

45−-- :}

46−-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"

47−--

48−-- @'ParamSchema'@ is basically the /base schema specification/ and many types

49−-- contain it. So for convenience, all @'ParamSchema'@ fields are transitively

50−-- made fields of the type that has it. For example, you can use @#type@ to

51−-- access @'SwaggerType'@ of @'Header'@ schema without having to use

52−-- @#paramSchema@:

53−--

54−-- >>> encode $ (mempty :: Header) & #type ?~ SwaggerNumber

55−-- "{\"type\":\"number\"}"

56−--

57−-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and

58−-- @'Responses'@ have direct access to it via @'Optics.Core.At.at'@. Example:

59−--

60−-- >>> :{

61−-- encode $ (mempty :: Operation)

62−-- & at 404 ?~ "Not found"

63−-- :}

64−-- "{\"responses\":{\"404\":{\"description\":\"Not found\"}}}"

65−--

66−module Data.Swagger.Optics () where

67−

68−import Data.Aeson (Value)

69−import Data.Scientific (Scientific)

70−import Data.Swagger.Internal

71−import Data.Text (Text)

72−import Optics.Core

73−import Optics.TH

74−

75−-- Lenses

76−

77−makeFieldLabels ''Swagger

78−makeFieldLabels ''Host

79−makeFieldLabels ''Info

80−makeFieldLabels ''Contact

81−makeFieldLabels ''License

82−makeFieldLabels ''PathItem

83−makeFieldLabels ''Tag

84−makeFieldLabels ''Operation

85−makeFieldLabels ''Param

86−makeFieldLabels ''ParamOtherSchema

87−makeFieldLabels ''Header

88−makeFieldLabels ''Schema

89−makeFieldLabels ''NamedSchema

90−makeFieldLabels ''ParamSchema

91−makeFieldLabels ''Xml

92−makeFieldLabels ''Responses

93−makeFieldLabels ''Response

94−makeFieldLabels ''SecurityScheme

95−makeFieldLabels ''ApiKeyParams

96−makeFieldLabels ''OAuth2Params

97−makeFieldLabels ''ExternalDocs

98−

99−-- Prisms

100−

101−makePrismLabels ''ParamAnySchema

102−makePrismLabels ''SecuritySchemeType

103−makePrismLabels ''Referenced

104−

105−-- SwaggerItems prisms

106−

107−instance

108− ( a ~ [Referenced Schema]

109− , b ~ [Referenced Schema]

110− ) => LabelOptic "_SwaggerItemsArray"

111− A_Review

112− (SwaggerItems 'SwaggerKindSchema)

113− (SwaggerItems 'SwaggerKindSchema)

114− a

115− b where

116− labelOptic = unto (\x -> SwaggerItemsArray x)

117− {-# INLINE labelOptic #-}

118−

119−instance

120− ( a ~ Referenced Schema

121− , b ~ Referenced Schema

122− ) => LabelOptic "_SwaggerItemsObject"

123− A_Review

124− (SwaggerItems 'SwaggerKindSchema)

125− (SwaggerItems 'SwaggerKindSchema)

126− a

127− b where

128− labelOptic = unto (\x -> SwaggerItemsObject x)

129− {-# INLINE labelOptic #-}

130−

131−instance

132− ( a ~ (Maybe (CollectionFormat t), ParamSchema t)

133− , b ~ (Maybe (CollectionFormat t), ParamSchema t)

134− ) => LabelOptic "_SwaggerItemsPrimitive"

135− A_Review

136− (SwaggerItems t)

137− (SwaggerItems t)

138− a

139− b where

140− labelOptic = unto (\(c, p) -> SwaggerItemsPrimitive c p)

141− {-# INLINE labelOptic #-}

142−

143−-- =============================================================

144−-- More helpful instances for easier access to schema properties

145−

146−type instance Index Responses = HttpStatusCode

147−type instance Index Operation = HttpStatusCode

148−

149−type instance IxValue Responses = Referenced Response

150−type instance IxValue Operation = Referenced Response

151−

152−instance Ixed Responses where

153− ix n = #responses % ix n

154− {-# INLINE ix #-}

155−instance At Responses where

156− at n = #responses % at n

157− {-# INLINE at #-}

158−

159−instance Ixed Operation where

160− ix n = #responses % ix n

161− {-# INLINE ix #-}

162−instance At Operation where

163− at n = #responses % at n

164− {-# INLINE at #-}

165−

166−-- #paramSchema

167−

168−instance

169− ( a ~ ParamSchema 'SwaggerKindSchema

170− , b ~ ParamSchema 'SwaggerKindSchema

171− ) => LabelOptic "paramSchema" A_Lens NamedSchema NamedSchema a b where

172− labelOptic = #schema % #paramSchema

173− {-# INLINE labelOptic #-}

174−

175−-- #type

176−

177−instance

178− ( a ~ Maybe (SwaggerType ('SwaggerKindNormal Header))

179− , b ~ Maybe (SwaggerType ('SwaggerKindNormal Header))

180− ) => LabelOptic "type" A_Lens Header Header a b where

181− labelOptic = #paramSchema % #type

182− {-# INLINE labelOptic #-}

183−

184−instance

185− ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)

186− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)

187− ) => LabelOptic "type" A_Lens Schema Schema a b where

188− labelOptic = #paramSchema % #type

189− {-# INLINE labelOptic #-}

190−

191−instance

192− ( a ~ Maybe (SwaggerType 'SwaggerKindSchema)

193− , b ~ Maybe (SwaggerType 'SwaggerKindSchema)

194− ) => LabelOptic "type" A_Lens NamedSchema NamedSchema a b where

195− labelOptic = #paramSchema % #type

196− {-# INLINE labelOptic #-}

197−

198−instance

199− ( a ~ Maybe (SwaggerType 'SwaggerKindParamOtherSchema)

200− , b ~ Maybe (SwaggerType 'SwaggerKindParamOtherSchema)

201− ) => LabelOptic "type" A_Lens ParamOtherSchema ParamOtherSchema a b where

202− labelOptic = #paramSchema % #type

203− {-# INLINE labelOptic #-}

204−

205−-- #default

206−

207−instance

208− ( a ~ Maybe Value, b ~ Maybe Value

209− ) => LabelOptic "default" A_Lens Header Header a b where

210− labelOptic = #paramSchema % #default

211− {-# INLINE labelOptic #-}

212−

213−instance

214− ( a ~ Maybe Value, b ~ Maybe Value

215− ) => LabelOptic "default" A_Lens Schema Schema a b where

216− labelOptic = #paramSchema % #default

217− {-# INLINE labelOptic #-}

218−

219−instance

220− ( a ~ Maybe Value, b ~ Maybe Value

221− ) => LabelOptic "default" A_Lens NamedSchema NamedSchema a b where

222− labelOptic = #paramSchema % #default

223− {-# INLINE labelOptic #-}

224−

225−instance

226− ( a ~ Maybe Value, b ~ Maybe Value

227− ) => LabelOptic "default" A_Lens ParamOtherSchema ParamOtherSchema a b where

228− labelOptic = #paramSchema % #default

229− {-# INLINE labelOptic #-}

230−

231−-- #format

232−

233−instance

234− ( a ~ Maybe Format, b ~ Maybe Format

235− ) => LabelOptic "format" A_Lens Header Header a b where

236− labelOptic = #paramSchema % #format

237− {-# INLINE labelOptic #-}

238−

239−instance

240− ( a ~ Maybe Format, b ~ Maybe Format

241− ) => LabelOptic "format" A_Lens Schema Schema a b where

242− labelOptic = #paramSchema % #format

243− {-# INLINE labelOptic #-}

244−

245−instance

246− ( a ~ Maybe Format, b ~ Maybe Format

247− ) => LabelOptic "format" A_Lens NamedSchema NamedSchema a b where

248− labelOptic = #paramSchema % #format

249− {-# INLINE labelOptic #-}

250−

251−instance

252− ( a ~ Maybe Format, b ~ Maybe Format

253− ) => LabelOptic "format" A_Lens ParamOtherSchema ParamOtherSchema a b where

254− labelOptic = #paramSchema % #format

255− {-# INLINE labelOptic #-}

256−

257−-- #items

258−

259−instance

260− ( a ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))

261− , b ~ Maybe (SwaggerItems ('SwaggerKindNormal Header))

262− ) => LabelOptic "items" A_Lens Header Header a b where

263− labelOptic = #paramSchema % #items

264− {-# INLINE labelOptic #-}

265−

266−instance

267− ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)

268− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)

269− ) => LabelOptic "items" A_Lens Schema Schema a b where

270− labelOptic = #paramSchema % #items

271− {-# INLINE labelOptic #-}

272−

273−instance

274− ( a ~ Maybe (SwaggerItems 'SwaggerKindSchema)

275− , b ~ Maybe (SwaggerItems 'SwaggerKindSchema)

276− ) => LabelOptic "items" A_Lens NamedSchema NamedSchema a b where

277− labelOptic = #paramSchema % #items

278− {-# INLINE labelOptic #-}

279−

280−instance

281− ( a ~ Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)

282− , b ~ Maybe (SwaggerItems 'SwaggerKindParamOtherSchema)

283− ) => LabelOptic "items" A_Lens ParamOtherSchema ParamOtherSchema a b where

284− labelOptic = #paramSchema % #items

285− {-# INLINE labelOptic #-}

286−

287−-- #maximum

288−

289−instance

290− ( a ~ Maybe Scientific, b ~ Maybe Scientific

291− ) => LabelOptic "maximum" A_Lens Header Header a b where

292− labelOptic = #paramSchema % #maximum

293− {-# INLINE labelOptic #-}

294−

295−instance

296− ( a ~ Maybe Scientific, b ~ Maybe Scientific

297− ) => LabelOptic "maximum" A_Lens Schema Schema a b where

298− labelOptic = #paramSchema % #maximum

299− {-# INLINE labelOptic #-}

300−

301−instance

302− ( a ~ Maybe Scientific, b ~ Maybe Scientific

303− ) => LabelOptic "maximum" A_Lens NamedSchema NamedSchema a b where

304− labelOptic = #paramSchema % #maximum

305− {-# INLINE labelOptic #-}

306−

307−instance

308− ( a ~ Maybe Scientific, b ~ Maybe Scientific

309− ) => LabelOptic "maximum" A_Lens ParamOtherSchema ParamOtherSchema a b where

310− labelOptic = #paramSchema % #maximum

311− {-# INLINE labelOptic #-}

312−

313−-- #exclusiveMaximum

314−

315−instance

316− ( a ~ Maybe Bool, b ~ Maybe Bool

317− ) => LabelOptic "exclusiveMaximum" A_Lens Header Header a b where

318− labelOptic = #paramSchema % #exclusiveMaximum

319− {-# INLINE labelOptic #-}

320−

321−instance

322− ( a ~ Maybe Bool, b ~ Maybe Bool

323− ) => LabelOptic "exclusiveMaximum" A_Lens Schema Schema a b where

324− labelOptic = #paramSchema % #exclusiveMaximum

325− {-# INLINE labelOptic #-}

326−

327−instance

328− ( a ~ Maybe Bool, b ~ Maybe Bool

329− ) => LabelOptic "exclusiveMaximum" A_Lens NamedSchema NamedSchema a b where

330− labelOptic = #paramSchema % #exclusiveMaximum

331− {-# INLINE labelOptic #-}

332−

333−instance

334− ( a ~ Maybe Bool, b ~ Maybe Bool

335− ) => LabelOptic "exclusiveMaximum" A_Lens ParamOtherSchema ParamOtherSchema a b where

336− labelOptic = #paramSchema % #exclusiveMaximum

337− {-# INLINE labelOptic #-}

338−

339−-- #minimum

340−

341−instance

342− ( a ~ Maybe Scientific, b ~ Maybe Scientific

343− ) => LabelOptic "minimum" A_Lens Header Header a b where

344− labelOptic = #paramSchema % #minimum

345− {-# INLINE labelOptic #-}

346−

347−instance

348− ( a ~ Maybe Scientific, b ~ Maybe Scientific

349− ) => LabelOptic "minimum" A_Lens Schema Schema a b where

350− labelOptic = #paramSchema % #minimum

351− {-# INLINE labelOptic #-}

352−

353−instance

354− ( a ~ Maybe Scientific, b ~ Maybe Scientific

355− ) => LabelOptic "minimum" A_Lens NamedSchema NamedSchema a b where

356− labelOptic = #paramSchema % #minimum

357− {-# INLINE labelOptic #-}

358−

359−instance

360− ( a ~ Maybe Scientific, b ~ Maybe Scientific

361− ) => LabelOptic "minimum" A_Lens ParamOtherSchema ParamOtherSchema a b where

362− labelOptic = #paramSchema % #minimum

363− {-# INLINE labelOptic #-}

364−

365−-- #exclusiveMinimum

366−

367−instance

368− ( a ~ Maybe Bool, b ~ Maybe Bool

369− ) => LabelOptic "exclusiveMinimum" A_Lens Header Header a b where

370− labelOptic = #paramSchema % #exclusiveMinimum

371− {-# INLINE labelOptic #-}

372−

373−instance

374− ( a ~ Maybe Bool, b ~ Maybe Bool

375− ) => LabelOptic "exclusiveMinimum" A_Lens Schema Schema a b where

376− labelOptic = #paramSchema % #exclusiveMinimum

377− {-# INLINE labelOptic #-}

378−

379−instance

380− ( a ~ Maybe Bool, b ~ Maybe Bool

381− ) => LabelOptic "exclusiveMinimum" A_Lens NamedSchema NamedSchema a b where

382− labelOptic = #paramSchema % #exclusiveMinimum

383− {-# INLINE labelOptic #-}

384−

385−instance

386− ( a ~ Maybe Bool, b ~ Maybe Bool

387− ) => LabelOptic "exclusiveMinimum" A_Lens ParamOtherSchema ParamOtherSchema a b where

388− labelOptic = #paramSchema % #exclusiveMinimum

389− {-# INLINE labelOptic #-}

390−

391−-- #maxLength

392−

393−instance

394− ( a ~ Maybe Integer, b ~ Maybe Integer

395− ) => LabelOptic "maxLength" A_Lens Header Header a b where

396− labelOptic = #paramSchema % #maxLength

397− {-# INLINE labelOptic #-}

398−

399−instance

400− ( a ~ Maybe Integer, b ~ Maybe Integer

401− ) => LabelOptic "maxLength" A_Lens Schema Schema a b where

402− labelOptic = #paramSchema % #maxLength

403− {-# INLINE labelOptic #-}

404−

405−instance

406− ( a ~ Maybe Integer, b ~ Maybe Integer

407− ) => LabelOptic "maxLength" A_Lens NamedSchema NamedSchema a b where

408− labelOptic = #paramSchema % #maxLength

409− {-# INLINE labelOptic #-}

410−

411−instance

412− ( a ~ Maybe Integer, b ~ Maybe Integer

413− ) => LabelOptic "maxLength" A_Lens ParamOtherSchema ParamOtherSchema a b where

414− labelOptic = #paramSchema % #maxLength

415− {-# INLINE labelOptic #-}

416−

417−-- #minLength

418−

419−instance

420− ( a ~ Maybe Integer, b ~ Maybe Integer

421− ) => LabelOptic "minLength" A_Lens Header Header a b where

422− labelOptic = #paramSchema % #minLength

423− {-# INLINE labelOptic #-}

424−

425−instance

426− ( a ~ Maybe Integer, b ~ Maybe Integer

427− ) => LabelOptic "minLength" A_Lens Schema Schema a b where

428− labelOptic = #paramSchema % #minLength

429− {-# INLINE labelOptic #-}

430−

431−instance

432− ( a ~ Maybe Integer, b ~ Maybe Integer

433− ) => LabelOptic "minLength" A_Lens NamedSchema NamedSchema a b where

434− labelOptic = #paramSchema % #minLength

435− {-# INLINE labelOptic #-}

436−

437−instance

438− ( a ~ Maybe Integer, b ~ Maybe Integer

439− ) => LabelOptic "minLength" A_Lens ParamOtherSchema ParamOtherSchema a b where

440− labelOptic = #paramSchema % #minLength

441− {-# INLINE labelOptic #-}

442−

443−-- #pattern

444−

445−instance

446− ( a ~ Maybe Text, b ~ Maybe Text

447− ) => LabelOptic "pattern" A_Lens Header Header a b where

448− labelOptic = #paramSchema % #pattern

449− {-# INLINE labelOptic #-}

450−

451−instance

452− ( a ~ Maybe Text, b ~ Maybe Text

453− ) => LabelOptic "pattern" A_Lens Schema Schema a b where

454− labelOptic = #paramSchema % #pattern

455− {-# INLINE labelOptic #-}

456−

457−instance

458− ( a ~ Maybe Text, b ~ Maybe Text

459− ) => LabelOptic "pattern" A_Lens NamedSchema NamedSchema a b where

460− labelOptic = #paramSchema % #pattern

461− {-# INLINE labelOptic #-}

462−

463−instance

464− ( a ~ Maybe Text, b ~ Maybe Text

465− ) => LabelOptic "pattern" A_Lens ParamOtherSchema ParamOtherSchema a b where

466− labelOptic = #paramSchema % #pattern

467− {-# INLINE labelOptic #-}

468−

469−-- #maxItems

470−

471−instance

472− ( a ~ Maybe Integer, b ~ Maybe Integer

473− ) => LabelOptic "maxItems" A_Lens Header Header a b where

474− labelOptic = #paramSchema % #maxItems

475− {-# INLINE labelOptic #-}

476−

477−instance

478− ( a ~ Maybe Integer, b ~ Maybe Integer

479− ) => LabelOptic "maxItems" A_Lens Schema Schema a b where

480− labelOptic = #paramSchema % #maxItems

481− {-# INLINE labelOptic #-}

482−

483−instance

484− ( a ~ Maybe Integer, b ~ Maybe Integer

485− ) => LabelOptic "maxItems" A_Lens NamedSchema NamedSchema a b where

486− labelOptic = #paramSchema % #maxItems

487− {-# INLINE labelOptic #-}

488−

489−instance

490− ( a ~ Maybe Integer, b ~ Maybe Integer

491− ) => LabelOptic "maxItems" A_Lens ParamOtherSchema ParamOtherSchema a b where

492− labelOptic = #paramSchema % #maxItems

493− {-# INLINE labelOptic #-}

494−

495−-- #minItems

496−

497−instance

498− ( a ~ Maybe Integer, b ~ Maybe Integer

499− ) => LabelOptic "minItems" A_Lens Header Header a b where

500− labelOptic = #paramSchema % #minItems

501− {-# INLINE labelOptic #-}

502−

503−instance

504− ( a ~ Maybe Integer, b ~ Maybe Integer

505− ) => LabelOptic "minItems" A_Lens Schema Schema a b where

506− labelOptic = #paramSchema % #minItems

507− {-# INLINE labelOptic #-}

508−

509−instance

510− ( a ~ Maybe Integer, b ~ Maybe Integer

511− ) => LabelOptic "minItems" A_Lens NamedSchema NamedSchema a b where

512− labelOptic = #paramSchema % #minItems

513− {-# INLINE labelOptic #-}

514−

515−instance

516− ( a ~ Maybe Integer, b ~ Maybe Integer

517− ) => LabelOptic "minItems" A_Lens ParamOtherSchema ParamOtherSchema a b where

518− labelOptic = #paramSchema % #minItems

519− {-# INLINE labelOptic #-}

520−

521−-- #uniqueItems

522−

523−instance

524− ( a ~ Maybe Bool, b ~ Maybe Bool

525− ) => LabelOptic "uniqueItems" A_Lens Header Header a b where

526− labelOptic = #paramSchema % #uniqueItems

527− {-# INLINE labelOptic #-}

528−

529−instance

530− ( a ~ Maybe Bool, b ~ Maybe Bool

531− ) => LabelOptic "uniqueItems" A_Lens Schema Schema a b where

532− labelOptic = #paramSchema % #uniqueItems

533− {-# INLINE labelOptic #-}

534−

535−instance

536− ( a ~ Maybe Bool, b ~ Maybe Bool

537− ) => LabelOptic "uniqueItems" A_Lens NamedSchema NamedSchema a b where

538− labelOptic = #paramSchema % #uniqueItems

539− {-# INLINE labelOptic #-}

540−

541−instance

542− ( a ~ Maybe Bool, b ~ Maybe Bool

543− ) => LabelOptic "uniqueItems" A_Lens ParamOtherSchema ParamOtherSchema a b where

544− labelOptic = #paramSchema % #uniqueItems

545− {-# INLINE labelOptic #-}

546−

547−-- #enum

548−

549−instance

550− ( a ~ Maybe [Value], b ~ Maybe [Value]

551− ) => LabelOptic "enum" A_Lens Header Header a b where

552− labelOptic = #paramSchema % #enum

553− {-# INLINE labelOptic #-}

554−

555−instance

556− ( a ~ Maybe [Value], b ~ Maybe [Value]

557− ) => LabelOptic "enum" A_Lens Schema Schema a b where

558− labelOptic = #paramSchema % #enum

559− {-# INLINE labelOptic #-}

560−

561−instance

562− ( a ~ Maybe [Value], b ~ Maybe [Value]

563− ) => LabelOptic "enum" A_Lens NamedSchema NamedSchema a b where

564− labelOptic = #paramSchema % #enum

565− {-# INLINE labelOptic #-}

566−

567−instance

568− ( a ~ Maybe [Value], b ~ Maybe [Value]

569− ) => LabelOptic "enum" A_Lens ParamOtherSchema ParamOtherSchema a b where

570− labelOptic = #paramSchema % #enum

571− {-# INLINE labelOptic #-}

572−

573−-- #multipleOf

574−

575−instance

576− ( a ~ Maybe Scientific, b ~ Maybe Scientific

577− ) => LabelOptic "multipleOf" A_Lens Header Header a b where

578− labelOptic = #paramSchema % #multipleOf

579− {-# INLINE labelOptic #-}

580−

581−instance

582− ( a ~ Maybe Scientific, b ~ Maybe Scientific

583− ) => LabelOptic "multipleOf" A_Lens Schema Schema a b where

584− labelOptic = #paramSchema % #multipleOf

585− {-# INLINE labelOptic #-}

586−

587−instance

588− ( a ~ Maybe Scientific, b ~ Maybe Scientific

589− ) => LabelOptic "multipleOf" A_Lens NamedSchema NamedSchema a b where

590− labelOptic = #paramSchema % #multipleOf

591− {-# INLINE labelOptic #-}

592−

593−instance

594− ( a ~ Maybe Scientific, b ~ Maybe Scientific

595− ) => LabelOptic "multipleOf" A_Lens ParamOtherSchema ParamOtherSchema a b where

596− labelOptic = #paramSchema % #multipleOf

597− {-# INLINE labelOptic #-}

src/Data/Swagger/Schema/Generator.hsdeleted−114

@@ -1,114 +0,0 @@

1−{-# LANGUAGE GADTs #-}

2−{-# LANGUAGE OverloadedLists #-}

3−{-# LANGUAGE ScopedTypeVariables #-}

4−

5−module Data.Swagger.Schema.Generator where

6−

7−import Prelude ()

8−import Prelude.Compat

9−

10−import Control.Lens.Operators

11−import Control.Monad (filterM)

12−import Data.Aeson

13−import Data.Aeson.Types

14−import qualified Data.HashMap.Strict.InsOrd as M

15−import Data.Maybe

16−import Data.Maybe

17−import Data.Proxy

18−import Data.Scientific

19−import qualified Data.Set as S

20−import Data.Swagger

21−import Data.Swagger.Declare

22−import Data.Swagger.Internal.Schema.Validation (inferSchemaTypes)

23−import qualified Data.Text as T

24−import qualified Data.Vector as V

25−import Test.QuickCheck (arbitrary)

26−import Test.QuickCheck.Gen

27−import Test.QuickCheck.Property

28−

29−-- | Note: 'schemaGen' may 'error', if schema type is not specified,

30−-- and cannot be inferred.

31−schemaGen :: Definitions Schema -> Schema -> Gen Value

32−schemaGen _ schema

33− | Just cases <- schema ^. paramSchema . enum_ = elements cases

34−schemaGen defns schema =

35− case schema ^. type_ of

36− Nothing ->

37− case inferSchemaTypes schema of

38− [ inferredType ] -> schemaGen defns (schema & type_ ?~ inferredType)

39− -- Gen is not MonadFail

40− _ -> error "unable to infer schema type"

41− Just SwaggerBoolean -> Bool <$> elements [True, False]

42− Just SwaggerNull -> pure Null

43− Just SwaggerNumber

44− | Just min <- schema ^. minimum_

45− , Just max <- schema ^. maximum_ ->

46− Number . fromFloatDigits <$>

47− choose (toRealFloat min, toRealFloat max :: Double)

48− | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)

49− Just SwaggerInteger

50− | Just min <- schema ^. minimum_

51− , Just max <- schema ^. maximum_ ->

52− Number . fromInteger <$>

53− choose (truncate min, truncate max)

54− | otherwise -> Number . fromInteger <$> arbitrary

55− Just SwaggerArray

56− | Just 0 <- schema ^. maxLength -> pure $ Array V.empty

57− | Just items <- schema ^. items ->

58− case items of

59− SwaggerItemsObject ref -> do

60− size <- getSize

61− let itemSchema = dereference defns ref

62− minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minItems

63− maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxItems

64− arrayLength <- choose (minLength', max minLength' maxLength')

65− generatedArray <- vectorOf arrayLength $ schemaGen defns itemSchema

66− return . Array $ V.fromList generatedArray

67− SwaggerItemsArray refs ->

68− let itemGens = schemaGen defns . dereference defns <$> refs

69− in fmap (Array . V.fromList) $ sequence itemGens

70− Just SwaggerString -> do

71− size <- getSize

72− let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength

73− let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength

74− length <- choose (minLength', max minLength' maxLength')

75− str <- vectorOf length arbitrary

76− return . String $ T.pack str

77− Just SwaggerObject -> do

78− size <- getSize

79− let props = dereference defns <$> schema ^. properties

80− reqKeys = S.fromList $ schema ^. required

81− allKeys = S.fromList . M.keys $ schema ^. properties

82− optionalKeys = allKeys S.\\ reqKeys

83− minProps' = fromMaybe (length reqKeys) $

84− fromInteger <$> schema ^. minProperties

85− maxProps' = fromMaybe size $ fromInteger <$> schema ^. maxProperties

86− shuffledOptional <- shuffle $ S.toList optionalKeys

87− numProps <- choose (minProps', max minProps' maxProps')

88− let presentKeys = take numProps $ S.toList reqKeys ++ shuffledOptional

89− let presentProps = M.filterWithKey (\k _ -> k `elem` presentKeys) props

90− let gens = schemaGen defns <$> presentProps

91− additionalGens <- case schema ^. additionalProperties of

92− Just (AdditionalPropertiesSchema addlSchema) -> do

93− additionalKeys <- sequence . take (numProps - length presentProps) . repeat $ T.pack <$> arbitrary

94− return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)

95− _ -> return []

96− x <- sequence $ gens <> additionalGens

97− return . Object $ M.toHashMap x

98− where

99− dereference :: Definitions a -> Referenced a -> a

100− dereference _ (Inline a) = a

101− dereference defs (Ref (Reference ref)) = fromJust $ M.lookup ref defs

102−

103−genValue :: (ToSchema a) => Proxy a -> Gen Value

104−genValue p =

105− let (defs, NamedSchema _ schema) = runDeclare (declareNamedSchema p) M.empty

106− in schemaGen defs schema

107−

108−validateFromJSON :: forall a . (ToSchema a, FromJSON a) => Proxy a -> Property

109−validateFromJSON p = forAll (genValue p) $

110− \val -> case parseEither parseJSON val of

111− Right (_ :: a) -> succeeded

112− Left err -> failed

113− { reason = err

114− }

src/Data/Swagger/Schema/Validation.hs−2

@@ -19,10 +19,8 @@ module Data.Swagger.Schema.Validation (

1919 ValidationError,

2020

2121 -- ** Using 'ToJSON' and 'ToSchema'

22− validatePrettyToJSON,

2322 validateToJSON,

2423 validateToJSONWithPatternChecker,

25− renderValidationErrors,

2624

2725 -- ** Using 'Value' and 'Schema'

2826 validateJSON,

stack-ghc-8.0.yamlnew file+5

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

1+resolver: nightly-2016-05-29

2+packages:

3+- '.'

4+extra-deps:

5+ - aeson-0.11.2.1

stack-lts-2.yamlnew file+22

@@ -0,0 +1,22 @@

1+flags: {}

2+packages:

3+- '.'

4+extra-deps:

5+- aeson-0.11.2.1

6+- attoparsec-0.13.1.0

7+- base-compat-0.9.1

8+- fail-4.9.0.0

9+- generics-sop-0.2.1.0

10+- insert-ordered-containers-0.1.0.1

11+- primitive-0.6.1.0

12+- QuickCheck-2.8.2

13+- tagged-0.8.4

14+- unordered-containers-0.2.7.0

15+resolver: lts-2.22

16+flags:

17+ aeson:

18+ old-locale: true

19+ QuickCheck:

20+ base3: false

21+ base4: true

22+ base4point8: false

stack.yaml+2−6

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

1−resolver: lts-14.3

1+resolver: lts-9.3

22packages:

33- '.'

44extra-deps:

5−- optics-core-0.2

6−- optics-th-0.2

7−- optics-extra-0.2

8−- indexed-profunctors-0.1

9−- insert-ordered-containers-0.2.3

5+- aeson-1.2.2.0

swagger2.cabal+55−82

@@ -1,15 +1,11 @@

1−cabal-version: >=1.10

21name: swagger2

3−version: 2.5

4−

2+version: 2.2.1

53synopsis: Swagger 2.0 data model

6−category: Web, Swagger

74description:

8− This library is intended to be used for decoding and encoding Swagger 2.0 API

5+ This library is inteded to be used for decoding and encoding Swagger 2.0 API

96 specifications as well as manipulating them.

107 .

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

12−

139homepage: https://github.com/GetShopTV/swagger2

1410bug-reports: https://github.com/GetShopTV/swagger2/issues

1511license: BSD3

@@ -17,22 +13,19 @@ license-file: LICENSE

1713author: Nickolay Kudasov

1814maintainer: nickolay@getshoptv.com

16+category: Web, Swagger

2017build-type: Custom

2118extra-source-files:

2219 README.md

2320 , CHANGELOG.md

2421 , examples/*.hs

2522 , include/overlapping-compat.h

26−tested-with:

27− GHC ==8.0.2

28− || ==8.2.2

29− || ==8.4.4

30− || ==8.6.5

31− || ==8.8.1

23+cabal-version: >=1.10

24+tested-with: GHC==7.8.4, GHC==7.10.3, GHC==8.0.2, GHC==8.2.2, GHC==8.4.1

3225

3326custom-setup

3427 setup-depends:

35− base, Cabal, cabal-doctest >=1.0.6 && <1.1

28+ base, Cabal, cabal-doctest >=1.0.2 && <1.1

3629

3730library

3831 hs-source-dirs: src

@@ -42,10 +35,8 @@ library

4235 Data.Swagger.Declare

4336 Data.Swagger.Lens

4437 Data.Swagger.Operation

45− Data.Swagger.Optics

4638 Data.Swagger.ParamSchema

4739 Data.Swagger.Schema

48− Data.Swagger.Schema.Generator

4940 Data.Swagger.Schema.Validation

5041 Data.Swagger.SchemaOptions

5142

@@ -57,79 +48,59 @@ library

5748 Data.Swagger.Internal.Utils

5849 Data.Swagger.Internal.AesonUtils

5950 Data.Swagger.Internal.TypeShape

60−

61− -- GHC boot libraries

62− build-depends:

63− base >=4.9 && <4.14

64− , aeson-pretty >=0.8.7 && <0.9

65− , bytestring >=0.10.4.0 && <0.11

66− , containers >=0.5.5.1 && <0.7

67− , template-haskell >=2.9.0.0 && <2.16

68− , time >=1.4.2 && <1.10

69− , transformers >=0.3.0.0 && <0.6

70−

71− build-depends:

72− mtl >=2.1 && <2.3

73− , text >=1.2.3.0 && <1.3

74−

75− -- other dependencies

76− build-depends:

77− base-compat-batteries >=0.10.4 && <0.12

78− , aeson >=1.4.2.0 && <1.5

79− -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint

80− , cookie >=0.4.3 && <0.5

81− , generics-sop >=0.3.2.0 && <0.6

82− , hashable >=1.2.7.0 && <1.4

83− , http-media >=0.7.1.2 && <0.9

84− , insert-ordered-containers >=0.2.3 && <0.3

85− , lens >=4.16.1 && <4.19

86− , network >=2.6.3.5 && <3.2

87− , optics-core >=0.2 && <0.3

88− , optics-th >=0.2 && <0.3

89− , scientific >=0.3.6.2 && <0.4

90− , transformers-compat >=0.3 && <0.7

91− , unordered-containers >=0.2.9.0 && <0.3

92− , uuid-types >=1.0.3 && <1.1

93− , vector >=0.12.0.1 && <0.13

94− , QuickCheck >=2.10.1 && <2.14

95−

51+ build-depends: base >=4.7 && <4.12

52+ , base-compat >=0.9.1 && <0.10

53+ , aeson >=0.11.2.1

54+ , bytestring

55+ , containers

56+ , hashable

57+ , generics-sop >=0.2 && <0.4

58+ , http-media

59+ , insert-ordered-containers >=0.1.0.0 && <0.3

60+ , lens

61+ , mtl

62+ , network

63+ , scientific

64+ , text

65+ , template-haskell

66+ , time

67+ , transformers

68+ , transformers-compat >= 0.3

69+ , unordered-containers

70+ , vector

71+ , uuid-types >=1.0.2 && <1.1

72+ if !impl(ghc >= 7.10)

73+ build-depends: nats >=1.1.1 && <1.2

74+ if !impl(ghc >= 8.0)

75+ build-depends: semigroups >= 0.18.3 && <0.19

9676 default-language: Haskell2010

9777

9878test-suite spec

9979 type: exitcode-stdio-1.0

10080 hs-source-dirs: test

10181 main-is: Spec.hs

102−

103− -- From library parat

10482 -- We need aeson's toEncoding for doctests too

105− build-depends:

106− base

107− , swagger2

108− , aeson

109− , base-compat-batteries

110− , bytestring

111− , containers

112− , hashable

113− , insert-ordered-containers

114− , lens

115− , mtl

116− , template-haskell

117− , text

118− , time

119− , unordered-containers

120− , vector

121− , QuickCheck

122−

123− -- test-suite only dependencies

124− build-depends:

125− hspec >=2.5.5 && <2.8

126− , HUnit >=1.6.0.0 && <1.7

127− , quickcheck-instances >=0.3.19 && <0.14

128− , utf8-string >=1.0.1.1 && <1.1

129−

130− -- https://github.com/haskell/cabal/issues/3708

131− build-tool-depends:

132− hspec-discover:hspec-discover >=2.5.5 && <2.8

83+ build-depends: base

84+ , base-compat

85+ , aeson >=0.10.0.0

86+ , aeson-qq

87+ , bytestring

88+ , containers

89+ , hashable

90+ , hspec

91+ , insert-ordered-containers

92+ , HUnit

93+ , mtl

94+ , QuickCheck >=2.8.2

95+ , quickcheck-instances

96+ , swagger2

97+ , text

98+ , time

99+ , unordered-containers

100+ , vector

101+ , lens

102+ if !impl(ghc >= 8.0)

103+ build-depends: semigroups

133104

134105 other-modules:

135106 SpecCommon

@@ -138,8 +109,10 @@ test-suite spec

138109 Data.Swagger.ParamSchemaSpec

139110 Data.Swagger.SchemaSpec

140111 Data.Swagger.Schema.ValidationSpec

141− Data.Swagger.Schema.GeneratorSpec

142112 default-language: Haskell2010

113+ -- https://github.com/haskell/cabal/issues/3708

114+ build-tool-depends:

115+ hspec-discover:hspec-discover

143116

144117test-suite doctests

145118 -- See QuickCheck note in https://github.com/phadej/cabal-doctest#notes

test/Data/Swagger/CommonTestTypes.hs+18−45

@@ -1,23 +1,25 @@

1−{-# LANGUAGE DeriveGeneric #-}

2−{-# LANGUAGE QuasiQuotes #-}

1+{-# LANGUAGE DeriveGeneric #-}

32{-# LANGUAGE ScopedTypeVariables #-}

3+{-# LANGUAGE QuasiQuotes #-}

55module Data.Swagger.CommonTestTypes where

7−import Prelude ()

8−import Prelude.Compat

7+import Prelude ()

8+import Prelude.Compat

10−import Data.Aeson (ToJSON (..), ToJSONKey (..), Value)

11−import Data.Aeson.QQ.Simple

12−import Data.Aeson.Types (toJSONKeyText)

13−import Data.Char

14−import Data.Map (Map)

15−import Data.Proxy

16−import Data.Set (Set)

17−import qualified Data.Text as Text

18−import GHC.Generics

10+import Data.Aeson (Value, ToJSON(..), ToJSONKey(..))

11+import Data.Aeson.Types (toJSONKeyText)

12+import Data.Aeson.QQ

13+import Data.Char

14+import Data.Proxy

15+import Data.Set (Set)

16+import Data.Map (Map)

17+import qualified Data.Text as Text

18+import GHC.Generics

1919

20−import Data.Swagger

20+import Data.Swagger

21+import Data.Swagger.Declare

22+import Data.Swagger.Internal (SwaggerKind(..))

2123

2224-- ========================================================================

2325-- Unit type

@@ -550,7 +552,7 @@ lightSchemaJSON = [aesonQQ|

550552 "type": "object",

551553 "properties":

552554 {

553− "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },

555+ "NoLight": { "type": "array", "items": [] },

554556 "LightFreq": { "type": "number", "format": "double" },

555557 "LightColor": { "$ref": "#/definitions/Color" },

556558 "LightWaveLength": { "type": "number", "format": "double" }

@@ -566,7 +568,7 @@ lightInlinedSchemaJSON = [aesonQQ|

566568 "type": "object",

567569 "properties":

568570 {

569− "NoLight": { "type": "array", "items": {}, "maxItems": 0, "example": [] },

571+ "NoLight": { "type": "array", "items": [] },

570572 "LightFreq": { "type": "number", "format": "double" },

571573 "LightColor":

572574 {

@@ -648,32 +650,3 @@ singleMaybeFieldSchemaJSON = [aesonQQ|

648650 }

649651}

650652|]

651−

652−

653−-- ========================================================================

654−-- TimeOfDay

655−-- ========================================================================

656−data TimeOfDay

657− = Int

658− | Pico

659− deriving (Generic)

660−instance ToSchema TimeOfDay

661−instance ToParamSchema TimeOfDay

662−

663−

664−timeOfDaySchemaJSON :: Value

665−timeOfDaySchemaJSON = [aesonQQ|

666−{

667− "example": "12:33:15",

668− "type": "string",

669− "format": "hh:MM:ss"

670−}

671−|]

672−

673−timeOfDayParamSchemaJSON :: Value

674−timeOfDayParamSchemaJSON = [aesonQQ|

675−{

676− "type": "string",

677− "format": "hh:MM:ss"

678−}

679−|]

test/Data/Swagger/ParamSchemaSpec.hs+2−7

@@ -3,11 +3,10 @@

33{-# LANGUAGE ScopedTypeVariables #-}

44{-# LANGUAGE TemplateHaskell #-}

55{-# LANGUAGE QuasiQuotes #-}

6−{-# LANGUAGE OverloadedStrings #-}

76module Data.Swagger.ParamSchemaSpec where

9−import Data.Aeson

10−import Data.Aeson.QQ.Simple

8+import Data.Aeson (Value)

9+import Data.Aeson.QQ

1110import Data.Char

1211import Data.Proxy

1312import GHC.Generics

@@ -18,9 +17,6 @@ import Data.Swagger.Internal (SwaggerKind(..))

1817import Data.Swagger.CommonTestTypes

1918import SpecCommon

2019import Test.Hspec

21−import Data.Time.LocalTime

22−

23−import qualified Data.HashMap.Strict as HM

2420

2521checkToParamSchema :: ToParamSchema a => Proxy a -> Value -> Spec

2622checkToParamSchema proxy js = (toParamSchema proxy :: ParamSchema ('SwaggerKindNormal Param)) <=> js

@@ -34,7 +30,6 @@ spec = do

3430 context "Unary records" $ do

3531 context "Email (unary record)" $ checkToParamSchema (Proxy :: Proxy Email) emailSchemaJSON

3632 context "UserId (non-record newtype)" $ checkToParamSchema (Proxy :: Proxy UserId) userIdSchemaJSON

37− context "TimeOfDay" $ checkToParamSchema (Proxy :: Proxy Data.Time.LocalTime.TimeOfDay) timeOfDayParamSchemaJSON

3833

3934main :: IO ()

4035main = hspec spec

test/Data/Swagger/Schema/GeneratorSpec.hsdeleted−168

@@ -1,168 +0,0 @@

1−{-# LANGUAGE OverloadedLists #-}

2−{-# LANGUAGE OverloadedStrings #-}

3−{-# LANGUAGE PackageImports #-}

4−module Data.Swagger.Schema.GeneratorSpec where

5−

6−import Prelude ()

7−import Prelude.Compat

8−

9−import Data.Swagger

10−import Data.Swagger.Schema.Generator

11−

12−import Control.Lens.Operators

13−import Data.Aeson

14−import Data.Hashable (Hashable)

15−import Data.HashMap.Strict (HashMap)

16−import qualified Data.HashMap.Strict as HashMap

17−import "unordered-containers" Data.HashSet (HashSet)

18−import qualified "unordered-containers" Data.HashSet as HashSet

19−import Data.Int

20−import Data.IntMap (IntMap)

21−import Data.List.NonEmpty.Compat (NonEmpty (..), nonEmpty)

22−import Data.Map (Map, fromList)

23−import Data.Monoid (mempty)

24−import Data.Proxy

25−import Data.Proxy

26−import Data.Set (Set)

27−import qualified Data.Text as T

28−import qualified Data.Text.Lazy as TL

29−import Data.Time

30−import Data.Version (Version)

31−import Data.Word

32−import GHC.Generics

33−

34−import Test.Hspec

35−import Test.Hspec.QuickCheck

36−import Test.QuickCheck

37−

38−shouldValidate :: (FromJSON a, ToSchema a) => Proxy a -> Property

39−shouldValidate = validateFromJSON

40−

41−

42−shouldNotValidate :: (FromJSON a, ToSchema a) => Proxy a -> Property

43−shouldNotValidate = expectFailure . shouldValidate

44−

45−

46−spec :: Spec

47−spec = do

48− describe "FromJSON validation" $ do

49− prop "Bool" $ shouldValidate (Proxy :: Proxy Bool)

50− prop "Char" $ shouldValidate (Proxy :: Proxy Char)

51− prop "Double" $ shouldValidate (Proxy :: Proxy Double)

52− prop "Float" $ shouldValidate (Proxy :: Proxy Float)

53− prop "Int" $ shouldValidate (Proxy :: Proxy Int)

54− prop "Int8" $ shouldValidate (Proxy :: Proxy Int8)

55− prop "Int16" $ shouldValidate (Proxy :: Proxy Int16)

56− prop "Int32" $ shouldValidate (Proxy :: Proxy Int32)

57− prop "Int64" $ shouldValidate (Proxy :: Proxy Int64)

58− prop "Integer" $ shouldValidate (Proxy :: Proxy Integer)

59− prop "Word" $ shouldValidate (Proxy :: Proxy Word)

60− prop "Word8" $ shouldValidate (Proxy :: Proxy Word8)

61− prop "Word16" $ shouldValidate (Proxy :: Proxy Word16)

62− prop "Word32" $ shouldValidate (Proxy :: Proxy Word32)

63− prop "Word64" $ shouldValidate (Proxy :: Proxy Word64)

64− prop "String" $ shouldValidate (Proxy :: Proxy String)

65− prop "()" $ shouldValidate (Proxy :: Proxy ())

66−-- prop "ZonedTime" $ shouldValidate (Proxy :: Proxy ZonedTime)

67−-- prop "UTCTime" $ shouldValidate (Proxy :: Proxy UTCTime)

68− prop "T.Text" $ shouldValidate (Proxy :: Proxy T.Text)

69− prop "TL.Text" $ shouldValidate (Proxy :: Proxy TL.Text)

70− prop "[String]" $ shouldValidate (Proxy :: Proxy [String])

71− -- prop "(Maybe [Int])" $ shouldValidate (Proxy :: Proxy (Maybe [Int]))

72− prop "(IntMap String)" $ shouldValidate (Proxy :: Proxy (IntMap String))

73− prop "(Set Bool)" $ shouldValidate (Proxy :: Proxy (Set Bool))

74− prop "(NonEmpty Bool)" $ shouldValidate (Proxy :: Proxy (NonEmpty Bool))

75− prop "(HashSet Bool)" $ shouldValidate (Proxy :: Proxy (HashSet Bool))

76− prop "(Either Int String)" $ shouldValidate (Proxy :: Proxy (Either Int String))

77− prop "(Int, String)" $ shouldValidate (Proxy :: Proxy (Int, String))

78− prop "(Map String Int)" $ shouldValidate (Proxy :: Proxy (Map String Int))

79− prop "(Map T.Text Int)" $ shouldValidate (Proxy :: Proxy (Map T.Text Int))

80− prop "(Map TL.Text Bool)" $ shouldValidate (Proxy :: Proxy (Map TL.Text Bool))

81− prop "(HashMap String Int)" $ shouldValidate (Proxy :: Proxy (HashMap String Int))

82− prop "(HashMap T.Text Int)" $ shouldValidate (Proxy :: Proxy (HashMap T.Text Int))

83− prop "(HashMap TL.Text Bool)" $ shouldValidate (Proxy :: Proxy (HashMap TL.Text Bool))

84− prop "Object" $ shouldValidate (Proxy :: Proxy Object)

85− prop "(Int, String, Double)" $ shouldValidate (Proxy :: Proxy (Int, String, Double))

86− prop "(Int, String, Double, [Int])" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int]))

87− prop "(Int, String, Double, [Int], Int)" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int], Int))

88− describe "Invalid FromJSON validation" $ do

89− prop "WrongType" $ shouldNotValidate (Proxy :: Proxy WrongType)

90− prop "MissingRequired" $ shouldNotValidate (Proxy :: Proxy MissingRequired)

91− prop "MissingProperty" $ shouldNotValidate (Proxy :: Proxy MissingProperty)

92− prop "WrongPropType" $ shouldNotValidate (Proxy :: Proxy WrongPropType)

93−

94−-- =============================

95−-- Data types and bunk instances

96−-- =============================

97−

98−data WrongType = WrongType Bool

99−

100−instance FromJSON WrongType where

101− parseJSON = withBool "WrongType" $ return . WrongType

102−

103−instance ToSchema WrongType where

104− declareNamedSchema _ = return . NamedSchema (Just "WrongType") $

105− mempty

106− & type_ ?~ SwaggerObject

107−

108−

109−data MissingRequired = MissingRequired

110− { propA :: String

111− , propB :: Bool

112− }

113−

114−instance FromJSON MissingRequired where

115− parseJSON = withObject "MissingRequired" $ \o ->

116− MissingRequired

117− <$> o .: "propA"

118− <*> o .: "propB"

119−

120−instance ToSchema MissingRequired where

121− declareNamedSchema _ = do

122− stringSchema <- declareSchemaRef (Proxy :: Proxy String)

123− boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)

124− return . NamedSchema (Just "MissingRequired") $

125− mempty

126− & type_ ?~ SwaggerObject

127− & properties .~ [("propA", stringSchema)

128− ,("propB", boolSchema)

129− ]

130− & required .~ ["propA"]

131−

132−data MissingProperty = MissingProperty

133− { propC :: String

134− , propD :: Bool

135− }

136−

137−instance FromJSON MissingProperty where

138− parseJSON = withObject "MissingProperty" $ \o ->

139− MissingProperty

140− <$> o .: "propC"

141− <*> o .: "propD"

142−

143−instance ToSchema MissingProperty where

144− declareNamedSchema _ = do

145− stringSchema <- declareSchemaRef (Proxy :: Proxy String)

146− return . NamedSchema (Just "MissingProperty") $

147− mempty

148− & type_ ?~ SwaggerObject

149− & properties .~ [("propC", stringSchema)]

150− & required .~ ["propC"]

151−

152−data WrongPropType = WrongPropType

153− { propE :: String

154− }

155−

156−instance FromJSON WrongPropType where

157− parseJSON = withObject "WrongPropType" $ \o ->

158− WrongPropType

159− <$> o .: "propE"

160−

161−instance ToSchema WrongPropType where

162− declareNamedSchema _ = do

163− boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)

164− return . NamedSchema (Just "WrongPropType") $

165− mempty

166− & type_ ?~ SwaggerObject

167− & properties .~ [("propE", boolSchema)]

168− & required .~ ["propE"]

test/Data/Swagger/Schema/ValidationSpec.hs+34−77

@@ -1,41 +1,39 @@

1−{-# LANGUAGE CPP #-}

2−{-# LANGUAGE DeriveGeneric #-}

3−{-# LANGUAGE PackageImports #-}

4−{-# LANGUAGE RecordWildCards #-}

1+{-# LANGUAGE CPP #-}

2+{-# LANGUAGE DeriveGeneric #-}

3+{-# LANGUAGE PackageImports #-}

4+{-# LANGUAGE RecordWildCards #-}

55{-# LANGUAGE ScopedTypeVariables #-}

66{-# OPTIONS_GHC -fno-warn-orphans #-}

77module Data.Swagger.Schema.ValidationSpec where

9−import Control.Applicative

10−import Control.Lens ((&), (.~), (?~))

11−import Data.Aeson

12−import Data.Aeson.Types

13−import Data.Hashable (Hashable)

14−import Data.HashMap.Strict (HashMap)

15−import qualified Data.HashMap.Strict as HashMap

16−import "unordered-containers" Data.HashSet (HashSet)

9+import Control.Applicative

10+import Data.Aeson

11+import Data.Aeson.Types

12+import Data.Int

13+import Data.IntMap (IntMap)

14+import Data.Hashable (Hashable)

15+import "unordered-containers" Data.HashSet (HashSet)

1716import qualified "unordered-containers" Data.HashSet as HashSet

18−import Data.Int

19−import Data.IntMap (IntMap)

20−import Data.List.NonEmpty.Compat (NonEmpty (..), nonEmpty)

21−import Data.Map (Map, fromList)

22−import Data.Monoid (mempty)

23−import Data.Proxy

24−import Data.Set (Set)

25−import qualified Data.Text as T

26−import qualified Data.Text.Lazy as TL

27−import Data.Time

28−import Data.Version (Version)

29−import Data.Word

30−import GHC.Generics

31−

32−import Data.Swagger

33−import Data.Swagger.Declare

34−

35−import Test.Hspec

36−import Test.Hspec.QuickCheck

37−import Test.QuickCheck

38−import Test.QuickCheck.Instances ()

17+import Data.HashMap.Strict (HashMap)

18+import qualified Data.HashMap.Strict as HashMap

19+import Data.List.NonEmpty (NonEmpty(..), nonEmpty)

20+import Data.Map (Map)

21+import Data.Monoid (mempty)

22+import Data.Proxy

23+import Data.Time

24+import qualified Data.Text as T

25+import qualified Data.Text.Lazy as TL

26+import Data.Set (Set)

27+import Data.Word

28+import GHC.Generics

29+

30+import Data.Swagger

31+import Data.Swagger.Declare

32+

33+import Test.Hspec

34+import Test.Hspec.QuickCheck

35+import Test.QuickCheck

36+import Test.QuickCheck.Instances ()

3937

4038shouldValidate :: (ToJSON a, ToSchema a) => Proxy a -> a -> Bool

4139shouldValidate _ x = validateToJSON x == []

@@ -83,7 +81,6 @@ spec = do

8381 prop "(HashMap String Int)" $ shouldValidate (Proxy :: Proxy (HashMap String Int))

8482 prop "(HashMap T.Text Int)" $ shouldValidate (Proxy :: Proxy (HashMap T.Text Int))

8583 prop "(HashMap TL.Text Bool)" $ shouldValidate (Proxy :: Proxy (HashMap TL.Text Bool))

86− prop "Object" $ shouldValidate (Proxy :: Proxy Object)

8784 prop "(Int, String, Double)" $ shouldValidate (Proxy :: Proxy (Int, String, Double))

8885 prop "(Int, String, Double, [Int])" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int]))

8986 prop "(Int, String, Double, [Int], Int)" $ shouldValidate (Proxy :: Proxy (Int, String, Double, [Int], Int))

@@ -93,8 +90,6 @@ spec = do

9390 prop "MyRoseTree" $ shouldValidate (Proxy :: Proxy MyRoseTree)

9491 prop "Light" $ shouldValidate (Proxy :: Proxy Light)

9592 prop "ButtonImages" $ shouldValidate (Proxy :: Proxy ButtonImages)

96− prop "Version" $ shouldValidate (Proxy :: Proxy Version)

97− prop "FreeForm" $ shouldValidate (Proxy :: Proxy FreeForm)

9893

9994 describe "invalid cases" $ do

10095 prop "invalidPersonToJSON" $ shouldNotValidate invalidPersonToJSON

@@ -140,9 +135,9 @@ instance Arbitrary Color where

140135 arbitrary = arbitraryBoundedEnum

141136

142137invalidColorToJSON :: Color -> Value

143−invalidColorToJSON Red = toJSON "red"

144−invalidColorToJSON Green = toJSON "green"

145−invalidColorToJSON Blue = toJSON "blue"

138+invalidColorToJSON Red = toJSON "red"

139+invalidColorToJSON Green = toJSON "green"

140+invalidColorToJSON Blue = toJSON "blue"

146141

147142-- ========================================================================

148143-- Paint (record with bounded enum property)

@@ -236,43 +231,5 @@ invalidButtonImagesToJSON = genericToJSON defaultOptions

236231instance Arbitrary ButtonImages where

237232 arbitrary = ButtonImages <$> arbitrary

238233

239−-- ========================================================================

240−-- FreeForm (wraps a raw JSON Value)

241−-- ========================================================================

242−

243−data FreeForm = FreeForm { jsonContent :: Map T.Text Value }

244− deriving (Show, Generic)

245−

246−instance ToJSON FreeForm where

247− toJSON = toJSON . jsonContent

248−

249−instance ToSchema FreeForm where

250− declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty

251− & type_ ?~ SwaggerObject

252− & additionalProperties ?~ AdditionalPropertiesAllowed True

253−

254−instance Arbitrary FreeForm where

255− arbitrary = (FreeForm . fromList) <$> genObj

256− where

257− genObj = listOf $ do

258− k <- arbitrary

259− v <- oneof [ String <$> arbitrary, Number <$> arbitrary, Bool <$> arbitrary, pure Null ]

260− pure (k, v)

261−

262234instance Eq ZonedTime where

263235 ZonedTime t (TimeZone x _ _) == ZonedTime t' (TimeZone y _ _) = t == t' && x == y

264−

265−-- ========================================================================

266−-- Arbitrary instance for Data.Aeson.Value

267−-- ========================================================================

268−

269−instance Arbitrary Value where

270− -- Weights are almost random

271− -- Uniform oneof tends not to build complex objects cause of recursive call.

272− arbitrary = resize 4 $ frequency

273− [ (3, Object <$> arbitrary)

274− , (3, Array <$> arbitrary)

275− , (3, String <$> arbitrary)

276− , (3, Number <$> arbitrary)

277− , (3, Bool <$> arbitrary)

278− , (1, return Null) ]

test/Data/Swagger/SchemaSpec.hs+6−5

@@ -8,11 +8,16 @@ import Prelude ()

88import Prelude.Compat

1010import Control.Lens ((^.))

11−import Data.Aeson (Value)

11+import Data.Aeson (Value, ToJSON(..), ToJSONKey(..))

12+import Data.Aeson.Types (toJSONKeyText)

13+import Data.Aeson.QQ

14+import Data.Char

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

1316import Data.Proxy

1417import Data.Set (Set)

18+import Data.Map (Map)

1519import qualified Data.Text as Text

20+import GHC.Generics

1621

1722import Data.Swagger

1823import Data.Swagger.Declare

@@ -21,9 +26,6 @@ import Data.Swagger.CommonTestTypes

2126import SpecCommon

2227import Test.Hspec

2328

24−import qualified Data.HashMap.Strict as HM

25−import Data.Time.LocalTime

26−

2729checkToSchema :: ToSchema a => Proxy a -> Value -> Spec

2830checkToSchema proxy js = toSchema proxy <=> js

2931

@@ -108,7 +110,6 @@ spec = do

108110 context "MyRoseTree' (inlineNonRecursiveSchemas)" $ checkInlinedRecSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'

109111 describe "Bounded Enum key mapping" $ do

110112 context "ButtonImages" $ checkToSchema (Proxy :: Proxy ButtonImages) buttonImagesSchemaJSON

111− context "TimeOfDay" $ checkToSchema (Proxy :: Proxy Data.Time.LocalTime.TimeOfDay) timeOfDaySchemaJSON

112113

113114main :: IO ()

114115main = hspec spec

test/Data/SwaggerSpec.hs+31−86

@@ -10,9 +10,9 @@ import Prelude.Compat

1010import Control.Lens

1111

1212import Data.Aeson

13−import Data.Aeson.QQ.Simple

13+import Data.Aeson.QQ

1414import Data.HashMap.Strict (HashMap)

15−import qualified Data.HashSet.InsOrd as InsOrdHS

15+import qualified Data.Set as Set

1616import Data.Text (Text)

1717

1818import Data.Swagger

@@ -37,13 +37,11 @@ spec = do

3737 context "Primitive Sample" $ schemaPrimitiveExample <=> schemaPrimitiveExampleJSON

3838 context "Simple Model" $ schemaSimpleModelExample <=> schemaSimpleModelExampleJSON

3939 context "Model with Map/Dictionary Properties" $ schemaModelDictExample <=> schemaModelDictExampleJSON

40− context "Model with Arbitrary Properties" $ schemaAdditionalExample <=> schemaAdditionalExampleJSON

4140 context "Model with Example" $ schemaWithExampleExample <=> schemaWithExampleExampleJSON

4241 describe "Definitions Object" $ definitionsExample <=> definitionsExampleJSON

4342 describe "Parameters Definition Object" $ paramsDefinitionExample <=> paramsDefinitionExampleJSON

4443 describe "Responses Definition Object" $ responsesDefinitionExample <=> responsesDefinitionExampleJSON

4544 describe "Security Definitions Object" $ securityDefinitionsExample <=> securityDefinitionsExampleJSON

46− describe "OAuth2 Security Definitions with merged Scope" $ oAuth2SecurityDefinitionsExample <=> oAuth2SecurityDefinitionsExampleJSON

4745 describe "Composition Schema Example" $ compositionSchemaExample <=> compositionSchemaExampleJSON

4846 describe "Swagger Object" $ do

4947 context "Todo Example" $ swaggerExample <=> swaggerExampleJSON

@@ -128,7 +126,7 @@ licenseExampleJSON = [aesonQQ|

128126

129127operationExample :: Operation

130128operationExample = mempty

131− & tags .~ InsOrdHS.fromList ["pet"]

129+ & tags .~ Set.fromList ["pet"]

132130 & summary ?~ "Updates a pet in the store with form data"

133131 & description ?~ ""

134132 & operationId ?~ "updatePetWithForm"

@@ -159,7 +157,7 @@ operationExample = mempty

159157 stringSchema :: ParamLocation -> ParamOtherSchema

160158 stringSchema loc = mempty

161159 & in_ .~ loc

162− & type_ ?~ SwaggerString

160+ & type_ .~ SwaggerString

163161

164162operationExampleJSON :: Value

165163operationExampleJSON = [aesonQQ|

@@ -225,7 +223,7 @@ operationExampleJSON = [aesonQQ|

225223

226224schemaPrimitiveExample :: Schema

227225schemaPrimitiveExample = mempty

228− & type_ ?~ SwaggerString

226+ & type_ .~ SwaggerString

229227 & format ?~ "email"

230228

231229schemaPrimitiveExampleJSON :: Value

@@ -238,14 +236,14 @@ schemaPrimitiveExampleJSON = [aesonQQ|

238236

239237schemaSimpleModelExample :: Schema

240238schemaSimpleModelExample = mempty

241− & type_ ?~ SwaggerObject

239+ & type_ .~ SwaggerObject

242240 & required .~ [ "name" ]

243241 & properties .~

244− [ ("name", Inline (mempty & type_ ?~ SwaggerString))

242+ [ ("name", Inline (mempty & type_ .~ SwaggerString))

245243 , ("address", Ref (Reference "Address"))

246244 , ("age", Inline $ mempty

247245 & minimum_ ?~ 0

248− & type_ ?~ SwaggerInteger

246+ & type_ .~ SwaggerInteger

249247 & format ?~ "int32" ) ]

250248

251249schemaSimpleModelExampleJSON :: Value

@@ -273,8 +271,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|

273271

274272schemaModelDictExample :: Schema

275273schemaModelDictExample = mempty

276− & type_ ?~ SwaggerObject

277− & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ SwaggerString))

274+ & type_ .~ SwaggerObject

275+ & additionalProperties ?~ Inline (mempty & type_ .~ SwaggerString)

278276

279277schemaModelDictExampleJSON :: Value

280278schemaModelDictExampleJSON = [aesonQQ|

@@ -286,28 +284,15 @@ schemaModelDictExampleJSON = [aesonQQ|

286284}

287285|]

288286

289−schemaAdditionalExample :: Schema

290−schemaAdditionalExample = mempty

291− & type_ ?~ SwaggerObject

292− & additionalProperties ?~ AdditionalPropertiesAllowed True

293−

294−schemaAdditionalExampleJSON :: Value

295−schemaAdditionalExampleJSON = [aesonQQ|

296−{

297− "type": "object",

298− "additionalProperties": true

299−}

300−|]

301−

302287schemaWithExampleExample :: Schema

303288schemaWithExampleExample = mempty

304− & type_ ?~ SwaggerObject

289+ & type_ .~ SwaggerObject

305290 & properties .~

306291 [ ("id", Inline $ mempty

307− & type_ ?~ SwaggerInteger

292+ & type_ .~ SwaggerInteger

308293 & format ?~ "int64" )

309294 , ("name", Inline $ mempty

310− & type_ ?~ SwaggerString) ]

295+ & type_ .~ SwaggerString) ]

311296 & required .~ [ "name" ]

312297 & example ?~ [aesonQQ|

313298 {

@@ -346,19 +331,19 @@ schemaWithExampleExampleJSON = [aesonQQ|

346331definitionsExample :: HashMap Text Schema

347332definitionsExample =

348333 [ ("Category", mempty

349− & type_ ?~ SwaggerObject

334+ & type_ .~ SwaggerObject

350335 & properties .~

351336 [ ("id", Inline $ mempty

352− & type_ ?~ SwaggerInteger

337+ & type_ .~ SwaggerInteger

353338 & format ?~ "int64")

354− , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] )

339+ , ("name", Inline (mempty & type_ .~ SwaggerString)) ] )

355340 , ("Tag", mempty

356− & type_ ?~ SwaggerObject

341+ & type_ .~ SwaggerObject

357342 & properties .~

358343 [ ("id", Inline $ mempty

359− & type_ ?~ SwaggerInteger

344+ & type_ .~ SwaggerInteger

360345 & format ?~ "int64")

361− , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] ) ]

346+ , ("name", Inline (mempty & type_ .~ SwaggerString)) ] ) ]

362347

363348definitionsExampleJSON :: Value

364349definitionsExampleJSON = [aesonQQ|

@@ -402,7 +387,7 @@ paramsDefinitionExample =

402387 & required ?~ True

403388 & schema .~ ParamOther (mempty

404389 & in_ .~ ParamQuery

405− & type_ ?~ SwaggerInteger

390+ & type_ .~ SwaggerInteger

406391 & format ?~ "int32" ))

407392 , ("limitParam", mempty

408393 & name .~ "limit"

@@ -410,7 +395,7 @@ paramsDefinitionExample =

410395 & required ?~ True

411396 & schema .~ ParamOther (mempty

412397 & in_ .~ ParamQuery

413− & type_ ?~ SwaggerInteger

398+ & type_ .~ SwaggerInteger

414399 & format ?~ "int32" )) ]

415400

416401paramsDefinitionExampleJSON :: Value

@@ -460,8 +445,8 @@ responsesDefinitionExampleJSON = [aesonQQ|

460445-- Responses Definition object

461446-- =======================================================================

462447

463−securityDefinitionsExample :: SecurityDefinitions

464−securityDefinitionsExample = SecurityDefinitions

448+securityDefinitionsExample :: HashMap Text SecurityScheme

449+securityDefinitionsExample =

465450 [ ("api_key", SecurityScheme

466451 { _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "api_key" ApiKeyHeader)

467452 , _securitySchemeDescription = Nothing })

@@ -493,46 +478,6 @@ securityDefinitionsExampleJSON = [aesonQQ|

493478}

494479|]

495480

496−oAuth2SecurityDefinitionsReadExample :: SecurityDefinitions

497−oAuth2SecurityDefinitionsReadExample = SecurityDefinitions

498− [ ("petstore_auth", SecurityScheme

499− { _securitySchemeType = SecuritySchemeOAuth2 (OAuth2Params

500− { _oauth2Flow = OAuth2Implicit "http://swagger.io/api/oauth/dialog"

501− , _oauth2Scopes =

502− [ ("read:pets", "read your pets") ] } )

503− , _securitySchemeDescription = Nothing })

504− ]

505−

506−oAuth2SecurityDefinitionsWriteExample :: SecurityDefinitions

507−oAuth2SecurityDefinitionsWriteExample = SecurityDefinitions

508− [ ("petstore_auth", SecurityScheme

509− { _securitySchemeType = SecuritySchemeOAuth2 (OAuth2Params

510− { _oauth2Flow = OAuth2Implicit "http://swagger.io/api/oauth/dialog"

511− , _oauth2Scopes =

512− [ ("write:pets", "modify pets in your account") ] } )

513− , _securitySchemeDescription = Nothing })

514− ]

515−

516−oAuth2SecurityDefinitionsExample :: SecurityDefinitions

517−oAuth2SecurityDefinitionsExample =

518− oAuth2SecurityDefinitionsWriteExample <>

519− oAuth2SecurityDefinitionsReadExample

520−

521−oAuth2SecurityDefinitionsExampleJSON :: Value

522−oAuth2SecurityDefinitionsExampleJSON = [aesonQQ|

523−{

524− "petstore_auth": {

525− "type": "oauth2",

526− "authorizationUrl": "http://swagger.io/api/oauth/dialog",

527− "flow": "implicit",

528− "scopes": {

529− "write:pets": "modify pets in your account",

530− "read:pets": "read your pets"

531− }

532− }

533−}

534−|]

535−

536481-- =======================================================================

537482-- Swagger object

538483-- =======================================================================

@@ -551,7 +496,7 @@ swaggerExample = mempty

551496 & at 200 ?~ Inline (mempty

552497 & description .~ "OK"

553498 & schema ?~ Inline (mempty

554− & type_ ?~ SwaggerObject

499+ & type_ .~ SwaggerObject

555500 & example ?~ [aesonQQ|

556501 {

557502 "created": 100,

@@ -560,9 +505,9 @@ swaggerExample = mempty

560505 & description ?~ "This is some real Todo right here"

561506 & properties .~

562507 [ ("created", Inline $ mempty

563− & type_ ?~ SwaggerInteger

508+ & type_ .~ SwaggerInteger

564509 & format ?~ "int32")

565− , ("description", Inline (mempty & type_ ?~ SwaggerString))]))

510+ , ("description", Inline (mempty & type_ .~ SwaggerString))]))

566511 & produces ?~ MimeList [ "application/json" ]

567512 & parameters .~

568513 [ Inline $ mempty

@@ -571,8 +516,8 @@ swaggerExample = mempty

571516 & description ?~ "TodoId param"

572517 & schema .~ ParamOther (mempty

573518 & in_ .~ ParamPath

574− & type_ ?~ SwaggerString ) ]

575− & tags .~ InsOrdHS.fromList [ "todo" ] ))

519+ & type_ .~ SwaggerString ) ]

520+ & tags .~ Set.fromList [ "todo" ] ))

576521

577522swaggerExampleJSON :: Value

578523swaggerExampleJSON = [aesonQQ|

@@ -1673,14 +1618,14 @@ petstoreExampleJSON = [aesonQQ|

16731618

16741619compositionSchemaExample :: Schema

16751620compositionSchemaExample = mempty

1676− & type_ ?~ SwaggerObject

1621+ & type_ .~ SwaggerObject

16771622 & Data.Swagger.allOf ?~ [

16781623 Ref (Reference "Other")

16791624 , Inline (mempty

1680− & type_ ?~ SwaggerObject

1625+ & type_ .~ SwaggerObject

16811626 & properties .~

16821627 [ ("greet", Inline $ mempty

1683− & type_ ?~ SwaggerString) ])

1628+ & type_ .~ SwaggerString) ])

16841629 ]

16851630

16861631compositionSchemaExampleJSON :: Value