{-|
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 #-}
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    (Message, Mutability(Const))
import Text.Show.Pretty (ppShow)

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

-- | A @'Transport'@ handles transmitting RPC messages.
data Transport = Transport
    { Transport -> Message 'Const -> IO ()
sendMsg :: Message 'Const -> IO ()
    -- ^ Send a message
    , Transport -> IO (Message 'Const)
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 -> WordCount -> Transport
handleTransport Handle
handle WordCount
limit = Transport :: (Message 'Const -> IO ()) -> IO (Message 'Const) -> Transport
Transport
    { sendMsg :: Message 'Const -> IO ()
sendMsg = Handle -> Message 'Const -> IO ()
hPutMsg Handle
handle
    , recvMsg :: IO (Message 'Const)
recvMsg = Handle -> WordCount -> IO (Message 'Const)
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 :: (Message 'Const -> IO ()) -> IO (Message 'Const) -> Transport
Transport
    { sendMsg :: Message 'Const -> IO ()
sendMsg = Socket -> Message 'Const -> IO ()
sPutMsg Socket
socket
    , recvMsg :: IO (Message 'Const)
recvMsg = Socket -> WordCount -> IO (Message 'Const)
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 :: (Message 'Const -> IO ()) -> IO (Message 'Const) -> Transport
Transport
    { sendMsg :: Message 'Const -> IO ()
sendMsg = \Message 'Const
msg -> do
        Message
rpcMsg <- Message 'Const -> IO Message
forall (m :: * -> *) (mut :: Mutability) a.
(MonadThrow m, MonadReadMessage mut (LimitT m),
 MonadReadMessage mut m, FromStruct mut a) =>
Message mut -> m a
msgToValue Message 'Const
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 -> Message 'Const -> IO ()
sendMsg Transport
trans Message 'Const
msg
    , recvMsg :: IO (Message 'Const)
recvMsg = do
        Message 'Const
msg <- Transport -> IO (Message 'Const)
recvMsg Transport
trans
        Message
rpcMsg <- Message 'Const -> IO Message
forall (m :: * -> *) (mut :: Mutability) a.
(MonadThrow m, MonadReadMessage mut (LimitT m),
 MonadReadMessage mut m, FromStruct mut a) =>
Message mut -> m a
msgToValue Message 'Const
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)
        Message 'Const -> IO (Message 'Const)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Message 'Const
msg
    }