module Botan.Low.Make where

import qualified Data.ByteString as ByteString

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

{-
Basic botan type template
-}

{-
-- Raw bindings
data TypStruct
type TypPtr = Ptr TypStruct

-- Low-level bindings
newtype Typ = MkTyp { getTypForeignPtr :: ForeignPtr TypStruct }

withTypPtr :: Typ -> (TypPtr -> IO a) -> IO a
withTypPtr = withForeignPtr . getTypForeignPtr

-- Common / optional associated types
type TypName = ByteString
type TypFlags = Word32
-}

{-
Helper types
-}

type WithPtr typ ptr = (forall a . typ -> (ptr -> IO a) -> IO a)
-- NOTE: WithPtr typ ptr ~ typ -> Codensity IO ptr 
--  where: type Codensity m a = forall b . (a -> m b) -> m b
-- TODO: Refine further per:
--  https://discourse.haskell.org/t/questions-about-ffi-foreignptr-and-opaque-types/6914/21?u=apothecalabs

{-
Initializers and destroyers
-}

-- TODO: Generalize all this away to simplify
--  Note the change in position of the destructor argument within the mk function itself,
--  as well as the position of the argument within the initializer
{-
type Construct struct typ = ForeignPtr struct -> typ
type Destruct struct = FinalizerPtr struct
type Initialize0 struct = Ptr (Ptr struct) -> IO BotanErrorCode

mkInit0
    :: Construct struct typ
    -> Destruct struct
    -> Initialize0 struct
    -> IO typ
mkInit0 construct destruct init0 = do
    alloca $ \ outPtr -> do
        throwBotanIfNegative_ $ init0 outPtr
        out <- peek outPtr
        foreignPtr <- newForeignPtr destruct out
        return $ construct foreignPtr
-}
-- More complex constructors can build on this with more arguments, but there is a choice
--  This choice is left vs right, return arguments before or after.
--  The effectiveness of this choice depends on the structure of the FFI
--  If we changed the FFI to always have trailing return arguments (instead of leading),
--  then we could type
--      Initializer1 withArg0 ... struct
--  instead of
--      Initializer1 struct withArg0 ...
--  Note that even Construct follows trailing return arguments as does Haskell,
--  so there is justifcation for converting the FFI to that format wholesale;
--  such effort (rewriting the Botan FFI to be 100% consistent) is far beyond
--  the scope of this project at this time.
-- SEE: mkInit_with
-- EXAMPLE:
{-
mkFoo :: A -> B -> C -> IO Foo
mkFoo a b c = withA a $ \ a' -> do
    withB b $ \ b' -> do
        withC c $ \ c' -> do
            -- Trailing-return style
            mkInit0 MkFoo botan_foo_destroy $ botan_foo_create a' b' c'
            -- Vs current leading-return style
            mkInit MkFoo (\ ptr -> botan_foo_create ptr a' b' c') botan_x509_cert_store_destroy
            -- Note the explicit ptr argument and the necessary parenthesis
-}
-- SEE: x509CertStoreSqlite3Create for how the current style makes ad-hoc constructors
--  more difficult than necessary unless we initialize the return pointer first
-- Also note that initializing the return value pointer last is probably a good practice in general
--  and trailing-return style makes that easy
-- ON THE OTHER HAND trailing-return style makes querying for sizes difficult
-- END TODO

type Constr struct typ = ForeignPtr struct -> typ

type Initializer struct = Ptr (Ptr struct) -> IO BotanErrorCode
type Initializer_name struct = Ptr (Ptr struct) -> CString -> IO BotanErrorCode
type Initializer_name_flags struct = Ptr (Ptr struct) -> CString -> Word32 -> IO BotanErrorCode
type Initializer_bytes struct = Ptr (Ptr struct) -> Ptr Word8 -> IO BotanErrorCode
type Initializer_bytes_len struct = Ptr (Ptr struct) -> Ptr Word8 -> CSize -> IO BotanErrorCode

type Destructor struct = FinalizerPtr struct

mkInit
    :: Constr struct typ
    -> Initializer struct
    -> Destructor struct
    -> IO typ
mkInit :: forall struct typ.
Constr struct typ
-> Initializer struct -> Destructor struct -> IO typ
mkInit Constr struct typ
constr Initializer struct
init Destructor struct
destroy = do
    (Ptr (Ptr struct) -> IO typ) -> IO typ
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr struct) -> IO typ) -> IO typ)
-> (Ptr (Ptr struct) -> IO typ) -> IO typ
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr struct)
outPtr -> do
        HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Initializer struct
init Ptr (Ptr struct)
outPtr
        Ptr struct
out <- Ptr (Ptr struct) -> IO (Ptr struct)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr struct)
outPtr
        ForeignPtr struct
foreignPtr <- Destructor struct -> Ptr struct -> IO (ForeignPtr struct)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr Destructor struct
destroy Ptr struct
out
        typ -> IO typ
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (typ -> IO typ) -> typ -> IO typ
forall a b. (a -> b) -> a -> b
$ Constr struct typ
constr ForeignPtr struct
foreignPtr

