| Safe Haskell | None |
|---|---|
| Language | Haskell2010 |
Capnp.Message
Contents
Description
This module provides support for working directly with Cap'N Proto messages.
Synopsis
- hPutMsg :: Handle -> ConstMsg -> IO ()
- hGetMsg :: Handle -> WordCount -> IO ConstMsg
- putMsg :: ConstMsg -> IO ()
- getMsg :: WordCount -> IO ConstMsg
- readMessage :: (MonadThrow m, MonadLimit m) => m Word32 -> (WordCount -> m (Segment ConstMsg)) -> m ConstMsg
- writeMessage :: MonadThrow m => ConstMsg -> (Word32 -> m ()) -> (Segment ConstMsg -> m ()) -> m ()
- maxSegmentSize :: Int
- maxSegments :: Int
- maxCaps :: Int
- encode :: Monad m => ConstMsg -> m Builder
- decode :: MonadThrow m => ByteString -> m ConstMsg
- class Monad m => Message m msg where
- data Segment msg
- numSegs :: msg -> m Int
- numWords :: Segment msg -> m WordCount
- numCaps :: msg -> m Int
- internalGetSeg :: msg -> Int -> m (Segment msg)
- internalGetCap :: msg -> Int -> m Client
- slice :: WordCount -> WordCount -> Segment msg -> m (Segment msg)
- read :: Segment msg -> WordCount -> m Word64
- fromByteString :: ByteString -> m (Segment msg)
- toByteString :: Segment msg -> m ByteString
- data ConstMsg
- empty :: ConstMsg
- getSegment :: (MonadThrow m, Message m msg) => msg -> Int -> m (Segment msg)
- getWord :: (MonadThrow m, Message m msg) => msg -> WordAddr -> m Word64
- getCap :: (MonadThrow m, Message m msg) => msg -> Int -> m Client
- getCapTable :: ConstMsg -> Vector Client
- data MutMsg s
- newMessage :: WriteCtx m s => Maybe WordCount -> m (MutMsg s)
- alloc :: WriteCtx m s => MutMsg s -> WordCount -> m WordAddr
- allocInSeg :: WriteCtx m s => MutMsg s -> Int -> WordCount -> m WordAddr
- newSegment :: WriteCtx m s => MutMsg s -> Int -> m (Int, Segment (MutMsg s))
- setSegment :: (WriteCtx m s, MonadThrow m) => MutMsg s -> Int -> Segment (MutMsg s) -> m ()
- setWord :: (WriteCtx m s, MonadThrow m) => MutMsg s -> WordAddr -> Word64 -> m ()
- setCap :: (WriteCtx m s, MonadThrow m) => MutMsg s -> Int -> Client -> m ()
- appendCap :: WriteCtx m s => MutMsg s -> Client -> m Int
- type WriteCtx m s = (PrimMonad m, s ~ PrimState m, MonadThrow m)
- data Client
- nullClient :: Client
- withCapTable :: Vector Client -> ConstMsg -> ConstMsg
Reading and writing messages
hGetMsg :: Handle -> WordCount -> IO ConstMsg Source #
reads a message from hGetMsg handle limithandle that is at most
limit 64-bit words in length.
readMessage :: (MonadThrow m, MonadLimit m) => m Word32 -> (WordCount -> m (Segment ConstMsg)) -> m ConstMsg Source #
reads in a message using the
monadic context, which should manage the current read position,
into a message. read32 should read a 32-bit little-endian integer,
and readMessage read32 readSegmentreadSegment n should read a blob of n 64-bit words.
The size of the message (in 64-bit words) is deducted from the traversal,
limit which can be used to set the maximum message size.
writeMessage :: MonadThrow m => ConstMsg -> (Word32 -> m ()) -> (Segment ConstMsg -> m ()) -> m () Source #
writes out the message. writeMesage write32 writeSegmentwrite32
should write a 32-bit word in little-endian format to the output stream.
writeSegment should write a blob.
Limits on message size
maxSegmentSize :: Int Source #
The maximum size of a segment supported by this libarary, in words.
maxSegments :: Int Source #
The maximum number of segments allowed in a message by this library.
Converting between messages and ByteStrings
encode :: Monad m => ConstMsg -> m Builder Source #
encode encodes a message as a bytestring builder.
decode :: MonadThrow m => ByteString -> m ConstMsg Source #
decode decodes a message from a bytestring.
The segments will not be copied; the resulting message will be a view into the original bytestring. Runs in O(number of segments in the message).
Message type class
class Monad m => Message m msg where Source #
A Message is a (possibly read-only) capnproto message. It is
parameterized over a monad in which operations are performed.
Methods
numSegs :: msg -> m Int Source #
numSegs gets the number of segments in a message.
numWords :: Segment msg -> m WordCount Source #
numWords gets the number of words in a segment.
numCaps :: msg -> m Int Source #
numCaps gets the number of capabilities in a message's capability
table.
internalGetSeg :: msg -> Int -> m (Segment msg) Source #
gets the segment at index internalGetSeg message indexindex
in message. Most callers should use the getSegment wrapper, instead
of calling this directly.
internalGetCap :: msg -> Int -> m Client Source #
reads a capability from the message's
capability table, returning the client. does not check bounds. Callers
should use getCap instead.internalGetCap cap index
slice :: WordCount -> WordCount -> Segment msg -> m (Segment msg) Source #
extracts a sub-section of the segment,
starting at index slice start length segmentstart, of length length.
read :: Segment msg -> WordCount -> m Word64 Source #
reads a 64-bit word from the segement at the
given index. Consider using read segment indexgetWord on the message, instead of
calling this directly.
fromByteString :: ByteString -> m (Segment msg) Source #
Convert a ByteString to a segment.
toByteString :: Segment msg -> m ByteString Source #
Convert a segment to a byte string.
Instances
Immutable messages
A read-only capnproto message.
ConstMsg is an instance of the generic Message type class. its
implementations of toByteString and fromByteString are O(1);
the underlying bytes are not copied.
Instances
empty is an empty message, i.e. a minimal message with a null pointer as
its root object.
Reading data from messages
getSegment :: (MonadThrow m, Message m msg) => msg -> Int -> m (Segment msg) Source #
fetches the given segment in the message.
It throws a getSegment message indexBoundsError if the address is out of bounds.
getWord :: (MonadThrow m, Message m msg) => msg -> WordAddr -> m Word64 Source #
returns the word at getWord msg addraddr within msg. It throws a
BoundsError if the address is out of bounds.
getCap :: (MonadThrow m, Message m msg) => msg -> Int -> m Client Source #
gets the capability with the given index from
the message. throws getCap message indexBoundsError if the index is out
of bounds.
getCapTable :: ConstMsg -> Vector Client Source #
getCapTable gets the capability table from a ConstMsg.
Mutable Messages
A MutMsg is a mutable capnproto message. The type parameter s is the
state token for the instance of PrimMonad in which the message may be
modified.
Due to mutabilty, the implementations of toByteString and fromByteString
must make full copies, and so are O(n) in the length of the segment.
Instances
newMessage :: WriteCtx m s => Maybe WordCount -> m (MutMsg s) Source #
allocates a new empty message, with a single segment
having capacity newMessage sizeHintsizeHint. If sizeHint is Nothing, defaults to a sensible
value.
Allocating space in messages
alloc :: WriteCtx m s => MutMsg s -> WordCount -> m WordAddr Source #
allocates alloc sizesize words within a message. it returns the
starting address of the allocated memory.
allocInSeg :: WriteCtx m s => MutMsg s -> Int -> WordCount -> m WordAddr Source #
Like alloc, but the second argument allows the caller to specify the
index of the segment in which to allocate the data.
newSegment :: WriteCtx m s => MutMsg s -> Int -> m (Int, Segment (MutMsg s)) Source #
allocates a new, initially empty segment in
newSegment msg sizeHintmsg with a capacity of sizeHint. It returns the a pair of the segment
number and the segment itself. Amortized O(1).
Modifying messages
setSegment :: (WriteCtx m s, MonadThrow m) => MutMsg s -> Int -> Segment (MutMsg s) -> m () Source #
sets the segment at the given index
in the message. It throws a setSegment message index segmentBoundsError if the address is out of bounds.
setWord :: (WriteCtx m s, MonadThrow m) => MutMsg s -> WordAddr -> Word64 -> m () Source #
sets the word at setWord message address valueaddress in the
message to value. If the address is not valid in the message, a
BoundsError will be thrown.
setCap :: (WriteCtx m s, MonadThrow m) => MutMsg s -> Int -> Client -> m () Source #
sets the sets the capability at setCap message index capindex in
the message's capability table to cap. If the index is out of bounds, a
BoundsError will be thrown.
appendCap :: WriteCtx m s => MutMsg s -> Client -> m Int Source #
appendCap appends a new capabilty to the end of a message's capability
table, returning its index.
type WriteCtx m s = (PrimMonad m, s ~ PrimState m, MonadThrow m) Source #
WriteCtx is the context needed for most write operations.
nullClient :: Client Source #
withCapTable :: Vector Client -> ConstMsg -> ConstMsg Source #
replaces the capability table in the message.withCapTable