e6597e6..master · typeable/openapi3

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

since splitsnapshots

unifiedsplit

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

8#

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

10#

11−# version: 0.12

11+# version: 0.14.3

12#

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

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

14#

15name: Haskell-CI

16on:

17− - push

17+ push:

18+ branches:

19+ - master

18− - pull_request

20+ pull_request:

21+ branches:

22+ - master

19jobs:

23jobs:

20 linux:

24 linux:

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

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

22 runs-on: ubuntu-18.04

26 runs-on: ubuntu-18.04

27+ timeout-minutes:

28+ 60

23 container:

29 container:

24− image: buildpack-deps:bionic

30+ image: buildpack-deps:focal

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

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

26 strategy:

32 strategy:

27 matrix:

33 matrix:

28 include:

34 include:

29− - compiler: ghc-9.0.1

35+ - compiler: ghc-9.2.2

36+ compilerKind: ghc

37+ compilerVersion: 9.2.2

38+ setup-method: ghcup

30 allow-failure: true

39 allow-failure: true

31− - compiler: ghc-8.10.4

40+ - compiler: ghc-9.0.2

41+ compilerKind: ghc

42+ compilerVersion: 9.0.2

43+ setup-method: ghcup

44+ allow-failure: false

45+ - compiler: ghc-8.10.7

46+ compilerKind: ghc

47+ compilerVersion: 8.10.7

48+ setup-method: ghcup

32 allow-failure: false

49 allow-failure: false

33 - compiler: ghc-8.8.4

50 - compiler: ghc-8.8.4

51+ compilerKind: ghc

52+ compilerVersion: 8.8.4

53+ setup-method: hvr-ppa

34 allow-failure: false

54 allow-failure: false

35 - compiler: ghc-8.6.5

55 - compiler: ghc-8.6.5

56+ compilerKind: ghc

57+ compilerVersion: 8.6.5

58+ setup-method: hvr-ppa

36 allow-failure: false

59 allow-failure: false

37 - compiler: ghc-8.4.4

60 - compiler: ghc-8.4.4

61+ compilerKind: ghc

62+ compilerVersion: 8.4.4

63+ setup-method: hvr-ppa

38 allow-failure: false

64 allow-failure: false

39 fail-fast: false

65 fail-fast: false

40 steps:

66 steps:

41 - name: apt

67 - name: apt

42 run: |

68 run: |

43 apt-get update

69 apt-get update

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

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

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

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

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

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

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

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

77+ else

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

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

46− apt-get update

79+ apt-get update

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

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

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

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

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

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

85+ fi

48 env:

86 env:

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

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

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

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

50 - name: Set PATH and environment variables

90 - name: Set PATH and environment variables

51 run: |

91 run: |

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

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

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

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

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

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

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

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

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

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

57− HCNAME=ghc

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

58− HC=$HCDIR/bin/$HCNAME

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

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

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

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

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

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

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

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

103+ else

104+ HC=$HCDIR/bin/$HCKIND

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

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

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

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

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

109+ fi

110+

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

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

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

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

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

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

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

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

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

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

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

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

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

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

70 env:

118 env:

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

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

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

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

72 - name: env

122 - name: env

73 run: |

123 run: |

74 env

124 env

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

91 repository hackage.haskell.org

141 repository hackage.haskell.org

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

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

93 EOF

143 EOF

144+ cat >> $CABAL_CONFIG <<EOF

145+ program-default-options

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

147+ EOF

94 cat $CABAL_CONFIG

148 cat $CABAL_CONFIG

95 - name: versions

149 - name: versions

96 run: |

150 run: |

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

129 - name: generate cabal.project

183 - name: generate cabal.project

130 run: |

184 run: |

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

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

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

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

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

133 touch cabal.project

188 touch cabal.project

134 touch cabal.project.local

189 touch cabal.project.local

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

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

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

175 run: |

230 run: |

176 rm -f cabal.project.local

231 rm -f cabal.project.local

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

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

233+ - name: prepare for constraint sets

234+ run: |

235+ rm -f cabal.project.local

236+ - name: constraint set aeson-2

237+ run: |

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

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

240+ - name: constraint set aeson-1

241+ run: |

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

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

CHANGELOG.md+26−1

@@ -1,7 +1,32 @@

