master..00aae14 · typeable/openapi3

git.iko.soy/typeable/openapi3

on 00aae14 help sign in

.github/workflows/haskell-ci.yml+30−96

since splitsnapshots

unifiedsplit

@@ -8,117 +8,67 @@

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

10#

11−# version: 0.14.3

11+# version: 0.12

12#

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

13+# REGENDATA ("0.12",["github","cabal.project"])

14#

15name: Haskell-CI

16on:

17− push:

17+ - push

18− branches:

19− - master

20− pull_request:

18+ - pull_request

21− branches:

22− - master

23jobs:

19jobs:

24 linux:

20 linux:

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

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

26 runs-on: ubuntu-18.04

22 runs-on: ubuntu-18.04

27− timeout-minutes:

28− 60

29 container:

23 container:

30− image: buildpack-deps:focal

24+ image: buildpack-deps:bionic

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

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

32 strategy:

26 strategy:

33 matrix:

27 matrix:

34 include:

28 include:

35− - compiler: ghc-9.2.2

29+ - compiler: ghc-9.0.1

36− compilerKind: ghc

37− compilerVersion: 9.2.2

38− setup-method: ghcup

39 allow-failure: true

30 allow-failure: true

40− - compiler: ghc-9.0.2

31+ - compiler: ghc-8.10.4

41− compilerKind: ghc

42− compilerVersion: 9.0.2

43− setup-method: ghcup

44− allow-failure: false

45− - compiler: ghc-8.10.7

46− compilerKind: ghc

47− compilerVersion: 8.10.7

48− setup-method: ghcup

49 allow-failure: false

32 allow-failure: false

50 - compiler: ghc-8.8.4

33 - compiler: ghc-8.8.4

51− compilerKind: ghc

52− compilerVersion: 8.8.4

53− setup-method: hvr-ppa

54 allow-failure: false

34 allow-failure: false

55 - compiler: ghc-8.6.5

35 - compiler: ghc-8.6.5

56− compilerKind: ghc

57− compilerVersion: 8.6.5

58− setup-method: hvr-ppa

59 allow-failure: false

36 allow-failure: false

60 - compiler: ghc-8.4.4

37 - compiler: ghc-8.4.4

61− compilerKind: ghc

62− compilerVersion: 8.4.4

63− setup-method: hvr-ppa

64 allow-failure: false

38 allow-failure: false

65 fail-fast: false

39 fail-fast: false

66 steps:

40 steps:

67 - name: apt

41 - name: apt

68 run: |

42 run: |

69 apt-get update

43 apt-get update

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

44+ apt-get install -y --no-install-recommends gnupg ca-certificates dirmngr curl git software-properties-common

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

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

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

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

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

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

77− else

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

45+ apt-add-repository -y 'ppa:hvr/ghc'

79− apt-get update

46+ apt-get update

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

47+ apt-get install -y $CC cabal-install-3.4

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

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

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

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

85− fi

86 env:

48 env:

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

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

49+ CC: ${{ matrix.compiler }}

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

90 - name: Set PATH and environment variables

50 - name: Set PATH and environment variables

91 run: |

51 run: |

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

52 echo "$HOME/.cabal/bin" >> $GITHUB_PATH

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

53+ echo "LANG=C.UTF-8" >> $GITHUB_ENV

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

54+ echo "CABAL_DIR=$HOME/.cabal" >> $GITHUB_ENV

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

55+ echo "CABAL_CONFIG=$HOME/.cabal/config" >> $GITHUB_ENV

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

56+ HCDIR=$(echo "/opt/$CC" | sed 's/-/\//')

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

57+ HCNAME=ghc

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

58+ HC=$HCDIR/bin/$HCNAME

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

59+ echo "HC=$HC" >> $GITHUB_ENV

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

60+ echo "HCPKG=$HCDIR/bin/$HCNAME-pkg" >> $GITHUB_ENV

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

61+ echo "HADDOCK=$HCDIR/bin/haddock" >> $GITHUB_ENV

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

103− else

104− HC=$HCDIR/bin/$HCKIND

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

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

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

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

62+ echo "CABAL=/opt/cabal/3.4/bin/cabal -vnormal+nowrap" >> $GITHUB_ENV

109− fi

110−

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

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

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

64+ echo "HCNUMVER=$HCNUMVER" >> $GITHUB_ENV

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

65+ echo "ARG_TESTS=--enable-tests" >> $GITHUB_ENV

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

66+ echo "ARG_BENCH=--enable-benchmarks" >> $GITHUB_ENV

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

67+ echo "HEADHACKAGE=false" >> $GITHUB_ENV

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

68+ echo "ARG_COMPILER=--$HCNAME --with-compiler=$HC" >> $GITHUB_ENV

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

69+ echo "GHCJSARITH=0" >> $GITHUB_ENV

118 env:

70 env:

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

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

71+ CC: ${{ matrix.compiler }}

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

122 - name: env

72 - name: env

123 run: |

73 run: |

124 env

74 env

@@ -141,10 +91,6 @@ jobs:

141 repository hackage.haskell.org

91 repository hackage.haskell.org

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

92 url: http://hackage.haskell.org/

