extism 1.2.0.3 → 1.2.1.0

raw patch · 7 files changed

+217/−166 lines, 7 filesPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

API changes (from Hackage documentation)

Files

• CHANGELOG.md +4/−0
• Example.hs +2/−2
• README.md +6/−3
• extism.cabal +1/−1
• src/Extism.hs +81/−99
• src/Extism/Bindings.hs +67/−21
• src/Extism/HostFunction.hs +56/−40

@@ -1,5 +1,9 @@ # Revision history for extism +## 1.2.1.0 -- 2024-04-22++* Added `newFunction`+ ## 1.0.0.0 -- 2024-01-08  * Extism 1.0 compatible release

@@ -13,12 +13,12 @@   putStrLn . unwrap <$> input currPlugin 0   putStrLn "Hello from Haskell!"   putStrLn msg-  output currPlugin 0 (JSON $ Count 999)+  output currPlugin 0 $ JSON $ Count 999  main = do   setLogFile "stdout" LogError   let m = manifest [wasmFile "wasm/code-functions.wasm"]-  f <- hostFunction "hello_world" [ptr] [ptr] hello "Hello, again"+  f <- newFunction "hello_world" [ptr] [ptr] "Hello, again" hello   plugin <- unwrap <$> newPlugin m [f] True   id <- pluginID plugin   print id

@@ -38,10 +38,12 @@ import Extism  main = do-  let wasm = wasmURL "GET" "https://github.com/extism/plugins/releases/latest/download/count_vowels.wasm"   plugin <- unwrap <$> newPlugin (manifest [wasm]) [] True   res <- unwrap <$> call plugin "count_vowels" "Hello, world!"   putStrLn res+  where+    wasm = wasmURL "GET" "https://github.com/extism/plugins/releases/latest/download/count_vowels.wasm"+ -- Prints: {"count":3,"total":3,"vowels":"aeiouAEIOU"}" ``` @@ -116,13 +118,14 @@  main = do   setLogFile "stdout" LogError-  let m = manifest [wasmFile "wasm/code-functions.wasm"]-  f <- hostFunction "hello_world" [ptr] [ptr] hello "Hello, again"+  f <- newFunction "hello_world" [ptr] [ptr] "Hello, again" hello   plugin <- unwrap <$> newPlugin m [f] True   id <- pluginID plugin   print id   JSON res <- (unwrap <$> call plugin "count_vowels" "this is a test" :: IO (JSON Count))   print res+  where+    m = manifest [wasmFile "wasm/code-functions.wasm"] -- Prints: Count {count = 999} ``` 

@@ -1,6 +1,6 @@ cabal-version:      3.0 name:               extism-version:            1.2.0.3+version:            1.2.1.0 license:            BSD-3-Clause maintainer:         oss@extism.org author:             Extism authors