mkInit_name
    :: Constr struct typ
    -> Initializer_name struct
    -> Destructor struct
    -> ByteString -> IO typ
mkInit_name :: forall struct typ.
Constr struct typ
-> Initializer_name struct
-> Destructor struct
-> ByteString
-> IO typ
mkInit_name Constr struct typ
constr Initializer_name struct
init Destructor struct
destroy ByteString
name = do
    (Ptr (Ptr struct) -> IO typ) -> IO typ
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr struct) -> IO typ) -> IO typ)
-> (Ptr (Ptr struct) -> IO typ) -> IO typ
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr struct)
outPtr -> do
        ByteString -> (Ptr CChar -> IO ()) -> IO ()
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
name ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
namePtr -> do 
            HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Initializer_name struct
init Ptr (Ptr struct)
outPtr Ptr CChar
namePtr
        Ptr struct
out <- Ptr (Ptr struct) -> IO (Ptr struct)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr struct)
outPtr
        ForeignPtr struct
foreignPtr <- Destructor struct -> Ptr struct -> IO (ForeignPtr struct)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr Destructor struct
destroy Ptr struct
out
        typ -> IO typ
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (typ -> IO typ) -> typ -> IO typ
forall a b. (a -> b) -> a -> b
$ Constr struct typ
constr ForeignPtr struct
foreignPtr

mkInit_name_flags
    :: Constr struct typ
    -> Initializer_name_flags struct
    -> Destructor struct
    -> ByteString -> Word32 -> IO typ
mkInit_name_flags :: forall struct typ.
Constr struct typ
-> Initializer_name_flags struct
-> Destructor struct
-> ByteString
-> Word32
-> IO typ
mkInit_name_flags Constr struct typ
constr Initializer_name_flags struct
init Destructor struct
destroy ByteString
name Word32
flags = do
    (Ptr (Ptr struct) -> IO typ) -> IO typ
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr struct) -> IO typ) -> IO typ)
-> (Ptr (Ptr struct) -> IO typ) -> IO typ
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr struct)
outPtr -> do
        ByteString -> (Ptr CChar -> IO ()) -> IO ()
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
name ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
namePtr -> do 
            HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Initializer_name_flags struct
init Ptr (Ptr struct)
outPtr Ptr CChar
namePtr Word32
flags
        Ptr struct
out <- Ptr (Ptr struct) -> IO (Ptr struct)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr struct)
outPtr
        ForeignPtr struct
foreignPtr <- Destructor struct -> Ptr struct -> IO (ForeignPtr struct)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr Destructor struct
destroy Ptr struct
out
        typ -> IO typ
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (typ -> IO typ) -> typ -> IO typ
forall a b. (a -> b) -> a -> b
$ Constr struct typ
constr ForeignPtr struct
foreignPtr

-- NOTE: Assumes that length is known
mkInit_bytes
    :: Constr struct typ
    -> Initializer_bytes struct
    -> Destructor struct
    -> ByteString -> IO typ
mkInit_bytes :: forall struct typ.
Constr struct typ
-> Initializer_bytes struct
-> Destructor struct
-> ByteString
-> IO typ
mkInit_bytes Constr struct typ
constr Initializer_bytes struct
init Destructor struct
destroy ByteString
bytes = do
    ByteString -> (Ptr Word8 -> IO typ) -> IO typ
forall byte a. ByteString -> (Ptr byte -> IO a) -> IO a
asBytes ByteString
bytes ((Ptr Word8 -> IO typ) -> IO typ)
-> (Ptr Word8 -> IO typ) -> IO typ
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
bytesPtr -> do 
        (Ptr (Ptr struct) -> IO typ) -> IO typ
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr struct) -> IO typ) -> IO typ)
-> (Ptr (Ptr struct) -> IO typ) -> IO typ
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr struct)
outPtr -> do
            HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Initializer_bytes struct
init Ptr (Ptr struct)
outPtr Ptr Word8
bytesPtr
            Ptr struct
out <- Ptr (Ptr struct) -> IO (Ptr struct)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr struct)
outPtr
            ForeignPtr struct
foreignPtr <- Destructor struct -> Ptr struct -> IO (ForeignPtr struct)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr Destructor struct
destroy Ptr struct
out
            typ -> IO typ
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (typ -> IO typ) -> typ -> IO typ
forall a b. (a -> b) -> a -> b
$ Constr struct typ
constr ForeignPtr struct
foreignPtr

mkInit_bytes_len
    :: Constr struct typ
    -> Initializer_bytes_len struct
    -> Destructor struct
    -> ByteString -> IO typ
mkInit_bytes_len :: forall struct typ.
Constr struct typ
-> Initializer_bytes_len struct
-> Destructor struct
-> ByteString
-> IO typ
mkInit_bytes_len Constr struct typ
constr Initializer_bytes_len struct
init Destructor struct
destroy ByteString
bytes = do
    ByteString -> (Ptr Word8 -> CSize -> IO typ) -> IO typ
forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen ByteString
bytes ((Ptr Word8 -> CSize -> IO typ) -> IO typ)
-> (Ptr Word8 -> CSize -> IO typ) -> IO typ
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
bytesPtr CSize
bytesLen -> do 
        (Ptr (Ptr struct) -> IO typ) -> IO typ
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr struct) -> IO typ) -> IO typ)
-> (Ptr (Ptr struct) -> IO typ) -> IO typ
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr struct)
outPtr -> do
            HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Initializer_bytes_len struct
init Ptr (Ptr struct)
outPtr Ptr Word8
bytesPtr CSize
bytesLen
            Ptr struct
out <- Ptr (Ptr struct) -> IO (Ptr struct)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr struct)
outPtr
            ForeignPtr struct
foreignPtr <- Destructor struct -> Ptr struct -> IO (ForeignPtr struct)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr Destructor struct
destroy Ptr struct
out
            typ -> IO typ
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (typ -> IO typ) -> typ -> IO typ
forall a b. (a -> b) -> a -> b
$ Constr struct typ
constr ForeignPtr struct
foreignPtr

-- Initializing with another botan object
-- TODO: Use this in already-implemented functions as appropriate

type Initializer_with struct withptr = Ptr (Ptr struct) -> withptr -> IO BotanErrorCode

mkInit_with
    :: Constr struct typ
    -> Initializer_with struct withptr
    -> Destructor struct
    -> (withtyp -> (withptr -> IO typ) -> IO typ)
    -> withtyp -> IO typ
mkInit_with :: forall struct typ withptr withtyp.
Constr struct typ
-> Initializer_with struct withptr
-> Destructor struct
-> (withtyp -> (withptr -> IO typ) -> IO typ)
-> withtyp
-> IO typ
mkInit_with Constr struct typ
constr Initializer_with struct withptr
init Destructor struct
destroy withtyp -> (withptr -> IO typ) -> IO typ
withTypPtr withtyp
typ = (Ptr (Ptr struct) -> IO typ) -> IO typ
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr (Ptr struct) -> IO typ) -> IO typ)
-> (Ptr (Ptr struct) -> IO typ) -> IO typ
forall a b. (a -> b) -> a -> b
$ \ Ptr (Ptr struct)
outPtr -> do
    withtyp -> (withptr -> IO typ) -> IO typ
withTypPtr withtyp
typ ((withptr -> IO typ) -> IO typ) -> (withptr -> IO typ) -> IO typ
forall a b. (a -> b) -> a -> b
$ \ withptr
typPtr -> do
        HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Initializer_with struct withptr
init Ptr (Ptr struct)
outPtr withptr
typPtr
        Ptr struct
out <- Ptr (Ptr struct) -> IO (Ptr struct)
forall a. Storable a => Ptr a -> IO a
peek Ptr (Ptr struct)
outPtr
        ForeignPtr struct
foreignPtr <- Destructor struct -> Ptr struct -> IO (ForeignPtr struct)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr Destructor struct
destroy Ptr struct
out
        typ -> IO typ
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (typ -> IO typ) -> typ -> IO typ
forall a b. (a -> b) -> a -> b
$ Constr struct typ
constr ForeignPtr struct
foreignPtr

{-
Non-effectful queries
-}

-- type GetName ptr = ptr -> Ptr CChar -> Ptr CSize -> IO BotanErrorCode

-- Replaced by the new mkGetCString
-- -- TODO: Prefer mkGetBytes / mkGetCString to mkGetName
-- mkGetName
--     :: WithPtr typ ptr
--     -> GetName ptr
--     -> typ -> IO ByteString
-- mkGetName withPtr get typ = withPtr typ $ \ typPtr -> do
--     -- TODO: Take advantage of allocBytesQuerying
--     -- TODO: use ByteString.Internal.createAndTrim?
--     -- NOTE: This uses copy to mimic ByteArray.take (which copies!) so we can drop the rest of the bytestring
--     -- alloca $ \ szPtr -> do
--     --     bytes <- allocBytes 64 $ \ bytesPtr -> do
--     --         throwBotanIfNegative_ $ get typPtr bytesPtr szPtr
--     --     sz <- peek szPtr
--     --     return $! ByteString.copy $! ByteString.take (fromIntegral sz) bytes
--     allocBytesQueryingCString $ \ bytesPtr szPtr -> get typPtr bytesPtr szPtr

-- NOTE: This now handles both Ptr Word8 and Ptr CChar
--  This reads the entire byte buffer, including any \NUL bytes
type GetBytes ptr byte = ptr -> Ptr byte -> Ptr CSize -> IO BotanErrorCode

mkGetBytes
    :: WithPtr typ ptr
    -> GetBytes ptr byte
    -> typ -> IO ByteString
