master..a2e6895 · typeable/openapi3

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

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

88#

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

1010#

11−# version: 0.14.3

11+# version: 0.12

1212#

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

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

1414#

1515name: Haskell-CI

1616on:

17− push:

18− branches:

19− - master

20− pull_request:

21− branches:

22− - master

17+ - push

18+ - pull_request

2319jobs:

2420 linux:

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

2622 runs-on: ubuntu-18.04

27− timeout-minutes:

28− 60

2923 container:

30− image: buildpack-deps:focal

24+ image: buildpack-deps:bionic

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

3226 strategy:

3327 matrix:

3428 include:

35− - compiler: ghc-9.2.2

36− compilerKind: ghc

37− compilerVersion: 9.2.2

38− setup-method: ghcup

29+ - compiler: ghc-9.0.1

3930 allow-failure: true

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

31+ - compiler: ghc-8.10.4

4932 allow-failure: false

5033 - compiler: ghc-8.8.4

51− compilerKind: ghc

52− compilerVersion: 8.8.4

53− setup-method: hvr-ppa

5434 allow-failure: false

5535 - compiler: ghc-8.6.5

56− compilerKind: ghc

57− compilerVersion: 8.6.5

58− setup-method: hvr-ppa

5936 allow-failure: false

6037 - compiler: ghc-8.4.4

61− compilerKind: ghc

62− compilerVersion: 8.4.4

63− setup-method: hvr-ppa

6438 allow-failure: false

6539 fail-fast: false

6640 steps:

6741 - name: apt

6842 run: |

6943 apt-get update

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

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

79− apt-get update

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

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

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

46+ apt-get update

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

8648 env:

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

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

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

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

9050 - name: Set PATH and environment variables

9151 run: |

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

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

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

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

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

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

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

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

100− echo "HCPKG=$HOME/.ghcup/bin/$HCKIND-pkg-$HCVER" >> "$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"

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

109− fi

110−

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

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

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

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

57+ HCNAME=ghc

58+ HC=$HCDIR/bin/$HCNAME

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

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

11870 env:

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

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

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

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

12272 - name: env

12373 run: |

12474 env

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

14191 repository hackage.haskell.org

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

14393 EOF

144− cat >> $CABAL_CONFIG <<EOF

145− program-default-options

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

147− EOF

14894 cat $CABAL_CONFIG

14995 - name: versions

15096 run: |

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

183129 - name: generate cabal.project

184130 run: |

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

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

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

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

188133 touch cabal.project

189134 touch cabal.project.local

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

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

230175 run: |

231176 rm -f cabal.project.local

232177 $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+1−16

@@ -1,23 +1,8 @@

11Unreleased

22----------

33

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

194- Use `SecurityDefinitions` type for `_componentsSecuritySchemes`

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

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

216

2273.1.0

238-----

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

11cabal-version: >=1.10

22name: openapi3

3−version: 3.2.2

3+version: 3.1.0

44

55synopsis: OpenAPI 3.0 data model

66category: Web, Swagger, OpenApi

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

2626 GHC ==8.4.4

2727 || ==8.6.5

2828 || ==8.8.4

29− || ==8.10.7

30− || ==9.0.2

31− || ==9.2.2

29+ || ==8.10.4

30+ || ==9.0.1

3231

3332custom-setup

3433 setup-depends:

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

5756 Data.OpenApi.Internal.AesonUtils

5857 Data.OpenApi.Internal.TypeShape

5958

60− Data.OpenApi.Aeson.Compat

61−

6259 -- GHC boot libraries

6360 build-depends:

64− base >=4.11.1.0 && <4.17

65− , bytestring >=0.10.8.2 && <0.12

61+ base >=4.11.1.0 && <4.16

62+ , bytestring >=0.10.8.2 && <0.11

6663 , containers >=0.5.11.0 && <0.7

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

68− , time >=1.8.0.2 && <1.14

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

65+ , time >=1.8.0.2 && <1.10

6966 , transformers >=0.5.5.0 && <0.6

7067

7168 build-depends:

7269 mtl >=2.2.2 && <2.3

73− , text >=1.2.3.1 && <2.1

70+ , text >=1.2.3.1 && <1.3

7471

7572 -- other dependencies

7673 build-depends:

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

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

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

75+ , aeson >=1.4.2.0 && <1.6

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

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

8178 , cookie >=0.4.3 && <0.5

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

8380 , hashable >=1.2.7.0 && <1.5

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

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

86− , lens >=4.16.1 && <5.2

83+ , lens >=4.16.1 && <5.1

8784 , network >=2.6.3.5 && <3.2

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

8986 , 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 #-}

