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 +4/−0
- Example.hs +17/−15
- README.md +129/−0
- cabal.project +1/−0
- extism.cabal +9/−7
- src/Extism.hs +173/−236
- src/Extism/Bindings.hs +56/−34
- src/Extism/CurrentPlugin.hs +0/−48
- src/Extism/Encoding.hs +139/−0
- src/Extism/HostFunction.hs +230/−0
- test/Test.hs +41/−52
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+ ]+ )