{-|
Module: Capnp.Basics
Description: Handling of "basic" capnp datatypes.

In particular

* 'Text' and 'Data' (which are primitive types in the schema language,
  but are both the same as @List(UInt8)@ on the wire).
* Lists of types other than those in "Capnp.Untyped".
  Whereas 'U.ListOf' only deals with low-level encodings of lists,
  this module's 'List' type can represent typed lists.
-}
{-# LANGUAGE FlexibleInstances     #-}
{-# LANGUAGE GADTs                 #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE TypeFamilies          #-}
module Capnp.Basics
    ( Text
    , Data(..)
    , ListElem(..)
    , MutListElem(..)
    , getData
    , getText
    , newData
    , newText
    , dataBytes
    , textBuffer
    , textBytes
    ) where

import Data.Word

import Control.Monad       (when, (>=>))
import Control.Monad.Catch (MonadThrow(throwM))

import qualified Data.ByteString as BS

import Capnp.Classes (FromPtr (..), ListElem (..), MutListElem (..), ToPtr (..))
import Internal.Gen.Instances ()

import qualified Capnp.Errors  as E
import qualified Capnp.Message as M
import qualified Capnp.Untyped as U


-- | A textual string (@Text@ in capnproto's schema language). On the wire,
-- this is NUL-terminated. The encoding should be UTF-8, but the library
-- /does not/ verify this; users of the library must do validation themselves, if
-- they care about this.
--
-- Rationale: validation would require doing an up-front pass over the data,
-- which runs counter to the overall design of capnproto.
newtype Text msg = Text (U.ListOf msg Word8)
-- The argument to the data constructor is the slice of the original message
-- containing the text, including the NUL terminator.

-- | A blob of bytes (@Data@ in capnproto's schema language). The argument
-- to the data constructor is a slice into the message, containing the raw
-- bytes.
newtype Data msg = Data (U.ListOf msg Word8)

-- | @'newData' msg len@ allocates a new data blob of length @len@ bytes
-- inside the message.
newData :: M.WriteCtx m s => M.MutMsg s -> Int -> m (Data (M.MutMsg s))
newData :: MutMsg s -> Int -> m (Data (MutMsg s))
newData MutMsg s
msg Int
len = ListOf (MutMsg s) Word8 -> Data (MutMsg s)
forall msg. ListOf msg Word8 -> Data msg
Data (ListOf (MutMsg s) Word8 -> Data (MutMsg s))
-> m (ListOf (MutMsg s) Word8) -> m (Data (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s -> Int -> m (ListOf (MutMsg s) Word8)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word8)
U.allocList8 MutMsg s
msg Int
len

-- | Interpret a list of 'Word8' as a capnproto 'Data' value.
getData :: U.ReadCtx m msg => U.ListOf msg Word8 -> m (Data msg)
getData :: ListOf msg Word8 -> m (Data msg)
getData = Data msg -> m (Data msg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Data msg -> m (Data msg))
-> (ListOf msg Word8 -> Data msg)
-> ListOf msg Word8
-> m (Data msg)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ListOf msg Word8 -> Data msg
forall msg. ListOf msg Word8 -> Data msg
Data

-- | @'newText' msg len@ Allocates a new 'Text' inside the message. The
-- value has space for @len@ *bytes* (not characters).
newText :: M.WriteCtx m s => M.MutMsg s -> Int -> m (Text (M.MutMsg s))
newText :: MutMsg s -> Int -> m (Text (MutMsg s))
newText MutMsg s
msg Int
len =
    ListOf (MutMsg s) Word8 -> Text (MutMsg s)
forall msg. ListOf msg Word8 -> Text msg
Text (ListOf (MutMsg s) Word8 -> Text (MutMsg s))
-> m (ListOf (MutMsg s) Word8) -> m (Text (MutMsg s))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s -> Int -> m (ListOf (MutMsg s) Word8)
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) Word8)
U.allocList8 MutMsg s
msg (Int
lenInt -> Int -> Int
forall a. Num a => a -> a -> a
+Int
1)

-- | Interpret a list of 'Word8' as a capnproto 'Text' value.
--
-- This vaildates that the list is NUL-terminated, but not that it is valid
-- UTF-8. If it is not NUL-terminaed, a 'SchemaViolationError' is thrown.
getText :: U.ReadCtx m msg => U.ListOf msg Word8 -> m (Text msg)
getText :: ListOf msg Word8 -> m (Text msg)
getText ListOf msg Word8
list = do
    let len :: Int
len = ListOf msg Word8 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg Word8
list
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
len Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Error -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m ()) -> Error -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Error
E.SchemaViolationError
        String
"Text is not NUL-terminated (list of bytes has length 0)"
    Word8
lastByte <- Int -> ListOf msg Word8 -> m Word8
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index (Int
len Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ListOf msg Word8
list
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
lastByte Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ Error -> m ()
forall (m :: * -> *) e a. (MonadThrow m, Exception e) => e -> m a
throwM (Error -> m ()) -> Error -> m ()
forall a b. (a -> b) -> a -> b
$ String -> Error
E.SchemaViolationError (String -> Error) -> String -> Error
forall a b. (a -> b) -> a -> b
$
        String
"Text is not NUL-terminated (last byte is " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word8 -> String
forall a. Show a => a -> String
show Word8
lastByte String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
")"
    Text msg -> m (Text msg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text msg -> m (Text msg)) -> Text msg -> m (Text msg)
forall a b. (a -> b) -> a -> b
$ ListOf msg Word8 -> Text msg
forall msg. ListOf msg Word8 -> Text msg
Text ListOf msg Word8
list

-- | Convert a 'Data' to a 'BS.ByteString'.
dataBytes :: U.ReadCtx m msg => Data msg -> m BS.ByteString
dataBytes :: Data msg -> m ByteString
dataBytes (Data ListOf msg Word8
list) = ListOf msg Word8 -> m ByteString
forall (m :: * -> *) msg.
ReadCtx m msg =>
ListOf msg Word8 -> m ByteString
U.rawBytes ListOf msg Word8
list

-- | Return the underlying buffer containing the text. This does not include the
-- null terminator.
textBuffer :: U.ReadCtx m msg => Text msg -> m (U.ListOf msg Word8)
textBuffer :: Text msg -> m (ListOf msg Word8)
textBuffer (Text ListOf msg Word8
list) = Int -> ListOf msg Word8 -> m (ListOf msg Word8)
forall (m :: * -> *) msg a.
MonadThrow m =>
Int -> ListOf msg a -> m (ListOf msg a)
U.take (ListOf msg Word8 -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg Word8
list Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) ListOf msg Word8
list

-- | Convert a 'Text' to a 'BS.ByteString', comprising the raw bytes of the text
-- (not counting the NUL terminator).
textBytes :: U.ReadCtx m msg => Text msg -> m BS.ByteString
textBytes :: Text msg -> m ByteString
textBytes = Text msg -> m (ListOf msg Word8)
forall (m :: * -> *) msg.
ReadCtx m msg =>
Text msg -> m (ListOf msg Word8)
textBuffer (Text msg -> m (ListOf msg Word8))
-> (ListOf msg Word8 -> m ByteString) -> Text msg -> m ByteString
forall (m :: * -> *) a b c.
Monad m =>
(a -> m b) -> (b -> m c) -> a -> m c
>=> ListOf msg Word8 -> m ByteString
forall (m :: * -> *) msg.
ReadCtx m msg =>
ListOf msg Word8 -> m ByteString
U.rawBytes

------------------- (Mut)ListElem instances for text and data ------------------
instance ListElem msg (Data msg) where
    newtype List msg (Data msg) = DataList (U.ListOf msg (Maybe (U.Ptr msg)))

    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Data msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = ListOf msg (Maybe (Ptr msg)) -> List msg (Data msg)
forall msg. ListOf msg (Maybe (Ptr msg)) -> List msg (Data msg)
DataList (ListOf msg (Maybe (Ptr msg)) -> List msg (Data msg))
-> m (ListOf msg (Maybe (Ptr msg))) -> m (List msg (Data msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> Maybe (Ptr msg) -> m (ListOf msg (Maybe (Ptr msg)))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
fromPtr msg
msg Maybe (Ptr msg)
ptr
    toUntypedList :: List msg (Data msg) -> List msg
toUntypedList (DataList l) = ListOf msg (Maybe (Ptr msg)) -> List msg
forall msg. ListOf msg (Maybe (Ptr msg)) -> List msg
U.ListPtr ListOf msg (Maybe (Ptr msg))
l

    length :: List msg (Data msg) -> Int
length (DataList l) = ListOf msg (Maybe (Ptr msg)) -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg (Maybe (Ptr msg))
l
    index :: Int -> List msg (Data msg) -> m (Data msg)
index Int
i (DataList l) = Int -> ListOf msg (Maybe (Ptr msg)) -> m (Data msg)
forall (m :: * -> *) msg a.
(ReadCtx m msg, FromPtr msg a) =>
Int -> ListOf msg (Maybe (Ptr msg)) -> m a
ptrListIndex Int
i ListOf msg (Maybe (Ptr msg))
l

instance MutListElem s (Data (M.MutMsg s)) where
    setIndex :: Data (MutMsg s) -> Int -> List (MutMsg s) (Data (MutMsg s)) -> m ()
setIndex (Data ListOf (MutMsg s) Word8
e) Int
i (DataList l) =
        Maybe (Ptr (MutMsg s))
-> Int -> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s))
forall a. a -> Maybe a
Just (List (MutMsg s) -> Ptr (MutMsg s)
forall msg. List msg -> Ptr msg
U.PtrList (ListOf (MutMsg s) Word8 -> List (MutMsg s)
forall msg. ListOf msg Word8 -> List msg
U.List8 ListOf (MutMsg s) Word8
e))) Int
i ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
l
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Data (MutMsg s)))
newList MutMsg s
msg Int
len = ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
-> List (MutMsg s) (Data (MutMsg s))
forall msg. ListOf msg (Maybe (Ptr msg)) -> List msg (Data msg)
DataList (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
 -> List (MutMsg s) (Data (MutMsg s)))
-> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
-> m (List (MutMsg s) (Data (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s -> Int -> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
U.allocListPtr MutMsg s
msg Int
len

instance ListElem msg (Text msg) where
    newtype List msg (Text msg) = TextList (U.ListOf msg (Maybe (U.Ptr msg)))

    listFromPtr :: msg -> Maybe (Ptr msg) -> m (List msg (Text msg))
listFromPtr msg
msg Maybe (Ptr msg)
ptr = ListOf msg (Maybe (Ptr msg)) -> List msg (Text msg)
forall msg. ListOf msg (Maybe (Ptr msg)) -> List msg (Text msg)
TextList (ListOf msg (Maybe (Ptr msg)) -> List msg (Text msg))
-> m (ListOf msg (Maybe (Ptr msg))) -> m (List msg (Text msg))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> msg -> Maybe (Ptr msg) -> m (ListOf msg (Maybe (Ptr msg)))
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
fromPtr msg
msg Maybe (Ptr msg)
ptr
    toUntypedList :: List msg (Text msg) -> List msg
toUntypedList (TextList l) = ListOf msg (Maybe (Ptr msg)) -> List msg
forall msg. ListOf msg (Maybe (Ptr msg)) -> List msg
U.ListPtr ListOf msg (Maybe (Ptr msg))
l

    length :: List msg (Text msg) -> Int
length (TextList l) = ListOf msg (Maybe (Ptr msg)) -> Int
forall msg a. ListOf msg a -> Int
U.length ListOf msg (Maybe (Ptr msg))
l
    index :: Int -> List msg (Text msg) -> m (Text msg)
index Int
i (TextList l) = Int -> ListOf msg (Maybe (Ptr msg)) -> m (Text msg)
forall (m :: * -> *) msg a.
(ReadCtx m msg, FromPtr msg a) =>
Int -> ListOf msg (Maybe (Ptr msg)) -> m a
ptrListIndex Int
i ListOf msg (Maybe (Ptr msg))
l

instance MutListElem s (Text (M.MutMsg s)) where
    setIndex :: Text (MutMsg s) -> Int -> List (MutMsg s) (Text (MutMsg s)) -> m ()
setIndex (Text ListOf (MutMsg s) Word8
e) Int
i (TextList l) =
        Maybe (Ptr (MutMsg s))
-> Int -> ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))) -> m ()
forall (m :: * -> *) s a.
RWCtx m s =>
a -> Int -> ListOf (MutMsg s) a -> m ()
U.setIndex (Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s))
forall a. a -> Maybe a
Just (List (MutMsg s) -> Ptr (MutMsg s)
forall msg. List msg -> Ptr msg
U.PtrList (ListOf (MutMsg s) Word8 -> List (MutMsg s)
forall msg. ListOf msg Word8 -> List msg
U.List8 ListOf (MutMsg s) Word8
e))) Int
i ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
l
    newList :: MutMsg s -> Int -> m (List (MutMsg s) (Text (MutMsg s)))
