packages feed

extism 0.5.0 → 1.0.0.0

raw patch · 11 files changed

+799/−392 lines, 11 filesdep +binarydep +uuiddep ~HUnitdep ~extism-manifestPVP ok

version bump matches the API change (PVP)

Dependencies added: binary, uuid

Dependency ranges changed: HUnit, extism-manifest

API changes (from Hackage documentation)

- Extism: Context :: ForeignPtr ExtismContext -> Context
- Extism: Debug :: LogLevel
- Extism: Error :: LogLevel
- Extism: ExternRef :: ValType
- Extism: F32 :: ValType
- Extism: F64 :: ValType
- Extism: FuncRef :: ValType
- Extism: I32 :: ValType
- Extism: I64 :: ValType
- Extism: Info :: LogLevel
- Extism: Trace :: LogLevel
- Extism: V128 :: ValType
- Extism: ValF32 :: Float -> Val
- Extism: ValF64 :: Double -> Val
- Extism: ValI32 :: Int32 -> Val
- Extism: ValI64 :: Int64 -> Val
- Extism: Warn :: LogLevel
- Extism: createPlugin :: ByteString -> [Function] -> Bool -> IO (Result Plugin)
- Extism: createPluginFromManifest :: Manifest -> [Function] -> Bool -> IO (Result Plugin)
- Extism: data Plugin
- Extism: data Val
- Extism: data ValType
- Extism: free :: Plugin -> IO ()
- Extism: fromByteString :: ByteString -> String
- Extism: fromF32 :: Val -> Maybe Float
- Extism: fromF64 :: Val -> Maybe Double
- Extism: fromI32 :: Integral a => Val -> Maybe a
- Extism: fromI64 :: Integral a => Val -> Maybe a
- Extism: hostFunction :: String -> [ValType] -> [ValType] -> (CurrentPlugin -> [Val] -> a -> IO [Val]) -> a -> IO Function
- Extism: instance GHC.Show.Show Extism.Error
- Extism: levelStr :: LogLevel -> String
- Extism: newContext :: IO Context
- Extism: newtype Context
- Extism: plugin :: Context -> ByteString -> [Function] -> Bool -> IO (Result Plugin)
- Extism: pluginFromManifest :: Context -> Manifest -> [Function] -> Bool -> IO (Result Plugin)
- Extism: reset :: Context -> IO ()
- Extism: toByteString :: String -> ByteString
- Extism: toF32 :: Float -> Val
- Extism: toF64 :: Double -> Val
- Extism: toI32 :: Integral a => a -> Val
- Extism: toI64 :: Integral a => a -> Val
- Extism: toString :: JSON a => a -> String
- Extism: type CurrentPlugin = Ptr ExtismCurrentPlugin
- Extism: update :: Plugin -> ByteString -> [Function] -> Bool -> IO (Result Plugin)
- Extism: updateManifest :: Plugin -> Manifest -> [Function] -> Bool -> IO (Result Plugin)
- Extism: withContext :: (Context -> IO a) -> IO a
- Extism: withPlugin :: (Plugin -> IO a) -> Plugin -> IO a
- Extism.CurrentPlugin: allocBytes :: CurrentPlugin -> ByteString -> IO Word64
- Extism.CurrentPlugin: memory :: CurrentPlugin -> IO (Ptr Word8)
- Extism.CurrentPlugin: memoryAlloc :: CurrentPlugin -> Word64 -> IO Word64
- Extism.CurrentPlugin: memoryBytes :: CurrentPlugin -> Word64 -> IO ByteString
- Extism.CurrentPlugin: memoryFree :: CurrentPlugin -> Word64 -> IO ()
- Extism.CurrentPlugin: memoryLength :: CurrentPlugin -> Word64 -> IO Word64
- Extism.CurrentPlugin: memoryOffset :: CurrentPlugin -> Word64 -> IO (Ptr Word8)
+ Extism: JSON :: x -> JSON x
+ Extism: LogDebug :: LogLevel
+ Extism: LogError :: LogLevel
+ Extism: LogInfo :: LogLevel
+ Extism: LogTrace :: LogLevel
+ Extism: LogWarn :: LogLevel
+ Extism: class (ToBytes a, FromBytes a) => Encoding a
+ Extism: class FromBytes a
+ Extism: class ToBytes a
+ Extism: fromBytes :: FromBytes a => ByteString -> Result a
+ Extism: instance Extism.PluginInput Data.ByteString.Internal.Type.ByteString
+ Extism: instance Extism.PluginInput Extism.Manifest.Manifest
+ Extism: instance GHC.Classes.Eq Extism.CancelHandle
+ Extism: instance GHC.Classes.Eq Extism.Function
+ Extism: instance GHC.Classes.Eq Extism.LogLevel
+ Extism: instance GHC.Classes.Eq Extism.Plugin
+ Extism: instance GHC.Show.Show Extism.CancelHandle
+ Extism: instance GHC.Show.Show Extism.Plugin
+ Extism: newPlugin :: PluginInput a => a -> [Function] -> Bool -> IO (Result Plugin)
+ Extism: newtype JSON x
+ Extism: newtype Plugin
+ Extism: pluginID :: Plugin -> IO UUID
+ Extism: toBytes :: ToBytes a => a -> ByteString
+ Extism: unwrap :: Either Error b -> b
+ Extism.Encoding: ExtismError :: String -> Error
+ Extism.Encoding: JSON :: x -> JSON x
+ Extism.Encoding: class (ToBytes a, FromBytes a) => Encoding a
+ Extism.Encoding: class FromBytes a
+ Extism.Encoding: class ToBytes a
+ Extism.Encoding: fromByteString :: ByteString -> String
+ Extism.Encoding: fromBytes :: FromBytes a => ByteString -> Result a
+ Extism.Encoding: instance Data.Data.Data a => Extism.Encoding.FromBytes (Extism.Encoding.JSON a)
+ Extism.Encoding: instance Data.Data.Data a => Extism.Encoding.ToBytes (Extism.Encoding.JSON a)
+ Extism.Encoding: instance Extism.Encoding.FromBytes ()
+ Extism.Encoding: instance Extism.Encoding.FromBytes Data.ByteString.Internal.Type.ByteString
+ Extism.Encoding: instance Extism.Encoding.FromBytes GHC.Int.Int32
+ Extism.Encoding: instance Extism.Encoding.FromBytes GHC.Int.Int64
+ Extism.Encoding: instance Extism.Encoding.FromBytes GHC.Types.Double
+ Extism.Encoding: instance Extism.Encoding.FromBytes GHC.Types.Float
+ Extism.Encoding: instance Extism.Encoding.FromBytes GHC.Word.Word32
+ Extism.Encoding: instance Extism.Encoding.FromBytes GHC.Word.Word64
+ Extism.Encoding: instance Extism.Encoding.FromBytes [GHC.Types.Char]
+ Extism.Encoding: instance Extism.Encoding.ToBytes ()
+ Extism.Encoding: instance Extism.Encoding.ToBytes Data.ByteString.Internal.Type.ByteString
+ Extism.Encoding: instance Extism.Encoding.ToBytes GHC.Int.Int32
+ Extism.Encoding: instance Extism.Encoding.ToBytes GHC.Int.Int64
+ Extism.Encoding: instance Extism.Encoding.ToBytes GHC.Types.Double
+ Extism.Encoding: instance Extism.Encoding.ToBytes GHC.Types.Float
+ Extism.Encoding: instance Extism.Encoding.ToBytes GHC.Word.Word32
+ Extism.Encoding: instance Extism.Encoding.ToBytes GHC.Word.Word64
+ Extism.Encoding: instance Extism.Encoding.ToBytes [GHC.Types.Char]
+ Extism.Encoding: instance GHC.Classes.Eq Extism.Encoding.Error
+ Extism.Encoding: instance GHC.Show.Show Extism.Encoding.Error
+ Extism.Encoding: newtype Error
+ Extism.Encoding: newtype JSON x
+ Extism.Encoding: toByteString :: String -> ByteString
+ Extism.Encoding: toBytes :: ToBytes a => a -> ByteString
+ Extism.Encoding: type Result a = Either Error a
+ Extism.HostFunction: CurrentPlugin :: Ptr ExtismCurrentPlugin -> [Val] -> Ptr Val -> Int -> CurrentPlugin
+ Extism.HostFunction: ExternRef :: ValType
+ Extism.HostFunction: F32 :: ValType
+ Extism.HostFunction: F64 :: ValType
+ Extism.HostFunction: FuncRef :: ValType
+ Extism.HostFunction: I32 :: ValType
+ Extism.HostFunction: I64 :: ValType
+ Extism.HostFunction: V128 :: ValType
+ Extism.HostFunction: ValF32 :: Float -> Val
+ Extism.HostFunction: ValF64 :: Double -> Val
+ Extism.HostFunction: ValI32 :: Int32 -> Val
+ Extism.HostFunction: ValI64 :: Int64 -> Val
+ Extism.HostFunction: alloc :: ToBytes a => CurrentPlugin -> a -> IO MemoryHandle
+ Extism.HostFunction: allocBytes :: CurrentPlugin -> ByteString -> IO MemoryHandle
+ Extism.HostFunction: allocString :: CurrentPlugin -> String -> IO MemoryHandle
+ Extism.HostFunction: data CurrentPlugin
+ Extism.HostFunction: data MemoryHandle
+ Extism.HostFunction: data Val
+ Extism.HostFunction: data ValType
+ Extism.HostFunction: fromF32 :: Val -> Maybe Float
+ Extism.HostFunction: fromF64 :: Val -> Maybe Double
+ Extism.HostFunction: fromI32 :: Integral a => Val -> Maybe a
+ Extism.HostFunction: fromI64 :: Integral a => Val -> Maybe a
+ Extism.HostFunction: getParams :: CurrentPlugin -> [Val]
+ Extism.HostFunction: hostFunction :: String -> [ValType] -> [ValType] -> (CurrentPlugin -> a -> IO ()) -> a -> IO Function
+ Extism.HostFunction: hostFunction' :: String -> String -> [ValType] -> [ValType] -> (CurrentPlugin -> a -> IO ()) -> a -> IO Function
+ Extism.HostFunction: input :: FromBytes a => CurrentPlugin -> Int -> IO (Result a)
+ Extism.HostFunction: instance GHC.Classes.Eq Extism.HostFunction.MemoryHandle
+ Extism.HostFunction: instance GHC.Classes.Ord Extism.HostFunction.MemoryHandle
+ Extism.HostFunction: instance GHC.Enum.Enum Extism.HostFunction.MemoryHandle
+ Extism.HostFunction: instance GHC.Num.Num Extism.HostFunction.MemoryHandle
+ Extism.HostFunction: instance GHC.Real.Integral Extism.HostFunction.MemoryHandle
+ Extism.HostFunction: instance GHC.Real.Real Extism.HostFunction.MemoryHandle
+ Extism.HostFunction: instance GHC.Show.Show Extism.HostFunction.MemoryHandle
+ Extism.HostFunction: memory :: CurrentPlugin -> IO (Ptr Word8)
+ Extism.HostFunction: memoryAlloc :: CurrentPlugin -> Word64 -> IO MemoryHandle
+ Extism.HostFunction: memoryBytes :: CurrentPlugin -> MemoryHandle -> IO ByteString
+ Extism.HostFunction: memoryFree :: CurrentPlugin -> MemoryHandle -> IO ()
+ Extism.HostFunction: memoryGet :: FromBytes a => CurrentPlugin -> MemoryHandle -> IO (Result a)
+ Extism.HostFunction: memoryLength :: CurrentPlugin -> MemoryHandle -> IO Word64
+ Extism.HostFunction: memoryOffset :: CurrentPlugin -> MemoryHandle -> IO (Ptr Word8)
+ Extism.HostFunction: memoryString :: CurrentPlugin -> MemoryHandle -> IO String
+ Extism.HostFunction: output :: ToBytes a => CurrentPlugin -> Int -> a -> IO ()
+ Extism.HostFunction: ptr :: ValType
+ Extism.HostFunction: setResults :: CurrentPlugin -> [Val] -> IO ()
+ Extism.HostFunction: toF32 :: Float -> Val
+ Extism.HostFunction: toF64 :: Double -> Val
+ Extism.HostFunction: toI32 :: Integral a => a -> Val
+ Extism.HostFunction: toI64 :: Integral a => a -> Val
- Extism: Plugin :: Context -> Int32 -> [Function] -> Plugin
+ Extism: Plugin :: ForeignPtr ExtismPlugin -> Plugin
- Extism: call :: Plugin -> String -> ByteString -> IO (Result ByteString)
+ Extism: call :: (ToBytes a, FromBytes b) => Plugin -> String -> a -> IO (Result b)
- Extism: isValid :: Plugin -> Bool
+ Extism: isValid :: Plugin -> IO Bool

