75ea91c · typeable/servant

git.iko.soy/typeable/servant

on master help sign in

Fix some tests

75ea91cJulian K. Arni9 years ago

servant-client-core/README.mdnew file+5

compare with master

unifiedsplit

@@ -0,0 +1,5 @@

1+# servant-client-core

3+![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)

5+HTTP-client-agnostic client functions for servant APIs.

servant-client-core/servant-client-core.cabal−2

@@ -65,5 +65,3 @@ test-suite spec

65 , QuickCheck >= 2.7 && < 2.10

66 other-modules:

67 Servant.Client.Core.Internal.BaseUrlSpec

68− build-depends:

69− base == 4.*

servant-client-core/src/Servant/Client/Core.hs+19−5

@@ -19,7 +19,7 @@

19module Servant.Client.Core

20 ( AuthClientData

21 , AuthenticateReq(..)

22− , client

22+ , clientIn

23 , HasClient(..)

24 , mkAuthenticateReq

25 , ServantError(..)

@@ -29,6 +29,15 @@ module Servant.Client.Core

29 , Response(..)

30 , RequestBody(..)

31 , module Servant.Client.Core.Internal.BaseUrl

32+ , ClientLike(..)

33+ , genericMkClientL

34+ , genericMkClientP

35+ -- * Writing instances

36+ , addHeader

37+ , appendToQueryString

38+ , appendToPath

39+ , setRequestBodyLBS

40+ , setRequestBody

32 ) where

41 ) where

34import Control.Monad.Error.Class (throwError)

43import Control.Monad.Error.Class (throwError)

