a19cb84...master · typeable/servant

.github/workflows/master.yml+2−4

since splitsnapshots

unifiedsplit

@@ -19,6 +19,7 @@ jobs:

19 - "8.8.4"

20 - "8.10.7"

21 - "9.0.2"

22+ - "9.2.2"

22

23

23 steps:

24 steps:

24 - uses: actions/checkout@v2

25 - uses: actions/checkout@v2

@@ -58,9 +59,6 @@ jobs:

58 cabal test all

59 cabal test all

59

60

60 - name: Run doctests

61 - name: Run doctests

61− # doctests are broken on GHC 9 due to compiler bug:

62− # https://gitlab.haskell.org/ghc/ghc/-/issues/19460

63− continue-on-error: ${{ matrix.ghc == '9.0.1' }}

64 run: |

62 run: |

65 # Necessary for doctest to be found in $PATH

63 # Necessary for doctest to be found in $PATH

66 export PATH="$HOME/.cabal/bin:$PATH"

64 export PATH="$HOME/.cabal/bin:$PATH"

@@ -82,7 +80,7 @@ jobs:

82 runs-on: ubuntu-latest

80 runs-on: ubuntu-latest

83 strategy:

81 strategy:

84 matrix:

82 matrix:

85− stack: ["2.7.3"]

83+ stack: ["2.7.5"]

86 ghc: ["8.10.7"]

84 ghc: ["8.10.7"]

87

85

88 steps:

86 steps:

cabal.project−4

@@ -51,7 +51,3 @@ packages:

51tests: True

52optimization: False

53-- reorder-goals: True

54−

55−-- https://github.com/chordify/haskell-servant-pagination/pull/12

56−allow-newer: servant-pagination-2.2.2:servant

57−allow-newer: servant-pagination-2.2.2:servant-server

changelog.d/1569new file+13

@@ -0,0 +1,13 @@

1+synopsis: Encode captures using toEncodedUrlPiece

2+prs: #1569

3+issues: #1511

4+

5+description: {

6+The `servant-client` library now makes direct use of `toEncodedUrlPiece` from `ToHttpApiData`

7+to encode captured values when building the request path. It gives user freedom to implement

8+URL-encoding however they need.

9+

10+Previous behavior was to use `toUrlPiece` and URL-encode its output using `toEncodedUrlPiece`

11+from the `Text` instance of `ToHttpApiData`. The issue with this approach is that

12+`ToHttpApiData Text` is overly zealous and also encodes characters, such as `*`, which are perfectly valid in a URL.

13+}

changelog.d/1580new file+12

@@ -0,0 +1,12 @@

1+synopsis: Allow IO in validationKeys

2+prs: #1580

3+issues: #1579

4+

5+description: {

6+

7+Currently validationKeys are a fixed JWKSet. This does not work with OIDC

8+providers such as AWS Cognito or Okta, which regularly fetching jwks_uri to

9+discover new and expired keys.

10+

11+This change alters the type of validationKeys from JWKSet to IO JWKSet.

12+}

changelog.d/1589new file+2

@@ -0,0 +1,2 @@

1+synopsis: Only include question mark for nonempty query strings

2+prs: 1589

changelog.d/1595new file+2

@@ -0,0 +1,2 @@

1+synopsis: Run ClientEnv's makeClientRequest in IO.

2+prs: #1595

doc/cookbook/curl-mock/curl-mock.cabal+3

@@ -11,6 +11,9 @@ build-type: Simple

11tested-with: GHC==8.6.5, GHC==8.8.3, GHC ==8.10.7

12

13executable cookbock-curl-mock

14+ if impl(ghc >= 9.2)

15+ -- generic-arbitrary is incompatible

16+ buildable: False

14 main-is: CurlMock.lhs

17 main-is: CurlMock.lhs

15 build-depends: base == 4.*

18 build-depends: base == 4.*

16 , aeson

19 , aeson

doc/cookbook/using-free-client/UsingFreeClient.lhs+1−1

@@ -119,7 +119,7 @@ Now we can use `servant-client`'s internals to convert servant's `Request`

119to http-client's `Request`, and we can inspect it:

120

121```haskell

122− let req' = I.defaultMakeClientRequest burl req

122+ req' <- I.defaultMakeClientRequest burl req

123 putStrLn $ "Making request: " ++ show req'

124```

125

doc/tutorial/tutorial.cabal+1−1

@@ -64,7 +64,7 @@ library

64 , blaze-markup >= 0.8.0.0 && < 0.9

65 , cookie >= 0.4.3 && < 0.5

66 , js-jquery >= 3.3.1 && < 3.4

67− , lucid >= 2.9.11 && < 2.10

67+ , lucid >= 2.9.11 && < 2.12

68 , random >= 1.1 && < 1.3

69 , servant-js >= 0.9 && < 0.10

70 , time >= 1.6.0.1 && < 1.13

servant-auth/servant-auth-client/servant-auth-client.cabal+5−5

@@ -31,8 +31,8 @@ library

31 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

32 ghc-options: -Wall

33 build-depends:

34− base >= 4.10 && < 4.16

34+ base >= 4.10 && < 4.17

35− , bytestring >= 0.10.6.0 && < 0.11

35+ , bytestring >= 0.10.6.0 && < 0.12

36 , containers >= 0.5.6.2 && < 0.7

37 , servant-auth == 0.4.*

38 , servant >= 0.13 && < 0.20

@@ -50,7 +50,7 @@ test-suite spec

50 test

51 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

52 ghc-options: -Wall

53− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9

53+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10

54

55 -- dependencies with bounds inherited from the library stanza

56 build-depends:

@@ -62,10 +62,10 @@ test-suite spec

62

63 -- test dependencies

64 build-depends:

65− hspec >= 2.5.5 && < 2.9

65+ hspec >= 2.5.5 && < 2.10

66 , QuickCheck >= 2.11.3 && < 2.15

67 , aeson >= 1.3.1.1 && < 3

68− , bytestring >= 0.10.6.0 && < 0.11

68+ , bytestring >= 0.10.6.0 && < 0.12

69 , http-client >= 0.5.13.1 && < 0.8

70 , http-types >= 0.12.2 && < 0.13

71 , servant-auth-server >= 0.4.2.0 && < 0.5

servant-auth/servant-auth-docs/servant-auth-docs.cabal+3−3

@@ -35,7 +35,7 @@ library

35 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

36 ghc-options: -Wall

37 build-depends:

38− base >= 4.10 && < 4.16

38+ base >= 4.10 && < 4.17

39 , servant-docs >= 0.11.2 && < 0.13

40 , servant >= 0.13 && < 0.20

41 , servant-auth == 0.4.*

@@ -64,7 +64,7 @@ test-suite spec

64 test

65 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

66 ghc-options: -Wall

67− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.9

67+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10

68

69 -- dependencies with bounds inherited from the library stanza

70 build-depends:

@@ -78,7 +78,7 @@ test-suite spec

78 -- test dependencies

79 build-depends:

80 servant-auth-docs

81− , hspec >= 2.5.5 && < 2.9

81+ , hspec >= 2.5.5 && < 2.10

82 , QuickCheck >= 2.11.3 && < 2.15

83

84 default-language: Haskell2010

servant-auth/servant-auth-server/servant-auth-server.cabal+7−7

