Safe Haskell | None |
---|---|
Language | Haskell2010 |
For efficiency reasons, Store
does not provide facilities for
incrementally consuming input. In order to avoid partial input, this
module introduces Message
s that wrap values of instances of Store
.
In addition to the serialisation of a value, the serialised message also contains the length of the serialisation. This way, instead of consuming input incrementally, more input can be demanded before serialisation is attempted in the first place.
Each message starts with a fixed magic number, in order to detect (randomly) invalid data.
- newtype Message a = Message {
- fromMessage :: a
- encodeMessage :: Store a => Message a -> ByteString
- type PeekMessage i m a = FT ((->) i) m a
- type FillByteBuffer i m = ByteBuffer -> Int -> i -> m ()
- peekMessage :: (MonadIO m, Store a) => FillByteBuffer i m -> ByteBuffer -> PeekMessage i m (Message a)
- decodeMessage :: (Store a, MonadIO m) => FillByteBuffer i m -> ByteBuffer -> m (Maybe i) -> m (Maybe (Message a))
- peekMessageBS :: (MonadIO m, Store a) => ByteBuffer -> PeekMessage ByteString m (Message a)
- decodeMessageBS :: (MonadIO m, Store a) => ByteBuffer -> m (Maybe ByteString) -> m (Maybe (Message a))
- data ReadMoreData = ReadMoreData
- peekMessageFd :: (MonadIO m, Store a) => ByteBuffer -> Fd -> PeekMessage ReadMoreData m (Message a)
- decodeMessageFd :: (MonadIO m, Store a) => ByteBuffer -> Fd -> m (Message a)
- conduitEncode :: (Monad m, Store a) => Conduit (Message a) m ByteString
- conduitDecode :: (MonadResource m, Store a) => Maybe Int -> Conduit ByteString m (Message a)
Message
s to stream data using Store
for serialisation.
If a
is an instance of Store
, Message a
can be serialised
and deserialised in a streaming fashion.
Message | |
|
Encoding Message
s
encodeMessage :: Store a => Message a -> ByteString Source #
Encode a Message
to a ByteString
.
Decoding Message
s
type PeekMessage i m a = FT ((->) i) m a Source #
The result of peeking at the next message can either be a successfully deserialised object, or a request for more input.
type FillByteBuffer i m = ByteBuffer -> Int -> i -> m () Source #
Given some sort of input, fills the ByteBuffer
with it.
The Int
is how many bytes we'd like: this is useful when the filling
function is fillFromFd
, where we can specify a max size.
peekMessage :: (MonadIO m, Store a) => FillByteBuffer i m -> ByteBuffer -> PeekMessage i m (Message a) Source #
Decode some object from a ByteBuffer
, by first reading its
header, and then the actual data.
decodeMessage :: (Store a, MonadIO m) => FillByteBuffer i m -> ByteBuffer -> m (Maybe i) -> m (Maybe (Message a)) Source #
Decode a Message
from a ByteBuffer
and an action that can get
additional inputs to refill the buffer when necessary.
The only conditions under which this function will give Nothing
,
is when the ByteBuffer
contains zero bytes, and refilling yields
Nothing
. If there is some data available, but not enough to
decode the whole Message
, a PeekException
will be thrown.
peekMessageBS :: (MonadIO m, Store a) => ByteBuffer -> PeekMessage ByteString m (Message a) Source #
Decode some Message
from a ByteBuffer
, by first reading its
header, and then the actual Message
.
decodeMessageBS :: (MonadIO m, Store a) => ByteBuffer -> m (Maybe ByteString) -> m (Maybe (Message a)) Source #
data ReadMoreData Source #
We use this type as a more descriptive unit to signal that more input should be read from the Fd.
This data-type is only available on POSIX systems (essentially, non-windows)
peekMessageFd :: (MonadIO m, Store a) => ByteBuffer -> Fd -> PeekMessage ReadMoreData m (Message a) Source #
Peeks a message from a _non blocking_ Fd
.
This function is only available on POSIX systems (essentially, non-windows)
decodeMessageFd :: (MonadIO m, Store a) => ByteBuffer -> Fd -> m (Message a) Source #
Decodes all the message using registerFd
to find out when a Socket
is
ready for reading.
This function is only available on POSIX systems (essentially, non-windows)
Conduits for encoding and decoding
conduitEncode :: (Monad m, Store a) => Conduit (Message a) m ByteString Source #
Conduit for encoding Message
s to ByteString
s.
:: (MonadResource m, Store a) | |
=> Maybe Int | Initial length of the |
-> Conduit ByteString m (Message a) |
Conduit for decoding Message
s from ByteString
s.