1Unreleased

2----------

3

4+3.2.2

5+-----

6+

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

8+

9+3.2.1

10+-----

11+

12+- Support aeson-2.0.3.

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

14+

15+3.2.0

16+-----

17+

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

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

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

21+

22+3.1.0

23+-----

24+

25+- Use `format: date-time` for `ToParamSchema ZonedTime` instance (see

26+ [#20](https://github.com/biocad/openapi3/pull/20)).

27+- Support generating schema for any polymorphic types via `Typeable` (see

28+ [#19](https://github.com/biocad/openapi3/pull/19)).

4−- Allow `hashable-1.3.1`, prettify doctests.

29+- Allow `hashable-1.3.1`, prettify doctests (see [#18](https://github.com/biocad/openapi3/pull/18)).

5

30

63.0.2.0

313.0.2.0

7-------

32-------

cabal.haskell-cinew file+11

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

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+17−14

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

1cabal-version: >=1.10

2name: openapi3

3−version: 3.0.2.0

3+version: 3.2.2

4

5synopsis: OpenAPI 3.0 data model

6category: Web, Swagger, OpenApi

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

26 GHC ==8.4.4

27 || ==8.6.5

28 || ==8.8.4

29− || ==8.10.4

29+ || ==8.10.7

30− || ==9.0.1

30+ || ==9.0.2

31+ || ==9.2.2

31

32

32custom-setup

33custom-setup

33 setup-depends:

34 setup-depends:

@@ -56,31 +57,33 @@ library

56 Data.OpenApi.Internal.AesonUtils

57 Data.OpenApi.Internal.AesonUtils

57 Data.OpenApi.Internal.TypeShape

58 Data.OpenApi.Internal.TypeShape

58

59

60+ Data.OpenApi.Aeson.Compat

61+

59 -- GHC boot libraries

62 -- GHC boot libraries

60 build-depends:

63 build-depends:

61− base >=4.11.1.0 && <4.16

64+ base >=4.11.1.0 && <4.17

62− , bytestring >=0.10.8.2 && <0.11

65+ , bytestring >=0.10.8.2 && <0.12

63 , containers >=0.5.11.0 && <0.7

66 , containers >=0.5.11.0 && <0.7

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

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

65− , time >=1.8.0.2 && <1.10

68+ , time >=1.8.0.2 && <1.14

66 , transformers >=0.5.5.0 && <0.6

69 , transformers >=0.5.5.0 && <0.6

67

70

68 build-depends:

71 build-depends:

69 mtl >=2.2.2 && <2.3

72 mtl >=2.2.2 && <2.3

70− , text >=1.2.3.1 && <1.3

73+ , text >=1.2.3.1 && <2.1

71

74

72 -- other dependencies

75 -- other dependencies

73 build-depends:

76 build-depends:

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

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

75− , aeson >=1.4.2.0 && <1.6

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

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

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

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

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

78 , cookie >=0.4.3 && <0.5

81 , cookie >=0.4.3 && <0.5

79 , generics-sop >=0.5.1.0 && <0.6

82 , generics-sop >=0.5.1.0 && <0.6

80− , hashable >=1.2.7.0 && <1.4

83+ , hashable >=1.2.7.0 && <1.5

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

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

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

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

83− , lens >=4.16.1 && <5.1

86+ , lens >=4.16.1 && <5.2

84 , network >=2.6.3.5 && <3.2

87 , network >=2.6.3.5 && <3.2

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

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

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

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

@@ -119,14 +122,14 @@ test-suite spec

119

122

120 -- test-suite only dependencies

123 -- test-suite only dependencies

121 build-depends:

124 build-depends:

122− hspec >=2.5.5 && <2.8

125+ hspec >=2.5.5 && <2.10

123 , HUnit >=1.6.0.0 && <1.7

126 , HUnit >=1.6.0.0 && <1.7

124 , quickcheck-instances >=0.3.19 && <0.14

127 , quickcheck-instances >=0.3.19 && <0.14

125 , utf8-string >=1.0.1.1 && <1.1

128 , utf8-string >=1.0.1.1 && <1.1

126

129

127 -- https://github.com/haskell/cabal/issues/3708

130 -- https://github.com/haskell/cabal/issues/3708

128 build-tool-depends:

131 build-tool-depends:

129− hspec-discover:hspec-discover >=2.5.5 && <2.8

132+ hspec-discover:hspec-discover >=2.5.5 && <2.10

130

133

131 other-modules:

134 other-modules:

132 SpecCommon

135 SpecCommon

src/Data/OpenApi/Aeson/Compat.hsnew file+76

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

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+18−15

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

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DataKinds #-}

2{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE DeriveGeneric #-}

4{-# LANGUAGE DeriveGeneric #-}

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

21import Control.Applicative

22import Control.Applicative

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

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

23import Data.Aeson hiding (Encoding)

24import Data.Aeson hiding (Encoding)

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

26+import qualified Data.Aeson.KeyMap as KeyMap

27+#endif

24import qualified Data.Aeson.Types as JSON

28import qualified Data.Aeson.Types as JSON

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

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

26 constrIndex, mkConstr, mkDataType)

30 constrIndex, mkConstr, mkDataType)

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

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

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

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

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

47

51

48−import Generics.SOP.TH (deriveGeneric)

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

49−import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToJSON

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

50− ,sopSwaggerGenericToJSONWithOpts

51− ,sopSwaggerGenericParseJSON

52− ,HasSwaggerAesonOptions(..)

53− ,AesonDefaultValue(..)

54− ,mkSwaggerAesonOptions

54+ mkSwaggerAesonOptions, saoAdditionalPairs, saoSubObject,

55− ,saoAdditionalPairs

55+ sopSwaggerGenericParseJSON, sopSwaggerGenericToEncoding,

56− ,saoSubObject)

56+ sopSwaggerGenericToJSON, sopSwaggerGenericToJSONWithOpts)

57import Data.OpenApi.Internal.Utils

58−import Data.OpenApi.Internal.AesonUtils (sopSwaggerGenericToEncoding)

58+import Generics.SOP.TH (deriveGeneric)

59

60-- $setup

61-- >>> :seti -XDataKinds

@@ -196,7 +196,7 @@ data Components = Components

196 , _componentsExamples :: Definitions Example

197 , _componentsRequestBodies :: Definitions RequestBody

198 , _componentsHeaders :: Definitions Header

199− , _componentsSecuritySchemes :: Definitions SecurityScheme

199+ , _componentsSecuritySchemes :: SecurityDefinitions

200 , _componentsLinks :: Definitions Link

201 , _componentsCallbacks :: Definitions Callback

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

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

@@ -1125,6 +1125,7 @@ instance SwaggerMonoid Response

1125instance SwaggerMonoid ExternalDocs

1126instance SwaggerMonoid Operation

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

1128+instance SwaggerMonoid SecurityDefinitions

1128

1129

1129instance SwaggerMonoid MimeList

1130instance SwaggerMonoid MimeList

1130deriving instance SwaggerMonoid URL

1131deriving instance SwaggerMonoid URL

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

1491instance FromJSON Responses where

1492instance FromJSON Responses where

1492 parseJSON (Object o) = Responses

1493 parseJSON (Object o) = Responses

1493 <$> o .:? "default"

1494 <$> o .:? "default"

1494− <*> parseJSON (Object (HashMap.delete "default" o))

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

1495 parseJSON _ = empty

1496 parseJSON _ = empty

1496

1497

1497instance FromJSON Example where

1498instance FromJSON Example where

@@ -1614,3 +1615,5 @@ instance AesonDefaultValue MimeList where defaultValue = Just mempty

1614instance AesonDefaultValue Info

1615instance AesonDefaultValue Info

1615instance AesonDefaultValue ParamLocation

1616instance AesonDefaultValue ParamLocation

1616instance AesonDefaultValue Link

1617instance AesonDefaultValue Link

1618+instance AesonDefaultValue SecurityDefinitions where

1619+ defaultValue = Just mempty

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

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

36import Generics.SOP

37

38import qualified Data.Text as T

39−import qualified Data.HashMap.Strict as HM

40import qualified Data.Set as Set

39import qualified Data.Set as Set

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

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

42import qualified Data.HashSet.InsOrd as InsOrdHS

41import qualified Data.HashSet.InsOrd as InsOrdHS

43

42

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

44+

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

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

45-- SwaggerAesonOptions

46-- SwaggerAesonOptions

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

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

47

48

48data SwaggerAesonOptions = SwaggerAesonOptions

49data SwaggerAesonOptions = SwaggerAesonOptions

49 { _saoPrefix :: String

50 { _saoPrefix :: String

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

51+ , _saoAdditionalPairs :: [Pair]

51 , _saoSubObject :: Maybe String

52 , _saoSubObject :: Maybe String

52 }

53 }

53

54

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

154 go Nil Nil Nil = []

155 go Nil Nil Nil = []

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

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

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

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

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

158+ Object m -> objectToList m ++ rest

158 Null -> rest

159 Null -> rest

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

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

160 -- If default value: omit it.

161 -- If default value: omit it.

161 | Just x == def =

162 | Just x == def =

162 rest

163 rest

163 | otherwise =

164 | otherwise =

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

165+ (stringToKey name', json) : rest

165 where

166 where

166 json = toJSON x

167 json = toJSON x

167 name' = fieldNameModifier name

168 name' = fieldNameModifier name

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

195 proxy = Proxy :: Proxy a

196 proxy = Proxy :: Proxy a

196 opts = swaggerAesonOptions proxy

197 opts = swaggerAesonOptions proxy

197

198

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

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

199 parseAdditionalField obj (k, v) = do

200 parseAdditionalField obj (k, v) = do

200 v' <- obj .: k

201 v' <- obj .: k

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

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

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

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

203 ++ ": " ++ show v

204 ++ ": " ++ show v

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

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

205

206

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

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

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

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

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

232 | otherwise = case def of

233 | otherwise = case def of

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

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

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

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

235 where

236 where

236 cons h t = I h :* t

237 cons h t = I h :* t

237 name' = fieldNameModifier name

238 name' = fieldNameModifier name

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

294 go Nil Nil Nil = mempty

295 go Nil Nil Nil = mempty

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

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

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

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

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

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

298 Null -> rest

299 Null -> rest

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

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

300 -- If default value: omit it.

301 -- If default value: omit it.

301 | Just x == def =

302 | Just x == def =

302 rest

303 rest

303 | otherwise =

304 | otherwise =

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

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

305 where

306 where

306 name' = fieldNameModifier name

307 name' = fieldNameModifier name

307 rest = go xs names defs

308 rest = go xs names defs

src/Data/OpenApi/Internal/ParamSchema.hs+2−2

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

216

217-- |

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

219−-- Just "yyyy-mm-ddThh:MM:ss+hhMM"

219+-- Just "date-time"

220instance ToParamSchema ZonedTime where

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

221+ toParamSchema _ = timeParamSchema "date-time"

222

223-- |

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

src/Data/OpenApi/Internal/Schema.hs+22−18

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

64import qualified Data.UUID.Types as UUID

65import Type.Reflection (Typeable, typeRep)

66

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

67−import Data.OpenApi.Declare

68+import Data.OpenApi.Declare

68−import Data.OpenApi.Internal

69+import Data.OpenApi.Internal

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

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

71+import Data.OpenApi.Internal.TypeShape

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

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

71−import qualified Data.OpenApi.Lens as Swagger

73+import qualified Data.OpenApi.Lens as Swagger

72−import Data.OpenApi.SchemaOptions

74+import Data.OpenApi.SchemaOptions

73−import Data.OpenApi.Internal.TypeShape

74

75

75import qualified Data.ByteString as BS

76import qualified Data.ByteString as BS

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

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

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

405 _ -> Nothing

406 _ -> Nothing

406 go (Object o) = mempty

407 go (Object o) = mempty

407 & type_ ?~ OpenApiObject

408 & type_ ?~ OpenApiObject

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

409+ & required .~ sort (objectKeys o)

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

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

410

411

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

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

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

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

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

570 go js@(Object o) = mempty

571 go js@(Object o) = mempty

571 & type_ ?~ OpenApiObject

572 & type_ ?~ OpenApiObject

572 & required .~ sort names

573 & required .~ sort names

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

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

574 & maxProperties ?~ fromIntegral (length names)

575 & maxProperties ?~ fromIntegral (length names)

575 & minProperties ?~ fromIntegral (length names)

576 & minProperties ?~ fromIntegral (length names)

576 & enum_ ?~ [js]

577 & enum_ ?~ [js]

577 where

578 where

578− names = HashMap.keys o

579+ names = objectKeys o

579

580

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

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

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

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

@@ -657,7 +658,7 @@ instance ToSchema LocalTime where

657 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"

658 declareNamedSchema _ = pure $ named "LocalTime" $ timeSchema "yyyy-mm-ddThh:MM:ss"

658 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))

659 & example ?~ toJSON (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0))

659

660

660−-- | Format @"date"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.

661+-- | Format @"date-time"@ corresponds to @yyyy-mm-ddThh:MM:ss(Z|+hh:MM)@ format.

661instance ToSchema ZonedTime where

662instance ToSchema ZonedTime where

662 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"

663 declareNamedSchema _ = pure $ named "ZonedTime" $ timeSchema "date-time"

663 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))

