Bindings.hs

{-# LANGUAGE DerivingStrategies #-}
{-# LANGUAGE ForeignFunctionInterface #-}

-- |
--   Contains low-level bindings to the Extism SDK
module Extism.Bindings where

import Data.Int
import Data.Word
import Foreign.C.String
import Foreign.C.Types
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.StablePtr
import Foreign.Storable

type FreeCallback = Ptr () -> IO ()

newtype ExtismPlugin = ExtismPlugin () deriving (Show)

newtype ExtismFunction = ExtismFunction () deriving (Show)

newtype ExtismCancelHandle = ExtismCancelHandle () deriving (Show)

newtype ExtismCurrentPlugin = ExtismCurrentPlugin () deriving (Show)

newtype ExtismCompiledPlugin = ExtismCompiledPlugin () deriving (Show)

-- | Low-level Wasm types
data ValType = I32 | I64 | F32 | F64 | V128 | FuncRef | ExternRef deriving (Show, Eq)

-- | Low-level Wasm values
data Val = ValI32 Int32 | ValI64 Int64 | ValF32 Float | ValF64 Double deriving (Show, Eq)

typeOfVal :: Val -> ValType
typeOfVal (ValI32 _) = I32
typeOfVal (ValI64 _) = I64
typeOfVal (ValF32 _) = F32
typeOfVal (ValF64 _) = F64

type CCallback = Ptr ExtismCurrentPlugin -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()

_32Bit = sizeOf (undefined :: Int) == 4

instance Storable Val where
  sizeOf _ =
    if _32Bit then 12 else 16
  alignment _ = 1
  peek ptr = do
    let offs = if _32Bit then 4 else 8
    t <- valTypeOfInt <$> peekByteOff ptr 0
    case t of
      I32 -> ValI32 <$> peekByteOff ptr offs
      I64 -> ValI64 <$> peekByteOff ptr offs
      F32 -> ValF32 <$> peekByteOff ptr offs
      F64 -> ValF64 <$> peekByteOff ptr offs
      _ -> error "Unsupported val type"
  poke ptr a = do
    let offs = if _32Bit then 4 else 8
    pokeByteOff ptr 0 (typeOfVal a)
    case a of
      ValI32 x -> pokeByteOff ptr offs x
      ValI64 x -> pokeByteOff ptr offs x
      ValF32 x -> pokeByteOff ptr offs x
      ValF64 x -> pokeByteOff ptr offs x

intOfValType :: ValType -> CInt
intOfValType I32 = 0
intOfValType I64 = 1
intOfValType F32 = 2
intOfValType F64 = 3
intOfValType V128 = 4
intOfValType FuncRef = 5
intOfValType ExternRef = 6

valTypeOfInt :: CInt -> ValType
valTypeOfInt 0 = I32
valTypeOfInt 1 = I64
valTypeOfInt 2 = F32
valTypeOfInt 3 = F64
valTypeOfInt 4 = V128
valTypeOfInt 5 = FuncRef
valTypeOfInt 6 = ExternRef
valTypeOfInt _ = error "Invalid ValType"

instance Storable ValType where
  sizeOf _ = 4
  alignment _ = 1
  peek ptr = do
    x <- peekByteOff ptr 0
    return $ valTypeOfInt (x :: CInt)
  poke ptr x =
    pokeByteOff ptr 0 (intOfValType x)

foreign import ccall safe "extism.h extism_plugin_new"
  extism_plugin_new ::
    Ptr Word8 -> Word64 -> Ptr (Ptr ExtismFunction) -> Word64 -> CBool -> Ptr CString -> IO (Ptr ExtismPlugin)

foreign import ccall safe "extism.h extism_plugin_new_from_compiled"
  extism_plugin_new_from_compiled ::
    Ptr ExtismCompiledPlugin -> Ptr CString -> IO (Ptr ExtismPlugin)

foreign import ccall safe "extism.h extism_compiled_plugin_new"
  extism_compiled_plugin_new ::
    Ptr Word8 -> Word64 -> Ptr (Ptr ExtismFunction) -> Word64 -> CBool -> Ptr CString -> IO (Ptr ExtismCompiledPlugin)

foreign import ccall safe "extism.h extism_plugin_call"
  extism_plugin_call ::
    Ptr ExtismPlugin -> CString -> Ptr Word8 -> Word64 -> IO Int32

foreign import ccall safe "extism.h extism_plugin_call_with_host_context"
  extism_plugin_call_with_host_context ::
    Ptr ExtismPlugin -> CString -> Ptr Word8 -> Word64 -> Ptr () -> IO Int32

foreign import ccall safe "extism.h extism_plugin_function_exists"
  extism_plugin_function_exists ::
    Ptr ExtismPlugin -> CString -> IO CBool

foreign import ccall safe "extism.h extism_plugin_error"
  extism_error ::
    Ptr ExtismPlugin -> IO CString

foreign import ccall safe "extism.h extism_plugin_output_length"
  extism_plugin_output_length ::
    Ptr ExtismPlugin -> IO Word64

foreign import ccall safe "extism.h extism_plugin_output_data"
  extism_plugin_output_data ::
    Ptr ExtismPlugin -> IO (Ptr Word8)

foreign import ccall safe "extism.h extism_log_file"
  extism_log_file ::
    CString -> CString -> IO CBool

foreign import ccall safe "extism.h extism_plugin_config"
  extism_plugin_config ::
    Ptr ExtismPlugin -> Ptr Word8 -> Int64 -> IO CBool

foreign import ccall safe "extism.h extism_plugin_free"
  extism_plugin_free ::
    Ptr ExtismPlugin -> IO ()

foreign import ccall safe "extism.h extism_compiled_plugin_free"
  extism_compiled_plugin_free ::
    Ptr ExtismCompiledPlugin -> IO ()

foreign import ccall safe "extism.h extism_plugin_reset"
  extism_plugin_reset ::
    Ptr ExtismPlugin -> IO ()

foreign import ccall safe "extism.h extism_plugin_new_error_free"
  extism_plugin_new_error_free ::
    CString -> IO ()

foreign import ccall safe "extism.h extism_version"
  extism_version ::
    IO CString

foreign import ccall safe "extism.h extism_plugin_id"
  extism_plugin_id ::
    Ptr ExtismPlugin -> IO (Ptr Word8)

foreign import ccall safe "extism.h extism_plugin_cancel_handle"
  extism_plugin_cancel_handle ::
    Ptr ExtismPlugin -> IO (Ptr ExtismCancelHandle)

foreign import ccall safe "extism.h extism_plugin_cancel"
  extism_plugin_cancel ::
    Ptr ExtismCancelHandle -> IO Bool

foreign import ccall safe "extism.h extism_function_new"
  extism_function_new ::
    CString -> Ptr ValType -> Word64 -> Ptr ValType -> Word64 -> FunPtr CCallback -> Ptr () -> FunPtr FreeCallback -> IO (Ptr ExtismFunction)

foreign import ccall safe "extism.h extism_function_free"
  extism_function_free ::
    Ptr ExtismFunction -> IO ()

foreign import ccall safe "extism.h extism_function_set_namespace"
  extism_function_set_namespace ::
    Ptr ExtismFunction -> CString -> IO ()

foreign import ccall safe "extism.h extism_current_plugin_memory"
  extism_current_plugin_memory ::
    Ptr ExtismCurrentPlugin -> IO (Ptr Word8)

foreign import ccall safe "extism.h extism_current_plugin_host_context"
  extism_current_plugin_host_context ::
    Ptr ExtismCurrentPlugin -> IO (Ptr ())

foreign import ccall safe "extism.h extism_current_plugin_memory_alloc"
  extism_current_plugin_memory_alloc ::
    Ptr ExtismCurrentPlugin -> Word64 -> IO Word64

foreign import ccall safe "extism.h extism_current_plugin_memory_length"
  extism_current_plugin_memory_length ::
    Ptr ExtismCurrentPlugin -> Word64 -> IO Word64

foreign import ccall safe "extism.h extism_current_plugin_memory_free"
  extism_current_plugin_memory_free ::
    Ptr ExtismCurrentPlugin -> Word64 -> IO ()

freePtr ptr = do
  let s = castPtrToStablePtr ptr
  (_, b, c, _) <- deRefStablePtr s
  freeHaskellFunPtr b
  freeHaskellFunPtr c
  freeStablePtr s

foreign import ccall "wrapper" freePtrWrap :: FreeCallback -> IO (FunPtr FreeCallback)

foreign import ccall "wrapper" callbackWrap :: CCallback -> IO (FunPtr CCallback)