-- |
-- 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 Extism.Bindings
import Extism.Encoding
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 (Result (..), decode, encode, showJSON, toJSObject)

-- | Host function, see 'Extism.HostFunction.hostFunction'
data Function = Function (ForeignPtr ExtismFunction) (StablePtr ()) deriving (Function -> Function -> Bool
(Function -> Function -> Bool)
-> (Function -> Function -> Bool) -> Eq Function
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Function -> Function -> Bool
== :: Function -> Function -> Bool
$c/= :: Function -> Function -> Bool
/= :: Function -> Function -> Bool
Eq)

-- | Plugins can be used to call WASM function
newtype Plugin = Plugin (ForeignPtr ExtismPlugin) deriving (Plugin -> Plugin -> Bool
(Plugin -> Plugin -> Bool)
-> (Plugin -> Plugin -> Bool) -> Eq Plugin
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Plugin -> Plugin -> Bool
== :: Plugin -> Plugin -> Bool
$c/= :: Plugin -> Plugin -> Bool
/= :: Plugin -> Plugin -> Bool
Eq, Int -> Plugin -> ShowS
[Plugin] -> ShowS
Plugin -> String
(Int -> Plugin -> ShowS)
-> (Plugin -> String) -> ([Plugin] -> ShowS) -> Show Plugin
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Plugin -> ShowS
showsPrec :: Int -> Plugin -> ShowS
$cshow :: Plugin -> String
show :: Plugin -> String
$cshowList :: [Plugin] -> ShowS
showList :: [Plugin] -> ShowS
Show)

-- | Cancellation handle for Plugins
newtype CancelHandle = CancelHandle (Ptr ExtismCancelHandle) deriving (CancelHandle -> CancelHandle -> Bool
(CancelHandle -> CancelHandle -> Bool)
-> (CancelHandle -> CancelHandle -> Bool) -> Eq CancelHandle
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: CancelHandle -> CancelHandle -> Bool
== :: CancelHandle -> CancelHandle -> Bool
$c/= :: CancelHandle -> CancelHandle -> Bool
/= :: CancelHandle -> CancelHandle -> Bool
Eq, Int -> CancelHandle -> ShowS
[CancelHandle] -> ShowS
CancelHandle -> String
(Int -> CancelHandle -> ShowS)
-> (CancelHandle -> String)
-> ([CancelHandle] -> ShowS)
-> Show CancelHandle
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> CancelHandle -> ShowS
showsPrec :: Int -> CancelHandle -> ShowS
$cshow :: CancelHandle -> String
show :: CancelHandle -> String
$cshowList :: [CancelHandle] -> ShowS
showList :: [CancelHandle] -> ShowS
Show)

-- | Log level
data LogLevel = LogError | LogWarn | LogInfo | LogDebug | LogTrace deriving (Int -> LogLevel -> ShowS
[LogLevel] -> ShowS
LogLevel -> String
(Int -> LogLevel -> ShowS)
-> (LogLevel -> String) -> ([LogLevel] -> ShowS) -> Show LogLevel
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> LogLevel -> ShowS
showsPrec :: Int -> LogLevel -> ShowS
$cshow :: LogLevel -> String
show :: LogLevel -> String
$cshowList :: [LogLevel] -> ShowS
showList :: [LogLevel] -> ShowS
Show, LogLevel -> LogLevel -> Bool
(LogLevel -> LogLevel -> Bool)
-> (LogLevel -> LogLevel -> Bool) -> Eq LogLevel
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: LogLevel -> LogLevel -> Bool
== :: LogLevel -> LogLevel -> Bool
$c/= :: LogLevel -> LogLevel -> Bool
/= :: LogLevel -> LogLevel -> Bool
Eq)

-- | Get the Extism version string
extismVersion :: () -> IO String
extismVersion :: () -> IO String
extismVersion () = do
  CString
v <- IO CString
extism_version
  CString -> IO String
peekCString CString
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 :: ByteString -> ByteString
pluginInput = ByteString -> ByteString
forall a. a -> a
id

instance PluginInput Manifest where
  pluginInput :: Manifest -> ByteString
pluginInput Manifest
m = String -> ByteString
toByteString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Manifest -> String
forall a. JSON a => a -> String
Text.JSON.encode Manifest
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 :: forall a.
PluginInput a =>
a -> [Function] -> Bool -> IO (Result Plugin)
newPlugin a
input [Function]
functions Bool
useWasi =
  let wasm :: ByteString
