extism 0.3.0 → 0.5.0

raw patch · 6 files changed

+304/−51 lines, 6 filesdep ~basedep ~bytestringdep ~extism-manifestPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: base, bytestring, extism-manifest, json

API changes (from Hackage documentation)

Files

• Example.hs +14/−5
• extism.cabal +7/−7
• src/Extism.hs +126/−36
• src/Extism/Bindings.hs +92/−0
• src/Extism/CurrentPlugin.hs +48/−0
• test/Test.hs +17/−3

@@ -1,15 +1,24 @@ module Main where  import Extism+import Extism.CurrentPlugin import Extism.Manifest(manifest, wasmFile)  unwrap (Right x) = x unwrap (Left (ExtismError msg)) = do   error msg +hello plugin params msg = do+  putStrLn "Hello from Haskell!"+  putStrLn msg+  offs <- allocBytes plugin (toByteString "{\"count\": 999}")+  return [toI64 offs]+ main = do-  let m = manifest [wasmFile "../wasm/code.wasm"]-  plugin <- unwrap <$> Extism.createPluginFromManifest m False-  res <- unwrap <$> Extism.call plugin "count_vowels" (Extism.toByteString "this is a test")-  putStrLn (Extism.fromByteString res)-  Extism.free plugin+  setLogFile "stdout" Error+  let m = manifest [wasmFile "../wasm/code-functions.wasm"]+  f <- hostFunction "hello_world" [I64] [I64] hello "Hello, again"+  plugin <- unwrap <$> createPluginFromManifest m [f] True+  res <- unwrap <$> call plugin "count_vowels" (toByteString "this is a test")+  putStrLn (fromByteString res)+  free plugin

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               extism-version:            0.3.0+version:            0.5.0 license:            BSD-3-Clause maintainer:         oss@extism.org author:             Extism authors@@ -8,10 +8,10 @@ synopsis:           Extism bindings description:        Bindings to Extism, the universal plugin system category:           Plugins, WebAssembly-extra-source-files: CHANGELOG.md+extra-doc-files: CHANGELOG.md  library-    exposed-modules:    Extism+    exposed-modules:    Extism Extism.CurrentPlugin     reexported-modules: Extism.Manifest     hs-source-dirs:     src     other-modules:      Extism.Bindings@@ -19,10 +19,10 @@     extra-libraries:    extism     extra-lib-dirs:     /usr/local/lib     build-depends:-        base              >= 4.16.1 && < 4.19.0,-        bytestring        >= 0.11.3 && < 0.12,-        json              >= 0.10 && < 0.11,-        extism-manifest   >= 0.0.0 && < 0.3.0+        base              >= 4.16.1 && < 5,+        bytestring        >= 0.11.3 && <= 0.12,+        json              >= 0.10 && <= 0.11,+        extism-manifest   >= 0.0.0 && < 0.4.0  test-suite extism-example     type:             exitcode-stdio-1.0