21{-# LANGUAGE DataKinds #-}

32{-# LANGUAGE DeriveDataTypeable #-}

43{-# LANGUAGE DeriveGeneric #-}

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

2221import Control.Applicative

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

2423import Data.Aeson hiding (Encoding)

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

26−import qualified Data.Aeson.KeyMap as KeyMap

27−#endif

2824import qualified Data.Aeson.Types as JSON

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

3026 constrIndex, mkConstr, mkDataType)

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

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

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

5147

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

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

5959

6060-- $setup

6161-- >>> :seti -XDataKinds

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

337337 -- | The content of the request body.

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

339339 -- 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/*@

341341 , _requestBodyContent :: InsOrdHashMap MediaType MediaTypeObject

342342

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

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

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

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

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

398398 _encodingContentType :: Maybe MediaType

399399

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

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

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

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

736736 -- 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/*@.

738738 , _responseContent :: InsOrdHashMap MediaType MediaTypeObject

739739

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

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

14921492instance FromJSON Responses where

14931493 parseJSON (Object o) = Responses

14941494 <$> o .:? "default"

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

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

14961496 parseJSON _ = empty

14971497

14981498instance FromJSON Example where

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

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

3636import Generics.SOP

3737

3838import qualified Data.Text as T

39+import qualified Data.HashMap.Strict as HM

3940import qualified Data.Set as Set

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

4142import qualified Data.HashSet.InsOrd as InsOrdHS

4243

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

44−

4544-------------------------------------------------------------------------------

4645-- SwaggerAesonOptions

4746-------------------------------------------------------------------------------

4847

4948data SwaggerAesonOptions = SwaggerAesonOptions

5049 { _saoPrefix :: String

51− , _saoAdditionalPairs :: [Pair]

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

5251 , _saoSubObject :: Maybe String

5352 }

5453

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

155154 go Nil Nil Nil = []

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

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

158− Object m -> objectToList m ++ rest

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

159158 Null -> rest

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

161160 -- If default value: omit it.

162161 | Just x == def =

163162 rest

164163 | otherwise =

165− (stringToKey name', json) : rest

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

166165 where

167166 json = toJSON x

168167 name' = fieldNameModifier name

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

196195 proxy = Proxy :: Proxy a

197196 opts = swaggerAesonOptions proxy

198197

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

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

200199 parseAdditionalField obj (k, v) = do

201200 v' <- obj .: k

202201 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

204203 ++ ": " ++ show v

205204 ++ " /= " ++ show v'

206205

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

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

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

233232 | otherwise = case def of

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

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

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

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

236235 where

237236 cons h t = I h :* t

238237 name' = fieldNameModifier name

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

295294 go Nil Nil Nil = mempty

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

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

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

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

299298 Null -> rest

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

301300 -- If default value: omit it.

302301 | Just x == def =

303302 rest

304303 | otherwise =

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

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

306305 where

307306 name' = fieldNameModifier name

308307 rest = go xs names defs

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

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

6464import qualified Data.UUID.Types as UUID

6565import Type.Reflection (Typeable, typeRep)

6666

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

68−import Data.OpenApi.Declare

69−import Data.OpenApi.Internal

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

71−import Data.OpenApi.Internal.TypeShape

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

73−import qualified Data.OpenApi.Lens as Swagger

74−import Data.OpenApi.SchemaOptions

67+import Data.OpenApi.Declare

68+import Data.OpenApi.Internal

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

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

71+import qualified Data.OpenApi.Lens as Swagger

72+import Data.OpenApi.SchemaOptions

73+import Data.OpenApi.Internal.TypeShape

7574

7675import qualified Data.ByteString as BS

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

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

406405 _ -> Nothing

407406 go (Object o) = mempty

408407 & type_ ?~ OpenApiObject

409− & required .~ sort (objectKeys o)

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

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

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

411410

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

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

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

571570 go js@(Object o) = mempty

572571 & type_ ?~ OpenApiObject

573572 & required .~ sort names

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

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

575574 & maxProperties ?~ fromIntegral (length names)

576575 & minProperties ?~ fromIntegral (length names)

577576 & enum_ ?~ [js]

578577 where

579− names = objectKeys o

578+ names = HashMap.keys o

580579

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

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

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

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

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

813812declareSchemaBoundedEnumKeyMapping _ = case toJSONKey :: ToJSONKeyFunction key of

814− ToJSONKeyText getKey _ -> objectSchema getKey

813+ ToJSONKeyText keyToText _ -> objectSchema keyToText

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

816815 where

817− objectSchema getKey = do

816+ objectSchema keyToText = do

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

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

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

819+ mkPair k = (keyToText k, valueRef)

821820 return $ mempty

822821 & type_ ?~ OpenApiObject

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

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

945944 case schema ^. items of

946945 Just (OpenApiItemsArray [_]) -> fieldSchema

947946 _ -> do

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

952− return (unnamed schema')

947+ declare defs

948+ return (unnamed schema)

953949 where

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

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

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

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

957953

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

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

11{-# OPTIONS_GHC -Wall #-}

2−{-# LANGUAGE CPP #-}

32{-# LANGUAGE DataKinds #-}

43{-# LANGUAGE DeriveFunctor #-}

54{-# LANGUAGE FlexibleInstances #-}

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

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

3332

3433import Data.Aeson hiding (Result)

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

36−import qualified Data.Aeson.KeyMap as KeyMap

37−#endif

3834import Data.Foldable (for_, sequenceA_,

3935 traverse_)

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

4136import Data.HashMap.Strict (HashMap)

42−#endif

37+import qualified Data.HashMap.Strict as HashMap

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

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

4540import Data.Maybe (fromMaybe)

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

5247import Data.Vector (Vector)

5348import qualified Data.Vector as Vector

5449

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

56−import Data.OpenApi.Declare

57−import Data.OpenApi.Internal

58−import Data.OpenApi.Internal.Schema

59−import Data.OpenApi.Internal.Utils

60−import Data.OpenApi.Lens

50+import Data.OpenApi.Declare

51+import Data.OpenApi.Internal

52+import Data.OpenApi.Internal.Utils

53+import Data.OpenApi.Internal.Schema

54+import Data.OpenApi.Lens

6155

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

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

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

372366 len = Vector.length xs

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

374368

375−validateObject ::

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

377− KeyMap.KeyMap Value

378−#else

379− HashMap Text Value

380−#endif

381− -> Validation Schema ()

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

382370validateObject o = withSchema $ \sch ->

383371 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

385373 Just (Success pvalue) ->

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

387375 -- TODO ref may be name or reference

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

400388 validateRequired

401389 validateProps

402390 where

403− size = fromIntegral (length o)

391+ size = fromIntegral (HashMap.size o)

404392

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

406394 validateReq n =

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

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

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

409397

410398 validateProps = withSchema $ \sch -> do

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

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

412400 case v of

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

414402 _ ->

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

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

2525import Test.QuickCheck.Gen

2626import Test.QuickCheck.Property

2727

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

29−

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

3129-- and cannot be inferred.

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

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

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

9896 _ -> return []

9997 x <- sequence $ gens <> additionalGens

100− return . Object $ fromInsOrdHashMap x

98+ return . Object $ M.toHashMap x

10199

102100dereference :: Definitions a -> Referenced a -> a

103101dereference _ (Inline a) = a

stack.yaml+1−1

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

1−resolver: lts-16.31

1+resolver: lts-16.8

22packages:

33- '.'

44extra-deps:

test/Data/OpenApi/CommonTestTypes.hs−123

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

863863}

864864|]

865865

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−|]

989866

990867-- ========================================================================

991868-- TimeOfDay

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

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

1−{-# LANGUAGE CPP #-}

21{-# LANGUAGE DeriveGeneric #-}

32{-# LANGUAGE PackageImports #-}

43{-# LANGUAGE RecordWildCards #-}

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

98import Control.Applicative

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

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

1611import Data.Aeson.Types

1712import Data.Hashable (Hashable)

1813import Data.HashMap.Strict (HashMap)

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

3530

3631import Data.OpenApi

3732import Data.OpenApi.Declare

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

3933

4034import Test.Hspec

4135import Test.Hspec.QuickCheck

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

130124

131125invalidPersonToJSON :: Person -> Value

132126invalidPersonToJSON Person{..} = object

133− [ stringToKey "personName" .= toJSON name

134− , stringToKey "personPhone" .= toJSON phone

135− , stringToKey "personEmail" .= toJSON email

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

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

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

136130 ]

137131

138132-- ========================================================================

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

301295-- Arbitrary instance for Data.Aeson.Value

302296-- ========================================================================

303297

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

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

306298instance Arbitrary Value where

307299 -- Weights are almost random

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

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

313305 , (3, Number <$> arbitrary)

314306 , (3, Bool <$> arbitrary)

315307 , (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

5959 where

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

6161

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

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

64−

6562spec :: Spec

6663spec = do

6764 describe "Generic ToSchema" $ do

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

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

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

8380 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

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

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

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

test/SpecCommon.hs+8

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

88

99import Test.Hspec

1010

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+

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

1220x <=> js = do

1321 it "encodes correctly" $ do