servant-client 0.18.3 → 0.19
raw patch · 9 files changed
+261/−45 lines, 9 filesdep ~basedep ~base-compatdep ~hspecnew-uploader
Dependency ranges changed: base, base-compat, hspec, servant, servant-client-core, servant-server, text, time, transformers-compat
Files
- CHANGELOG.md +31/−0
- servant-client.cabal +16/−9
- src/Servant/Client/Internal/HttpClient.hs +11/−7
- src/Servant/Client/Internal/HttpClient/Streaming.hs +3/−5
- test/Servant/BrokenSpec.hs +71/−0
- test/Servant/ClientTestUtils.hs +66/−6
- test/Servant/FailSpec.hs +3/−5
- test/Servant/GenericSpec.hs +37/−0
- test/Servant/SuccessSpec.hs +23/−13
CHANGELOG.md view
@@ -1,6 +1,37 @@ [The latest version of this document is on GitHub.](https://github.com/haskell-servant/servant/blob/master/servant-client/CHANGELOG.md) [Changelog for `servant` package contains significant entries for all core packages.](https://github.com/haskell-servant/servant/blob/master/servant/CHANGELOG.md) +Package versions follow the [Package Versioning Policy](https://pvp.haskell.org/): in A.B.C, bumps to either A or B represent major versions.++0.19+----++### Significant changes++- Drop support for GHC < 8.6.+- Support GHC 9.0 (GHC 9.2 should work as well, but isn't fully tested yet).+- Support Aeson 2 ([#1475](https://github.com/haskell-servant/servant/pull/1475)),+ which fixes a [DOS vulnerability](https://github.com/haskell/aeson/issues/864)+ related to hash collisions.+- Add `NamedRoutes` combinator, making support for records first-class in Servant+ ([#1388](https://github.com/haskell-servant/servant/pull/1388)).+- Add custom type errors for partially applied combinators+ ([#1289](https://github.com/haskell-servant/servant/pull/1289),+ [#1486](https://github.com/haskell-servant/servant/pull/1486)).+- *servant-client* / *servant-client-core* / *servant-http-streams*: Fix+ erroneous behavior, where only 2XX status codes would be considered+ successful, irrelevant of the status parameter specified by the verb+ combinator. ([#1469](https://github.com/haskell-servant/servant/pull/1469))+- *servant-client* / *servant-client-core*: Fix `Show` instance for+ `Servant.Client.Core.Request`.+- *servant-client* / *servant-client-core*: Allow passing arbitrary binary data+ in Query parameters.+ ([#1432](https://github.com/haskell-servant/servant/pull/1432)).++### Other changes++- Various version bumps.+ 0.18.3 ------
servant-client.cabal view
@@ -1,6 +1,6 @@-cabal-version: >=1.10+cabal-version: 2.2 name: servant-client-version: 0.18.3+version: 0.19 synopsis: Automatic derivation of querying functions for servant category: Servant, Web@@ -14,13 +14,14 @@ homepage: http://docs.servant.dev/ bug-reports: http://github.com/haskell-servant/servant/issues-license: BSD3+license: BSD-3-Clause license-file: LICENSE author: Servant Contributors maintainer: haskell-servant-maintainers@googlegroups.com copyright: 2014-2016 Zalora South East Asia Pte Ltd, 2016-2019 Servant Contributors build-type: Simple-tested-with: GHC ==8.0.2 || ==8.2.2 || ==8.4.4 || ==8.6.5 || ==8.8.4 || ==8.10.2 || ==9.0.1+tested-with: GHC ==8.6.5 || ==8.8.4 || ==8.10.2 || ==9.0.1+ , GHCJS ==8.6.0.1 extra-source-files: CHANGELOG.md@@ -57,8 +58,8 @@ -- Servant dependencies. -- Strict dependency on `servant-client-core` as we re-export things. build-depends:- servant == 0.18.*- , servant-client-core >= 0.18.3 && <0.18.4+ servant >= 0.18 && < 0.20+ , servant-client-core >= 0.19 && < 0.19.1 -- Other dependencies: Lower bound around what is in the latest Stackage LTS. -- Here can be exceptions if we really need features from the newer versions.@@ -72,7 +73,7 @@ , monad-control >= 1.0.2.3 && < 1.1 , semigroupoids >= 5.3.1 && < 5.4 , transformers-base >= 0.4.5.2 && < 0.5- , transformers-compat >= 0.6.2 && < 0.7+ , transformers-compat >= 0.6.2 && < 0.8 hs-source-dirs: src default-language: Haskell2010@@ -82,14 +83,18 @@ type: exitcode-stdio-1.0 ghc-options: -Wall -rtsopts -threaded "-with-rtsopts=-T -N2" default-language: Haskell2010+ if impl(ghcjs)+ buildable: False hs-source-dirs: test main-is: Spec.hs other-modules: Servant.BasicAuthSpec+ Servant.BrokenSpec Servant.ClientTestUtils Servant.ConnectionErrorSpec Servant.FailSpec Servant.GenAuthSpec+ Servant.GenericSpec Servant.HoistClientSpec Servant.StreamSpec Servant.SuccessSpec@@ -123,8 +128,8 @@ , HUnit >= 1.6.0.0 && < 1.7 , network >= 2.8.0.0 && < 3.2 , QuickCheck >= 2.12.6.1 && < 2.15- , servant == 0.18.*- , servant-server == 0.18.*+ , servant == 0.19.*+ , servant-server == 0.19.* , tdigest >= 0.2 && < 0.3 build-tool-depends:@@ -137,3 +142,5 @@ build-tool-depends: markdown-unlit:markdown-unlit ghc-options: -pgmL markdown-unlit default-language: Haskell2010+ if impl(ghcjs)+ buildable: False
src/Servant/Client/Internal/HttpClient.hs view
@@ -46,15 +46,13 @@ import Data.Either (either) import Data.Foldable- (toList)+ (foldl',toList) import Data.Functor.Alt (Alt (..)) import Data.Maybe (maybe, maybeToList) import Data.Proxy (Proxy (..))-import Data.Semigroup- ((<>)) import Data.Sequence (fromList) import Data.String@@ -65,7 +63,7 @@ import Network.HTTP.Media (renderHeader) import Network.HTTP.Types- (hContentType, renderQuery, statusCode, Status)+ (hContentType, renderQuery, statusIsSuccessful, urlEncode, Status) import Servant.Client.Core import qualified Network.HTTP.Client as Client@@ -181,10 +179,9 @@ response <- maybe (requestWithoutCookieJar m request) (requestWithCookieJar m request) cookieJar' let status = Client.responseStatus response- status_code = statusCode status ourResponse = clientResponseToResponse id response goodStatus = case acceptStatus of- Nothing -> status_code >= 200 && status_code < 300+ Nothing -> statusIsSuccessful status Just good -> status `elem` good unless goodStatus $ do throwError $ mkFailureResponse burl req ourResponse@@ -240,7 +237,7 @@ , Client.path = BSL.toStrict $ fromString (baseUrlPath burl) <> toLazyByteString (requestPath r)- , Client.queryString = renderQuery True . toList $ requestQueryString r+ , Client.queryString = buildQueryString . toList $ requestQueryString r , Client.requestHeaders = maybeToList acceptHdr ++ maybeToList contentTypeHdr ++ headers , Client.requestBody = body@@ -290,6 +287,13 @@ isSecure = case baseUrlScheme burl of Http -> False Https -> True++ -- Query string builder which does not do any encoding+ buildQueryString = ("?" <>) . foldl' addQueryParam mempty++ addQueryParam qs (k, v) =+ qs <> (if BS.null qs then mempty else "&") <> urlEncode True k <> foldMap ("=" <>) v+ catchConnectionError :: IO a -> IO (Either ClientError a) catchConnectionError action =
src/Servant/Client/Internal/HttpClient/Streaming.hs view
@@ -47,7 +47,7 @@ (getCurrentTime) import GHC.Generics import Network.HTTP.Types- (Status, statusCode)+ (Status, statusIsSuccessful) import qualified Network.HTTP.Client as Client @@ -163,10 +163,9 @@ now' <- getCurrentTime atomically $ modifyTVar' cj (fst . Client.updateCookieJar response request now') let status = Client.responseStatus response- status_code = statusCode status ourResponse = clientResponseToResponse id response goodStatus = case acceptStatus of- Nothing -> status_code >= 200 && status_code < 300+ Nothing -> statusIsSuccessful status Just good -> status `elem` good unless goodStatus $ do throwError $ mkFailureResponse burl req ourResponse@@ -182,10 +181,9 @@ ClientM $ lift $ lift $ Codensity $ \k1 -> Client.withResponse request m $ \res -> do let status = Client.responseStatus res- status_code = statusCode status -- we throw FailureResponse in IO :(- unless (status_code >= 200 && status_code < 300) $ do+ unless (statusIsSuccessful status) $ do b <- BSL.fromChunks <$> Client.brConsume (Client.responseBody res) throwIO $ mkFailureResponse burl req (clientResponseToResponse (const b) res)
+ test/Servant/BrokenSpec.hs view
@@ -0,0 +1,71 @@+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE TypeOperators #-}+{-# OPTIONS_GHC -freduction-depth=100 #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++module Servant.BrokenSpec (spec) where++import Prelude ()+import Prelude.Compat++import Data.Monoid ()+import Data.Proxy+import qualified Network.HTTP.Types as HTTP+import Test.Hspec++import Servant.API+ ((:<|>) ((:<|>)), (:>), JSON, Verb, Get, StdMethod (GET))+import Servant.Client+import Servant.ClientTestUtils+import Servant.Server++-- * api for testing inconsistencies between client and server++type Get201 = Verb 'GET 201+type Get301 = Verb 'GET 301++type BrokenAPI =+ -- the server should respond with 200, but returns 201+ "get200" :> Get201 '[JSON] ()+ -- the server should respond with 307, but returns 301+ :<|> "get307" :> Get301 '[JSON] ()++brokenApi :: Proxy BrokenAPI+brokenApi = Proxy++brokenServer :: Application+brokenServer = serve brokenApi (pure () :<|> pure ())++type PublicAPI =+ -- the client expects 200+ "get200" :> Get '[JSON] ()+ -- the client expects 307+ :<|> "get307" :> Get307 '[JSON] ()++publicApi :: Proxy PublicAPI+publicApi = Proxy++get200Client :: ClientM ()+get307Client :: ClientM ()+get200Client :<|> get307Client = client publicApi+++spec :: Spec+spec = describe "Servant.BrokenSpec" $ do+ brokenSpec++brokenSpec :: Spec+brokenSpec = beforeAll (startWaiApp brokenServer) $ afterAll endWaiApp $ do+ context "client returns errors for inconsistencies between client and server api" $ do+ it "reports FailureResponse with wrong 2xx status code" $ \(_, baseUrl) -> do+ res <- runClient get200Client baseUrl+ case res of+ Left (FailureResponse _ r) | responseStatusCode r == HTTP.status201 -> return ()+ _ -> fail $ "expected 201 broken response, but got " <> show res++ it "reports FailureResponse with wrong 3xx status code" $ \(_, baseUrl) -> do+ res <- runClient get307Client baseUrl+ case res of+ Left (FailureResponse _ r) | responseStatusCode r == HTTP.status301 -> return ()+ _ -> fail $ "expected 301 broken response, but got " <> show res
test/Servant/ClientTestUtils.hs view
@@ -24,9 +24,15 @@ import Control.Concurrent (ThreadId, forkIO, killThread)+import Control.Monad+ (join) import Control.Monad.Error.Class (throwError) import Data.Aeson+import Data.ByteString+ (ByteString)+import Data.ByteString.Builder+ (byteString) import qualified Data.ByteString.Lazy as LazyByteString import Data.Char (chr, isPrint)@@ -54,11 +60,12 @@ import Servant.API ((:<|>) ((:<|>)), (:>), AuthProtect, BasicAuth, BasicAuthData (..), Capture, CaptureAll, DeleteNoContent,- EmptyAPI, FormUrlEncoded, Fragment, Get, Header, Headers,+ EmptyAPI, FormUrlEncoded, Fragment, FromHttpApiData (..), Get, Header, Headers, JSON, MimeRender (mimeRender), MimeUnrender (mimeUnrender), NoContent (NoContent), PlainText, Post, QueryFlag, QueryParam,- QueryParams, Raw, ReqBody, StdMethod (GET), UVerb, Union,- WithStatus (WithStatus), addHeader)+ QueryParams, Raw, ReqBody, StdMethod (GET), ToHttpApiData (..), UVerb, Union,+ Verb, WithStatus (WithStatus), NamedRoutes, addHeader)+import Servant.API.Generic ((:-)) import Servant.Client import qualified Servant.Client.Core.Auth as Auth import Servant.Server@@ -101,14 +108,35 @@ type TestHeaders = '[Header "X-Example1" Int, Header "X-Example2" String] +data RecordRoutes mode = RecordRoutes+ { version :: mode :- "version" :> Get '[JSON] Int+ , echo :: mode :- "echo" :> Capture "string" String :> Get '[JSON] String+ , otherRoutes :: mode :- "other" :> Capture "someParam" Int :> NamedRoutes OtherRoutes+ } deriving Generic++data OtherRoutes mode = OtherRoutes+ { something :: mode :- "something" :> Get '[JSON] [String]+ } deriving Generic++-- Get for HTTP 307 Temporary Redirect+type Get307 = Verb 'GET 307+ type Api = Get '[JSON] Person :<|> "get" :> Get '[JSON] Person+ -- This endpoint returns a response with status code 307 Temporary Redirect,+ -- different from the ones in the 2xx successful class, to test derivation+ -- of clients' api.+ :<|> "get307" :> Get307 '[PlainText] Text :<|> "deleteEmpty" :> DeleteNoContent :<|> "capture" :> Capture "name" String :> Get '[JSON,FormUrlEncoded] Person :<|> "captureAll" :> CaptureAll "names" String :> Get '[JSON] [Person] :<|> "body" :> ReqBody '[FormUrlEncoded,JSON] Person :> Post '[JSON] Person :<|> "param" :> QueryParam "name" String :> Get '[FormUrlEncoded,JSON] Person+ -- This endpoint makes use of a 'Raw' server because it is not currently+ -- possible to handle arbitrary binary query param values with+ -- @servant-server@+ :<|> "param-binary" :> QueryParam "payload" UrlEncodedByteString :> Raw :<|> "params" :> QueryParams "names" String :> Get '[JSON] [Person] :<|> "flag" :> QueryFlag "flag" :> Get '[JSON] Bool :<|> "fragment" :> Fragment String :> Get '[JSON] Person@@ -131,18 +159,20 @@ UVerb 'GET '[PlainText] '[WithStatus 200 Person, WithStatus 301 Text] :<|> "uverb-get-created" :> UVerb 'GET '[PlainText] '[WithStatus 201 Person]-+ :<|> NamedRoutes RecordRoutes api :: Proxy Api api = Proxy getRoot :: ClientM Person getGet :: ClientM Person+getGet307 :: ClientM Text getDeleteEmpty :: ClientM NoContent getCapture :: String -> ClientM Person getCaptureAll :: [String] -> ClientM [Person] getBody :: Person -> ClientM Person getQueryParam :: Maybe String -> ClientM Person+getQueryParamBinary :: Maybe UrlEncodedByteString -> HTTP.Method -> ClientM Response getQueryParams :: [String] -> ClientM [Person] getQueryFlag :: Bool -> ClientM Bool getFragment :: ClientM Person@@ -159,14 +189,17 @@ -> ClientM (Union '[WithStatus 200 Person, WithStatus 301 Text]) uverbGetCreated :: ClientM (Union '[WithStatus 201 Person])+recordRoutes :: RecordRoutes (AsClientT ClientM) getRoot :<|> getGet+ :<|> getGet307 :<|> getDeleteEmpty :<|> getCapture :<|> getCaptureAll :<|> getBody :<|> getQueryParam+ :<|> getQueryParamBinary :<|> getQueryParams :<|> getQueryFlag :<|> getFragment@@ -180,12 +213,14 @@ :<|> getRedirectWithCookie :<|> EmptyClient :<|> uverbGetSuccessOrRedirect- :<|> uverbGetCreated = client api+ :<|> uverbGetCreated+ :<|> recordRoutes = client api server :: Application server = serve api ( return carol :<|> return alice+ :<|> return "redirecting" :<|> return NoContent :<|> (\ name -> return $ Person name 0) :<|> (\ names -> return (zipWith Person names [0..]))@@ -194,6 +229,13 @@ Just "alice" -> return alice Just n -> throwError $ ServerError 400 (n ++ " not found") "" [] Nothing -> throwError $ ServerError 400 "missing parameter" "" [])+ :<|> const (Tagged $ \request respond ->+ respond . maybe (Wai.responseLBS HTTP.notFound404 [] "Missing: payload")+ (Wai.responseLBS HTTP.ok200 [] . LazyByteString.fromStrict)+ . join+ . lookup "payload"+ $ Wai.queryString request+ ) :<|> (\ names -> return (zipWith Person names [0..])) :<|> return :<|> return alice@@ -210,8 +252,17 @@ then respond (WithStatus @301 ("redirecting" :: Text)) else respond (WithStatus @200 alice )) :<|> respond (WithStatus @201 carol)+ :<|> RecordRoutes+ { version = pure 42+ , echo = pure+ , otherRoutes = \_ -> OtherRoutes+ { something = pure ["foo", "bar", "pweet"]+ }+ } ) +-- * api for testing failures+ type FailApi = "get" :> Raw :<|> "capture" :> Capture "name" String :> Raw@@ -226,7 +277,7 @@ :<|> (\ _capture -> Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/json")] "") :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "fooooo")] "") :<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/x-www-form-urlencoded"), ("X-Example1", "1"), ("X-Example2", "foo")] "")- )+ ) -- * basic auth stuff @@ -310,3 +361,12 @@ filter (not . (`elem` ("?%[]/#;" :: String))) $ filter isPrint $ map chr [0..127]++newtype UrlEncodedByteString = UrlEncodedByteString { unUrlEncodedByteString :: ByteString }++instance ToHttpApiData UrlEncodedByteString where+ toEncodedUrlPiece = byteString . HTTP.urlEncode True . unUrlEncodedByteString+ toUrlPiece = decodeUtf8 . HTTP.urlEncode True . unUrlEncodedByteString++instance FromHttpApiData UrlEncodedByteString where+ parseUrlPiece = pure . UrlEncodedByteString . HTTP.urlDecode True . encodeUtf8
test/Servant/FailSpec.hs view
@@ -21,8 +21,6 @@ import Prelude.Compat import Data.Monoid ()-import Data.Semigroup- ((<>)) import qualified Network.HTTP.Types as HTTP import Test.Hspec @@ -40,14 +38,14 @@ context "client returns errors appropriately" $ do it "reports FailureResponse" $ \(_, baseUrl) -> do- let (_ :<|> _ :<|> getDeleteEmpty :<|> _) = client api+ let (_ :<|> _ :<|> _ :<|> getDeleteEmpty :<|> _) = client api Left res <- runClient getDeleteEmpty baseUrl case res of FailureResponse _ r | responseStatusCode r == HTTP.status404 -> return () _ -> fail $ "expected 404 response, but got " <> show res it "reports DecodeFailure" $ \(_, baseUrl) -> do- let (_ :<|> _ :<|> _ :<|> getCapture :<|> _) = client api+ let (_ :<|> _ :<|> _ :<|> _ :<|> getCapture :<|> _) = client api Left res <- runClient (getCapture "foo") baseUrl case res of DecodeFailure _ _ -> return ()@@ -74,7 +72,7 @@ _ -> fail $ "expected UnsupportedContentType, but got " <> show res it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do- let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api+ let (_ :<|> _ :<|> _ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api Left res <- runClient (getBody alice) baseUrl case res of InvalidContentTypeHeader _ -> return ()
+ test/Servant/GenericSpec.hs view
@@ -0,0 +1,37 @@+{-# LANGUAGE CPP #-}+{-# LANGUAGE ConstraintKinds #-}+{-# LANGUAGE DataKinds #-}+{-# LANGUAGE FlexibleContexts #-}+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE MultiParamTypeClasses #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE PolyKinds #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE TypeOperators #-}+{-# LANGUAGE UndecidableInstances #-}+{-# OPTIONS_GHC -freduction-depth=100 #-}+{-# OPTIONS_GHC -fno-warn-orphans #-}+{-# OPTIONS_GHC -fno-warn-name-shadowing #-}++module Servant.GenericSpec (spec) where++import Test.Hspec++import Servant.Client ((//), (/:))+import Servant.ClientTestUtils++spec :: Spec+spec = describe "Servant.GenericSpec" $ do+ genericSpec++genericSpec :: Spec+genericSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do+ context "Record clients work as expected" $ do++ it "Client functions return expected values" $ \(_,baseUrl) -> do+ runClient (recordRoutes // version) baseUrl `shouldReturn` Right 42+ runClient (recordRoutes // echo /: "foo") baseUrl `shouldReturn` Right "foo"+ it "Clients can be nested" $ \(_,baseUrl) -> do+ runClient (recordRoutes // otherRoutes /: 42 // something) baseUrl `shouldReturn` Right ["foo", "bar", "pweet"]
test/Servant/SuccessSpec.hs view
@@ -22,17 +22,18 @@ import Prelude.Compat import Control.Arrow- (left)+ ((+++), left) import Control.Concurrent.STM (atomically) import Control.Concurrent.STM.TVar (newTVar, readTVar)+import qualified Data.ByteString as BS+import qualified Data.ByteString.Lazy as BL import Data.Foldable (forM_, toList) import Data.Maybe (listToMaybe) import Data.Monoid ()-import Data.SOP (NS (..), I (..)) import Data.Text (Text) import qualified Network.HTTP.Client as C@@ -43,11 +44,9 @@ import Test.QuickCheck import Servant.API- (NoContent (NoContent), WithStatus (WithStatus), getHeaders)+ (NoContent (NoContent), WithStatus (WithStatus), getHeaders, Headers(..)) import Servant.Client import qualified Servant.Client.Core.Request as Req-import Servant.Client.Internal.HttpClient- (defaultMakeClientRequest) import Servant.ClientTestUtils import Servant.Test.ComprehensiveAPI @@ -60,12 +59,16 @@ successSpec :: Spec successSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do- it "Servant.API.Get root" $ \(_, baseUrl) -> do- left show <$> runClient getRoot baseUrl `shouldReturn` Right carol+ describe "Servant.API.Get" $ do+ it "get root endpoint" $ \(_, baseUrl) -> do+ left show <$> runClient getRoot baseUrl `shouldReturn` Right carol - it "Servant.API.Get" $ \(_, baseUrl) -> do- left show <$> runClient getGet baseUrl `shouldReturn` Right alice+ it "get simple endpoint" $ \(_, baseUrl) -> do+ left show <$> runClient getGet baseUrl `shouldReturn` Right alice + it "get redirection endpoint" $ \(_, baseUrl) -> do+ left show <$> runClient getGet307 baseUrl `shouldReturn` Right "redirecting"+ describe "Servant.API.Delete" $ do it "allows empty content type" $ \(_, baseUrl) -> do left show <$> runClient getDeleteEmpty baseUrl `shouldReturn` Right NoContent@@ -96,6 +99,11 @@ Left (FailureResponse _ r) <- runClient (getQueryParam (Just "bob")) baseUrl responseStatusCode r `shouldBe` HTTP.Status 400 "bob not found" + it "Servant.API.QueryParam binary data" $ \(_, baseUrl) -> do+ let payload = BS.pack [0, 1, 2, 4, 8, 16, 32, 64, 128]+ apiCall = getQueryParamBinary (Just $ UrlEncodedByteString payload) HTTP.methodGet+ (show +++ responseBody) <$> runClient apiCall baseUrl `shouldReturn` Right (BL.fromStrict payload)+ it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do left show <$> runClient (getQueryParams []) baseUrl `shouldReturn` Right [] left show <$> runClient (getQueryParams ["alice", "bob"]) baseUrl@@ -107,6 +115,7 @@ it "Servant.API.Fragment" $ \(_, baseUrl) -> do left id <$> runClient getFragment baseUrl `shouldReturn` Right alice+ it "Servant.API.Raw on success" $ \(_, baseUrl) -> do res <- runClient (getRawSuccess HTTP.methodGet) baseUrl case res of@@ -134,9 +143,10 @@ res <- runClient getUVerbRespHeaders baseUrl case res of Left e -> assertFailure $ show e- Right (Z (I (WithStatus val))) ->- getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]- Right (S _) -> assertFailure "expected first alternative of union"+ Right val -> case matchUnion val of+ Just (WithStatus val' :: WithStatus 200 (Headers TestHeaders Bool))+ -> getHeaders val' `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]+ Nothing -> assertFailure "unexpected alternative of union" it "Stores Cookie in CookieJar after a redirect" $ \(_, baseUrl) -> do mgr <- C.newManager C.defaultManagerSettings@@ -151,7 +161,7 @@ -- In proper situation, extra headers should probably be visible in API type. -- However, testing for response timeout is difficult, so we test with something which is easy to observe let createClientRequest url r = (defaultMakeClientRequest url r) { C.requestHeaders = [("X-Added-Header", "XXX")] }- let clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest }+ clientEnv = (mkClientEnv mgr baseUrl) { makeClientRequest = createClientRequest } res <- runClientM (getRawSuccessPassHeaders HTTP.methodGet) clientEnv case res of Left e ->