{- |
Module: Capnp.GenHelpers
Description: Misc. helpers for generated code.

This module provides various helpers used by generated code; developers
are not expected to invoke them directly.

These helpers are used by the low-level api. "Capnp.GenHelpers.Pure"
defines helpers used by high-level api.
-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies     #-}
module Capnp.GenHelpers where

import Data.Bits
import Data.Word

import Data.Maybe (fromJust)

import qualified Data.ByteString as BS

import Capnp.Bits

import Capnp (bsToMsg, evalLimitT)

import qualified Capnp.Classes as C
import qualified Capnp.Message as M
import qualified Capnp.Untyped as U

-- | @'getWordField' struct index offset def@ fetches a field from the
-- struct's data section. @index@ is the index of the 64-bit word in the data
-- section in which the field resides. @offset@ is the offset in bits from the
-- start of that word to the field. @def@ is the default value for this field.
getWordField :: (U.ReadCtx m msg, C.IsWord a) => U.Struct msg -> Int -> Int -> Word64 -> m a
getWordField :: Struct msg -> Int -> Int -> Word64 -> m a
getWordField Struct msg
struct Int
idx Int
offset Word64
def = (Word64 -> a) -> m Word64 -> m a
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap
    ( Word64 -> a
forall a. IsWord a => Word64 -> a
C.fromWord
    (Word64 -> a) -> (Word64 -> Word64) -> Word64 -> a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> Word64 -> Word64
forall a. Bits a => a -> a -> a
xor Word64
def
    (Word64 -> Word64) -> (Word64 -> Word64) -> Word64 -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` Int
offset)
    )
    (Int -> Struct msg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m Word64
U.getData Int
idx Struct msg
struct)

-- | @'setWordField' struct value index offset def@ sets a field in the
-- struct's data section. The meaning of the parameters are as in
-- 'getWordField', with @value@ being the value to set. The width of the
-- value is inferred from its type.
setWordField ::
    ( U.RWCtx m s
    , Bounded a, Integral a, C.IsWord a, Bits a
    )
    => U.Struct (M.MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
setWordField :: Struct (MutMsg s) -> a -> Int -> Int -> Word64 -> m ()
setWordField Struct (MutMsg s)
struct a
value Int
idx Int
offset Word64
def = do
    Word64
old <- Int -> Struct (MutMsg s) -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m Word64
U.getData Int
idx Struct (MutMsg s)
struct
    let new :: Word64
new = a -> Word64 -> Int -> Word64
forall a. (Bounded a, Integral a) => a -> Word64 -> Int -> Word64
replaceBits (a
value a -> a -> a
forall a. Bits a => a -> a -> a
`xor` Word64 -> a
forall a. IsWord a => Word64 -> a
C.fromWord Word64
def) Word64
old Int
offset
    Word64 -> Int -> Struct (MutMsg s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m (MutMsg s), WriteCtx m s) =>
Word64 -> Int -> Struct (MutMsg s) -> m ()
U.setData Word64
new Int
idx Struct (MutMsg s)
struct

embedCapPtr :: M.WriteCtx m s => M.MutMsg s -> M.Client -> m (Maybe (U.Ptr (M.MutMsg s)))
embedCapPtr :: MutMsg s -> Client -> m (Maybe (Ptr (MutMsg s)))
embedCapPtr MutMsg s
msg Client
client =
    Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s))
forall a. a -> Maybe a
Just (Ptr (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> (Cap (MutMsg s) -> Ptr (MutMsg s))
-> Cap (MutMsg s)
-> Maybe (Ptr (MutMsg s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cap (MutMsg s) -> Ptr (MutMsg s)
forall msg. Cap msg -> Ptr msg
U.PtrCap (Cap (MutMsg s) -> Maybe (Ptr (MutMsg s)))
-> m (Cap (MutMsg s)) -> m (Maybe (Ptr (MutMsg s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> MutMsg s -> Client -> m (Cap (MutMsg s))
forall (m :: * -> *) s.
WriteCtx m s =>
MutMsg s -> Client -> m (Cap (MutMsg s))
U.appendCap MutMsg s
msg Client
client

-- | Get a pointer from a ByteString, where the root object is a struct with
-- one pointer, which is the pointer we will retrieve. This is only safe for
-- trusted inputs; it reads the message with a traversal limit of 'maxBound'
-- (and so is suseptable to denial of service attacks), and it calls 'error'
-- if decoding is not successful.
--
-- The purpose of this is for defining constants of pointer type from a schema.
getPtrConst :: C.FromPtr M.ConstMsg a => BS.ByteString -> a
getPtrConst :: ByteString -> a
getPtrConst ByteString
bytes = Maybe a -> a
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ do
    ConstMsg
msg <- ByteString -> Maybe ConstMsg
forall (m :: * -> *). MonadThrow m => ByteString -> m ConstMsg
bsToMsg ByteString
bytes
    WordCount -> LimitT Maybe a -> Maybe a
forall (m :: * -> *) a.
MonadThrow m =>
WordCount -> LimitT m a -> m a
evalLimitT WordCount
forall a. Bounded a => a
maxBound (LimitT Maybe a -> Maybe a) -> LimitT Maybe a -> Maybe a
forall a b. (a -> b) -> a -> b
$ ConstMsg -> LimitT Maybe (Struct ConstMsg)
forall (m :: * -> *) msg. ReadCtx m msg => msg -> m (Struct msg)
U.rootPtr ConstMsg
msg LimitT Maybe (Struct ConstMsg)
-> (Struct ConstMsg -> LimitT Maybe (Maybe (Ptr ConstMsg)))
-> LimitT Maybe (Maybe (Ptr ConstMsg))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Struct ConstMsg -> LimitT Maybe (Maybe (Ptr ConstMsg))
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr Int
0 LimitT Maybe (Maybe (Ptr ConstMsg))
-> (Maybe (Ptr ConstMsg) -> LimitT Maybe a) -> LimitT Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= ConstMsg -> Maybe (Ptr ConstMsg) -> LimitT Maybe a
forall msg a (m :: * -> *).
(FromPtr msg a, ReadCtx m msg) =>
msg -> Maybe (Ptr msg) -> m a
C.fromPtr ConstMsg
msg


getTag :: U.ReadCtx m msg => U.Struct msg -> Int -> m Word16
getTag :: Struct msg -> Int -> m Word16
getTag Struct msg
struct Int
offset = do
    Word64
word <- Int -> Struct msg -> m Word64
forall (m :: * -> *) msg.
ReadCtx m msg =>
Int -> Struct msg -> m Word64
U.getData (Int
offset Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
4) Struct msg
struct
    Word16 -> m Word16
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Word16 -> m Word16) -> Word16 -> m Word16
forall a b. (a -> b) -> a -> b
$ Word64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Word16) -> Word64 -> Word16
forall a b. (a -> b) -> a -> b
$ Word64
word Word64 -> Int -> Word64
forall a. Bits a => a -> Int -> a
`shiftR` ((Int
offset Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
4) Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
16)