@@ -31,11 +31,11 @@ library

31 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

32 ghc-options: -Wall

33 build-depends:

34− base >= 4.10 && < 4.16

34+ base >= 4.10 && < 4.17

35 , aeson >= 1.0.0.1 && < 3

36 , base64-bytestring >= 1.0.0.1 && < 2

37 , blaze-builder >= 0.4.1.0 && < 0.5

38− , bytestring >= 0.10.6.0 && < 0.11

38+ , bytestring >= 0.10.6.0 && < 0.12

39 , case-insensitive >= 1.2.0.11 && < 1.3

40 , cookie >= 0.4.4 && < 0.5

41 , data-default-class >= 0.1.2.0 && < 0.2

@@ -43,7 +43,7 @@ library

43 , http-types >= 0.12.2 && < 0.13

44 , jose >= 0.7.0.0 && < 0.10

45 , lens >= 4.16.1 && < 5.2

46− , memory >= 0.14.16 && < 0.17

46+ , memory >= 0.14.16 && < 0.18

47 , monad-time >= 0.3.1.0 && < 0.4

48 , mtl >= 2.2.2 && < 2.3

49 , servant >= 0.13 && < 0.20

@@ -51,7 +51,7 @@ library

51 , servant-server >= 0.13 && < 0.20

52 , tagged >= 0.8.4 && < 0.9

53 , text >= 1.2.3.0 && < 2.1

54− , time >= 1.5.0.1 && < 1.10

54+ , time >= 1.5.0.1 && < 1.12

55 , unordered-containers >= 0.2.9.0 && < 0.3

56 , wai >= 3.2.1.2 && < 3.3

57

@@ -102,7 +102,7 @@ test-suite spec

102 test

103 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

104 ghc-options: -Wall

105− build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.8

105+ build-tool-depends: hspec-discover:hspec-discover >=2.5.5 && <2.10

106

107 -- dependencies with bounds inherited from the library stanza

108 build-depends:

@@ -123,10 +123,10 @@ test-suite spec

123 -- test dependencies

124 build-depends:

125 servant-auth-server

126− , hspec >= 2.5.5 && < 2.8

126+ , hspec >= 2.5.5 && < 2.10

127 , QuickCheck >= 2.11.3 && < 2.15

128 , http-client >= 0.5.13.1 && < 0.8

129− , lens-aeson >= 1.0.2 && < 1.2

129+ , lens-aeson >= 1.0.2 && < 1.3

130 , warp >= 3.2.25 && < 3.4

131 , wreq >= 0.5.2.1 && < 0.6

132 other-modules:

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/ConfigTypes.hs+2−2

@@ -33,7 +33,7 @@ data JWTSettings = JWTSettings

33 -- | Algorithm used to sign JWT.

34 , jwtAlg :: Maybe Jose.Alg

35 -- | Keys used to validate JWT.

36− , validationKeys :: Jose.JWKSet

36+ , validationKeys :: IO Jose.JWKSet

37 -- | An @aud@ predicate. The @aud@ is a string or URI that identifies the

38 -- intended recipient of the JWT.

39 , audienceMatches :: Jose.StringOrURI -> IsMatch

@@ -44,7 +44,7 @@ defaultJWTSettings :: Jose.JWK -> JWTSettings

44defaultJWTSettings k = JWTSettings

45 { signingKey = k

46 , jwtAlg = Nothing

47− , validationKeys = Jose.JWKSet [k]

47+ , validationKeys = pure $ Jose.JWKSet [k]

48 , audienceMatches = const Matches }

49

50-- | The policies to use when generating cookies.

servant-auth/servant-auth-server/src/Servant/Auth/Server/Internal/JWT.hs+4−3

@@ -58,14 +58,15 @@ makeJWT v cfg expiry = runExceptT $ do

58

59verifyJWT :: FromJWT a => JWTSettings -> BS.ByteString -> IO (Maybe a)

60verifyJWT jwtCfg input = do

61+ keys <- validationKeys jwtCfg

61− verifiedJWT <- liftIO $ runExceptT $ do

62+ verifiedJWT <- runExceptT $ do

62 unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)

63 unverifiedJWT <- Jose.decodeCompact (BSL.fromStrict input)

63 Jose.verifyClaims

64 Jose.verifyClaims

64 (jwtSettingsToJwtValidationSettings jwtCfg)

65 (jwtSettingsToJwtValidationSettings jwtCfg)

65− (validationKeys jwtCfg)

66+ keys

66 unverifiedJWT

67 unverifiedJWT

67 return $ case verifiedJWT of

68 return $ case verifiedJWT of

68 Left (_ :: Jose.JWTError) -> Nothing

69 Left (_ :: Jose.JWTError) -> Nothing

69 Right v -> case decodeJWT v of

70 Right v -> case decodeJWT v of

70 Left _ -> Nothing

71 Left _ -> Nothing

71− Right v' -> Just v'

72+ Right v' -> Just v'

servant-auth/servant-auth-swagger/servant-auth-swagger.cabal+3−7

@@ -31,15 +31,13 @@ library

31 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

32 ghc-options: -Wall

33 build-depends:

34− base >= 4.10 && < 4.16

34+ base >= 4.10 && < 4.17

35 , text >= 1.2.3.0 && < 2.1

36 , servant-swagger >= 1.1.5 && < 2

37 , swagger2 >= 2.2.2 && < 3

38 , servant >= 0.13 && < 0.20

39 , servant-auth == 0.4.*

40 , lens >= 4.16.1 && < 5.2

41− if impl(ghc >= 9)

42− buildable: False

43 exposed-modules:

41 exposed-modules:

44 Servant.Auth.Swagger

42 Servant.Auth.Swagger

45 default-language: Haskell2010

43 default-language: Haskell2010

@@ -51,7 +49,7 @@ test-suite spec

51 test

49 test

52 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

50 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

53 ghc-options: -Wall

51 ghc-options: -Wall

54− build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.9

52+ build-tool-depends: hspec-discover:hspec-discover >= 2.5.5 && <2.10

55 -- dependencies with bounds inherited from the library stanza

53 -- dependencies with bounds inherited from the library stanza

56 build-depends:

54 build-depends:

57 base

55 base

@@ -61,13 +59,11 @@ test-suite spec

61 , servant

59 , servant

62 , servant-auth

60 , servant-auth

63 , lens

61 , lens

64− if impl(ghc >= 9)

65− buildable: False

66

62

67 -- test dependencies

63 -- test dependencies

68 build-depends:

64 build-depends:

69 servant-auth-swagger

65 servant-auth-swagger

70− , hspec >= 2.5.5 && < 2.9

66+ , hspec >= 2.5.5 && < 2.10

71 , QuickCheck >= 2.11.3 && < 2.15

67 , QuickCheck >= 2.11.3 && < 2.15

72 other-modules:

68 other-modules:

73 Servant.Auth.SwaggerSpec

69 Servant.Auth.SwaggerSpec

servant-auth/servant-auth/servant-auth.cabal+1−1

@@ -33,7 +33,7 @@ library

33 default-extensions: ConstraintKinds DataKinds DefaultSignatures DeriveFoldable DeriveFunctor DeriveGeneric DeriveTraversable FlexibleContexts FlexibleInstances FunctionalDependencies GADTs KindSignatures MultiParamTypeClasses OverloadedStrings RankNTypes ScopedTypeVariables TypeFamilies TypeOperators