newList MutMsg s
msg Int
len = ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
-> List (MutMsg s) (Text (MutMsg s))
forall msg. ListOf msg (Maybe (Ptr msg)) -> List msg (Text msg)
TextList (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s)))
 -> List (MutMsg s) (Text (MutMsg s)))
-> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
-> m (List (MutMsg s) (Text (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s -> Int -> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Int -> m (ListOf (MutMsg s) (Maybe (Ptr (MutMsg s))))
U.allocListPtr MutMsg s
msg Int
len

-- helper for the above instances.
ptrListIndex :: (U.ReadCtx m msg, FromPtr msg a) => Int -> U.ListOf msg (Maybe (U.Ptr msg)) -> m a
ptrListIndex :: Int -> ListOf msg (Maybe (Ptr msg)) -> m a
ptrListIndex Int
i ListOf msg (Maybe (Ptr msg))
list = do
    Maybe (Ptr msg)
ptr <- Int -> ListOf msg (Maybe (Ptr msg)) -> m (Maybe (Ptr msg))
forall (m :: * -> *) msg a.
ReadCtx m msg =>
Int -> ListOf msg a -> m a
U.index Int
i ListOf msg (Maybe (Ptr msg))
list
    msg -> Maybe (Ptr msg) -> m a
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
fromPtr (ListOf msg (Maybe (Ptr msg))
-> InMessage (ListOf msg (Maybe (Ptr msg)))
forall a. HasMessage a => a -> InMessage a
U.message ListOf msg (Maybe (Ptr msg))
list) Maybe (Ptr msg)
ptr

--------- To/FromPtr instances for Text and Data. These wrap lists of bytes. --------

instance FromPtr msg (Data msg) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Data msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = msg -> Maybe (Ptr msg) -> m (ListOf msg Word8)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
fromPtr msg
msg Maybe (Ptr msg)
ptr m (ListOf msg Word8)
-> (ListOf msg Word8 -> m (Data msg)) -> m (Data msg)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf msg Word8 -> m (Data msg)
forall (m :: * -> *) msg.
ReadCtx m msg =>
ListOf msg Word8 -> m (Data msg)
getData
instance ToPtr s (Data (M.MutMsg s)) where
    toPtr :: MutMsg s -> Data (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Data ListOf (MutMsg s) Word8
l) = MutMsg s -> ListOf (MutMsg s) Word8 -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg ListOf (MutMsg s) Word8
l

instance FromPtr msg (Text msg) where
    fromPtr :: msg -> Maybe (Ptr msg) -> m (Text msg)
fromPtr msg
msg Maybe (Ptr msg)
ptr = case Maybe (Ptr msg)
ptr of
        Just Ptr msg
_ ->
            msg -> Maybe (Ptr msg) -> m (ListOf msg Word8)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
fromPtr msg
msg Maybe (Ptr msg)
ptr m (ListOf msg Word8)
-> (ListOf msg Word8 -> m (Text msg)) -> m (Text msg)
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ListOf msg Word8 -> m (Text msg)
forall (m :: * -> *) msg.
ReadCtx m msg =>
ListOf msg Word8 -> m (Text msg)
getText
        Maybe (Ptr msg)
Nothing -> do
            -- getText expects and strips off a NUL byte at the end of the
            -- string. In the case of a null pointer we just want to return
            -- the empty string, so we bypass it here.
            Data ListOf msg Word8
bytes <- msg -> Maybe (Ptr msg) -> m (Data msg)
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
fromPtr msg
msg Maybe (Ptr msg)
ptr
            Text msg -> m (Text msg)
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Text msg -> m (Text msg)) -> Text msg -> m (Text msg)
forall a b. (a -> b) -> a -> b
$ ListOf msg Word8 -> Text msg
forall msg. ListOf msg Word8 -> Text msg
Text ListOf msg Word8
bytes
instance ToPtr s (Text (M.MutMsg s)) where
    toPtr :: MutMsg s -> Text (MutMsg s) -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg (Text ListOf (MutMsg s) Word8
l) = MutMsg s -> ListOf (MutMsg s) Word8 -> m (Maybe (Ptr (MutMsg s)))
forall s a (m :: * -> *).
(ToPtr s a, WriteCtx m s) =>
MutMsg s -> a -> m (Maybe (Ptr (MutMsg s)))
toPtr MutMsg s
msg ListOf (MutMsg s) Word8
l