extism-1.3.0.0: src/Extism.hs

-- |
-- A Haskell Extism host
--
-- Requires a libextism installation, see [https://extism.org/docs/install](https://extism.org/docs/install)
module Extism
  ( module Extism.Manifest,
    module Extism.Encoding,
    Function (..),
    Plugin (..),
    CancelHandle (..),
    LogLevel (..),
    Error (..),
    Result (..),
    extismVersion,
    newPlugin,
    newCompiledPlugin,
    newPluginFromCompiled,
    isValid,
    setConfig,
    setLogFile,
    functionExists,
    call,
    call',
    callWithHostContext,
    callWithHostContext',
    cancelHandle,
    cancel,
    pluginID,
    unwrap,
    ToBytes (..),
    FromBytes (..),
    JSON (..),
    PluginInput (..),
    reset,
  )
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 Extism.Bindings
import Extism.Encoding
import Extism.JSON
import Extism.Manifest (Manifest)
import Foreign.C.String
import Foreign.Concurrent
import Foreign.ForeignPtr
import Foreign.Marshal.Alloc
import Foreign.Marshal.Array
import Foreign.Ptr
import Foreign.StablePtr
import Foreign.Storable
import GHC.Ptr
import qualified Text.JSON (JSValue (JSNull, JSString), Result (..), decode, encode, toJSObject, toJSString)

-- | Host function, see 'Extism.HostFunction.hostFunction'
data Function = Function (ForeignPtr ExtismFunction) (StablePtr ()) deriving (Eq)

-- | Plugins can be used to call WASM function
newtype Plugin = Plugin (ForeignPtr ExtismPlugin) deriving (Eq, Show)

-- | CompiledPlugins can be used to create multiple plugin instances from a single pre-compiled plugin
newtype CompiledPlugin = CompiledPlugin (ForeignPtr ExtismCompiledPlugin) deriving (Eq, Show)

-- | Cancellation handle for Plugins
newtype CancelHandle = CancelHandle (Ptr ExtismCancelHandle) deriving (Eq, Show)

-- | Log level
data LogLevel = LogError | LogWarn | LogInfo | LogDebug | LogTrace deriving (Show, Eq)

-- | Get the Extism version string
extismVersion :: () -> IO String
extismVersion () = do
  v <- extism_version
  peekCString v

-- | Defines types that can be used to pass Wasm data into a plugin
class PluginInput a where
  pluginInput :: a -> B.ByteString

instance PluginInput B.ByteString where
  pluginInput = id

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
newPlugin :: (PluginInput a) => a -> [Function] -> Bool -> IO (Result Plugin)
newPlugin input functions useWasi = do
  funcs <- mapM (\(Function ptr _) -> withForeignPtr ptr return) functions
  alloca $ \e -> do
    let errmsg = (e :: Ptr CString)
    p <- unsafeUseAsCString wasm $ \s ->
      withArray funcs $ \funcs ->
        extism_plugin_new (castPtr s) length' funcs nfunctions wasi errmsg

    if p == nullPtr
      then do
        err <- peek errmsg
        e <- peekCString err
        extism_plugin_new_error_free err
        return $ Left (ExtismError e)
      else do
        ptr <- Foreign.Concurrent.newForeignPtr p (extism_plugin_free p)
        return $ Right (Plugin ptr)
  where
    wasm = pluginInput input
    nfunctions = fromIntegral (length functions)
    length' = fromIntegral (B.length wasm)
    wasi = fromInteger (if useWasi then 1 else 0)

-- | Create a 'Plugin' from a WASM module, `useWasi` determines if WASI should
-- | be linked
newCompiledPlugin :: (PluginInput a) => a -> [Function] -> Bool -> IO (Result CompiledPlugin)
newCompiledPlugin input functions useWasi = do
  funcs <- mapM (\(Function ptr _) -> withForeignPtr ptr return) functions
  alloca $ \e -> do
    let errmsg = (e :: Ptr CString)
    p <- unsafeUseAsCString wasm $ \s ->
      withArray funcs $ \funcs ->
        extism_compiled_plugin_new (castPtr s) length' funcs nfunctions wasi errmsg

    if p == nullPtr
      then do
        err <- peek errmsg
        e <- peekCString err
        extism_plugin_new_error_free err
        return $ Left (ExtismError e)
      else do
        ptr <- Foreign.Concurrent.newForeignPtr p (extism_compiled_plugin_free p)
        return $ Right (CompiledPlugin ptr)
  where
    wasm = pluginInput input
    nfunctions = fromIntegral (length functions)
    length' = fromIntegral (B.length wasm)
    wasi = fromInteger (if useWasi then 1 else 0)

-- | Create a new plugin from a `CompiledPlugin`
newPluginFromCompiled :: CompiledPlugin -> IO (Result Plugin)
newPluginFromCompiled (CompiledPlugin compiled) = do
  alloca $ \e -> do
    let errmsg = (e :: Ptr CString)
    p <- withForeignPtr compiled $ \c ->
      extism_plugin_new_from_compiled c errmsg
    if p == nullPtr
      then do
        err <- peek errmsg
        e <- peekCString err
        extism_plugin_new_error_free err
        return $ Left (ExtismError e)
      else do
        ptr <- Foreign.Concurrent.newForeignPtr p (extism_plugin_free p)
        return $ Right (Plugin ptr)

-- | Same as `newPlugin` but converts the error case to an exception
newPlugin' :: (PluginInput a) => a -> [Function] -> Bool -> IO Plugin
newPlugin' input functions useWasi = do
  unwrap <$> newPlugin input functions useWasi

-- | Same as `newPluginFromCompiled` but converts the error case to an exception
newPluginFromCompiled' :: CompiledPlugin -> IO Plugin
newPluginFromCompiled' c =
  unwrap <$> newPluginFromCompiled c

-- | Check if a 'Plugin' is valid
isValid :: Plugin -> IO Bool
isValid (Plugin p) = withForeignPtr p (\x -> return (x /= nullPtr))

-- | Set configuration values for a plugin
setConfig :: Plugin -> [(String, Maybe String)] -> IO Bool
setConfig (Plugin plugin) x =
  unsafeUseAsCString bs $ \s ->
    withForeignPtr plugin $ \plugin' -> do
      b <- extism_plugin_config plugin' (castPtr s) length'
      print b
      return $ b /= 0
  where
    mk = maybe Text.JSON.JSNull (Text.JSON.JSString . Text.JSON.toJSString)
    obj = Text.JSON.toJSObject [(k, mk v) | (k, v) <- x]
    bs = toByteString (Text.JSON.encode obj)
    length' = fromIntegral (B.length bs)

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 =
  withCString filename $ \f ->
    withCString s $ \l -> do
      b <- extism_log_file f l
      return $ b /= 0
  where
    s = levelStr level

-- | Check if a function exists in the given plugin
functionExists :: Plugin -> String -> IO Bool
functionExists (Plugin plugin) name =
  withForeignPtr plugin $ \plugin' -> do
    b <- withCString name (extism_plugin_function_exists plugin')
    if b == 1 then return True else return False

--- | Call a function provided by the given plugin
call :: (ToBytes a, FromBytes b) => Plugin -> String -> a -> IO (Result b)
call (Plugin plugin) name inp =
  withForeignPtr plugin $ \plugin' -> do
    rc <- withCString name $ \name' ->
      unsafeUseAsCString input $ \input' ->
        extism_plugin_call plugin' name' (castPtr input') length'
    err <- extism_error plugin'
    if err /= nullPtr
      then do
        e <- peekCString err
        return $ Left (ExtismError e)
      else
        if rc == 0
          then do
            len <- extism_plugin_output_length plugin'
            Ptr ptr <- extism_plugin_output_data plugin'
            x <- unsafePackLenAddress (fromIntegral len) ptr
            return $ fromBytes x
          else return $ Left (ExtismError "Call failed")
  where
    input = toBytes inp
    length' = fromIntegral (B.length input)

call' :: (ToBytes a, FromBytes b) => Plugin -> String -> a -> IO b
call' plugin name inp = do
  unwrap <$> call plugin name inp

--- | Call a function provided by the given plugin with a host context value
callWithHostContext :: (ToBytes a, FromBytes b) => Plugin -> String -> a -> c -> IO (Result b)
callWithHostContext (Plugin plugin) name inp ctx =
  withForeignPtr plugin $ \plugin' -> do
    sptr <- newStablePtr ctx
    let ptr = castStablePtrToPtr sptr
    rc <- withCString name $ \name' ->
      unsafeUseAsCString input $ \input' ->
        extism_plugin_call_with_host_context plugin' name' (castPtr input') length' ptr
    freeStablePtr sptr
    err <- extism_error plugin'
    if err /= nullPtr
      then do
        e <- peekCString err
        return $ Left (ExtismError e)
      else
        if rc == 0
          then do
            len <- extism_plugin_output_length plugin'
            Ptr ptr <- extism_plugin_output_data plugin'
            x <- unsafePackLenAddress (fromIntegral len) ptr
            return $ fromBytes x
          else return $ Left (ExtismError "Call failed")
  where
    input = toBytes inp
    length' = fromIntegral (B.length input)

callWithHostContext' :: (ToBytes a, FromBytes b) => Plugin -> String -> a -> c -> IO b
callWithHostContext' plugin name inp ctx = do
  unwrap <$> callWithHostContext plugin name inp ctx

-- | Create a new 'CancelHandle' that can be used to cancel a running plugin
-- | from another thread.
cancelHandle :: Plugin -> IO CancelHandle
cancelHandle (Plugin plugin) = do
  handle <- withForeignPtr plugin extism_plugin_cancel_handle
  return (CancelHandle handle)

-- | Cancel a running plugin using a 'CancelHandle'
cancel :: CancelHandle -> IO Bool
cancel (CancelHandle handle) =
  extism_plugin_cancel handle

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

reset :: Plugin -> IO ()
reset (Plugin plugin) =
  withForeignPtr plugin extism_plugin_reset

unwrap (Right x) = x
unwrap (Left (ExtismError msg)) =
  error msg