34 ghc-options: -Wall

35 build-depends:

36− base >= 4.10 && < 4.16

36+ base >= 4.10 && < 4.17

37 , containers >= 0.6 && < 0.7

38 , aeson >= 1.3.1.1 && < 3

39 , jose >= 0.7.0.0 && < 0.10

servant-client-core/servant-client-core.cabal+5−5

@@ -50,14 +50,14 @@ library

50 --

51 -- note: mtl lower bound is so low because of GHC-7.8

52 build-depends:

53− base >= 4.9 && < 4.16

53+ base >= 4.9 && < 4.17

54 , bytestring >= 0.10.8.1 && < 0.12

55 , constraints >= 0.2 && < 0.14

56 , containers >= 0.5.7.1 && < 0.7

57 , deepseq >= 1.4.2.0 && < 1.5

58 , text >= 1.2.3.0 && < 2.1

59 , transformers >= 0.5.2.0 && < 0.6

60− , template-haskell >= 2.11.1.0 && < 2.18

60+ , template-haskell >= 2.11.1.0 && < 2.19

61

62 if !impl(ghc >= 8.2)

63 build-depends:

@@ -71,7 +71,7 @@ library

71 -- Here can be exceptions if we really need features from the newer versions.

72 build-depends:

73 aeson >= 1.4.1.0 && < 3

74− , base-compat >= 0.10.5 && < 0.12

74+ , base-compat >= 0.10.5 && < 0.13

75 , base64-bytestring >= 1.0.0.1 && < 1.3

76 , exceptions >= 0.10.0 && < 0.11

77 , free >= 5.1 && < 5.2

@@ -104,8 +104,8 @@ test-suite spec

104 -- Additional dependencies

105 build-depends:

106 deepseq >= 1.4.2.0 && < 1.5

107− , hspec >= 2.6.0 && < 2.9

107+ , hspec >= 2.6.0 && < 2.10

108 , QuickCheck >= 2.12.6.1 && < 2.15

109

110 build-tool-depends:

111− hspec-discover:hspec-discover >= 2.6.0 && <2.9

111+ hspec-discover:hspec-discover >= 2.6.0 && <2.10

servant-client-core/src/Servant/Client/Core/HasClient.hs+7−7

@@ -208,7 +208,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m api)

208 clientWithRoute pm (Proxy :: Proxy api)

209 (appendToPath p req)

210

211− where p = (toUrlPiece val)

211+ where p = toEncodedUrlPiece val

212

213 hoistClientMonad pm _ f cl = \a ->

214 hoistClientMonad pm (Proxy :: Proxy api) f (cl a)

@@ -243,7 +243,7 @@ instance (KnownSymbol capture, ToHttpApiData a, HasClient m sublayout)

243 clientWithRoute pm (Proxy :: Proxy sublayout)