mkGetBytes :: forall typ ptr byte.
WithPtr typ ptr -> GetBytes ptr byte -> typ -> IO ByteString
mkGetBytes WithPtr typ ptr
withPtr GetBytes ptr byte
get typ
typ = typ -> (ptr -> IO ByteString) -> IO ByteString
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO ByteString) -> IO ByteString)
-> (ptr -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    (Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString
forall byte.
(Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString
allocBytesQuerying ((Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString)
-> (Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr byte
outPtr Ptr CSize
outLen -> GetBytes ptr byte
get ptr
typPtr Ptr byte
outPtr Ptr CSize
outLen

-- NOTE This reads a CString, up to the first \NUL
type GetCString ptr byte = ptr -> Ptr byte -> Ptr CSize -> IO BotanErrorCode

mkGetCString
    :: WithPtr typ ptr
    -> GetCString ptr byte
    -> typ -> IO ByteString
mkGetCString :: forall typ ptr byte.
WithPtr typ ptr -> GetBytes ptr byte -> typ -> IO ByteString
mkGetCString WithPtr typ ptr
withPtr GetCString ptr byte
get typ
typ = typ -> (ptr -> IO ByteString) -> IO ByteString
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO ByteString) -> IO ByteString)
-> (ptr -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    (Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString
forall byte.
(Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString
allocBytesQueryingCString ((Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString)
-> (Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr byte
outPtr Ptr CSize
outLen -> GetCString ptr byte
get ptr
typPtr Ptr byte
outPtr Ptr CSize
outLen

type GetInt ptr = ptr -> Ptr CInt -> IO BotanErrorCode

mkGetInt
    :: WithPtr typ ptr
    -> GetInt ptr
    -> typ -> IO Int
mkGetInt :: forall typ ptr. WithPtr typ ptr -> GetInt ptr -> typ -> IO Int
mkGetInt WithPtr typ ptr
withPtr GetInt ptr
get typ
typ = typ -> (ptr -> IO Int) -> IO Int
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO Int) -> IO Int) -> (ptr -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    (Ptr BotanErrorCode -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr BotanErrorCode -> IO Int) -> IO Int)
-> (Ptr BotanErrorCode -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ Ptr BotanErrorCode
szPtr -> do
        HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ GetInt ptr
get ptr
typPtr Ptr BotanErrorCode
szPtr
        BotanErrorCode -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (BotanErrorCode -> Int) -> IO BotanErrorCode -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr BotanErrorCode -> IO BotanErrorCode
forall a. Storable a => Ptr a -> IO a
peek Ptr BotanErrorCode
szPtr

type GetSize ptr = ptr -> Ptr CSize -> IO BotanErrorCode
type GetSize_csize ptr = ptr -> CSize -> Ptr CSize -> IO BotanErrorCode
type GetSizes2 ptr = ptr -> Ptr CSize -> Ptr CSize -> IO BotanErrorCode
type GetSizes3 ptr = ptr -> Ptr CSize -> Ptr CSize -> Ptr CSize -> IO BotanErrorCode

mkGetSize
    :: WithPtr typ ptr
    -> GetSize ptr
    -> typ -> IO Int
mkGetSize :: forall typ ptr. WithPtr typ ptr -> GetSize ptr -> typ -> IO Int
mkGetSize WithPtr typ ptr
withPtr GetSize ptr
get typ
typ = typ -> (ptr -> IO Int) -> IO Int
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO Int) -> IO Int) -> (ptr -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    (Ptr CSize -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO Int) -> IO Int)
-> (Ptr CSize -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
szPtr -> do
        HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ GetSize ptr
get ptr
typPtr Ptr CSize
szPtr
        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

mkGetSize_csize
    :: WithPtr typ ptr
    -> GetSize_csize ptr
    -> typ -> Int -> IO Int
mkGetSize_csize :: forall typ ptr.
WithPtr typ ptr -> GetSize_csize ptr -> typ -> Int -> IO Int
mkGetSize_csize WithPtr typ ptr
withPtr GetSize_csize ptr
get typ
typ Int
forSz = typ -> (ptr -> IO Int) -> IO Int
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO Int) -> IO Int) -> (ptr -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    (Ptr CSize -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO Int) -> IO Int)
-> (Ptr CSize -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
szPtr -> do
        HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ GetSize_csize ptr
get ptr
typPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
forSz) Ptr CSize
szPtr
        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

mkGetSizes2
    :: WithPtr typ ptr
    -> GetSizes2 ptr
    -> typ -> IO (Int,Int)
mkGetSizes2 :: forall typ ptr.
WithPtr typ ptr -> GetSizes2 ptr -> typ -> IO (Int, Int)
mkGetSizes2 WithPtr typ ptr
withPtr GetSizes2 ptr
get typ
typ = typ -> (ptr -> IO (Int, Int)) -> IO (Int, Int)
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO (Int, Int)) -> IO (Int, Int))
-> (ptr -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    (Ptr CSize -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CSize -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
szPtrA -> (Ptr CSize -> IO (Int, Int)) -> IO (Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO (Int, Int)) -> IO (Int, Int))
-> (Ptr CSize -> IO (Int, Int)) -> IO (Int, Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
szPtrB -> do
        HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ GetSizes2 ptr
get ptr
typPtr Ptr CSize
szPtrA Ptr CSize
szPtrB
        Int
szA <- 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
szPtrA
        Int
szB <- 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
szPtrB
        (Int, Int) -> IO (Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
szA,Int
szB)

mkGetSizes3
    :: WithPtr typ ptr
    -> GetSizes3 ptr
    -> typ -> IO (Int,Int,Int)
mkGetSizes3 :: forall typ ptr.
WithPtr typ ptr -> GetSizes3 ptr -> typ -> IO (Int, Int, Int)
mkGetSizes3 WithPtr typ ptr
withPtr GetSizes3 ptr
get typ
typ = typ -> (ptr -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (ptr -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    (Ptr CSize -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr CSize -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
szPtrA -> (Ptr CSize -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr CSize -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
szPtrB -> (Ptr CSize -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO (Int, Int, Int)) -> IO (Int, Int, Int))
-> (Ptr CSize -> IO (Int, Int, Int)) -> IO (Int, Int, Int)
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
szPtrC -> do
        HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ GetSizes3 ptr
get ptr
typPtr Ptr CSize
szPtrA Ptr CSize
szPtrB Ptr CSize
szPtrC
        Int
szA <- 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
szPtrA
        Int
szB <- 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
szPtrB
        Int
szC <- 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
szPtrC
        (Int, Int, Int) -> IO (Int, Int, Int)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
szA,Int
szB,Int
szC)

-- type GetBytes ptr = ptr -> Ptr Word8 -> CSize -> IO BotanErrorCode

-- NOTE: Get...Code nomenclature signifies that we get the desired return value
--  from the error code error code, eg they use something other than throwBotanIfNegative_
--      


type GetSuccessCode ptr = ptr -> IO BotanErrorCode
type GetSuccessCode_csize ptr = ptr -> CSize -> IO BotanErrorCode

mkGetSuccessCode
    :: WithPtr typ ptr
    -> GetSuccessCode ptr
    -> typ -> IO Bool
mkGetSuccessCode :: forall typ ptr.
WithPtr typ ptr -> GetSuccessCode ptr -> typ -> IO Bool
mkGetSuccessCode WithPtr typ ptr
withPtr GetSuccessCode ptr
get typ
typ = typ -> (ptr -> IO Bool) -> IO Bool
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO Bool) -> IO Bool) -> (ptr -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    HasCallStack => IO BotanErrorCode -> IO Bool
IO BotanErrorCode -> IO Bool
throwBotanCatchingSuccess (IO BotanErrorCode -> IO Bool) -> IO BotanErrorCode -> IO Bool
forall a b. (a -> b) -> a -> b
$ GetSuccessCode ptr
get ptr
typPtr

mkGetSuccessCode_csize
    :: WithPtr typ ptr
    -> GetSuccessCode_csize ptr
    -> typ -> Int -> IO Bool
mkGetSuccessCode_csize :: forall typ ptr.
WithPtr typ ptr
-> GetSuccessCode_csize ptr -> typ -> Int -> IO Bool
mkGetSuccessCode_csize WithPtr typ ptr
withPtr GetSuccessCode_csize ptr
get typ
typ Int
sz = typ -> (ptr -> IO Bool) -> IO Bool
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO Bool) -> IO Bool) -> (ptr -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    HasCallStack => IO BotanErrorCode -> IO Bool
IO BotanErrorCode -> IO Bool
throwBotanCatchingSuccess (IO BotanErrorCode -> IO Bool) -> IO BotanErrorCode -> IO Bool
forall a b. (a -> b) -> a -> b
$ GetSuccessCode_csize ptr
get ptr
typPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)


type GetBoolCode ptr = ptr -> IO BotanErrorCode
type GetBoolCode_csize ptr = ptr -> CSize -> IO BotanErrorCode

mkGetBoolCode
    :: WithPtr typ ptr
    -> GetBoolCode ptr
    -> typ -> IO Bool
mkGetBoolCode :: forall typ ptr.
WithPtr typ ptr -> GetSuccessCode ptr -> typ -> IO Bool
mkGetBoolCode WithPtr typ ptr
withPtr GetBoolCode ptr
get typ
typ = typ -> (ptr -> IO Bool) -> IO Bool
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO Bool) -> IO Bool) -> (ptr -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    HasCallStack => IO BotanErrorCode -> IO Bool
IO BotanErrorCode -> IO Bool
throwBotanCatchingBool (IO BotanErrorCode -> IO Bool) -> IO BotanErrorCode -> IO Bool
forall a b. (a -> b) -> a -> b
$ GetBoolCode ptr
get ptr
typPtr

mkGetBoolCode_csize
    :: WithPtr typ ptr
    -> GetBoolCode_csize ptr
    -> typ -> Int -> IO Bool
mkGetBoolCode_csize :: forall typ ptr.
WithPtr typ ptr
-> GetSuccessCode_csize ptr -> typ -> Int -> IO Bool
mkGetBoolCode_csize WithPtr typ ptr
withPtr GetBoolCode_csize ptr
get typ
typ Int
sz = typ -> (ptr -> IO Bool) -> IO Bool
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO Bool) -> IO Bool) -> (ptr -> IO Bool) -> IO Bool
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    HasCallStack => IO BotanErrorCode -> IO Bool
IO BotanErrorCode -> IO Bool
throwBotanCatchingBool (IO BotanErrorCode -> IO Bool) -> IO BotanErrorCode -> IO Bool
forall a b. (a -> b) -> a -> b
$ GetBoolCode_csize ptr
get ptr
typPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)

