{-|
Module      : Botan.Low.Remake
Description : Low-level binding generators
Copyright   : (c) Leo D, 2023
License     : BSD-3-Clause
Maintainer  : leo@apotheca.io
Stability   : experimental
Portability : POSIX

Generate low-level bindings automatically
-}

module Botan.Low.Remake
( mkBindings
, mkCreateObject
, mkCreateObjects
, mkCreateObjectWith
, mkCreateObjectCString
, mkCreateObjectCString1
, mkCreateObjectCBytes
, mkCreateObjectCBytesLen
, mkCreateObjectCBytesLen1
, mkWithObjectAction
, mkWithObjectGetterCBytesLen
, mkWithObjectGetterCBytesLen1
, mkWithObjectSetterCString
, mkWithObjectSetterCBytesLen
) where

import Botan.Low.Prelude
import Botan.Low.Error

import qualified Data.ByteString.Internal as ByteString

import Botan.Low.Make (allocBytesQuerying)

-- ByteString Helpers

-- NOTE: Was allocBytes
createByteString :: Int -> (Ptr byte -> IO ()) -> IO ByteString
createByteString :: forall byte. Int -> (Ptr byte -> IO ()) -> IO ByteString
createByteString Int
sz Ptr byte -> IO ()
f = Int -> (Ptr Word8 -> IO ()) -> IO ByteString
ByteString.create Int
sz (Ptr byte -> IO ()
f (Ptr byte -> IO ())
-> (Ptr Word8 -> Ptr byte) -> Ptr Word8 -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr Word8 -> Ptr byte
forall a b. Ptr a -> Ptr b
castPtr)

-- NOTE: Was allocBytesWith
-- createByteString' :: Int -> (Ptr byte -> IO a) -> IO (a, ByteString)

