78dd024 · typeable/swagger2

git.iko.soy/typeable/swagger2

Merge remote-tracking branch 'origin/master' into 87_add_instance_for_TimeOfDay

# Conflicts: # test/Data/Swagger/SchemaSpec.hs

commit78dd0242676760f36f58f7bd06712c3b67928a6e authoranneloreegger <annelore.e@hotmail.com> dateThu 24 Oct 2019, 17:12 (7 years ago) parent48a545d c121663

7 files changed+130−57

compare with master

unifiedsplit

.ghci+1 .travis.yml+28−37 src/Data/Swagger/Internal/Schema/Validation.hs+92−6 src/Data/Swagger/Schema/Validation.hs+2 swagger2.cabal+6−4 test/Data/Swagger/CommonTestTypes.hs−2 test/Data/Swagger/SchemaSpec.hs+1−8

.ghci+1

@@ -1 +1,2 @@

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+28−37

@@ -4,7 +4,7 @@

44#

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

66#

7−# version: 0.3.20190429

7+# version: 0.5.20190908

88#

99language: c

1010dist: xenial

@@ -31,30 +31,29 @@ matrix:

3131 include:

3232 - compiler: ghc-8.8.1

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

34− env: GHCHEAD=true

3534 - compiler: ghc-8.6.5

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

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

3736 - compiler: ghc-8.4.4

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

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

3938 - compiler: ghc-8.2.2

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

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

4140 - compiler: ghc-8.0.2

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

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

4342 - compiler: ghc-7.10.3

44− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-2.4"]}}

43+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.10.3","cabal-install-3.0"]}}

4544 - compiler: ghc-7.8.4

46− addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-2.4"]}}

47− allow_failures:

48− - compiler: ghc-8.8.1

45+ addons: {"apt":{"sources":["hvr-ghc"],"packages":["ghc-7.8.4","cabal-install-3.0"]}}

4946before_install:

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

48+ - WITHCOMPILER="-w $HC"

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

5150 - HCPKG="$HC-pkg"

5251 - unset CC

5352 - CABAL=/opt/ghc/bin/cabal

5453 - CABALHOME=$HOME/.cabal

5554 - export PATH="$CABALHOME/bin:$PATH"

5655 - TOP=$(pwd)

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

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

5857 - echo $HCNUMVER

5958 - CABAL="$CABAL -vnormal+nowrap+markoutput"

6059 - set -o pipefail

@@ -81,11 +80,12 @@ install:

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

8281 - TEST=--enable-tests

8382 - BENCH=--enable-benchmarks

84− - GHCHEAD=${GHCHEAD-false}

83+ - HEADHACKAGE=false

8584 - rm -f $CABALHOME/config

8685 - |

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

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

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

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

9090 echo "logs-dir: $CABALHOME/logs" >> $CABALHOME/config

9191 echo "world-file: $CABALHOME/world" >> $CABALHOME/config

@@ -99,17 +99,8 @@ install:

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

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

101101 - |

102− if $GHCHEAD; then

103− echo "allow-newer: $($HCPKG list --simple-output | sed -E 's/([a-zA-Z-]+)-[0-9.]+/*:\1/g')" >> $CABALHOME/config

104−

105− echo "repository head.hackage" >> $CABALHOME/config

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

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

108− echo " root-keys: 07c59cb65787dedfaef5bd5f987ceb5f7e5ebf88b904bbd4c5cbdeb2ff71b740" >> $CABALHOME/config

109− echo " 2e8555dde16ebd8df076f1a8ef13b8f14c66bad8eafefd7d9e37d0ed711821fb" >> $CABALHOME/config

110− echo " 8f79fd2389ab2967354407ec852cbe73f2e8635793ac446d09461ffb99527f6e" >> $CABALHOME/config

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

112− fi

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

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

113104 - cat $CABALHOME/config

114105 - rm -fv cabal.project cabal.project.local cabal.project.freeze

115106 - travis_retry ${CABAL} v2-update -v

@@ -117,18 +108,17 @@ install:

117108 - rm -rf cabal.project cabal.project.local cabal.project.freeze

118109 - touch cabal.project

119110 - |

120− echo 'packages: "."' >> cabal.project

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