type GetIntCode ptr = ptr -> IO BotanErrorCode
type GetIntCode_csize ptr = ptr -> CSize -> IO BotanErrorCode

mkGetIntCode
    :: WithPtr typ ptr
    -> GetIntCode ptr
    -> typ -> IO Int
mkGetIntCode :: forall typ ptr. WithPtr typ ptr -> GetIntCode ptr -> typ -> IO Int
mkGetIntCode WithPtr typ ptr
withPtr GetIntCode ptr
get typ
typ = typ -> (ptr -> IO Int) -> IO Int
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO Int) -> IO Int) -> (ptr -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    HasCallStack => IO BotanErrorCode -> IO Int
IO BotanErrorCode -> IO Int
throwBotanCatchingInt (IO BotanErrorCode -> IO Int) -> IO BotanErrorCode -> IO Int
forall a b. (a -> b) -> a -> b
$ GetIntCode ptr
get ptr
typPtr

mkGetIntCode_csize
    :: WithPtr typ ptr
    -> GetIntCode_csize ptr
    -> typ -> CSize -> IO Int
mkGetIntCode_csize :: forall typ ptr.
WithPtr typ ptr -> GetIntCode_csize ptr -> typ -> CSize -> IO Int
mkGetIntCode_csize WithPtr typ ptr
withPtr GetIntCode_csize ptr
get typ
typ CSize
sz = typ -> (ptr -> IO Int) -> IO Int
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO Int) -> IO Int) -> (ptr -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    HasCallStack => IO BotanErrorCode -> IO Int
IO BotanErrorCode -> IO Int
throwBotanCatchingInt (IO BotanErrorCode -> IO Int) -> IO BotanErrorCode -> IO Int
forall a b. (a -> b) -> a -> b
$ GetIntCode_csize ptr
get ptr
typPtr CSize
sz

{-
Effectful actions
-}

type Action ptr = ptr -> IO BotanErrorCode
mkAction
    :: WithPtr typ ptr
    -> Action ptr
    -> typ -> IO ()
mkAction :: forall typ ptr. WithPtr typ ptr -> Action ptr -> typ -> IO ()
mkAction WithPtr typ ptr
withPtr Action ptr
action typ
typ = typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Action ptr
action ptr
typPtr

mkSet
    :: WithPtr typ ptr
    -> (ptr -> a -> IO BotanErrorCode)
    -> typ -> a -> IO ()
mkSet :: forall typ ptr a.
WithPtr typ ptr
-> (ptr -> a -> IO BotanErrorCode) -> typ -> a -> IO ()
mkSet WithPtr typ ptr
withPtr ptr -> a -> IO BotanErrorCode
set typ
typ a
a = typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ ptr -> a -> IO BotanErrorCode
set ptr
typPtr a
a

mkSetOn
    :: WithPtr typ ptr
    -> (a -> b)
    -> (ptr -> b -> IO BotanErrorCode)
    -> typ -> a -> IO ()
mkSetOn :: forall typ ptr a b.
WithPtr typ ptr
-> (a -> b) -> (ptr -> b -> IO BotanErrorCode) -> typ -> a -> IO ()
mkSetOn WithPtr typ ptr
withPtr a -> b
fn ptr -> b -> IO BotanErrorCode
set typ
typ a
sz = typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ ptr -> b -> IO BotanErrorCode
set ptr
typPtr (a -> b
fn a
sz)

type SetCSize ptr = ptr -> CSize -> IO BotanErrorCode
type SetCInt ptr = ptr -> CInt -> IO BotanErrorCode

mkSetCSize
    :: WithPtr typ ptr
    -> SetCSize ptr
    -> typ -> Int -> IO ()
mkSetCSize :: forall typ ptr.
WithPtr typ ptr -> SetCSize ptr -> typ -> Int -> IO ()
mkSetCSize WithPtr typ ptr
withPtr SetCSize ptr
set typ
typ Int
sz = typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ SetCSize ptr
set ptr
typPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)

