mirror of
https://github.com/unclechu/gRPC-haskell.git
synced 2024-11-23 03:29:42 +01:00
Expose ClientError
type (#36)
* Expose the max receive message length channel argument + unittest * `ClientError` GADT ctor => `ClientErrorResponse`, expose `ClientError` Prior to this commit, the name `ClientError` was both: - The name of a data constructor name for the `ClientResult` GADT - A name of an internal sum type for capturing different kinds of client errors We want to expose the latter to users of the library, and so expose the latter and rename the former. * Remove unused `MultiWayIf` lang ext
This commit is contained in:
parent
3aa835a6f2
commit
4a30625a70
4 changed files with 17 additions and 18 deletions
|
@ -44,5 +44,5 @@ main = do
|
||||||
| rsp == expected -> return ()
|
| rsp == expected -> return ()
|
||||||
| otherwise -> fail $ "Got unexpected response: '" ++ show rsp ++ "', expected: '" ++ show expected ++ "'"
|
| otherwise -> fail $ "Got unexpected response: '" ++ show rsp ++ "', expected: '" ++ show expected ++ "'"
|
||||||
ClientNormalResponse _ _ _ st _ -> fail $ "Got unexpected status " ++ show st ++ " from call, expecting StatusOk"
|
ClientNormalResponse _ _ _ st _ -> fail $ "Got unexpected status " ++ show st ++ " from call, expecting StatusOk"
|
||||||
ClientError e -> fail $ "Got client error: " ++ show e
|
ClientErrorResponse e -> fail $ "Got client error: " ++ show e
|
||||||
putStrLn $ "echo-client success: sent " ++ show pay ++ ", got " ++ show pay
|
putStrLn $ "echo-client success: sent " ++ show pay ++ ", got " ++ show pay
|
||||||
|
|
|
@ -13,15 +13,15 @@ module Network.GRPC.HighLevel.Client
|
||||||
, StreamSend
|
, StreamSend
|
||||||
, WritesDone
|
, WritesDone
|
||||||
, LL.Client
|
, LL.Client
|
||||||
|
|
||||||
, ServiceClient
|
, ServiceClient
|
||||||
|
, ClientError(..)
|
||||||
, ClientRequest(..)
|
, ClientRequest(..)
|
||||||
, ClientResult(..)
|
, ClientResult(..)
|
||||||
-- , ClientResponse, response, initMD, trailMD, rspCode, details
|
|
||||||
|
|
||||||
, ClientRegisterable(..)
|
, ClientRegisterable(..)
|
||||||
|
, clientRequest
|
||||||
|
)
|
||||||
|
|
||||||
, clientRequest ) where
|
where
|
||||||
|
|
||||||
import qualified Network.GRPC.LowLevel.Client as LL
|
import qualified Network.GRPC.LowLevel.Client as LL
|
||||||
import qualified Network.GRPC.LowLevel.Call as LL
|
import qualified Network.GRPC.LowLevel.Call as LL
|
||||||
|
@ -62,8 +62,7 @@ data ClientResult (streamType :: GRPCMethodType) response where
|
||||||
ClientWriterResponse :: Maybe response -> MetadataMap -> MetadataMap -> StatusCode -> StatusDetails -> ClientResult 'ClientStreaming response
|
ClientWriterResponse :: Maybe response -> MetadataMap -> MetadataMap -> StatusCode -> StatusDetails -> ClientResult 'ClientStreaming response
|
||||||
ClientReaderResponse :: MetadataMap -> StatusCode -> StatusDetails -> ClientResult 'ServerStreaming response
|
ClientReaderResponse :: MetadataMap -> StatusCode -> StatusDetails -> ClientResult 'ServerStreaming response
|
||||||
ClientBiDiResponse :: MetadataMap -> StatusCode -> StatusDetails -> ClientResult 'BiDiStreaming response
|
ClientBiDiResponse :: MetadataMap -> StatusCode -> StatusDetails -> ClientResult 'BiDiStreaming response
|
||||||
|
ClientErrorResponse :: ClientError -> ClientResult streamType response
|
||||||
ClientError :: ClientError -> ClientResult streamType response
|
|
||||||
|
|
||||||
class ClientRegisterable (methodType :: GRPCMethodType) where
|
class ClientRegisterable (methodType :: GRPCMethodType) where
|
||||||
clientRegisterMethod :: LL.Client
|
clientRegisterMethod :: LL.Client
|
||||||
|
@ -92,30 +91,30 @@ clientRequest :: (Message request, Message response) =>
|
||||||
clientRequest client (RegisteredMethod method) (ClientNormalRequest req timeout meta) =
|
clientRequest client (RegisteredMethod method) (ClientNormalRequest req timeout meta) =
|
||||||
mkResponse <$> LL.clientRequest client method timeout (BL.toStrict (toLazyByteString req)) meta
|
mkResponse <$> LL.clientRequest client method timeout (BL.toStrict (toLazyByteString req)) meta
|
||||||
where
|
where
|
||||||
mkResponse (Left ioError_) = ClientError (ClientIOError ioError_)
|
mkResponse (Left ioError_) = ClientErrorResponse (ClientIOError ioError_)
|
||||||
mkResponse (Right rsp) =
|
mkResponse (Right rsp) =
|
||||||
case fromByteString (LL.rspBody rsp) of
|
case fromByteString (LL.rspBody rsp) of
|
||||||
Left err -> ClientError (ClientErrorNoParse err)
|
Left err -> ClientErrorResponse (ClientErrorNoParse err)
|
||||||
Right parsedRsp ->
|
Right parsedRsp ->
|
||||||
ClientNormalResponse parsedRsp (LL.initMD rsp) (LL.trailMD rsp) (LL.rspCode rsp) (LL.details rsp)
|
ClientNormalResponse parsedRsp (LL.initMD rsp) (LL.trailMD rsp) (LL.rspCode rsp) (LL.details rsp)
|
||||||
clientRequest client (RegisteredMethod method) (ClientWriterRequest timeout meta handler) =
|
clientRequest client (RegisteredMethod method) (ClientWriterRequest timeout meta handler) =
|
||||||
mkResponse <$> LL.clientWriter client method timeout meta (handler . convertSend)
|
mkResponse <$> LL.clientWriter client method timeout meta (handler . convertSend)
|
||||||
where
|
where
|
||||||
mkResponse (Left ioError_) = ClientError (ClientIOError ioError_)
|
mkResponse (Left ioError_) = ClientErrorResponse (ClientIOError ioError_)
|
||||||
mkResponse (Right (rsp_, initMD_, trailMD_, rspCode_, details_)) =
|
mkResponse (Right (rsp_, initMD_, trailMD_, rspCode_, details_)) =
|
||||||
case maybe (Right Nothing) (fmap Just . fromByteString) rsp_ of
|
case maybe (Right Nothing) (fmap Just . fromByteString) rsp_ of
|
||||||
Left err -> ClientError (ClientErrorNoParse err)
|
Left err -> ClientErrorResponse (ClientErrorNoParse err)
|
||||||
Right parsedRsp ->
|
Right parsedRsp ->
|
||||||
ClientWriterResponse parsedRsp initMD_ trailMD_ rspCode_ details_
|
ClientWriterResponse parsedRsp initMD_ trailMD_ rspCode_ details_
|
||||||
clientRequest client (RegisteredMethod method) (ClientReaderRequest req timeout meta handler) =
|
clientRequest client (RegisteredMethod method) (ClientReaderRequest req timeout meta handler) =
|
||||||
mkResponse <$> LL.clientReader client method timeout (BL.toStrict (toLazyByteString req)) meta (\m recv -> handler m (convertRecv recv))
|
mkResponse <$> LL.clientReader client method timeout (BL.toStrict (toLazyByteString req)) meta (\m recv -> handler m (convertRecv recv))
|
||||||
where
|
where
|
||||||
mkResponse (Left ioError_) = ClientError (ClientIOError ioError_)
|
mkResponse (Left ioError_) = ClientErrorResponse (ClientIOError ioError_)
|
||||||
mkResponse (Right (meta_, rspCode_, details_)) =
|
mkResponse (Right (meta_, rspCode_, details_)) =
|
||||||
ClientReaderResponse meta_ rspCode_ details_
|
ClientReaderResponse meta_ rspCode_ details_
|
||||||
clientRequest client (RegisteredMethod method) (ClientBiDiRequest timeout meta handler) =
|
clientRequest client (RegisteredMethod method) (ClientBiDiRequest timeout meta handler) =
|
||||||
mkResponse <$> LL.clientRW client method timeout meta (\_m recv send writesDone -> handler meta (convertRecv recv) (convertSend send) writesDone)
|
mkResponse <$> LL.clientRW client method timeout meta (\_m recv send writesDone -> handler meta (convertRecv recv) (convertSend send) writesDone)
|
||||||
where
|
where
|
||||||
mkResponse (Left ioError_) = ClientError (ClientIOError ioError_)
|
mkResponse (Left ioError_) = ClientErrorResponse (ClientIOError ioError_)
|
||||||
mkResponse (Right (meta_, rspCode_, details_)) =
|
mkResponse (Right (meta_, rspCode_, details_)) =
|
||||||
ClientBiDiResponse meta_ rspCode_ details_
|
ClientBiDiResponse meta_ rspCode_ details_
|
||||||
|
|
|
@ -32,6 +32,7 @@ module Network.GRPC.HighLevel.Generated (
|
||||||
-- * Client
|
-- * Client
|
||||||
, withGRPCClient
|
, withGRPCClient
|
||||||
, ClientConfig(..)
|
, ClientConfig(..)
|
||||||
|
, ClientError(..)
|
||||||
, ClientRequest(..)
|
, ClientRequest(..)
|
||||||
, ClientResult(..)
|
, ClientResult(..)
|
||||||
)
|
)
|
||||||
|
|
|
@ -39,7 +39,7 @@ testNormalCall client = testCase "Normal call" $
|
||||||
res <- simpleServiceNormalCall client
|
res <- simpleServiceNormalCall client
|
||||||
(ClientNormalRequest req 10 mempty)
|
(ClientNormalRequest req 10 mempty)
|
||||||
case res of
|
case res of
|
||||||
ClientError err -> assertString ("ClientError: " <> show err)
|
ClientErrorResponse err -> assertString ("ClientErrorResponse: " <> show err)
|
||||||
ClientNormalResponse res _ _ stsCode _ ->
|
ClientNormalResponse res _ _ stsCode _ ->
|
||||||
do stsCode @?= StatusOk
|
do stsCode @?= StatusOk
|
||||||
simpleServiceResponseResponse res @?= "NormalRequest"
|
simpleServiceResponseResponse res @?= "NormalRequest"
|
||||||
|
@ -60,7 +60,7 @@ testClientStreamingCall client = testCase "Client-streaming call" $
|
||||||
|
|
||||||
(finalName, totalSum) <- readMVar v
|
(finalName, totalSum) <- readMVar v
|
||||||
case res of
|
case res of
|
||||||
ClientError err -> assertString ("ClientError: " <> show err)
|
ClientErrorResponse err -> assertString ("ClientErrorResponse: " <> show err)
|
||||||
ClientWriterResponse Nothing _ _ _ _ -> assertString "No response received"
|
ClientWriterResponse Nothing _ _ _ _ -> assertString "No response received"
|
||||||
ClientWriterResponse (Just res) _ _ stsCode _ ->
|
ClientWriterResponse (Just res) _ _ stsCode _ ->
|
||||||
do stsCode @?= StatusOk
|
do stsCode @?= StatusOk
|
||||||
|
@ -90,7 +90,7 @@ testServerStreamingCall client = testCase "Server-streaming call" $
|
||||||
ClientReaderRequest (SimpleServiceRequest "Test" (fromList nums)) 10 mempty
|
ClientReaderRequest (SimpleServiceRequest "Test" (fromList nums)) 10 mempty
|
||||||
(\_ -> checkResults nums)
|
(\_ -> checkResults nums)
|
||||||
case res of
|
case res of
|
||||||
ClientError err -> assertString ("ClientError: " <> show err)
|
ClientErrorResponse err -> assertString ("ClientErrorResponse: " <> show err)
|
||||||
ClientReaderResponse _ sts _ ->
|
ClientReaderResponse _ sts _ ->
|
||||||
sts @?= StatusOk
|
sts @?= StatusOk
|
||||||
|
|
||||||
|
@ -116,7 +116,7 @@ testBiDiStreamingCall client = testCase "Bidi-streaming call" $
|
||||||
res <- simpleServiceBiDiStreamingCall client $
|
res <- simpleServiceBiDiStreamingCall client $
|
||||||
ClientBiDiRequest 10 mempty (\_ -> handleRequests iterations)
|
ClientBiDiRequest 10 mempty (\_ -> handleRequests iterations)
|
||||||
case res of
|
case res of
|
||||||
ClientError err -> assertString ("ClientError: " <> show err)
|
ClientErrorResponse err -> assertString ("ClientErrorResponse: " <> show err)
|
||||||
ClientBiDiResponse _ sts _ ->
|
ClientBiDiResponse _ sts _ ->
|
||||||
sts @?= StatusOk
|
sts @?= StatusOk
|
||||||
|
|
||||||
|
@ -133,4 +133,3 @@ main = do
|
||||||
, testServerStreamingCall service
|
, testServerStreamingCall service
|
||||||
, testBiDiStreamingCall service ]) `finally`
|
, testBiDiStreamingCall service ]) `finally`
|
||||||
(simpleServiceDone service (ClientNormalRequest SimpleServiceDone 10 mempty))
|
(simpleServiceDone service (ClientNormalRequest SimpleServiceDone 10 mempty))
|
||||||
|
|
||||||
|
|
Loading…
Reference in a new issue