244 (foldl' (flip appendToPath) req ps)

245

246− where ps = map (toUrlPiece) vals

246+ where ps = map toEncodedUrlPiece vals

247

248 hoistClientMonad pm _ f cl = \as ->

249 hoistClientMonad pm (Proxy :: Proxy sublayout) f (cl as)

@@ -740,7 +740,7 @@ instance (KnownSymbol path, HasClient m api) => HasClient m (path :> api) where

740 clientWithRoute pm (Proxy :: Proxy api)

741 (appendToPath p req)

742

743− where p = pack $ symbolVal (Proxy :: Proxy path)

743+ where p = toEncodedUrlPiece $ pack $ symbolVal (Proxy :: Proxy path)

744

745 hoistClientMonad pm _ f cl = hoistClientMonad pm (Proxy :: Proxy api) f cl

746

@@ -874,7 +874,7 @@ infixl 2 /:

874--

875-- Example:

876--

877−-- @@

877+-- @

878-- type Api = NamedRoutes RootApi

879--

880-- data RootApi mode = RootApi

@@ -895,7 +895,7 @@ infixl 2 /:

895--

896-- endpointClient :: ClientM Person

897-- endpointClient = client // subApi // endpoint

898−-- @@

898+-- @

899(//) :: a -> (a -> b) -> b

900x // f = f x

901

@@ -906,7 +906,7 @@ x // f = f x

906--

907-- Example:

908--

909−-- @@

909+-- @

910-- type Api = NamedRoutes RootApi

911--

912-- data RootApi mode = RootApi

@@ -931,7 +931,7 @@ x // f = f x

931--

932-- endpointClient :: ClientM Person

933-- endpointClient = client // subApi /: "foobar123" // endpoint

934−-- @@

934+-- @

935(/:) :: (a -> b -> c) -> b -> a -> c

936(/:) = flip

937

servant-client-core/src/Servant/Client/Core/Request.hs+10−6

@@ -34,6 +34,8 @@ import Data.Bifunctor

34import Data.Bitraversable

35 (Bitraversable (..), bifoldMapDefault, bimapDefault)

36import qualified Data.ByteString as BS

37+import Data.ByteString.Builder

38+ (Builder)

37import qualified Data.ByteString.Builder as Builder

39import qualified Data.ByteString.Builder as Builder

38import qualified Data.ByteString.Lazy as LBS

40import qualified Data.ByteString.Lazy as LBS

39import qualified Data.Sequence as Seq

41import qualified Data.Sequence as Seq

@@ -49,9 +51,9 @@ import Network.HTTP.Media

49 (MediaType)

51 (MediaType)

50import Network.HTTP.Types

52import Network.HTTP.Types

51 (Header, HeaderName, HttpVersion (..), Method, QueryItem,

53 (Header, HeaderName, HttpVersion (..), Method, QueryItem,

52− http11, methodGet)

54+ http11, methodGet, urlEncodeBuilder)

53import Servant.API

55import Servant.API

54− (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)

56+ (ToHttpApiData, toEncodedUrlPiece, toQueryParam, toHeader, SourceIO)

55

57

56import Servant.Client.Core.Internal (mediaTypeRnf)

58import Servant.Client.Core.Internal (mediaTypeRnf)

57

59

@@ -112,7 +114,7 @@ instance (NFData path, NFData body) => NFData (RequestF body path) where

112 rnfB Nothing = ()

114 rnfB Nothing = ()

113 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt

115 rnfB (Just (b, mt)) = rnf b `seq` mediaTypeRnf mt

114

116

115−type Request = RequestF RequestBody Builder.Builder

117+type Request = RequestF RequestBody Builder

116

118

117-- | The request body. R replica of the @http-client@ @RequestBody@.

119-- | The request body. R replica of the @http-client@ @RequestBody@.

118data RequestBody

120data RequestBody

@@ -145,9 +147,10 @@ defaultRequest = Request

145

147

146-- | Append extra path to the request being constructed.

148-- | Append extra path to the request being constructed.

147--

149--

150+-- Warning: This function assumes that the path fragment is already URL-encoded.

148−appendToPath :: Text -> Request -> Request

151+appendToPath :: Builder -> Request -> Request

149appendToPath p req

152appendToPath p req

150− = req { requestPath = requestPath req <> "/" <> toEncodedUrlPiece p }

153+ = req { requestPath = requestPath req <> "/" <> p }

151

154

152-- | Append a query parameter to the request being constructed.

155-- | Append a query parameter to the request being constructed.

153--

156--

@@ -162,7 +165,8 @@ appendToQueryString pname pvalue req

162-- | Encode a query parameter value.

165-- | Encode a query parameter value.

163--

166--

164encodeQueryParamValue :: ToHttpApiData a => a -> BS.ByteString

167encodeQueryParamValue :: ToHttpApiData a => a -> BS.ByteString

165−encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString . toEncodedUrlPiece

168+encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString

169+ . urlEncodeBuilder True . encodeUtf8 . toQueryParam

166

170

167-- | Add header to the request being constructed.

171-- | Add header to the request being constructed.

168--

172--

servant-client/servant-client.cabal+5−5

@@ -41,14 +41,14 @@ library

41 -- Bundled with GHC: Lower bound to not force re-installs

42 -- text and mtl are bundled starting with GHC-8.4

43 build-depends:

44− base >= 4.9 && < 4.16

44+ base >= 4.9 && < 4.17

45 , bytestring >= 0.10.8.1 && < 0.12

46 , containers >= 0.5.7.1 && < 0.7

47 , deepseq >= 1.4.2.0 && < 1.5

48 , mtl >= 2.2.2 && < 2.3

49 , stm >= 2.4.5.1 && < 2.6

50 , text >= 1.2.3.0 && < 2.1

51− , time >= 1.6.0.1 && < 1.10

51+ , time >= 1.6.0.1 && < 1.12

52 , transformers >= 0.5.2.0 && < 0.6

53

54 if !impl(ghc >= 8.2)

@@ -64,7 +64,7 @@ library

64 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

65 -- Here can be exceptions if we really need features from the newer versions.

66 build-depends:

67− base-compat >= 0.10.5 && < 0.12

67+ base-compat >= 0.10.5 && < 0.13

68 , http-client >= 0.5.13.1 && < 0.8

69 , http-media >= 0.7.1.3 && < 0.9

70 , http-types >= 0.12.2 && < 0.13

@@ -124,7 +124,7 @@ test-suite spec

124 -- Additional dependencies

125 build-depends:

126 entropy >= 0.4.1.3 && < 0.5

127− , hspec >= 2.6.0 && < 2.9

127+ , hspec >= 2.6.0 && < 2.10

128 , HUnit >= 1.6.0.0 && < 1.7

129 , network >= 2.8.0.0 && < 3.2

130 , QuickCheck >= 2.12.6.1 && < 2.15

@@ -133,7 +133,7 @@ test-suite spec

133 , tdigest >= 0.2 && < 0.3

134

135 build-tool-depends:

136− hspec-discover:hspec-discover >= 2.6.0 && < 2.9

136+ hspec-discover:hspec-discover >= 2.6.0 && < 2.10

137

138test-suite readme

139 type: exitcode-stdio-1.0

servant-client/src/Servant/Client/Internal/HttpClient.hs+8−7

@@ -24,7 +24,7 @@ import Control.Monad

24import Control.Monad.Base

25 (MonadBase (..))

26import Control.Monad.Catch

27− (MonadCatch, MonadThrow)

27+ (MonadCatch, MonadThrow, MonadMask)

28import Control.Monad.Error.Class

29 (MonadError (..))

30import Control.Monad.IO.Class

@@ -80,7 +80,7 @@ data ClientEnv

80 { manager :: Client.Manager

81 , baseUrl :: BaseUrl

82 , cookieJar :: Maybe (TVar Client.CookieJar)

83− , makeClientRequest :: BaseUrl -> Request -> Client.Request

83+ , makeClientRequest :: BaseUrl -> Request -> IO Client.Request

84 -- ^ this function can be used to customize the creation of @http-client@ requests from @servant@ requests. Default value: 'defaultMakeClientRequest'

85 -- Note that:

86 -- 1. 'makeClientRequest' exists to allow overriding operational semantics e.g. 'responseTimeout' per request,

@@ -136,7 +136,7 @@ newtype ClientM a = ClientM

136 { unClientM :: ReaderT ClientEnv (ExceptT ClientError IO) a }

137 deriving ( Functor, Applicative, Monad, MonadIO, Generic

138 , MonadReader ClientEnv, MonadError ClientError, MonadThrow

139− , MonadCatch)

139+ , MonadCatch, MonadMask)

140

141instance MonadBase IO ClientM where

142 liftBase = ClientM . liftBase

@@ -162,7 +162,7 @@ runClientM cm env = runExceptT $ flip runReaderT env $ unClientM cm

162performRequest :: Maybe [Status] -> Request -> ClientM Response

163performRequest acceptStatus req = do

164 ClientEnv m burl cookieJar' createClientRequest <- ask

165− let clientRequest = createClientRequest burl req

165+ clientRequest <- liftIO $ createClientRequest burl req

166 request <- case cookieJar' of

167 Nothing -> pure clientRequest

168 Just cj -> liftIO $ do

@@ -229,8 +229,8 @@ clientResponseToResponse f r = Response

229-- | Create a @http-client@ 'Client.Request' from a @servant@ 'Request'

230-- The 'Client.host', 'Client.path' and 'Client.port' fields are extracted from the 'BaseUrl'

231-- otherwise the body, headers and query string are derived from the @servant@ 'Request'

232−defaultMakeClientRequest :: BaseUrl -> Request -> Client.Request

232+defaultMakeClientRequest :: BaseUrl -> Request -> IO Client.Request

233−defaultMakeClientRequest burl r = Client.defaultRequest

233+defaultMakeClientRequest burl r = return Client.defaultRequest

234 { Client.method = requestMethod r

235 , Client.host = fromString $ baseUrlHost burl

236 , Client.port = baseUrlPort burl

@@ -289,7 +289,8 @@ defaultMakeClientRequest burl r = Client.defaultRequest

289 Https -> True

290

291 -- Query string builder which does not do any encoding

292+ buildQueryString [] = mempty

292− buildQueryString = ("?" <>) . foldl' addQueryParam mempty

293+ buildQueryString qps = "?" <> foldl' addQueryParam mempty qps

293

294

294 addQueryParam qs (k, v) =

295 addQueryParam qs (k, v) =

295 qs <> (if BS.null qs then mempty else "&") <> urlEncode True k <> foldMap ("=" <>) v

296 qs <> (if BS.null qs then mempty else "&") <> urlEncode True k <> foldMap ("=" <>) v

servant-client/src/Servant/Client/Internal/HttpClient/Streaming.hs+2−2

@@ -140,7 +140,7 @@ performRequest :: Maybe [Status] -> Request -> ClientM Response

140performRequest acceptStatus req = do

141 -- TODO: should use Client.withResponse here too

142 ClientEnv m burl cookieJar' createClientRequest <- ask

143− let clientRequest = createClientRequest burl req

143+ clientRequest <- liftIO $ createClientRequest burl req

144 request <- case cookieJar' of

145 Nothing -> pure clientRequest

146 Just cj -> liftIO $ do

@@ -177,7 +177,7 @@ performWithStreamingRequest req k = do

177 m <- asks manager

178 burl <- asks baseUrl

179 createClientRequest <- asks makeClientRequest

180− let request = createClientRequest burl req

180+ request <- liftIO $ createClientRequest burl req

181 ClientM $ lift $ lift $ Codensity $ \k1 ->

182 Client.withResponse request m $ \res -> do

183 let status = Client.responseStatus res

servant-client/test/Servant/ClientTestUtils.hs+13−1

@@ -160,6 +160,7 @@ type Api =

160 WithStatus 301 Text]

161 :<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]

162 :<|> NamedRoutes RecordRoutes

163+ :<|> "captureVerbatim" :> Capture "someString" Verbatim :> Get '[PlainText] Text

163

164

164api :: Proxy Api

165api :: Proxy Api

165api = Proxy

166api = Proxy

@@ -214,7 +215,8 @@ getRoot

214 :<|> EmptyClient

215 :<|> EmptyClient

215 :<|> uverbGetSuccessOrRedirect

216 :<|> uverbGetSuccessOrRedirect

216 :<|> uverbGetCreated

217 :<|> uverbGetCreated

217− :<|> recordRoutes = client api

218+ :<|> recordRoutes

219+ :<|> captureVerbatim = client api

218

220

219server :: Application

221server :: Application

220server = serve api (

222server = serve api (

@@ -259,6 +261,7 @@ server = serve api (

259 { something = pure ["foo", "bar", "pweet"]

261 { something = pure ["foo", "bar", "pweet"]

260 }

262 }

261 }

263 }

264+ :<|> pure . decodeUtf8 . unVerbatim

262 )

265 )

