module Botan.Low.Make (
    WithPtr
  , Constr
  , Initializer
  , Initializer_name
  , Initializer_name_flags
  , Initializer_bytes
  , Initializer_bytes_len
  , Destructor
  , mkInit
  , mkInit_name
  , mkInit_name_flags
  , mkInit_bytes
  , mkInit_bytes_len
  , Initializer_with
  , mkInit_with
  , GetBytes
  , mkGetBytes
  , GetCString
  , mkGetCString
  , GetInt
  , mkGetInt
  , GetSize
  , GetSize_csize
  , GetSizes2
  , GetSizes3
  , mkGetSize
  , mkGetSize_csize
  , mkGetSizes2
  , mkGetSizes3
  , GetBoolCode
  , GetBoolCode_csize
  , mkGetBoolCode
  , mkGetBoolCode_csize
  , GetIntCode
  , GetIntCode_csize
  , mkGetIntCode
  , mkGetIntCode_csize
  , Action
  , mkAction
  , mkSet
  , mkSetOn
  , SetCSize
  , SetCInt
  , mkSetCSize
  , mkSetCInt
  , SetCString
  , SetCString_csize
  , mkSetCString
  , mkSetCString_csize
  , SetBytesLen
  , mkSetBytesLen
  , allocBytesQuerying
  , allocBytesQueryingCString
  , mkWithTemp
  , mkWithTemp1
  , mkWithTemp2
  , mkWithTemp3
  , mkWithTemp4
  , withPtrs
  ) where

import           Botan.Bindings.Error
import           Botan.Low.Error.Internal
import           Botan.Low.Internal.ByteString
import           Control.DeepSeq
import           Control.Exception
import           Data.ByteString (ByteString)
import qualified Data.ByteString as ByteString
import           Data.Word
import           Foreign.C.String
import           Foreign.C.Types
import           Foreign.ForeignPtr
import           Foreign.Marshal.Alloc
import           Foreign.Ptr
import           Foreign.Storable
import           Prelude hiding (init)

{-
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 CInt

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 CInt
type Initializer_name struct = Ptr (Ptr struct) -> CString -> IO CInt
type Initializer_name_flags struct = Ptr (Ptr struct) -> CString -> Word32 -> IO CInt
type Initializer_bytes struct = Ptr (Ptr struct) -> Ptr Word8 -> IO CInt
type Initializer_bytes_len struct = Ptr (Ptr struct) -> Ptr Word8 -> CSize -> IO CInt

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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt

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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt

-- 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 CInt

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 CInt) -> IO ByteString
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQuerying ((Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString)
-> (Ptr byte -> Ptr CSize -> IO CInt) -> 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 CInt

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 CInt) -> IO ByteString
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQueryingCString ((Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString)
-> (Ptr byte -> Ptr CSize -> IO CInt) -> 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 CInt

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 CInt -> IO Int) -> IO Int
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca ((Ptr CInt -> IO Int) -> IO Int) -> (Ptr CInt -> IO Int) -> IO Int
forall a b. (a -> b) -> a -> b
$ \ Ptr CInt
szPtr -> do
        HasCallStack => IO CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ GetInt ptr
get ptr
typPtr Ptr CInt
szPtr
        CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (CInt -> Int) -> IO CInt -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr CInt -> IO CInt
forall a. Storable a => Ptr a -> IO a
peek Ptr CInt
szPtr

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

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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt

-- 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 GetBoolCode ptr = ptr -> IO CInt
type GetBoolCode_csize ptr = ptr -> CSize -> IO CInt

mkGetBoolCode
    :: WithPtr typ ptr
    -> GetBoolCode ptr
    -> typ -> IO Bool
mkGetBoolCode :: forall typ ptr.
WithPtr typ ptr -> GetBoolCode 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 CInt -> IO Bool
IO CInt -> IO Bool
throwBotanCatchingBool (IO CInt -> IO Bool) -> IO CInt -> 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 -> GetBoolCode_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 CInt -> IO Bool
IO CInt -> IO Bool
throwBotanCatchingBool (IO CInt -> IO Bool) -> IO CInt -> 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 CInt
type GetIntCode_csize ptr = ptr -> CSize -> IO CInt

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
    (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ HasCallStack => IO CInt -> IO CInt
IO CInt -> IO CInt
throwBotanIfNegative (IO CInt -> IO CInt) -> IO CInt -> IO CInt
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
    (CInt -> Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap CInt -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (IO CInt -> IO Int) -> IO CInt -> IO Int
forall a b. (a -> b) -> a -> b
$ HasCallStack => IO CInt -> IO CInt
IO CInt -> IO CInt
throwBotanIfNegative (IO CInt -> IO CInt) -> IO CInt -> IO CInt
forall a b. (a -> b) -> a -> b
$ GetIntCode_csize ptr
get ptr
typPtr CSize
sz

{-
Effectful actions
-}

type Action ptr = ptr -> IO CInt
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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Action ptr
action ptr
typPtr

mkSet
    :: WithPtr typ ptr
    -> (ptr -> a -> IO CInt)
    -> typ -> a -> IO ()
mkSet :: forall typ ptr a.
WithPtr typ ptr -> (ptr -> a -> IO CInt) -> typ -> a -> IO ()
mkSet WithPtr typ ptr
withPtr ptr -> a -> IO CInt
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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ ptr -> a -> IO CInt
set ptr
typPtr a
a

mkSetOn
    :: WithPtr typ ptr
    -> (a -> b)
    -> (ptr -> b -> IO CInt)
    -> typ -> a -> IO ()
mkSetOn :: forall typ ptr a b.
WithPtr typ ptr
-> (a -> b) -> (ptr -> b -> IO CInt) -> typ -> a -> IO ()
mkSetOn WithPtr typ ptr
withPtr a -> b
fn ptr -> b -> IO CInt
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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ ptr -> b -> IO CInt
set ptr
typPtr (a -> b
fn a
sz)

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

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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ SetCInt ptr
set ptr
typPtr (Int -> CInt
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
sz)

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

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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt

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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> 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 CInt) -> IO ByteString
allocBytesQuerying :: forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQuerying Ptr byte -> Ptr CSize -> IO CInt
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
        Ptr CSize -> CSize -> IO ()
forall a. Storable a => Ptr a -> a -> IO ()
poke Ptr CSize
szPtr CSize
0
        CInt
code <- Ptr byte -> Ptr CSize -> IO CInt
fn Ptr byte
forall a. Ptr a
nullPtr Ptr CSize
szPtr
        case CInt
code of
            CInt
BOTAN_FFI_ERROR_INSUFFICIENT_BUFFER_SPACE -> 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 CInt -> IO ()
IO CInt -> IO ()
throwBotanIfNegative_ (IO CInt -> IO ()) -> IO CInt -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr byte -> Ptr CSize -> IO CInt
fn Ptr byte
outPtr Ptr CSize
szPtr
            CInt
_                       -> do
                CInt -> IO ByteString
forall a. HasCallStack => CInt -> IO a
throwBotanError CInt
code

-- NOTE: Does not check length of taken string, vulnerable to null byte injection
allocBytesQueryingCString :: (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQueryingCString :: forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQueryingCString Ptr byte -> Ptr CSize -> IO CInt
action = do
    ByteString
cstring <- (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQuerying Ptr byte -> Ptr CSize -> IO CInt
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
typPtr:))

-- withNullablePtr

-- withNullablePtrList