-- NOTE: Was allocBytesQuerying
-- createByteStringQuerying :: (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
-- createByteStringQuerying fn = do
--     alloca $ \ szPtr -> do
--         -- TODO: Maybe poke szPtr 0 for extra safety in cas its not initially zero
--         code <- fn nullPtr szPtr
--         case code of
--             InsufficientBufferSpace -> do
--                 sz <- fromIntegral <$> peek szPtr
--                 allocBytes sz $ \ outPtr -> throwBotanIfNegative_ $ fn outPtr szPtr
--             _                       -> do
--                 throwBotanError code

-- NOTE: Was allocBytesQueryingCString
-- NOTE: Does not check length of taken string, vulnerable to null byte injection
-- createByteStringQueryingCString :: (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
-- createByteStringQueryingCString action = do
--     cstring <- allocBytesQuerying action
--     return $!! ByteString.takeWhile (/= 0) cstring

--

-- type NewObject      object botan = botan -> IO object 
-- type WithObject     object botan = (forall a . object -> (botan -> IO a) -> IO a)
-- type DestroyObject  object botan = object -> IO ()
-- type CreateObject   object botan = (Ptr botan -> IO CInt) -> IO object
-- type CreateObjects  object botan = (Ptr botan -> Ptr CSize -> IO CInt) -> IO object

-- Example usage
{-
newtype RNG = MkRNG { getRNGForeignPtr :: ForeignPtr BotanRNGStruct }

newRNG      :: BotanRNG -> IO RNG
withRNG     :: RNG -> (BotanRNG -> IO a) -> IO a
rngDestroy  :: RNG -> IO ()
createRNG   :: (Ptr BotanRNG -> IO CInt) -> IO RNG
(newRNG, withRNG, rngDestroy, createRNG, _)
    = mkBindings MkBotanRNG runBotanRNG MkRNG getRNGForeignPtr botan_rng_destroy
    
rngInit :: RNGType -> IO RNG
rngInit name = asCString name $ \ namePtr -> do
    createRNG $ \ outPtr -> botan_rng_init outPtr (ConstPtr namePtr)
-}
mkBindings
    ::  (Storable botan)
    =>  (Ptr struct -> botan)                                   -- mkBotan
    ->  (botan -> Ptr struct)                                   -- runBotan
    ->  (ForeignPtr struct -> object)                           -- mkForeign
    ->  (object -> ForeignPtr struct)                           -- runForeign
    ->  FinalizerPtr struct                                     -- destroy / finalizer
    ->  (   botan -> IO object                                  -- newObject
        ,   object -> (botan -> IO a) -> IO a                   -- withObject
        ,   object -> IO ()                                     -- destroyObject
        ,   (Ptr botan -> IO CInt) -> IO object                 -- createObject
        ,   (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object]  -- createObjects
        )
mkBindings :: forall botan struct object a.
Storable botan =>
(Ptr struct -> botan)
-> (botan -> Ptr struct)
-> (ForeignPtr struct -> object)
-> (object -> ForeignPtr struct)
-> FinalizerPtr struct
-> (botan -> IO object, object -> (botan -> IO a) -> IO a,
    object -> IO (), (Ptr botan -> IO CInt) -> IO object,
    (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object])
mkBindings Ptr struct -> botan
mkBotan botan -> Ptr struct
runBotan ForeignPtr struct -> object
mkForeign object -> ForeignPtr struct
runForeign FinalizerPtr struct
destroy = (botan -> IO object, object -> (botan -> IO a) -> IO a,
 object -> IO (), (Ptr botan -> IO CInt) -> IO object,
 (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object])
forall {b}.
(botan -> IO object, object -> (botan -> IO b) -> IO b,
 object -> IO (), (Ptr botan -> IO CInt) -> IO object,
 (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object])
bindings where
    bindings :: (botan -> IO object, object -> (botan -> IO b) -> IO b,
 object -> IO (), (Ptr botan -> IO CInt) -> IO object,
 (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object])
bindings = (botan -> IO object
newObject, object -> (botan -> IO b) -> IO b
forall {b}. object -> (botan -> IO b) -> IO b
withObject, object -> IO ()
objectDestroy, (Ptr botan -> IO CInt) -> IO object
createObject, (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object]
createObjects)
    newObject :: botan -> IO object
newObject botan
botan = do
        ForeignPtr struct
foreignPtr <- FinalizerPtr struct -> Ptr struct -> IO (ForeignPtr struct)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr struct
destroy (botan -> Ptr struct
runBotan botan
botan)
        object -> IO object
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (object -> IO object) -> object -> IO object
forall a b. (a -> b) -> a -> b
$ ForeignPtr struct -> object
mkForeign ForeignPtr struct
foreignPtr
    withObject :: object -> (botan -> IO b) -> IO b
withObject object
object botan -> IO b
f = ForeignPtr struct -> (Ptr struct -> IO b) -> IO b
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr (object -> ForeignPtr struct
runForeign object
object) (botan -> IO b
f (botan -> IO b) -> (Ptr struct -> botan) -> Ptr struct -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Ptr struct -> botan
mkBotan)
    objectDestroy :: object -> IO ()
objectDestroy object
object = ForeignPtr struct -> IO ()
forall a. ForeignPtr a -> IO ()
finalizeForeignPtr (object -> ForeignPtr struct
runForeign object
object)
    -- NOTE: This ^ is really a Haskell finalizer
    --  We could include the actual C++ botan destructor instead of indirectly omitting it:
    --      objectFinalize obj = new stable foreign ptr ... destroy
    --      objectDestroy obj = withObject obj destroy
    createObject :: (Ptr botan -> IO CInt) -> IO object
createObject = (botan -> IO object) -> (Ptr botan -> IO CInt) -> IO object
forall botan object.
Storable botan =>
(botan -> IO object) -> (Ptr botan -> IO CInt) -> IO object
mkCreateObject botan -> IO object
newObject
    createObjects :: (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object]
createObjects = (botan -> IO object)
-> (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object]
forall botan object.
Storable botan =>
(botan -> IO object)
-> (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object]
mkCreateObjects botan -> IO object
newObject

{-
Create functions
-}

-- TODO: Rename mkCreate
mkCreateObject
    :: (Storable botan)
    => (botan -> IO object)
    -> (Ptr botan-> IO CInt)
    -> IO object
mkCreateObject :: forall botan object.
Storable botan =>
(botan -> IO object) -> (Ptr botan -> IO CInt) -> IO object
mkCreateObject botan -> IO object
newObject Ptr botan -> IO CInt
init = IO object -> IO object
forall a. IO a -> IO a
mask_ (IO object -> IO object) -> IO object -> IO object
forall a b. (a -> b) -> a -> b
$ (Ptr botan -> IO object) -> IO object
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr botan -> IO object) -> IO object)
-> (Ptr botan -> IO object) -> IO object
forall a b. (a -> b) -> a -> b
$ \ Ptr botan
outPtr -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr botan -> IO CInt
init Ptr botan
outPtr
        botan
