servant-client 0.5 → 0.6
raw patch · 4 files changed
+158/−181 lines, 4 filesdep ~servantdep ~servant-server
Dependency ranges changed: servant, servant-server
Files
- servant-client.cabal +4/−4
- src/Servant/Client.hs +61/−78
- src/Servant/Common/Req.hs +13/−12
- test/Servant/ClientSpec.hs +80/−87
servant-client.cabal view
@@ -1,5 +1,5 @@ name: servant-client-version: 0.5+version: 0.6 synopsis: automatical derivation of querying functions for servant webservices description: This library lets you derive automatically Haskell functions that@@ -45,7 +45,7 @@ , http-types , network-uri >= 2.6 , safe- , servant == 0.5.*+ , servant == 0.6.* , string-conversions , text , transformers@@ -79,9 +79,9 @@ , HUnit , network >= 2.6 , QuickCheck >= 2.7- , servant == 0.5.*+ , servant == 0.6.* , servant-client- , servant-server == 0.5.*+ , servant-server == 0.6.* , text , wai , warp
src/Servant/Client.hs view
@@ -27,14 +27,13 @@ #if !MIN_VERSION_base(4,8,0) import Control.Applicative ((<$>)) #endif-import Control.Monad.Trans.Except import Data.ByteString.Lazy (ByteString) import Data.List import Data.Proxy import Data.String.Conversions import Data.Text (unpack) import GHC.TypeLits-import Network.HTTP.Client (Response, Manager)+import Network.HTTP.Client (Manager, Response) import Network.HTTP.Media import qualified Network.HTTP.Types as H import qualified Network.HTTP.Types.Header as HTTP@@ -54,19 +53,18 @@ -- > myApi :: Proxy MyApi -- > myApi = Proxy -- >--- > getAllBooks :: ExceptT String IO [Book]--- > postNewBook :: Book -> ExceptT String IO Book--- > (getAllBooks :<|> postNewBook) = client myApi host manager--- > where host = BaseUrl Http "localhost" 8080-client :: HasClient layout => Proxy layout -> BaseUrl -> Manager -> Client layout-client p baseurl = clientWithRoute p defReq baseurl+-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]+-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book+-- > (getAllBooks :<|> postNewBook) = client myApi+client :: HasClient layout => Proxy layout -> Client layout+client p = clientWithRoute p defReq -- | This class lets us define how each API combinator -- influences the creation of an HTTP request. It's mostly -- an internal class, you can just use 'client'. class HasClient layout where type Client layout :: *- clientWithRoute :: Proxy layout -> Req -> BaseUrl -> Manager -> Client layout+ clientWithRoute :: Proxy layout -> Req -> Client layout -- | A client querying function for @a ':<|>' b@ will actually hand you@@ -79,15 +77,14 @@ -- > myApi :: Proxy MyApi -- > myApi = Proxy -- >--- > getAllBooks :: ExceptT String IO [Book]--- > postNewBook :: Book -> ExceptT String IO Book--- > (getAllBooks :<|> postNewBook) = client myApi host manager--- > where host = BaseUrl Http "localhost" 8080+-- > getAllBooks :: Manager -> BaseUrl -> ClientM [Book]+-- > postNewBook :: Book -> Manager -> BaseUrl -> ClientM Book+-- > (getAllBooks :<|> postNewBook) = client myApi instance (HasClient a, HasClient b) => HasClient (a :<|> b) where type Client (a :<|> b) = Client a :<|> Client b- clientWithRoute Proxy req baseurl manager =- clientWithRoute (Proxy :: Proxy a) req baseurl manager :<|>- clientWithRoute (Proxy :: Proxy b) req baseurl manager+ clientWithRoute Proxy req =+ clientWithRoute (Proxy :: Proxy a) req :<|>+ clientWithRoute (Proxy :: Proxy b) req -- | If you use a 'Capture' in one of your endpoints in your API, -- the corresponding querying function will automatically take@@ -105,9 +102,8 @@ -- > myApi :: Proxy MyApi -- > myApi = Proxy -- >--- > getBook :: Text -> ExceptT String IO Book--- > getBook = client myApi host manager--- > where host = BaseUrl Http "localhost" 8080+-- > getBook :: Text -> Manager -> BaseUrl -> ClientM Book+-- > getBook = client myApi -- > -- then you can just use "getBook" to query that endpoint instance (KnownSymbol capture, ToHttpApiData a, HasClient sublayout) => HasClient (Capture capture a :> sublayout) where@@ -115,11 +111,9 @@ type Client (Capture capture a :> sublayout) = a -> Client sublayout - clientWithRoute Proxy req baseurl manager val =+ clientWithRoute Proxy req val = clientWithRoute (Proxy :: Proxy sublayout) (appendToPath p req)- baseurl- manager where p = unpack (toUrlPiece val) @@ -127,16 +121,17 @@ -- Note [Non-Empty Content Types] (MimeUnrender ct a, ReflectMethod method, cts' ~ (ct ': cts) ) => HasClient (Verb method status cts' a) where- type Client (Verb method status cts' a) = ExceptT ServantError IO a- clientWithRoute Proxy req baseurl manager =- snd <$> performRequestCT (Proxy :: Proxy ct) method req baseurl manager+ type Client (Verb method status cts' a) = Manager -> BaseUrl -> ClientM a+ clientWithRoute Proxy req manager baseurl =+ snd <$> performRequestCT (Proxy :: Proxy ct) method req manager baseurl where method = reflectMethod (Proxy :: Proxy method) instance OVERLAPPING_ (ReflectMethod method) => HasClient (Verb method status cts NoContent) where- type Client (Verb method status cts NoContent) = ExceptT ServantError IO NoContent- clientWithRoute Proxy req baseurl manager =- performRequestNoBody method req baseurl manager >> return NoContent+ type Client (Verb method status cts NoContent)+ = Manager -> BaseUrl -> ClientM NoContent+ clientWithRoute Proxy req manager baseurl =+ performRequestNoBody method req manager baseurl >> return NoContent where method = reflectMethod (Proxy :: Proxy method) instance OVERLAPPING_@@ -144,10 +139,10 @@ ( MimeUnrender ct a, BuildHeadersTo ls, ReflectMethod method, cts' ~ (ct ': cts) ) => HasClient (Verb method status cts' (Headers ls a)) where type Client (Verb method status cts' (Headers ls a))- = ExceptT ServantError IO (Headers ls a)- clientWithRoute Proxy req baseurl manager = do+ = Manager -> BaseUrl -> ClientM (Headers ls a)+ clientWithRoute Proxy req manager baseurl = do let method = reflectMethod (Proxy :: Proxy method)- (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req baseurl manager+ (hdrs, resp) <- performRequestCT (Proxy :: Proxy ct) method req manager baseurl return $ Headers { getResponse = resp , getHeadersHList = buildHeadersTo hdrs }@@ -156,10 +151,10 @@ ( BuildHeadersTo ls, ReflectMethod method ) => HasClient (Verb method status cts (Headers ls NoContent)) where type Client (Verb method status cts (Headers ls NoContent))- = ExceptT ServantError IO (Headers ls NoContent)- clientWithRoute Proxy req baseurl manager = do+ = Manager -> BaseUrl -> ClientM (Headers ls NoContent)+ clientWithRoute Proxy req manager baseurl = do let method = reflectMethod (Proxy :: Proxy method)- hdrs <- performRequestNoBody method req baseurl manager+ hdrs <- performRequestNoBody method req manager baseurl return $ Headers { getResponse = NoContent , getHeadersHList = buildHeadersTo hdrs }@@ -178,7 +173,7 @@ -- Example: -- -- > newtype Referer = Referer { referrer :: Text }--- > deriving (Eq, Show, Generic, FromText, ToHttpApiData)+-- > deriving (Eq, Show, Generic, ToHttpApiData) -- > -- > -- GET /view-my-referer -- > type MyApi = "view-my-referer" :> Header "Referer" Referer :> Get '[JSON] Referer@@ -186,9 +181,8 @@ -- > myApi :: Proxy MyApi -- > myApi = Proxy -- >--- > viewReferer :: Maybe Referer -> ExceptT String IO Book--- > viewReferer = client myApi host--- > where host = BaseUrl Http "localhost" 8080+-- > viewReferer :: Maybe Referer -> Manager -> BaseUrl -> ClientM Book+-- > viewReferer = client myApi -- > -- then you can just use "viewRefer" to query that endpoint -- > -- specifying Nothing or e.g Just "http://haskell.org/" as arguments instance (KnownSymbol sym, ToHttpApiData a, HasClient sublayout)@@ -197,14 +191,12 @@ type Client (Header sym a :> sublayout) = Maybe a -> Client sublayout - clientWithRoute Proxy req baseurl manager mval =+ clientWithRoute Proxy req mval = clientWithRoute (Proxy :: Proxy sublayout) (maybe req (\value -> Servant.Common.Req.addHeader hname value req) mval )- baseurl- manager where hname = symbolVal (Proxy :: Proxy sym) @@ -239,9 +231,8 @@ -- > myApi :: Proxy MyApi -- > myApi = Proxy -- >--- > getBooksBy :: Maybe Text -> ExceptT String IO [Book]--- > getBooksBy = client myApi host--- > where host = BaseUrl Http "localhost" 8080+-- > getBooksBy :: Maybe Text -> Manager -> BaseUrl -> ClientM [Book]+-- > getBooksBy = client myApi -- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- 'getBooksBy Nothing' for all books -- > -- 'getBooksBy (Just "Isaac Asimov")' to get all books by Isaac Asimov@@ -252,14 +243,12 @@ Maybe a -> Client sublayout -- if mparam = Nothing, we don't add it to the query string- clientWithRoute Proxy req baseurl manager mparam =+ clientWithRoute Proxy req mparam = clientWithRoute (Proxy :: Proxy sublayout) (maybe req (flip (appendToQueryString pname) req . Just) mparamText )- baseurl- manager where pname = cs pname' pname' = symbolVal (Proxy :: Proxy sym)@@ -286,9 +275,8 @@ -- > myApi :: Proxy MyApi -- > myApi = Proxy -- >--- > getBooksBy :: [Text] -> ExceptT String IO [Book]--- > getBooksBy = client myApi host--- > where host = BaseUrl Http "localhost" 8080+-- > getBooksBy :: [Text] -> Manager -> BaseUrl -> ClientM [Book]+-- > getBooksBy = client myApi -- > -- then you can just use "getBooksBy" to query that endpoint. -- > -- 'getBooksBy []' for all books -- > -- 'getBooksBy ["Isaac Asimov", "Robert A. Heinlein"]'@@ -299,13 +287,12 @@ type Client (QueryParams sym a :> sublayout) = [a] -> Client sublayout - clientWithRoute Proxy req baseurl manager paramlist =+ clientWithRoute Proxy req paramlist = clientWithRoute (Proxy :: Proxy sublayout) (foldl' (\ req' -> maybe req' (flip (appendToQueryString pname) req' . Just)) req paramlist' )- baseurl manager where pname = cs pname' pname' = symbolVal (Proxy :: Proxy sym)@@ -327,9 +314,8 @@ -- > myApi :: Proxy MyApi -- > myApi = Proxy -- >--- > getBooks :: Bool -> ExceptT String IO [Book]--- > getBooks = client myApi host--- > where host = BaseUrl Http "localhost" 8080+-- > getBooks :: Bool -> Manager -> BaseUrl -> ClientM [Book]+-- > getBooks = client myApi -- > -- then you can just use "getBooks" to query that endpoint. -- > -- 'getBooksBy False' for all books -- > -- 'getBooksBy True' to only get _already published_ books@@ -339,13 +325,12 @@ type Client (QueryFlag sym :> sublayout) = Bool -> Client sublayout - clientWithRoute Proxy req baseurl manager flag =+ clientWithRoute Proxy req flag = clientWithRoute (Proxy :: Proxy sublayout) (if flag then appendToQueryString paramname Nothing req else req )- baseurl manager where paramname = cs $ symbolVal (Proxy :: Proxy sym) @@ -353,11 +338,12 @@ -- | Pick a 'Method' and specify where the server you want to query is. You get -- back the full `Response`. instance HasClient Raw where- type Client Raw = H.Method -> ExceptT ServantError IO (Int, ByteString, MediaType, [HTTP.Header], Response ByteString)+ type Client Raw+ = H.Method -> Manager -> BaseUrl -> ClientM (Int, ByteString, MediaType, [HTTP.Header], Response ByteString) - clientWithRoute :: Proxy Raw -> Req -> BaseUrl -> Manager -> Client Raw- clientWithRoute Proxy req baseurl manager httpMethod = do- performRequest httpMethod req baseurl manager+ clientWithRoute :: Proxy Raw -> Req -> Client Raw+ clientWithRoute Proxy req httpMethod = do+ performRequest httpMethod req -- | If you use a 'ReqBody' in one of your endpoints in your API, -- the corresponding querying function will automatically take@@ -374,9 +360,8 @@ -- > myApi :: Proxy MyApi -- > myApi = Proxy -- >--- > addBook :: Book -> ExceptT String IO Book--- > addBook = client myApi host manager--- > where host = BaseUrl Http "localhost" 8080+-- > addBook :: Book -> Manager -> BaseUrl -> ClientM Book+-- > addBook = client myApi -- > -- then you can just use "addBook" to query that endpoint instance (MimeRender ct a, HasClient sublayout) => HasClient (ReqBody (ct ': cts) a :> sublayout) where@@ -384,43 +369,41 @@ type Client (ReqBody (ct ': cts) a :> sublayout) = a -> Client sublayout - clientWithRoute Proxy req baseurl manager body =+ clientWithRoute Proxy req body = clientWithRoute (Proxy :: Proxy sublayout) (let ctProxy = Proxy :: Proxy ct in setRQBody (mimeRender ctProxy body) (contentType ctProxy) req )- baseurl manager -- | Make the querying function append @path@ to the request path. instance (KnownSymbol path, HasClient sublayout) => HasClient (path :> sublayout) where type Client (path :> sublayout) = Client sublayout - clientWithRoute Proxy req baseurl manager =+ clientWithRoute Proxy req = clientWithRoute (Proxy :: Proxy sublayout) (appendToPath p req)- baseurl manager where p = symbolVal (Proxy :: Proxy path) instance HasClient api => HasClient (Vault :> api) where type Client (Vault :> api) = Client api - clientWithRoute Proxy req baseurl manager =- clientWithRoute (Proxy :: Proxy api) req baseurl manager+ clientWithRoute Proxy req =+ clientWithRoute (Proxy :: Proxy api) req instance HasClient api => HasClient (RemoteHost :> api) where type Client (RemoteHost :> api) = Client api - clientWithRoute Proxy req baseurl manager =- clientWithRoute (Proxy :: Proxy api) req baseurl manager+ clientWithRoute Proxy req =+ clientWithRoute (Proxy :: Proxy api) req instance HasClient api => HasClient (IsSecure :> api) where type Client (IsSecure :> api) = Client api - clientWithRoute Proxy req baseurl manager =- clientWithRoute (Proxy :: Proxy api) req baseurl manager+ clientWithRoute Proxy req =+ clientWithRoute (Proxy :: Proxy api) req instance HasClient subapi => HasClient (WithNamedContext name context subapi) where@@ -433,16 +416,16 @@ type Client (AuthProtect tag :> api) = AuthenticateReq (AuthProtect tag) -> Client api - clientWithRoute Proxy req baseurl manager (AuthenticateReq (val,func)) =- clientWithRoute (Proxy :: Proxy api) (func val req) baseurl manager+ clientWithRoute Proxy req (AuthenticateReq (val,func)) =+ clientWithRoute (Proxy :: Proxy api) (func val req) -- * Basic Authentication instance HasClient api => HasClient (BasicAuth realm usr :> api) where type Client (BasicAuth realm usr :> api) = BasicAuthData -> Client api - clientWithRoute Proxy req baseurl manager val =- clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req) baseurl manager+ clientWithRoute Proxy req val =+ clientWithRoute (Proxy :: Proxy api) (basicAuthReq val req) {- Note [Non-Empty Content Types]
src/Servant/Common/Req.hs view
@@ -123,11 +123,12 @@ displayHttpRequest :: Method -> String displayHttpRequest httpmethod = "HTTP " ++ cs httpmethod ++ " request" +type ClientM = ExceptT ServantError IO -performRequest :: Method -> Req -> BaseUrl -> Manager- -> ExceptT ServantError IO ( Int, ByteString, MediaType- , [HTTP.Header], Response ByteString)-performRequest reqMethod req reqHost manager = do+performRequest :: Method -> Req -> Manager -> BaseUrl+ -> ClientM ( Int, ByteString, MediaType+ , [HTTP.Header], Response ByteString)+performRequest reqMethod req manager reqHost = do partialRequest <- liftIO $ reqToRequest req reqHost let request = partialRequest { Client.method = reqMethod@@ -155,21 +156,21 @@ performRequestCT :: MimeUnrender ct result =>- Proxy ct -> Method -> Req -> BaseUrl -> Manager- -> ExceptT ServantError IO ([HTTP.Header], result)-performRequestCT ct reqMethod req reqHost manager = do+ Proxy ct -> Method -> Req -> Manager -> BaseUrl+ -> ClientM ([HTTP.Header], result)+performRequestCT ct reqMethod req manager reqHost = do let acceptCT = contentType ct (_status, respBody, respCT, hdrs, _response) <-- performRequest reqMethod (req { reqAccept = [acceptCT] }) reqHost manager+ performRequest reqMethod (req { reqAccept = [acceptCT] }) manager reqHost unless (matches respCT (acceptCT)) $ throwE $ UnsupportedContentType respCT respBody case mimeUnrender ct respBody of Left err -> throwE $ DecodeFailure err respCT respBody Right val -> return (hdrs, val) -performRequestNoBody :: Method -> Req -> BaseUrl -> Manager- -> ExceptT ServantError IO [HTTP.Header]-performRequestNoBody reqMethod req reqHost manager = do- (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req reqHost manager+performRequestNoBody :: Method -> Req -> Manager -> BaseUrl+ -> ClientM [HTTP.Header]+performRequestNoBody reqMethod req manager reqHost = do+ (_status, _body, _ct, hdrs, _response) <- performRequest reqMethod req manager reqHost return hdrs catchConnectionError :: IO a -> IO (Either ServantError a)
test/Servant/ClientSpec.hs view
@@ -28,19 +28,18 @@ import Control.Arrow (left) import Control.Concurrent (forkIO, killThread, ThreadId) import Control.Exception (bracket)-import Control.Monad.Trans.Except (ExceptT, runExceptT, throwE)+import Control.Monad.Trans.Except (ExceptT, throwE, runExceptT) import Data.Aeson+import qualified Data.ByteString.Lazy as BS import Data.Char (chr, isPrint) import Data.Foldable (forM_) import Data.Monoid hiding (getLast) import Data.Proxy import qualified Data.Text as T import GHC.Generics (Generic)-import GHC.TypeLits import qualified Network.HTTP.Client as C import Network.HTTP.Media-import Network.HTTP.Types (Status (..), badRequest400,- methodGet, ok200, status400)+import qualified Network.HTTP.Types as HTTP import Network.Socket import Network.Wai (Application, Request, requestHeaders, responseLBS)@@ -120,6 +119,34 @@ api :: Proxy Api api = Proxy +getGet :: C.Manager -> BaseUrl -> SCR.ClientM Person+getDeleteEmpty :: C.Manager -> BaseUrl -> SCR.ClientM NoContent+getCapture :: String -> C.Manager -> BaseUrl -> SCR.ClientM Person+getBody :: Person -> C.Manager -> BaseUrl -> SCR.ClientM Person+getQueryParam :: Maybe String -> C.Manager -> BaseUrl -> SCR.ClientM Person+getQueryParams :: [String] -> C.Manager -> BaseUrl -> SCR.ClientM [Person]+getQueryFlag :: Bool -> C.Manager -> BaseUrl -> SCR.ClientM Bool+getRawSuccess :: HTTP.Method -> C.Manager -> BaseUrl+ -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)+getRawFailure :: HTTP.Method -> C.Manager -> BaseUrl+ -> SCR.ClientM (Int, BS.ByteString, MediaType, [HTTP.Header], C.Response BS.ByteString)+getMultiple :: String -> Maybe Int -> Bool -> [(String, [Rational])] -> C.Manager -> BaseUrl+ -> SCR.ClientM (String, Maybe Int, Bool, [(String, [Rational])])+getRespHeaders :: C.Manager -> BaseUrl -> SCR.ClientM (Headers TestHeaders Bool)+getDeleteContentType :: C.Manager -> BaseUrl -> SCR.ClientM NoContent+getGet+ :<|> getDeleteEmpty+ :<|> getCapture+ :<|> getBody+ :<|> getQueryParam+ :<|> getQueryParams+ :<|> getQueryFlag+ :<|> getRawSuccess+ :<|> getRawFailure+ :<|> getMultiple+ :<|> getRespHeaders+ :<|> getDeleteContentType = client api+ server :: Application server = serve api ( return alice@@ -132,8 +159,8 @@ Nothing -> throwE $ ServantErr 400 "missing parameter" "" []) :<|> (\ names -> return (zipWith Person names [0..])) :<|> return- :<|> (\ _request respond -> respond $ responseLBS ok200 [] "rawSuccess")- :<|> (\ _request respond -> respond $ responseLBS badRequest400 [] "rawFailure")+ :<|> (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "rawSuccess")+ :<|> (\ _request respond -> respond $ responseLBS HTTP.badRequest400 [] "rawFailure") :<|> (\ a b c d -> return (a, b, c, d)) :<|> (return $ addHeader 1729 $ addHeader "eg2" True) :<|> return NoContent@@ -149,9 +176,9 @@ failServer :: Application failServer = serve failApi (- (\ _request respond -> respond $ responseLBS ok200 [] "")- :<|> (\ _capture _request respond -> respond $ responseLBS ok200 [("content-type", "application/json")] "")- :<|> (\_request respond -> respond $ responseLBS ok200 [("content-type", "fooooo")] "")+ (\ _request respond -> respond $ responseLBS HTTP.ok200 [] "")+ :<|> (\ _capture _request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "application/json")] "")+ :<|> (\_request respond -> respond $ responseLBS HTTP.ok200 [("content-type", "fooooo")] "") ) -- * basic auth stuff@@ -208,76 +235,64 @@ sucessSpec = beforeAll (startWaiApp server) $ afterAll endWaiApp $ do it "Servant.API.Get" $ \(_, baseUrl) -> do- let getGet = getNth (Proxy :: Proxy 0) $ client api baseUrl manager- (left show <$> runExceptT getGet) `shouldReturn` Right alice+ (left show <$> runExceptT (getGet manager baseUrl)) `shouldReturn` Right alice describe "Servant.API.Delete" $ do it "allows empty content type" $ \(_, baseUrl) -> do- let getDeleteEmpty = getNth (Proxy :: Proxy 1) $ client api baseUrl manager- (left show <$> runExceptT getDeleteEmpty) `shouldReturn` Right NoContent+ (left show <$> runExceptT (getDeleteEmpty manager baseUrl)) `shouldReturn` Right NoContent it "allows content type" $ \(_, baseUrl) -> do- let getDeleteContentType = getLast $ client api baseUrl manager- (left show <$> runExceptT getDeleteContentType) `shouldReturn` Right NoContent+ (left show <$> runExceptT (getDeleteContentType manager baseUrl)) `shouldReturn` Right NoContent it "Servant.API.Capture" $ \(_, baseUrl) -> do- let getCapture = getNth (Proxy :: Proxy 2) $ client api baseUrl manager- (left show <$> runExceptT (getCapture "Paula")) `shouldReturn` Right (Person "Paula" 0)+ (left show <$> runExceptT (getCapture "Paula" manager baseUrl)) `shouldReturn` Right (Person "Paula" 0) it "Servant.API.ReqBody" $ \(_, baseUrl) -> do let p = Person "Clara" 42- getBody = getNth (Proxy :: Proxy 3) $ client api baseUrl manager- (left show <$> runExceptT (getBody p)) `shouldReturn` Right p+ (left show <$> runExceptT (getBody p manager baseUrl)) `shouldReturn` Right p it "Servant.API.QueryParam" $ \(_, baseUrl) -> do- let getQueryParam = getNth (Proxy :: Proxy 4) $ client api baseUrl manager- left show <$> runExceptT (getQueryParam (Just "alice")) `shouldReturn` Right alice- Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob"))- responseStatus `shouldBe` Status 400 "bob not found"+ left show <$> runExceptT (getQueryParam (Just "alice") manager baseUrl) `shouldReturn` Right alice+ Left FailureResponse{..} <- runExceptT (getQueryParam (Just "bob") manager baseUrl)+ responseStatus `shouldBe` HTTP.Status 400 "bob not found" it "Servant.API.QueryParam.QueryParams" $ \(_, baseUrl) -> do- let getQueryParams = getNth (Proxy :: Proxy 5) $ client api baseUrl manager- (left show <$> runExceptT (getQueryParams [])) `shouldReturn` Right []- (left show <$> runExceptT (getQueryParams ["alice", "bob"]))+ (left show <$> runExceptT (getQueryParams [] manager baseUrl)) `shouldReturn` Right []+ (left show <$> runExceptT (getQueryParams ["alice", "bob"] manager baseUrl)) `shouldReturn` Right [Person "alice" 0, Person "bob" 1] context "Servant.API.QueryParam.QueryFlag" $ forM_ [False, True] $ \ flag -> it (show flag) $ \(_, baseUrl) -> do- let getQueryFlag = getNth (Proxy :: Proxy 6) $ client api baseUrl manager- (left show <$> runExceptT (getQueryFlag flag)) `shouldReturn` Right flag+ (left show <$> runExceptT (getQueryFlag flag manager baseUrl)) `shouldReturn` Right flag it "Servant.API.Raw on success" $ \(_, baseUrl) -> do- let getRawSuccess = getNth (Proxy :: Proxy 7) $ client api baseUrl manager- res <- runExceptT (getRawSuccess methodGet)+ res <- runExceptT (getRawSuccess HTTP.methodGet manager baseUrl) case res of Left e -> assertFailure $ show e Right (code, body, ct, _, response) -> do (code, body, ct) `shouldBe` (200, "rawSuccess", "application"//"octet-stream") C.responseBody response `shouldBe` body- C.responseStatus response `shouldBe` ok200+ C.responseStatus response `shouldBe` HTTP.ok200 it "Servant.API.Raw should return a Left in case of failure" $ \(_, baseUrl) -> do- let getRawFailure = getNth (Proxy :: Proxy 8) $ client api baseUrl manager- res <- runExceptT (getRawFailure methodGet)+ res <- runExceptT (getRawFailure HTTP.methodGet manager baseUrl) case res of Right _ -> assertFailure "expected Left, but got Right" Left e -> do- Servant.Client.responseStatus e `shouldBe` status400+ Servant.Client.responseStatus e `shouldBe` HTTP.status400 Servant.Client.responseBody e `shouldBe` "rawFailure" it "Returns headers appropriately" $ \(_, baseUrl) -> do- let getRespHeaders = getNth (Proxy :: Proxy 10) $ client api baseUrl manager- res <- runExceptT getRespHeaders+ res <- runExceptT (getRespHeaders manager baseUrl) case res of Left e -> assertFailure $ show e Right val -> getHeaders val `shouldBe` [("X-Example1", "1729"), ("X-Example2", "eg2")] modifyMaxSuccess (const 20) $ do it "works for a combination of Capture, QueryParam, QueryFlag and ReqBody" $ \(_, baseUrl) ->- let getMultiple = getNth (Proxy :: Proxy 9) $ client api baseUrl manager- in property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body ->+ property $ forAllShrink pathGen shrink $ \(NonEmpty cap) num flag body -> ioProperty $ do- result <- left show <$> runExceptT (getMultiple cap num flag body)+ result <- left show <$> runExceptT (getMultiple cap num flag body manager baseUrl) return $ result === Right (cap, num, flag, body) @@ -289,10 +304,10 @@ let test :: (WrappedApi, String) -> Spec test (WrappedApi api, desc) = it desc $ bracket (startWaiApp $ serveW api) endWaiApp $ \(_, baseUrl) -> do- let getResponse :: ExceptT ServantError IO ()- getResponse = client api baseUrl manager- Left FailureResponse{..} <- runExceptT getResponse- responseStatus `shouldBe` (Status 500 "error message")+ let getResponse :: C.Manager -> BaseUrl -> SCR.ClientM ()+ getResponse = client api+ Left FailureResponse{..} <- runExceptT (getResponse manager baseUrl)+ responseStatus `shouldBe` (HTTP.Status 500 "error message") in mapM_ test $ (WrappedApi (Proxy :: Proxy (Delete '[JSON] ())), "Delete") : (WrappedApi (Proxy :: Proxy (Get '[JSON] ())), "Get") :@@ -305,43 +320,43 @@ context "client returns errors appropriately" $ do it "reports FailureResponse" $ \(_, baseUrl) -> do- let (_ :<|> getDeleteEmpty :<|> _) = client api baseUrl manager- Left res <- runExceptT getDeleteEmpty+ let (_ :<|> getDeleteEmpty :<|> _) = client api+ Left res <- runExceptT (getDeleteEmpty manager baseUrl) case res of- FailureResponse (Status 404 "Not Found") _ _ -> return ()+ FailureResponse (HTTP.Status 404 "Not Found") _ _ -> return () _ -> fail $ "expected 404 response, but got " <> show res it "reports DecodeFailure" $ \(_, baseUrl) -> do- let (_ :<|> _ :<|> getCapture :<|> _) = client api baseUrl manager- Left res <- runExceptT (getCapture "foo")+ let (_ :<|> _ :<|> getCapture :<|> _) = client api+ Left res <- runExceptT (getCapture "foo" manager baseUrl) case res of DecodeFailure _ ("application/json") _ -> return () _ -> fail $ "expected DecodeFailure, but got " <> show res it "reports ConnectionError" $ \_ -> do- let (getGetWrongHost :<|> _) = client api (BaseUrl Http "127.0.0.1" 19872 "") manager- Left res <- runExceptT getGetWrongHost+ let (getGetWrongHost :<|> _) = client api+ Left res <- runExceptT (getGetWrongHost 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 api baseUrl manager- Left res <- runExceptT getGet+ let (getGet :<|> _ ) = client api+ Left res <- runExceptT (getGet manager baseUrl) case res of UnsupportedContentType ("application/octet-stream") _ -> return () _ -> fail $ "expected UnsupportedContentType, but got " <> show res it "reports InvalidContentTypeHeader" $ \(_, baseUrl) -> do- let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api baseUrl manager- Left res <- runExceptT (getBody alice)+ let (_ :<|> _ :<|> _ :<|> getBody :<|> _) = client api+ Left res <- runExceptT (getBody alice manager baseUrl) case res of InvalidContentTypeHeader "fooooo" _ -> return () _ -> fail $ "expected InvalidContentTypeHeader, but got " <> show res data WrappedApi where WrappedApi :: (HasServer (api :: *) '[], Server api ~ ExceptT ServantErr IO a,- HasClient api, Client api ~ ExceptT ServantError IO ()) =>+ HasClient api, Client api ~ (C.Manager -> BaseUrl -> SCR.ClientM ())) => Proxy api -> WrappedApi basicAuthSpec :: Spec@@ -349,34 +364,34 @@ context "Authentication works when requests are properly authenticated" $ do it "Authenticates a BasicAuth protected server appropriately" $ \(_,baseUrl) -> do- let getBasic = client basicAuthAPI baseUrl manager+ let getBasic = client basicAuthAPI let basicAuthData = BasicAuthData "servant" "server"- (left show <$> runExceptT (getBasic basicAuthData)) `shouldReturn` Right alice+ (left show <$> runExceptT (getBasic basicAuthData manager baseUrl)) `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 basicAuthAPI baseUrl manager+ let getBasic = client basicAuthAPI let basicAuthData = BasicAuthData "not" "password"- Left FailureResponse{..} <- runExceptT (getBasic basicAuthData)- responseStatus `shouldBe` Status 403 "Forbidden"+ Left FailureResponse{..} <- runExceptT (getBasic basicAuthData manager baseUrl)+ responseStatus `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 genAuthAPI baseUrl manager+ let getProtected = client genAuthAPI let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "AuthHeader" ("cool" :: String) req)- (left show <$> runExceptT (getProtected authRequest)) `shouldReturn` Right alice+ (left show <$> runExceptT (getProtected authRequest manager baseUrl)) `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 genAuthAPI baseUrl manager+ let getProtected = client genAuthAPI let authRequest = mkAuthenticateReq () (\_ req -> SCR.addHeader "Wrong" ("header" :: String) req)- Left FailureResponse{..} <- runExceptT (getProtected authRequest)- responseStatus `shouldBe` (Status 401 "Unauthorized")+ Left FailureResponse{..} <- runExceptT (getProtected authRequest manager baseUrl)+ responseStatus `shouldBe` (HTTP.Status 401 "Unauthorized") -- * utils @@ -407,25 +422,3 @@ filter (not . (`elem` ("?%[]/#;" :: String))) $ filter isPrint $ map chr [0..127]--class GetNth (n :: Nat) a b | n a -> b where- getNth :: Proxy n -> a -> b--instance OVERLAPPING_- GetNth 0 (x :<|> y) x where- getNth _ (x :<|> _) = x--instance OVERLAPPING_- (GetNth (n - 1) x y) => GetNth n (a :<|> x) y where- getNth _ (_ :<|> x) = getNth (Proxy :: Proxy (n - 1)) x--class GetLast a b | a -> b where- getLast :: a -> b--instance OVERLAPPING_- (GetLast b c) => GetLast (a :<|> b) c where- getLast (_ :<|> b) = getLast b--instance OVERLAPPING_- GetLast a a where- getLast a = a