040db21 · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Merge pull request #599 from chkl/clientm

040db21Julian Arni10 years ago

doc/tutorial/Client.lhs+10−17

compare with master

unifiedsplit

@@ -15,11 +15,10 @@ need to have some language extensions and imports:

16module Client where

18−import Control.Monad.Trans.Except (ExceptT, runExceptT)

19import Data.Aeson

18import Data.Aeson

20import Data.Proxy

19import Data.Proxy

21import GHC.Generics

20import GHC.Generics

22−import Network.HTTP.Client (Manager, newManager, defaultManagerSettings)

21+import Network.HTTP.Client (newManager, defaultManagerSettings)

23import Servant.API

22import Servant.API

24import Servant.Client

23import Servant.Client

25```

24```

@@ -71,19 +70,13 @@ What we are going to get with **servant-client** here is 3 functions, one to que

71``` haskell

70``` haskell

72position :: Int -- ^ value for "x"

71position :: Int -- ^ value for "x"

73 -> Int -- ^ value for "y"

72 -> Int -- ^ value for "y"

74− -> Manager -- ^ the HTTP client to use

73+ -> ClientM Position

75− -> BaseUrl -- ^ the URL at which the API can be found

76− -> ExceptT ServantError IO Position

78hello :: Maybe String -- ^ an optional value for "name"

75hello :: Maybe String -- ^ an optional value for "name"

79− -> Manager -- ^ the HTTP client to use

80− -> BaseUrl -- ^ the URL at which the API can be found

81− -> ExceptT ServantError IO HelloMessage

76+ -> ClientM HelloMessage

83marketing :: ClientInfo -- ^ value for the request body

78marketing :: ClientInfo -- ^ value for the request body

84− -> Manager -- ^ the HTTP client to use

79+ -> ClientM Email

85− -> BaseUrl -- ^ the URL at which the API can be found

86− -> ExceptT ServantError IO Email

87```

80```

89Each function makes available as an argument any value that the response may

82Each function makes available as an argument any value that the response may

@@ -120,17 +113,17 @@ data BaseUrl = BaseUrl

120That's it. Let's now write some code that uses our client functions.

113That's it. Let's now write some code that uses our client functions.

121

114

122``` haskell

115``` haskell

123−queries :: Manager -> BaseUrl -> ExceptT ServantError IO (Position, HelloMessage, Email)

116+queries :: ClientM (Position, HelloMessage, Email)

124−queries manager baseurl = do

117+queries = do

125− pos <- position 10 10 manager baseurl

118+ pos <- position 10 10

126− message <- hello (Just "servant") manager baseurl

119+ message <- hello (Just "servant")

127− em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"]) manager baseurl

120+ em <- marketing (ClientInfo "Alp" "alp@foo.com" 26 ["haskell", "mathematics"])

128 return (pos, message, em)

121 return (pos, message, em)

129

122

130run :: IO ()

123run :: IO ()

131run = do

124run = do

132 manager <- newManager defaultManagerSettings

125 manager <- newManager defaultManagerSettings

133− res <- runExceptT (queries manager (BaseUrl Http "localhost" 8081 ""))

126+ res <- runClientM queries (ClientEnv manager (BaseUrl Http "localhost" 8081 ""))

134 case res of

127 case res of

135 Left err -> putStrLn $ "Error: " ++ show err

128 Left err -> putStrLn $ "Error: " ++ show err

136 Right (pos, message, em) -> do

129 Right (pos, message, em) -> do

servant-client/CHANGELOG.md+8

@@ -1,3 +1,11 @@

1+0.8.1

2+-----

4+* BACKWARDS INCOMPATIBLE: `client` now returns a ClientM which is a Reader for

5+ BasicEnv. BasicEnv comprises the HttpManager and BaseUrl that have had to be

6+ passed to each method returned by `client`.

10.7.1

90.7.1

2-----

10-----

servant-client/servant-client.cabal+1

@@ -53,6 +53,7 @@ library

53 , text >= 1.2 && < 1.3

54 , transformers >= 0.3 && < 0.6

55 , transformers-compat >= 0.4 && < 0.6

56+ , mtl

56 hs-source-dirs: src

57 hs-source-dirs: src

57 default-language: Haskell2010

58 default-language: Haskell2010