mkSetCInt
    :: WithPtr typ ptr
    -> SetCInt ptr
    -> typ -> Int -> IO ()
mkSetCInt :: forall typ ptr.
WithPtr typ ptr -> SetCInt ptr -> typ -> Int -> IO ()
mkSetCInt WithPtr typ ptr
withPtr SetCInt ptr
set typ
typ Int
sz = typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ SetCInt ptr
set ptr
typPtr (Int -> BotanErrorCode
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)

type SetCString ptr = ptr -> CString -> IO BotanErrorCode
type SetCString_csize ptr = ptr -> CString -> CSize -> IO BotanErrorCode

mkSetCString
    :: WithPtr typ ptr
    -> SetCString ptr
    -> typ -> ByteString -> IO ()
mkSetCString :: forall typ ptr.
WithPtr typ ptr -> SetCString ptr -> typ -> ByteString -> IO ()
mkSetCString WithPtr typ ptr
withPtr SetCString ptr
set typ
typ ByteString
cstring = typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    ByteString -> (Ptr CChar -> IO ()) -> IO ()
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
cstring ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
cstringPtr -> do 
        HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ SetCString ptr
set ptr
typPtr Ptr CChar
cstringPtr

mkSetCString_csize
    :: WithPtr typ ptr
    -> SetCString_csize ptr
    -> typ -> ByteString -> Int -> IO ()
