{-# 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
data Transport = Transport
{ Transport -> Message 'Const -> IO ()
sendMsg :: Message 'Const -> IO ()
, Transport -> IO (Message 'Const)
recvMsg :: IO (Message 'Const)
}
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 -> 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 :: (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
}