58 ghc-options: -Wall

59 ghc-options: -Wall

servant-client/src/Servant/Client.hs+16−14

@@ -20,6 +20,8 @@ module Servant.Client

20 , client

21 , HasClient(..)

22 , ClientM

23+ , runClientM

24+ , ClientEnv (ClientEnv)

23 , mkAuthenticateReq

25 , mkAuthenticateReq

24 , ServantError(..)

26 , ServantError(..)

25 , module Servant.Common.BaseUrl

27 , module Servant.Common.BaseUrl

@@ -34,7 +36,7 @@ import Data.Proxy

34import Data.String.Conversions

36import Data.String.Conversions

35import Data.Text (unpack)

37import Data.Text (unpack)

36import GHC.TypeLits

38import GHC.TypeLits

37−import Network.HTTP.Client (Manager, Response)

39+import Network.HTTP.Client (Response)

38import Network.HTTP.Media

40import Network.HTTP.Media

39import qualified Network.HTTP.Types as H

41import qualified Network.HTTP.Types as H

40import qualified Network.HTTP.Types.Header as HTTP

42import qualified Network.HTTP.Types.Header as HTTP

@@ -154,17 +156,17 @@ instance OVERLAPPABLE_

154 -- Note [Non-Empty Content Types]

156 -- Note [Non-Empty Content Types]

155 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)

157 (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts)

