master..1fba9dc · typeable/servant

changelog.d/1595deleted−2

since splitsnapshots

unifiedsplit

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

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

2−prs: #1595

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− req' <- I.defaultMakeClientRequest burl req

122+ let req' = I.defaultMakeClientRequest burl req

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

124```

125

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

@@ -31,13 +31,15 @@ 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.17

34+ base >= 4.10 && < 4.16

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

41 exposed-modules:

43 exposed-modules:

42 Servant.Auth.Swagger

44 Servant.Auth.Swagger

43 default-language: Haskell2010

45 default-language: Haskell2010

@@ -59,6 +61,8 @@ test-suite spec

59 , servant

61 , servant

60 , servant-auth

62 , servant-auth

61 , lens

63 , lens

64+ if impl(ghc >= 9)

65+ buildable: False

62

66

63 -- test dependencies

67 -- test dependencies

64 build-depends:

68 build-depends:

servant-client-core/src/Servant/Client/Core/Request.hs+3−4

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

51 (MediaType)

52import Network.HTTP.Types

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

54− http11, methodGet, urlEncodeBuilder)

54+ http11, methodGet)

55import Servant.API

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

56+ (ToHttpApiData, toEncodedUrlPiece, toHeader, SourceIO)

57

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

59

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

165-- | Encode a query parameter value.

166--

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

168−encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString

168+encodeQueryParamValue = LBS.toStrict . Builder.toLazyByteString . toEncodedUrlPiece

169− . urlEncodeBuilder True . encodeUtf8 . toQueryParam

170

169

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

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

172--

171--

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

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

80 { manager :: Client.Manager

81 , baseUrl :: BaseUrl

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

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

83+ , makeClientRequest :: BaseUrl -> Request -> 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,

@@ -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− clientRequest <- liftIO $ createClientRequest burl req

165+ let clientRequest = 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 -> IO Client.Request

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

233−defaultMakeClientRequest burl r = return Client.defaultRequest

233+defaultMakeClientRequest burl r = Client.defaultRequest

234 { Client.method = requestMethod r

235 , Client.host = fromString $ baseUrlHost burl

236 , Client.port = baseUrlPort burl

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− clientRequest <- liftIO $ createClientRequest burl req

143+ let clientRequest = 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− request <- liftIO $ createClientRequest burl req

180+ let request = 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/SuccessSpec.hs+1−2

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

162 mgr <- C.newManager C.defaultManagerSettings

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

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

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

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

166− (defaultMakeClientRequest url r)

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

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

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

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

169 case res of

168 case res of