263

266

264-- * api for testing failures

267-- * api for testing failures

@@ -370,3 +373,12 @@ instance ToHttpApiData UrlEncodedByteString where

370

373

371instance FromHttpApiData UrlEncodedByteString where

374instance FromHttpApiData UrlEncodedByteString where

372 parseUrlPiece = pure . UrlEncodedByteString . HTTP.urlDecode True . encodeUtf8

375 parseUrlPiece = pure . UrlEncodedByteString . HTTP.urlDecode True . encodeUtf8

376+

377+newtype Verbatim = Verbatim { unVerbatim :: ByteString }

378+

379+instance ToHttpApiData Verbatim where

380+ toEncodedUrlPiece = byteString . unVerbatim

381+ toUrlPiece = decodeUtf8 . unVerbatim

382+

383+instance FromHttpApiData Verbatim where

384+ parseUrlPiece = pure . Verbatim . encodeUtf8

servant-client/test/Servant/SuccessSpec.hs+11−1

@@ -36,6 +36,8 @@ import Data.Maybe

36import Data.Monoid ()

37import Data.Text

38 (Text)

39+import Data.Text.Encoding

40+ (encodeUtf8)

39import qualified Network.HTTP.Client as C

41import qualified Network.HTTP.Client as C

40import qualified Network.HTTP.Types as HTTP

42import qualified Network.HTTP.Types as HTTP

41import Test.Hspec

43import Test.Hspec

@@ -160,7 +162,8 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

160 mgr <- C.newManager C.defaultManagerSettings

162 mgr <- C.newManager C.defaultManagerSettings

161 -- In proper situation, extra headers should probably be visible in API type.

163 -- In proper situation, extra headers should probably be visible in API type.

162 -- However, testing for response timeout is difficult, so we test with something which is easy to observe

164 -- However, testing for response timeout is difficult, so we test with something which is easy to observe

163− let createClientRequest url r = (defaultMakeClientRequest url r) { C.requestHeaders = [("X-Added-Header", "XXX")] }

165+ let createClientRequest url r = fmap (\req -> req { C.requestHeaders = [("X-Added-Header", "XXX")] })

166+ (defaultMakeClientRequest url r)

164 clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest }

167 clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest }

165 res <- runClientM (getRawSuccessPassHeaders HTTP.methodGet) clientEnv

168 res <- runClientM (getRawSuccessPassHeaders HTTP.methodGet) clientEnv

166 case res of

169 case res of

@@ -196,3 +199,10 @@ successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

196 case eitherResponse of

199 case eitherResponse of

197 Left clientError -> fail $ show clientError

200 Left clientError -> fail $ show clientError

198 Right response -> matchUnion response `shouldBe` Just (WithStatus @201 carol)

201 Right response -> matchUnion response `shouldBe` Just (WithStatus @201 carol)

202+

203+ it "encodes URL pieces following ToHttpApiData instance" $ \(_, baseUrl) -> do

204+ let textOrig = "*"

205+ eitherResponse <- runClient (captureVerbatim $ Verbatim $ encodeUtf8 textOrig) baseUrl

206+ case eitherResponse of

207+ Left clientError -> fail $ show clientError

208+ Right textBack -> textBack `shouldBe` textOrig

servant-docs/servant-docs.cabal+2−2

@@ -41,7 +41,7 @@ library

41 --

42 -- note: mtl lower bound is so low because of GHC-7.8

43 build-depends:

44− base >= 4.9 && < 4.16

44+ base >= 4.9 && < 4.17

45 , bytestring >= 0.10.8.1 && < 0.12

46 , text >= 1.2.3.0 && < 2.1

47

@@ -54,7 +54,7 @@ library

54 build-depends:

55 aeson >= 1.4.1.0 && < 3

56 , aeson-pretty >= 0.8.5 && < 0.9

57− , base-compat >= 0.10.5 && < 0.12

57+ , base-compat >= 0.10.5 && < 0.13

58 , case-insensitive >= 1.2.0.11 && < 1.3

59 , hashable >= 1.2.7.0 && < 1.5

60 , http-media >= 0.7.1.3 && < 0.9

servant-docs/src/Servant/Docs/Internal.hs+4

@@ -62,6 +62,7 @@ import GHC.TypeLits

62import Servant.API

63import Servant.API.ContentTypes

64import Servant.API.TypeLevel

65+import Servant.API.Generic

65

66

66import qualified Data.Universe.Helpers as U

67import qualified Data.Universe.Helpers as U

67

68