@@ -1,10 +1,21 @@-module Extism (module Extism, module Extism.Manifest) where+module Extism (+  module Extism,+  module Extism.Manifest,+  ValType(..),+  Val(..)+) where+ import Data.Int import Data.Word import Control.Monad (void) import Foreign.ForeignPtr import Foreign.C.String import Foreign.Ptr+import Foreign.Marshal.Array+import Foreign.Storable+import Foreign.StablePtr+import Foreign.Concurrent+import Foreign.Marshal.Utils (copyBytes, moveBytes) import Data.ByteString as B import Data.ByteString.Internal (c2w, w2c) import Data.ByteString.Unsafe (unsafeUseAsCString)@@ -16,11 +27,18 @@ -- | Context for managing plugins newtype Context = Context (ForeignPtr ExtismContext) +-- | Host function+data Function = Function (ForeignPtr ExtismFunction) (StablePtr ())+ -- | Plugins can be used to call WASM function-data Plugin = Plugin Context Int32+data Plugin = Plugin Context Int32 [Function] -data CancelHandle = CancelHandle (Ptr ExtismCancelHandle)+-- | Cancellation handle for Plugins+newtype CancelHandle = CancelHandle (Ptr ExtismCancelHandle) +-- | Access the plugin that is currently executing from inside a host function+type CurrentPlugin = Ptr ExtismCurrentPlugin+ -- | Log level data LogLevel = Error | Warn | Info | Debug | Trace deriving (Show) @@ -53,80 +71,94 @@ newContext :: IO Context newContext = do   ptr <- extism_context_new-  fptr <- newForeignPtr extism_context_free ptr+  fptr <- Foreign.ForeignPtr.newForeignPtr extism_context_free ptr   return (Context fptr)- + -- | Execute a function with a new 'Context' that is destroyed when it returns withContext :: (Context -> IO a) -> IO a withContext f = do   ctx <- newContext   f ctx +-- | Execute a function with the provided 'Plugin' as a parameter, then frees the 'Plugin'+-- | before returning the result.+withPlugin :: (Plugin -> IO a) -> Plugin -> IO a+withPlugin f plugin = do+  res <- f plugin+  free plugin+  return res+ -- | Create a 'Plugin' from a WASM module, `useWasi` determines if WASI should -- | be linked-plugin :: Context -> B.ByteString -> Bool -> IO (Result Plugin)-plugin c wasm useWasi =+plugin :: Context -> B.ByteString -> [Function] -> Bool -> IO (Result Plugin)+plugin c wasm functions useWasi =+  let nfunctions = fromIntegral (Prelude.length functions) in   let length = fromIntegral (B.length wasm) in   let wasi = fromInteger (if useWasi then 1 else 0) in   let Context ctx = c in   do+    funcs <- Prelude.mapM (\(Function ptr _) -> withForeignPtr ptr (\x -> do return x)) functions     withForeignPtr ctx (\ctx -> do       p <- unsafeUseAsCString wasm (\s ->-        extism_plugin_new ctx (castPtr s) length nullPtr 0 wasi )+        withArray funcs (\funcs ->+          extism_plugin_new ctx (castPtr s) length funcs nfunctions wasi ))       if p < 0 then do         err <- extism_error ctx (-1)         e <- peekCString err         return $ Left (ExtismError e)       else-        return $ Right (Plugin c p))-      +        return $ Right (Plugin c p functions))+ -- | Create a 'Plugin' with its own 'Context'-createPlugin :: B.ByteString -> Bool -> IO (Result Plugin)-createPlugin c useWasi = do+createPlugin :: B.ByteString -> [Function] -> Bool -> IO (Result Plugin)+createPlugin c functions useWasi = do   ctx <- newContext-  plugin ctx c useWasi+  plugin ctx c functions useWasi  -- | Create a 'Plugin' from a 'Manifest'-pluginFromManifest :: Context -> Manifest -> Bool -> IO (Result Plugin)-pluginFromManifest ctx manifest useWasi =+pluginFromManifest :: Context -> Manifest -> [Function] -> Bool -> IO (Result Plugin)+pluginFromManifest ctx manifest functions useWasi =   let wasm = toByteString $ toString manifest in-  plugin ctx wasm useWasi+  plugin ctx wasm functions useWasi  -- | Create a 'Plugin' with its own 'Context' from a 'Manifest'-createPluginFromManifest :: Manifest -> Bool -> IO (Result Plugin)-createPluginFromManifest manifest useWasi = do+createPluginFromManifest :: Manifest -> [Function] -> Bool -> IO (Result Plugin)+createPluginFromManifest manifest functions useWasi = do   ctx <- newContext-  pluginFromManifest ctx manifest useWasi+  pluginFromManifest ctx manifest functions useWasi  -- | Update a 'Plugin' with a new WASM module-update :: Plugin -> B.ByteString -> Bool -> IO (Result ())-update (Plugin (Context ctx) id) wasm useWasi =+update :: Plugin -> B.ByteString -> [Function] -> Bool -> IO (Result Plugin)+update (Plugin (Context ctx) id _) wasm functions useWasi =+  let nfunctions = fromIntegral (Prelude.length functions) in   let length = fromIntegral (B.length wasm) in   let wasi = fromInteger (if useWasi then 1 else 0) in   do-    withForeignPtr ctx (\ctx -> do+    funcs <- Prelude.mapM (\(Function ptr _ ) -> withForeignPtr ptr (\x -> do return x)) functions+    withForeignPtr ctx (\ctx' -> do       b <- unsafeUseAsCString wasm (\s ->-        extism_plugin_update ctx id (castPtr s) length nullPtr 0 wasi)+        withArray funcs (\funcs ->+          extism_plugin_update ctx' id (castPtr s) length funcs nfunctions wasi))       if b <= 0 then do-        err <- extism_error ctx (-1)+        err <- extism_error ctx' (-1)         e <- peekCString err         return $ Left (ExtismError e)       else-        return (Right ()))+        return (Right (Plugin (Context ctx) id functions)))  -- | Update a 'Plugin' with a new 'Manifest'-updateManifest :: Plugin -> Manifest -> Bool -> IO (Result ())-updateManifest plugin manifest useWasi =+updateManifest :: Plugin -> Manifest -> [Function] -> Bool -> IO (Result Plugin)+updateManifest plugin manifest functions useWasi =   let wasm = toByteString $ toString manifest in-  update plugin wasm useWasi+  update plugin wasm functions useWasi  -- | Check if a 'Plugin' is valid isValid :: Plugin -> Bool-isValid (Plugin _ p) = p >= 0+isValid (Plugin _ p _) = p >= 0  -- | Set configuration values for a plugin setConfig :: Plugin -> [(String, Maybe String)] -> IO Bool-setConfig (Plugin (Context ctx) plugin) x =+setConfig (Plugin (Context ctx) plugin _) x =   if plugin < 0     then return False   else@@ -155,14 +187,14 @@  -- | Check if a function exists in the given plugin functionExists :: Plugin -> String -> IO Bool-functionExists (Plugin (Context ctx) plugin) name = do+functionExists (Plugin (Context ctx) plugin _) name = do   withForeignPtr ctx (\ctx -> do     b <- withCString name (extism_plugin_function_exists ctx plugin)     if b == 1 then return True else return False)  --- | Call a function provided by the given plugin call :: Plugin -> String -> B.ByteString -> IO (Result B.ByteString)-call (Plugin (Context ctx) plugin) name input =+call (Plugin (Context ctx) plugin _) name input =   let length = fromIntegral (B.length input) in   do     withForeignPtr ctx (\ctx -> do@@ -184,15 +216,73 @@ -- | Free a 'Plugin', this will automatically be called for every plugin -- | associated with a 'Context' when that 'Context' is freed free :: Plugin -> IO ()-free (Plugin (Context ctx) plugin) =+free (Plugin (Context ctx) plugin _) =   withForeignPtr ctx (`extism_plugin_free` plugin) +-- | Create a new 'CancelHandle' that can be used to cancel a running plugin+-- | from another thread. cancelHandle :: Plugin -> IO CancelHandle-cancelHandle (Plugin (Context ctx) plugin) = do-  handle <- withForeignPtr ctx (\ctx -> extism_plugin_cancel_handle ctx plugin)+cancelHandle (Plugin (Context ctx) plugin _) = do+  handle <- withForeignPtr ctx (`extism_plugin_cancel_handle` plugin)   return (CancelHandle handle) +-- | Cancel a running plugin using a 'CancelHandle' cancel :: CancelHandle -> IO Bool-cancel (CancelHandle handle) = +cancel (CancelHandle handle) =   extism_plugin_cancel handle ++-- | Create a new 'Function' that can be called from a 'Plugin'+hostFunction :: String -> [ValType] -> [ValType] -> (CurrentPlugin -> [Val] -> a -> IO [Val]) -> a -> IO Function+hostFunction name params results f v =+  let nparams = fromIntegral $ Prelude.length params in+  let nresults = fromIntegral $ Prelude.length results in+  do+    cb <- callbackWrap (callback f :: CCallback)+    free <- freePtrWrap freePtr+    userData <- newStablePtr (v, free, cb)+    let userDataPtr = castStablePtrToPtr userData+    x <- withCString name (\name ->  do+      withArray params (\params ->+        withArray results (\results -> do+          extism_function_new name params nparams results nresults cb userDataPtr free)))+    let freeFn = extism_function_free x+    fptr <- Foreign.Concurrent.newForeignPtr x freeFn+    return $ Function fptr (castPtrToStablePtr userDataPtr)+++-- | Create a new I32 'Val'+toI32 :: Integral a => a -> Val+toI32 x = ValI32 (fromIntegral x)++-- | Create a new I64 'Val'+toI64 :: Integral a => a -> Val+toI64 x = ValI64 (fromIntegral x)++-- | Create a new F32 'Val'+toF32 :: Float -> Val+toF32 = ValF32++-- | Create a new F64 'Val'+toF64 :: Double -> Val+toF64 = ValF64++-- | Get I32 'Val'+fromI32 :: Integral a => Val -> Maybe a+fromI32 (ValI32 x) = Just (fromIntegral x)+fromI32 _ = Nothing++-- | Get I64 'Val'+fromI64 :: Integral a => Val -> Maybe a+fromI64 (ValI64 x) = Just (fromIntegral x)+fromI64 _ = Nothing++-- | Get F32 'Val'+fromF32 :: Val -> Maybe Float+fromF32 (ValF32 x) = Just x+fromF32 _ = Nothing++-- | Get F64 'Val'+fromF64 :: Val -> Maybe Double+fromF64 (ValF64 x) = Just x+fromF64 _ = Nothing