@@ -67,10 +76,15 @@ import Servant.API ((:<|>) ((:<|>)), (:>),

67import Servant.API.ContentTypes (contentTypes)

76import Servant.API.ContentTypes (contentTypes)

69import Servant.Client.Core.Internal.Auth

78import Servant.Client.Core.Internal.Auth

70−import Servant.Client.Core.Internal.BaseUrl

79+import Servant.Client.Core.Internal.BaseUrl (BaseUrl (..),

80+ InvalidBaseUrlException,

81+ Scheme (..),

82+ parseBaseUrl,

83+ showBaseUrl)

71import Servant.Client.Core.Internal.BasicAuth

84import Servant.Client.Core.Internal.BasicAuth

72import Servant.Client.Core.Internal.Class

85import Servant.Client.Core.Internal.Class

73import Servant.Client.Core.Internal.Request

86import Servant.Client.Core.Internal.Request

87+import Servant.Client.Core.Internal.Generic

75-- * Accessing APIs as a Client

89-- * Accessing APIs as a Client

@@ -88,9 +102,9 @@ import Servant.Client.Core.Internal.Request

88-- >

102-- >

89-- > getAllBooks :: ClientM [Book]

103-- > getAllBooks :: ClientM [Book]

90-- > postNewBook :: Book -> ClientM Book

104-- > postNewBook :: Book -> ClientM Book

91−-- > (getAllBooks :<|> postNewBook) = client clientM myApi

105+-- > (getAllBooks :<|> postNewBook) = myApi `clientIn` clientM

92−client :: HasClient m api => Proxy m -> Proxy api -> Client m api

106+clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api

93−client pm p = clientWithRoute pm p defaultRequest

107+clientIn p pm = clientWithRoute pm p defaultRequest

108

109

96-- | This class lets us define how each API combinator

110-- | This class lets us define how each API combinator

servant-client-core/src/Servant/Client/Core/Internal/Auth.hs+3−3

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

1−{-# LANGUAGE OverloadedStrings #-}

1+{-# LANGUAGE OverloadedStrings #-}

2+{-# LANGUAGE TypeFamilies #-}

2{-# LANGUAGE TypeSynonymInstances #-}

3{-# LANGUAGE TypeSynonymInstances #-}

3−{-# LANGUAGE TypeFamilies #-}

5-- | Authentication for clients

7module Servant.Client.Core.Internal.Auth where

9−import Servant.Client.Core.Internal.Request (Request)

9+import Servant.Client.Core.Internal.Request (Request)

11-- | For a resource protected by authentication (e.g. AuthProtect), we need

12-- to provide the client with some data used to add authentication data

servant-client-core/src/Servant/Client/Core/Internal/BaseUrl.hs+2−10

@@ -1,21 +1,13 @@

1{-# LANGUAGE DeriveDataTypeable #-}

2{-# LANGUAGE DeriveGeneric #-}

3{-# LANGUAGE ViewPatterns #-}

4−module Servant.Client.Core.Internal.BaseUrl (

4+module Servant.Client.Core.Internal.BaseUrl where

5− -- * types

6− BaseUrl (..)

7− , InvalidBaseUrlException

8− , Scheme (..)

9− -- * functions

10− , parseBaseUrl

11− , showBaseUrl

12−) where

14import Control.Monad.Catch (Exception, MonadThrow, throwM)

6import Control.Monad.Catch (Exception, MonadThrow, throwM)

15import Data.List

7import Data.List

16import Data.Typeable

8import Data.Typeable

17import GHC.Generics

9import GHC.Generics

18−import Network.URI hiding (path)

10+import Network.URI hiding (path)

19import Safe

11import Safe

20import Text.Read

12import Text.Read

servant-client-core/src/Servant/Client/Core/Internal/Generic.hs+1−5

@@ -10,11 +10,7 @@

11#include "overlapping-compat.h"

13−module Servant.Client.Core.Internal.Generic

13+module Servant.Client.Core.Internal.Generic where

14− ( ClientLike(..)

15− , genericMkClientL

16− , genericMkClientP

17− ) where

19import Generics.SOP (Code, Generic, I(..), NP(..), NS(Z), SOP(..), to)

15import Generics.SOP (Code, Generic, I(..), NP(..), NS(Z), SOP(..), to)

20import Servant.API ((:<|>)(..))

16import Servant.API ((:<|>)(..))

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

@@ -12,7 +12,7 @@ license: BSD3

12license-file: LICENSE

13author: Servant Contributors

14maintainer: haskell-servant-maintainers@googlegroups.com

15−copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors

15+copyright: 2014-2017 Zalora South East Asia Pte Ltd, Servant Contributors

16category: Servant, Web

17build-type: Simple

18cabal-version: >=1.10

@@ -29,7 +29,8 @@ source-repository head

30library

31 exposed-modules:

32− Servant.Client.HttpClient

32+ Servant.Client

33+ Servant.Client.Internal.HttpClient

33 build-depends:

34 build-depends:

34 base >= 4.7 && < 4.11

35 base >= 4.7 && < 4.11

35 , base-compat >= 0.9.1 && < 0.10

36 , base-compat >= 0.9.1 && < 0.10

@@ -67,7 +68,6 @@ test-suite spec

67 main-is: Spec.hs

68 main-is: Spec.hs

68 other-modules:

69 other-modules:

69 Servant.ClientSpec

70 Servant.ClientSpec

70− , Servant.Common.BaseUrlSpec

71 build-depends:

72 base == 4.*

73 , aeson

servant-client/src/Servant/Client.hsnew file+10

@@ -0,0 +1,10 @@

1+module Servant.Client

2+ ( ClientEnv(..)

3+ , ClientM

4+ , runClientM

5+ , client

6+ , module X

7+ ) where

9+import Servant.Client.Internal.HttpClient

10+import Servant.Client.Core as X

servant-client/src/Servant/Client/HttpClient.hs → servant-client/src/Servant/Client/Internal/HttpClient.hsrenamed+5−1

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

1{-# LANGUAGE CPP #-}

2{-# LANGUAGE DeriveDataTypeable #-}

3{-# LANGUAGE DeriveGeneric #-}

4+{-# LANGUAGE FlexibleContexts #-}

4{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE FlexibleInstances #-}

5{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE GeneralizedNewtypeDeriving #-}

6{-# LANGUAGE MultiParamTypeClasses #-}

7{-# LANGUAGE MultiParamTypeClasses #-}

@@ -9,7 +10,7 @@

9{-# LANGUAGE TypeFamilies #-}

10{-# LANGUAGE TypeFamilies #-}

11{-| http-client based client requests executor -}

12{-| http-client based client requests executor -}

12−module Servant.Client.HttpClient where

13+module Servant.Client.Internal.HttpClient where

15import Prelude ()

16import Prelude ()

@@ -28,6 +29,7 @@ import qualified Data.ByteString.Lazy as BSL

28import Data.Foldable (toList)

29import Data.Foldable (toList)

29import Data.Functor.Alt (Alt (..))

30import Data.Functor.Alt (Alt (..))

30import Data.Monoid ((<>))

31import Data.Monoid ((<>))

32+import Data.Proxy (Proxy (..))

31import Data.String (fromString)

33import Data.String (fromString)

32import qualified Data.Text as T

34import qualified Data.Text as T

33import GHC.Exts (fromList)

35import GHC.Exts (fromList)

@@ -45,6 +47,8 @@ data ClientEnv

45 , baseUrl :: BaseUrl

47 , baseUrl :: BaseUrl

46 }

48 }

50+client :: HasClient ClientM api => Proxy api -> Client ClientM api

51+client api = api `clientIn` (Proxy :: Proxy ClientM)

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

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

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

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

servant-client/test/Servant/ClientSpec.hs+126−109

@@ -26,44 +26,59 @@

26#include "overlapping-compat.h"

27module Servant.ClientSpec where

29−import Control.Arrow (left)

29+import Control.Arrow (left)

30−import Control.Concurrent (forkIO, killThread, ThreadId)

30+import Control.Concurrent (ThreadId, forkIO,

31+ killThread)

31−import Control.Exception (bracket)

32+import Control.Exception (bracket)

32−import Control.Monad.Error.Class (throwError )

33+import Control.Monad.Error.Class (throwError)

33import Data.Aeson

34import Data.Aeson

34−import qualified Data.ByteString.Lazy as BS

35+import qualified Data.ByteString.Lazy as BS

35−import Data.Char (chr, isPrint)

36+import Data.Char (chr, isPrint)

36−import Data.Foldable (forM_)

37+import Data.Foldable (forM_)

37−import Data.Monoid hiding (getLast)

38+import Data.Monoid hiding (getLast)

38import Data.Proxy

39import Data.Proxy

39−import qualified Generics.SOP as SOP

40+import qualified Generics.SOP as SOP

40−import GHC.Generics (Generic)

41+import GHC.Generics (Generic)

41−import qualified Network.HTTP.Client as C

42+import qualified Network.HTTP.Client as C

42import Network.HTTP.Media

43import Network.HTTP.Media

43−import qualified Network.HTTP.Types as HTTP

44+import qualified Network.HTTP.Types as HTTP

44import Network.Socket

45import Network.Socket

45−import Network.Wai (Request, requestHeaders, responseLBS)

46+import qualified Network.Wai as Wai

46import Network.Wai.Handler.Warp

47import Network.Wai.Handler.Warp

47−import Prelude ()

48+import Prelude ()

48import Prelude.Compat

49import Prelude.Compat

49−import System.IO.Unsafe (unsafePerformIO)

50+import System.IO.Unsafe (unsafePerformIO)

50−import Test.HUnit

51import Test.Hspec

52import Test.Hspec.QuickCheck

53+import Test.HUnit

53import Test.QuickCheck

54import Test.QuickCheck

54−import Web.FormUrlEncoded (FromForm, ToForm)

55+import Web.FormUrlEncoded (FromForm, ToForm)

55−

56+

56−import Servant.API

57+import Servant.API ((:<|>) ((:<|>)),

58+ (:>), AuthProtect,

59+ BasicAuth,

60+ BasicAuthData (..),

61+ Capture,

62+ CaptureAll, Delete,

63+ DeleteNoContent,

64+ EmptyAPI,

65+ FormUrlEncoded,

66+ Get, Header,

67+ Headers, JSON,

68+ NoContent, Post,

69+ Put, QueryFlag,

70+ QueryParam,

71+ QueryParams,

72+ ReqBody)

57import Servant.API.Internal.Test.ComprehensiveAPI

73import Servant.API.Internal.Test.ComprehensiveAPI

58import Servant.Client

74import Servant.Client

59−import Servant.Client.Generic

60−import qualified Servant.Common.Req as SCR

75+{-import qualified Servant.Common.Req as SCR-}

61−import qualified Servant.Client.HttpClient as SCR

76+{-import qualified Servant.Client.HttpClient as SCR-}

62import Servant.Server

77import Servant.Server

63import Servant.Server.Experimental.Auth

78import Servant.Server.Experimental.Auth

65-- This declaration simply checks that all instances are in place.

80-- This declaration simply checks that all instances are in place.

66−_ = client inClientM comprehensiveAPI

81+_ = client comprehensiveAPI

68spec :: Spec

83spec :: Spec

69spec = describe "Servant.Client" $ do

84spec = describe "Servant.Client" $ do

@@ -76,17 +91,16 @@ spec = describe "Servant.Client" $ do

77-- * test data types

92-- * test data types

79−data Person = Person {

94+data Person = Person

80− name :: String,

95+ { name :: String

81− age :: Integer

96+ , age :: Integer

82− }

83− deriving (Eq, Show, Generic)

97+ } deriving (Eq, Show, Generic)

85instance ToJSON Person

99instance ToJSON Person

86instance FromJSON Person

100instance FromJSON Person

101

88−instance ToForm Person where

102+instance ToForm Person

89−instance FromForm Person where

103+instance FromForm Person

104

91alice :: Person

105alice :: Person

92alice = Person "Alice" 42

106alice = Person "Alice" 42

@@ -117,22 +131,22 @@ type Api =

117api :: Proxy Api

131api :: Proxy Api

118api = Proxy

132api = Proxy

119

133

120−getGet :: SCR.ClientM Person

134+getGet :: ClientM Person

121−getDeleteEmpty :: SCR.ClientM NoContent

135+getDeleteEmpty :: ClientM NoContent

122−getCapture :: String -> SCR.ClientM Person

136+getCapture :: String -> ClientM Person

123−getCaptureAll :: [String] -> SCR.ClientM [Person]

137+getCaptureAll :: [String] -> ClientM [Person]

124−getBody :: Person -> SCR.ClientM Person

138+getBody :: Person -> ClientM Person

125−getQueryParam :: Maybe String -> SCR.ClientM Person

139+getQueryParam :: Maybe String -> ClientM Person

126−getQueryParams :: [String] -> SCR.ClientM [Person]

140+getQueryParams :: [String] -> ClientM [Person]

127−getQueryFlag :: Bool -> SCR.ClientM Bool

141+getQueryFlag :: Bool -> ClientM Bool

128getRawSuccess :: HTTP.Method

142getRawSuccess :: HTTP.Method

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

143+ -> ClientM Response

130getRawFailure :: HTTP.Method

144getRawFailure :: HTTP.Method

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

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

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

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

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

147+ -> ClientM (String, Maybe Int, Bool, [(String, [Rational])])

134−getRespHeaders :: SCR.ClientM (Headers TestHeaders Bool)

148+getRespHeaders :: ClientM (Headers TestHeaders Bool)

135−getDeleteContentType :: SCR.ClientM NoContent

149+getDeleteContentType :: ClientM NoContent

136

150

137getGet

151getGet

138 :<|> getDeleteEmpty

152 :<|> getDeleteEmpty

@@ -147,7 +161,7 @@ getGet

147 :<|> getMultiple

161 :<|> getMultiple

148 :<|> getRespHeaders

162 :<|> getRespHeaders

149 :<|> getDeleteContentType

163 :<|> getDeleteContentType

150− :<|> EmptyClient = client inClientM api

164+ :<|> EmptyClient = client api

151

165

152server :: Application

166server :: Application

153server = serve api (

167server = serve api (

@@ -162,8 +176,8 @@ server = serve api (

162 Nothing -> throwError $ ServantErr 400 "missing parameter" "" [])

176 Nothing -> throwError $ ServantErr 400 "missing parameter" "" [])

163 :<|> (\ names -> return (zipWith Person names [0..]))

177 :<|> (\ names -> return (zipWith Person names [0..]))

164 :<|> return

178 :<|> return

165− :<|> (Tagged $ \ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess")

179+ :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")

166− :<|> (Tagged $ \ _request respond -> respond $ responseLBS HTTP.badRequest400 [] "rawFailure")

180+ :<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.badRequest400 [] "rawFailure")

167 :<|> (\ a b c d -> return (a, b, c, d))

181 :<|> (\ a b c d -> return (a, b, c, d))

168 :<|> (return $ addHeader 1729 $ addHeader "eg2" True)

182 :<|> (return $ addHeader 1729 $ addHeader "eg2" True)

169 :<|> return NoContent

183 :<|> return NoContent

@@ -179,9 +193,9 @@ failApi = Proxy

179

193

180failServer :: Application

194failServer :: Application

181failServer = serve failApi (

195failServer = serve failApi (

182− (Tagged $ \ _request respond -> respond $ responseLBS HTTP.ok200 [] "")

196+ (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "")

183− :<|> (\ _capture -> Tagged $ \_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "application/json")] "")

197+ :<|> (\ _capture -> Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/json")] "")

184− :<|> (Tagged $ \_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "fooooo")] "")

198+ :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "fooooo")] "")

185 )

199 )

186

200

187-- * basic auth stuff

201-- * basic auth stuff

@@ -237,7 +251,7 @@ type GenericClientAPI

237 :<|> Capture "foo" String :> NestedAPI1

251 :<|> Capture "foo" String :> NestedAPI1

238

252

239data GenericClient = GenericClient

253data GenericClient = GenericClient

240− { getSqr :: Maybe Int -> SCR.ClientM Int

254+ { getSqr :: Maybe Int -> ClientM Int

241 , mkNestedClient1 :: String -> NestedClient1

255 , mkNestedClient1 :: String -> NestedClient1

242 } deriving Generic

256 } deriving Generic

243instance SOP.Generic GenericClient

257instance SOP.Generic GenericClient

@@ -249,7 +263,7 @@ type NestedAPI1

249

263

250data NestedClient1 = NestedClient1

264data NestedClient1 = NestedClient1

251 { mkNestedClient2 :: Maybe Int -> NestedClient2

265 { mkNestedClient2 :: Maybe Int -> NestedClient2

252− , idChar :: Maybe Char -> SCR.ClientM Char

266+ , idChar :: Maybe Char -> ClientM Char

253 } deriving Generic

267 } deriving Generic

254instance SOP.Generic NestedClient1

268instance SOP.Generic NestedClient1

255instance (Client ClientM NestedAPI1 ~ client) => ClientLike client NestedClient1

269instance (Client ClientM NestedAPI1 ~ client) => ClientLike client NestedClient1

@@ -259,8 +273,8 @@ type NestedAPI2

259 :<|> "void" :> Post '[JSON] ()

273 :<|> "void" :> Post '[JSON] ()

260

274

261data NestedClient2 = NestedClient2

275data NestedClient2 = NestedClient2

262− { getSum :: Int -> Int -> SCR.ClientM Int

276+ { getSum :: Int -> Int -> ClientM Int

263− , doNothing :: SCR.ClientM ()

277+ , doNothing :: ClientM ()

264 } deriving Generic

278 } deriving Generic

265instance SOP.Generic NestedClient2

279instance SOP.Generic NestedClient2

266instance (Client ClientM NestedAPI2 ~ client) => ClientLike client NestedClient2

280instance (Client ClientM NestedAPI2 ~ client) => ClientLike client NestedClient2

@@ -277,50 +291,52 @@ genericClientServer = serve (Proxy :: Proxy GenericClientAPI) (

277 nestedServer1 _str = nestedServer2 :<|> (maybe (throwError $ ServantErr 400 "missing parameter" "" []) return)

291 nestedServer1 _str = nestedServer2 :<|> (maybe (throwError $ ServantErr 400 "missing parameter" "" []) return)

278 nestedServer2 _int = (\ x y -> return (x + y)) :<|> return ()

292 nestedServer2 _int = (\ x y -> return (x + y)) :<|> return ()

279

293

280−{-# NOINLINE manager #-}

294+{-# NOINLINE manager' #-}

281−manager :: C.Manager

295+manager' :: C.Manager

282−manager = unsafePerformIO $ C.newManager C.defaultManagerSettings

296+manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings

297+

298+runClient x = runClientM x (ClientEnv manager' baseUrl)

283

299

284sucessSpec :: Spec

300sucessSpec :: Spec

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

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

286

302

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

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

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

304+ (left show <$> runClient getGet) `shouldReturn` Right alice

289

305

290 describe "Servant.API.Delete" $ do

306 describe "Servant.API.Delete" $ do

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

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

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

308+ (left show <$> (runClient getDeleteEmpty)) `shouldReturn` Right NoContent

293

309

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

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

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

311+ (left show <$> (runClient getDeleteContentType)) `shouldReturn` Right NoContent

296

312

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

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

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

314+ (left show <$> (runClient (getCapture "Paula"))) `shouldReturn` Right (Person "Paula" 0)

299

315

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

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

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

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

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

318+ (left show <$> (runClient (getCaptureAll ["Paula", "Peta"]))) `shouldReturn` Right expected

303

319

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

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

305 let p = Person "Clara" 42

321 let p = Person "Clara" 42

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

322+ (left show <$> runClient (getBody p)) `shouldReturn` Right p

307

323

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

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

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

325+ left show <$> runClient (getQueryParam (Just "alice")) `shouldReturn` Right alice

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

326+ Left (FailureResponse r) <- runClient (getQueryParam (Just "bob"))

311− responseStatus `shouldBe` HTTP.Status 400 "bob not found"

327+ responseStatusCode r `shouldBe` HTTP.Status 400 "bob not found"

312

328

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

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

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

330+ (left show <$> runClient (getQueryParams [])) `shouldReturn` Right []

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

331+ (left show <$> runClient (getQueryParams ["alice", "bob"]))

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

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

317

333

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

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

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

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

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

336+ (left show <$> runClient (getQueryFlag flag)) `shouldReturn` Right flag

321

337

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

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

323− res <- runClientM (getRawSuccess HTTP.methodGet) (ClientEnv manager baseUrl)

339+ res <- runClient (getRawSuccess HTTP.methodGet)

324 case res of

340 case res of

325 Left e -> assertFailure $ show e

341 Left e -> assertFailure $ show e

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

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

@@ -329,15 +345,16 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do

329 C.responseStatus response `shouldBe` HTTP.ok200

345 C.responseStatus response `shouldBe` HTTP.ok200

330

346

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

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

332− res <- runClientM (getRawFailure HTTP.methodGet) (ClientEnv manager baseUrl)

348+ res <- runClient (getRawFailure HTTP.methodGet)

333 case res of

349 case res of

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

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

335− Left e -> do

351+ Left (FailureResponse r) -> do

336− Servant.Client.responseStatus e `shouldBe` HTTP.status400

352+ responseStatusCode r `shouldBe` HTTP.status400

337− Servant.Client.responseBody e `shouldBe` "rawFailure"

353+ responseBody r `shouldBe` "rawFailure"

354+ Left e -> assertFailure $ "expected FailureResponse, but got " ++ show e

338

355

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

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

340− res <- runClientM getRespHeaders (ClientEnv manager baseUrl)

357+ res <- runClient getRespHeaders

341 case res of

358 case res of

342 Left e -> assertFailure $ show e

359 Left e -> assertFailure $ show e

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

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

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

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

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

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

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

348 ioProperty $ do

365 ioProperty $ do

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

366+ result <- left show <$> runClient (getMultiple cap num flag body)

350 return $

367 return $

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

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

352

369

@@ -358,10 +375,10 @@ wrappedApiSpec = describe "error status codes" $ do

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

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

359 test (WrappedApi api, desc) =

376 test (WrappedApi api, desc) =

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

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

361− let getResponse :: SCR.ClientM ()

378+ let getResponse :: ClientM ()

362− getResponse = client inClientM api

379+ getResponse = client api

363− Left FailureResponse{..} <- runClientM getResponse (ClientEnv manager baseUrl)

380+ Left (FailureResponse r) <- runClient getResponse

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

381+ responseStatusCode r `shouldBe` (HTTP.Status 500 "error message")

365 in mapM_ test $

382 in mapM_ test $

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

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

367 (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :

384 (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :

@@ -374,43 +391,43 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do

374

391

375 context "client returns errors appropriately" $ do

392 context "client returns errors appropriately" $ do

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

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

377− let (_ :<|> getDeleteEmpty :<|> _) = client inClientM api

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

378− Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)

395+ Left res <- runClient getDeleteEmpty

379 case res of

396 case res of

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

397+ FailureResponse r | responseStatusCode r == 404 -> return ()

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

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

382

399

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

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

384− let (_ :<|> _ :<|> getCapture :<|> _) = client inClientM api

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

385− Left res <- runClientM (getCapture "foo") (ClientEnv manager baseUrl)

402+ Left res <- runClient (getCapture "foo") (ClientEnv manager baseUrl)

386 case res of

403 case res of

387− DecodeFailure _ ("application/json") _ -> return ()

404+ DecodeFailure _ _ -> return ()

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

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

389

406

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

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

391− let (getGetWrongHost :<|> _) = client inClientM api

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

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

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

393 case res of

410 case res of

394 ConnectionError _ -> return ()

411 ConnectionError _ -> return ()

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

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

396

413

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

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

398− let (getGet :<|> _ ) = client inClientM api

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

399− Left res <- runClientM getGet (ClientEnv manager baseUrl)

416+ Left res <- runClient getGet

400 case res of

417 case res of

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

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

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

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

403

420

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

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

405− let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client inClientM api

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

406− Left res <- runClientM (getBody alice) (ClientEnv manager baseUrl)

423+ Left res <- runClient (getBody alice)

407 case res of

424 case res of

408− InvalidContentTypeHeader "fooooo" _ -> return ()

425+ InvalidContentTypeHeader _ -> return ()

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

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

410

427

411data WrappedApi where

428data WrappedApi where

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

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

413− HasClient ClientM api, Client ClientM api ~ SCR.ClientM ()) =>

430+ HasClient ClientM api, Client ClientM api ~ ClientM ()) =>

414 Proxy api -> WrappedApi

431 Proxy api -> WrappedApi

415

432

416basicAuthSpec :: Spec

433basicAuthSpec :: Spec

@@ -418,50 +435,50 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d

418 context "Authentication works when requests are properly authenticated" $ do

435 context "Authentication works when requests are properly authenticated" $ do

419

436

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

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

421− let getBasic = client inClientM basicAuthAPI

438+ let getBasic = client basicAuthAPI

422 let basicAuthData = BasicAuthData "servant" "server"

439 let basicAuthData = BasicAuthData "servant" "server"

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

440+ (left show <$> runClient (getBasic basicAuthData)) `shouldReturn` Right alice

424

441

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

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

426

443

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

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

428− let getBasic = client inClientM basicAuthAPI

445+ let getBasic = client basicAuthAPI

429 let basicAuthData = BasicAuthData "not" "password"

446 let basicAuthData = BasicAuthData "not" "password"

430− Left FailureResponse{..} <- runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)

447+ Left (FailureResponse r) <- runClient (getBasic basicAuthData)

431− responseStatus `shouldBe` HTTP.Status 403 "Forbidden"

448+ responseStatusCode r `shouldBe` HTTP.Status 403 "Forbidden"

432

449

433genAuthSpec :: Spec

450genAuthSpec :: Spec

434genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do

451genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do

435 context "Authentication works when requests are properly authenticated" $ do

452 context "Authentication works when requests are properly authenticated" $ do

436

453

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

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

438− let getProtected = client inClientM genAuthAPI

455+ let getProtected = client genAuthAPI

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

456+ let authRequest = mkAuthenticateReq () (\_ req -> addHeader "AuthHeader" ("cool" :: String) req)

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

457+ (left show <$> runClient (getProtected authRequest) ) `shouldReturn` Right alice

441

458

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

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

443

460

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

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

445− let getProtected = client inClientM genAuthAPI

462+ let getProtected = client genAuthAPI

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

463+ let authRequest = mkAuthenticateReq () (\_ req -> addHeader "Wrong" ("header" :: String) req)

447− Left FailureResponse{..} <- runClientM (getProtected authRequest) (ClientEnv manager baseUrl)

464+ Left (FailureResponse r) <- runClient (getProtected authRequest)

448− responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")

465+ responseStatusCode r `shouldBe` (HTTP.Status 401 "Unauthorized")

449

466

450genericClientSpec :: Spec

467genericClientSpec :: Spec

451genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWaiApp $ do

468genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWaiApp $ do

452 describe "Servant.Client.Generic" $ do

469 describe "Servant.Client.Generic" $ do

453

470

454− let GenericClient{..} = mkClient (client inClientM (Proxy :: Proxy GenericClientAPI))

471+ let GenericClient{..} = mkClient (client (Proxy :: Proxy GenericClientAPI))

455 NestedClient1{..} = mkNestedClient1 "example"

472 NestedClient1{..} = mkNestedClient1 "example"

456 NestedClient2{..} = mkNestedClient2 (Just 42)

473 NestedClient2{..} = mkNestedClient2 (Just 42)

457

474

458 it "works for top-level client inClientM function" $ \(_, baseUrl) -> do

475 it "works for top-level client inClientM function" $ \(_, baseUrl) -> do

459− (left show <$> (runClientM (getSqr (Just 5)) (ClientEnv manager baseUrl))) `shouldReturn` Right 25

476+ (left show <$> (runClient (getSqr (Just 5)))) `shouldReturn` Right 25

460

477

461 it "works for nested clients" $ \(_, baseUrl) -> do

478 it "works for nested clients" $ \(_, baseUrl) -> do

462− (left show <$> (runClientM (idChar (Just 'c')) (ClientEnv manager baseUrl))) `shouldReturn` Right 'c'

479+ (left show <$> (runClient (idChar (Just 'c')))) `shouldReturn` Right 'c'

463− (left show <$> (runClientM (getSum 3 4) (ClientEnv manager baseUrl))) `shouldReturn` Right 7

480+ (left show <$> (runClient (getSum 3 4))) `shouldReturn` Right 7

464− (left show <$> (runClientM doNothing (ClientEnv manager baseUrl))) `shouldReturn` Right ()

481+ (left show <$> (runClient doNothing )) `shouldReturn` Right ()

465

482

466-- * utils

483-- * utils

467

484