wasm = a -> ByteString
forall a. PluginInput a => a -> ByteString
pluginInput a
input
   in let nfunctions :: Word64
nfunctions = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral ([Function] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Function]
functions)
       in let length' :: Word64
length' = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
wasm)
           in let wasi :: CBool
wasi = Integer -> CBool
forall a. Num a => Integer -> a
fromInteger (if Bool
useWasi then Integer
1 else Integer
0)
               in do
                    [Ptr ExtismFunction]
funcs <- (Function -> IO (Ptr ExtismFunction))
-> [Function] -> IO [Ptr ExtismFunction]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
forall (m :: * -> *) a b. Monad m => (a -> m b) -> [a] -> m [b]
mapM (\(Function ForeignPtr ExtismFunction
ptr StablePtr ()
_) -> ForeignPtr ExtismFunction
-> (Ptr ExtismFunction -> IO (Ptr ExtismFunction))
-> IO (Ptr ExtismFunction)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismFunction
ptr Ptr ExtismFunction -> IO (Ptr ExtismFunction)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return) [Function]
functions
                    (Ptr CString -> IO (Result Plugin)) -> IO (Result Plugin)
forall a b. Storable a => (Ptr a -> IO b) -> IO b
alloca
                      ( \Ptr CString
e -> do
                          let errmsg :: Ptr CString
errmsg = (Ptr CString
e :: Ptr CString)
                          Ptr ExtismPlugin
p <-
                            ByteString
-> (CString -> IO (Ptr ExtismPlugin)) -> IO (Ptr ExtismPlugin)
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString
                              ByteString
wasm
                              ( \CString
s ->
                                  [Ptr ExtismFunction]
-> (Ptr (Ptr ExtismFunction) -> IO (Ptr ExtismPlugin))
-> IO (Ptr ExtismPlugin)
forall a b. Storable a => [a] -> (Ptr a -> IO b) -> IO b
withArray
                                    [Ptr ExtismFunction]
funcs
                                    ( \Ptr (Ptr ExtismFunction)
funcs ->
                                        Ptr Word8
-> Word64
-> Ptr (Ptr ExtismFunction)
-> Word64
-> CBool
-> Ptr CString
-> IO (Ptr ExtismPlugin)
extism_plugin_new (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
s) Word64
length' Ptr (Ptr ExtismFunction)
funcs Word64
nfunctions CBool
wasi Ptr CString
errmsg
                                    )
                              )
                          if Ptr ExtismPlugin
p Ptr ExtismPlugin -> Ptr ExtismPlugin -> Bool
forall a. Eq a => a -> a -> Bool
== Ptr ExtismPlugin
forall a. Ptr a
nullPtr
                            then do
                              CString
err <- Ptr CString -> IO CString
forall a. Storable a => Ptr a -> IO a
peek Ptr CString
errmsg
                              String
e <- CString -> IO String
peekCString CString
err
                              CString -> IO ()
extism_plugin_new_error_free CString
err
                              Result Plugin -> IO (Result Plugin)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result Plugin -> IO (Result Plugin))
-> Result Plugin -> IO (Result Plugin)
forall a b. (a -> b) -> a -> b
$ Error -> Result Plugin
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
                            else do
                              ForeignPtr ExtismPlugin
ptr <- Ptr ExtismPlugin -> IO () -> IO (ForeignPtr ExtismPlugin)
forall a. Ptr a -> IO () -> IO (ForeignPtr a)
Foreign.Concurrent.newForeignPtr Ptr ExtismPlugin
p (Ptr ExtismPlugin -> IO ()
extism_plugin_free Ptr ExtismPlugin
p)
                              Result Plugin -> IO (Result Plugin)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result Plugin -> IO (Result Plugin))
-> Result Plugin -> IO (Result Plugin)
forall a b. (a -> b) -> a -> b
$ Plugin -> Result Plugin
forall a b. b -> Either a b
Right (ForeignPtr ExtismPlugin -> Plugin
Plugin ForeignPtr ExtismPlugin
ptr)
                      )

-- | Check if a 'Plugin' is valid
isValid :: Plugin -> IO Bool
isValid :: Plugin -> IO Bool
isValid (Plugin ForeignPtr ExtismPlugin
p) = ForeignPtr ExtismPlugin -> (Ptr ExtismPlugin -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismPlugin
p (\Ptr ExtismPlugin
x -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ExtismPlugin
x Ptr ExtismPlugin -> Ptr ExtismPlugin -> Bool
forall a. Eq a => a -> a -> Bool
/= Ptr ExtismPlugin
forall a. Ptr a
nullPtr))