121112 - |

122− echo "write-ghc-environment-files: always" >> cabal.project

123113 - "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"

124114 - cat cabal.project || true

125115 - cat cabal.project.local || true

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

127− - ${CABAL} v2-freeze -w ${HC} ${TEST} ${BENCH} | color_cabal_output

117+ - ${CABAL} v2-freeze $WITHCOMPILER ${TEST} ${BENCH} | color_cabal_output

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

129119 - rm cabal.project.freeze

130− - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} --dep -j2 all | color_cabal_output

131− - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks --dep -j2 all | color_cabal_output

120+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} --dep -j2 all | color_cabal_output

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

132122script:

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

134124 # Packaging...

@@ -136,32 +126,33 @@ script:

136126 # Unpacking...

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

138128 - cd ${DISTDIR} || false

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

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

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

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

140132 # Generate cabal.project

141133 - rm -rf cabal.project cabal.project.local cabal.project.freeze

142134 - touch cabal.project

143135 - |

144− echo 'packages: "swagger2-*/*.cabal"' >> cabal.project

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

145137 - |

146− echo "write-ghc-environment-files: always" >> cabal.project

147138 - "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"

148139 - cat cabal.project || true

149140 - cat cabal.project.local || true

150141 # Building...

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

152− - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output

143+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output

153144 # Building with tests and benchmarks...

154145 # build & run tests, build benchmarks

155− - ${CABAL} v2-build -w ${HC} ${TEST} ${BENCH} all | color_cabal_output

146+ - ${CABAL} v2-build $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output

156147 # Testing...

157− - ${CABAL} v2-test -w ${HC} ${TEST} ${BENCH} all | color_cabal_output

148+ - ${CABAL} v2-test $WITHCOMPILER ${TEST} ${BENCH} all | color_cabal_output

158149 # cabal check...

159− - (cd swagger2-* && ${CABAL} -vnormal check)

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

160151 # haddock...

161− - if [ $HCNUMVER -ge 80400 ] ; then ${CABAL} v2-haddock -w ${HC} ${TEST} ${BENCH} all | color_cabal_output ; fi

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

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

163154 - rm -f cabal.project.local

164− - ${CABAL} v2-build -w ${HC} --disable-tests --disable-benchmarks all | color_cabal_output

155+ - ${CABAL} v2-build $WITHCOMPILER --disable-tests --disable-benchmarks all | color_cabal_output

165156

166157# REGENDATA ["--branches","master","--haddock-jobs=>=8.4","--output",".travis.yml","swagger2.cabal"]

167158# EOF

src/Data/Swagger/Internal/Schema/Validation.hs+92−6

@@ -22,23 +22,27 @@

2222-- Validate JSON values with Swagger Schema.

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

2424

25+import Prelude ()

26+import Prelude.Compat

27+

2528import Control.Applicative

2629import Control.Lens

2730import Control.Monad (when)

2831

2932import Data.Aeson hiding (Result)

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

3034import Data.Foldable (for_, sequenceA_,

3135 traverse_)

3236import Data.HashMap.Strict (HashMap)

3337import qualified Data.HashMap.Strict as HashMap

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

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

36−import Data.List (intercalate)

37−import Data.Monoid

3840import Data.Proxy

3941import Data.Scientific (Scientific, isInteger)

4042import Data.Text (Text)

4143import qualified Data.Text as Text

44+import qualified Data.Text.Lazy as TL

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

4246import Data.Vector (Vector)

4347import qualified Data.Vector as Vector

4448

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

5458--

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

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

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

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

5969

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

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

6272--

63−-- For validation without patterns see @'validateToJSON'@.

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

74+-- 'renderValidationErrors'.

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

6576validateToJSONWithPatternChecker checker = validateJSONWithPatternChecker checker defs sch . toJSON

6677 where

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

6879

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+

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

70157--

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

@@ -397,7 +484,7 @@ validateSchemaType value = withSchema $ \sch ->

397484 (Nothing, String s) -> sub_ paramSchema (validateString s)

398485 (Nothing, Array xs) -> sub_ paramSchema (validateArray xs)

399486 (Nothing, Object o) -> validateObject o

400− param@(t, _) -> invalid $ "expected JSON value of type " ++ showType param

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

