{-|
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.
-}
module Capnp.Rpc.Transport
    ( Transport(..)
    , handleTransport
    , socketTransport
    , tracingTransport
    ) where

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

import Capnp.Bits       (WordCount)
import Capnp.Convert    (msgToValue)
import Capnp.IO         (hGetMsg, hPutMsg, sGetMsg, sPutMsg)
import Capnp.Message    (ConstMsg)
import Text.Show.Pretty (ppShow)

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

-- | A @'Transport'@ handles transmitting RPC messages.
data Transport = Transport
    { Transport -> ConstMsg -> IO ()
sendMsg :: ConstMsg -> IO ()
    -- ^ Send a message
    , Transport -> IO ConstMsg
recvMsg :: IO ConstMsg
    -- ^ 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 -> WordCount -> Transport
handleTransport Handle
handle WordCount
limit = Transport :: (ConstMsg -> IO ()) -> IO ConstMsg -> Transport
Transport
    { sendMsg :: ConstMsg -> IO ()
sendMsg = Handle -> ConstMsg -> IO ()
hPutMsg Handle
handle
    , recvMsg :: IO ConstMsg
recvMsg = Handle -> WordCount -> IO ConstMsg
hGetMsg Handle
handle WordCount
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 -> WordCount -> Transport
socketTransport Socket
socket WordCount
limit = Transport :: (ConstMsg -> IO ()) -> IO ConstMsg -> Transport
Transport
    { sendMsg :: ConstMsg -> IO ()
sendMsg = Socket -> ConstMsg -> IO ()
sPutMsg Socket
socket
    , recvMsg :: IO ConstMsg
recvMsg = Socket -> WordCount -> IO ConstMsg
sGetMsg Socket
socket WordCount
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 :: (String -> IO ()) -> Transport -> Transport
tracingTransport String -> IO ()
log Transport
trans = Transport :: (ConstMsg -> IO ()) -> IO ConstMsg -> Transport
Transport
    { sendMsg :: ConstMsg -> IO ()
sendMsg = \ConstMsg
msg -> do
        Message
rpcMsg <- ConstMsg -> IO Message
forall (m :: * -> *) msg a.
(MonadThrow m, Message (LimitT m) msg, Message m msg,
 FromStruct msg a) =>
msg -> m a
msgToValue ConstMsg
msg
        String -> IO ()
log (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"sending message: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Message -> String
forall a. Show a => a -> String
ppShow (Message
rpcMsg :: R.Message)
        Transport -> ConstMsg -> IO ()
sendMsg Transport
trans ConstMsg
msg
    , recvMsg :: IO ConstMsg
recvMsg = do
        ConstMsg
msg <- Transport -> IO ConstMsg
recvMsg Transport
trans
        Message
rpcMsg <- ConstMsg -> IO Message
forall (m :: * -> *) msg a.
(MonadThrow m, Message (LimitT m) msg, Message m msg,
 FromStruct msg a) =>
msg -> m a
msgToValue ConstMsg
msg
        String -> IO ()
log (String -> IO ()) -> String -> IO ()
forall a b. (a -> b) -> a -> b
$ String
"received message: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Message -> String
forall a. Show a => a -> String
ppShow (Message
rpcMsg :: R.Message)
        ConstMsg -> IO ConstMsg
forall (f :: * -> *) a. Applicative f => a -> f a
pure ConstMsg
msg
    }