out <- Ptr botan -> IO botan
forall a. Storable a => Ptr a -> IO a
peek Ptr botan
outPtr
        botan -> IO object
newObject botan
out

-- TODO: Rename mkCreates
mkCreateObjects
    :: (Storable botan)
    => (botan -> IO object)
    -> (Ptr botan -> Ptr CSize -> IO CInt)
    -> IO [object]
mkCreateObjects :: forall botan object.
Storable botan =>
(botan -> IO object)
-> (Ptr botan -> Ptr CSize -> IO CInt) -> IO [object]
mkCreateObjects botan -> IO object
newObject Ptr botan -> Ptr CSize -> IO CInt
inits = IO [object] -> IO [object]
forall a. IO a -> IO a
mask_ (IO [object] -> IO [object]) -> IO [object] -> IO [object]
forall a b. (a -> b) -> a -> b
$ (Ptr CSize -> IO [object]) -> IO [object]
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO [object]) -> IO [object])
-> (Ptr CSize -> IO [object]) -> IO [object]
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
szPtr -> do
        CInt
code <- Ptr botan -> Ptr CSize -> IO CInt
inits Ptr botan
forall a. Ptr a
nullPtr Ptr CSize
szPtr
        case CInt
code of
            CInt
InsufficientBufferSpace -> do
                Int
sz <- CSize -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CSize -> Int) -> IO CSize -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CSize -> IO CSize
forall a. Storable a => Ptr a -> IO a
peek Ptr CSize
szPtr
                Int -> (Ptr botan -> IO [object]) -> IO [object]
forall a b. Storable a => Int -> (Ptr a -> IO b) -> IO b
allocaArray Int
sz ((Ptr botan -> IO [object]) -> IO [object])
-> (Ptr botan -> IO [object]) -> IO [object]
forall a b. (a -> b) -> a -> b
$ \ Ptr botan
arrPtr -> do
                    HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr botan -> Ptr CSize -> IO CInt
inits Ptr botan
arrPtr Ptr CSize
szPtr
                    [botan]
outs <- Int -> Ptr botan -> IO [botan]
forall a. Storable a => Int -> Ptr a -> IO [a]
peekArray Int
sz Ptr botan
arrPtr
                    [botan] -> (botan -> IO object) -> IO [object]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
t a -> (a -> m b) -> m (t b)
forM [botan]
outs botan -> IO object
newObject
            CInt
_ -> CInt -> IO [object]
forall a. HasCallStack => CInt -> IO a
throwBotanError CInt
code

mkCreateObjectWith
    :: ((Ptr botan -> IO CInt) -> IO object)
    -> (arg -> (carg -> IO object) -> IO object)
    -> (Ptr botan -> carg -> IO CInt)
    -> arg
    -> IO object
mkCreateObjectWith :: forall botan object arg carg.
((Ptr botan -> IO CInt) -> IO object)
-> (arg -> (carg -> IO object) -> IO object)
-> (Ptr botan -> carg -> IO CInt)
-> arg
-> IO object
mkCreateObjectWith (Ptr botan -> IO CInt) -> IO object
createObject arg -> (carg -> IO object) -> IO object
withArg Ptr botan -> carg -> IO CInt
init arg
arg = arg -> (carg -> IO object) -> IO object
withArg arg
arg ((carg -> IO object) -> IO object)
-> (carg -> IO object) -> IO object
forall a b. (a -> b) -> a -> b
$ \ carg
carg -> do
    (Ptr botan -> IO CInt) -> IO object
