Transport.hs

{-|
Module: Capnp.Rpc.Transport
Description: Support for exchanging messages with remote vats.

This module provides a 'Transport' type, which provides operations
used to transmit messages between vats in the RPC protocol.
-}
{-# LANGUAGE DataKinds        #-}
{-# LANGUAGE TypeApplications #-}
module Capnp.Rpc.Transport
    ( Transport(..)
    , handleTransport
    , socketTransport
    , tracingTransport
    ) where

import Network.Socket (Socket)
import System.IO      (Handle)

import Capnp.Bits           (WordCount)
import Capnp.Convert        (msgToParsed)
import Capnp.IO             (hGetMsg, hPutMsg, sGetMsg, sPutMsg)
import Capnp.Message        (Message, Mutability(Const))
import Capnp.TraversalLimit (evalLimitT)
import Text.Show.Pretty     (ppShow)

import qualified Capnp.Gen.Capnp.Rpc.New as R

-- | A @'Transport'@ handles transmitting RPC messages.
data Transport = Transport
    { sendMsg :: Message 'Const -> IO ()
    -- ^ Send a message
    , recvMsg :: IO (Message 'Const)
    -- ^ Receive a message
    }

-- | @'handleTransport' handle limit@ is a transport which reads and writes
-- messages from/to @handle@. It uses @limit@ as the traversal limit when
-- reading messages and decoding.
handleTransport :: Handle -> WordCount -> Transport
handleTransport handle limit = Transport
    { sendMsg = hPutMsg handle
    , recvMsg = hGetMsg handle limit
    }

-- | @'socketTransport' socket limit@ is a transport which reads and writes
-- messages to/from a socket. It uses @limit@ as the traversal limit when
-- reading messages and decoing.
socketTransport :: Socket -> WordCount -> Transport
socketTransport socket limit = Transport
    { sendMsg = sPutMsg socket
    , recvMsg = sGetMsg socket limit
    }

-- | @'tracingTransport' log trans@ wraps another transport @trans@, loging
-- messages when they are sent or received (using the @log@ function). This
-- can be useful for debugging.
tracingTransport :: (String -> IO ()) -> Transport -> Transport
tracingTransport log trans = Transport
    { sendMsg = \msg -> do
        rpcMsg <- evalLimitT maxBound $ msgToParsed @R.Message msg
        log $ "sending message: " ++ ppShow rpcMsg
        sendMsg trans msg
    , recvMsg = do
        msg <- recvMsg trans
        rpcMsg <- evalLimitT maxBound $ msgToParsed @R.Message msg
        log $ "received message: " ++ ppShow rpcMsg
        pure msg
    }