@@ -7,11 +7,78 @@ import Foreign.C.String import Data.Int import Data.Word+import Foreign.Storable+import Foreign.Marshal.Array+import Foreign.StablePtr +type FreeCallback = Ptr () -> IO ()+ newtype ExtismContext = ExtismContext () deriving Show newtype ExtismFunction = ExtismFunction () deriving Show newtype ExtismCancelHandle = ExtismCancelHandle () deriving Show+newtype ExtismCurrentPlugin = ExtismCurrentPlugin () deriving Show+data ValType = I32 | I64 | F32 | F64 | V128 | FuncRef | ExternRef deriving (Show, Eq)+data Val = ValI32 Int32 | ValI64 Int64 | ValF32 Float | ValF64 Double deriving (Show, Eq) +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+  poke ptr x = do+    let offs = if _32Bit then 4 else 8+    pokeByteOff ptr 0 (typeOfVal x)+    case x 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 = do+    pokeByteOff ptr 0 (intOfValType x)+ foreign import ccall safe "extism.h extism_context_new" extism_context_new :: IO (Ptr ExtismContext) foreign import ccall safe "extism.h &extism_context_free" extism_context_free :: FunPtr (Ptr ExtismContext -> IO ()) foreign import ccall safe "extism.h extism_plugin_new" extism_plugin_new :: Ptr ExtismContext -> Ptr Word8 -> Word64 -> Ptr (Ptr ExtismFunction) -> Word64 -> CBool -> IO Int32@@ -28,3 +95,28 @@ foreign import ccall safe "extism.h extism_version" extism_version :: IO CString foreign import ccall safe "extism.h extism_plugin_cancel_handle" extism_plugin_cancel_handle :: Ptr ExtismContext -> Int32 -> 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_current_plugin_memory" extism_current_plugin_memory :: Ptr ExtismCurrentPlugin -> IO (Ptr Word8)+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+  (a, 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)++callback :: (Ptr ExtismCurrentPlugin -> [Val] -> a -> IO [Val]) -> (Ptr ExtismCurrentPlugin -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ())+callback f plugin params nparams results nresults ptr = do+    p <- peekArray (fromIntegral nparams) params+    (userData, _, _)  <- deRefStablePtr (castPtrToStablePtr ptr)+    res <- f plugin p userData+    pokeArray results res

