Improve external buffer API

This commit is contained in:
Edsko de Vries 2023-03-29 13:14:11 +02:00
parent 452fce4ea5
commit 6e245576e8
3 changed files with 47 additions and 16 deletions

View file

@ -0,0 +1,10 @@
// Forward-declare the Rust-exported function
void haskell_ffi_external_free(void* vec);
// Wrapper around the Rust function that takes an additional (unused) argument,
// which makes it match the Haskell `FinalizerEnvPtr` type. The wrapper also
// avoids linker errors when the Rust library is not available (of course,
// the Rust library must be linked into the final application).
void haskell_ffi_external_free_env(void* vec, void* ptr) {
haskell_ffi_external_free(vec);
}

View file

@ -93,6 +93,8 @@ library
, th-abstraction , th-abstraction
, vector , vector
, wide-word , wide-word
c-sources:
cbits/wrap-rust-haskell-ffi.c
test-suite test-foreign-rust test-suite test-foreign-rust
import: import:

View file

@ -6,48 +6,67 @@ module Foreign.Rust.Marshall.External (
) where ) where
import Codec.Borsh import Codec.Borsh
import Control.Exception
import Data.Typeable import Data.Typeable
import Data.Word import Data.Word
import Foreign.C import Foreign.C
import Foreign.Concurrent
import Foreign.Ptr import Foreign.Ptr
import qualified Data.ByteString.Internal as Strict import qualified Data.ByteString.Internal as Strict
import Foreign.Rust.Marshall.Util import Foreign.Rust.Marshall.Util
import Foreign.ForeignPtr
data External data ExternalBuffer
foreign import ccall "haskell_ffi_external_ptr" {-------------------------------------------------------------------------------
Foreign imports
Although 'externalPtr' and 'externalLen' are morally pure, we make
them live in IO to make reasoning about order of operations easier in
'fromExternalBorsh'.
These C functions are defined in the companion Rust @haskell-ffi@ library.
-------------------------------------------------------------------------------}
foreign import ccall unsafe "haskell_ffi_external_ptr"
externalPtr externalPtr
:: Ptr External -> Ptr Word8 :: Ptr ExternalBuffer -> IO (Ptr Word8)
foreign import ccall "haskell_ffi_external_len" foreign import ccall unsafe "haskell_ffi_external_len"
externalLen externalLen
:: Ptr External -> CSize :: Ptr ExternalBuffer -> IO CSize
foreign import ccall "haskell_ffi_external_free" foreign import ccall unsafe "&haskell_ffi_external_free_env"
externalFree externalFree
:: Ptr External -> IO () :: FinalizerEnvPtr ExternalBuffer Word8
-- | Internal auxiliary: cast pointer {-------------------------------------------------------------------------------
Internal auxiliary
-------------------------------------------------------------------------------}
-- | Cast pointer
-- --
-- For ease of integration with c2hs, 'fromExternalBorsh' takes a @Ptr ()@ as -- For ease of integration with c2hs, 'fromExternalBorsh' takes a @Ptr ()@ as
-- input instead of the more accurate @Ptr External@. -- input instead of the more accurate @Ptr ExternalBuffer@.
castToExternal :: Ptr () -> Ptr External castToExternal :: Ptr () -> Ptr ExternalBuffer
castToExternal = castPtr castToExternal = castPtr
{-------------------------------------------------------------------------------
Public API
-------------------------------------------------------------------------------}
-- | Output marshaller for values stored in Rust-allocated buffer -- | Output marshaller for values stored in Rust-allocated buffer
-- --
-- Should be used together with the Rust function @marshall_to_haskell_external@ -- Should be used together with the Rust function @marshall_to_haskell_external@
-- (from @haskell-ffi@). -- (from @haskell-ffi@).
fromExternalBorsh :: (FromBorsh a, Typeable a) => Ptr () -> IO a fromExternalBorsh :: (FromBorsh a, Typeable a) => Ptr () -> IO a
fromExternalBorsh (castToExternal -> ptr) = do fromExternalBorsh (castToExternal -> vec) = do
len <- evaluate $ fromIntegral $ externalLen ptr ptr <- externalPtr vec
fptr <- newForeignPtr (externalPtr ptr) (externalFree ptr) len <- fromIntegral <$> externalLen vec
fptr <- newForeignPtrEnv externalFree vec ptr
let bs :: Strict.ByteString let bs :: Strict.ByteString
bs = Strict.PS fptr 0 len bs = Strict.fromForeignPtr fptr 0 len
return $ deserialiseStrictOrPanic bs return $ deserialiseStrictOrPanic bs