-- | Set configuration values for a plugin
setConfig :: Plugin -> [(String, Maybe String)] -> IO Bool
setConfig :: Plugin -> [(String, Maybe String)] -> IO Bool
setConfig (Plugin ForeignPtr ExtismPlugin
plugin) [(String, Maybe String)]
x =
  let obj :: JSObject JSValue
obj = [(String, JSValue)] -> JSObject JSValue
forall a. [(String, a)] -> JSObject a
Text.JSON.toJSObject [(String
k, Maybe String -> JSValue
forall a. JSON a => a -> JSValue
Text.JSON.showJSON Maybe String
v) | (String
k, Maybe String
v) <- [(String, Maybe String)]
x]
   in let bs :: ByteString
bs = String -> ByteString
toByteString (JSObject JSValue -> String
forall a. JSON a => a -> String
Text.JSON.encode JSObject JSValue
obj)
       in let length' :: Int64
length' = Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs)
           in ByteString -> (CString -> IO Bool) -> IO Bool
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString
                ByteString
bs
                ( \CString
s ->
                    ForeignPtr ExtismPlugin -> (Ptr ExtismPlugin -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr
                      ForeignPtr ExtismPlugin
plugin
                      ( \Ptr ExtismPlugin
plugin' -> do
                          CBool
b <- Ptr ExtismPlugin -> Ptr Word8 -> Int64 -> IO CBool
extism_plugin_config Ptr ExtismPlugin
plugin' (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
s) Int64
length'
                          Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CBool
b CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
/= CBool
0
                      )
                )

levelStr :: LogLevel -> String
levelStr LogLevel
LogError = String
"error"
levelStr LogLevel
LogDebug = String
"debug"
levelStr LogLevel
LogWarn = String
"warn"
levelStr LogLevel
LogTrace = String
"trace"
levelStr LogLevel
LogInfo = String
"info"

-- | Set the log file and level, this is a global configuration
setLogFile :: String -> LogLevel -> IO Bool
setLogFile :: String -> LogLevel -> IO Bool
setLogFile String
filename LogLevel
level =
  let s :: String
s = LogLevel -> String
levelStr LogLevel
level
   in String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString
        String
filename
        ( \CString
f ->
            String -> (CString -> IO Bool) -> IO Bool
forall a. String -> (CString -> IO a) -> IO a
withCString
              String
s
              ( \CString
l -> do
                  CBool
b <- CString -> CString -> IO CBool
extism_log_file CString
f CString
l
                  Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Bool -> IO Bool) -> Bool -> IO Bool
forall a b. (a -> b) -> a -> b
$ CBool
b CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
/= CBool
0
              )
        )