156 ) => HasClient (Verb method status cts' a) where

158 ) => HasClient (Verb method status cts' a) where

157− type Client (Verb method status cts' a) = Manager -> BaseUrl -> ClientM a

159+ type Client (Verb method status cts' a) = ClientM a

158− clientWithRoute Proxy req manager baseurl =

160+ clientWithRoute Proxy req = do

159− snd <$> performRequestCT (Proxy :: Proxy ct) method req manager baseurl

161+ snd <$> performRequestCT (Proxy :: Proxy ct) method req

160 where method = reflectMethod (Proxy :: Proxy method)

162 where method = reflectMethod (Proxy :: Proxy method)

161

163

162instance OVERLAPPING_

164instance OVERLAPPING_

163 (ReflectMethod method) => HasClient (Verb method status cts NoContent) where

165 (ReflectMethod method) => HasClient (Verb method status cts NoContent) where

164 type Client (Verb method status cts NoContent)

166 type Client (Verb method status cts NoContent)

165− = Manager -> BaseUrl -> ClientM NoContent

167+ = ClientM NoContent

166− clientWithRoute Proxy req manager baseurl =

168+ clientWithRoute Proxy req = do

167− performRequestNoBody method req manager baseurl >> return NoContent

169+ performRequestNoBody method req >> return NoContent

168 where method = reflectMethod (Proxy :: Proxy method)

170 where method = reflectMethod (Proxy :: Proxy method)

169

171

170instance OVERLAPPING_

172instance OVERLAPPING_

@@ -172,10 +174,10 @@ instance OVERLAPPING_

172 ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)

174 ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts)

173 ) => HasClient (Verb method status cts' (Headers ls a)) where

175 ) => HasClient (Verb method status cts' (Headers ls a)) where

174 type Client (Verb method status cts' (Headers ls a))

176 type Client (Verb method status cts' (Headers ls a))

175− = Manager -> BaseUrl -> ClientM (Headers ls a)

177+ = ClientM (Headers ls a)

176− clientWithRoute Proxy req manager baseurl = do

178+ clientWithRoute Proxy req = do

177 let method = reflectMethod (Proxy :: Proxy method)

179 let method = reflectMethod (Proxy :: Proxy method)

178− (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req manager baseurl

180+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req

179 return $ Headers { getResponse = resp

181 return $ Headers { getResponse = resp

180 , getHeadersHList = buildHeadersTo hdrs

182 , getHeadersHList = buildHeadersTo hdrs

181 }

183 }

@@ -184,10 +186,10 @@ instance OVERLAPPING_

184 ( BuildHeadersTo ls, ReflectMethod method

186 ( BuildHeadersTo ls, ReflectMethod method

185 ) => HasClient (Verb method status cts (Headers ls NoContent)) where

187 ) => HasClient (Verb method status cts (Headers ls NoContent)) where

186 type Client (Verb method status cts (Headers ls NoContent))

188 type Client (Verb method status cts (Headers ls NoContent))

187− = Manager -> BaseUrl -> ClientM (Headers ls NoContent)

189+ = ClientM (Headers ls NoContent)

188− clientWithRoute Proxy req manager baseurl = do

190+ clientWithRoute Proxy req = do

189 let method = reflectMethod (Proxy :: Proxy method)

191 let method = reflectMethod (Proxy :: Proxy method)

190− hdrs <- performRequestNoBody method req manager baseurl

192+ hdrs <- performRequestNoBody method req

191 return $ Headers { getResponse = NoContent

193 return $ Headers { getResponse = NoContent

192 , getHeadersHList = buildHeadersTo hdrs

194 , getHeadersHList = buildHeadersTo hdrs

193 }

195 }

@@ -372,7 +374,7 @@ instance (KnownSymbol sym, HasClient api)

372-- back the full `Response`.

374-- back the full `Response`.

373instance HasClient Raw where

375instance HasClient Raw where

374 type Client Raw

376 type Client Raw

375− = H.Method -> Manager -> BaseUrl -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)

377+ = H.Method -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)

376

378

377 clientWithRoute :: Proxy Raw -> Req -> Client Raw

379 clientWithRoute :: Proxy Raw -> Req -> Client Raw

378 clientWithRoute Proxy req httpMethod = do

380 clientWithRoute Proxy req httpMethod = do

servant-client/src/Servant/Common/Req.hs+50−19

@@ -1,7 +1,10 @@

1{-# LANGUAGE DeriveDataTypeable #-}

2+{-# LANGUAGE DeriveGeneric #-}

2{-# LANGUAGE CPP #-}

3{-# LANGUAGE CPP #-}

3{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE OverloadedStrings #-}

4{-# LANGUAGE ScopedTypeVariables #-}

5{-# LANGUAGE ScopedTypeVariables #-}

6+{-# LANGUAGE GeneralizedNewtypeDeriving #-}

5module Servant.Common.Req where

8module Servant.Common.Req where

7#if !MIN_VERSION_base(4,8,0)

10#if !MIN_VERSION_base(4,8,0)

@@ -10,8 +13,18 @@ import Control.Applicative

10import Control.Exception

13import Control.Exception

11import Control.Monad

14import Control.Monad

12import Control.Monad.Catch (MonadThrow)

15import Control.Monad.Catch (MonadThrow)

16+

17+#if MIN_VERSION_mtl(2,2,0)

18+import Control.Monad.Except (MonadError(..))

19+#else

13−import Control.Monad.IO.Class

20+import Control.Monad.Error.Class (MonadError(..))

21+#endif

14import Control.Monad.Trans.Except

22import Control.Monad.Trans.Except

23+

24+

25+import GHC.Generics

26+import Control.Monad.IO.Class ()

27+import Control.Monad.Reader

15import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)

28import Data.ByteString.Lazy hiding (pack, filter, map, null, elem)

16import Data.String

29import Data.String

17import Data.String.Conversions

30import Data.String.Conversions

@@ -19,9 +32,9 @@ import Data.Proxy

19import Data.Text (Text)

32import Data.Text (Text)

20import Data.Text.Encoding

33import Data.Text.Encoding

21import Data.Typeable

34import Data.Typeable

22−import Network.HTTP.Client hiding (Proxy, path)

23import Network.HTTP.Media

35import Network.HTTP.Media

24import Network.HTTP.Types

36import Network.HTTP.Types

37+import Network.HTTP.Client hiding (Proxy, path)

25import qualified Network.HTTP.Types.Header as HTTP

38import qualified Network.HTTP.Types.Header as HTTP

26import Network.URI hiding (path)

39import Network.URI hiding (path)

27import Servant.API.ContentTypes

40import Servant.API.ContentTypes

@@ -149,20 +162,40 @@ parseRequest url = liftM disableStatusCheck (parseUrl url)

149displayHttpRequest :: Method -> String

162displayHttpRequest :: Method -> String

150displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"

163displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request"

151

164

165+data ClientEnv

166+ = ClientEnv

167+ { manager :: Manager

168+ , baseUrl :: BaseUrl

169+ }

170+

171+

172+-- | @ClientM@ is the monad in which client functions run. Contains the

173+-- 'Manager' and 'BaseUrl' used for requests in the reader environment.

174+

152−type ClientM = ExceptT ServantError IO

175+newtype ClientM a = ClientM { runClientM' :: ReaderT ClientEnv (ExceptT ServantError IO) a }

176+ deriving ( Functor, Applicative, Monad, MonadIO, Generic

177+ , MonadReader ClientEnv

178+ , MonadError ServantError

179+ )

180+

181+runClientM :: ClientM a -> ClientEnv -> IO (Either ServantError a)

182+runClientM cm env = runExceptT $ (flip runReaderT env) $ runClientM' cm

183+

153

184

154−performRequest :: Method -> Req -> Manager -> BaseUrl

185+performRequest :: Method -> Req

155 -> ClientM ( Int, ByteString, MediaType

186 -> ClientM ( Int, ByteString, MediaType

156 , [HTTP.Header], Response ByteString)

187 , [HTTP.Header], Response ByteString)

157−performRequest reqMethod req manager reqHost = do

188+performRequest reqMethod req = do

189+ m <- asks manager

190+ reqHost <- asks baseUrl

158 partialRequest <- liftIO $ reqToRequest req reqHost

191 partialRequest <- liftIO $ reqToRequest req reqHost

159

192

160 let request = partialRequest { Client.method = reqMethod }

193 let request = partialRequest { Client.method = reqMethod }

161

194

162− eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request manager

195+ eResponse <- liftIO $ catchConnectionError $ Client.httpLbs request m

163 case eResponse of

196 case eResponse of

164 Left err ->

197 Left err ->

165− throwE . ConnectionError $ SomeException err

198+ throwError . ConnectionError $ SomeException err

166

199

167 Right response -> do

200 Right response -> do

168 let status = Client.responseStatus response

201 let status = Client.responseStatus response

@@ -172,28 +205,26 @@ performRequest reqMethod req manager reqHost = do

172 ct <- case lookup "Content-Type" $ Client.responseHeaders response of

205 ct <- case lookup "Content-Type" $ Client.responseHeaders response of

173 Nothing -> pure $ "application"//"octet-stream"

206 Nothing -> pure $ "application"//"octet-stream"

174 Just t -> case parseAccept t of

207 Just t -> case parseAccept t of

175− Nothing -> throwE $ InvalidContentTypeHeader (cs t) body

208+ Nothing -> throwError $ InvalidContentTypeHeader (cs t) body

176 Just t' -> pure t'

209 Just t' -> pure t'

177 unless (status_code >= 200 && status_code < 300) $

210 unless (status_code >= 200 && status_code < 300) $

178− throwE $ FailureResponse status ct body

211+ throwError $ FailureResponse status ct body

179 return (status_code, body, ct, hdrs, response)

212 return (status_code, body, ct, hdrs, response)

180

213

181−performRequestCT :: MimeUnrender ct result =>

214+performRequestCT :: MimeUnrender ct result => Proxy ct -> Method -> Req

182− Proxy ct -> Method -> Req -> Manager -> BaseUrl

183 -> ClientM ([HTTP.Header], result)

215 -> ClientM ([HTTP.Header], result)

184−performRequestCT ct reqMethod req manager reqHost = do

216+performRequestCT ct reqMethod req = do

185 let acceptCT = contentType ct

217 let acceptCT = contentType ct

186 (_status, respBody, respCT, hdrs, _response) <-

218 (_status, respBody, respCT, hdrs, _response) <-

187− performRequest reqMethod (req { reqAccept = [acceptCT] }) manager reqHost

219+ performRequest reqMethod (req { reqAccept = [acceptCT] })

188− unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody

220+ unless (matches respCT (acceptCT)) $ throwError $ UnsupportedContentType respCT respBody

189 case mimeUnrender ct respBody of

221 case mimeUnrender ct respBody of

190− Left err -> throwE $ DecodeFailure err respCT respBody

222+ Left err -> throwError $ DecodeFailure err respCT respBody

191 Right val -> return (hdrs, val)

223 Right val -> return (hdrs, val)

192

224

193−performRequestNoBody :: Method -> Req -> Manager -> BaseUrl

225+performRequestNoBody :: Method -> Req -> ClientM [HTTP.Header]

194− -> ClientM [HTTP.Header]

195−performRequestNoBody reqMethod req manager reqHost = do

226+performRequestNoBody reqMethod req = do

196− (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost

227+ (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req

197 return hdrs

228 return hdrs

198

229

199catchConnectionError :: IO a -> IO (Either ServantError a)

230catchConnectionError :: IO a -> IO (Either ServantError a)

servant-client/test/Servant/ClientSpec.hs+41−41

@@ -32,7 +32,7 @@ import Control.Applicative ((<$>))

32import Control.Arrow (left)

33import Control.Concurrent (forkIO, killThread, ThreadId)

34import Control.Exception (bracket)

35−import Control.Monad.Trans.Except (throwE, runExceptT)

35+import Control.Monad.Trans.Except (throwE )

36import Data.Aeson

37import qualified Data.ByteString.Lazy as BS

38import Data.Char (chr, isPrint)

@@ -123,22 +123,22 @@ type Api =

123api :: Proxy Api

124api = Proxy

125

126−getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person

126+getGet :: SCR.ClientM Person

127−getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent

127+getDeleteEmpty :: SCR.ClientM NoContent

128−getCapture :: String -> C.Manager -> BaseUrl -> SCR.ClientM Person

128+getCapture :: String -> SCR.ClientM Person

129−getCaptureAll :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person]

129+getCaptureAll :: [String] -> SCR.ClientM [Person]

130−getBody :: Person -> C.Manager -> BaseUrl -> SCR.ClientM Person

130+getBody :: Person -> SCR.ClientM Person

131−getQueryParam :: Maybe String -> C.Manager -> BaseUrl -> SCR.ClientM Person

131+getQueryParam :: Maybe String -> SCR.ClientM Person

132−getQueryParams :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person]

132+getQueryParams :: [String] -> SCR.ClientM [Person]

133−getQueryFlag :: Bool -> C.Manager -> BaseUrl -> SCR.ClientM Bool

133+getQueryFlag :: Bool -> SCR.ClientM Bool

134−getRawSuccess :: HTTP.Method -> C.Manager -> BaseUrl

134+getRawSuccess :: HTTP.Method

135 -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)

136−getRawFailure :: HTTP.Method -> C.Manager -> BaseUrl

136+getRawFailure :: HTTP.Method

137 -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)

138−getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> C.Manager -> BaseUrl

138+getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]

139 -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])

140−getRespHeaders :: C.Manager -> BaseUrl -> SCR.ClientM (Headers TestHeaders Bool)

140+getRespHeaders :: SCR.ClientM (Headers TestHeaders Bool)

141−getDeleteContentType :: C.Manager -> BaseUrl -> SCR.ClientM NoContent

141+getDeleteContentType :: SCR.ClientM NoContent

142getGet

143 :<|> getDeleteEmpty

144 :<|> getCapture

@@ -242,42 +242,42 @@ sucessSpec :: Spec

242sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

243

244 it "Servant.API.Get" $ \(_, baseUrl) -> do

245− (left show <$> runExceptT (getGet manager baseUrl)) `shouldReturn` Right alice

245+ (left show <$> (runClientM getGet (ClientEnv manager baseUrl))) `shouldReturn` Right alice

246

247 describe "Servant.API.Delete" $ do

248 it "allows empty content type" $ \(_, baseUrl) -> do

249− (left show <$> runExceptT (getDeleteEmpty manager baseUrl)) `shouldReturn` Right NoContent

249+ (left show <$> (runClientM getDeleteEmpty (ClientEnv manager baseUrl))) `shouldReturn` Right NoContent

250

251 it "allows content type" $ \(_, baseUrl) -> do

252− (left show <$> runExceptT (getDeleteContentType manager baseUrl)) `shouldReturn` Right NoContent

252+ (left show <$> (runClientM getDeleteContentType (ClientEnv manager baseUrl))) `shouldReturn` Right NoContent

253

254 it "Servant.API.Capture" $ \(_, baseUrl) -> do

255− (left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0)

255+ (left show <$> (runClientM (getCapture "Paula") (ClientEnv manager baseUrl))) `shouldReturn` Right (Person "Paula" 0)

256

257 it "Servant.API.CaptureAll" $ \(_, baseUrl) -> do

258 let expected = [(Person "Paula" 0), (Person "Peta" 1)]

259− (left show <$> runExceptT (getCaptureAll ["Paula", "Peta"] manager baseUrl)) `shouldReturn` Right expected

259+ (left show <$> (runClientM (getCaptureAll ["Paula", "Peta"]) (ClientEnv manager baseUrl))) `shouldReturn` Right expected

260

261 it "Servant.API.ReqBody" $ \(_, baseUrl) -> do

262 let p = Person "Clara" 42

263− (left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p

263+ (left show <$> runClientM (getBody p) (ClientEnv manager baseUrl)) `shouldReturn` Right p

264

265 it "Servant.API.QueryParam" $ \(_, baseUrl) -> do

266− left show <$> runExceptT (getQueryParam (Just "alice") manager baseUrl) `shouldReturn` Right alice

266+ left show <$> runClientM (getQueryParam (Just "alice")) (ClientEnv manager baseUrl) `shouldReturn` Right alice

267− Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob") manager baseUrl)

267+ Left FailureResponse{..} <- runClientM (getQueryParam (Just "bob")) (ClientEnv manager baseUrl)

268 responseStatus `shouldBe` HTTP.Status 400 "bob not found"

269

270 it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do

271− (left show <$> runExceptT (getQueryParams [] manager baseUrl)) `shouldReturn` Right []

271+ (left show <$> runClientM (getQueryParams []) (ClientEnv manager baseUrl)) `shouldReturn` Right []

272− (left show <$> runExceptT (getQueryParams ["alice", "bob"] manager baseUrl))

272+ (left show <$> runClientM (getQueryParams ["alice", "bob"]) (ClientEnv manager baseUrl))

273 `shouldReturn` Right [Person "alice" 0, Person "bob" 1]

274

275 context "Servant.API.QueryParam.QueryFlag" $

276 forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do

277− (left show <$> runExceptT (getQueryFlag flag manager baseUrl)) `shouldReturn` Right flag

277+ (left show <$> runClientM (getQueryFlag flag) (ClientEnv manager baseUrl)) `shouldReturn` Right flag

278

279 it "Servant.API.Raw on success" $ \(_, baseUrl) -> do

280− res <- runExceptT (getRawSuccess HTTP.methodGet manager baseUrl)

280+ res <- runClientM (getRawSuccess HTTP.methodGet) (ClientEnv manager baseUrl)

281 case res of

282 Left e -> assertFailure $ show e

283 Right (code, body, ct, _, response) -> do

@@ -286,7 +286,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

286 C.responseStatus response `shouldBe` HTTP.ok200

287

288 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do

289− res <- runExceptT (getRawFailure HTTP.methodGet manager baseUrl)

289+ res <- runClientM (getRawFailure HTTP.methodGet) (ClientEnv manager baseUrl)

290 case res of

291 Right _ -> assertFailure "expected Left, but got Right"

292 Left e -> do

@@ -294,7 +294,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

294 Servant.Client.responseBody e `shouldBe` "rawFailure"

295

296 it "Returns headers appropriately" $ \(_, baseUrl) -> do

297− res <- runExceptT (getRespHeaders manager baseUrl)

297+ res <- runClientM getRespHeaders (ClientEnv manager baseUrl)

298 case res of

299 Left e -> assertFailure $ show e

300 Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]

@@ -303,7 +303,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

303 it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->

304 property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->

305 ioProperty $ do

306− result <- left show <$> runExceptT (getMultiple cap num flag body manager baseUrl)

306+ result <- left show <$> runClientM (getMultiple cap num flag body) (ClientEnv manager baseUrl)

307 return $

308 result === Right (cap, num, flag, body)

309

@@ -315,9 +315,9 @@ wrappedApiSpec = describe "error status codes" $ do

315 let test :: (WrappedApi, String) -> Spec

316 test (WrappedApi api, desc) =

317 it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do

318− let getResponse :: C.Manager -> BaseUrl -> SCR.ClientM ()

318+ let getResponse :: SCR.ClientM ()

319 getResponse = client api

320− Left FailureResponse{..} <- runExceptT (getResponse manager baseUrl)

320+ Left FailureResponse{..} <- runClientM getResponse (ClientEnv manager baseUrl)

321 responseStatus `shouldBe` (HTTP.Status 500 "error message")

322 in mapM_ test $

323 (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :

@@ -332,42 +332,42 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do

332 context "client returns errors appropriately" $ do

333 it "reports FailureResponse" $ \(_, baseUrl) -> do

334 let (_ :<|> getDeleteEmpty :<|> _) = client api

335− Left res <- runExceptT (getDeleteEmpty manager baseUrl)

335+ Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)

336 case res of

337 FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return ()

338 _ -> fail $ "expected 404 response, but got " <> show res

339

340 it "reports DecodeFailure" $ \(_, baseUrl) -> do

341 let (_ :<|> _ :<|> getCapture :<|> _) = client api

342− Left res <- runExceptT (getCapture "foo" manager baseUrl)

342+ Left res <- runClientM (getCapture "foo") (ClientEnv manager baseUrl)

343 case res of

344 DecodeFailure _ ("application/json") _ -> return ()

345 _ -> fail $ "expected DecodeFailure, but got " <> show res

346

347 it "reports ConnectionError" $ \_ -> do

348 let (getGetWrongHost :<|> _) = client api

349− Left res <- runExceptT (getGetWrongHost manager (BaseUrl Http "127.0.0.1" 19872 ""))

349+ Left res <- runClientM getGetWrongHost (ClientEnv manager (BaseUrl Http "127.0.0.1" 19872 ""))

350 case res of

351 ConnectionError _ -> return ()

352 _ -> fail $ "expected ConnectionError, but got " <> show res

353

354 it "reports UnsupportedContentType" $ \(_, baseUrl) -> do

355 let (getGet :<|> _ ) = client api

356− Left res <- runExceptT (getGet manager baseUrl)

356+ Left res <- runClientM getGet (ClientEnv manager baseUrl)

357 case res of

358 UnsupportedContentType ("application/octet-stream") _ -> return ()

359 _ -> fail $ "expected UnsupportedContentType, but got " <> show res

360

361 it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do

362 let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api

363− Left res <- runExceptT (getBody alice manager baseUrl)

363+ Left res <- runClientM (getBody alice) (ClientEnv manager baseUrl)

364 case res of

365 InvalidContentTypeHeader "fooooo" _ -> return ()

366 _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res

367

368data WrappedApi where

369 WrappedApi :: (HasServer (api :: *) '[], Server api ~ Handler a,

370− HasClient api, Client api ~ (C.Manager -> BaseUrl -> SCR.ClientM ())) =>

370+ HasClient api, Client api ~ SCR.ClientM ()) =>

371 Proxy api -> WrappedApi

372

373basicAuthSpec :: Spec

@@ -377,14 +377,14 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d

377 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do

378 let getBasic = client basicAuthAPI

379 let basicAuthData = BasicAuthData "servant" "server"

380− (left show <$> runExceptT (getBasic basicAuthData manager baseUrl)) `shouldReturn` Right alice

380+ (left show <$> runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)) `shouldReturn` Right alice

381

382 context "Authentication is rejected when requests are not authenticated properly" $ do

383

384 it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do

385 let getBasic = client basicAuthAPI

386 let basicAuthData = BasicAuthData "not" "password"

387− Left FailureResponse{..} <- runExceptT (getBasic basicAuthData manager baseUrl)

387+ Left FailureResponse{..} <- runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)

388 responseStatus `shouldBe` HTTP.Status 403 "Forbidden"

389

390genAuthSpec :: Spec

@@ -394,14 +394,14 @@ genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do

394 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do

395 let getProtected = client genAuthAPI

396 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)

397− (left show <$> runExceptT (getProtected authRequest manager baseUrl)) `shouldReturn` Right alice

397+ (left show <$> runClientM (getProtected authRequest) (ClientEnv manager baseUrl)) `shouldReturn` Right alice

398

399 context "Authentication is rejected when requests are not authenticated properly" $ do

400

401 it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do

402 let getProtected = client genAuthAPI

403 let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)

404− Left FailureResponse{..} <- runExceptT (getProtected authRequest manager baseUrl)

404+ Left FailureResponse{..} <- runClientM (getProtected authRequest) (ClientEnv manager baseUrl)

405 responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")

406

407-- * utils