@@ -0,0 +1,48 @@+module Extism.CurrentPlugin where++import Extism+import Extism.Bindings+import Data.Word+import Data.ByteString as B+import Foreign.Ptr+import Foreign.Marshal.Array++-- | Allocate a new handle of the given size+memoryAlloc :: CurrentPlugin -> Word64 -> IO Word64+memoryAlloc = extism_current_plugin_memory_alloc++-- | Get the length of a handle, returns 0 if the handle is invalid+memoryLength :: CurrentPlugin -> Word64 -> IO Word64+memoryLength = extism_current_plugin_memory_length++-- | Free allocated memory+memoryFree :: CurrentPlugin -> Word64 -> IO ()+memoryFree = extism_current_plugin_memory_free++-- | Access a pointer to the entire memory region+memory :: CurrentPlugin -> IO (Ptr Word8)+memory = extism_current_plugin_memory++-- | Access a pointer the a specific offset in memory+memoryOffset :: CurrentPlugin -> Word64 -> IO (Ptr Word8)+memoryOffset plugin offs = do+  x <- extism_current_plugin_memory plugin+  return $ plusPtr x (fromIntegral offs)++-- | Access the data associated with a handle as a 'ByteString'+memoryBytes :: CurrentPlugin -> Word64 ->  IO B.ByteString+memoryBytes plugin offs = do+  ptr <- memoryOffset plugin offs+  len <- memoryLength plugin offs+  arr <- peekArray (fromIntegral len) ptr+  return $ B.pack arr++-- | Allocate memory and copy an existing 'ByteString' into it+allocBytes :: CurrentPlugin -> B.ByteString -> IO Word64+allocBytes plugin s = do+  let length = B.length s+  offs <- memoryAlloc plugin (fromIntegral length)+  ptr <- memoryOffset plugin offs+  pokeArray ptr (B.unpack s)+  return offs+

