{-|
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
    { 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
        Parsed Message
rpcMsg <- WordCount -> LimitT IO (Parsed Message) -> IO (Parsed Message)
forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT WordCount
forall a. Bounded a => a
maxBound (LimitT IO (Parsed Message) -> IO (Parsed Message))
-> LimitT IO (Parsed Message) -> IO (Parsed Message)
forall a b. (a -> b) -> a -> b
$ Message 'Const -> LimitT IO (Parsed Message)
forall a (m :: * -> *) pa.
(ReadCtx m 'Const, IsStruct a, Parse a pa) =>
Message 'Const -> m pa
msgToParsed @R.Message 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]
++ Parsed Message -> String
forall a. Show a => a -> String
ppShow Parsed Message
rpcMsg
        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
        Parsed Message
rpcMsg <- WordCount -> LimitT IO (Parsed Message) -> IO (Parsed Message)
forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT WordCount
forall a. Bounded a => a
maxBound (LimitT IO (Parsed Message) -> IO (Parsed Message))
-> LimitT IO (Parsed Message) -> IO (Parsed Message)
forall a b. (a -> b) -> a -> b
$ Message 'Const -> LimitT IO (Parsed Message)
forall a (m :: * -> *) pa.
(ReadCtx m 'Const, IsStruct a, Parse a pa) =>
Message 'Const -> m pa
msgToParsed @R.Message 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]
++ Parsed Message -> String
forall a. Show a => a -> String
ppShow Parsed Message
rpcMsg
        Message 'Const -> IO (Message 'Const)
forall (f :: * -> *) a. Applicative f => a -> f a
pure Message 'Const
msg
    }