143 EOF

93 EOF

144− cat >> $CABAL_CONFIG <<EOF

145− program-default-options

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

147− EOF

148 cat $CABAL_CONFIG

94 cat $CABAL_CONFIG

149 - name: versions

95 - name: versions

150 run: |

96 run: |

@@ -183,8 +129,7 @@ jobs:

183 - name: generate cabal.project

129 - name: generate cabal.project

184 run: |

130 run: |

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

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

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

132+ echo "PKGDIR_openapi3=${PKGDIR_openapi3}" >> $GITHUB_ENV

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

188 touch cabal.project

133 touch cabal.project

189 touch cabal.project.local

134 touch cabal.project.local

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

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

@@ -230,14 +175,3 @@ jobs:

230 run: |

175 run: |

231 rm -f cabal.project.local

176 rm -f cabal.project.local

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

177 $CABAL v2-build $ARG_COMPILER --disable-tests --disable-benchmarks all

233− - name: prepare for constraint sets

234− run: |

235− rm -f cabal.project.local

236− - name: constraint set aeson-2

237− run: |

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

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

240− - name: constraint set aeson-1

241− run: |

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

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

CHANGELOG.md−18

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

1Unreleased

2----------

4−3.2.2

5−-----

6−

7−- Fix bug with infinite recursion in GToSchema [#37](https://github.com/biocad/openapi3/pull/37).

8−

9−3.2.1

10−-----

11−

12−- Support aeson-2.0.3.

13−- Support GHC-9.2 (doctests still fail).

14−

15−3.2.0

16−-----

17−

18−- Support aeson-2 [#34](https://github.com/biocad/openapi3/pull/34).

19−- Use `SecurityDefinitions` type for `_componentsSecuritySchemes`

20− [#32](https://github.com/biocad/openapi3/pull/32).

21−

223.1.0

43.1.0

23-----

5-----

cabal.haskell-cideleted−11

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

1−branches: master

2−

3−distribution: focal

4−allow-failures: >=9.2

5−

6−constraint-set aeson-1

7− constraints: aeson <2.0

8− ghc: <9.2

9−

10−constraint-set aeson-2

11− constraints: aeson >=2.0

openapi3.cabal+11−14

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

1cabal-version: >=1.10

2name: openapi3

3−version: 3.2.2

3+version: 3.1.0

5synopsis: OpenAPI 3.0 data model

6category: Web, Swagger, OpenApi

@@ -26,9 +26,8 @@ tested-with:

26 GHC ==8.4.4

27 || ==8.6.5

28 || ==8.8.4

29− || ==8.10.7

29+ || ==8.10.4

30− || ==9.0.2

30+ || ==9.0.1

31− || ==9.2.2

33custom-setup

32custom-setup

34 setup-depends:

33 setup-depends:

@@ -57,25 +56,23 @@ library

57 Data.OpenApi.Internal.AesonUtils

56 Data.OpenApi.Internal.AesonUtils

58 Data.OpenApi.Internal.TypeShape

57 Data.OpenApi.Internal.TypeShape

60− Data.OpenApi.Aeson.Compat

61−

62 -- GHC boot libraries

59 -- GHC boot libraries

63 build-depends:

60 build-depends:

64− base >=4.11.1.0 && <4.17

61+ base >=4.11.1.0 && <4.16

65− , bytestring >=0.10.8.2 && <0.12

62+ , bytestring >=0.10.8.2 && <0.11

66 , containers >=0.5.11.0 && <0.7

63 , containers >=0.5.11.0 && <0.7

67− , template-haskell >=2.13.0.0 && <2.19

64+ , template-haskell >=2.13.0.0 && <2.18

68− , time >=1.8.0.2 && <1.14

65+ , time >=1.8.0.2 && <1.10

69 , transformers >=0.5.5.0 && <0.6

66 , transformers >=0.5.5.0 && <0.6

71 build-depends:

68 build-depends:

72 mtl >=2.2.2 && <2.3

69 mtl >=2.2.2 && <2.3

73− , text >=1.2.3.1 && <2.1

70+ , text >=1.2.3.1 && <1.3

75 -- other dependencies

72 -- other dependencies

76 build-depends:

73 build-depends:

77− base-compat-batteries >=0.11.1 && <0.13

74+ base-compat-batteries >=0.11.1 && <0.12

78− , aeson >=1.4.2.0 && <1.6 || >=2.0.1.0 && < 2.1

75+ , aeson >=1.4.2.0 && <1.6

79 , aeson-pretty >=0.8.7 && <0.9

76 , aeson-pretty >=0.8.7 && <0.9

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

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

81 , cookie >=0.4.3 && <0.5

78 , cookie >=0.4.3 && <0.5

@@ -83,7 +80,7 @@ library

83 , hashable >=1.2.7.0 && <1.5

80 , hashable >=1.2.7.0 && <1.5

84 , http-media >=0.8.0.0 && <0.9

81 , http-media >=0.8.0.0 && <0.9

85 , insert-ordered-containers >=0.2.3 && <0.3

82 , insert-ordered-containers >=0.2.3 && <0.3

86− , lens >=4.16.1 && <5.2

83+ , lens >=4.16.1 && <5.1

87 , network >=2.6.3.5 && <3.2

84 , network >=2.6.3.5 && <3.2

88 , optics-core >=0.2 && <0.5

85 , optics-core >=0.2 && <0.5

89 , optics-th >=0.2 && <0.5

86 , optics-th >=0.2 && <0.5

src/Data/OpenApi/Aeson/Compat.hsdeleted−76

@@ -1,76 +0,0 @@

1−{-# LANGUAGE CPP #-}

2−

3−module Data.OpenApi.Aeson.Compat where

4−

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

6−import Data.Aeson (Key)

7−import qualified Data.Aeson.Key as Key

8−import qualified Data.Aeson.KeyMap as KeyMap

9−#else

10−import qualified Data.HashMap.Strict as HM

11−#endif

12−import Data.Bifunctor (first)

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

14−import qualified Data.Text as T

15−

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

17−deleteKey :: Key -> KeyMap.KeyMap v -> KeyMap.KeyMap v

18−deleteKey = KeyMap.delete

19−

20−objectToList :: KeyMap.KeyMap v -> [(Key, v)]

21−objectToList = KeyMap.toList

22−

23−objectKeys :: KeyMap.KeyMap v -> [T.Text]

24−objectKeys = map Key.toText . KeyMap.keys

25−

26−stringToKey :: String -> Key

27−stringToKey = Key.fromString

28−

29−keyToString :: Key -> String

30−keyToString = Key.toString

31−

32−keyToText :: Key -> T.Text

33−keyToText = Key.toText

34−

35−toInsOrdHashMap :: KeyMap.KeyMap v -> InsOrdHashMap.InsOrdHashMap T.Text v

36−toInsOrdHashMap = InsOrdHashMap.fromList . fmap (first Key.toText) . KeyMap.toList

37−

38−fromInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap T.Text v -> KeyMap.KeyMap v

39−fromInsOrdHashMap = KeyMap.fromList . fmap (first Key.fromText) . InsOrdHashMap.toList

40−

41−lookupKey :: T.Text -> KeyMap.KeyMap v -> Maybe v

42−lookupKey = KeyMap.lookup . Key.fromText

43−

44−hasKey :: T.Text -> KeyMap.KeyMap a -> Bool

45−hasKey = KeyMap.member . Key.fromText

46−#else

47−deleteKey :: T.Text -> HM.HashMap T.Text v -> HM.HashMap T.Text v

48−deleteKey = HM.delete

49−

50−objectToList :: HM.HashMap T.Text v -> [(T.Text, v)]

51−objectToList = HM.toList

52−

53−objectKeys :: HM.HashMap T.Text v -> [T.Text]

54−objectKeys = HM.keys

55−

56−stringToKey :: String -> T.Text

57−stringToKey = T.pack

58−

59−keyToString :: T.Text -> String

60−keyToString = T.unpack

61−

62−keyToText :: T.Text -> T.Text

63−keyToText = id

64−

65−toInsOrdHashMap :: HM.HashMap T.Text v -> InsOrdHashMap.InsOrdHashMap T.Text v

66−toInsOrdHashMap = InsOrdHashMap.fromHashMap

67−

68−fromInsOrdHashMap :: InsOrdHashMap.InsOrdHashMap T.Text v -> HM.HashMap T.Text v

69−fromInsOrdHashMap = InsOrdHashMap.toHashMap

70−

71−lookupKey :: T.Text -> HM.HashMap T.Text v -> Maybe v

72−lookupKey = HM.lookup

73−

74−hasKey :: T.Text -> HM.HashMap T.Text a -> Bool

75−hasKey = HM.member

76−#endif

src/Data/OpenApi/Internal.hs+14−14

@@ -1,4 +1,3 @@

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE DataKinds #-}

1{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE DeriveDataTypeable #-}

4{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE DeriveGeneric #-}

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

22import Control.Applicative

21import Control.Applicative

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

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

24import Data.Aeson hiding (Encoding)

23import Data.Aeson hiding (Encoding)

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

26−import qualified Data.Aeson.KeyMap as KeyMap

27−#endif

28import qualified Data.Aeson.Types as JSON

24import qualified Data.Aeson.Types as JSON

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

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

30 constrIndex, mkConstr, mkDataType)

26 constrIndex, mkConstr, mkDataType)

@@ -49,13 +45,17 @@ import Text.Read (readMaybe)

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

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

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

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

52−import Data.OpenApi.Aeson.Compat (deleteKey)

53−import Data.OpenApi.Internal.AesonUtils (AesonDefaultValue (..), HasSwaggerAesonOptions (..),

54− mkSwaggerAesonOptions, saoAdditionalPairs, saoSubObject,

55− sopSwaggerGenericParseJSON, sopSwaggerGenericToEncoding,

56− sopSwaggerGenericToJSON, sopSwaggerGenericToJSONWithOpts)

57−import Data.OpenApi.Internal.Utils

58import Generics.SOP.TH (deriveGeneric)

48import Generics.SOP.TH (deriveGeneric)

49+import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToEncoding

50+ ,sopSwaggerGenericToJSON

51+ ,sopSwaggerGenericToJSONWithOpts

52+ ,sopSwaggerGenericParseJSON

53+ ,HasSwaggerAesonOptions(..)

54+ ,AesonDefaultValue(..)

55+ ,mkSwaggerAesonOptions

56+ ,saoAdditionalPairs

57+ ,saoSubObject)

58+import Data.OpenApi.Internal.Utils

60-- $setup

61-- >>> :seti -XDataKinds

@@ -337,7 +337,7 @@ data RequestBody = RequestBody

337 -- | The content of the request body.

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

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

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

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

341 , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject

342

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

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

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

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

396 -- The value can be a specific media type (e.g. @application/json@),

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

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

398 _encodingContentType :: Maybe MediaType

399

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

@@ -734,7 +734,7 @@ data Response = Response

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

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

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

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

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

738 , _responseContent :: InsOrdHashMap MediaType MediaTypeObject

739

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

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

1492instance FromJSON Responses where

1493 parseJSON (Object o) = Responses

1494 <$> o .:? "default"

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

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

1496 parseJSON _ = empty

1497

1498instance FromJSON Example where

src/Data/OpenApi/Internal/AesonUtils.hs+10−11

@@ -36,19 +36,18 @@ import Data.Text (Text)

36import Generics.SOP

38import qualified Data.Text as T

39+import qualified Data.HashMap.Strict as HM

39import qualified Data.Set as Set

40import qualified Data.Set as Set

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

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

41import qualified Data.HashSet.InsOrd as InsOrdHS

42import qualified Data.HashSet.InsOrd as InsOrdHS

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

44−

45-------------------------------------------------------------------------------

44-------------------------------------------------------------------------------

46-- SwaggerAesonOptions

45-- SwaggerAesonOptions

47-------------------------------------------------------------------------------

46-------------------------------------------------------------------------------

49data SwaggerAesonOptions = SwaggerAesonOptions

48data SwaggerAesonOptions = SwaggerAesonOptions

50 { _saoPrefix :: String

49 { _saoPrefix :: String

51− , _saoAdditionalPairs :: [Pair]

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

52 , _saoSubObject :: Maybe String

51 , _saoSubObject :: Maybe String

53 }

52 }

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

155 go Nil Nil Nil = []

154 go Nil Nil Nil = []

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

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

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

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

158− Object m -> objectToList m ++ rest

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

159 Null -> rest

158 Null -> rest

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

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

161 -- If default value: omit it.

160 -- If default value: omit it.

162 | Just x == def =

161 | Just x == def =

163 rest

162 rest

164 | otherwise =

163 | otherwise =

165− (stringToKey name', json) : rest

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

166 where

165 where

167 json = toJSON x

166 json = toJSON x

168 name' = fieldNameModifier name

167 name' = fieldNameModifier name

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

196 proxy = Proxy :: Proxy a

195 proxy = Proxy :: Proxy a

197 opts = swaggerAesonOptions proxy

196 opts = swaggerAesonOptions proxy

198

197

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

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

200 parseAdditionalField obj (k, v) = do

199 parseAdditionalField obj (k, v) = do

201 v' <- obj .: k

200 v' <- obj .: k

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

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

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

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

204 ++ ": " ++ show v

203 ++ ": " ++ show v

205 ++ " /= " ++ show v'

204 ++ " /= " ++ show v'

206

205

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

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

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

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

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

233 | otherwise = case def of

232 | otherwise = case def of

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

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

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

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

236 where

235 where

237 cons h t = I h :* t

236 cons h t = I h :* t

238 name' = fieldNameModifier name

237 name' = fieldNameModifier name

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

295 go Nil Nil Nil = mempty

294 go Nil Nil Nil = mempty

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

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

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

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

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

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

299 Null -> rest

298 Null -> rest

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

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

301 -- If default value: omit it.

300 -- If default value: omit it.

302 | Just x == def =

301 | Just x == def =

303 rest

302 rest

304 | otherwise =

303 | otherwise =

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

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

306 where

305 where

307 name' = fieldNameModifier name

306 name' = fieldNameModifier name

308 rest = go xs names defs

307 rest = go xs names defs

src/Data/OpenApi/Internal/Schema.hs+17−21

@@ -64,14 +64,13 @@ import GHC.Generics

64import qualified Data.UUID.Types as UUID

65import Type.Reflection (Typeable, typeRep)

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

68−import Data.OpenApi.Declare

67+import Data.OpenApi.Declare

69−import Data.OpenApi.Internal

68+import Data.OpenApi.Internal

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

69+import Data.OpenApi.Internal.ParamSchema (ToParamSchema(..))

71−import Data.OpenApi.Internal.TypeShape

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

70+import Data.OpenApi.Lens hiding (name, schema)

73−import qualified Data.OpenApi.Lens as Swagger

71+import qualified Data.OpenApi.Lens as Swagger

74−import Data.OpenApi.SchemaOptions

72+import Data.OpenApi.SchemaOptions

73+import Data.OpenApi.Internal.TypeShape

76import qualified Data.ByteString as BS

75import qualified Data.ByteString as BS

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

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

@@ -406,8 +405,8 @@ sketchSchema = sketch . toJSON

406 _ -> Nothing

405 _ -> Nothing

407 go (Object o) = mempty

406 go (Object o) = mempty

408 & type_ ?~ OpenApiObject

407 & type_ ?~ OpenApiObject

409− & required .~ sort (objectKeys o)

408+ & required .~ sort (HashMap.keys o)

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

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

411

410

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

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

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

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

@@ -571,12 +570,12 @@ sketchStrictSchema = go . toJSON

571 go js@(Object o) = mempty

570 go js@(Object o) = mempty

572 & type_ ?~ OpenApiObject

571 & type_ ?~ OpenApiObject

573 & required .~ sort names

572 & required .~ sort names

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

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

575 & maxProperties ?~ fromIntegral (length names)

574 & maxProperties ?~ fromIntegral (length names)

576 & minProperties ?~ fromIntegral (length names)

575 & minProperties ?~ fromIntegral (length names)

577 & enum_ ?~ [js]

576 & enum_ ?~ [js]

578 where

577 where

579− names = objectKeys o

578+ names = HashMap.keys o

580

579

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

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

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

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

@@ -811,13 +810,13 @@ declareSchemaBoundedEnumKeyMapping :: forall map key value.

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

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

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

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

813declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of

812declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of

814− ToJSONKeyText getKey _ -> objectSchema getKey

813+ ToJSONKeyText keyToText _ -> objectSchema keyToText

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

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

816 where

815 where

817− objectSchema getKey = do

816+ objectSchema keyToText = do

818 valueRef <- declareSchemaRef (Proxy :: Proxy value)

817 valueRef <- declareSchemaRef (Proxy :: Proxy value)

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

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

820− mkPair k = (keyToText $ getKey k, valueRef)

819+ mkPair k = (keyToText k, valueRef)

821 return $ mempty

820 return $ mempty

822 & type_ ?~ OpenApiObject

821 & type_ ?~ OpenApiObject

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

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

@@ -945,13 +944,10 @@ instance (Selector s, GToSchema f, GToSchema (S1 s f)) => GToSchema (C1 c (S1 s

945 case schema ^. items of

944 case schema ^. items of

946 Just (OpenApiItemsArray [_]) -> fieldSchema

945 Just (OpenApiItemsArray [_]) -> fieldSchema

947 _ -> do

946 _ -> do

948− -- We have to run recordSchema instead of just using its defs,

947+ declare defs

949− -- since those can be recursive and will lead to infinite loop,

950− -- see https://github.com/biocad/openapi3/pull/37

951− NamedSchema _ schema' <- recordSchema

952− return (unnamed schema')

948+ return (unnamed schema)

953 where

949 where

954− (_, NamedSchema _ schema) = runDeclare recordSchema mempty

950+ (defs, NamedSchema _ schema) = runDeclare recordSchema mempty

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

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

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

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

957

953

src/Data/OpenApi/Internal/Schema/Validation.hs+11−23

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

1{-# OPTIONS_GHC -Wall #-}

2−{-# LANGUAGE CPP #-}

3{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DataKinds #-}

4{-# LANGUAGE DeriveFunctor #-}

3{-# LANGUAGE DeriveFunctor #-}

5{-# LANGUAGE FlexibleInstances #-}

4{-# LANGUAGE FlexibleInstances #-}

@@ -32,14 +31,10 @@ import Control.Lens hiding (allOf)

32import Control.Monad (forM, forM_, when)

31import Control.Monad (forM, forM_, when)

34import Data.Aeson hiding (Result)

33import Data.Aeson hiding (Result)

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

36−import qualified Data.Aeson.KeyMap as KeyMap

37−#endif

38import Data.Foldable (for_, sequenceA_,

34import Data.Foldable (for_, sequenceA_,

39 traverse_)

35 traverse_)

40−#if !MIN_VERSION_aeson(2,0,0)

41import Data.HashMap.Strict (HashMap)

36import Data.HashMap.Strict (HashMap)

42−#endif

37+import qualified Data.HashMap.Strict as HashMap

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

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

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

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

45import Data.Maybe (fromMaybe)

40import Data.Maybe (fromMaybe)

@@ -52,12 +47,11 @@ import qualified Data.Text.Lazy.Encoding as TL

52import Data.Vector (Vector)

47import Data.Vector (Vector)

53import qualified Data.Vector as Vector

48import qualified Data.Vector as Vector

55−import Data.OpenApi.Aeson.Compat (hasKey, keyToText, lookupKey, objectToList)

56−import Data.OpenApi.Declare

50+import Data.OpenApi.Declare

51+import Data.OpenApi.Internal

57−import Data.OpenApi.Internal

52+import Data.OpenApi.Internal.Utils

58−import Data.OpenApi.Internal.Schema

53+import Data.OpenApi.Internal.Schema

59−import Data.OpenApi.Internal.Utils

60−import Data.OpenApi.Lens

54+import Data.OpenApi.Lens

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

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

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

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

@@ -372,16 +366,10 @@ validateArray xs = do

372 len = Vector.length xs

366 len = Vector.length xs

373 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))

367 allUnique = len == HashSet.size (HashSet.fromList (Vector.toList xs))

374

368

375−validateObject ::

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

377− KeyMap.KeyMap Value

378−#else

379− HashMap Text Value

369+validateObject :: HashMap Text Value -> Validation Schema ()

380−#endif

381− -> Validation Schema ()

382validateObject o = withSchema $ \sch ->

370validateObject o = withSchema $ \sch ->

383 case sch ^. discriminator of

371 case sch ^. discriminator of

384− Just (Discriminator pname types) -> case fromJSON <$> lookupKey pname o of

372+ Just (Discriminator pname types) -> case fromJSON <$> HashMap.lookup pname o of

385 Just (Success pvalue) ->

373 Just (Success pvalue) ->

386 let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types

374 let ref = fromMaybe pvalue $ InsOrdHashMap.lookup pvalue types

387 -- TODO ref may be name or reference

375 -- TODO ref may be name or reference

@@ -400,15 +388,15 @@ validateObject o = withSchema $ \sch ->

400 validateRequired

388 validateRequired

401 validateProps

389 validateProps

402 where

390 where

403− size = fromIntegral (length o)

391+ size = fromIntegral (HashMap.size o)

404

392

405 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)

393 validateRequired = withSchema $ \sch -> traverse_ validateReq (sch ^. required)

406 validateReq n =

394 validateReq n =

407− when (not (hasKey n o)) $

395+ when (not (HashMap.member n o)) $

408 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))

396 invalid ("property " ++ show n ++ " is required, but not found in " ++ show (encode o))

409

397

410 validateProps = withSchema $ \sch -> do

398 validateProps = withSchema $ \sch -> do

411− for_ (objectToList o) $ \(keyToText -> k, v) ->

399+ for_ (HashMap.toList o) $ \(k, v) ->

412 case v of

400 case v of

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

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

414 _ ->

402 _ ->

src/Data/OpenApi/Schema/Generator.hs+1−3

@@ -25,8 +25,6 @@ import Test.QuickCheck (arbitrary)

25import Test.QuickCheck.Gen

26import Test.QuickCheck.Property

28−import Data.OpenApi.Aeson.Compat (fromInsOrdHashMap)

29−

30-- | Note: 'schemaGen' may 'error', if schema type is not specified,

28-- | Note: 'schemaGen' may 'error', if schema type is not specified,

31-- and cannot be inferred.

29-- and cannot be inferred.

32schemaGen :: Definitions Schema -> Schema -> Gen Value

30schemaGen :: Definitions Schema -> Schema -> Gen Value

@@ -97,7 +95,7 @@ schemaGen defns schema =

97 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)

95 return . M.fromList $ zip additionalKeys (repeat . schemaGen defns $ dereference defns addlSchema)

98 _ -> return []

96 _ -> return []

99 x <- sequence $ gens <> additionalGens

97 x <- sequence $ gens <> additionalGens

100− return . Object $ fromInsOrdHashMap x

98+ return . Object $ M.toHashMap x

101

102dereference :: Definitions a -> Referenced a -> a

100dereference :: Definitions a -> Referenced a -> a

103dereference _ (Inline a) = a

101dereference _ (Inline a) = a

stack.yaml+1−1

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

1−resolver: lts-16.31

1+resolver: lts-16.8

2packages:

3- '.'

4extra-deps:

test/Data/OpenApi/CommonTestTypes.hs−123

@@ -863,129 +863,6 @@ singleMaybeFieldSchemaJSON = [aesonQQ|

863}

864|]

865

866−-- ========================================================================

867−-- Natural Language (single field data with recursive fields)

868−-- ========================================================================

869−

870−data Predicate

871− = PredicateNoun Noun

872− | PredicateOmitted Omitted

873− deriving (Eq, Ord, Read, Show, Generic)

874−instance ToJSON Predicate

875−instance ToSchema Predicate

876−

877−data Noun

878− = Noun

879− { nounSurf :: LangWord

880− , nounModify :: [Modifier]

881− }

882− deriving (Eq, Ord, Read, Show, Generic)

883−instance ToJSON Noun

884−instance ToSchema Noun

885−

886−data LangWord

887− = LangWord

888− { langWordSurf :: String

889− , langWordBase :: String

890− }

891− deriving (Eq, Ord, Read, Show, Generic)

892−instance ToJSON LangWord

893−instance ToSchema LangWord

894−

895−data Modifier

896− = ModifierNoun Noun

897− | ModifierOmitted Omitted

898− deriving (Eq, Ord, Read, Show, Generic)

899−instance ToJSON Modifier

900−instance ToSchema Modifier

901−

902−newtype Omitted

903− = Omitted

904− { omittedModify :: [Modifier]

905− }

906− deriving (Eq, Ord, Read, Show, Generic)

907−instance ToJSON Omitted

908−instance ToSchema Omitted

909−

910−predicateSchemaDeclareJSON :: Value

911−predicateSchemaDeclareJSON = [aesonQQ|

912−[

913− {

914− "Predicate": {

915− "oneOf": [

916− {

917− "properties": {

918− "contents": { "$ref": "#/components/schemas/Noun" },

919− "tag": { "enum": ["PredicateNoun"], "type": "string" }

920− },

921− "required": ["tag", "contents"],

922− "type": "object"

923− },

924− {

925− "properties": {

926− "contents": { "$ref": "#/components/schemas/Omitted" },

927− "tag": { "enum": ["PredicateOmitted"], "type": "string" }

928− },

929− "required": ["tag", "contents"],

930− "type": "object"

931− }

932− ],

933− "type": "object"

934− },

935− "Noun": {

936− "properties": {

937− "nounModify": {

938− "items": { "$ref": "#/components/schemas/Modifier" },

939− "type": "array"

940− },

941− "nounSurf": { "$ref": "#/components/schemas/LangWord" }

942− },

943− "required": ["nounSurf", "nounModify"],

944− "type": "object"

945− },

946− "LangWord": {

947− "properties": {

948− "langWordBase": { "type": "string" },

949− "langWordSurf": { "type": "string" }

950− },

951− "required": ["langWordSurf", "langWordBase"],

952− "type": "object"

953− },

954− "Modifier": {

955− "oneOf": [

956− {

957− "properties": {

958− "contents": { "$ref": "#/components/schemas/Noun" },

959− "tag": { "enum": ["ModifierNoun"], "type": "string" }

960− },

961− "required": ["tag", "contents"],

962− "type": "object"

963− },

964− {

965− "properties": {

966− "contents": { "$ref": "#/components/schemas/Omitted" },

967− "tag": { "enum": ["ModifierOmitted"], "type": "string" }

968− },

969− "required": ["tag", "contents"],

970− "type": "object"

971− }

972− ],

973− "type": "object"

974− },

975− "Omitted": {

976− "properties": {

977− "omittedModify": {

978− "items": { "$ref": "#/components/schemas/Modifier" },

979− "type": "array"

980− }

981− },

982− "required": ["omittedModify"],

983− "type": "object"

984− }

985− },

986− { "$ref": "#/components/schemas/Predicate" }

987−]

988−|]

989

866

990-- ========================================================================

867-- ========================================================================

991-- TimeOfDay

868-- TimeOfDay

test/Data/OpenApi/Schema/ValidationSpec.hs+3−20

@@ -1,4 +1,3 @@

1−{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveGeneric #-}

1{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE PackageImports #-}

2{-# LANGUAGE PackageImports #-}

4{-# LANGUAGE RecordWildCards #-}

3{-# LANGUAGE RecordWildCards #-}

@@ -9,10 +8,6 @@ module Data.OpenApi.Schema.ValidationSpec where

9import Control.Applicative

8import Control.Applicative

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

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

11import Data.Aeson

10import Data.Aeson

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

13−import qualified Data.Aeson.Key as Key

14−import qualified Data.Aeson.KeyMap as KeyMap

15−#endif

16import Data.Aeson.Types

11import Data.Aeson.Types

17import Data.Hashable (Hashable)

12import Data.Hashable (Hashable)

18import Data.HashMap.Strict (HashMap)

13import Data.HashMap.Strict (HashMap)

@@ -35,7 +30,6 @@ import GHC.Generics

36import Data.OpenApi

31import Data.OpenApi

37import Data.OpenApi.Declare

32import Data.OpenApi.Declare

38−import Data.OpenApi.Aeson.Compat (stringToKey)

40import Test.Hspec

34import Test.Hspec

41import Test.Hspec.QuickCheck

35import Test.Hspec.QuickCheck

@@ -130,9 +124,9 @@ instance Arbitrary Person where

130

124

131invalidPersonToJSON :: Person -> Value

125invalidPersonToJSON :: Person -> Value

132invalidPersonToJSON Person{..} = object

126invalidPersonToJSON Person{..} = object

133− [ stringToKey "personName" .= toJSON name

127+ [ T.pack "personName" .= toJSON name

134− , stringToKey "personPhone" .= toJSON phone

128+ , T.pack "personPhone" .= toJSON phone

135− , stringToKey "personEmail" .= toJSON email

129+ , T.pack "personEmail" .= toJSON email

136 ]

130 ]

137

131

138-- ========================================================================

132-- ========================================================================

@@ -301,8 +295,6 @@ instance Eq ZonedTime where

301-- Arbitrary instance for Data.Aeson.Value

295-- Arbitrary instance for Data.Aeson.Value

302-- ========================================================================

296-- ========================================================================

303

297

304−-- These instances were introduces in aeson upstream in 2.0.3

305−#if !MIN_VERSION_aeson(2,0,3)

306instance Arbitrary Value where

298instance Arbitrary Value where

307 -- Weights are almost random

299 -- Weights are almost random

308 -- Uniform oneof tends not to build complex objects cause of recursive call.

300 -- Uniform oneof tends not to build complex objects cause of recursive call.

@@ -313,12 +305,3 @@ instance Arbitrary Value where

313 , (3, Number <$> arbitrary)

305 , (3, Number <$> arbitrary)

314 , (3, Bool <$> arbitrary)

306 , (3, Bool <$> arbitrary)

315 , (1, return Null) ]

307 , (1, return Null) ]

316−

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

318−instance Arbitrary v => Arbitrary (KeyMap.KeyMap v) where

319− arbitrary = KeyMap.fromList <$> arbitrary

320−

321−instance Arbitrary Key.Key where

322− arbitrary = Key.fromText <$> arbitrary

323−#endif

324−#endif

test/Data/OpenApi/SchemaSpec.hs−4

@@ -59,9 +59,6 @@ checkInlinedRecSchema proxy js = inlineNonRecursiveSchemas defs s <=> js

59 where

60 (defs, s) = runDeclare (declareSchema proxy) mempty

62−checkToSchemaDeclare :: (HasCallStack, ToSchema a) => Proxy a -> Value -> Spec

63−checkToSchemaDeclare proxy js = runDeclare (declareSchemaRef proxy) mempty <=> js

64−

65spec :: Spec

62spec :: Spec

66spec = do

63spec = do

67 describe "Generic ToSchema" $ do

64 describe "Generic ToSchema" $ do

@@ -81,7 +78,6 @@ spec = do

81 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON

78 context "UserId (non-record newtype)" $ checkToSchema (Proxy :: Proxy UserId) userIdSchemaJSON

82 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON

79 context "Player (unary record)" $ checkToSchema (Proxy :: Proxy Player) playerSchemaJSON

83 context "SingleMaybeField (unary record with Maybe)" $ checkToSchema (Proxy :: Proxy SingleMaybeField) singleMaybeFieldSchemaJSON

80 context "SingleMaybeField (unary record with Maybe)" $ checkToSchema (Proxy :: Proxy SingleMaybeField) singleMaybeFieldSchemaJSON

84− context "Natural Language (single field data with recursive fields)" $ checkToSchemaDeclare (Proxy :: Proxy Predicate) predicateSchemaDeclareJSON

85 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON

81 context "Players (inlining schema)" $ checkToSchema (Proxy :: Proxy Players) playersSchemaJSON

86 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON

82 context "MyRoseTree (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree) myRoseTreeSchemaJSON

87 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'

83 context "MyRoseTree' (datatypeNameModifier)" $ checkToSchema (Proxy :: Proxy MyRoseTree') myRoseTreeSchemaJSON'

test/Data/OpenApiSpec.hs+1−17

@@ -45,10 +45,6 @@ spec = do

45 fromJSON petstoreExampleJSON `shouldSatisfy` (\x -> case x of Success (_ :: OpenApi) -> True; _ -> False)

46 it "roundtrips: fmap toJSON . fromJSON" $ do

47 (toJSON :: OpenApi -> Value) <$> fromJSON petstoreExampleJSON `shouldBe` Success petstoreExampleJSON

48− context "Security schemes" $ do

49− it "merged correctly" $ do

50− let merged = oAuth2SecurityDefinitionsReadOpenApi <> oAuth2SecurityDefinitionsWriteOpenApi

51− merged `shouldBe` oAuth2SecurityDefinitionsOpenApi

53main :: IO ()

49main :: IO ()

54main = hspec spec

50main = hspec spec

@@ -445,7 +441,7 @@ responsesDefinitionExampleJSON = [aesonQQ|

445|]

441|]

446

442

447-- =======================================================================

443-- =======================================================================

448−-- Security Definition object

444+-- Responses Definition object

449-- =======================================================================

445-- =======================================================================

450

446

451securityDefinitionsExample :: SecurityDefinitions

447securityDefinitionsExample :: SecurityDefinitions

@@ -531,18 +527,6 @@ oAuth2SecurityDefinitionsExampleJSON = [aesonQQ|

531}

527}

532|]

528|]

533

529

534−oAuth2SecurityDefinitionsReadOpenApi :: OpenApi

535−oAuth2SecurityDefinitionsReadOpenApi =

536− mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsReadExample

537−

538−oAuth2SecurityDefinitionsWriteOpenApi :: OpenApi

539−oAuth2SecurityDefinitionsWriteOpenApi =

540− mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsWriteExample

541−

542−oAuth2SecurityDefinitionsOpenApi :: OpenApi

543−oAuth2SecurityDefinitionsOpenApi =

544− mempty & components . securitySchemes .~ oAuth2SecurityDefinitionsExample

545−

546-- =======================================================================

530-- =======================================================================

547-- Swagger object

531-- Swagger object

548-- =======================================================================

532-- =======================================================================

test/SpecCommon.hs+8

@@ -8,6 +8,14 @@ import qualified Data.Vector as Vector

9import Test.Hspec

11+isSubJSON :: Value -> Value -> Bool

12+isSubJSON Null _ = True

13+isSubJSON (Object x) (Object y) = HashMap.keys x == HashMap.keys i && F.and i

14+ where

15+ i = HashMap.intersectionWith isSubJSON x y

16+isSubJSON (Array xs) (Array ys) = Vector.length xs == Vector.length ys && F.and (Vector.zipWith isSubJSON xs ys)

17+isSubJSON x y = x == y

18+

11(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec

19(<=>) :: (Eq a, Show a, ToJSON a, FromJSON a, HasCallStack) => a -> Value -> Spec

12x <=> js = do

20x <=> js = do

13 it "encodes correctly" $ do

21 it "encodes correctly" $ do