mkSetCString_csize :: forall typ ptr.
WithPtr typ ptr
-> SetCString_csize ptr -> typ -> ByteString -> Int -> IO ()
mkSetCString_csize WithPtr typ ptr
withPtr SetCString_csize ptr
set typ
typ ByteString
cstring Int
sz = typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    ByteString -> (Ptr CChar -> IO ()) -> IO ()
forall a. ByteString -> (Ptr CChar -> IO a) -> IO a
asCString ByteString
cstring ((Ptr CChar -> IO ()) -> IO ()) -> (Ptr CChar -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr CChar
cstringPtr -> do 
        HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ SetCString_csize ptr
set ptr
typPtr Ptr CChar
cstringPtr (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)

type SetBytesLen ptr = ptr -> Ptr Word8 -> CSize -> IO BotanErrorCode

mkSetBytesLen
    :: WithPtr typ ptr
    -> SetBytesLen ptr
    -> typ -> ByteString -> IO ()
mkSetBytesLen :: forall typ ptr.
WithPtr typ ptr -> SetBytesLen ptr -> typ -> ByteString -> IO ()
mkSetBytesLen WithPtr typ ptr
withPtr SetBytesLen ptr
set typ
typ ByteString
bytes = typ -> (ptr -> IO ()) -> IO ()
WithPtr typ ptr
withPtr typ
typ ((ptr -> IO ()) -> IO ()) -> (ptr -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> do
    ByteString -> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall byte a. ByteString -> (Ptr byte -> CSize -> IO a) -> IO a
asBytesLen ByteString
bytes ((Ptr Word8 -> CSize -> IO ()) -> IO ())
-> (Ptr Word8 -> CSize -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \ Ptr Word8
bytesPtr CSize
bytesLen -> do 
        HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ SetBytesLen ptr
set ptr
typPtr Ptr Word8
bytesPtr CSize
bytesLen

-- EXPERIMENTAL

-- TODO: allocBytesEstimating

-- NOTE: This properly takes advantage of szPtr, queries the buffer size - use this elsewhere
-- NOTE: This throws any botan codes other than BOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE
allocBytesQuerying :: (Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString
allocBytesQuerying :: forall byte.
(Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString
allocBytesQuerying Ptr byte -> Ptr CSize -> IO BotanErrorCode
fn = do
    (Ptr CSize -> IO ByteString) -> IO ByteString
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CSize -> IO ByteString) -> IO ByteString)
-> (Ptr CSize -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr CSize
szPtr -> do
        -- TODO: Maybe poke szPtr 0 for extra safety in cas its not initially zero
        BotanErrorCode
code <- Ptr byte -> Ptr CSize -> IO BotanErrorCode
fn Ptr byte
forall a. Ptr a
nullPtr Ptr CSize
szPtr
        case BotanErrorCode
code of
            BotanErrorCode
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 byte -> IO ()) -> IO ByteString
forall byte. Int -> (Ptr byte -> IO ()) -> IO ByteString
allocBytes Int
sz ((Ptr byte -> IO ()) -> IO ByteString)
-> (Ptr byte -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ Ptr byte
outPtr -> HasCallStack => IO BotanErrorCode -> IO ()
IO BotanErrorCode -> IO ()
throwBotanIfNegative_ (IO BotanErrorCode -> IO ()) -> IO BotanErrorCode -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr byte -> Ptr CSize -> IO BotanErrorCode
fn Ptr byte
outPtr Ptr CSize
szPtr
            BotanErrorCode
_                       -> do
                BotanErrorCode -> IO ByteString
forall a. HasCallStack => BotanErrorCode -> IO a
throwBotanError BotanErrorCode
code

-- NOTE: Does not check length of taken string, vulnerable to null byte injection
allocBytesQueryingCString :: (Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString
allocBytesQueryingCString :: forall byte.
(Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString
allocBytesQueryingCString Ptr byte -> Ptr CSize -> IO BotanErrorCode
action = do
    ByteString
cstring <- (Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString
forall byte.
(Ptr byte -> Ptr CSize -> IO BotanErrorCode) -> IO ByteString
allocBytesQuerying Ptr byte -> Ptr CSize -> IO BotanErrorCode
action
    ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. NFData a => (a -> b) -> a -> b
$!! (Word8 -> Bool) -> ByteString -> ByteString
ByteString.takeWhile (Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
/= Word8
0) ByteString
cstring

-- ALSO EXPERIMENTAL

-- LAZY BUT EFFECTIVE

mkWithTemp :: IO t -> (t -> IO ()) -> (t -> IO a) -> IO a
mkWithTemp :: forall t a. IO t -> (t -> IO ()) -> (t -> IO a) -> IO a
mkWithTemp = IO t -> (t -> IO ()) -> (t -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket

mkWithTemp1 :: (x -> IO t) -> (t -> IO ()) -> x -> (t -> IO a) -> IO a
mkWithTemp1 :: forall x t a.
(x -> IO t) -> (t -> IO ()) -> x -> (t -> IO a) -> IO a
mkWithTemp1 x -> IO t
init t -> IO ()
destroy x
x = IO t -> (t -> IO ()) -> (t -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (x -> IO t
init x
x) t -> IO ()
destroy

mkWithTemp2 :: (x -> y -> IO t) -> (t -> IO ()) -> x -> y -> (t -> IO a) -> IO a
mkWithTemp2 :: forall x y t a.
(x -> y -> IO t) -> (t -> IO ()) -> x -> y -> (t -> IO a) -> IO a
mkWithTemp2 x -> y -> IO t
init t -> IO ()
destroy x
x y
y = IO t -> (t -> IO ()) -> (t -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (x -> y -> IO t
init x
x y
y) t -> IO ()
destroy

mkWithTemp3 :: (x -> y -> z -> IO t) -> (t -> IO ()) -> x -> y -> z -> (t -> IO a) -> IO a
mkWithTemp3 :: forall x y z t a.
(x -> y -> z -> IO t)
-> (t -> IO ()) -> x -> y -> z -> (t -> IO a) -> IO a
mkWithTemp3 x -> y -> z -> IO t
init t -> IO ()
destroy x
x y
y z
z = IO t -> (t -> IO ()) -> (t -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (x -> y -> z -> IO t
init x
x y
y z
z) t -> IO ()
destroy

mkWithTemp4 :: (x -> y -> z -> w -> IO t) -> (t -> IO ()) -> x -> y -> z -> w -> (t -> IO a) -> IO a
mkWithTemp4 :: forall x y z w t a.
(x -> y -> z -> w -> IO t)
-> (t -> IO ()) -> x -> y -> z -> w -> (t -> IO a) -> IO a
mkWithTemp4 x -> y -> z -> w -> IO t
init t -> IO ()
destroy x
x y
y z
z w
w = IO t -> (t -> IO ()) -> (t -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
bracket (x -> y -> z -> w -> IO t
init x
x y
y z
z w
w) t -> IO ()
destroy

--

withPtrs :: (forall a . typ -> (ptr -> IO a) -> IO a) -> [typ] -> ([ptr] -> IO b) -> IO b
withPtrs :: forall typ ptr b.
(forall a. typ -> (ptr -> IO a) -> IO a)
-> [typ] -> ([ptr] -> IO b) -> IO b
withPtrs forall a. typ -> (ptr -> IO a) -> IO a
withPtr []         [ptr] -> IO b
act = [ptr] -> IO b
act []
withPtrs forall a. typ -> (ptr -> IO a) -> IO a
withPtr (typ
typ:[typ]
typs) [ptr] -> IO b
act = typ -> (ptr -> IO b) -> IO b
forall a. typ -> (ptr -> IO a) -> IO a
withPtr typ
typ ((ptr -> IO b) -> IO b) -> (ptr -> IO b) -> IO b
forall a b. (a -> b) -> a -> b
$ \ ptr
typPtr -> (forall a. typ -> (ptr -> IO a) -> IO a)
-> [typ] -> ([ptr] -> IO b) -> IO b
forall typ ptr b.
(forall a. typ -> (ptr -> IO a) -> IO a)
-> [typ] -> ([ptr] -> IO b) -> IO b
withPtrs typ -> (ptr -> IO a) -> IO a
forall a. typ -> (ptr -> IO a) -> IO a
withPtr [typ]
typs ([ptr] -> IO b
act ([ptr] -> IO b) -> ([ptr] -> [ptr]) -> [ptr] -> IO b
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (ptr
typPtrptr -> [ptr] -> [ptr]
forall a. a -> [a] -> [a]
:))

-- withNullablePtr

-- withNullablePtrList