@@ -1,6 +1,7 @@ import Test.HUnit import Extism import Extism.Manifest+import Extism.CurrentPlugin   unwrap (Right x) = return x@@ -8,12 +9,13 @@   assertFailure msg  defaultManifest = manifest [wasmFile "../../wasm/code.wasm"]+hostFunctionManifest = manifest [wasmFile "../../wasm/code-functions.wasm"]  initPlugin :: Maybe Context -> IO Plugin initPlugin Nothing =-  Extism.createPluginFromManifest defaultManifest False >>= unwrap+  Extism.createPluginFromManifest defaultManifest [] False >>= unwrap initPlugin (Just ctx) =-  Extism.pluginFromManifest ctx defaultManifest False >>= unwrap+  Extism.pluginFromManifest ctx defaultManifest [] False >>= unwrap  pluginFunctionExists = do   p <- initPlugin Nothing@@ -30,6 +32,17 @@   p <- initPlugin Nothing   checkCallResult p ++hello plugin params () = do+  putStrLn "Hello from Haskell!"+  offs <- allocBytes plugin (toByteString "{\"count\": 999}")+  return [toI64 offs]++pluginCallHostFunction = do+  p <- Extism.createPluginFromManifest hostFunctionManifest [] False >>= unwrap+  res <- call p "count_vowels" (toByteString "this is a test") >>= unwrap+  assertEqual "count vowels output" "{\"count\": 999}" (fromByteString res)+ pluginMultiple = do   withContext(\ctx -> do     p <- initPlugin (Just ctx)@@ -42,7 +55,7 @@ pluginUpdate = do   withContext (\ctx -> do     p <- initPlugin (Just ctx)-    updateManifest p defaultManifest True >>= unwrap+    updateManifest p defaultManifest [] True >>= unwrap     checkCallResult p)  pluginConfig = do@@ -62,6 +75,7 @@     [       t "Plugin.FunctionExists" pluginFunctionExists       , t "Plugin.Call" pluginCall+      , t "Plugin.CallHostFunction" pluginCallHostFunction       , t "Plugin.Multiple" pluginMultiple       , t "Plugin.Update" pluginUpdate       , t "Plugin.Config" pluginConfig