Expose ClientCall in ClientReaderHandler and ClientRWHandler (#87)
This allows you to cancel the call from within the callback using `clientCallCancel`.
This commit is contained in:
Moritz Kiefer
Gabriel Gonzalez
parent
6e09678dc7
commit
a26497c82c
|
|
@ -256,7 +256,7 @@ compileNormalRequestResults x =
|
|||
-- clientReader (client side of server streaming mode)
|
||||
|
||||
-- | First parameter is initial server metadata.
|
||||
type ClientReaderHandler = MetadataMap -> StreamRecv ByteString -> IO ()
|
||||
type ClientReaderHandler = ClientCall -> MetadataMap -> StreamRecv ByteString -> IO ()
|
||||
type ClientReaderResult = (MetadataMap, C.StatusCode, StatusDetails)
|
||||
|
||||
clientReader :: Client
|
||||
|
|
@ -269,13 +269,13 @@ clientReader :: Client
|
|||
clientReader cl@Client{ clientCQ = cq } rm tm body initMeta f =
|
||||
withClientCall cl rm tm go
|
||||
where
|
||||
go (unsafeCC -> c) = runExceptT $ do
|
||||
go cc@(unsafeCC -> c) = runExceptT $ do
|
||||
void $ runOps' c cq [ OpSendInitialMetadata initMeta
|
||||
, OpSendMessage body
|
||||
, OpSendCloseFromClient
|
||||
]
|
||||
srvMD <- recvInitialMetadata c cq
|
||||
liftIO $ f srvMD (streamRecvPrim c cq)
|
||||
liftIO $ f cc srvMD (streamRecvPrim c cq)
|
||||
recvStatusOnClient c cq
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
@ -326,7 +326,8 @@ pattern CWRFinal mmsg initMD trailMD st ds
|
|||
-- clientRW (client side of bidirectional streaming mode)
|
||||
|
||||
type ClientRWHandler
|
||||
= IO (Either GRPCIOError MetadataMap)
|
||||
= ClientCall
|
||||
-> IO (Either GRPCIOError MetadataMap)
|
||||
-> StreamRecv ByteString
|
||||
-> StreamSend ByteString
|
||||
-> WritesDone
|
||||
|
|
@ -352,7 +353,7 @@ clientRW' :: Client
|
|||
-> MetadataMap
|
||||
-> ClientRWHandler
|
||||
-> IO (Either GRPCIOError ClientRWResult)
|
||||
clientRW' (clientCQ -> cq) (unsafeCC -> c) initMeta f = runExceptT $ do
|
||||
clientRW' (clientCQ -> cq) cc@(unsafeCC -> c) initMeta f = runExceptT $ do
|
||||
sendInitialMetadata c cq initMeta
|
||||
|
||||
-- 'mdmv' is used to synchronize between callers of 'getMD' and 'recv'
|
||||
|
|
@ -412,7 +413,7 @@ clientRW' (clientCQ -> cq) (unsafeCC -> c) initMeta f = runExceptT $ do
|
|||
-- programmer.
|
||||
writesDone = writesDonePrim c cq
|
||||
|
||||
liftIO (f getMD recv send writesDone)
|
||||
liftIO (f cc getMD recv send writesDone)
|
||||
recvStatusOnClient c cq -- Finish()
|
||||
|
||||
--------------------------------------------------------------------------------
|
||||
|
|
|
|||
|
|
@ -406,7 +406,7 @@ testServerStreaming =
|
|||
|
||||
client c = do
|
||||
rm <- clientRegisterMethodServerStreaming c "/feed"
|
||||
eea <- clientReader c rm 10 clientPay clientInitMD $ \initMD recv -> do
|
||||
eea <- clientReader c rm 10 clientPay clientInitMD $ \_cc initMD recv -> do
|
||||
checkMD "Server initial metadata mismatch" serverInitMD initMD
|
||||
forM_ pays $ \p -> recv `is` Right (Just p)
|
||||
recv `is` Right Nothing
|
||||
|
|
@ -436,7 +436,7 @@ testServerStreamingUnregistered =
|
|||
|
||||
client c = do
|
||||
rm <- clientRegisterMethodServerStreaming c "/feed"
|
||||
eea <- clientReader c rm 10 clientPay clientInitMD $ \initMD recv -> do
|
||||
eea <- clientReader c rm 10 clientPay clientInitMD $ \_cc initMD recv -> do
|
||||
checkMD "Server initial metadata mismatch" serverInitMD initMD
|
||||
forM_ pays $ \p -> recv `is` Right (Just p)
|
||||
recv `is` Right Nothing
|
||||
|
|
@ -517,7 +517,7 @@ testBiDiStreaming =
|
|||
|
||||
client c = do
|
||||
rm <- clientRegisterMethodBiDiStreaming c "/bidi"
|
||||
eea <- clientRW c rm 10 clientInitMD $ \getMD recv send writesDone -> do
|
||||
eea <- clientRW c rm 10 clientInitMD $ \_cc getMD recv send writesDone -> do
|
||||
either clientFail (checkMD "Server rsp metadata mismatch" serverInitMD) =<< getMD
|
||||
send "cw0" `is` Right ()
|
||||
recv `is` Right (Just "sw0")
|
||||
|
|
@ -553,7 +553,7 @@ testBiDiStreamingUnregistered =
|
|||
|
||||
client c = do
|
||||
rm <- clientRegisterMethodBiDiStreaming c "/bidi"
|
||||
eea <- clientRW c rm 10 clientInitMD $ \getMD recv send writesDone -> do
|
||||
eea <- clientRW c rm 10 clientInitMD $ \_cc getMD recv send writesDone -> do
|
||||
either clientFail (checkMD "Server rsp metadata mismatch" serverInitMD) =<< getMD
|
||||
send "cw0" `is` Right ()
|
||||
recv `is` Right (Just "sw0")
|
||||
|
|
|
|||
|
|
@ -42,7 +42,7 @@ doHelloSS c n = do
|
|||
let pay = SSRqt "server streaming mode" (fromIntegral n)
|
||||
enc = BL.toStrict . toLazyByteString $ pay
|
||||
err desc e = fail $ "doHelloSS: " ++ desc ++ " error: " ++ show e
|
||||
eea <- clientReader c rm n enc mempty $ \_md recv -> do
|
||||
eea <- clientReader c rm n enc mempty $ \_cc _md recv -> do
|
||||
n' <- flip fix (0::Int) $ \go i -> recv >>= \case
|
||||
Left e -> err "recv" e
|
||||
Right Nothing -> return i
|
||||
|
|
@ -84,7 +84,7 @@ doHelloBi c n = do
|
|||
let pay = BiRqtRpy "bidi payload"
|
||||
enc = BL.toStrict . toLazyByteString $ pay
|
||||
err desc e = fail $ "doHelloBi: " ++ desc ++ " error: " ++ show e
|
||||
eea <- clientRW c rm n mempty $ \_getMD recv send writesDone -> do
|
||||
eea <- clientRW c rm n mempty $ \_cc _getMD recv send writesDone -> do
|
||||
-- perform n writes on a worker thread
|
||||
thd <- async $ do
|
||||
replicateM_ n $ send enc >>= \case
|
||||
|
|
|
|||
|
|
@ -72,8 +72,8 @@ data ClientRequest (streamType :: GRPCMethodType) request response where
|
|||
-- | The final field will be invoked once, and it should repeatedly
|
||||
-- invoke its final argument (of type @(StreamRecv response)@)
|
||||
-- in order to obtain the streaming response incrementally.
|
||||
ClientReaderRequest :: request -> TimeoutSeconds -> MetadataMap -> (MetadataMap -> StreamRecv response -> IO ()) -> ClientRequest 'ServerStreaming request response
|
||||
ClientBiDiRequest :: TimeoutSeconds -> MetadataMap -> (MetadataMap -> StreamRecv response -> StreamSend request -> WritesDone -> IO ()) -> ClientRequest 'BiDiStreaming request response
|
||||
ClientReaderRequest :: request -> TimeoutSeconds -> MetadataMap -> (LL.ClientCall -> MetadataMap -> StreamRecv response -> IO ()) -> ClientRequest 'ServerStreaming request response
|
||||
ClientBiDiRequest :: TimeoutSeconds -> MetadataMap -> (LL.ClientCall -> MetadataMap -> StreamRecv response -> StreamSend request -> WritesDone -> IO ()) -> ClientRequest 'BiDiStreaming request response
|
||||
|
||||
data ClientResult (streamType :: GRPCMethodType) response where
|
||||
ClientNormalResponse :: response -> MetadataMap -> MetadataMap -> StatusCode -> StatusDetails -> ClientResult 'Normal response
|
||||
|
|
@ -125,13 +125,13 @@ clientRequest client (RegisteredMethod method) (ClientWriterRequest timeout meta
|
|||
Right parsedRsp ->
|
||||
ClientWriterResponse parsedRsp initMD_ trailMD_ rspCode_ details_
|
||||
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 (\cc m recv -> handler cc m (convertRecv recv))
|
||||
where
|
||||
mkResponse (Left ioError_) = ClientErrorResponse (ClientIOError ioError_)
|
||||
mkResponse (Right (meta_, rspCode_, details_)) =
|
||||
ClientReaderResponse meta_ rspCode_ details_
|
||||
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 (\cc _m recv send writesDone -> handler cc meta (convertRecv recv) (convertSend send) writesDone)
|
||||
where
|
||||
mkResponse (Left ioError_) = ClientErrorResponse (ClientIOError ioError_)
|
||||
mkResponse (Right (meta_, rspCode_, details_)) =
|
||||
|
|
@ -164,7 +164,7 @@ simplifyServerStreaming :: TimeoutSeconds
|
|||
-- ^ Endpoint implementation (typically generated by grpc-haskell)
|
||||
-> request
|
||||
-- ^ Request payload
|
||||
-> (MetadataMap -> StreamRecv response -> IO ())
|
||||
-> (LL.ClientCall -> MetadataMap -> StreamRecv response -> IO ())
|
||||
-- ^ Stream handler; note that the 'StreamRecv'
|
||||
-- action must be called repeatedly in order to
|
||||
-- consume the stream
|
||||
|
|
|
|||
|
|
@ -88,7 +88,7 @@ testServerStreamingCall client = testCase "Server-streaming call" $
|
|||
checkResults nums recv
|
||||
res <- simpleServiceServerStreamingCall client $
|
||||
ClientReaderRequest (SimpleServiceRequest "Test" (fromList nums)) 10 mempty
|
||||
(\_ -> checkResults nums)
|
||||
(\_ _ -> checkResults nums)
|
||||
case res of
|
||||
ClientErrorResponse err -> assertFailure ("ClientErrorResponse: " <> show err)
|
||||
ClientReaderResponse _ sts _ ->
|
||||
|
|
@ -114,7 +114,7 @@ testBiDiStreamingCall client = testCase "Bidi-streaming call" $
|
|||
iterations <- randomRIO (50, 500)
|
||||
|
||||
res <- simpleServiceBiDiStreamingCall client $
|
||||
ClientBiDiRequest 10 mempty (\_ -> handleRequests iterations)
|
||||
ClientBiDiRequest 10 mempty (\_ _ -> handleRequests iterations)
|
||||
case res of
|
||||
ClientErrorResponse err -> assertFailure ("ClientErrorResponse: " <> show err)
|
||||
ClientBiDiResponse _ sts _ ->
|
||||
|
|
|
|||
Loading…
Reference in New Issue