diff --git a/Example.hs b/Example.hs --- a/Example.hs +++ b/Example.hs @@ -7,7 +7,7 @@ import Extism.JSON import Extism.Manifest (manifest, wasmFile) -newtype Count = Count {count :: Int} deriving (Data, Typeable, Show) +newtype Count = Count {count :: Int} deriving (Data, Show) hello currPlugin msg = do putStrLn . unwrap <$> input currPlugin 0 diff --git a/README.md b/README.md --- a/README.md +++ b/README.md @@ -108,7 +108,7 @@ import Extism.JSON import Extism.Manifest (manifest, wasmFile) -newtype Count = Count {count :: Int} deriving (Data, Typeable, Show) +newtype Count = Count {count :: Int} deriving (Data, Show) hello currPlugin msg = do putStrLn . unwrap <$> input currPlugin 0 diff --git a/extism.cabal b/extism.cabal --- a/extism.cabal +++ b/extism.cabal @@ -1,6 +1,6 @@ cabal-version: 3.0 name: extism -version: 1.2.1.0 +version: 1.3.0.0 license: BSD-3-Clause maintainer: oss@extism.org author: Extism authors diff --git a/src/Extism.hs b/src/Extism.hs --- a/src/Extism.hs +++ b/src/Extism.hs @@ -13,11 +13,16 @@ Result (..), extismVersion, newPlugin, + newCompiledPlugin, + newPluginFromCompiled, isValid, setConfig, setLogFile, functionExists, call, + call', + callWithHostContext, + callWithHostContext', cancelHandle, cancel, pluginID, @@ -39,6 +44,7 @@ import Data.Word import Extism.Bindings import Extism.Encoding +import Extism.JSON import Extism.Manifest (Manifest) import Foreign.C.String import Foreign.Concurrent @@ -49,7 +55,7 @@ import Foreign.StablePtr import Foreign.Storable import GHC.Ptr -import qualified Text.JSON (Result (..), decode, encode, showJSON, toJSObject) +import qualified Text.JSON (JSValue (JSNull, JSString), Result (..), decode, encode, toJSObject, toJSString) -- | Host function, see 'Extism.HostFunction.hostFunction' data Function = Function (ForeignPtr ExtismFunction) (StablePtr ()) deriving (Eq) @@ -57,6 +63,9 @@ -- | Plugins can be used to call WASM function newtype Plugin = Plugin (ForeignPtr ExtismPlugin) deriving (Eq, Show) +-- | CompiledPlugins can be used to create multiple plugin instances from a single pre-compiled plugin +newtype CompiledPlugin = CompiledPlugin (ForeignPtr ExtismCompiledPlugin) deriving (Eq, Show) + -- | Cancellation handle for Plugins newtype CancelHandle = CancelHandle (Ptr ExtismCancelHandle) deriving (Eq, Show) @@ -105,11 +114,59 @@ length' = fromIntegral (B.length wasm) wasi = fromInteger (if useWasi then 1 else 0) +-- | Create a 'Plugin' from a WASM module, `useWasi` determines if WASI should +-- | be linked +newCompiledPlugin :: (PluginInput a) => a -> [Function] -> Bool -> IO (Result CompiledPlugin) +newCompiledPlugin input functions useWasi = do + funcs <- mapM (\(Function ptr _) -> withForeignPtr ptr return) functions + alloca $ \e -> do + let errmsg = (e :: Ptr CString) + p <- unsafeUseAsCString wasm $ \s -> + withArray funcs $ \funcs -> + extism_compiled_plugin_new (castPtr s) length' funcs nfunctions wasi errmsg + + if p == nullPtr + then do + err <- peek errmsg + e <- peekCString err + extism_plugin_new_error_free err + return $ Left (ExtismError e) + else do + ptr <- Foreign.Concurrent.newForeignPtr p (extism_compiled_plugin_free p) + return $ Right (CompiledPlugin ptr) + where + wasm = pluginInput input + nfunctions = fromIntegral (length functions) + length' = fromIntegral (B.length wasm) + wasi = fromInteger (if useWasi then 1 else 0) + +-- | Create a new plugin from a `CompiledPlugin` +newPluginFromCompiled :: CompiledPlugin -> IO (Result Plugin) +newPluginFromCompiled (CompiledPlugin compiled) = do + alloca $ \e -> do + let errmsg = (e :: Ptr CString) + p <- withForeignPtr compiled $ \c -> + extism_plugin_new_from_compiled c errmsg + if p == nullPtr + then do + err <- peek errmsg + e <- peekCString err + extism_plugin_new_error_free err + return $ Left (ExtismError e) + else do + ptr <- Foreign.Concurrent.newForeignPtr p (extism_plugin_free p) + return $ Right (Plugin ptr) + -- | Same as `newPlugin` but converts the error case to an exception newPlugin' :: (PluginInput a) => a -> [Function] -> Bool -> IO Plugin newPlugin' input functions useWasi = do unwrap <$> newPlugin input functions useWasi +-- | Same as `newPluginFromCompiled` but converts the error case to an exception +newPluginFromCompiled' :: CompiledPlugin -> IO Plugin +newPluginFromCompiled' c = + unwrap <$> newPluginFromCompiled c + -- | Check if a 'Plugin' is valid isValid :: Plugin -> IO Bool isValid (Plugin p) = withForeignPtr p (\x -> return (x /= nullPtr)) @@ -120,9 +177,11 @@ unsafeUseAsCString bs $ \s -> withForeignPtr plugin $ \plugin' -> do b <- extism_plugin_config plugin' (castPtr s) length' + print b return $ b /= 0 where - obj = Text.JSON.toJSObject [(k, Text.JSON.showJSON v) | (k, v) <- x] + mk = maybe Text.JSON.JSNull (Text.JSON.JSString . Text.JSON.toJSString) + obj = Text.JSON.toJSObject [(k, mk v) | (k, v) <- x] bs = toByteString (Text.JSON.encode obj) length' = fromIntegral (B.length bs) @@ -176,6 +235,37 @@ call' :: (ToBytes a, FromBytes b) => Plugin -> String -> a -> IO b call' plugin name inp = do unwrap <$> call plugin name inp + +--- | Call a function provided by the given plugin with a host context value +callWithHostContext :: (ToBytes a, FromBytes b) => Plugin -> String -> a -> c -> IO (Result b) +callWithHostContext (Plugin plugin) name inp ctx = + withForeignPtr plugin $ \plugin' -> do + sptr <- newStablePtr ctx + let ptr = castStablePtrToPtr sptr + rc <- withCString name $ \name' -> + unsafeUseAsCString input $ \input' -> + extism_plugin_call_with_host_context plugin' name' (castPtr input') length' ptr + freeStablePtr sptr + err <- extism_error plugin' + if err /= nullPtr + then do + e <- peekCString err + return $ Left (ExtismError e) + else + if rc == 0 + then do + len <- extism_plugin_output_length plugin' + Ptr ptr <- extism_plugin_output_data plugin' + x <- unsafePackLenAddress (fromIntegral len) ptr + return $ fromBytes x + else return $ Left (ExtismError "Call failed") + where + input = toBytes inp + length' = fromIntegral (B.length input) + +callWithHostContext' :: (ToBytes a, FromBytes b) => Plugin -> String -> a -> c -> IO b +callWithHostContext' plugin name inp ctx = do + unwrap <$> callWithHostContext plugin name inp ctx -- | Create a new 'CancelHandle' that can be used to cancel a running plugin -- | from another thread. diff --git a/src/Extism/Bindings.hs b/src/Extism/Bindings.hs --- a/src/Extism/Bindings.hs +++ b/src/Extism/Bindings.hs @@ -24,6 +24,8 @@ 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) @@ -94,10 +96,22 @@ 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 @@ -126,6 +140,10 @@ 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 () @@ -165,6 +183,10 @@ 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 :: diff --git a/src/Extism/HostFunction.hs b/src/Extism/HostFunction.hs --- a/src/Extism/HostFunction.hs +++ b/src/Extism/HostFunction.hs @@ -35,6 +35,7 @@ output, getParams, setResults, + hostContext, ptr, ) where @@ -199,6 +200,15 @@ input' plugin index = unwrap <$> input plugin index +hostContext :: CurrentPlugin -> IO (Maybe a) +hostContext (CurrentPlugin cp _ _ _) = do + ptr <- extism_current_plugin_host_context cp + if ptr == nullPtr + then return Nothing + else do + x <- deRefStablePtr (castPtrToStablePtr ptr) + return $ Just x + callback :: (CurrentPlugin -> a -> IO ()) -> (Ptr ExtismCurrentPlugin -> Ptr Val -> Word64 -> Ptr Val -> Word64 -> Ptr () -> IO ()) callback f plugin params nparams results nresults ptr = do p <- peekArray (fromIntegral nparams) params @@ -226,22 +236,22 @@ nparams = fromIntegral $ length params nresults = fromIntegral $ length results --- | 'hostFunction "function_name" inputTypes outputTypes callback userData' creates a new --- | 'Function' in the default namespace that can be called from a 'Plugin' +-- | @hostFunction "function_name" inputTypes outputTypes callback userData@ creates a new +-- | 'Extism.Function' in the default namespace that can be called from a 'Extism.Plugin' hostFunction :: String -> [ValType] -> [ValType] -> (CurrentPlugin -> a -> IO ()) -> a -> IO Function hostFunction = hostFunctionWithNamespace' Nothing --- | 'hostFunction' "namespace" "function_name" inputTypes outputTypes callback userData' creates a new --- | 'Function' in the provided namespace that can be called from a 'Plugin' +-- | @hostFunction' "namespace" "function_name" inputTypes outputTypes callback userData@ creates a new +-- | 'Extism.Function' in the provided namespace that can be called from a 'Extism.Plugin' hostFunction' :: String -> String -> [ValType] -> [ValType] -> (CurrentPlugin -> a -> IO ()) -> a -> IO Function hostFunction' ns = hostFunctionWithNamespace' (Just ns) --- | 'newFunction "function_name" inputTypes outputTypes callback userData' creates a new --- | 'Function' in the default namespace that can be called from a 'Plugin' +-- | @newFunction' "function_name" inputTypes outputTypes userData callback@ creates a new +-- | 'Extism.Function' in the default namespace that can be called from a 'Extism.Plugin' newFunction :: String -> [ValType] -> [ValType] -> a -> (CurrentPlugin -> a -> IO ()) -> IO Function newFunction name params results x f = hostFunctionWithNamespace' Nothing name params results f x --- | 'newFunction' "namespace" "function_name" inputTypes outputTypes callback userData' creates a new --- | 'Function' in the provided namespace that can be called from a 'Plugin' +-- | @newFunction' "namespace" "function_name" inputTypes outputTypes userData callback@ creates a new +-- | 'Extism.Function' in the provided namespace that can be called from a 'Extism.Plugin' newFunction' :: String -> String -> [ValType] -> [ValType] -> a -> (CurrentPlugin -> a -> IO ()) -> IO Function newFunction' ns name params results x f = hostFunctionWithNamespace' (Just ns) name params results f x diff --git a/test/Test.hs b/test/Test.hs --- a/test/Test.hs +++ b/test/Test.hs @@ -1,5 +1,8 @@ +{-# LANGUAGE DeriveDataTypeable #-} + import Extism import Extism.HostFunction +import Extism.JSON import Extism.Manifest import Test.HUnit @@ -7,9 +10,9 @@ assertUnwrap (Left (ExtismError msg)) = assertFailure msg -defaultManifest = manifest [wasmFile "../wasm/code.wasm"] +defaultManifest = manifest [wasmFile "wasm/code.wasm"] -hostFunctionManifest = manifest [wasmFile "../wasm/code-functions.wasm"] +hostFunctionManifest = manifest [wasmFile "wasm/code-functions.wasm"] initPlugin :: IO Plugin initPlugin = @@ -24,23 +27,38 @@ checkCallResult p = do res <- call p "count_vowels" "this is a test" >>= assertUnwrap - assertEqual "count vowels output" "{\"count\": 4}" res + assertEqual "count vowels output" "{\"count\":4,\"total\":4,\"vowels\":\"aeiouAEIOU\"}" res pluginCall = do p <- initPlugin checkCallResult p -hello plugin () = do - s <- unwrap <$> input plugin 0 - assertEqual "host function input" "{\"count\": 4}" s +newtype Count = Count {count :: Int} deriving (Data, Show) + +hello currPlugin msg = do + putStrLn . unwrap <$> input currPlugin 0 putStrLn "Hello from Haskell!" - output plugin 0 "{\"count\": 999}" + putStrLn msg + output currPlugin 0 $ JSON $ Count 999 pluginCallHostFunction = do - p <- Extism.newPlugin hostFunctionManifest [] False >>= assertUnwrap + f <- newFunction "hello_world" [ptr] [ptr] "Hello, again" hello + p <- Extism.newPlugin hostFunctionManifest [f] True >>= assertUnwrap res <- call p "count_vowels" "this is a test" >>= assertUnwrap - assertEqual "count vowels output" "{\"count\": 999}" res + assertEqual "count vowels output" "{\"count\":999}" res +helloContext currPlugin msg = do + ctx <- hostContext currPlugin + case ctx of + Nothing -> assertBool "Expected host context" False + Just s -> putStrLn s + output currPlugin 0 msg + +pluginCallHostContext = do + f <- newFunction "hello_world" [ptr] [ptr] "Hello, again" helloContext + p <- Extism.newPlugin hostFunctionManifest [f] True >>= assertUnwrap + callWithHostContext p "count_vowels" "this is a test" "host context" >>= assertUnwrap + pluginMultiple = do p <- initPlugin checkCallResult p @@ -58,6 +76,11 @@ b <- setLogFile "stderr" Extism.LogError assertBool "set log file" b +testCompiledPlugin = do + c <- Extism.newCompiledPlugin defaultManifest [] False >>= assertUnwrap + p <- Extism.newPluginFromCompiled c >>= assertUnwrap + checkCallResult p + t name f = TestLabel name (TestCase f) main = do @@ -66,8 +89,10 @@ [ t "Plugin.FunctionExists" pluginFunctionExists, t "Plugin.Call" pluginCall, t "Plugin.CallHostFunction" pluginCallHostFunction, + t "Plugin.CallHostContext" pluginCallHostContext, t "Plugin.Multiple" pluginMultiple, t "Plugin.Config" pluginConfig, - t "SetLogFile" testSetLogFile + t "SetLogFile" testSetLogFile, + t "CompiledPlugin" testCompiledPlugin ] )