{- |
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 DataKinds        #-}
{-# 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 (Mutability (..), 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 mut, C.IsWord a) => U.Struct mut -> Int -> Int -> Word64 -> m a
getWordField :: Struct mut -> Int -> Int -> Word64 -> m a
getWordField Struct mut
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 mut -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m Word64
U.getData Int
idx Struct mut
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 ('Mut s) -> a -> Int -> Int -> Word64 -> m ()
setWordField :: Struct ('Mut s) -> a -> Int -> Int -> Word64 -> m ()
setWordField Struct ('Mut s)
struct a
value Int
idx Int
offset Word64
def = do
    Word64
old <- Int -> Struct ('Mut s) -> m Word64
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m Word64
U.getData Int
idx Struct ('Mut 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 ('Mut s) -> m ()
forall (m :: * -> *) s.
(ReadCtx m ('Mut s), WriteCtx m s) =>
Word64 -> Int -> Struct ('Mut s) -> m ()
U.setData Word64
new Int
idx Struct ('Mut s)
struct

embedCapPtr :: M.WriteCtx m s => M.Message ('Mut s) -> M.Client -> m (Maybe (U.Ptr ('Mut s)))
embedCapPtr :: Message ('Mut s) -> Client -> m (Maybe (Ptr ('Mut s)))
embedCapPtr Message ('Mut s)
msg Client
client =
    Ptr ('Mut s) -> Maybe (Ptr ('Mut s))
forall a. a -> Maybe a
Just (Ptr ('Mut s) -> Maybe (Ptr ('Mut s)))
-> (Cap ('Mut s) -> Ptr ('Mut s))
-> Cap ('Mut s)
-> Maybe (Ptr ('Mut s))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Cap ('Mut s) -> Ptr ('Mut s)
forall (mut :: Mutability). Cap mut -> Ptr mut
U.PtrCap (Cap ('Mut s) -> Maybe (Ptr ('Mut s)))
-> m (Cap ('Mut s)) -> m (Maybe (Ptr ('Mut s)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Message ('Mut s) -> Client -> m (Cap ('Mut s))
forall (m :: * -> *) s.
WriteCtx m s =>
Message ('Mut s) -> Client -> m (Cap ('Mut s))
U.appendCap Message ('Mut 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 'Const 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
    Message 'Const
msg <- ByteString -> Maybe (Message 'Const)
forall (m :: * -> *).
MonadThrow m =>
ByteString -> m (Message 'Const)
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
$ Message 'Const -> LimitT Maybe (Struct 'Const)
forall (m :: * -> *) (mut :: Mutability).
ReadCtx m mut =>
Message mut -> m (Struct mut)
U.rootPtr Message 'Const
msg LimitT Maybe (Struct 'Const)
-> (Struct 'Const -> LimitT Maybe (Maybe (Ptr 'Const)))
-> LimitT Maybe (Maybe (Ptr 'Const))
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Struct 'Const -> LimitT Maybe (Maybe (Ptr 'Const))
forall (m :: * -> *) (msg :: Mutability).
ReadCtx m msg =>
Int -> Struct msg -> m (Maybe (Ptr msg))
U.getPtr Int
0 LimitT Maybe (Maybe (Ptr 'Const))
-> (Maybe (Ptr 'Const) -> LimitT Maybe a) -> LimitT Maybe a
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Message 'Const -> Maybe (Ptr 'Const) -> LimitT Maybe a
forall (mut :: Mutability) a (m :: * -> *).
(FromPtr mut a, ReadCtx m mut) =>
Message mut -> Maybe (Ptr mut) -> m a
C.fromPtr Message 'Const
msg


getTag :: U.ReadCtx m mut => U.Struct mut -> Int -> m Word16
getTag :: Struct mut -> Int -> m Word16
getTag Struct mut
struct Int
offset = do
    Word64
word <- Int -> Struct mut -> m Word64
forall (m :: * -> *) (msg :: Mutability).
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 mut
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)