@@ -4,6 +4,7 @@ -- Requires a libextism installation, see [https://extism.org/docs/install](https://extism.org/docs/install) module Extism   ( module Extism.Manifest,+    module Extism.Encoding,     Function (..),     Plugin (..),     CancelHandle (..),@@ -22,9 +23,10 @@     pluginID,     unwrap,     ToBytes (..),-    Encoding,     FromBytes (..),     JSON (..),+    PluginInput (..),+    reset,   ) where @@ -80,37 +82,34 @@ -- | Create a 'Plugin' from a WASM module, `useWasi` determines if WASI should -- | be linked newPlugin :: (PluginInput a) => a -> [Function] -> Bool -> IO (Result Plugin)-newPlugin input functions useWasi =-  let wasm = pluginInput input-   in let nfunctions = fromIntegral (length functions)-       in let length' = fromIntegral (B.length wasm)-           in let wasi = fromInteger (if useWasi then 1 else 0)-               in 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_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_plugin_free p)-                              return $ Right (Plugin ptr)-                      )+newPlugin 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_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_plugin_free p)+        return $ Right (Plugin ptr)+  where+    wasm = pluginInput input+    nfunctions = fromIntegral (length functions)+    length' = fromIntegral (B.length wasm)+    wasi = fromInteger (if useWasi then 1 else 0)++-- | 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+ -- | Check if a 'Plugin' is valid isValid :: Plugin -> IO Bool isValid (Plugin p) = withForeignPtr p (\x -> return (x /= nullPtr))@@ -118,19 +117,14 @@ -- | Set configuration values for a plugin setConfig :: Plugin -> [(String, Maybe String)] -> IO Bool setConfig (Plugin plugin) x =-  let obj = Text.JSON.toJSObject [(k, Text.JSON.showJSON v) | (k, v) <- x]-   in let bs = toByteString (Text.JSON.encode obj)-       in let length' = fromIntegral (B.length bs)-           in unsafeUseAsCString-                bs-                ( \s ->-                    withForeignPtr-                      plugin-                      ( \plugin' -> do-                          b <- extism_plugin_config plugin' (castPtr s) length'-                          return $ b /= 0-                      )-                )+  unsafeUseAsCString bs $ \s ->+    withForeignPtr plugin $ \plugin' -> do+      b <- extism_plugin_config plugin' (castPtr s) length'+      return $ b /= 0+  where+    obj = Text.JSON.toJSObject [(k, Text.JSON.showJSON v) | (k, v) <- x]+    bs = toByteString (Text.JSON.encode obj)+    length' = fromIntegral (B.length bs)  levelStr LogError = "error" levelStr LogDebug = "debug"@@ -141,61 +135,48 @@ -- | Set the log file and level, this is a global configuration setLogFile :: String -> LogLevel -> IO Bool setLogFile filename level =-  let s = levelStr level-   in withCString-        filename-        ( \f ->-            withCString-              s-              ( \l -> do-                  b <- extism_log_file f l-                  return $ b /= 0-              )-        )+  withCString filename $ \f ->+    withCString s $ \l -> do+      b <- extism_log_file f l+      return $ b /= 0+  where+    s = levelStr level  -- | Check if a function exists in the given plugin functionExists :: Plugin -> String -> IO Bool functionExists (Plugin plugin) name =-  withForeignPtr-    plugin-    ( \plugin' -> do-        b <- withCString name (extism_plugin_function_exists plugin')-        if b == 1 then return True else return False-    )+  withForeignPtr plugin $ \plugin' -> do+    b <- withCString name (extism_plugin_function_exists plugin')+    if b == 1 then return True else return False  --- | Call a function provided by the given plugin call :: (ToBytes a, FromBytes b) => Plugin -> String -> a -> IO (Result b) call (Plugin plugin) name inp =-  let input = toBytes inp-   in let length' = fromIntegral (B.length input)-       in withForeignPtr-            plugin-            ( \plugin' -> do-                rc <--                  withCString-                    name-                    ( \name' ->-                        unsafeUseAsCString-                          input-                          ( \input' ->-                              extism_plugin_call plugin' name' (castPtr input') length'-                          )-                    )-                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")-            )+  withForeignPtr plugin $ \plugin' -> do+    rc <- withCString name $ \name' ->+      unsafeUseAsCString input $ \input' ->+        extism_plugin_call plugin' name' (castPtr input') length'+    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) +call' :: (ToBytes a, FromBytes b) => Plugin -> String -> a -> IO b+call' plugin name inp = do+  unwrap <$> call plugin name inp+ -- | Create a new 'CancelHandle' that can be used to cancel a running plugin -- | from another thread. cancelHandle :: Plugin -> IO CancelHandle@@ -210,15 +191,16 @@  pluginID :: Plugin -> IO Data.UUID.UUID pluginID (Plugin plugin) =-  withForeignPtr-    plugin-    ( \plugin' -> do-        ptr <- extism_plugin_id plugin'-        buf <- B.packCStringLen (castPtr ptr, 16)-        case Data.UUID.fromByteString (BL.fromStrict buf) of-          Nothing -> error "Invalid Plugin ID"-          Just x -> return x-    )+  withForeignPtr plugin $ \plugin' -> do+    ptr <- extism_plugin_id plugin'+    buf <- B.packCStringLen (castPtr ptr, 16)+    case Data.UUID.fromByteString (BL.fromStrict buf) of+      Nothing -> error "Invalid Plugin ID"+      Just x -> return x++reset :: Plugin -> IO ()+reset (Plugin plugin) =+  withForeignPtr plugin extism_plugin_reset  unwrap (Right x) = x unwrap (Left (ExtismError msg)) =

@@ -90,47 +90,93 @@   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"+  extism_plugin_new ::+    Ptr Word8 -> Word64 -> Ptr (Ptr ExtismFunction) -> Word64 -> CBool -> Ptr CString -> IO (Ptr ExtismPlugin) -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"+  extism_plugin_call ::+    Ptr ExtismPlugin -> CString -> Ptr Word8 -> Word64 -> 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_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_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_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_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_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_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_plugin_free"+  extism_plugin_free ::+    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_plugin_reset"+  extism_plugin_reset ::+    Ptr ExtismPlugin -> IO () -foreign import ccall safe "extism.h extism_version" extism_version :: IO CString+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_plugin_id" extism_plugin_id :: Ptr ExtismPlugin -> IO (Ptr Word8)+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 ExtismPlugin -> IO (Ptr ExtismCancelHandle)+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" extism_plugin_cancel :: Ptr ExtismCancelHandle -> IO Bool+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_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_plugin_cancel"+  extism_plugin_cancel ::+    Ptr ExtismCancelHandle -> IO Bool -foreign import ccall safe "extism.h extism_function_free" extism_function_free :: Ptr ExtismFunction -> IO ()+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_set_namespace" extism_function_set_namespace :: Ptr ExtismFunction -> CString -> IO ()+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_function_set_namespace"+  extism_function_set_namespace ::+    Ptr ExtismFunction -> CString -> IO () -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"+  extism_current_plugin_memory ::+    Ptr ExtismCurrentPlugin -> IO (Ptr Word8) -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_alloc"+  extism_current_plugin_memory_alloc ::+    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 ()+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

@@ -7,6 +7,7 @@     ValType (..),     Val (..),     MemoryHandle,+    Function,     memoryAlloc,     memoryLength,     memoryFree,@@ -28,6 +29,8 @@     fromF64,     hostFunction,     hostFunction',+    newFunction,+    newFunction',     input,     output,     getParams,@@ -101,6 +104,12 @@   x <- memoryBytes plugin offs   return $ fromBytes x +-- | Access the data associated with a handle and convert it into a Haskell type+memoryGet' :: (FromBytes a) => CurrentPlugin -> MemoryHandle -> IO a+memoryGet' plugin offs = do+  x <- memoryBytes plugin offs+  return $ unwrap $ fromBytes x+ -- | Allocate memory and copy an existing 'ByteString' into it allocBytes :: CurrentPlugin -> B.ByteString -> IO MemoryHandle allocBytes plugin s = do@@ -168,22 +177,28 @@  output :: (ToBytes a) => CurrentPlugin -> Int -> a -> IO () output !p !index !x =-  let CurrentPlugin _ _ !res !len = p-   in do-        mem <- alloc p x-        if index >= len-          then return ()-          else pokeElemOff res index (toI64 mem)+  do+    mem <- alloc p x+    if index >= len+      then return ()+      else pokeElemOff res index (toI64 mem)+  where+    CurrentPlugin _ _ !res !len = p  input :: (FromBytes a) => CurrentPlugin -> Int -> IO (Result a) input plugin index =-  let (CurrentPlugin _ params _ _) = plugin-   in let x = fromI64 (params !! index) :: Maybe Word64-       in case x of-            Nothing -> return $ Left (ExtismError "invalid parameter")-            Just offs -> do-              memoryGet plugin (MemoryHandle offs)+  case x of+    Nothing -> return $ Left (ExtismError "invalid parameter")+    Just offs -> do+      memoryGet plugin (MemoryHandle offs)+  where+    (CurrentPlugin _ params _ _) = plugin+    x = fromI64 (params !! index) :: Maybe Word64 +input' :: (FromBytes a) => CurrentPlugin -> Int -> IO a+input' plugin index =+  unwrap <$> input plugin index+ 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@@ -191,34 +206,25 @@   f (CurrentPlugin plugin p results (fromIntegral nresults)) userData  hostFunctionWithNamespace' ns name params results f v =-  let nparams = fromIntegral $ length params-   in let nresults = fromIntegral $ length results-       in do-            let g = callback f-            cb <- callbackWrap g-            free <- freePtrWrap freePtr-            userData <- newStablePtr (v, free, cb, g)-            let userDataPtr = castStablePtrToPtr userData-            x <--              withCString-                name-                ( \name' ->-                    withArray-                      params-                      ( \params' ->-                          withArray-                            results-                            ( \results' ->-                                extism_function_new name' params' nparams results' nresults cb userDataPtr free-                            )-                      )-                )-            let freeFn = extism_function_free x-            case ns of-              Nothing -> return ()-              Just ns -> withCString ns (extism_function_set_namespace x)-            fptr <- Foreign.Concurrent.newForeignPtr x freeFn-            return $ Function fptr (castPtrToStablePtr userDataPtr)+  do+    let g = callback f+    cb <- callbackWrap g+    free <- freePtrWrap freePtr+    userData <- newStablePtr (v, free, cb, g)+    let userDataPtr = castStablePtrToPtr userData+    x <- withCString name $ \name' ->+      withArray params $ \params' ->+        withArray results $ \results' ->+          extism_function_new name' params' nparams results' nresults cb userDataPtr free+    let freeFn = extism_function_free x+    case ns of+      Nothing -> return ()+      Just ns -> withCString ns (extism_function_set_namespace x)+    fptr <- Foreign.Concurrent.newForeignPtr x freeFn+    return $ Function fptr (castPtrToStablePtr userDataPtr)+  where+    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'@@ -229,3 +235,13 @@ -- | 'Function' in the provided namespace that can be called from a '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 :: 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' :: 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