-- | Check if a function exists in the given plugin
functionExists :: Plugin -> String -> IO Bool
functionExists :: Plugin -> String -> IO Bool
functionExists (Plugin ForeignPtr ExtismPlugin
plugin) String
name =
  ForeignPtr ExtismPlugin -> (Ptr ExtismPlugin -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr
    ForeignPtr ExtismPlugin
plugin
    ( \Ptr ExtismPlugin
plugin' -> do
        CBool
b <- String -> (CString -> IO CBool) -> IO CBool
forall a. String -> (CString -> IO a) -> IO a
withCString String
name (Ptr ExtismPlugin -> CString -> IO CBool
extism_plugin_function_exists Ptr ExtismPlugin
plugin')
        if CBool
b CBool -> CBool -> Bool
forall a. Eq a => a -> a -> Bool
== CBool
1 then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    )

--- | Call a function provided by the given plugin
call :: (ToBytes a, FromBytes b) => Plugin -> String -> a -> IO (Result b)
call :: forall a b.
(ToBytes a, FromBytes b) =>
Plugin -> String -> a -> IO (Result b)
call (Plugin ForeignPtr ExtismPlugin
plugin) String
name a
inp =
  let input :: ByteString
input = a -> ByteString
forall a. ToBytes a => a -> ByteString
toBytes a
inp
   in let length' :: Word64
length' = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
input)
       in ForeignPtr ExtismPlugin
-> (Ptr ExtismPlugin -> IO (Result b)) -> IO (Result b)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr
            ForeignPtr ExtismPlugin
plugin
            ( \Ptr ExtismPlugin
plugin' -> do
                Int32
rc <-
                  String -> (CString -> IO Int32) -> IO Int32
forall a. String -> (CString -> IO a) -> IO a
withCString
                    String
name
                    ( \CString
name' ->
                        ByteString -> (CString -> IO Int32) -> IO Int32
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString
                          ByteString
input
                          ( \CString
input' ->
                              Ptr ExtismPlugin -> CString -> Ptr Word8 -> Word64 -> IO Int32
extism_plugin_call Ptr ExtismPlugin
plugin' CString
name' (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
input') Word64
length'
                          )
                    )
                CString
err <- Ptr ExtismPlugin -> IO CString
extism_error Ptr ExtismPlugin
plugin'
                if CString
err CString -> CString -> Bool
forall a. Eq a => a -> a -> Bool
/= CString
forall a. Ptr a
nullPtr
                  then do
                    String
e <- CString -> IO String
peekCString CString
err
                    Result b -> IO (Result b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result b -> IO (Result b)) -> Result b -> IO (Result b)
forall a b. (a -> b) -> a -> b
$ Error -> Result b
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
                  else
                    if Int32
rc Int32 -> Int32 -> Bool
forall a. Eq a => a -> a -> Bool
== Int32
0
                      then do
                        Word64
len <- Ptr ExtismPlugin -> IO Word64
extism_plugin_output_length Ptr ExtismPlugin
plugin'
                        Ptr Addr#
ptr <- Ptr ExtismPlugin -> IO (Ptr Word8)
extism_plugin_output_data Ptr ExtismPlugin
plugin'
                        ByteString
x <- Int -> Addr# -> IO ByteString
unsafePackLenAddress (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
len) Addr#
ptr
                        Result b -> IO (Result b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result b -> IO (Result b)) -> Result b -> IO (Result b)
forall a b. (a -> b) -> a -> b
$ ByteString -> Result b
forall a. FromBytes a => ByteString -> Result a
fromBytes ByteString
x
                      else Result b -> IO (Result b)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result b -> IO (Result b)) -> Result b -> IO (Result b)
forall a b. (a -> b) -> a -> b
$ Error -> Result b
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
"Call failed")
            )

-- | Create a new 'CancelHandle' that can be used to cancel a running plugin
-- | from another thread.
cancelHandle :: Plugin -> IO CancelHandle
cancelHandle :: Plugin -> IO CancelHandle
cancelHandle (Plugin ForeignPtr ExtismPlugin
plugin) = do
  Ptr ExtismCancelHandle
handle <- ForeignPtr ExtismPlugin
-> (Ptr ExtismPlugin -> IO (Ptr ExtismCancelHandle))
-> IO (Ptr ExtismCancelHandle)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismPlugin
plugin Ptr ExtismPlugin -> IO (Ptr ExtismCancelHandle)
extism_plugin_cancel_handle
  CancelHandle -> IO CancelHandle
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Ptr ExtismCancelHandle -> CancelHandle
CancelHandle Ptr ExtismCancelHandle
handle)

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

pluginID :: Plugin -> IO Data.UUID.UUID
pluginID :: Plugin -> IO UUID
pluginID (Plugin ForeignPtr ExtismPlugin
plugin) =
  ForeignPtr ExtismPlugin -> (Ptr ExtismPlugin -> IO UUID) -> IO UUID
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr
    ForeignPtr ExtismPlugin
plugin
    ( \Ptr ExtismPlugin
plugin' -> do
        Ptr Word8
ptr <- Ptr ExtismPlugin -> IO (Ptr Word8)
extism_plugin_id Ptr ExtismPlugin
plugin'
        ByteString
buf <- CStringLen -> IO ByteString
B.packCStringLen (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr, Int
16)
        case ByteString -> Maybe UUID
Data.UUID.fromByteString (ByteString -> ByteString
BL.fromStrict ByteString
buf) of
          Maybe UUID
Nothing -> String -> IO UUID
forall a. HasCallStack => String -> a
error String
"Invalid Plugin ID"
          Just UUID
x -> UUID -> IO UUID
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return UUID
x
    )

unwrap :: Either Error b -> b
unwrap (Right b
x) = b
x
unwrap (Left (ExtismError String
msg)) =
  String -> b
forall a. HasCallStack => String -> a
error String
msg