mirror of
https://github.com/higherkindness/mu-haskell.git
synced 2024-09-11 14:36:01 +03:00
[grpc-client] Handle bidirectional streams correctly (#314)
This is a breaking change: The handler for bidirectional streams is returns two conduits now, instead of one. This enables the client to correctly tackle the concurrent nature of the client to server stream and the server to client stream. Each response in the server-to-client stream is no longer wrapped in GRpcReply, any error during parsing the stream is thrown in IO. Other connection related errors are returned in the result value of the conduit corresponding to the server-to-client Conduit. Note: The client didn't and still doesn't handle any errors that the server might indicate using headers or trailers, e.g. grpc-status or the HTTP status code. This commit also adds TODO comments to handle these.
This commit is contained in:
parent
5315abd39c
commit
0f4942b1c4
@ -21,6 +21,7 @@ import Control.Concurrent.Async
|
|||||||
import Control.Concurrent.STM (atomically)
|
import Control.Concurrent.STM (atomically)
|
||||||
import Control.Concurrent.STM.TMChan
|
import Control.Concurrent.STM.TMChan
|
||||||
import Control.Concurrent.STM.TMVar
|
import Control.Concurrent.STM.TMVar
|
||||||
|
import Control.Exception (throwIO)
|
||||||
import Control.Monad.IO.Class
|
import Control.Monad.IO.Class
|
||||||
import Data.Avro
|
import Data.Avro
|
||||||
import qualified Data.ByteString.Char8 as BS
|
import qualified Data.ByteString.Char8 as BS
|
||||||
@ -38,7 +39,7 @@ import Network.GRPC.Client.Helpers
|
|||||||
import Network.GRPC.HTTP2.Encoding (GRPCInput, GRPCOutput)
|
import Network.GRPC.HTTP2.Encoding (GRPCInput, GRPCOutput)
|
||||||
import Network.HTTP2 (ErrorCode)
|
import Network.HTTP2 (ErrorCode)
|
||||||
import Network.HTTP2.Client (ClientError, ClientIO, TooMuchConcurrency,
|
import Network.HTTP2.Client (ClientError, ClientIO, TooMuchConcurrency,
|
||||||
runExceptT)
|
runExceptT, ExceptT)
|
||||||
|
|
||||||
import Mu.Adapter.ProtoBuf.Via
|
import Mu.Adapter.ProtoBuf.Via
|
||||||
import Mu.GRpc.Avro
|
import Mu.GRpc.Avro
|
||||||
@ -304,47 +305,50 @@ conduitFromChannel chan promise = go
|
|||||||
|
|
||||||
instance ( KnownName name
|
instance ( KnownName name
|
||||||
, GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r
|
, GRpcInputWrapper p vref v, GRpcOutputWrapper p rref r
|
||||||
, handler ~ (CompressMode -> IO (ConduitT v (GRpcReply r) IO ())) )
|
, handler ~ (CompressMode -> IO (ConduitT v Void IO (), ConduitT () r IO (GRpcReply ()))))
|
||||||
=> GRpcMethodCall p ('Method name '[ 'ArgStream aname vref ]
|
=> GRpcMethodCall p ('Method name '[ 'ArgStream aname vref ]
|
||||||
('RetStream rref)) handler where
|
('RetStream rref)) handler where
|
||||||
gRpcMethodCall rpc _ client compress
|
gRpcMethodCall rpc _ client compress
|
||||||
= do -- Create a new TMChan
|
= do serverChan <- newTMChanIO :: IO (TMChan r)
|
||||||
inchan <- newTMChanIO :: IO (TMChan (GRpcReply r))
|
clientChan <- newTMChanIO :: IO (TMChan v)
|
||||||
outchan <- newTMChanIO :: IO (TMChan v)
|
finalReply <- newEmptyTMVarIO :: IO (TMVar (GRpcReply ()))
|
||||||
var <- newEmptyTMVarIO -- if full, this means an error
|
|
||||||
-- Start executing the client in another thread
|
-- Start executing the client in another thread
|
||||||
|
-- TODO: Is there anything that makes sure that this thread doesn't keep running forever?
|
||||||
_ <- async $ do
|
_ <- async $ do
|
||||||
v <- simplifyResponse $
|
v <- simplifyResponse $
|
||||||
buildGRpcReply3 <$>
|
buildGRpcReply3 <$>
|
||||||
rawGeneralStream
|
rawGeneralStream
|
||||||
@_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r)
|
@_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r)
|
||||||
rpc client
|
rpc client
|
||||||
() (\_ ievent -> do -- on the first iteration, say that everything is OK
|
() (incomingEventConsumer serverChan)
|
||||||
_ <- liftIO $ atomically $ tryPutTMVar var (GRpcOk ())
|
() (outgoingEventProducer clientChan)
|
||||||
case ievent of
|
liftIO $ atomically $ putTMVar finalReply v
|
||||||
RecvMessage o -> liftIO $ atomically $ writeTMChan inchan (GRpcOk $ unGRpcOWTy(Proxy @p) (Proxy @rref) o)
|
let clientConduit = do
|
||||||
Invalid e -> liftIO $ atomically $ writeTMChan inchan (GRpcErrorString (show e))
|
sinkTMChan clientChan
|
||||||
_ -> pure () )
|
liftIO . atomically . closeTMChan $ clientChan
|
||||||
() (\_ -> do
|
serverConduit = do
|
||||||
nextVal <- liftIO $ atomically $ readTMChan outchan
|
sourceTMChan serverChan
|
||||||
case nextVal of
|
liftIO . atomically . readTMVar $ finalReply
|
||||||
Nothing -> pure ((), Finalize)
|
pure (clientConduit, serverConduit)
|
||||||
Just v -> pure ((), SendMessage compress (buildGRpcIWTy (Proxy @p) (Proxy @vref) v)))
|
where
|
||||||
case v of
|
incomingEventConsumer :: TMChan r -> () -> IncomingEvent (GRpcOWTy p rref r) () -> ExceptT ClientError IO ()
|
||||||
GRpcOk () -> liftIO $ atomically $ closeTMChan inchan
|
incomingEventConsumer serverChan _ ievent =
|
||||||
_ -> liftIO $ atomically $ putTMVar var v
|
case ievent of
|
||||||
-- This conduit feeds information to the other thread
|
RecvMessage o -> do
|
||||||
let go = do err <- liftIO $ atomically $ takeTMVar var
|
liftIO $ atomically $ writeTMChan serverChan (unGRpcOWTy (Proxy @p) (Proxy @rref) o)
|
||||||
case err of
|
Invalid e -> liftIO $ do
|
||||||
GRpcOk _ -> go2
|
atomically $ closeTMChan serverChan
|
||||||
e -> yield $ (\_ -> error "this should never happen") <$> e
|
throwIO e
|
||||||
go2 = do nextOut <- await
|
Trailers _ ->
|
||||||
case nextOut of
|
-- TODO: Read the trailers and use them to make the 'finalReply'
|
||||||
Just v -> do liftIO $ atomically $ writeTMChan outchan v
|
liftIO $ atomically $ closeTMChan serverChan
|
||||||
go2
|
Headers _ ->
|
||||||
Nothing -> do r <- liftIO $ atomically $ tryReadTMChan inchan
|
-- TODO: Read the headers and use them to make the 'finalReply'
|
||||||
case r of
|
pure ()
|
||||||
Nothing -> pure () -- both are empty, end
|
|
||||||
Just Nothing -> go2
|
outgoingEventProducer :: TMChan v -> () -> ExceptT ClientError IO ((), OutgoingEvent (GRpcIWTy p vref v) ())
|
||||||
Just (Just nextIn) -> yield nextIn >> go2
|
outgoingEventProducer clientChan _ = do
|
||||||
pure go
|
nextVal <- liftIO $ atomically $ readTMChan clientChan
|
||||||
|
case nextVal of
|
||||||
|
Nothing -> pure ((), Finalize)
|
||||||
|
Just v -> pure ((), SendMessage compress (buildGRpcIWTy (Proxy @p) (Proxy @vref) v))
|
||||||
|
Loading…
Reference in New Issue
Block a user