content: -- | Node with server role (i.e., its peer is a client)
  module Network.GRPC.Util.Session.Server (
      ConnectionToClient(..)
    , setupResponseChannel
    ) where
  
  import Network.HTTP2.Server qualified as Server
  
  import Network.GRPC.Util.HTTP2.Stream
  import Network.GRPC.Util.Session.API
  import Network.GRPC.Util.Session.Channel
  import Network.GRPC.Util.Thread
  
  {-------------------------------------------------------------------------------
    Connection
  -------------------------------------------------------------------------------}
  
  -- | Connection to the client, as provided by @http2@
  data ConnectionToClient = ConnectionToClient {
        request :: Server.Request
      , respond :: Server.Response -> IO ()
      }
  
  {-------------------------------------------------------------------------------
    Initiate response
  -------------------------------------------------------------------------------}
  
  -- | Setup response channel
  --
  -- Notes:
  --
  -- * The actual response will not immediately be initiated; see below.
  -- * We assume that the client is allowed to close their outbound stream to us.
  -- * 'setupResponseChannel' will not throw any exceptions.
  setupResponseChannel :: forall sess.
       IsSession sess
    => sess
    -> ConnectionToClient
    -> FlowStart (Inbound sess)
    -> IO (FlowStart (Outbound sess), ResponseInfo)
    -- ^ Construct headers for the initial response
    --
    -- This function is allowed to block. If it does, no response will not be
    -- initiated until it returns.
    --
    -- If this function throws an exception, the response is never initiated;
    -- this is treated the same was as when we fail to set up the outbound
    -- connection due to a network failure.
    -> IO (Channel sess)
  setupResponseChannel sess
                       conn
                       inboundStart
                       startOutbound
                     = do
      channel <- initChannel
  
      forkThread "grapesy:serverInbound" (channelInbound channel) $
        \unmask markReady _debugId -> unmask $
          linkOutboundToInbound ContinueWhenInboundClosed channel $ do
            case inboundStart of
              FlowStartRegular headers -> do
                regular <- initFlowStateRegular headers
                stream  <- serverInputStream (request conn)
                markReady $ FlowStateRegular regular
                Right <$> recvMessageLoop sess regular stream
              FlowStartNoMessages trailers -> do
                -- The client sent a request with an empty body
                markReady $ FlowStateNoMessages trailers
                return $ Left trailers
                -- Thread terminates immediately
  
      forkThread "grapesy:serverOutbound" (channelOutbound channel) $
        \unmask markReady _debugId -> unmask $ do
          (outboundStart, responseInfo) <- startOutbound
          case outboundStart of
            FlowStartRegular headers -> do
              regular <- initFlowStateRegular headers
              markReady $ FlowStateRegular regular
              let resp :: Server.Response
                  resp = setResponseTrailers sess channel regular
                       $ Server.responseStreamingIface
                               (responseStatus  responseInfo)
                               (responseHeaders responseInfo)
                       $ \iface -> do
                            stream <- serverOutputStream iface
                            sendMessageLoop sess regular stream
              respond conn resp
            FlowStartNoMessages trailers -> do
              markReady $ FlowStateNoMessages trailers
              let resp :: Server.Response
                  resp = Server.responseNoBody
                           (responseStatus  responseInfo)
                           (responseHeaders responseInfo)
              respond conn $ resp
  
      return channel
  
  {-------------------------------------------------------------------------------
    Auxiliary http2
  -------------------------------------------------------------------------------}
  
  setResponseTrailers ::
       IsSession sess
    => sess
    -> Channel sess
    -> RegularFlowState (Outbound sess)
    -> Server.Response -> Server.Response
  setResponseTrailers sess channel regular resp =
      Server.setResponseTrailersMaker resp $
        outboundTrailersMaker sess channel regular
  