@@ -1150,6 +1151,9 @@ instance (ToAuthInfo (BasicAuth realm usr), HasDocs api) => HasDocs (BasicAuth r

1150 authProxy = Proxy :: Proxy (BasicAuth realm usr)

1151 authProxy = Proxy :: Proxy (BasicAuth realm usr)

1151 action' = over authInfo (|> toAuthInfo authProxy) action

1152 action' = over authInfo (|> toAuthInfo authProxy) action

1152

1153

1154+instance HasDocs (ToServantApi api) => HasDocs (NamedRoutes api) where

1155+ docsFor Proxy = docsFor (Proxy :: Proxy (ToServantApi api))

1156+

1153-- ToSample instances for simple types

1157-- ToSample instances for simple types

1154instance ToSample NoContent

1158instance ToSample NoContent

1155instance ToSample Bool

1159instance ToSample Bool

servant-foreign/servant-foreign.cabal+4−4

@@ -41,7 +41,7 @@ library

41 --

42 -- note: mtl lower bound is so low because of GHC-7.8

43 build-depends:

44− base >= 4.9 && < 4.16

44+ base >= 4.9 && < 4.17

45 , text >= 1.2.3.0 && < 2.1

46

47 -- Servant dependencies

@@ -51,7 +51,7 @@ library

51 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

52 -- Here can be exceptions if we really need features from the newer versions.

53 build-depends:

54− base-compat >= 0.10.5 && < 0.12

54+ base-compat >= 0.10.5 && < 0.13

55 , lens >= 4.17 && < 5.2

56 , http-types >= 0.12.2 && < 0.13

57

@@ -74,7 +74,7 @@ test-suite spec

74

75 -- Additional dependencies

76 build-depends:

77− hspec >= 2.6.0 && <2.9

77+ hspec >= 2.6.0 && <2.10

78 build-tool-depends:

79− hspec-discover:hspec-discover >=2.6.0 && <2.9

79+ hspec-discover:hspec-discover >=2.6.0 && <2.10

80 default-language: Haskell2010

servant-http-streams/servant-http-streams.cabal+7−7

@@ -38,13 +38,13 @@ library

38 -- Bundled with GHC: Lower bound to not force re-installs

39 -- text and mtl are bundled starting with GHC-8.4

40 build-depends:

41− base >= 4.9 && < 4.16

41+ base >= 4.9 && < 4.17

42 , bytestring >= 0.10.8.1 && < 0.12

43 , containers >= 0.5.7.1 && < 0.7

44 , deepseq >= 1.4.2.0 && < 1.5

45 , mtl >= 2.2.2 && < 2.3

46 , text >= 1.2.3.0 && < 2.1

47− , time >= 1.6.0.1 && < 1.10

47+ , time >= 1.6.0.1 && < 1.12

48 , transformers >= 0.5.2.0 && < 0.6

49

50 if !impl(ghc >= 8.2)

@@ -60,19 +60,19 @@ library

60 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

61 -- Here can be exceptions if we really need features from the newer versions.

62 build-depends:

63− base-compat >= 0.10.5 && < 0.12

63+ base-compat >= 0.10.5 && < 0.13

64 , case-insensitive

65 , http-streams >= 0.8.6.1 && < 0.9

66 , http-media >= 0.7.1.3 && < 0.9

67 , io-streams >= 1.5.0.1 && < 1.6

68 , http-types >= 0.12.2 && < 0.13

69− , http-common >= 0.8.2.0 && < 0.8.3

69+ , http-common >= 0.8.2.0 && < 0.9

70 , exceptions >= 0.10.0 && < 0.11

71 , kan-extensions >= 5.2 && < 5.3

72 , monad-control >= 1.0.2.3 && < 1.1

73 , semigroupoids >= 5.3.1 && < 5.4

74 , transformers-base >= 0.4.5.2 && < 0.5

75− , transformers-compat >= 0.6.2 && < 0.7

75+ , transformers-compat >= 0.6.2 && < 0.8

76

77 hs-source-dirs: src

78 default-language: Haskell2010

@@ -112,7 +112,7 @@ test-suite spec

112 -- Additional dependencies

113 build-depends:

114 entropy >= 0.4.1.3 && < 0.5

115− , hspec >= 2.6.0 && < 2.9

115+ , hspec >= 2.6.0 && < 2.10

116 , HUnit >= 1.6.0.0 && < 1.7

117 , network >= 2.8.0.0 && < 3.2

118 , QuickCheck >= 2.12.6.1 && < 2.15

@@ -121,7 +121,7 @@ test-suite spec

121 , tdigest >= 0.2 && < 0.3

122

123 build-tool-depends:

124− hspec-discover:hspec-discover >= 2.6.0 && < 2.9

124+ hspec-discover:hspec-discover >= 2.6.0 && < 2.10

125

126test-suite readme

127 type: exitcode-stdio-1.0

servant-server/CHANGELOG.md+3−2

@@ -3,10 +3,11 @@

3

4Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions.

5

6−Unreleased

6+0.19.1

7−----------

7+------

8

9- Add `MonadFail` instance for `Handler` wrt [#1545](https://github.com/haskell-servant/servant/issues/1545)

10+- Support GHC 9.2 [#1525](https://github.com/haskell-servant/servant/issues/1525)

10

11

110.19

120.19

12----

13----

servant-server/example/greet.hs−1

@@ -18,7 +18,6 @@ import Network.Wai.Handler.Warp

18

19import Servant

20import Servant.Server.Generic ()

21−import Servant.API.Generic

22

21

23-- * Example

22-- * Example

24

23

servant-server/servant-server.cabal+6−6

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

1cabal-version: 2.2

2name: servant-server

3−version: 0.19

3+version: 0.19.1

4

5synopsis: A family of combinators for defining webservices APIs and serving them

6category: Servant, Web

@@ -60,7 +60,7 @@ library

60 -- Bundled with GHC: Lower bound to not force re-installs

61 -- text and mtl are bundled starting with GHC-8.4

62 build-depends:

63− base >= 4.9 && < 4.16

63+ base >= 4.9 && < 4.17

64 , bytestring >= 0.10.8.1 && < 0.12

65 , constraints >= 0.2 && < 0.14

66 , containers >= 0.5.7.1 && < 0.7

@@ -72,13 +72,13 @@ library

72 -- Servant dependencies

73 -- strict dependency as we re-export 'servant' things.

74 build-depends:

75− servant >= 0.19

75+ servant >= 0.19 && < 0.20

76 , http-api-data >= 0.4.1 && < 0.4.4

77

78 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

79 -- Here can be exceptions if we really need features from the newer versions.

80 build-depends:

81− base-compat >= 0.10.5 && < 0.12

81+ base-compat >= 0.10.5 && < 0.13

82 , base64-bytestring >= 1.0.0.1 && < 1.3

83 , exceptions >= 0.10.0 && < 0.11

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

@@ -159,7 +159,7 @@ test-suite spec

159 build-depends:

160 aeson >= 1.4.1.0 && < 3

161 , directory >= 1.3.0.0 && < 1.4

162− , hspec >= 2.6.0 && < 2.9

162+ , hspec >= 2.6.0 && < 2.10

163 , hspec-wai >= 0.10.1 && < 0.12

164 , QuickCheck >= 2.12.6.1 && < 2.15

165 , should-not-typecheck >= 2.1.0 && < 2.2

@@ -167,4 +167,4 @@ test-suite spec

167 , wai-extra >= 3.0.24.3 && < 3.2

168

169 build-tool-depends:

170− hspec-discover:hspec-discover >= 2.6.0 && <2.9

170+ hspec-discover:hspec-discover >= 2.6.0 && <2.10

servant-swagger/servant-swagger.cabal+7−7

@@ -50,7 +50,7 @@ source-repository head

50custom-setup

51 setup-depends:

52 base >=4.9 && <5,

53− Cabal >= 1.24 && < 3.5,

53+ Cabal >= 1.24,

54 cabal-doctest >=1.0.6 && <1.1

55

56library

@@ -72,12 +72,12 @@ library

72 build-depends: aeson >=1.4.2.0 && <3

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

74 , base >=4.9.1.0 && <5

75− , base-compat >=0.10.5 && <0.12

75+ , base-compat >=0.10.5 && <0.13

76− , bytestring >=0.10.8.1 && <0.11

76+ , bytestring >=0.10.8.1 && <0.12

77 , http-media >=0.7.1.3 && <0.9

78 , insert-ordered-containers >=0.2.1.0 && <0.3

79 , lens >=4.17 && <6

80− , servant >=0.18.1 && <0.20

80+ , servant >=0.18.2 && <0.20

81 , singleton-bool >=0.1.4 && <0.2

82 , swagger2 >=2.3.0.1 && <3

83 , text >=1.2.3.0 && <2.1

@@ -106,14 +106,14 @@ test-suite spec

106 type: exitcode-stdio-1.0

107 hs-source-dirs: test

108 main-is: Spec.hs

109− build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.8

109+ build-tool-depends: hspec-discover:hspec-discover >=2.6.0 && <2.10

110 build-depends: base

111 , base-compat

112 , aeson >=1.4.2.0 && <3

113− , hspec >=2.6.0 && <2.8

113+ , hspec >=2.6.0 && <2.10

114 , QuickCheck

115 , lens

116− , lens-aeson >=1.0.2 && <1.2

116+ , lens-aeson >=1.0.2 && <1.3

117 , servant

118 , servant-swagger

119 , swagger2

servant-swagger/src/Servant/Swagger.hs+5−3

@@ -55,6 +55,7 @@ import Servant.Swagger.Internal.Orphans ()

55-- >>> import Data.Typeable

56-- >>> import GHC.Generics

57-- >>> import Servant.API

58+-- >>> import System.Environment

58-- >>> import Test.Hspec

59-- >>> import Test.Hspec

59-- >>> import Test.QuickCheck

60-- >>> import Test.QuickCheck

60-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL8

61-- >>> import qualified Data.ByteString.Lazy.Char8 as BSL8

@@ -64,6 +65,7 @@ import Servant.Swagger.Internal.Orphans ()

64-- >>> :set -XGeneralizedNewtypeDeriving

65-- >>> :set -XGeneralizedNewtypeDeriving

65-- >>> :set -XOverloadedStrings

66-- >>> :set -XOverloadedStrings

66-- >>> :set -XTypeOperators

67-- >>> :set -XTypeOperators

68+-- >>> setEnv "HSPEC_COLOR" "no"

67-- >>> data User = User { name :: String, age :: Int } deriving (Show, Generic, Typeable)

69-- >>> data User = User { name :: String, age :: Int } deriving (Show, Generic, Typeable)

68-- >>> newtype UserId = UserId Integer deriving (Show, Generic, Typeable, ToJSON)

70-- >>> newtype UserId = UserId Integer deriving (Show, Generic, Typeable, ToJSON)

69-- >>> instance ToJSON User

71-- >>> instance ToJSON User

@@ -160,11 +162,11 @@ import Servant.Swagger.Internal.Orphans ()

160-- >>> instance Arbitrary UserId where arbitrary = UserId <$> arbitrary

162-- >>> instance Arbitrary UserId where arbitrary = UserId <$> arbitrary

161-- >>> hspec $ validateEveryToJSON (Proxy :: Proxy UserAPI)

163-- >>> hspec $ validateEveryToJSON (Proxy :: Proxy UserAPI)

162-- <BLANKLINE>

164-- <BLANKLINE>

163−-- [User]

165+-- [User]...

164-- ...

166-- ...

165−-- User

167+-- User...

166-- ...

168-- ...

167−-- UserId

169+-- UserId...

168-- ...

170-- ...

169-- Finished in ... seconds

171-- Finished in ... seconds

170-- 3 examples, 0 failures

172-- 3 examples, 0 failures

servant-swagger/src/Servant/Swagger/Internal.hs+11

@@ -3,11 +3,13 @@

3{-# LANGUAGE DataKinds #-}

4{-# LANGUAGE FlexibleContexts #-}

5{-# LANGUAGE FlexibleInstances #-}

6+{-# LANGUAGE OverloadedLists #-}

6{-# LANGUAGE OverloadedStrings #-}

7{-# LANGUAGE OverloadedStrings #-}

7{-# LANGUAGE PolyKinds #-}

8{-# LANGUAGE PolyKinds #-}

8{-# LANGUAGE RankNTypes #-}

9{-# LANGUAGE RankNTypes #-}

9{-# LANGUAGE ScopedTypeVariables #-}

10{-# LANGUAGE ScopedTypeVariables #-}

10{-# LANGUAGE TypeOperators #-}

11{-# LANGUAGE TypeOperators #-}

12+{-# LANGUAGE TypeFamilies #-}

11#if __GLASGOW_HASKELL__ >= 806

13#if __GLASGOW_HASKELL__ >= 806

12{-# LANGUAGE UndecidableInstances #-}

14{-# LANGUAGE UndecidableInstances #-}

13#endif

15#endif

@@ -30,11 +32,13 @@ import qualified Data.Swagger as Swagger

30import Data.Swagger.Declare

32import Data.Swagger.Declare

31import Data.Text (Text)

33import Data.Text (Text)

32import qualified Data.Text as Text

34import qualified Data.Text as Text

35+import GHC.Generics (D1, Meta(..), Rep)

33import GHC.TypeLits

36import GHC.TypeLits

34import Network.HTTP.Media (MediaType)

37import Network.HTTP.Media (MediaType)

35import Servant.API

38import Servant.API

36import Servant.API.Description (FoldDescription,

39import Servant.API.Description (FoldDescription,

37 reflectDescription)

40 reflectDescription)

41+import Servant.API.Generic (ToServantApi, AsApi)

38import Servant.API.Modifiers (FoldRequired)

42import Servant.API.Modifiers (FoldRequired)

39

43

40import Servant.Swagger.Internal.TypeLevel.API

44import Servant.Swagger.Internal.TypeLevel.API

@@ -149,6 +153,10 @@ mkEndpointNoContentVerb path _ = mempty

149addParam :: Param -> Swagger -> Swagger

153addParam :: Param -> Swagger -> Swagger

150addParam param = allOperations.parameters %~ (Inline param :)

154addParam param = allOperations.parameters %~ (Inline param :)

151

155

156+-- | Add a tag to every operation in the spec.

157+addTag :: Text -> Swagger -> Swagger

158+addTag tag = allOperations.tags %~ ([tag] <>)

159+

152-- | Add accepted content types to every operation in the spec.

160-- | Add accepted content types to every operation in the spec.

153addConsumes :: [MediaType] -> Swagger -> Swagger

161addConsumes :: [MediaType] -> Swagger -> Swagger

154addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs))

162addConsumes cs = allOperations.consumes %~ (<> Just (MimeList cs))

@@ -439,6 +447,9 @@ instance (ToSchema a, Accept ct, HasSwagger sub, KnownSymbol (FoldDescription mo

439 & required ?~ True

447 & required ?~ True

440 & schema .~ ParamBody ref

448 & schema .~ ParamBody ref

441

449

450+instance (HasSwagger (ToServantApi routes), KnownSymbol datatypeName, Rep (routes AsApi) ~ D1 ('MetaData datatypeName moduleName packageName isNewtype) f) => HasSwagger (NamedRoutes routes) where

451+ toSwagger _ = addTag (Text.pack $ symbolVal (Proxy :: Proxy datatypeName)) (toSwagger (Proxy :: Proxy (ToServantApi routes)))

452+

442-- =======================================================================

453-- =======================================================================

443-- Below are the definitions that should be in Servant.API.ContentTypes

454-- Below are the definitions that should be in Servant.API.ContentTypes

444-- =======================================================================

455-- =======================================================================

servant-swagger/src/Servant/Swagger/Internal/Test.hs+8−6

@@ -29,10 +29,12 @@ import Servant.Swagger.Internal.TypeLevel

29-- >>> import Control.Applicative

30-- >>> import GHC.Generics

31-- >>> import Test.QuickCheck

32+-- >>> import System.Environment (setEnv)

32-- >>> :set -XDeriveGeneric

33-- >>> :set -XDeriveGeneric

33-- >>> :set -XGeneralizedNewtypeDeriving

34-- >>> :set -XGeneralizedNewtypeDeriving

34-- >>> :set -XDataKinds

35-- >>> :set -XDataKinds

35-- >>> :set -XTypeOperators

36-- >>> :set -XTypeOperators

37+-- >>> setEnv "HSPEC_COLOR" "no"

36

38

37-- | Verify that every type used with @'JSON'@ content type in a servant API

39-- | Verify that every type used with @'JSON'@ content type in a servant API

38-- has compatible @'ToJSON'@ and @'ToSchema'@ instances using @'validateToJSON'@.

40-- has compatible @'ToJSON'@ and @'ToSchema'@ instances using @'validateToJSON'@.

@@ -53,10 +55,10 @@ import Servant.Swagger.Internal.TypeLevel

53--

55--

54-- >>> hspec $ context "ToJSON matches ToSchema" $ validateEveryToJSON (Proxy :: Proxy UserAPI)

56-- >>> hspec $ context "ToJSON matches ToSchema" $ validateEveryToJSON (Proxy :: Proxy UserAPI)

55-- <BLANKLINE>

57-- <BLANKLINE>

56−-- ToJSON matches ToSchema

58+-- ToJSON matches ToSchema...

57−-- User

59+-- User...

58-- ...

60-- ...

59−-- UserId

61+-- UserId...

60-- ...

62-- ...

61-- Finished in ... seconds

63-- Finished in ... seconds

62-- 2 examples, 0 failures

64-- 2 examples, 0 failures

@@ -118,11 +120,11 @@ validateEveryToJSONWithPatternChecker checker _ = props

118-- :}

120-- :}

119-- <BLANKLINE>

121-- <BLANKLINE>

120-- read . show == id

122-- read . show == id

121−-- Bool

123+-- Bool...

122-- ...

124-- ...

123−-- Int

125+-- Int...

124-- ...

126-- ...

125−-- [Char]

127+-- [Char]...

126-- ...

128-- ...

127-- Finished in ... seconds

129-- Finished in ... seconds

128-- 3 examples, 0 failures

130-- 3 examples, 0 failures

servant/servant.cabal+5−5

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

80 --

81 -- note: mtl lower bound is so low because of GHC-7.8

82 build-depends:

83− base >= 4.9 && < 4.16

83+ base >= 4.9 && < 4.17

84 , bytestring >= 0.10.8.1 && < 0.12

85 , constraints >= 0.2

86 , mtl >= 2.2.2 && < 2.3

@@ -98,7 +98,7 @@ library

98 -- Other dependencies: Lower bound around what is in the latest Stackage LTS.

99 -- Here can be exceptions if we really need features from the newer versions.

100 build-depends:

101− base-compat >= 0.10.5 && < 0.12

101+ base-compat >= 0.10.5 && < 0.13

102 , aeson >= 1.4.1.0 && < 3

103 , attoparsec >= 0.13.2.2 && < 0.15

104 , bifunctors >= 5.5.3 && < 5.6

@@ -106,7 +106,7 @@ library

106 , deepseq >= 1.4.2.0 && < 1.5

107 , http-media >= 0.7.1.3 && < 0.9

108 , http-types >= 0.12.2 && < 0.13

109− , mmorph >= 1.1.2 && < 1.2

109+ , mmorph >= 1.1.2 && < 1.3

110 , network-uri >= 2.6.1.0 && < 2.7

111 , QuickCheck >= 2.12.6.1 && < 2.15

112 , string-conversions >= 0.4.0.1 && < 0.5

@@ -166,9 +166,9 @@ test-suite spec

166

167 -- Additional dependencies

168 build-depends:

169− hspec >= 2.6.0 && < 2.9

169+ hspec >= 2.6.0 && < 2.10

170 , QuickCheck >= 2.12.6.1 && < 2.15

171 , quickcheck-instances >= 0.3.19 && < 0.4

172

173 build-tool-depends:

174− hspec-discover:hspec-discover >= 2.6.0 && < 2.9

174+ hspec-discover:hspec-discover >= 2.6.0 && < 2.10

servant/src/Servant/API.hs+4

@@ -38,6 +38,7 @@ module Servant.API (

38

39 -- * Sub-APIs defined as records of routes

40 module Servant.API.NamedRoutes,

41+ module Servant.API.Generic,

41

42

42 -- * Streaming endpoints, distinguished by HTTP method

43 -- * Streaming endpoints, distinguished by HTTP method

43 module Servant.API.Stream,

44 module Servant.API.Stream,

@@ -102,6 +103,9 @@ import Servant.API.Fragment

102 (Fragment)

103 (Fragment)

103import Servant.API.Header

104import Servant.API.Header

104 (Header, Header')

105 (Header, Header')

106+import Servant.API.Generic

107+ (GenericMode ((:-)), AsApi, ToServant, ToServantApi, GServantProduct,

108+ GenericServant, fromServant, toServant, genericApi)

105import Servant.API.HttpVersion

109import Servant.API.HttpVersion

106 (HttpVersion (..))

110 (HttpVersion (..))

107import Servant.API.IsSecure

111import Servant.API.IsSecure

servant/src/Servant/API/ContentTypes.hs+1−1

@@ -295,7 +295,7 @@ instance {-# OVERLAPPABLE #-}

295-- then this would be taken care of. However there is no more specific instance

296-- between that and 'MimeRender JSON a', so we do this instead

297instance {-# OVERLAPPING #-} ( Accept ctyp ) => AllMimeRender '[ctyp] NoContent where

298− allMimeRender _ _ = map (, "") $ NE.toList $ contentTypes pctyp

298+ allMimeRender _ NoContent = map (, "") $ NE.toList $ contentTypes pctyp

299 where

300 pctyp = Proxy :: Proxy ctyp

301

servant/test/Servant/API/ContentTypesSpec.hs+11

@@ -33,6 +33,8 @@ import Data.String.Conversions

33import qualified Data.Text as TextS

34import qualified Data.Text.Encoding as TextSE

35import qualified Data.Text.Lazy as TextL

36+import Control.Exception

37+ (evaluate)

36import GHC.Generics

38import GHC.Generics

37import Test.Hspec

39import Test.Hspec

38import Test.QuickCheck

40import Test.QuickCheck

@@ -78,6 +80,15 @@ spec = describe "Servant.API.ContentTypes" $ do

78 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do

80 it "has mimeUnrender reverse mimeRender for valid top-level json " $ do

79 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)

81 property $ \x -> mimeUnrender p (mimeRender p x) == Right (x::SomeData)

80

82

83+ describe "The NoContent Content-Type type" $ do

84+ let p = Proxy :: Proxy '[JSON]

85+

86+ it "does not render any content" $

87+ allMimeRender p NoContent `shouldSatisfy` (all (BSL8.null . snd))

88+

89+ it "evaluates the NoContent value" $

90+ evaluate (allMimeRender p (undefined :: NoContent)) `shouldThrow` anyErrorCall

91+

81 describe "The PlainText Content-Type type" $ do

92 describe "The PlainText Content-Type type" $ do

82 let p = Proxy :: Proxy PlainText

93 let p = Proxy :: Proxy PlainText

83

94