API for working with external buffers

This commit is contained in:
Edsko de Vries 2023-03-29 10:25:25 +02:00
parent 0bdbb0f1cb
commit 8994f68c3b
2 changed files with 55 additions and 0 deletions

View file

@ -48,6 +48,7 @@ common lang
TypeFamilies TypeFamilies
TypeOperators TypeOperators
UndecidableInstances UndecidableInstances
ViewPatterns
library library
import: import:
@ -56,6 +57,7 @@ library
Foreign.Rust.External.JSON Foreign.Rust.External.JSON
Foreign.Rust.External.Bincode Foreign.Rust.External.Bincode
Foreign.Rust.Failure Foreign.Rust.Failure
Foreign.Rust.Marshall.External
Foreign.Rust.Marshall.Fixed Foreign.Rust.Marshall.Fixed
Foreign.Rust.Marshall.Variable Foreign.Rust.Marshall.Variable
Foreign.Rust.SafeConv Foreign.Rust.SafeConv

View file

@ -0,0 +1,53 @@
-- | Marshall from a Rust-side allocated buffer
--
-- Intended for unqualified import.
module Foreign.Rust.Marshall.External (
fromExternalBorsh
) where
import Codec.Borsh
import Control.Exception
import Data.Typeable
import Data.Word
import Foreign.C
import Foreign.Concurrent
import Foreign.Ptr
import qualified Data.ByteString.Internal as Strict
import Foreign.Rust.Marshall.Util
data External
foreign import ccall "haskell_ffi_external_ptr"
externalPtr
:: Ptr External -> Ptr Word8
foreign import ccall "haskell_ffi_external_len"
externalLen
:: Ptr External -> CSize
foreign import ccall "haskell_ffi_external_free"
externalFree
:: Ptr External -> IO ()
-- | Internal auxiliary: cast pointer
--
-- For ease of integration with c2hs, 'fromExternalBorsh' takes a @Ptr ()@ as
-- input instead of the more accurate @Ptr External@.
castToExternal :: Ptr () -> Ptr External
castToExternal = castPtr
-- | Output marshaller for values stored in Rust-allocated buffer
--
-- Should be used together with the Rust function @marshall_to_haskell_external@
-- (from @haskell-ffi@).
fromExternalBorsh :: (FromBorsh a, Typeable a) => Ptr () -> IO a
fromExternalBorsh (castToExternal -> ptr) = do
len <- evaluate $ fromIntegral $ externalLen ptr
fptr <- newForeignPtr (externalPtr ptr) (externalFree ptr)
let bs :: Strict.ByteString
bs = Strict.PS fptr 0 len
return $ deserialiseStrictOrPanic bs