createObject ((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> IO CInt) -> IO object
forall a b. (a -> b) -> a -> b
$ \ Ptr botan
outPtr -> Ptr botan -> carg -> IO CInt
init Ptr botan
outPtr carg
carg

-- TODO: Rename mkCreateCString
mkCreateObjectCString
    :: ((Ptr botan -> IO CInt) -> IO object)
    -> (Ptr botan -> ConstPtr CChar -> IO CInt)
    -> ByteString
    -> IO object
-- mkCreateObjectCString createObject init cstr = withCString cstr $ \ namePtr -> do
--     createObject $ \ outPtr -> init outPtr (ConstPtr namePtr)
mkCreateObjectCString :: forall botan object.
((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> ConstPtr CChar -> IO CInt)
-> ByteString
-> IO object
mkCreateObjectCString (Ptr botan -> IO CInt) -> IO object
createObject = ((Ptr botan -> IO CInt) -> IO object)
-> (ByteString -> (ConstPtr CChar -> IO object) -> IO object)
-> (Ptr botan -> ConstPtr CChar -> IO CInt)
-> ByteString
-> IO object
forall botan object arg carg.
((Ptr botan -> IO CInt) -> IO object)
-> (arg -> (carg -> IO object) -> IO object)
-> (Ptr botan -> carg -> IO CInt)
-> arg
-> IO object
mkCreateObjectWith (Ptr botan -> IO CInt) -> IO object
createObject ByteString -> (ConstPtr CChar -> IO object) -> IO object
forall a. ByteString -> (ConstPtr CChar -> IO a) -> IO a
withConstCString

-- TODO: Rename mkCreateCString1
mkCreateObjectCString1
    :: ((Ptr botan -> IO CInt) -> IO object)
    -> (Ptr botan -> ConstPtr CChar -> a -> IO CInt)
    -> ByteString
    -> a
    -> IO object
mkCreateObjectCString1 :: forall botan object a.
((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> ConstPtr CChar -> a -> IO CInt)
-> ByteString
-> a
-> IO object
mkCreateObjectCString1 (Ptr botan -> IO CInt) -> IO object
createObject Ptr botan -> ConstPtr CChar -> a -> IO CInt
init ByteString
str a
a = ByteString -> (CString -> IO object) -> IO object
forall a. ByteString -> (CString -> IO a) -> IO a
withCString ByteString
str ((CString -> IO object) -> IO object)
-> (CString -> IO object) -> IO object
forall a b. (a -> b) -> a -> b
$ \ CString
cstr -> do
    (Ptr botan -> IO CInt) -> IO object
createObject ((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> IO CInt) -> IO object
forall a b. (a -> b) -> a -> b
$ \ Ptr botan
outPtr -> Ptr botan -> ConstPtr CChar -> a -> IO CInt
init Ptr botan
outPtr (CString -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr CString
cstr) a
a

-- TODO: Rename mkCreateCBytes
mkCreateObjectCBytes
    :: ((Ptr botan -> IO CInt) -> IO object)
    -> (Ptr botan -> ConstPtr Word8 -> IO CInt)
    -> ByteString
    -> IO object
mkCreateObjectCBytes :: forall botan object.
((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> ConstPtr Word8 -> IO CInt)
-> ByteString
-> IO object
mkCreateObjectCBytes (Ptr botan -> IO CInt) -> IO object
createObject Ptr botan -> ConstPtr Word8 -> IO CInt
init ByteString
bytes = ByteString -> (Ptr Word8 -> IO object) -> IO object
forall a. ByteString -> (Ptr Word8 -> IO a) -> IO a
withCBytes ByteString
bytes ((Ptr Word8 -> IO object) -> IO object)
-> (Ptr Word8 -> IO object) -> IO object
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
cbytes -> do
    (Ptr botan -> IO CInt) -> IO object
createObject ((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> IO CInt) -> IO object
forall a b. (a -> b) -> a -> b
$ \ Ptr botan
out -> Ptr botan -> ConstPtr Word8 -> IO CInt
init Ptr botan
out (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
cbytes)
{-# WARNING mkCreateObjectCBytes "You probably want mkCreateObjectCBytesLen; this is for functions that expect a bytestring of known exact length." #-}

-- TODO: Rename mkCreateCBytesLen
mkCreateObjectCBytesLen
    :: ((Ptr botan -> IO CInt) -> IO object)
    -> (Ptr botan -> ConstPtr Word8 -> CSize -> IO CInt)
    -> ByteString
    -> IO object
mkCreateObjectCBytesLen :: forall botan object.
((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> ConstPtr Word8 -> CSize -> IO CInt)
-> ByteString
-> IO object
mkCreateObjectCBytesLen (Ptr botan -> IO CInt) -> IO object
createObject Ptr botan -> ConstPtr Word8 -> CSize -> IO CInt
init ByteString
bytes = ByteString -> (CBytesLen -> IO object) -> IO object
forall a. ByteString -> (CBytesLen -> IO a) -> IO a
withCBytesLen ByteString
bytes ((CBytesLen -> IO object) -> IO object)
-> (CBytesLen -> IO object) -> IO object
forall a b. (a -> b) -> a -> b
$ \ (Ptr Word8
cbytes,Int
len) -> do
    (Ptr botan -> IO CInt) -> IO object
createObject ((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> IO CInt) -> IO object
forall a b. (a -> b) -> a -> b
$ \ Ptr botan
out -> Ptr botan -> ConstPtr Word8 -> CSize -> IO CInt
init Ptr botan
out (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
cbytes) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

mkCreateObjectCBytesLen1
    :: ((Ptr botan -> IO CInt) -> IO object)
    -> (Ptr botan -> ConstPtr Word8 -> CSize -> a -> IO CInt)
    -> ByteString
    -> a
    -> IO object
mkCreateObjectCBytesLen1 :: forall botan object a.
((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> ConstPtr Word8 -> CSize -> a -> IO CInt)
-> ByteString
-> a
-> IO object
mkCreateObjectCBytesLen1 (Ptr botan -> IO CInt) -> IO object
createObject Ptr botan -> ConstPtr Word8 -> CSize -> a -> IO CInt
init ByteString
bytes a
a = ByteString -> (CBytesLen -> IO object) -> IO object
forall a. ByteString -> (CBytesLen -> IO a) -> IO a
withCBytesLen ByteString
bytes ((CBytesLen -> IO object) -> IO object)
-> (CBytesLen -> IO object) -> IO object
forall a b. (a -> b) -> a -> b
$ \ (Ptr Word8
cbytes,Int
len) -> do
    (Ptr botan -> IO CInt) -> IO object
createObject ((Ptr botan -> IO CInt) -> IO object)
-> (Ptr botan -> IO CInt) -> IO object
forall a b. (a -> b) -> a -> b
$ \ Ptr botan
out -> Ptr botan -> ConstPtr Word8 -> CSize -> a -> IO CInt
init Ptr botan
out (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
cbytes) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len) a
a

{-
Action
-}
 
-- TODO: Rename mkAction
mkWithObjectAction
    :: (forall a . object -> (botan -> IO a) -> IO a)
    -> (botan -> IO CInt)
    -> object
    -> IO ()
mkWithObjectAction :: forall object botan.
(forall a. object -> (botan -> IO a) -> IO a)
-> (botan -> IO CInt) -> object -> IO ()
mkWithObjectAction forall a. object -> (botan -> IO a) -> IO a
withObject botan -> IO CInt
action object
obj = object -> (botan -> IO ()) -> IO ()
forall a. object -> (botan -> IO a) -> IO a
withObject object
obj ((botan -> IO ()) -> IO ()) -> (botan -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ botan
cobj -> do
    HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ botan -> IO CInt
action botan
cobj

{-
Getters
-}

-- TODO: getter parameter order may be improper - switch up if problematic
mkWithObjectGetterCBytesLen
    :: (forall a . object -> (botan -> IO a) -> IO a)
    -> (botan -> Ptr Word8 -> Ptr CSize -> IO CInt)
    -> object
    -> IO ByteString
mkWithObjectGetterCBytesLen :: forall object botan.
(forall a. object -> (botan -> IO a) -> IO a)
-> (botan -> Ptr Word8 -> Ptr CSize -> IO CInt)
-> object
-> IO ByteString
mkWithObjectGetterCBytesLen forall a. object -> (botan -> IO a) -> IO a
withObject botan -> Ptr Word8 -> Ptr CSize -> IO CInt
getter object
obj = object -> (botan -> IO ByteString) -> IO ByteString
forall a. object -> (botan -> IO a) -> IO a
withObject object
obj ((botan -> IO ByteString) -> IO ByteString)
-> (botan -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ botan
cobj -> do
    (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQuerying ((Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString)
-> (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
outPtr Ptr CSize
outLen -> botan -> Ptr Word8 -> Ptr CSize -> IO CInt
getter
        botan
cobj
        Ptr Word8
outPtr
        Ptr CSize
outLen

-- TODO: getter parameter order may be improper - switch up if problematic
mkWithObjectGetterCBytesLen1
    :: (forall a . object -> (botan -> IO a) -> IO a)
    -> (botan -> a -> Ptr Word8 -> Ptr CSize -> IO CInt)
    -> object
    -> a
    -> IO ByteString
mkWithObjectGetterCBytesLen1 :: forall object botan a.
(forall a. object -> (botan -> IO a) -> IO a)
-> (botan -> a -> Ptr Word8 -> Ptr CSize -> IO CInt)
-> object
-> a
-> IO ByteString
mkWithObjectGetterCBytesLen1 forall a. object -> (botan -> IO a) -> IO a
withObject botan -> a -> Ptr Word8 -> Ptr CSize -> IO CInt
getter object
obj a
a = object -> (botan -> IO ByteString) -> IO ByteString
forall a. object -> (botan -> IO a) -> IO a
withObject object
obj ((botan -> IO ByteString) -> IO ByteString)
-> (botan -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ botan
cobj -> do
    (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQuerying ((Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString)
-> (Ptr Word8 -> Ptr CSize -> IO CInt) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
outPtr Ptr CSize
outLen -> botan -> a -> Ptr Word8 -> Ptr CSize -> IO CInt
getter
        botan
cobj
        a
a
        Ptr Word8
outPtr
        Ptr CSize
outLen

{-
Setters
-}

-- TODO: Rename mkSetterCString
mkWithObjectSetterCString 
    :: (forall a . object -> (botan -> IO a) -> IO a)
    -> (botan -> ConstPtr CChar -> IO BotanErrorCode)
    -> object
    -> ByteString
    -> IO ()
mkWithObjectSetterCString :: forall object botan.
(forall a. object -> (botan -> IO a) -> IO a)
-> (botan -> ConstPtr CChar -> IO CInt)
-> object
-> ByteString
-> IO ()
mkWithObjectSetterCString forall a. object -> (botan -> IO a) -> IO a
withObject botan -> ConstPtr CChar -> IO CInt
setter object
obj ByteString
str = object -> (botan -> IO ()) -> IO ()
forall a. object -> (botan -> IO a) -> IO a
withObject object
obj ((botan -> IO ()) -> IO ()) -> (botan -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ botan
cobj -> do
    ByteString -> (CString -> IO ()) -> IO ()
forall a. ByteString -> (CString -> IO a) -> IO a
withCString ByteString
str ((CString -> IO ()) -> IO ()) -> (CString -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ CString
cstr -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ botan -> ConstPtr CChar -> IO CInt
setter botan
cobj (CString -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr CString
cstr)

-- Replaces mkSetBytesLen
-- TODO: Rename mkSetterCBytesLen
mkWithObjectSetterCBytesLen
    :: (forall a . object -> (botan -> IO a) -> IO a)
    -> (botan -> ConstPtr Word8 -> CSize -> IO BotanErrorCode)
    -> object
    -> ByteString
    -> IO ()
mkWithObjectSetterCBytesLen :: forall object botan.
(forall a. object -> (botan -> IO a) -> IO a)
-> (botan -> ConstPtr Word8 -> CSize -> IO CInt)
-> object
-> ByteString
-> IO ()
mkWithObjectSetterCBytesLen forall a. object -> (botan -> IO a) -> IO a
withObject botan -> ConstPtr Word8 -> CSize -> IO CInt
setter object
obj ByteString
bytes = object -> (botan -> IO ()) -> IO ()
forall a. object -> (botan -> IO a) -> IO a
withObject object
obj ((botan -> IO ()) -> IO ()) -> (botan -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ botan
cobj -> do
    ByteString -> (CBytesLen -> IO ()) -> IO ()
forall a. ByteString -> (CBytesLen -> IO a) -> IO a
withCBytesLen ByteString
bytes ((CBytesLen -> IO ()) -> IO ()) -> (CBytesLen -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ (Ptr Word8
cbytes,Int
len) -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ botan -> ConstPtr Word8 -> CSize -> IO CInt
setter botan
cobj (Ptr Word8 -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr Ptr Word8
cbytes) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)