401488

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

403490validateParamSchemaType value = withSchema $ \sch ->

@@ -412,8 +499,7 @@ validateParamSchemaType value = withSchema $ \sch ->

412499 (Nothing, Number n) -> validateNumber n

413500 (Nothing, String s) -> validateString s

414501 (Nothing, Array xs) -> validateArray xs

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

416− param@(t, _) -> invalid $ "expected JSON value of type " ++ showType param

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

417503

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

419505showType (Just type_, _) = show type_

src/Data/Swagger/Schema/Validation.hs+2

@@ -19,8 +19,10 @@ module Data.Swagger.Schema.Validation (

1919 ValidationError,

2020

2121 -- ** Using 'ToJSON' and 'ToSchema'

22+ validatePrettyToJSON,

2223 validateToJSON,

2324 validateToJSONWithPatternChecker,

25+ renderValidationErrors,

2426

2527 -- ** Using 'Value' and 'Schema'

2628 validateJSON,

swagger2.cabal+6−4

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

11cabal-version: >=1.10

22name: swagger2

33version: 2.4

4+x-revision: 1

56synopsis: Swagger 2.0 data model

67category: Web, Swagger

@@ -61,10 +62,11 @@ library

6162

6263 -- GHC boot libraries

6364 build-depends:

64− base >=4.7 && <4.13

65+ base >=4.7 && <4.14

66+ , aeson-pretty >=0.8.7 && <0.9

6567 , bytestring >=0.10.4.0 && <0.11

6668 , containers >=0.5.5.1 && <0.7

67− , template-haskell >=2.9.0.0 && <2.15

69+ , template-haskell >=2.9.0.0 && <2.16

6870 , time >=1.4.2 && <1.10

6971 , transformers >=0.3.0.0 && <0.6

7072

@@ -74,7 +76,7 @@ library

7476

7577 -- other dependencies

7678 build-depends:

77− base-compat-batteries >=0.10.4 && <0.11

79+ base-compat-batteries >=0.10.4 && <0.12

7880 , aeson >=1.4.2.0 && <1.5

7981 -- cookie 0.4.3 is needed by GHC 7.8 due to time>=1.4 constraint

8082 , cookie >=0.4.3 && <0.5

@@ -82,7 +84,7 @@ library

8284 , hashable >=1.2.7.0 && <1.4

8385 , http-media >=0.7.1.2 && <0.9

8486 , insert-ordered-containers >=0.2.2 && <0.3

85− , lens >=4.16.1 && <4.18

87+ , lens >=4.16.1 && <4.19

8688 , network >=2.6.3.5 && <3.2

8789 , scientific >=0.3.6.2 && <0.4

8890 , transformers-compat >=0.3 && <0.7

test/Data/Swagger/CommonTestTypes.hs−2

@@ -18,8 +18,6 @@ import qualified Data.Text as Text

1818import GHC.Generics

1919

2020import Data.Swagger

21−import Data.Swagger.Declare

22−import Data.Swagger.Internal (SwaggerKind (..))

2321

2422-- ========================================================================

2523-- Unit type

test/Data/Swagger/SchemaSpec.hs+1−8

@@ -1,25 +1,18 @@

11{-# LANGUAGE DeriveGeneric #-}

2−{-# LANGUAGE DataKinds #-}

32{-# LANGUAGE ScopedTypeVariables #-}

43{-# LANGUAGE TemplateHaskell #-}

54{-# LANGUAGE QuasiQuotes #-}

6−{-# LANGUAGE OverloadedStrings #-}

75module Data.Swagger.SchemaSpec where

97import Prelude ()

108import Prelude.Compat

119

1210import Control.Lens ((^.))

13−import Data.Aeson (Value, ToJSON(..), ToJSONKey(..), Value(Object), Value(String))

14−import Data.Aeson.Types (toJSONKeyText)

15−import Data.Aeson.QQ.Simple

16−import Data.Char

11+import Data.Aeson (Value)

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

1813import Data.Proxy

1914import Data.Set (Set)

20−import Data.Map (Map)

2115import qualified Data.Text as Text

22−import GHC.Generics

2316

2417import Data.Swagger

2518import Data.Swagger.Declare