git.iko.soy/typeable/swagger2
on 29f720f help sign in
24 files changed+266−1256
since splitsnapshots
unifiedsplit
.ghci−1 .travis.yml+70−112 CHANGELOG.md−26 cabal.project−2 examples/hackage.hs+1−1 src/Data/Swagger.hs+4−9 src/Data/Swagger/Internal.hs+7−48 src/Data/Swagger/Internal/AesonUtils.hs−14 src/Data/Swagger/Internal/ParamSchema.hs+21−27 src/Data/Swagger/Internal/Schema.hs+28−32 src/Data/Swagger/Internal/Schema/Validation.hs+49−207 src/Data/Swagger/Lens.hs+4−10 src/Data/Swagger/Operation.hs+2−3 src/Data/Swagger/Optics.hs−597 src/Data/Swagger/Schema/Generator.hs+14−22 src/Data/Swagger/Schema/Validation.hs−2 stack.yaml+4−6 swagger2.cabal+17−20 test/Data/Swagger/CommonTestTypes.hs+2−29 test/Data/Swagger/ParamSchemaSpec.hs+1−6 test/Data/Swagger/Schema/GeneratorSpec.hs+4−4 test/Data/Swagger/Schema/ValidationSpec.hs+1−1 test/Data/Swagger/SchemaSpec.hs+6−5 test/Data/SwaggerSpec.hs+31−72
.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+70−112
@@ -1,23 +1,24 @@
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+# haskell-ci '--branches' 'master' '--haddock=>=8.4' '--output' '.travis.yml' 'swagger2.cabal'
44#
55# For more information, see https://github.com/haskell-CI/haskell-ci
66#
7−# version: 0.5.20191020
8−#
97language: c
108dist: xenial
9+
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:
2223 - rm -fv $CABALHOME/packages/hackage.haskell.org/build-reports.log
2324 # remove files that are regenerated by 'cabal update'
@@ -26,137 +27,94 @@ before_cache:
2627 - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.cache
2728 - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar
2829 - rm -fv $CABALHOME/packages/hackage.haskell.org/01-index.tar.idx
30+
2931 - rm -rfv $CABALHOME/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-8.6.2"
36+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.6.2], sources: [hvr-ghc]}}
37+ - compiler: "ghc-8.4.4"
38+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.4.4], sources: [hvr-ghc]}}
39+ - compiler: "ghc-8.2.2"
40+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.2.2], sources: [hvr-ghc]}}
41+ - compiler: "ghc-8.0.2"
42+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-8.0.2], sources: [hvr-ghc]}}
43+ - compiler: "ghc-7.10.3"
44+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.10.3], sources: [hvr-ghc]}}
45+ - compiler: "ghc-7.8.4"
46+ addons: {apt: {packages: [ghc-ppa-tools,cabal-install-2.4,ghc-7.8.4], sources: [hvr-ghc]}}
47+
4248before_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"
49+ - HC=/opt/ghc/bin/${CC}
50+ - HCPKG=${HC/ghc/ghc-pkg}
4751 - unset CC
4852 - CABAL=/opt/ghc/bin/cabal
4953 - 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))')"
54+ - "export PATH=\"$CABALHOME/bin:$PATH\""
55+ - ROOTDIR=$(pwd)
56+ - HCNUMVER=$(( $(${HC} --numeric-version|sed -E 's/([0-9]+)\.([0-9]+)\.([0-9]+).*/\1 * 10000 + \2 * 100 + \3/') ))
5357 - 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
58+
7459install:
7560 - ${CABAL} --version
7661 - echo "$(${HC} --version) [$(${HC} --print-project-git-commit-id 2> /dev/null || echo '?')]"
7762 - TEST=--enable-tests
7863 - 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
64+ - GHCHEAD=${GHCHEAD-false}
65+ - travis_retry ${CABAL} update -v
66+ - "sed -i.bak 's/^jobs:/-- jobs:/' $CABALHOME/config"
67+ - rm -fv cabal.project cabal.project.local
68+ - grep -Ev -- '^\s*--' $CABALHOME/config | grep -Ev '^\s*$'
69+ - rm -f cabal.project
11370 - 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"
71+ - "printf 'packages: \".\"\\n' >> cabal.project"
72+ - "printf 'write-ghc-environment-files: always\\n' >> cabal.project"
73+ - touch cabal.project.local
74+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(swagger2)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
11875 - cat cabal.project || true
11976 - cat cabal.project.local || true
12077 - 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:
78+ - rm -f cabal.project.freeze
79+ - ${CABAL} new-freeze -w ${HC} ${TEST} ${BENCH} --project-file="cabal.project" --dry
80+ - "cat \"cabal.project.freeze\" | sed -E 's/^(constraints: *| *)//' | sed 's/any.//'"
81+ - rm "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...
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+ - ${CABAL} new-sdist all
13192 - mv dist-newstyle/sdist/*.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
94+ - find . -maxdepth 1 -name '*.tar.gz' -exec tar -xvf '{}' \;
95+ - rm -f cabal.project
13896 - 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"
97+ - "printf 'packages: \"swagger2-*/*.cabal\"\\n' >> cabal.project"
98+ - "printf 'write-ghc-environment-files: always\\n' >> cabal.project"
99+ - touch cabal.project.local
100+ - "for pkg in $($HCPKG list --simple-output); do echo $pkg | sed 's/-[^-]*$//' | grep -vE -- '^(swagger2)$' | sed 's/^/constraints: /' | sed 's/$/ installed/' >> cabal.project.local; done"
143101 - cat cabal.project || true
144102 - cat cabal.project.local || true
145− # Building...
146103 # 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...
104+ - ${CABAL} new-build -w ${HC} --disable-tests --disable-benchmarks all
105+
149106 # 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
107+ - ${CABAL} new-build -w ${HC} ${TEST} ${BENCH} all
108+ - if [ "x$TEST" = "x--enable-tests" ]; then ${CABAL} new-test -w ${HC} ${TEST} ${BENCH} all; fi
109+
110+ # ${CABAL} check
111+ - (cd swagger2-* && ${CABAL} check)
112+
113+ # haddock
114+ - if [ $HCNUMVER -ge 80400 ] ; then ${CABAL} new-haddock -w ${HC} ${TEST} ${BENCH} all ; fi
115+
116+ # Build without installed constraints for packages in global-db
117+ - rm -f cabal.project.local; ${CABAL} new-build -w ${HC} --disable-tests --disable-benchmarks all;
160118
161−# REGENDATA ("0.5.20191020",["--branches","master","--haddock-jobs=>=8.4","--output",".travis.yml","swagger2.cabal"])
119+# REGENDATA ["--branches","master","--haddock=>=8.4","--output",".travis.yml","swagger2.cabal"]
162120# EOF
CHANGELOG.md−26
@@ -1,31 +1,5 @@
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−
2612.3.1.1
272-------
28−
293- Allow `network-3.0`
304
3152.3.1
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−9
@@ -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,
@@ -89,7 +88,6 @@ module Data.Swagger (
8988 SecurityScheme(..),
9089 SecuritySchemeType(..),
9190 SecurityRequirement(..),
92− SecurityDefinitions(..),
9391
9492 -- *** API key
9593 ApiKeyParams(..),
@@ -114,7 +112,6 @@ module Data.Swagger (
114112) where
115113
116114import Data.Swagger.Lens
117−import Data.Swagger.Optics ()
118115import Data.Swagger.Operation
119116import Data.Swagger.ParamSchema
120117import Data.Swagger.Schema
@@ -178,15 +175,13 @@ import Data.Swagger.Internal
178175
179176-- $lens
180177--
181−-- Note: if you're working with the <https://hackage.haskell.org/package/optics optics> library, take a look at "Data.Swagger.Optics".
182−--
183178-- Since @'Swagger'@ has a fairly complex structure, lenses and prisms are used
184179-- to work comfortably with it. In combination with @'Monoid'@ instances, lenses
185180-- make it fairly simple to construct/modify any part of the specification:
186181--
187182-- >>> :{
188183-- encode $ (mempty :: Swagger)
189−-- & definitions .~ [ ("User", mempty & type_ ?~ SwaggerString) ]
184+-- & definitions .~ [ ("User", mempty & type_ .~ SwaggerString) ]
190185-- & paths .~
191186-- [ ("/user", mempty & get ?~ (mempty
192187-- & produces ?~ MimeList ["application/json"]
@@ -209,7 +204,7 @@ import Data.Swagger.Internal
209204-- "{\"description\":\"No content\"}"
210205-- >>> :{
211206-- encode $ (mempty :: Schema)
212−-- & type_ ?~ SwaggerBoolean
207+-- & type_ .~ SwaggerBoolean
213208-- & description ?~ "To be or not to be"
214209-- :}
215210-- "{\"description\":\"To be or not to be\",\"type\":\"boolean\"}"
@@ -218,7 +213,7 @@ import Data.Swagger.Internal
218213-- So for convenience, all @'ParamSchema'@ fields are transitively made fields of the type that has it.
219214-- For example, you can use @'type_'@ to access @'SwaggerType'@ of @'Header'@ schema without having to use @'paramSchema'@:
220215--
221−-- >>> encode $ (mempty :: Header) & type_ ?~ SwaggerNumber
216+-- >>> encode $ (mempty :: Header) & type_ .~ SwaggerNumber
222217-- "{\"type\":\"number\"}"
223218--
224219-- Additionally, to simplify working with @'Response'@, both @'Operation'@ and @'Responses'@
@@ -280,7 +275,7 @@ import Data.Swagger.Internal
280275-- >>> encode $ toSchema (Proxy :: Proxy Person)
281276-- "{\"required\":[\"name\",\"age\"],\"properties\":{\"name\":{\"type\":\"string\"},\"age\":{\"type\":\"integer\"}},\"type\":\"object\"}"
282277--
283−-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a
278+-- Please note that not all valid Haskell data types will have a proper swagger schema. For example while we can derive a
284279-- schema for basic enums like
285280--
286281-- >>> data SampleEnum = ChoiceOne | ChoiceTwo deriving Generic
src/Data/Swagger/Internal.hs+7−48
@@ -29,14 +29,13 @@ 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 (..))
3836import Data.Semigroup.Compat (Semigroup (..))
3937import Data.Scientific (Scientific)
38+import Data.Set (Set)
4039import Data.String (IsString(..))
4140import Data.Text (Text)
4241import qualified Data.Text as Text
@@ -117,7 +116,7 @@ data Swagger = Swagger
117116 , _swaggerResponses :: Definitions Response
118117
119118 -- | Security scheme definitions that can be used across the specification.
120− , _swaggerSecurityDefinitions :: SecurityDefinitions
119+ , _swaggerSecurityDefinitions :: Definitions SecurityScheme
121120
122121 -- | A declaration of which security schemes are applied for the API as a whole.
123122 -- The list of values describes alternative security schemes that can be used
@@ -130,7 +129,7 @@ data Swagger = Swagger
130129 -- Not all tags that are used by the Operation Object must be declared.
131130 -- The tags that are not declared may be organized randomly or based on the tools' logic.
132131 -- Each tag name in the list MUST be unique.
133− , _swaggerTags :: InsOrdHashSet Tag
132+ , _swaggerTags :: Set Tag
134133
135134 -- | Additional external documentation.
136135 , _swaggerExternalDocs :: Maybe ExternalDocs
@@ -252,7 +251,7 @@ data PathItem = PathItem
252251data Operation = Operation
253252 { -- | A list of tags for API documentation control.
254253 -- Tags can be used for logical grouping of operations by resources or any other qualifier.
255− _operationTags :: InsOrdHashSet TagName
254+ _operationTags :: Set TagName
256255
257256 -- | A short summary of what the operation does.
258257 -- For maximum readability in the swagger-ui, this field SHOULD be less than 120 characters.
@@ -594,7 +593,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
594593 -- Unlike JSON Schema this value MUST conform to the defined type for this parameter.
595594 _paramSchemaDefault :: Maybe Value
596595
597− , _paramSchemaType :: Maybe (SwaggerType t)
596+ , _paramSchemaType :: SwaggerType t
598597 , _paramSchemaFormat :: Maybe Format
599598 , _paramSchemaItems :: Maybe (SwaggerItems t)
600599 , _paramSchemaMaximum :: Maybe Scientific
@@ -611,7 +610,7 @@ data ParamSchema (t :: SwaggerKind *) = ParamSchema
611610 , _paramSchemaMultipleOf :: Maybe Scientific
612611 } deriving (Eq, Show, Generic, Typeable)
613612
614−deriving instance (Typeable k, Data (Maybe (SwaggerType k)), Data (SwaggerItems k)) => Data (ParamSchema k)
613+deriving instance (Typeable k, Data (SwaggerType k), Data (SwaggerItems k)) => Data (ParamSchema k)
615614
616615data Xml = Xml
617616 { -- | Replaces the name of the element/attribute used for the described schema property.
@@ -755,22 +754,6 @@ data SecurityScheme = SecurityScheme
755754 , _securitySchemeDescription :: Maybe Text
756755 } deriving (Eq, Show, Generic, Data, Typeable)
757756
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−
774757-- | Lists the required security schemes to execute this operation.
775758-- The object can have multiple security schemes declared in it which are all required
776759-- (that is, there is a logical AND between the schemes).
@@ -795,8 +778,6 @@ data Tag = Tag
795778 , _tagExternalDocs :: Maybe ExternalDocs
796779 } deriving (Eq, Ord, Show, Generic, Data, Typeable)
797780
798−instance Hashable Tag
799−
800781instance IsString Tag where
801782 fromString s = Tag (fromString s) Nothing Nothing
802783
@@ -810,8 +791,6 @@ data ExternalDocs = ExternalDocs
810791 , _externalDocsUrl :: URL
811792 } deriving (Eq, Ord, Show, Generic, Data, Typeable)
812793
813−instance Hashable ExternalDocs
814−
815794-- | A simple object to allow referencing other definitions in the specification.
816795-- It can be used to reference parameters and responses that are defined at the top level for reuse.
817796newtype Reference = Reference { getReference :: Text }
@@ -825,7 +804,7 @@ data Referenced a
825804instance IsString a => IsString (Referenced a) where
826805 fromString = Inline . fromString
827806
828−newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, Hashable, ToJSON, FromJSON, Data, Typeable)
807+newtype URL = URL { getUrl :: Text } deriving (Eq, Ord, Show, ToJSON, FromJSON, Data, Typeable)
829808
830809data AdditionalProperties
831810 = AdditionalPropertiesAllowed Bool
@@ -920,17 +899,6 @@ instance Monoid Example where
920899 mempty = genericMempty
921900 mappend = (<>)
922901
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−
934902-- =======================================================================
935903-- SwaggerMonoid helper instances
936904-- =======================================================================
@@ -945,8 +913,6 @@ instance SwaggerMonoid Responses
945913instance SwaggerMonoid Response
946914instance SwaggerMonoid ExternalDocs
947915instance SwaggerMonoid Operation
948−instance SwaggerMonoid SecurityDefinitions
949−instance (Eq a, Hashable a) => SwaggerMonoid (InsOrdHashSet a)
950916
951917instance SwaggerMonoid MimeList
952918deriving instance SwaggerMonoid URL
@@ -1146,9 +1112,6 @@ instance ToJSON PathItem where
11461112instance ToJSON Example where
11471113 toJSON = toJSON . Map.mapKeys show . getExample
11481114
1149−instance ToJSON SecurityDefinitions where
1150− toJSON (SecurityDefinitions sd) = toJSON sd
1151−
11521115instance ToJSON Reference where
11531116 toJSON (Reference ref) = object [ "$ref" .= ref ]
11541117
@@ -1310,9 +1273,6 @@ instance FromJSON Operation where
13101273instance FromJSON PathItem where
13111274 parseJSON = sopSwaggerGenericParseJSON
13121275
1313−instance FromJSON SecurityDefinitions where
1314− parseJSON js = SecurityDefinitions <$> parseJSON js
1315−
13161276instance FromJSON Reference where
13171277 parseJSON (Object o) = Reference <$> o .: "$ref"
13181278 parseJSON _ = empty
@@ -1424,4 +1384,3 @@ instance AesonDefaultValue (SwaggerType a)
14241384instance AesonDefaultValue MimeList where defaultValue = Just mempty
14251385instance AesonDefaultValue Info
14261386instance AesonDefaultValue ParamLocation
1427−instance AesonDefaultValue SecurityDefinitions where defaultValue = Just $ SecurityDefinitions mempty
src/Data/Swagger/Internal/AesonUtils.hs−14
@@ -44,7 +44,6 @@ 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)
@@ -86,7 +85,6 @@ instance AesonDefaultValue Text where defaultValue = Nothing
8685instance AesonDefaultValue (Maybe a) where defaultValue = Just Nothing
8786instance AesonDefaultValue [a] where defaultValue = Just []
8887instance AesonDefaultValue (Set.Set a) where defaultValue = Just Set.empty
89−instance AesonDefaultValue (InsOrdHS.InsOrdHashSet k) where defaultValue = Just InsOrdHS.empty
9088instance AesonDefaultValue (InsOrd.InsOrdHashMap k v) where defaultValue = Just InsOrd.empty
9189
9290-------------------------------------------------------------------------------
@@ -146,11 +144,7 @@ sopSwaggerGenericToJSON'
146144 -> DatatypeInfo '[xs]
147145 -> POP Maybe '[xs]
148146 -> [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
152147sopSwaggerGenericToJSON' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =
153−#endif
154148 sopSwaggerGenericToJSON'' opts fields fieldsInfo defs
155149sopSwaggerGenericToJSON' _ _ _ _ = error "sopSwaggerGenericToJSON: unsupported type"
156150
@@ -226,11 +220,7 @@ sopSwaggerGenericParseJSON'
226220 -> DatatypeInfo '[xs]
227221 -> POP Maybe '[xs]
228222 -> 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
232223sopSwaggerGenericParseJSON' opts obj (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =
233−#endif
234224 SOP . Z <$> sopSwaggerGenericParseJSON'' opts obj fieldsInfo defs
235225sopSwaggerGenericParseJSON' _ _ _ _ = error "sopSwaggerGenericParseJSON: unsupported type"
236226
@@ -302,11 +292,7 @@ sopSwaggerGenericToEncoding'
302292 -> DatatypeInfo '[xs]
303293 -> POP Maybe '[xs]
304294 -> 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
308295sopSwaggerGenericToEncoding' opts (SOP (Z fields)) (ADT _ _ (Record _ fieldsInfo :* Nil)) (POP (defs :* Nil)) =
309−#endif
310296 sopSwaggerGenericToEncoding'' opts fields fieldsInfo defs
311297sopSwaggerGenericToEncoding' _ _ _ _ = error "sopSwaggerGenericToEncoding: unsupported type"
312298
src/Data/Swagger/Internal/ParamSchema.hs+21−27
@@ -59,20 +59,20 @@ import GHC.TypeLits (TypeError, ErrorMessage(..))
5959-- | Default schema for binary data (any sequence of octets).
6060binaryParamSchema :: ParamSchema t
6161binaryParamSchema = mempty
62− & type_ ?~ SwaggerString
62+ & type_ .~ SwaggerString
6363 & format ?~ "binary"
6464
6565-- | Default schema for binary data (base64 encoded).
6666byteParamSchema :: ParamSchema t
6767byteParamSchema = mempty
68− & type_ ?~ SwaggerString
68+ & type_ .~ SwaggerString
6969 & format ?~ "byte"
7070
7171-- | Default schema for password string.
7272-- @"password"@ format is used to hint UIs the input needs to be obscured.
7373passwordParamSchema :: ParamSchema t
7474passwordParamSchema = mempty
75− & type_ ?~ SwaggerString
75+ & type_ .~ SwaggerString
7676 & format ?~ "password"
7777
7878-- | Convert a type into a plain @'ParamSchema'@.
@@ -88,7 +88,7 @@ passwordParamSchema = mempty
8888--
8989-- instance ToParamSchema Direction where
9090-- toParamSchema _ = mempty
91−-- & type_ ?~ SwaggerString
91+-- & type_ .~ SwaggerString
9292-- & enum_ ?~ [ \"Up\", \"Down\" ]
9393-- @
9494--
@@ -120,17 +120,17 @@ class ToParamSchema a where
120120 toParamSchema = genericToParamSchema defaultSchemaOptions
121121
122122instance OVERLAPPING_ ToParamSchema String where
123− toParamSchema _ = mempty & type_ ?~ SwaggerString
123+ toParamSchema _ = mempty & type_ .~ SwaggerString
124124
125125instance ToParamSchema Bool where
126− toParamSchema _ = mempty & type_ ?~ SwaggerBoolean
126+ toParamSchema _ = mempty & type_ .~ SwaggerBoolean
127127
128128instance ToParamSchema Integer where
129− toParamSchema _ = mempty & type_ ?~ SwaggerInteger
129+ toParamSchema _ = mempty & type_ .~ SwaggerInteger
130130
131131instance ToParamSchema Natural where
132132 toParamSchema _ = mempty
133− & type_ ?~ SwaggerInteger
133+ & type_ .~ SwaggerInteger
134134 & minimum_ ?~ 0
135135 & exclusiveMinimum ?~ False
136136
@@ -156,49 +156,43 @@ instance ToParamSchema Word64 where toParamSchema = toParamSchemaBoundedIntegral
156156-- "{\"maximum\":127,\"minimum\":-128,\"type\":\"integer\"}"
157157toParamSchemaBoundedIntegral :: forall a t. (Bounded a, Integral a) => Proxy a -> ParamSchema t
158158toParamSchemaBoundedIntegral _ = mempty
159− & type_ ?~ SwaggerInteger
159+ & type_ .~ SwaggerInteger
160160 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
161161 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
162162
163163instance ToParamSchema Char where
164164 toParamSchema _ = mempty
165− & type_ ?~ SwaggerString
165+ & type_ .~ SwaggerString
166166 & maxLength ?~ 1
167167 & minLength ?~ 1
168168
169169instance ToParamSchema Scientific where
170− toParamSchema _ = mempty & type_ ?~ SwaggerNumber
170+ toParamSchema _ = mempty & type_ .~ SwaggerNumber
171171
172172instance HasResolution a => ToParamSchema (Fixed a) where
173173 toParamSchema _ = mempty
174− & type_ ?~ SwaggerNumber
174+ & type_ .~ SwaggerNumber
175175 & multipleOf ?~ (recip . fromInteger $ resolution (Proxy :: Proxy a))
176176
177177instance ToParamSchema Double where
178178 toParamSchema _ = mempty
179− & type_ ?~ SwaggerNumber
179+ & type_ .~ SwaggerNumber
180180 & format ?~ "double"
181181
182182instance ToParamSchema Float where
183183 toParamSchema _ = mempty
184− & type_ ?~ SwaggerNumber
184+ & type_ .~ SwaggerNumber
185185 & format ?~ "float"
186186
187187timeParamSchema :: String -> ParamSchema t
188188timeParamSchema fmt = mempty
189− & type_ ?~ SwaggerString
189+ & type_ .~ SwaggerString
190190 & format ?~ T.pack fmt
191191
192192-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
193193instance ToParamSchema Day where
194194 toParamSchema _ = timeParamSchema "date"
195195
196−-- |
197−-- >>> toParamSchema (Proxy :: Proxy TimeOfDay) ^. format
198−-- Just "hh:MM:ss"
199−instance ToParamSchema TimeOfDay where
200− toParamSchema _ = timeParamSchema "hh:MM:ss"
201−
202196-- |
203197-- >>> toParamSchema (Proxy :: Proxy LocalTime) ^. format
204198-- Just "yyyy-mm-ddThh:MM:ss"
@@ -228,12 +222,12 @@ instance ToParamSchema TL.Text where
228222
229223instance ToParamSchema Version where
230224 toParamSchema _ = mempty
231− & type_ ?~ SwaggerString
225+ & type_ .~ SwaggerString
232226 & pattern ?~ "^\\d+(\\.\\d+)*$"
233227
234228instance ToParamSchema SetCookie where
235229 toParamSchema _ = mempty
236− & type_ ?~ SwaggerString
230+ & type_ .~ SwaggerString
237231
238232
239233#if __GLASGOW_HASKELL__ < 800
@@ -260,7 +254,7 @@ instance ToParamSchema a => ToParamSchema (Identity a) where toParamSchema _ = t
260254
261255instance ToParamSchema a => ToParamSchema [a] where
262256 toParamSchema _ = mempty
263− & type_ ?~ SwaggerArray
257+ & type_ .~ SwaggerArray
264258 & items ?~ SwaggerItemsPrimitive Nothing (toParamSchema (Proxy :: Proxy a))
265259
266260instance ToParamSchema a => ToParamSchema (V.Vector a) where toParamSchema _ = toParamSchema (Proxy :: Proxy [a])
@@ -280,12 +274,12 @@ instance ToParamSchema a => ToParamSchema (HashSet a) where
280274-- "{\"type\":\"string\",\"enum\":[\"_\"]}"
281275instance ToParamSchema () where
282276 toParamSchema _ = mempty
283− & type_ ?~ SwaggerString
277+ & type_ .~ SwaggerString
284278 & enum_ ?~ ["_"]
285279
286280instance ToParamSchema UUID where
287281 toParamSchema _ = mempty
288− & type_ ?~ SwaggerString
282+ & type_ .~ SwaggerString
289283 & format ?~ "uuid"
290284
291285-- | A configurable generic @'ParamSchema'@ creator.
@@ -323,7 +317,7 @@ instance (GEnumParamSchema f, GEnumParamSchema g) => GEnumParamSchema (f :+: g)
323317
324318instance Constructor c => GEnumParamSchema (C1 c U1) where
325319 genumParamSchema opts _ s = s
326− & type_ ?~ SwaggerString
320+ & type_ .~ SwaggerString
327321 & enum_ %~ addEnumValue tag
328322 where
329323 tag = toJSON (constructorTagModifier opts (conName (Proxy3 :: Proxy3 c f p)))
src/Data/Swagger/Internal/Schema.hs+28−32
@@ -111,7 +111,7 @@ rename name (NamedSchema _ schema) = NamedSchema name schema
111111-- declareNamedSchema _ = do
112112-- doubleSchema <- declareSchemaRef (Proxy :: Proxy Double)
113113-- return $ NamedSchema (Just \"Coord\") $ mempty
114−-- & type_ ?~ SwaggerObject
114+-- & type_ .~ SwaggerObject
115115-- & properties .~
116116-- [ (\"x\", doubleSchema)
117117-- , (\"y\", doubleSchema)
@@ -147,10 +147,6 @@ class ToSchema a where
147147 Proxy a -> Declare (Definitions Schema) NamedSchema
148148 declareNamedSchema = genericDeclareNamedSchema defaultSchemaOptions
149149
150−instance ToSchema TimeOfDay where
151− declareNamedSchema _ = pure $ named "TimeOfDay" $ timeSchema "hh:MM:ss"
152− & example ?~ toJSON (TimeOfDay 12 33 15)
153−
154150-- | Convert a type into a schema and declare all used schema definitions.
155151declareSchema :: ToSchema a => Proxy a -> Declare (Definitions Schema) Schema
156152declareSchema = fmap _namedSchemaSchema . declareNamedSchema
@@ -298,20 +294,20 @@ inlineNonRecursiveSchemas defs = inlineSchemasWhen nonRecursive defs
298294-- | Default schema for binary data (any sequence of octets).
299295binarySchema :: Schema
300296binarySchema = mempty
301− & type_ ?~ SwaggerString
297+ & type_ .~ SwaggerString
302298 & format ?~ "binary"
303299
304300-- | Default schema for binary data (base64 encoded).
305301byteSchema :: Schema
306302byteSchema = mempty
307− & type_ ?~ SwaggerString
303+ & type_ .~ SwaggerString
308304 & format ?~ "byte"
309305
310306-- | Default schema for password string.
311307-- @"password"@ format is used to hint UIs the input needs to be obscured.
312308passwordSchema :: Schema
313309passwordSchema = mempty
314− & type_ ?~ SwaggerString
310+ & type_ .~ SwaggerString
315311 & format ?~ "password"
316312
317313-- | Make an unrestrictive sketch of a @'Schema'@ based on a @'ToJSON'@ instance.
@@ -337,12 +333,12 @@ sketchSchema = sketch . toJSON
337333 sketch js@(Bool _) = go js
338334 sketch js = go js & example ?~ js
339335
340− go Null = mempty & type_ ?~ SwaggerNull
341− go (Bool _) = mempty & type_ ?~ SwaggerBoolean
342− go (String _) = mempty & type_ ?~ SwaggerString
343− go (Number _) = mempty & type_ ?~ SwaggerNumber
336+ go Null = mempty & type_ .~ SwaggerNull
337+ go (Bool _) = mempty & type_ .~ SwaggerBoolean
338+ go (String _) = mempty & type_ .~ SwaggerString
339+ go (Number _) = mempty & type_ .~ SwaggerNumber
344340 go (Array xs) = mempty
345− & type_ ?~ SwaggerArray
341+ & type_ .~ SwaggerArray
346342 & items ?~ case ischema of
347343 Just s -> SwaggerItemsObject (Inline s)
348344 _ -> SwaggerItemsArray (map Inline ys)
@@ -354,7 +350,7 @@ sketchSchema = sketch . toJSON
354350 (z:_) | allSame -> Just z
355351 _ -> Nothing
356352 go (Object o) = mempty
357− & type_ ?~ SwaggerObject
353+ & type_ .~ SwaggerObject
358354 & required .~ HashMap.keys o
359355 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
360356
@@ -377,24 +373,24 @@ sketchSchema = sketch . toJSON
377373sketchStrictSchema :: ToJSON a => a -> Schema
378374sketchStrictSchema = go . toJSON
379375 where
380− go Null = mempty & type_ ?~ SwaggerNull
376+ go Null = mempty & type_ .~ SwaggerNull
381377 go js@(Bool _) = mempty
382− & type_ ?~ SwaggerBoolean
378+ & type_ .~ SwaggerBoolean
383379 & enum_ ?~ [js]
384380 go js@(String s) = mempty
385− & type_ ?~ SwaggerString
381+ & type_ .~ SwaggerString
386382 & maxLength ?~ fromIntegral (T.length s)
387383 & minLength ?~ fromIntegral (T.length s)
388384 & pattern ?~ s
389385 & enum_ ?~ [js]
390386 go js@(Number n) = mempty
391− & type_ ?~ SwaggerNumber
387+ & type_ .~ SwaggerNumber
392388 & maximum_ ?~ n
393389 & minimum_ ?~ n
394390 & multipleOf ?~ n
395391 & enum_ ?~ [js]
396392 go js@(Array xs) = mempty
397− & type_ ?~ SwaggerArray
393+ & type_ .~ SwaggerArray
398394 & maxItems ?~ fromIntegral sz
399395 & minItems ?~ fromIntegral sz
400396 & items ?~ SwaggerItemsArray (map (Inline . go) (V.toList xs))
@@ -404,7 +400,7 @@ sketchStrictSchema = go . toJSON
404400 sz = length xs
405401 allUnique = sz == HashSet.size (HashSet.fromList (V.toList xs))
406402 go js@(Object o) = mempty
407− & type_ ?~ SwaggerObject
403+ & type_ .~ SwaggerObject
408404 & required .~ names
409405 & properties .~ fmap (Inline . go) (InsOrdHashMap.fromHashMap o)
410406 & maxProperties ?~ fromIntegral (length names)
@@ -420,7 +416,7 @@ instance OVERLAPPABLE_ ToSchema a => ToSchema [a] where
420416 declareNamedSchema _ = do
421417 ref <- declareSchemaRef (Proxy :: Proxy a)
422418 return $ unnamed $ mempty
423− & type_ ?~ SwaggerArray
419+ & type_ .~ SwaggerArray
424420 & items ?~ SwaggerItemsObject ref
425421
426422instance OVERLAPPING_ ToSchema String where declareNamedSchema = plain . paramSchemaToSchema
@@ -470,7 +466,7 @@ instance (ToSchema a, ToSchema b, ToSchema c, ToSchema d, ToSchema e, ToSchema f
470466
471467timeSchema :: T.Text -> Schema
472468timeSchema fmt = mempty
473− & type_ ?~ SwaggerString
469+ & type_ .~ SwaggerString
474470 & format ?~ fmt
475471
476472-- | Format @"date"@ corresponds to @yyyy-mm-dd@ format.
@@ -532,7 +528,7 @@ instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (Map k v) where
532528 declareObjectMapSchema = do
533529 schema <- declareSchemaRef (Proxy :: Proxy v)
534530 return $ unnamed $ mempty
535− & type_ ?~ SwaggerObject
531+ & type_ .~ SwaggerObject
536532 & additionalProperties ?~ AdditionalPropertiesSchema schema
537533
538534instance (ToJSONKey k, ToSchema k, ToSchema v) => ToSchema (HashMap k v) where
@@ -544,7 +540,7 @@ instance ToSchema a => ToSchema (Map String a) where
544540 declareNamedSchema _ = do
545541 schema <- declareSchemaRef (Proxy :: Proxy a)
546542 return $ unnamed $ mempty
547− & type_ ?~ SwaggerObject
543+ & type_ .~ SwaggerObject
548544 & additionalProperties ?~ schema
549545
550546instance ToSchema a => ToSchema (Map T.Text a) where declareNamedSchema _ = declareNamedSchema (Proxy :: Proxy (Map String a))
@@ -558,7 +554,7 @@ instance ToSchema a => ToSchema (HashMap TL.Text a) where declareNamedSchema _ =
558554
559555instance OVERLAPPING_ ToSchema Object where
560556 declareNamedSchema _ = pure $ NamedSchema (Just "Object") $ mempty
561− & type_ ?~ SwaggerObject
557+ & type_ .~ SwaggerObject
562558 & description ?~ "Arbitrary JSON object."
563559 & additionalProperties ?~ AdditionalPropertiesAllowed True
564560
@@ -599,7 +595,7 @@ instance ToSchema a => ToSchema (Identity a) where declareNamedSchema _ = declar
599595-- "{\"maximum\":32767,\"minimum\":-32768,\"type\":\"integer\"}"
600596toSchemaBoundedIntegral :: forall a. (Bounded a, Integral a) => Proxy a -> Schema
601597toSchemaBoundedIntegral _ = mempty
602− & type_ ?~ SwaggerInteger
598+ & type_ .~ SwaggerInteger
603599 & minimum_ ?~ fromInteger (toInteger (minBound :: a))
604600 & maximum_ ?~ fromInteger (toInteger (maxBound :: a))
605601
@@ -645,7 +641,7 @@ declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key o
645641 let allKeys = [minBound..maxBound :: key]
646642 mkPair k = (keyToText k, valueRef)
647643 return $ mempty
648− & type_ ?~ SwaggerObject
644+ & type_ .~ SwaggerObject
649645 & properties .~ InsOrdHashMap.fromList (map mkPair allKeys)
650646
651647-- | A 'Schema' for a mapping with 'Bounded' 'Enum' keys.
@@ -719,7 +715,7 @@ paramSchemaToSchema proxy = mempty & paramSchema .~ toParamSchema proxy
719715
720716nullarySchema :: Schema
721717nullarySchema = mempty
722− & type_ ?~ SwaggerArray
718+ & type_ .~ SwaggerArray
723719 & items ?~ SwaggerItemsArray []
724720
725721gtoNamedSchema :: GToSchema f => SchemaOptions -> Proxy f -> NamedSchema
@@ -790,12 +786,12 @@ withFieldSchema opts _ isRequiredField schema = do
790786 return $
791787 if T.null fname
792788 then schema
793− & type_ ?~ SwaggerArray
789+ & type_ .~ SwaggerArray
794790 & items %~ appendItem ref
795791 & maxItems %~ Just . maybe 1 (+1) -- increment maxItems
796792 & minItems %~ Just . maybe 1 (+1) -- increment minItems
797793 else schema
798− & type_ ?~ SwaggerObject
794+ & type_ .~ SwaggerObject
799795 & properties . at fname ?~ ref
800796 & if isRequiredField
801797 then required %~ (++ [fname])
@@ -832,7 +828,7 @@ gdeclareNamedSumSchema opts proxy s
832828 (sumSchema, All allNullary) = undeclare (runWriterT declareSumSchema)
833829
834830 toStringTag schema = mempty
835− & type_ ?~ SwaggerString
831+ & type_ .~ SwaggerString
836832 & enum_ ?~ map toJSON (schema ^.. properties.ifolded.asIndex)
837833
838834type AllNullary = All
@@ -846,7 +842,7 @@ instance (GSumToSchema f, GSumToSchema g) => GSumToSchema (f :+: g) where
846842gsumConToSchemaWith :: forall c f. (GToSchema (C1 c f), Constructor c) =>
847843 Referenced Schema -> SchemaOptions -> Proxy (C1 c f) -> Schema -> Schema
848844gsumConToSchemaWith ref opts _ schema = schema
849− & type_ ?~ SwaggerObject
845+ & type_ .~ SwaggerObject
850846 & properties . at tag ?~ ref
851847 & maxProperties ?~ 1
852848 & minProperties ?~ 1
src/Data/Swagger/Internal/Schema/Validation.hs+49−207
@@ -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
1715-- Copyright: (c) 2015 GetShopTV
@@ -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)) == []
@@ -411,8 +320,8 @@ validateObject o = withSchema $ \sch ->
411320 validateAdditional _ v (AdditionalPropertiesSchema s) = validateWithSchemaRef s v
412321
413322 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"
323+ unknownProperty name = invalid $
324+ "property " <> show name <> " is found in JSON value, but it is not mentioned in Swagger schema"
416325
417326validateEnum :: Value -> Validation (ParamSchema t) ()
418327validateEnum value = do
@@ -420,92 +329,25 @@ validateEnum value = do
420329 when (value `notElem` xs) $
421330 invalid ("expected one of " ++ show (encode xs) ++ " but got " ++ show value)
422331
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−
470332validateSchemaType :: Value -> Validation Schema ()
471333validateSchemaType value = withSchema $ \sch ->
472334 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
335+ (SwaggerNull, Null) -> valid
336+ (SwaggerBoolean, Bool _) -> valid
337+ (SwaggerInteger, Number n) -> sub_ paramSchema (validateInteger n)
338+ (SwaggerNumber, Number n) -> sub_ paramSchema (validateNumber n)
339+ (SwaggerString, String s) -> sub_ paramSchema (validateString s)
340+ (SwaggerArray, Array xs) -> sub_ paramSchema (validateArray xs)
341+ (SwaggerObject, Object o) -> validateObject o
342+ (t, _) -> invalid $ "expected JSON value of type " ++ show t
488343
489344validateParamSchemaType :: Value -> Validation (ParamSchema t) ()
490345validateParamSchemaType value = withSchema $ \sch ->
491346 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"
347+ (SwaggerBoolean, Bool _) -> valid
348+ (SwaggerInteger, Number n) -> validateInteger n
349+ (SwaggerNumber, Number n) -> validateNumber n
350+ (SwaggerString, String s) -> validateString s
351+ (SwaggerArray, Array xs) -> validateArray xs
352+ (t, _) -> invalid $ "expected JSON value of type " ++ show t
353+
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+2−3
@@ -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,8 +111,8 @@ 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.
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.hs+14−22
@@ -4,55 +4,47 @@
44
55module Data.Swagger.Schema.Generator where
66
7−import Prelude ()
7+import Prelude ()
88import Prelude.Compat
99
1010import Control.Lens.Operators
11−import Control.Monad (filterM)
11+import Control.Monad (filterM)
1212import Data.Aeson
1313import Data.Aeson.Types
14−import qualified Data.HashMap.Strict.InsOrd as M
14+import qualified Data.HashMap.Strict.InsOrd as M
1515import Data.Maybe
1616import Data.Maybe
1717import Data.Proxy
1818import Data.Scientific
19−import qualified Data.Set as S
19+import qualified Data.Set as S
2020import Data.Swagger
2121import 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)
22+import qualified Data.Text as T
23+import qualified Data.Vector as V
24+import Test.QuickCheck (arbitrary)
2625import Test.QuickCheck.Gen
2726import Test.QuickCheck.Property
2827
29−-- | Note: 'schemaGen' may 'error', if schema type is not specified,
30−-- and cannot be inferred.
3128schemaGen :: Definitions Schema -> Schema -> Gen Value
3229schemaGen _ schema
3330 | Just cases <- schema ^. paramSchema . enum_ = elements cases
3431schemaGen defns schema =
3532 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
33+ SwaggerBoolean -> Bool <$> elements [True, False]
34+ SwaggerNull -> pure Null
35+ SwaggerNumber
4436 | Just min <- schema ^. minimum_
4537 , Just max <- schema ^. maximum_ ->
4638 Number . fromFloatDigits <$>
4739 choose (toRealFloat min, toRealFloat max :: Double)
4840 | otherwise -> Number .fromFloatDigits <$> (arbitrary :: Gen Double)
49− Just SwaggerInteger
41+ SwaggerInteger
5042 | Just min <- schema ^. minimum_
5143 , Just max <- schema ^. maximum_ ->
5244 Number . fromInteger <$>
5345 choose (truncate min, truncate max)
5446 | otherwise -> Number . fromInteger <$> arbitrary
55− Just SwaggerArray
47+ SwaggerArray
5648 | Just 0 <- schema ^. maxLength -> pure $ Array V.empty
5749 | Just items <- schema ^. items ->
5850 case items of
@@ -67,14 +59,14 @@ schemaGen defns schema =
6759 SwaggerItemsArray refs ->
6860 let itemGens = schemaGen defns . dereference defns <$> refs
6961 in fmap (Array . V.fromList) $ sequence itemGens
70− Just SwaggerString -> do
62+ SwaggerString -> do
7163 size <- getSize
7264 let minLength' = fromMaybe 0 $ fromInteger <$> schema ^. minLength
7365 let maxLength' = fromMaybe size $ fromInteger <$> schema ^. maxLength
7466 length <- choose (minLength', max minLength' maxLength')
7567 str <- vectorOf length arbitrary
7668 return . String $ T.pack str
77− Just SwaggerObject -> do
69+ SwaggerObject -> do
7870 size <- getSize
7971 let props = dereference defns <$> schema ^. properties
8072 reqKeys = S.fromList $ schema ^. required
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.yaml+4−6
@@ -1,9 +1,7 @@
1−resolver: lts-14.3
1+resolver: lts-12.10
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.4.2.0
6+- base-compat-batteries-0.10.4
7+- contravariant-1.5
swagger2.cabal+17−20
@@ -1,6 +1,6 @@
11cabal-version: >=1.10
22name: swagger2
3−version: 2.5
3+version: 2.3.1.1
44
55synopsis: Swagger 2.0 data model
66category: Web, Swagger
@@ -24,11 +24,12 @@ extra-source-files:
2424 , examples/*.hs
2525 , include/overlapping-compat.h
2626tested-with:
27− GHC ==8.0.2
27+ GHC ==7.8.4
28+ || ==7.10.3
29+ || ==8.0.2
2830 || ==8.2.2
2931 || ==8.4.4
30− || ==8.6.5
31− || ==8.8.1
32+ || ==8.6.2
3233
3334custom-setup
3435 setup-depends:
@@ -42,7 +43,6 @@ library
4243 Data.Swagger.Declare
4344 Data.Swagger.Lens
4445 Data.Swagger.Operation
45− Data.Swagger.Optics
4646 Data.Swagger.ParamSchema
4747 Data.Swagger.Schema
4848 Data.Swagger.Schema.Generator
@@ -60,12 +60,11 @@ library
6060
6161 -- GHC boot libraries
6262 build-depends:
63− base >=4.9 && <4.14
64− , aeson-pretty >=0.8.7 && <0.9
63+ base >=4.7 && <4.13
6564 , bytestring >=0.10.4.0 && <0.11
6665 , containers >=0.5.5.1 && <0.7
67− , template-haskell >=2.9.0.0 && <2.16
68− , time >=1.4.2 && <1.10
66+ , template-haskell >=2.9.0.0 && <2.15
67+ , time >=1.4.2 && <1.9
6968 , transformers >=0.3.0.0 && <0.6
7069
7170 build-depends:
@@ -74,24 +73,22 @@ library
7473
7574 -- other dependencies
7675 build-depends:
77− base-compat-batteries >=0.10.4 && <0.12
76+ base-compat-batteries >=0.10.4 && <0.11
7877 , aeson >=1.4.2.0 && <1.5
7978 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint
8079 , 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
80+ , generics-sop >=0.3.2.0 && <0.5
81+ , hashable >=1.2.7.0 && <1.3
82+ , http-media >=0.7.1.2 && <0.8
83+ , insert-ordered-containers >=0.2.1.0 && <0.3
84+ , lens >=4.16.1 && <4.18
85+ , network >=2.6.3.5 && <3.1
8986 , scientific >=0.3.6.2 && <0.4
9087 , transformers-compat >=0.3 && <0.7
9188 , unordered-containers >=0.2.9.0 && <0.3
9289 , uuid-types >=1.0.3 && <1.1
9390 , vector >=0.12.0.1 && <0.13
94− , QuickCheck >=2.10.1 && <2.14
91+ , QuickCheck >=2.10.1 && <2.13
9592
9693 default-language: Haskell2010
9794
@@ -118,12 +115,12 @@ test-suite spec
118115 , time
119116 , unordered-containers
120117 , vector
121− , QuickCheck
122118
123119 -- test-suite only dependencies
124120 build-depends:
125121 hspec >=2.5.5 && <2.8
126122 , HUnit >=1.6.0.0 && <1.7
123+ , QuickCheck >=2.11.3 && <2.13
127124 , quickcheck-instances >=0.3.19 && <0.14
128125 , utf8-string >=1.0.1.1 && <1.1
129126
test/Data/Swagger/CommonTestTypes.hs+2−29
@@ -18,6 +18,8 @@ import qualified Data.Text as Text
1818import GHC.Generics
1919
2020import Data.Swagger
21+import Data.Swagger.Declare
22+import Data.Swagger.Internal (SwaggerKind (..))
2123
2224-- ========================================================================
2325-- Unit type
@@ -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+1−6
@@ -3,10 +3,9 @@
33{-# LANGUAGE ScopedTypeVariables #-}
44{-# LANGUAGE TemplateHaskell #-}
55{-# LANGUAGE QuasiQuotes #-}
6−{-# LANGUAGE OverloadedStrings #-}
76module Data.Swagger.ParamSchemaSpec where
87
9−import Data.Aeson
8+import Data.Aeson (Value)
109import Data.Aeson.QQ.Simple
1110import Data.Char
1211import Data.Proxy
@@ -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.hs+4−4
@@ -103,7 +103,7 @@ instance FromJSON WrongType where
103103instance ToSchema WrongType where
104104 declareNamedSchema _ = return . NamedSchema (Just "WrongType") $
105105 mempty
106− & type_ ?~ SwaggerObject
106+ & type_ .~ SwaggerObject
107107
108108
109109data MissingRequired = MissingRequired
@@ -123,7 +123,7 @@ instance ToSchema MissingRequired where
123123 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)
124124 return . NamedSchema (Just "MissingRequired") $
125125 mempty
126− & type_ ?~ SwaggerObject
126+ & type_ .~ SwaggerObject
127127 & properties .~ [("propA", stringSchema)
128128 ,("propB", boolSchema)
129129 ]
@@ -145,7 +145,7 @@ instance ToSchema MissingProperty where
145145 stringSchema <- declareSchemaRef (Proxy :: Proxy String)
146146 return . NamedSchema (Just "MissingProperty") $
147147 mempty
148− & type_ ?~ SwaggerObject
148+ & type_ .~ SwaggerObject
149149 & properties .~ [("propC", stringSchema)]
150150 & required .~ ["propC"]
151151
@@ -163,6 +163,6 @@ instance ToSchema WrongPropType where
163163 boolSchema <- declareSchemaRef (Proxy :: Proxy Bool)
164164 return . NamedSchema (Just "WrongPropType") $
165165 mempty
166− & type_ ?~ SwaggerObject
166+ & type_ .~ SwaggerObject
167167 & properties .~ [("propE", boolSchema)]
168168 & required .~ ["propE"]
test/Data/Swagger/Schema/ValidationSpec.hs+1−1
@@ -248,7 +248,7 @@ instance ToJSON FreeForm where
248248
249249instance ToSchema FreeForm where
250250 declareNamedSchema _ = pure $ NamedSchema (Just $ T.pack "FreeForm") $ mempty
251− & type_ ?~ SwaggerObject
251+ & type_ .~ SwaggerObject
252252 & additionalProperties ?~ AdditionalPropertiesAllowed True
253253
254254instance Arbitrary FreeForm where
test/Data/Swagger/SchemaSpec.hs+6−5
@@ -8,11 +8,16 @@ import Prelude ()
88import Prelude.Compat
99
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.Simple
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−72
@@ -12,7 +12,7 @@ import Control.Lens
1212import Data.Aeson
1313import Data.Aeson.QQ.Simple
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
@@ -43,7 +43,6 @@ spec = do
4343 describe "Parameters Definition Object" $ paramsDefinitionExample <=> paramsDefinitionExampleJSON
4444 describe "Responses Definition Object" $ responsesDefinitionExample <=> responsesDefinitionExampleJSON
4545 describe "Security Definitions Object" $ securityDefinitionsExample <=> securityDefinitionsExampleJSON
46− describe "OAuth2 Security Definitions with merged Scope" $ oAuth2SecurityDefinitionsExample <=> oAuth2SecurityDefinitionsExampleJSON
4746 describe "Composition Schema Example" $ compositionSchemaExample <=> compositionSchemaExampleJSON
4847 describe "Swagger Object" $ do
4948 context "Todo Example" $ swaggerExample <=> swaggerExampleJSON
@@ -128,7 +127,7 @@ licenseExampleJSON = [aesonQQ|
128127
129128operationExample :: Operation
130129operationExample = mempty
131− & tags .~ InsOrdHS.fromList ["pet"]
130+ & tags .~ Set.fromList ["pet"]
132131 & summary ?~ "Updates a pet in the store with form data"
133132 & description ?~ ""
134133 & operationId ?~ "updatePetWithForm"
@@ -159,7 +158,7 @@ operationExample = mempty
159158 stringSchema :: ParamLocation -> ParamOtherSchema
160159 stringSchema loc = mempty
161160 & in_ .~ loc
162− & type_ ?~ SwaggerString
161+ & type_ .~ SwaggerString
163162
164163operationExampleJSON :: Value
165164operationExampleJSON = [aesonQQ|
@@ -225,7 +224,7 @@ operationExampleJSON = [aesonQQ|
225224
226225schemaPrimitiveExample :: Schema
227226schemaPrimitiveExample = mempty
228− & type_ ?~ SwaggerString
227+ & type_ .~ SwaggerString
229228 & format ?~ "email"
230229
231230schemaPrimitiveExampleJSON :: Value
@@ -238,14 +237,14 @@ schemaPrimitiveExampleJSON = [aesonQQ|
238237
239238schemaSimpleModelExample :: Schema
240239schemaSimpleModelExample = mempty
241− & type_ ?~ SwaggerObject
240+ & type_ .~ SwaggerObject
242241 & required .~ [ "name" ]
243242 & properties .~
244− [ ("name", Inline (mempty & type_ ?~ SwaggerString))
243+ [ ("name", Inline (mempty & type_ .~ SwaggerString))
245244 , ("address", Ref (Reference "Address"))
246245 , ("age", Inline $ mempty
247246 & minimum_ ?~ 0
248− & type_ ?~ SwaggerInteger
247+ & type_ .~ SwaggerInteger
249248 & format ?~ "int32" ) ]
250249
251250schemaSimpleModelExampleJSON :: Value
@@ -273,8 +272,8 @@ schemaSimpleModelExampleJSON = [aesonQQ|
273272
274273schemaModelDictExample :: Schema
275274schemaModelDictExample = mempty
276− & type_ ?~ SwaggerObject
277− & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ ?~ SwaggerString))
275+ & type_ .~ SwaggerObject
276+ & additionalProperties ?~ AdditionalPropertiesSchema (Inline (mempty & type_ .~ SwaggerString))
278277
279278schemaModelDictExampleJSON :: Value
280279schemaModelDictExampleJSON = [aesonQQ|
@@ -288,7 +287,7 @@ schemaModelDictExampleJSON = [aesonQQ|
288287
289288schemaAdditionalExample :: Schema
290289schemaAdditionalExample = mempty
291− & type_ ?~ SwaggerObject
290+ & type_ .~ SwaggerObject
292291 & additionalProperties ?~ AdditionalPropertiesAllowed True
293292
294293schemaAdditionalExampleJSON :: Value
@@ -301,13 +300,13 @@ schemaAdditionalExampleJSON = [aesonQQ|
301300
302301schemaWithExampleExample :: Schema
303302schemaWithExampleExample = mempty
304− & type_ ?~ SwaggerObject
303+ & type_ .~ SwaggerObject
305304 & properties .~
306305 [ ("id", Inline $ mempty
307− & type_ ?~ SwaggerInteger
306+ & type_ .~ SwaggerInteger
308307 & format ?~ "int64" )
309308 , ("name", Inline $ mempty
310− & type_ ?~ SwaggerString) ]
309+ & type_ .~ SwaggerString) ]
311310 & required .~ [ "name" ]
312311 & example ?~ [aesonQQ|
313312 {
@@ -346,19 +345,19 @@ schemaWithExampleExampleJSON = [aesonQQ|
346345definitionsExample :: HashMap Text Schema
347346definitionsExample =
348347 [ ("Category", mempty
349− & type_ ?~ SwaggerObject
348+ & type_ .~ SwaggerObject
350349 & properties .~
351350 [ ("id", Inline $ mempty
352− & type_ ?~ SwaggerInteger
351+ & type_ .~ SwaggerInteger
353352 & format ?~ "int64")
354− , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] )
353+ , ("name", Inline (mempty & type_ .~ SwaggerString)) ] )
355354 , ("Tag", mempty
356− & type_ ?~ SwaggerObject
355+ & type_ .~ SwaggerObject
357356 & properties .~
358357 [ ("id", Inline $ mempty
359− & type_ ?~ SwaggerInteger
358+ & type_ .~ SwaggerInteger
360359 & format ?~ "int64")
361− , ("name", Inline (mempty & type_ ?~ SwaggerString)) ] ) ]
360+ , ("name", Inline (mempty & type_ .~ SwaggerString)) ] ) ]
362361
363362definitionsExampleJSON :: Value
364363definitionsExampleJSON = [aesonQQ|
@@ -402,7 +401,7 @@ paramsDefinitionExample =
402401 & required ?~ True
403402 & schema .~ ParamOther (mempty
404403 & in_ .~ ParamQuery
405− & type_ ?~ SwaggerInteger
404+ & type_ .~ SwaggerInteger
406405 & format ?~ "int32" ))
407406 , ("limitParam", mempty
408407 & name .~ "limit"
@@ -410,7 +409,7 @@ paramsDefinitionExample =
410409 & required ?~ True
411410 & schema .~ ParamOther (mempty
412411 & in_ .~ ParamQuery
413− & type_ ?~ SwaggerInteger
412+ & type_ .~ SwaggerInteger
414413 & format ?~ "int32" )) ]
415414
416415paramsDefinitionExampleJSON :: Value
@@ -460,8 +459,8 @@ responsesDefinitionExampleJSON = [aesonQQ|
460459-- Responses Definition object
461460-- =======================================================================
462461
463−securityDefinitionsExample :: SecurityDefinitions
464−securityDefinitionsExample = SecurityDefinitions
462+securityDefinitionsExample :: HashMap Text SecurityScheme
463+securityDefinitionsExample =
465464 [ ("api_key", SecurityScheme
466465 { _securitySchemeType = SecuritySchemeApiKey (ApiKeyParams "api_key" ApiKeyHeader)
467466 , _securitySchemeDescription = Nothing })
@@ -493,46 +492,6 @@ securityDefinitionsExampleJSON = [aesonQQ|
493492}
494493|]
495494
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−
536495-- =======================================================================
537496-- Swagger object
538497-- =======================================================================
@@ -551,7 +510,7 @@ swaggerExample = mempty
551510 & at 200 ?~ Inline (mempty
552511 & description .~ "OK"
553512 & schema ?~ Inline (mempty
554− & type_ ?~ SwaggerObject
513+ & type_ .~ SwaggerObject
555514 & example ?~ [aesonQQ|
556515 {
557516 "created": 100,
@@ -560,9 +519,9 @@ swaggerExample = mempty
560519 & description ?~ "This is some real Todo right here"
561520 & properties .~
562521 [ ("created", Inline $ mempty
563− & type_ ?~ SwaggerInteger
522+ & type_ .~ SwaggerInteger
564523 & format ?~ "int32")
565− , ("description", Inline (mempty & type_ ?~ SwaggerString))]))
524+ , ("description", Inline (mempty & type_ .~ SwaggerString))]))
566525 & produces ?~ MimeList [ "application/json" ]
567526 & parameters .~
568527 [ Inline $ mempty
@@ -571,8 +530,8 @@ swaggerExample = mempty
571530 & description ?~ "TodoId param"
572531 & schema .~ ParamOther (mempty
573532 & in_ .~ ParamPath
574− & type_ ?~ SwaggerString ) ]
575− & tags .~ InsOrdHS.fromList [ "todo" ] ))
533+ & type_ .~ SwaggerString ) ]
534+ & tags .~ Set.fromList [ "todo" ] ))
576535
577536swaggerExampleJSON :: Value
578537swaggerExampleJSON = [aesonQQ|
@@ -1673,14 +1632,14 @@ petstoreExampleJSON = [aesonQQ|
16731632
16741633compositionSchemaExample :: Schema
16751634compositionSchemaExample = mempty
1676− & type_ ?~ SwaggerObject
1635+ & type_ .~ SwaggerObject
16771636 & Data.Swagger.allOf ?~ [
16781637 Ref (Reference "Other")
16791638 , Inline (mempty
1680− & type_ ?~ SwaggerObject
1639+ & type_ .~ SwaggerObject
16811640 & properties .~
16821641 [ ("greet", Inline $ mempty
1683− & type_ ?~ SwaggerString) ])
1642+ & type_ .~ SwaggerString) ])
16841643 ]
16851644
16861645compositionSchemaExampleJSON :: Value