664 & example ?~ toJSON (ZonedTime (LocalTime (fromGregorian 2016 7 22) (TimeOfDay 7 40 0)) (hoursToTimeZone 3))

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

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

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

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

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

812declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of

813declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of

813− ToJSONKeyText keyToText _ -> objectSchema keyToText

814+ ToJSONKeyText getKey _ -> objectSchema getKey

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

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

815 where

816 where

816− objectSchema keyToText = do

817+ objectSchema getKey = do

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

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

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

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

819− mkPair k = (keyToText k, valueRef)

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

820 return $ mempty

821 return $ mempty

821 & type_ ?~ OpenApiObject

822 & type_ ?~ OpenApiObject

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

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

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

944 case schema ^. items of

945 case schema ^. items of

945 Just (OpenApiItemsArray [_]) -> fieldSchema

946 Just (OpenApiItemsArray [_]) -> fieldSchema

946 _ -> do

947 _ -> do

947− declare defs

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

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

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

951+ NamedSchema _ schema' <- recordSchema

948− return (unnamed schema)

952+ return (unnamed schema')

949 where

953 where

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

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

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

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

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

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

953

957

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

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

1{-# OPTIONS_GHC -Wall #-}

2+{-# LANGUAGE CPP #-}

2{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DataKinds #-}

3{-# LANGUAGE DeriveFunctor #-}

4{-# LANGUAGE DeriveFunctor #-}

4{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE FlexibleInstances #-}

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

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

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

32

33

33import Data.Aeson hiding (Result)

34import Data.Aeson hiding (Result)

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

36+import qualified Data.Aeson.KeyMap as KeyMap

37+#endif

34import Data.Foldable (for_, sequenceA_,

38import Data.Foldable (for_, sequenceA_,

35 traverse_)

39 traverse_)

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

36import Data.HashMap.Strict (HashMap)

41import Data.HashMap.Strict (HashMap)

37−import qualified Data.HashMap.Strict as HashMap

42+#endif

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

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

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

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

40import Data.Maybe (fromMaybe)

45import Data.Maybe (fromMaybe)

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

47import Data.Vector (Vector)

52import Data.Vector (Vector)

48import qualified Data.Vector as Vector

53import qualified Data.Vector as Vector

49

54

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

50−import Data.OpenApi.Declare

56+import Data.OpenApi.Declare

57+import Data.OpenApi.Internal

51−import Data.OpenApi.Internal

58+import Data.OpenApi.Internal.Schema

52−import Data.OpenApi.Internal.Utils

59+import Data.OpenApi.Internal.Utils

53−import Data.OpenApi.Internal.Schema

54−import Data.OpenApi.Lens

60+import Data.OpenApi.Lens

55

61

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

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

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

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

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

366 len = Vector.length xs

372 len = Vector.length xs

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

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

368

374

375+validateObject ::

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

377+ KeyMap.KeyMap Value

378+#else

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

379+ HashMap Text Value

380+#endif

381+ -> Validation Schema ()

370validateObject o = withSchema $ \sch ->

382validateObject o = withSchema $ \sch ->

371 case sch ^. discriminator of

383 case sch ^. discriminator of

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

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

373 Just (Success pvalue) ->

385 Just (Success pvalue) ->

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

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

375 -- TODO ref may be name or reference

387 -- TODO ref may be name or reference

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

388 validateRequired

400 validateRequired

389 validateProps

401 validateProps

390 where

402 where

391− size = fromIntegral (HashMap.size o)

403+ size = fromIntegral (length o)

392

404

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

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

394 validateReq n =

406 validateReq n =

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

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

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

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

397

409

398 validateProps = withSchema $ \sch -> do

410 validateProps = withSchema $ \sch -> do

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

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

400 case v of

412 case v of

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

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

402 _ ->

414 _ ->

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

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

25import Test.QuickCheck.Gen

26import Test.QuickCheck.Property

27

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

29+

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

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

29-- and cannot be inferred.

31-- and cannot be inferred.

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

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

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

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

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

96 _ -> return []

98 _ -> return []

97 x <- sequence $ gens <> additionalGens

99 x <- sequence $ gens <> additionalGens

98− return . Object $ M.toHashMap x

100+ return . Object $ fromInsOrdHashMap x

99

101

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

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

101dereference _ (Inline a) = a

103dereference _ (Inline a) = a

stack.yaml+1−1

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

1−resolver: lts-16.8

1+resolver: lts-16.31

2packages:

3- '.'

4extra-deps:

test/Data/OpenApi/CommonTestTypes.hs+123

@@ -863,6 +863,129 @@ 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+|]

866

989

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

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

868-- TimeOfDay

991-- TimeOfDay

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

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

1+{-# LANGUAGE CPP #-}

1{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE PackageImports #-}

3{-# LANGUAGE PackageImports #-}

3{-# LANGUAGE RecordWildCards #-}

4{-# LANGUAGE RecordWildCards #-}

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

8import Control.Applicative

9import Control.Applicative

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

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

10import Data.Aeson

11import 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

11import Data.Aeson.Types

16import Data.Aeson.Types

12import Data.Hashable (Hashable)

17import Data.Hashable (Hashable)

13import Data.HashMap.Strict (HashMap)

18import Data.HashMap.Strict (HashMap)

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

30

35

31import Data.OpenApi

36import Data.OpenApi

32import Data.OpenApi.Declare

37import Data.OpenApi.Declare

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

33

39

34import Test.Hspec

40import Test.Hspec

35import Test.Hspec.QuickCheck

41import Test.Hspec.QuickCheck

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

124

130

125invalidPersonToJSON :: Person -> Value

131invalidPersonToJSON :: Person -> Value

126invalidPersonToJSON Person{..} = object

132invalidPersonToJSON Person{..} = object

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

133+ [ stringToKey "personName" .= toJSON name

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

134+ , stringToKey "personPhone" .= toJSON phone

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

135+ , stringToKey "personEmail" .= toJSON email

130 ]

136 ]

131

137

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

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

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

295-- Arbitrary instance for Data.Aeson.Value

301-- Arbitrary instance for Data.Aeson.Value

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

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

297

303

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

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

298instance Arbitrary Value where

306instance Arbitrary Value where

299 -- Weights are almost random

307 -- Weights are almost random

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

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

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

305 , (3, Number <$> arbitrary)

313 , (3, Number <$> arbitrary)

306 , (3, Bool <$> arbitrary)

314 , (3, Bool <$> arbitrary)

307 , (1, return Null) ]

315 , (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,6 +59,9 @@ checkInlinedRecSchema proxy js = inlineNonRecursiveSchemas defs s <=> js

59 where

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

61

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

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

64+

62spec :: Spec

65spec :: Spec

63spec = do

66spec = do

64 describe "Generic ToSchema" $ do

67 describe "Generic ToSchema" $ do

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

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

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

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

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

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

83 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

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

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

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

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

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

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

test/Data/OpenApiSpec.hs+17−1

@@ -45,6 +45,10 @@ 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

48

52

49main :: IO ()

53main :: IO ()

50main = hspec spec

54main = hspec spec

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

441|]

445|]

442

446

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

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

444−-- Responses Definition object

448+-- Security Definition object

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

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

446

450

447securityDefinitionsExample :: SecurityDefinitions

451securityDefinitionsExample :: SecurityDefinitions

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

527}

531}

528|]

532|]

529

533

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+

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

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

531-- Swagger object

547-- Swagger object

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

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

test/SpecCommon.hs−8

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

8

9import Test.Hspec

10

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−

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

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

20x <=> js = do

12x <=> js = do

21 it "encodes correctly" $ do

13 it "encodes correctly" $ do