Files

CHANGELOG.md view
@@ -1,5 +1,9 @@ # Revision history for extism +## 1.0.0.0 -- 2024-01-08++* Extism 1.0 compatible release+ ## 0.2.0.0 -- 2023-01-16  * First version. Released on an unsuspecting world.
Example.hs view
@@ -1,24 +1,26 @@+{-# LANGUAGE DeriveDataTypeable #-}+ module Main where  import Extism-import Extism.CurrentPlugin-import Extism.Manifest(manifest, wasmFile)+import Extism.HostFunction+import Extism.JSON+import Extism.Manifest (manifest, wasmFile) -unwrap (Right x) = x-unwrap (Left (ExtismError msg)) = do-  error msg+newtype Count = Count {count :: Int} deriving (Data, Typeable, Show) -hello plugin params msg = do+hello currPlugin msg = do+  putStrLn . unwrap <$> input currPlugin 0   putStrLn "Hello from Haskell!"   putStrLn msg-  offs <- allocBytes plugin (toByteString "{\"count\": 999}")-  return [toI64 offs]+  output currPlugin 0 (JSON $ Count 999)  main = do-  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+  setLogFile "stdout" LogError+  let m = manifest [wasmFile "wasm/code-functions.wasm"]+  f <- hostFunction "hello_world" [ptr] [ptr] hello "Hello, again"+  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
+ README.md view
@@ -0,0 +1,129 @@+# Extism Haskell Host SDK++This repo contains the Haskell package for integrating with the [Extism](https://extism.org/) runtime.++> **Note**: If you're unsure what Extism is or what an SDK is see our homepage: [https://extism.org](https://extism.org).++## Documentation++Documentation is available at [https://hackage.haskell.org/package/extism](https://hackage.haskell.org/package/extism)++## Installation++### Install the Extism Runtime Dependency++For this library, you first need to install the Extism Runtime. You can [download the shared object directly from a release](https://github.com/extism/extism/releases) or use the [Extism CLI](https://github.com/extism/cli) to install it.++### Add the library to dune++Then add `extism` to your [cabal](https://www.haskell.org/cabal/) file:++```+library+  build-depends: extism+```++## Getting Started++This guide should walk you through some of the concepts in Extism and the Haskell bindings.++### Creating A Plug-in++The primary concept in Extism is the [plug-in](https://extism.org/docs/concepts/plug-in). You can think of a plug-in as a code module stored in a `.wasm` file.++Since you may not have an Extism plug-in on hand to test, let's load a demo plug-in from the web:++```haskell+module Main where+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+-- Prints: {"count":3,"total":3,"vowels":"aeiouAEIOU"}"+```++> **Note**: See [the Manifest docs](https://hackage.haskell.org/package/extism-manifest) as it has a rich schema and a lot of options.++This plug-in was written in Rust and it does one thing, it counts vowels in a string. As such, it exposes one "export" function: `count_vowels`. We can call exports using [Extism.call](https://hackage.haskell.org/package/extism/docs/Extism.html#v:call):++All exports have a simple interface of bytes-in and bytes-out. This plug-in happens to take a string and return a JSON encoded string with a report of results.++This library also allowes for conversion of input/outputs types using [FromBytes](https://hackage.haskell.org/package/extism/docs/Extism.html#t:FromBytes) and [ToBytes](https://hackage.haskell.org/package/extism/docs/Extism.html#t:ToBytes)++### Plug-in State++Plug-ins may be stateful or stateless. Plug-ins can maintain state b/w calls by the use of variables. Our count vowels plug-in remembers the total number of vowels it's ever counted in the "total" key in the result. You can see this by making subsequent calls to the export:++```haskell+ghci> unwrap <$> call plugin "count_vowels" "Hello, world!"+{"count":3,"total":9,"vowels":"aeiouAEIOU"}+ghci> unwrap <$> call plugin "count_vowels" "Hello, world!"+{"count":3,"total":12,"vowels":"aeiouAEIOU"}+```++These variables will persist until this plug-in is freed or you initialize a new one.++### Configuration++Plug-ins may optionally take a configuration object. This is a static way to configure the plug-in. Our count-vowels plugin takes an optional configuration to change out which characters are considered vowels. Example:++```haskell+ghci> let manifest = manifest [wasm]+ghci> plugin <- unwrap <$> newPlugin manifest [] True+ghci> res <- (unwrap <$> call plugin "count_vowels" "Yellow, world!" :: String)+ghci> res+{"count":3,"total":3,"vowels":"aeiouAEIOU"}++ghci> plugin <- withConfig (manifest [wasm]) [("vowels","aeiouyAEIOUY")] ;;+ghci> res <- (unwrap <$> call plugin "count_vowels" "Yellow, world!" :: String)+ghci> res+{"count":4,"total":4,"vowels":"aeiouAEIOUY"}+```++### Host Functions++Let's extend our count-vowels example a little bit: we can intercept the results and adjust them before returning from the plugin using a `hello_world` [host function](https://extism.org/docs/concepts/host-functions)+with `wasm/code-functions.wasm`++[Host functions](https://extism.org/docs/concepts/host-functions) allow us to grant new capabilities to our plug-ins from our application. They are simply some OCaml functions you write which can be passed down and invoked from any language inside the plug-in.++Using [Extism.HostFunction.hostFunction](https://hackage.haskell.org/package/extism/docs/Extism-HostFunction.html#v:hostFunction) we can define a host function that can be called from the guest plug-in.++In this example, we want to expose a single function to our plugin (in Haskell types): `hello_world :: String -> String` which will intercept the original result and replace it with a new one.++Let's load the manifest like usual but load up `wasm/code-functions.wasm` plug-in:++```haskell+{-# LANGUAGE DeriveDataTypeable #-}++module Main where++import Extism+import Extism.HostFunction+import Extism.JSON+import Extism.Manifest (manifest, wasmFile)++newtype Count = Count {count :: Int} deriving (Data, Typeable, Show)++hello currPlugin msg = do+  putStrLn . unwrap <$> input currPlugin 0+  putStrLn "Hello from Haskell!"+  putStrLn msg+  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"+  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+-- Prints: Count {count = 999}+```++> *Note*: In order to write host functions you should get familiar with the methods on the [Extism.HostFunction](https://hackage.haskell.org/package/extism/docs/Extism-HostFunction.html) module.
+ cabal.project view
@@ -0,0 +1,1 @@+packages: extism.cabal manifest/extism-manifest.cabal
extism.cabal view
@@ -1,18 +1,18 @@ cabal-version:      3.0 name:               extism-version:            0.5.0+version:            1.0.0.0 license:            BSD-3-Clause maintainer:         oss@extism.org author:             Extism authors-bug-reports:        https://github.com/extism/extism+bug-reports:        https://github.com/extism/haskell-sdk synopsis:           Extism bindings description:        Bindings to Extism, the universal plugin system category:           Plugins, WebAssembly-extra-doc-files: CHANGELOG.md+extra-doc-files: cabal.project README.md CHANGELOG.md  library-    exposed-modules:    Extism Extism.CurrentPlugin-    reexported-modules: Extism.Manifest+    exposed-modules:    Extism, Extism.HostFunction, Extism.Encoding+    reexported-modules: Extism.Manifest, Extism.JSON     hs-source-dirs:     src     other-modules:      Extism.Bindings     default-language:   Haskell2010@@ -22,7 +22,9 @@         base              >= 4.16.1 && < 5,         bytestring        >= 0.11.3 && <= 0.12,         json              >= 0.10 && <= 0.11,-        extism-manifest   >= 0.0.0 && < 0.4.0+        extism-manifest   >= 1.0.0 && < 2.0.0,+        uuid              >= 1.3 && < 2,+        binary            >= 0.8.9 && < 0.9.0  test-suite extism-example     type:             exitcode-stdio-1.0@@ -42,4 +44,4 @@         base,         extism,         bytestring,-        HUnit+        HUnit >= 1.5.0 && < 2
src/Extism.hs view
@@ -1,60 +1,65 @@-module Extism (-  module Extism,-  module Extism.Manifest,-  ValType(..),-  Val(..)-) where+-- |+-- A Haskell Extism host+--+-- Requires a libextism installation, see [https://extism.org/docs/install](https://extism.org/docs/install)+module Extism+  ( module Extism.Manifest,+    Function (..),+    Plugin (..),+    CancelHandle (..),+    LogLevel (..),+    Error (..),+    Result (..),+    extismVersion,+    newPlugin,+    isValid,+    setConfig,+    setLogFile,+    functionExists,+    call,+    cancelHandle,+    cancel,+    pluginID,+    unwrap,+    ToBytes (..),+    Encoding,+    FromBytes (..),+    JSON (..),+  )+where +import qualified Data.ByteString as B+import Data.ByteString.Internal (c2w, unsafePackLenAddress, w2c)+import qualified Data.ByteString.Lazy as BL+import Data.ByteString.Unsafe (unsafeUseAsCString) import Data.Int+import qualified Data.UUID (UUID, fromByteString, toString) import Data.Word-import Control.Monad (void)-import Foreign.ForeignPtr+import Extism.Bindings+import Extism.Encoding+import Extism.Manifest (Manifest) import Foreign.C.String-import Foreign.Ptr+import Foreign.Concurrent+import Foreign.ForeignPtr+import Foreign.Marshal.Alloc import Foreign.Marshal.Array-import Foreign.Storable+import Foreign.Ptr 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)-import Data.Bifunctor (second)-import Text.JSON (encode, toJSObject, showJSON)-import Extism.Manifest (Manifest, toString)-import Extism.Bindings---- | Context for managing plugins-newtype Context = Context (ForeignPtr ExtismContext)+import Foreign.Storable+import GHC.Ptr+import qualified Text.JSON (Result (..), decode, encode, showJSON, toJSObject) --- | Host function-data Function = Function (ForeignPtr ExtismFunction) (StablePtr ())+-- | Host function, see 'Extism.HostFunction.hostFunction'+data Function = Function (ForeignPtr ExtismFunction) (StablePtr ()) deriving (Eq)  -- | Plugins can be used to call WASM function-data Plugin = Plugin Context Int32 [Function]+newtype Plugin = Plugin (ForeignPtr ExtismPlugin) deriving (Eq, Show)  -- | 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+newtype CancelHandle = CancelHandle (Ptr ExtismCancelHandle) deriving (Eq, Show)  -- | Log level-data LogLevel = Error | Warn | Info | Debug | Trace deriving (Show)---- | Extism error-newtype Error = ExtismError String deriving Show---- | Result type-type Result a = Either Error a---- | Helper function to convert a 'String' to a 'ByteString'-toByteString :: String -> ByteString-toByteString x = B.pack (Prelude.map c2w x)---- | Helper function to convert a 'ByteString' to a 'String'-fromByteString :: ByteString -> String-fromByteString bs = Prelude.map w2c $ B.unpack bs+data LogLevel = LogError | LogWarn | LogInfo | LogDebug | LogTrace deriving (Show, Eq)  -- | Get the Extism version string extismVersion :: () -> IO String@@ -62,168 +67,140 @@   v <- extism_version   peekCString v --- | Remove all registered plugins in a 'Context'-reset :: Context -> IO ()-reset (Context ctx) =-  withForeignPtr ctx extism_context_reset---- | Create a new 'Context'-newContext :: IO Context-newContext = do-  ptr <- extism_context_new-  fptr <- Foreign.ForeignPtr.newForeignPtr extism_context_free ptr-  return (Context fptr)+-- | Defines types that can be used to pass Wasm data into a plugin+class PluginInput a where+  pluginInput :: a -> B.ByteString --- | 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+instance PluginInput B.ByteString where+  pluginInput = id --- | 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+instance PluginInput Manifest where+  pluginInput m = toByteString $ Text.JSON.encode m  -- | Create a 'Plugin' from a WASM module, `useWasi` determines if WASI should -- | be linked-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 ->-        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 functions))---- | Create a 'Plugin' with its own 'Context'-createPlugin :: B.ByteString -> [Function] -> Bool -> IO (Result Plugin)-createPlugin c functions useWasi = do-  ctx <- newContext-  plugin ctx c functions useWasi---- | Create a 'Plugin' from a 'Manifest'-pluginFromManifest :: Context -> Manifest -> [Function] -> Bool -> IO (Result Plugin)-pluginFromManifest ctx manifest functions useWasi =-  let wasm = toByteString $ toString manifest in-  plugin ctx wasm functions useWasi---- | Create a 'Plugin' with its own 'Context' from a 'Manifest'-createPluginFromManifest :: Manifest -> [Function] -> Bool -> IO (Result Plugin)-createPluginFromManifest manifest functions useWasi = do-  ctx <- newContext-  pluginFromManifest ctx manifest functions useWasi---- | Update a 'Plugin' with a new WASM module-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-    funcs <- Prelude.mapM (\(Function ptr _ ) -> withForeignPtr ptr (\x -> do return x)) functions-    withForeignPtr ctx (\ctx' -> do-      b <- unsafeUseAsCString wasm (\s ->-        withArray funcs (\funcs ->-          extism_plugin_update ctx' id (castPtr s) length funcs nfunctions wasi))-      if b <= 0 then do-        err <- extism_error ctx' (-1)-        e <- peekCString err-        return $ Left (ExtismError e)-      else-        return (Right (Plugin (Context ctx) id functions)))---- | Update a 'Plugin' with a new 'Manifest'-updateManifest :: Plugin -> Manifest -> [Function] -> Bool -> IO (Result Plugin)-updateManifest plugin manifest functions useWasi =-  let wasm = toByteString $ toString manifest in-  update plugin wasm functions useWasi+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)+                      )  -- | Check if a 'Plugin' is valid-isValid :: Plugin -> Bool-isValid (Plugin _ p _) = p >= 0+isValid :: Plugin -> IO Bool+isValid (Plugin p) = withForeignPtr p (\x -> return (x /= nullPtr))  -- | Set configuration values for a plugin setConfig :: Plugin -> [(String, Maybe String)] -> IO Bool-setConfig (Plugin (Context ctx) plugin _) x =-  if plugin < 0-    then return False-  else-    let obj = toJSObject [(k, showJSON v) | (k, v) <- x] in-    let bs = toByteString (encode obj) in-    let length = fromIntegral (B.length bs) in-    unsafeUseAsCString bs (\s -> do-      withForeignPtr ctx (\ctx -> do-        b <- extism_plugin_config ctx plugin (castPtr s) length-        return $ b /= 0))+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+                      )+                ) -levelStr Error = "error"-levelStr Debug = "debug"-levelStr Warn = "warn"-levelStr Trace = "trace"-levelStr Info = "info"+levelStr LogError = "error"+levelStr LogDebug = "debug"+levelStr LogWarn = "warn"+levelStr LogTrace = "trace"+levelStr LogInfo = "info"  -- | 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))+  let s = levelStr level+   in withCString+        filename+        ( \f ->+            withCString+              s+              ( \l -> do+                  b <- extism_log_file f l+                  return $ b /= 0+              )+        )  -- | Check if a function exists in the given plugin functionExists :: Plugin -> String -> IO Bool-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)+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+    )  --- | Call a function provided by the given plugin-call :: Plugin -> String -> B.ByteString -> IO (Result B.ByteString)-call (Plugin (Context ctx) plugin _) name input =-  let length = fromIntegral (B.length input) in-  do-    withForeignPtr ctx (\ctx -> do-      rc <- withCString name (\name ->-        unsafeUseAsCString input (\input ->-          extism_plugin_call ctx plugin name (castPtr input) length))-      err <- extism_error ctx plugin-      if err /= nullPtr-        then do e <- peekCString err-                return $ Left (ExtismError e)-      else if rc == 0-        then do-          length <- extism_plugin_output_length ctx plugin-          ptr <- extism_plugin_output_data ctx plugin-          buf <- packCStringLen (castPtr ptr, fromIntegral length)-          return $ Right buf-      else return $ Left (ExtismError "Call failed"))---- | 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 _) =-  withForeignPtr ctx (`extism_plugin_free` 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")+            )  -- | 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 (`extism_plugin_cancel_handle` plugin)+cancelHandle (Plugin plugin) = do+  handle <- withForeignPtr plugin extism_plugin_cancel_handle   return (CancelHandle handle)  -- | Cancel a running plugin using a 'CancelHandle'@@ -231,58 +208,18 @@ 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+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+    ) --- | Get F64 'Val'-fromF64 :: Val -> Maybe Double-fromF64 (ValF64 x) = Just x-fromF64 _ = Nothing+unwrap (Right x) = x+unwrap (Left (ExtismError msg)) =+  error msg
src/Extism/Bindings.hs view
@@ -1,25 +1,36 @@+{-# LANGUAGE DerivingStrategies #-} {-# LANGUAGE ForeignFunctionInterface #-} +-- |+--   Contains low-level bindings to the Extism SDK module Extism.Bindings where -import Foreign.C.Types-import Foreign.Ptr-import Foreign.C.String import Data.Int import Data.Word-import Foreign.Storable+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 ExtismContext = ExtismContext () deriving Show-newtype ExtismFunction = ExtismFunction () deriving Show-newtype ExtismCancelHandle = ExtismCancelHandle () deriving Show-newtype ExtismCurrentPlugin = ExtismCurrentPlugin () deriving Show+newtype ExtismPlugin = ExtismPlugin () deriving (Show)++newtype ExtismFunction = ExtismFunction () deriving (Show)++newtype ExtismCancelHandle = ExtismCancelHandle () deriving (Show)++newtype ExtismCurrentPlugin = ExtismCurrentPlugin () 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@@ -41,16 +52,16 @@       I64 -> ValI64 <$> peekByteOff ptr offs       F32 -> ValF32 <$> peekByteOff ptr offs       F64 -> ValF64 <$> peekByteOff ptr offs-  poke ptr x = do+      _ -> error "Unsupported val type"+  poke ptr a = do     let offs = if _32Bit then 4 else 8-    pokeByteOff ptr 0 (typeOfVal x)-    case x of+    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@@ -76,36 +87,54 @@   peek ptr = do     x <- peekByteOff ptr 0     return $ valTypeOfInt (x :: CInt)-  poke ptr x = do+  poke ptr x =     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-foreign import ccall safe "extism.h extism_plugin_update" extism_plugin_update :: Ptr ExtismContext -> Int32 -> Ptr Word8 -> Word64 -> Ptr (Ptr ExtismFunction) -> Word64 -> CBool -> IO CBool-foreign import ccall safe "extism.h extism_plugin_call" extism_plugin_call :: Ptr ExtismContext -> Int32 -> CString -> Ptr Word8 -> Word64 -> IO Int32-foreign import ccall safe "extism.h extism_plugin_function_exists" extism_plugin_function_exists :: Ptr ExtismContext -> Int32 -> CString -> IO CBool-foreign import ccall safe "extism.h extism_error" extism_error :: Ptr ExtismContext -> Int32 -> IO CString-foreign import ccall safe "extism.h extism_plugin_output_length" extism_plugin_output_length :: Ptr ExtismContext -> Int32 -> IO Word64-foreign import ccall safe "extism.h extism_plugin_output_data" extism_plugin_output_data :: Ptr ExtismContext -> Int32 -> IO (Ptr Word8)+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_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 ExtismContext -> Int32 -> Ptr Word8 -> Int64 -> IO CBool-foreign import ccall safe "extism.h extism_plugin_free" extism_plugin_free :: Ptr ExtismContext -> Int32 -> IO ()-foreign import ccall safe "extism.h extism_context_reset" extism_context_reset :: Ptr ExtismContext -> IO ()++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_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_cancel_handle" extism_plugin_cancel_handle :: Ptr ExtismContext -> Int32 -> 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_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_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+  (_, b, c) <- deRefStablePtr s   freeHaskellFunPtr b   freeHaskellFunPtr c   freeStablePtr s@@ -113,10 +142,3 @@ 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
− src/Extism/CurrentPlugin.hs
@@ -1,48 +0,0 @@-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-
+ src/Extism/Encoding.hs view
@@ -0,0 +1,139 @@+{-# LANGUAGE FlexibleInstances #-}++-- |+-- Extism.Encoding handles how values are encoded to be copied in and out of Wasm linear memory+module Extism.Encoding+  ( fromByteString,+    toByteString,+    Error (..),+    Result (..),+    ToBytes (..),+    FromBytes (..),+    Encoding (..),+    JSON (..),+  )+where++import Data.Binary.Get (getDoublele, getFloatle, getInt32le, getInt64le, getWord32le, getWord64le, runGetOrFail)+import Data.Binary.Put (putDoublele, putFloatle, putInt32le, putInt64le, putWord32le, putWord64le, runPut)+import qualified Data.ByteString as B+import Data.ByteString.Internal (c2w, unsafePackLenAddress, w2c)+import Data.Int+import Data.Word+import qualified Text.JSON (JSValue, Result (..), decode, encode, showJSON, toJSObject)+import qualified Text.JSON.Generic (Data, decodeJSON, encodeJSON, fromJSON, toJSON)++-- | Helper function to convert a 'String' to a 'ByteString'+toByteString :: String -> B.ByteString+toByteString x = B.pack (map c2w x)++-- | Helper function to convert a 'ByteString' to a 'String'+fromByteString :: B.ByteString -> String+fromByteString bs = map w2c $ B.unpack bs++-- | Extism error+newtype Error = ExtismError String deriving (Show, Eq)++-- | Result type+type Result a = Either Error a++-- Used to convert a value into linear memory+class ToBytes a where+  toBytes :: a -> B.ByteString++-- Used to read a value from linear memory+class FromBytes a where+  fromBytes :: B.ByteString -> Result a++-- Encoding is used to indicate a type implements both `ToBytes` and `FromBytes`+class (ToBytes a, FromBytes a) => Encoding a++instance ToBytes () where+  toBytes () = toByteString ""++instance FromBytes () where+  fromBytes _ = Right ()++instance ToBytes B.ByteString where+  toBytes x = x++instance FromBytes B.ByteString where+  fromBytes = Right++instance ToBytes [Char] where+  toBytes = toByteString++instance FromBytes [Char] where+  fromBytes bs =+    Right $ fromByteString bs++instance ToBytes Int32 where+  toBytes i = B.toStrict (runPut (putInt32le i))++instance FromBytes Int32 where+  fromBytes bs =+    case runGetOrFail getInt32le (B.fromStrict bs) of+      Left (_, _, e) -> Left (ExtismError e)+      Right (_, _, x) -> Right x++instance ToBytes Int64 where+  toBytes i = B.toStrict (runPut (putInt64le i))++instance FromBytes Int64 where+  fromBytes bs =+    case runGetOrFail getInt64le (B.fromStrict bs) of+      Left (_, _, e) -> Left (ExtismError e)+      Right (_, _, x) -> Right x++instance ToBytes Word32 where+  toBytes i = B.toStrict (runPut (putWord32le i))++instance FromBytes Word32 where+  fromBytes bs =+    case runGetOrFail getWord32le (B.fromStrict bs) of+      Left (_, _, e) -> Left (ExtismError e)+      Right (_, _, x) -> Right x++instance ToBytes Word64 where+  toBytes i = B.toStrict (runPut (putWord64le i))++instance FromBytes Word64 where+  fromBytes bs =+    case runGetOrFail getWord64le (B.fromStrict bs) of+      Left (_, _, e) -> Left (ExtismError e)+      Right (_, _, x) -> Right x++instance ToBytes Float where+  toBytes i = B.toStrict (runPut (putFloatle i))++instance FromBytes Float where+  fromBytes bs =+    case runGetOrFail getFloatle (B.fromStrict bs) of+      Left (_, _, e) -> Left (ExtismError e)+      Right (_, _, x) -> Right x++instance ToBytes Double where+  toBytes i = B.toStrict (runPut (putDoublele i))++instance FromBytes Double where+  fromBytes bs =+    case runGetOrFail getDoublele (B.fromStrict bs) of+      Left (_, _, e) -> Left (ExtismError e)+      Right (_, _, x) -> Right x++-- Wraps a `JSON` value for input/output+newtype JSON x = JSON x++instance (Text.JSON.Generic.Data a) => ToBytes (JSON a) where+  toBytes (JSON x) =+    toByteString $ Text.JSON.Generic.encodeJSON x++instance (Text.JSON.Generic.Data a) => FromBytes (JSON a) where+  fromBytes bs =+    let x = Text.JSON.decode (fromByteString bs)+     in case x of+          Text.JSON.Error e -> Left (ExtismError e)+          Text.JSON.Ok x ->+            case Text.JSON.Generic.fromJSON (x :: Text.JSON.JSValue) of+              Text.JSON.Error e -> Left (ExtismError e)+              Text.JSON.Ok x -> Right (JSON x)
+ src/Extism/HostFunction.hs view
@@ -0,0 +1,230 @@+{-# LANGUAGE BangPatterns #-}+{-# LANGUAGE DerivingStrategies #-}+{-# LANGUAGE GeneralizedNewtypeDeriving #-}++module Extism.HostFunction+  ( CurrentPlugin (..),+    ValType (..),+    Val (..),+    MemoryHandle,+    memoryAlloc,+    memoryLength,+    memoryFree,+    memory,+    memoryOffset,+    memoryBytes,+    memoryString,+    memoryGet,+    allocBytes,+    allocString,+    alloc,+    toI32,+    toI64,+    toF32,+    toF64,+    fromI32,+    fromI64,+    fromF32,+    fromF64,+    hostFunction,+    hostFunction',+    input,+    output,+    getParams,+    setResults,+    ptr,+  )+where++import qualified Data.ByteString as B+import qualified Data.ByteString.Internal as BS (c2w, unsafePackLenAddress)+import Data.IORef+import Data.Word+import Extism+import Extism.Bindings+import Extism.Encoding+import Foreign.C.String+import Foreign.Concurrent+import Foreign.ForeignPtr+import Foreign.Marshal.Array+import Foreign.Ptr+import Foreign.StablePtr+import Foreign.Storable+import GHC.Ptr++ptr :: ValType+ptr = I64++-- | Access the plugin that is currently executing from inside a host function+data CurrentPlugin = CurrentPlugin (Ptr ExtismCurrentPlugin) [Val] (Ptr Val) Int++-- | A memory handle represents an allocated block of Extism memory+newtype MemoryHandle = MemoryHandle Word64 deriving (Num, Enum, Eq, Ord, Real, Integral, Show)++-- | Allocate a new handle of the given size+memoryAlloc :: CurrentPlugin -> Word64 -> IO MemoryHandle+memoryAlloc (CurrentPlugin p _ _ _) n = MemoryHandle <$> extism_current_plugin_memory_alloc p n++-- | Get the length of a handle, returns 0 if the handle is invalid+memoryLength :: CurrentPlugin -> MemoryHandle -> IO Word64+memoryLength (CurrentPlugin p _ _ _) (MemoryHandle offs) = extism_current_plugin_memory_length p offs++-- | Free allocated memory+memoryFree :: CurrentPlugin -> MemoryHandle -> IO ()+memoryFree (CurrentPlugin p _ _ _) (MemoryHandle offs) = extism_current_plugin_memory_free p offs++-- | Access a pointer to the entire memory region+memory :: CurrentPlugin -> IO (Ptr Word8)+memory (CurrentPlugin p _ _ _) = extism_current_plugin_memory p++-- | Access the pointer for the given 'MemoryHandle'+memoryOffset :: CurrentPlugin -> MemoryHandle -> IO (Ptr Word8)+memoryOffset (CurrentPlugin plugin _ _ _) (MemoryHandle 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 -> MemoryHandle -> IO B.ByteString+memoryBytes plugin offs = do+  Ptr ptr <- memoryOffset plugin offs+  len <- memoryLength plugin offs+  BS.unsafePackLenAddress (fromIntegral len) ptr++-- | Access the data associated with a handle as a 'String'+memoryString :: CurrentPlugin -> MemoryHandle -> IO String+memoryString plugin offs = do+  fromByteString <$> memoryBytes plugin offs++-- | Access the data associated with a handle and convert it into a Haskell type+memoryGet :: (FromBytes a) => CurrentPlugin -> MemoryHandle -> IO (Result a)+memoryGet plugin offs = do+  x <- memoryBytes plugin offs+  return $ fromBytes x++-- | Allocate memory and copy an existing 'ByteString' into it+allocBytes :: CurrentPlugin -> B.ByteString -> IO MemoryHandle+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++-- | Allocate memory and copy an existing 'String' into it+allocString :: CurrentPlugin -> String -> IO MemoryHandle+allocString plugin s = do+  let length = Prelude.length s+  offs <- memoryAlloc plugin (fromIntegral length)+  ptr <- memoryOffset plugin offs+  pokeArray ptr (Prelude.map BS.c2w s)+  return offs++alloc :: (ToBytes a) => CurrentPlugin -> a -> IO MemoryHandle+alloc plugin x =+  let a = toBytes x+   in allocBytes plugin a++-- | 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++setResults :: CurrentPlugin -> [Val] -> IO ()+setResults (CurrentPlugin _ _ res _) = pokeArray res++getParams :: CurrentPlugin -> [Val]+getParams (CurrentPlugin _ params _ _) = params++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)++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)++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+  (userData, _, _) <- deRefStablePtr (castPtrToStablePtr ptr)+  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+            cb <- callbackWrap (callback f)+            free <- freePtrWrap freePtr+            userData <- newStablePtr (v, free, cb)+            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)++-- | 'hostFunction "function_name" inputTypes outputTypes callback userData' creates a new+-- | 'Function' in the default namespace that can be called from a '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' :: String -> String -> [ValType] -> [ValType] -> (CurrentPlugin -> a -> IO ()) -> a -> IO Function+hostFunction' ns = hostFunctionWithNamespace' (Just ns)
test/Test.hs view
@@ -1,84 +1,73 @@-import Test.HUnit import Extism+import Extism.HostFunction import Extism.Manifest-import Extism.CurrentPlugin-+import Test.HUnit -unwrap (Right x) = return x-unwrap (Left (ExtismError msg)) =+assertUnwrap (Right x) = return x+assertUnwrap (Left (ExtismError msg)) =   assertFailure msg -defaultManifest = manifest [wasmFile "../../wasm/code.wasm"]-hostFunctionManifest = manifest [wasmFile "../../wasm/code-functions.wasm"]+defaultManifest = manifest [wasmFile "../wasm/code.wasm"] -initPlugin :: Maybe Context -> IO Plugin-initPlugin Nothing =-  Extism.createPluginFromManifest defaultManifest [] False >>= unwrap-initPlugin (Just ctx) =-  Extism.pluginFromManifest ctx defaultManifest [] False >>= unwrap+hostFunctionManifest = manifest [wasmFile "../wasm/code-functions.wasm"] +initPlugin :: IO Plugin+initPlugin =+  Extism.newPlugin defaultManifest [] False >>= assertUnwrap+ pluginFunctionExists = do-  p <- initPlugin Nothing+  p <- initPlugin   exists <- functionExists p "count_vowels"   assertBool "function exists" exists   exists' <- functionExists p "function_doesnt_exist"   assertBool "function doesn't exist" (not exists')  checkCallResult p = do-  res <- call p "count_vowels" (toByteString "this is a test") >>= unwrap-  assertEqual "count vowels output" "{\"count\": 4}" (fromByteString res)+  res <- call p "count_vowels" "this is a test" >>= assertUnwrap+  assertEqual "count vowels output" "{\"count\": 4}" res  pluginCall = do-  p <- initPlugin Nothing+  p <- initPlugin   checkCallResult p --hello plugin params () = do+hello plugin () = do+  s <- unwrap <$> input plugin 0+  assertEqual "host function input" "{\"count\": 4}" s   putStrLn "Hello from Haskell!"-  offs <- allocBytes plugin (toByteString "{\"count\": 999}")-  return [toI64 offs]+  output plugin 0 "{\"count\": 999}"  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)+  p <- Extism.newPlugin hostFunctionManifest [] False >>= assertUnwrap+  res <- call p "count_vowels" "this is a test" >>= assertUnwrap+  assertEqual "count vowels output" "{\"count\": 999}" res  pluginMultiple = do-  withContext(\ctx -> do-    p <- initPlugin (Just ctx)-    checkCallResult p-    q <- initPlugin (Just ctx)-    r <- initPlugin (Just ctx)-    checkCallResult q-    checkCallResult r)--pluginUpdate = do-  withContext (\ctx -> do-    p <- initPlugin (Just ctx)-    updateManifest p defaultManifest [] True >>= unwrap-    checkCallResult p)+  p <- initPlugin+  checkCallResult p+  q <- initPlugin+  r <- initPlugin+  checkCallResult q+  checkCallResult r  pluginConfig = do-  withContext (\ctx -> do-    p <- initPlugin (Just ctx)-    b <- setConfig p [("a", Just "1"), ("b", Just "2"), ("c", Just "3"), ("d", Nothing)]-    assertBool "set config" b)+  p <- initPlugin+  b <- setConfig p [("a", Just "1"), ("b", Just "2"), ("c", Just "3"), ("d", Nothing)]+  assertBool "set config" b  testSetLogFile = do-  b <- setLogFile "stderr" Extism.Error+  b <- setLogFile "stderr" Extism.LogError   assertBool "set log file" b  t name f = TestLabel name (TestCase f)  main = do-  runTestTT (TestList-    [-      t "Plugin.FunctionExists" pluginFunctionExists-      , t "Plugin.Call" pluginCall-      , t "Plugin.CallHostFunction" pluginCallHostFunction-      , t "Plugin.Multiple" pluginMultiple-      , t "Plugin.Update" pluginUpdate-      , t "Plugin.Config" pluginConfig-      , t "SetLogFile" testSetLogFile-    ])-+  runTestTT+    ( TestList+        [ t "Plugin.FunctionExists" pluginFunctionExists,+          t "Plugin.Call" pluginCall,+          t "Plugin.CallHostFunction" pluginCallHostFunction,+          t "Plugin.Multiple" pluginMultiple,+          t "Plugin.Config" pluginConfig,+          t "SetLogFile" testSetLogFile+        ]+    )