[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.

grpc/client/src/Mu/GRpc/Client/Internal.hs

@@ -21,6 +21,7 @@ import           Control.Concurrent.Async
 import           Control.Concurrent.STM        (atomically)
 import           Control.Concurrent.STM.TMChan
 import           Control.Concurrent.STM.TMVar
+import           Control.Exception (throwIO)
 import           Control.Monad.IO.Class
 import           Data.Avro
 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.HTTP2                 (ErrorCode)
 import           Network.HTTP2.Client          (ClientError, ClientIO, TooMuchConcurrency,
-                                                runExceptT)
+                                                runExceptT, ExceptT)
 
 import           Mu.Adapter.ProtoBuf.Via
 import           Mu.GRpc.Avro
@@ -304,47 +305,50 @@ conduitFromChannel chan promise = go
 
 instance ( KnownName name
          , 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 ]
                                       ('RetStream rref)) handler where
   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
+         -- TODO: Is there anything that makes sure that this thread doesn't keep running forever?
          _ <- async $ do
             v <- simplifyResponse $
                  buildGRpcReply3 <$>
                  rawGeneralStream
                    @_ @(GRpcIWTy p vref v) @(GRpcOWTy p rref r)
                    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))