Fix outboundTrailersMaker

In current `http2`, `respond` returns when the body is sent and before the
trailers are constructed. In the new `http2` architecture, `respond` does not
return until *after* trailers are constructed, which deadlocks `grapesy`.

util/Network/GRPC/Util/Session/Channel.hs

@@ -611,20 +611,18 @@ outboundTrailersMaker :: forall sess.
      IsSession sess
   => sess
   -> Channel sess
+  -> RegularFlowState (Outbound sess)
   -> HTTP2.TrailersMaker
-outboundTrailersMaker sess channel = go
+outboundTrailersMaker sess Channel{channelOutbound} regular = go
   where
     go :: HTTP2.TrailersMaker
     go (Just _) = return $ HTTP2.NextTrailersMaker go
     go Nothing  = do
-        -- Wait for the thread to terminate
-        --
-        -- If the thread was killed, this will throw an exception (which will
-        -- then result in @http2@ cancelling the corresponding stream).
-        flowState <- waitForOutbound channel
-        trailers  <- case flowState of
-                       FlowStateRegular regular ->
-                         atomically $ readTMVar $ flowTerminated regular
-                       FlowStateNoMessages _ ->
-                         error "unexpected FlowStateNoMessages"
-        return $ HTTP2.Trailers $ buildOutboundTrailers sess trailers
+        mFlowState <- atomically $ do
+                   (Right <$> readTMVar (flowTerminated regular))
+          `orElse` (Left <$> waitForAbnormalThreadTermination channelOutbound)
+        case mFlowState of
+            Right trailers ->
+              return $ HTTP2.Trailers $ buildOutboundTrailers sess trailers
+            Left _exception ->
+              return $ HTTP2.Trailers []

util/Network/GRPC/Util/Session/Server.hs

@@ -77,7 +77,7 @@ setupResponseChannel sess
             regular <- initFlowStateRegular headers
             markReady $ FlowStateRegular regular
             let resp :: Server.Response
-                resp = setResponseTrailers sess channel
+                resp = setResponseTrailers sess channel regular
                      $ Server.responseStreaming
                              (responseStatus  responseInfo)
                              (responseHeaders responseInfo)
@@ -103,7 +103,8 @@ setResponseTrailers ::
      IsSession sess
   => sess
   -> Channel sess
+  -> RegularFlowState (Outbound sess)
   -> Server.Response -> Server.Response
-setResponseTrailers sess channel resp =
+setResponseTrailers sess channel regular resp =
     Server.setResponseTrailersMaker resp $
-      outboundTrailersMaker sess channel
+      outboundTrailersMaker sess channel regular

util/Network/GRPC/Util/Thread.hs

@@ -16,6 +16,7 @@ module Network.GRPC.Util.Thread (
   , cancelThread
   , withThreadInterface
   , waitForNormalThreadTermination
+  , waitForAbnormalThreadTermination
   , waitForNormalOrAbnormalThreadTermination
   , hasThreadTerminated
   ) where
@@ -316,6 +317,15 @@ waitForNormalOrAbnormalThreadTermination ::
 waitForNormalOrAbnormalThreadTermination state =
     hasThreadTerminated state >>= maybe retry return
 
+-- | Wait for the thread to terminate abnormally
+waitForAbnormalThreadTermination ::
+     TVar (ThreadState a)
+  -> STM SomeException
+waitForAbnormalThreadTermination state =
+    hasThreadTerminated state >>= \case
+      Just (Left e) -> return e
+      _otherwise    -> retry
+
 -- | Has the thread terminated?
 hasThreadTerminated ::
      TVar (ThreadState a)