eeva/servant
1
0
Fork 0
Code Issues Pull requests Projects Releases Wiki Activity

Fix some tests

Browse source
This commit is contained in:
Julian K. Arni 2017-09-12 12:38:52 -04:00
parent 6995e39427
commit 75ea91c34d
10 changed files with 173 additions and 137 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

5
servant-client-core/README.md Normal file
View file

@ -0,0 +1,5 @@
# servant-client-core
![servant](https://raw.githubusercontent.com/haskell-servant/servant/master/servant.png)
HTTP-client-agnostic client functions for servant APIs.

2
servant-client-core/servant-client-core.cabal
View file

@ -65,5 +65,3 @@ test-suite spec
, QuickCheck >= 2.7 && < 2.10
other-modules:
Servant.Client.Core.Internal.BaseUrlSpec
build-depends:
base == 4.*

24
servant-client-core/src/Servant/Client/Core.hs
View file

@ -19,7 +19,7 @@
module Servant.Client.Core
( AuthClientData
, AuthenticateReq(..)
, client
, clientIn
, HasClient(..)
, mkAuthenticateReq
, ServantError(..)
@ -29,6 +29,15 @@ module Servant.Client.Core
, Response(..)
, RequestBody(..)
, module Servant.Client.Core.Internal.BaseUrl
, ClientLike(..)
, genericMkClientL
, genericMkClientP
-- * Writing instances
, addHeader
, appendToQueryString
, appendToPath
, setRequestBodyLBS
, setRequestBody
) where
import Control.Monad.Error.Class (throwError)
@ -67,10 +76,15 @@ import Servant.API ((:<|>) ((:<|>)), (:>),
import Servant.API.ContentTypes (contentTypes)
import Servant.Client.Core.Internal.Auth
import Servant.Client.Core.Internal.BaseUrl
import Servant.Client.Core.Internal.BaseUrl (BaseUrl (..),
InvalidBaseUrlException,
Scheme (..),
parseBaseUrl,
showBaseUrl)
import Servant.Client.Core.Internal.BasicAuth
import Servant.Client.Core.Internal.Class
import Servant.Client.Core.Internal.Request
import Servant.Client.Core.Internal.Generic
-- * Accessing APIs as a Client
@ -88,9 +102,9 @@ import Servant.Client.Core.Internal.Request
-- >
-- > getAllBooks :: ClientM [Book]
-- > postNewBook :: Book -> ClientM Book
-- > (getAllBooks :<|> postNewBook) = client clientM myApi
client :: HasClient m api => Proxy m -> Proxy api -> Client m api
client pm p = clientWithRoute pm p defaultRequest
-- > (getAllBooks :<|> postNewBook) = myApi `clientIn` clientM
clientIn :: HasClient m api => Proxy api -> Proxy m -> Client m api
clientIn p pm = clientWithRoute pm p defaultRequest
-- | This class lets us define how each API combinator

2
servant-client-core/src/Servant/Client/Core/Internal/Auth.hs
View file

@ -1,6 +1,6 @@
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeSynonymInstances #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeSynonymInstances #-}
-- | Authentication for clients

10
servant-client-core/src/Servant/Client/Core/Internal/BaseUrl.hs
View file

@ -1,15 +1,7 @@
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE ViewPatterns #-}
module Servant.Client.Core.Internal.BaseUrl (
-- * types
BaseUrl (..)
, InvalidBaseUrlException
, Scheme (..)
-- * functions
, parseBaseUrl
, showBaseUrl
) where
module Servant.Client.Core.Internal.BaseUrl where
import Control.Monad.Catch (Exception, MonadThrow, throwM)
import Data.List

6
servant-client-core/src/Servant/Client/Core/Internal/Generic.hs
View file

@ -10,11 +10,7 @@
#include "overlapping-compat.h"
module Servant.Client.Core.Internal.Generic
( ClientLike(..)
, genericMkClientL
, genericMkClientP
) where
module Servant.Client.Core.Internal.Generic where
import Generics.SOP (Code, Generic, I(..), NP(..), NS(Z), SOP(..), to)
import Servant.API ((:<|>)(..))

6
servant-client/servant-client.cabal
View file

@ -12,7 +12,7 @@ license: BSD3
license-file: LICENSE
author: Servant Contributors
maintainer: haskell-servant-maintainers@googlegroups.com
copyright: 2014-2016 Zalora South East Asia Pte Ltd, Servant Contributors
copyright: 2014-2017 Zalora South East Asia Pte Ltd, Servant Contributors
category: Servant, Web
build-type: Simple
cabal-version: >=1.10
@ -29,7 +29,8 @@ source-repository head
library
exposed-modules:
Servant.Client.HttpClient
Servant.Client
Servant.Client.Internal.HttpClient
build-depends:
base >= 4.7 && < 4.11
, base-compat >= 0.9.1 && < 0.10
@ -67,7 +68,6 @@ test-suite spec
main-is: Spec.hs
other-modules:
Servant.ClientSpec
, Servant.Common.BaseUrlSpec
build-depends:
base == 4.*
, aeson

10
servant-client/src/Servant/Client.hs Normal file
View file

@ -0,0 +1,10 @@
module Servant.Client
( ClientEnv(..)
, ClientM
, runClientM
, client
, module X
) where
import Servant.Client.Internal.HttpClient
import Servant.Client.Core as X

6
servant-client/src/Servant/Client/HttpClient.hs → servant-client/src/Servant/Client/Internal/HttpClient.hs
View file

@ -1,6 +1,7 @@
{-# LANGUAGE CPP #-}
{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE MultiParamTypeClasses #-}
@ -9,7 +10,7 @@
{-# LANGUAGE TypeFamilies #-}
{-| http-client based client requests executor -}
module Servant.Client.HttpClient where
module Servant.Client.Internal.HttpClient where
import Prelude ()
@ -28,6 +29,7 @@ import qualified Data.ByteString.Lazy as BSL
import Data.Foldable (toList)
import Data.Functor.Alt (Alt (..))
import Data.Monoid ((<>))
import Data.Proxy (Proxy (..))
import Data.String (fromString)
import qualified Data.Text as T
import GHC.Exts (fromList)
@ -45,6 +47,8 @@ data ClientEnv
, baseUrl :: BaseUrl
}
client :: HasClient ClientM api => Proxy api -> Client ClientM api
client api = api `clientIn` (Proxy :: Proxy ClientM)
-- | @ClientM@ is the monad in which client functions run. Contains the
-- 'Manager' and 'BaseUrl' used for requests in the reader environment.

205
servant-client/test/Servant/ClientSpec.hs
View file

@ -27,7 +27,8 @@
module Servant.ClientSpec where
import Control.Arrow (left)
import Control.Concurrent (forkIO, killThread, ThreadId)
import Control.Concurrent (ThreadId, forkIO,
killThread)
import Control.Exception (bracket)
import Control.Monad.Error.Class (throwError)
import Data.Aeson
@ -42,28 +43,42 @@ import qualified Network.HTTP.Client as C
import Network.HTTP.Media
import qualified Network.HTTP.Types as HTTP
import Network.Socket
import Network.Wai (Request, requestHeaders, responseLBS)
import qualified Network.Wai as Wai
import Network.Wai.Handler.Warp
import Prelude ()
import Prelude.Compat
import System.IO.Unsafe (unsafePerformIO)
import Test.HUnit
import Test.Hspec
import Test.Hspec.QuickCheck
import Test.HUnit
import Test.QuickCheck
import Web.FormUrlEncoded (FromForm, ToForm)
import Servant.API
import Servant.API ((:<|>) ((:<|>)),
(:>), AuthProtect,
BasicAuth,
BasicAuthData (..),
Capture,
CaptureAll, Delete,
DeleteNoContent,
EmptyAPI,
FormUrlEncoded,
Get, Header,
Headers, JSON,
NoContent, Post,
Put, QueryFlag,
QueryParam,
QueryParams,
ReqBody)
import Servant.API.Internal.Test.ComprehensiveAPI
import Servant.Client
import Servant.Client.Generic
import qualified Servant.Common.Req as SCR
import qualified Servant.Client.HttpClient as SCR
{-import qualified Servant.Common.Req as SCR-}
{-import qualified Servant.Client.HttpClient as SCR-}
import Servant.Server
import Servant.Server.Experimental.Auth
-- This declaration simply checks that all instances are in place.
_ = client inClientM comprehensiveAPI
_ = client comprehensiveAPI
spec :: Spec
spec = describe "Servant.Client" $ do
@ -76,17 +91,16 @@ spec = describe "Servant.Client" $ do
-- * test data types
data Person = Person {
name :: String,
age :: Integer
}
deriving (Eq, Show, Generic)
data Person = Person
{ name :: String
, age :: Integer
} deriving (Eq, Show, Generic)
instance ToJSON Person
instance FromJSON Person
instance ToForm Person where
instance FromForm Person where
instance ToForm Person
instance FromForm Person
alice :: Person
alice = Person "Alice" 42
@ -117,22 +131,22 @@ type Api =
api :: Proxy Api
api = Proxy
getGet :: SCR.ClientM Person
getDeleteEmpty :: SCR.ClientM NoContent
getCapture :: String -> SCR.ClientM Person
getCaptureAll :: [String] -> SCR.ClientM [Person]
getBody :: Person -> SCR.ClientM Person
getQueryParam :: Maybe String -> SCR.ClientM Person
getQueryParams :: [String] -> SCR.ClientM [Person]
getQueryFlag :: Bool -> SCR.ClientM Bool
getGet :: ClientM Person
getDeleteEmpty :: ClientM NoContent
getCapture :: String -> ClientM Person
getCaptureAll :: [String] -> ClientM [Person]
getBody :: Person -> ClientM Person
getQueryParam :: Maybe String -> ClientM Person
getQueryParams :: [String] -> ClientM [Person]
getQueryFlag :: Bool -> ClientM Bool
getRawSuccess :: HTTP.Method
-> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
-> ClientM Response
getRawFailure :: HTTP.Method
-> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
-> ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)
getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])]
-> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])
getRespHeaders :: SCR.ClientM (Headers TestHeaders Bool)
getDeleteContentType :: SCR.ClientM NoContent
-> ClientM (String, Maybe Int, Bool, [(String, [Rational])])
getRespHeaders :: ClientM (Headers TestHeaders Bool)
getDeleteContentType :: ClientM NoContent
getGet
:<|> getDeleteEmpty
@ -147,7 +161,7 @@ getGet
:<|> getMultiple
:<|> getRespHeaders
:<|> getDeleteContentType
:<|> EmptyClient = client inClientM api
:<|> EmptyClient = client api
server :: Application
server = serve api (
@ -162,8 +176,8 @@ server = serve api (
Nothing -> throwError $ ServantErr 400 "missing parameter" "" [])
:<|> (\ names -> return (zipWith Person names [0..]))
:<|> return
:<|> (Tagged $ \ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess")
:<|> (Tagged $ \ _request respond -> respond $ responseLBS HTTP.badRequest400 [] "rawFailure")
:<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "rawSuccess")
:<|> (Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.badRequest400 [] "rawFailure")
:<|> (\ a b c d -> return (a, b, c, d))
:<|> (return $ addHeader 1729 $ addHeader "eg2" True)
:<|> return NoContent
@ -179,9 +193,9 @@ failApi = Proxy
failServer :: Application
failServer = serve failApi (
(Tagged $ \ _request respond -> respond $ responseLBS HTTP.ok200 [] "")
:<|> (\ _capture -> Tagged $ \_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "application/json")] "")
:<|> (Tagged $ \_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
(Tagged $ \ _request respond -> respond $ Wai.responseLBS HTTP.ok200 [] "")
:<|> (\ _capture -> Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "application/json")] "")
:<|> (Tagged $ \_request respond -> respond $ Wai.responseLBS HTTP.ok200 [("content-type", "fooooo")] "")
)
-- * basic auth stuff
@ -237,7 +251,7 @@ type GenericClientAPI
:<|> Capture "foo" String :> NestedAPI1
data GenericClient = GenericClient
{ getSqr :: Maybe Int -> SCR.ClientM Int
{ getSqr :: Maybe Int -> ClientM Int
, mkNestedClient1 :: String -> NestedClient1
} deriving Generic
instance SOP.Generic GenericClient
@ -249,7 +263,7 @@ type NestedAPI1
data NestedClient1 = NestedClient1
{ mkNestedClient2 :: Maybe Int -> NestedClient2
, idChar :: Maybe Char -> SCR.ClientM Char
, idChar :: Maybe Char -> ClientM Char
} deriving Generic
instance SOP.Generic NestedClient1
instance (Client ClientM NestedAPI1 ~ client) => ClientLike client NestedClient1
@ -259,8 +273,8 @@ type NestedAPI2
:<|> "void" :> Post '[JSON] ()
data NestedClient2 = NestedClient2
{ getSum :: Int -> Int -> SCR.ClientM Int
, doNothing :: SCR.ClientM ()
{ getSum :: Int -> Int -> ClientM Int
, doNothing :: ClientM ()
} deriving Generic
instance SOP.Generic NestedClient2
instance (Client ClientM NestedAPI2 ~ client) => ClientLike client NestedClient2
@ -277,50 +291,52 @@ genericClientServer = serve (Proxy :: Proxy GenericClientAPI) (
nestedServer1 _str = nestedServer2 :<|> (maybe (throwError $ ServantErr 400 "missing parameter" "" []) return)
nestedServer2 _int = (\ x y -> return (x + y)) :<|> return ()
{-# NOINLINE manager #-}
manager :: C.Manager
manager = unsafePerformIO $ C.newManager C.defaultManagerSettings
{-# NOINLINE manager' #-}
manager' :: C.Manager
manager' = unsafePerformIO $ C.newManager C.defaultManagerSettings
runClient x = runClientM x (ClientEnv manager' baseUrl)
sucessSpec :: Spec
sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
it "Servant.API.Get" $ \(_, baseUrl) -> do
(left show <$> (runClientM getGet (ClientEnv manager baseUrl))) `shouldReturn` Right alice
(left show <$> runClient getGet) `shouldReturn` Right alice
describe "Servant.API.Delete" $ do
it "allows empty content type" $ \(_, baseUrl) -> do
(left show <$> (runClientM getDeleteEmpty (ClientEnv manager baseUrl))) `shouldReturn` Right NoContent
(left show <$> (runClient getDeleteEmpty)) `shouldReturn` Right NoContent
it "allows content type" $ \(_, baseUrl) -> do
(left show <$> (runClientM getDeleteContentType (ClientEnv manager baseUrl))) `shouldReturn` Right NoContent
(left show <$> (runClient getDeleteContentType)) `shouldReturn` Right NoContent
it "Servant.API.Capture" $ \(_, baseUrl) -> do
(left show <$> (runClientM (getCapture "Paula") (ClientEnv manager baseUrl))) `shouldReturn` Right (Person "Paula" 0)
(left show <$> (runClient (getCapture "Paula"))) `shouldReturn` Right (Person "Paula" 0)
it "Servant.API.CaptureAll" $ \(_, baseUrl) -> do
let expected = [(Person "Paula" 0), (Person "Peta" 1)]
(left show <$> (runClientM (getCaptureAll ["Paula", "Peta"]) (ClientEnv manager baseUrl))) `shouldReturn` Right expected
(left show <$> (runClient (getCaptureAll ["Paula", "Peta"]))) `shouldReturn` Right expected
it "Servant.API.ReqBody" $ \(_, baseUrl) -> do
let p = Person "Clara" 42
(left show <$> runClientM (getBody p) (ClientEnv manager baseUrl)) `shouldReturn` Right p
(left show <$> runClient (getBody p)) `shouldReturn` Right p
it "Servant.API.QueryParam" $ \(_, baseUrl) -> do
left show <$> runClientM (getQueryParam (Just "alice")) (ClientEnv manager baseUrl) `shouldReturn` Right alice
Left FailureResponse{..} <- runClientM (getQueryParam (Just "bob")) (ClientEnv manager baseUrl)
responseStatus `shouldBe` HTTP.Status 400 "bob not found"
left show <$> runClient (getQueryParam (Just "alice")) `shouldReturn` Right alice
Left (FailureResponse r) <- runClient (getQueryParam (Just "bob"))
responseStatusCode r `shouldBe` HTTP.Status 400 "bob not found"
it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do
(left show <$> runClientM (getQueryParams []) (ClientEnv manager baseUrl)) `shouldReturn` Right []
(left show <$> runClientM (getQueryParams ["alice", "bob"]) (ClientEnv manager baseUrl))
(left show <$> runClient (getQueryParams [])) `shouldReturn` Right []
(left show <$> runClient (getQueryParams ["alice", "bob"]))
`shouldReturn` Right [Person "alice" 0, Person "bob" 1]
context "Servant.API.QueryParam.QueryFlag" $
forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do
(left show <$> runClientM (getQueryFlag flag) (ClientEnv manager baseUrl)) `shouldReturn` Right flag
(left show <$> runClient (getQueryFlag flag)) `shouldReturn` Right flag
it "Servant.API.Raw on success" $ \(_, baseUrl) -> do
res <- runClientM (getRawSuccess HTTP.methodGet) (ClientEnv manager baseUrl)
res <- runClient (getRawSuccess HTTP.methodGet)
case res of
Left e -> assertFailure $ show e
Right (code, body, ct, _, response) -> do
@ -329,15 +345,16 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
C.responseStatus response `shouldBe` HTTP.ok200
it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do
res <- runClientM (getRawFailure HTTP.methodGet) (ClientEnv manager baseUrl)
res <- runClient (getRawFailure HTTP.methodGet)
case res of
Right _ -> assertFailure "expected Left, but got Right"
Left e -> do
Servant.Client.responseStatus e `shouldBe` HTTP.status400
Servant.Client.responseBody e `shouldBe` "rawFailure"
Left (FailureResponse r) -> do
responseStatusCode r `shouldBe` HTTP.status400
responseBody r `shouldBe` "rawFailure"
Left e -> assertFailure $ "expected FailureResponse, but got " ++ show e
it "Returns headers appropriately" $ \(_, baseUrl) -> do
res <- runClientM getRespHeaders (ClientEnv manager baseUrl)
res <- runClient getRespHeaders
case res of
Left e -> assertFailure $ show e
Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")]
@ -346,7 +363,7 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do
it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->
property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->
ioProperty $ do
result <- left show <$> runClientM (getMultiple cap num flag body) (ClientEnv manager baseUrl)
result <- left show <$> runClient (getMultiple cap num flag body)
return $
result === Right (cap, num, flag, body)
@ -358,10 +375,10 @@ wrappedApiSpec = describe "error status codes" $ do
let test :: (WrappedApi, String) -> Spec
test (WrappedApi api, desc) =
it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do
let getResponse :: SCR.ClientM ()
getResponse = client inClientM api
Left FailureResponse{..} <- runClientM getResponse (ClientEnv manager baseUrl)
responseStatus `shouldBe` (HTTP.Status 500 "error message")
let getResponse :: ClientM ()
getResponse = client api
Left (FailureResponse r) <- runClient getResponse
responseStatusCode r `shouldBe` (HTTP.Status 500 "error message")
in mapM_ test $
(WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") :
(WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :
@ -374,43 +391,43 @@ failSpec = beforeAll (startWaiApp failServer) $ afterAll endWaiApp $ do
context "client returns errors appropriately" $ do
it "reports FailureResponse" $ \(_, baseUrl) -> do
let (_ :<|> getDeleteEmpty :<|> _) = client inClientM api
Left res <- runClientM getDeleteEmpty (ClientEnv manager baseUrl)
let (_ :<|> getDeleteEmpty :<|> _) = client api
Left res <- runClient getDeleteEmpty
case res of
FailureResponse _ (HTTP.Status 404 "Not Found") _ _ -> return ()
FailureResponse r | responseStatusCode r == 404 -> return ()
_ -> fail $ "expected 404 response, but got " <> show res
it "reports DecodeFailure" $ \(_, baseUrl) -> do
let (_ :<|> _ :<|> getCapture :<|> _) = client inClientM api
Left res <- runClientM (getCapture "foo") (ClientEnv manager baseUrl)
let (_ :<|> _ :<|> getCapture :<|> _) = client api
Left res <- runClient (getCapture "foo") (ClientEnv manager baseUrl)
case res of
DecodeFailure _ ("application/json") _ -> return ()
DecodeFailure _ _ -> return ()
_ -> fail $ "expected DecodeFailure, but got " <> show res
it "reports ConnectionError" $ \_ -> do
let (getGetWrongHost :<|> _) = client inClientM api
let (getGetWrongHost :<|> _) = client api
Left res <- runClientM getGetWrongHost (ClientEnv manager (BaseUrl Http "127.0.0.1" 19872 ""))
case res of
ConnectionError _ -> return ()
_ -> fail $ "expected ConnectionError, but got " <> show res
it "reports UnsupportedContentType" $ \(_, baseUrl) -> do
let (getGet :<|> _ ) = client inClientM api
Left res <- runClientM getGet (ClientEnv manager baseUrl)
let (getGet :<|> _ ) = client api
Left res <- runClient getGet
case res of
UnsupportedContentType ("application/octet-stream") _ -> return ()
_ -> fail $ "expected UnsupportedContentType, but got " <> show res
it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do
let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client inClientM api
Left res <- runClientM (getBody alice) (ClientEnv manager baseUrl)
let (_ :<|> _ :<|> _ :<|> _ :<|> getBody :<|> _) = client api
Left res <- runClient (getBody alice)
case res of
InvalidContentTypeHeader "fooooo" _ -> return ()
InvalidContentTypeHeader _ -> return ()
_ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res
data WrappedApi where
WrappedApi :: (HasServer (api :: *) '[], Server api ~ Handler a,
HasClient ClientM api, Client ClientM api ~ SCR.ClientM ()) =>
HasClient ClientM api, Client ClientM api ~ ClientM ()) =>
Proxy api -> WrappedApi
basicAuthSpec :: Spec
@ -418,50 +435,50 @@ basicAuthSpec = beforeAll (startWaiApp basicAuthServer) $ afterAll endWaiApp $ d
context "Authentication works when requests are properly authenticated" $ do
it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
let getBasic = client inClientM basicAuthAPI
let getBasic = client basicAuthAPI
let basicAuthData = BasicAuthData "servant" "server"
(left show <$> runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)) `shouldReturn` Right alice
(left show <$> runClient (getBasic basicAuthData)) `shouldReturn` Right alice
context "Authentication is rejected when requests are not authenticated properly" $ do
it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do
let getBasic = client inClientM basicAuthAPI
let getBasic = client basicAuthAPI
let basicAuthData = BasicAuthData "not" "password"
Left FailureResponse{..} <- runClientM (getBasic basicAuthData) (ClientEnv manager baseUrl)
responseStatus `shouldBe` HTTP.Status 403 "Forbidden"
Left (FailureResponse r) <- runClient (getBasic basicAuthData)
responseStatusCode r `shouldBe` HTTP.Status 403 "Forbidden"
genAuthSpec :: Spec
genAuthSpec = beforeAll (startWaiApp genAuthServer) $ afterAll endWaiApp $ do
context "Authentication works when requests are properly authenticated" $ do
it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
let getProtected = client inClientM genAuthAPI
let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)
(left show <$> runClientM (getProtected authRequest) (ClientEnv manager baseUrl)) `shouldReturn` Right alice
let getProtected = client genAuthAPI
let authRequest = mkAuthenticateReq () (\_ req -> addHeader "AuthHeader" ("cool" :: String) req)
(left show <$> runClient (getProtected authRequest) ) `shouldReturn` Right alice
context "Authentication is rejected when requests are not authenticated properly" $ do
it "Authenticates a AuthProtect protected server appropriately" $ \(_, baseUrl) -> do
let getProtected = client inClientM genAuthAPI
let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)
Left FailureResponse{..} <- runClientM (getProtected authRequest) (ClientEnv manager baseUrl)
responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized")
let getProtected = client genAuthAPI
let authRequest = mkAuthenticateReq () (\_ req -> addHeader "Wrong" ("header" :: String) req)
Left (FailureResponse r) <- runClient (getProtected authRequest)
responseStatusCode r `shouldBe` (HTTP.Status 401 "Unauthorized")
genericClientSpec :: Spec
genericClientSpec = beforeAll (startWaiApp genericClientServer) $ afterAll endWaiApp $ do
describe "Servant.Client.Generic" $ do
let GenericClient{..} = mkClient (client inClientM (Proxy :: Proxy GenericClientAPI))
let GenericClient{..} = mkClient (client (Proxy :: Proxy GenericClientAPI))
NestedClient1{..} = mkNestedClient1 "example"
NestedClient2{..} = mkNestedClient2 (Just 42)
it "works for top-level client inClientM function" $ \(_, baseUrl) -> do
(left show <$> (runClientM (getSqr (Just 5)) (ClientEnv manager baseUrl))) `shouldReturn` Right 25
(left show <$> (runClient (getSqr (Just 5)))) `shouldReturn` Right 25
it "works for nested clients" $ \(_, baseUrl) -> do
(left show <$> (runClientM (idChar (Just 'c')) (ClientEnv manager baseUrl))) `shouldReturn` Right 'c'
(left show <$> (runClientM (getSum 3 4) (ClientEnv manager baseUrl))) `shouldReturn` Right 7
(left show <$> (runClientM doNothing (ClientEnv manager baseUrl))) `shouldReturn` Right ()
(left show <$> (runClient (idChar (Just 'c')))) `shouldReturn` Right 'c'
(left show <$> (runClient (getSum 3 4))) `shouldReturn` Right 7
(left show <$> (runClient doNothing )) `shouldReturn` Right ()
-- * utils