{-|
Module      : Botan.Low.Remake
Description : Low-level binding generators
Copyright   : (c) 2023-2024, Apotheca Labs
              (c) 2024-2025, Haskell Foundation
License     : BSD-3-Clause
Maintainer  : joris@well-typed.com, leo@apotheca.io
Stability   : experimental
Portability : POSIX

Generate low-level bindings automatically
-}

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

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

mkBindings
    ::  (Storable botan)
    =>  (Ptr struct -> botan)                                   -- mkBotan
    ->  (botan -> Ptr struct)                                   -- runBotan
    ->  (ForeignPtr struct -> object)                           -- mkForeign
    ->  (object -> ForeignPtr struct)                           -- runForeign
    ->  FinalizerPtr struct                                     -- destroy / finalizer
    ->  (   object -> (botan -> IO a) -> IO a                   -- withObject
        ,   object -> IO ()                                     -- destroyObject
        ,   (Ptr botan -> IO CInt) -> IO object                 -- createObject
        )
mkBindings :: forall botan struct object a.
Storable botan =>
(Ptr struct -> botan)
-> (botan -> Ptr struct)
-> (ForeignPtr struct -> object)
-> (object -> ForeignPtr struct)
-> FinalizerPtr struct
-> (object -> (botan -> IO a) -> IO a, object -> IO (),
    (Ptr botan -> IO CInt) -> IO object)
mkBindings Ptr struct -> botan
mkBotan botan -> Ptr struct
runBotan ForeignPtr struct -> object
mkForeign object -> ForeignPtr struct
runForeign FinalizerPtr struct
destroy = (object -> (botan -> IO a) -> IO a, object -> IO (),
 (Ptr botan -> IO CInt) -> IO object)
forall {b}.
(object -> (botan -> IO b) -> IO b, object -> IO (),
 (Ptr botan -> IO CInt) -> IO object)
bindings where
    bindings :: (object -> (botan -> IO b) -> IO b, object -> IO (),
 (Ptr botan -> IO CInt) -> IO object)
bindings = (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)
    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

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

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
  where
    withConstCString :: ByteString -> (ConstPtr CChar -> IO a) -> IO a
withConstCString ByteString
bs ConstPtr CChar -> IO a
k = ByteString -> (CString -> IO a) -> IO a
forall a. ByteString -> (CString -> IO a) -> IO a
withCString ByteString
bs ((CString -> IO a) -> IO a) -> (CString -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \CString
ptr -> ConstPtr CChar -> IO a
k (CString -> ConstPtr CChar
forall a. Ptr a -> ConstPtr a
ConstPtr CString
ptr)

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

-- | You probably want mkCreateObjectCBytesLen; this is for functions that
-- expect a bytestring of known exact length.
mkCreateObjectCBytes
    :: ((Ptr botan -> IO CInt) -> IO object)
    -> (Ptr botan -> ConstPtr Word8 -> IO CInt)
    -> ByteString
    -> IO object
-- TODO: Rename mkCreateCBytes
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 -> (CBytes -> IO object) -> IO object
forall a. ByteString -> (CBytes -> IO a) -> IO a
withCBytes ByteString
bytes ((CBytes -> IO object) -> IO object)
-> (CBytes -> IO object) -> IO object
forall a b. (a -> b) -> a -> b
$ \ CBytes
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 (CBytes -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr CBytes
cbytes)

-- 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
$ \ (CBytes
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 (CBytes -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr CBytes
cbytes) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)

{-
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
mkWithObjectGetterCBytesLen1
    :: (forall b . object -> (botan -> IO b) -> IO b)
    -> (botan -> a -> Ptr Word8 -> Ptr CSize -> IO CInt)
    -> object
    -> a
    -> IO ByteString
mkWithObjectGetterCBytesLen1 :: forall object botan a.
(forall b. object -> (botan -> IO b) -> IO b)
-> (botan -> a -> CBytes -> Ptr CSize -> IO CInt)
-> object
-> a
-> IO ByteString
mkWithObjectGetterCBytesLen1 forall b. object -> (botan -> IO b) -> IO b
withObject botan -> a -> CBytes -> Ptr CSize -> IO CInt
getter object
obj a
a = object -> (botan -> IO ByteString) -> IO ByteString
forall b. object -> (botan -> IO b) -> IO b
withObject object
obj ((botan -> IO ByteString) -> IO ByteString)
-> (botan -> IO ByteString) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ botan
cobj -> do
    (CBytes -> Ptr CSize -> IO CInt) -> IO ByteString
forall byte. (Ptr byte -> Ptr CSize -> IO CInt) -> IO ByteString
allocBytesQuerying ((CBytes -> Ptr CSize -> IO CInt) -> IO ByteString)
-> (CBytes -> Ptr CSize -> IO CInt) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \ CBytes
outPtr Ptr CSize
outLen -> botan -> a -> CBytes -> Ptr CSize -> IO CInt
getter
        botan
cobj
        a
a
        CBytes
outPtr
        Ptr CSize
outLen

{-
Setters
-}

-- Replaces mkSetBytesLen
-- TODO: Rename mkSetterCBytesLen
mkWithObjectSetterCBytesLen
    :: (forall a . object -> (botan -> IO a) -> IO a)
    -> (botan -> ConstPtr Word8 -> CSize -> IO CInt)
    -> 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
$ \ (CBytes
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 (CBytes -> ConstPtr Word8
forall a. Ptr a -> ConstPtr a
ConstPtr CBytes
cbytes) (Int -> CSize
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
len)