module Extism (module Extism, module Extism.Manifest) where
import Data.Int
import Data.Word
import Control.Monad (void)
import Foreign.ForeignPtr
import Foreign.C.String
import Foreign.Ptr
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)

-- | Plugins can be used to call WASM function
data Plugin = Plugin Context Int32

data CancelHandle = CancelHandle (Ptr ExtismCancelHandle)

-- | Log level
data LogLevel = Error | Warn | Info | Debug | Trace 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)

-- | Extism error
newtype Error = ExtismError String deriving Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
(Int -> Error -> ShowS)
-> (Error -> String) -> ([Error] -> ShowS) -> Show Error
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Error -> ShowS
showsPrec :: Int -> Error -> ShowS
$cshow :: Error -> String
show :: Error -> String
$cshowList :: [Error] -> ShowS
showList :: [Error] -> ShowS
Show

-- | Result type
type Result a = Either Error a

-- | Helper function to convert a 'String' to a 'ByteString'
toByteString :: String -> ByteString
toByteString :: String -> ByteString
toByteString String
x = [Word8] -> ByteString
B.pack ((Char -> Word8) -> String -> [Word8]
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Char -> Word8
c2w String
x)

-- | Helper function to convert a 'ByteString' to a 'String'
fromByteString :: ByteString -> String
fromByteString :: ByteString -> String
fromByteString ByteString
bs = (Word8 -> Char) -> [Word8] -> String
forall a b. (a -> b) -> [a] -> [b]
Prelude.map Word8 -> Char
w2c ([Word8] -> String) -> [Word8] -> String
forall a b. (a -> b) -> a -> b
$ ByteString -> [Word8]
B.unpack ByteString
bs

-- | 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

-- | Remove all registered plugins in a 'Context'
reset :: Context -> IO ()
reset :: Context -> IO ()
reset (Context ForeignPtr ExtismContext
ctx) =
  ForeignPtr ExtismContext -> (Ptr ExtismContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismContext
ctx Ptr ExtismContext -> IO ()
extism_context_reset

-- | Create a new 'Context'
newContext :: IO Context
newContext :: IO Context
newContext = do
  Ptr ExtismContext
ptr <- IO (Ptr ExtismContext)
extism_context_new
  ForeignPtr ExtismContext
fptr <- FinalizerPtr ExtismContext
-> Ptr ExtismContext -> IO (ForeignPtr ExtismContext)
forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FinalizerPtr ExtismContext
extism_context_free Ptr ExtismContext
ptr
  Context -> IO Context
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ForeignPtr ExtismContext -> Context
Context ForeignPtr ExtismContext
fptr)
 
-- | Execute a function with a new 'Context' that is destroyed when it returns
withContext :: (Context -> IO a) -> IO a
withContext :: forall a. (Context -> IO a) -> IO a
withContext Context -> IO a
f = do
  Context
ctx <- IO Context
newContext
  Context -> IO a
f Context
ctx

-- | Create a 'Plugin' from a WASM module, `useWasi` determines if WASI should
-- | be linked
plugin :: Context -> B.ByteString -> Bool -> IO (Result Plugin)
plugin :: Context -> ByteString -> Bool -> IO (Result Plugin)
plugin Context
c ByteString
wasm Bool
useWasi =
  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
  let Context ForeignPtr ExtismContext
ctx = Context
c in
  do
    ForeignPtr ExtismContext
-> (Ptr ExtismContext -> IO (Result Plugin)) -> IO (Result Plugin)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismContext
ctx (\Ptr ExtismContext
ctx -> do
      Int32
p <- ByteString -> (CString -> IO Int32) -> IO Int32
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString ByteString
wasm (\CString
s ->
        Ptr ExtismContext
-> Ptr Word8
-> Word64
-> Ptr (Ptr ExtismFunction)
-> Word64
-> CBool
-> IO Int32
extism_plugin_new Ptr ExtismContext
ctx (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
s) Word64
length Ptr (Ptr ExtismFunction)
forall a. Ptr a
nullPtr Word64
0 CBool
wasi )
      if Int32
p Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
0 then do
        CString
err <- Ptr ExtismContext -> Int32 -> IO CString
extism_error Ptr ExtismContext
ctx (-Int32
1)
        String
e <- CString -> IO String
peekCString 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
        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 (Context -> Int32 -> Plugin
Plugin Context
c Int32
p))
      
-- | Create a 'Plugin' with its own 'Context'
createPlugin :: B.ByteString -> Bool -> IO (Result Plugin)
createPlugin :: ByteString -> Bool -> IO (Result Plugin)
createPlugin ByteString
c Bool
useWasi = do
  Context
ctx <- IO Context
newContext
  Context -> ByteString -> Bool -> IO (Result Plugin)
plugin Context
ctx ByteString
c Bool
useWasi

-- | Create a 'Plugin' from a 'Manifest'
pluginFromManifest :: Context -> Manifest -> Bool -> IO (Result Plugin)
pluginFromManifest :: Context -> Manifest -> Bool -> IO (Result Plugin)
pluginFromManifest Context
ctx Manifest
manifest Bool
useWasi =
  let wasm :: ByteString
wasm = String -> ByteString
toByteString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Manifest -> String
forall a. JSON a => a -> String
toString Manifest
manifest in
  Context -> ByteString -> Bool -> IO (Result Plugin)
plugin Context
ctx ByteString
wasm Bool
useWasi

-- | Create a 'Plugin' with its own 'Context' from a 'Manifest'
createPluginFromManifest :: Manifest -> Bool -> IO (Result Plugin)
createPluginFromManifest :: Manifest -> Bool -> IO (Result Plugin)
createPluginFromManifest Manifest
manifest Bool
useWasi = do
  Context
ctx <- IO Context
newContext
  Context -> Manifest -> Bool -> IO (Result Plugin)
pluginFromManifest Context
ctx Manifest
manifest Bool
useWasi

-- | Update a 'Plugin' with a new WASM module
update :: Plugin -> B.ByteString -> Bool -> IO (Result ())
update :: Plugin -> ByteString -> Bool -> IO (Result ())
update (Plugin (Context ForeignPtr ExtismContext
ctx) Int32
id) ByteString
wasm Bool
useWasi =
  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
    ForeignPtr ExtismContext
-> (Ptr ExtismContext -> IO (Result ())) -> IO (Result ())
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismContext
ctx (\Ptr ExtismContext
ctx -> do
      CBool
b <- ByteString -> (CString -> IO CBool) -> IO CBool
forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString ByteString
wasm (\CString
s ->
        Ptr ExtismContext
-> Int32
-> Ptr Word8
-> Word64
-> Ptr (Ptr ExtismFunction)
-> Word64
-> CBool
-> IO CBool
extism_plugin_update Ptr ExtismContext
ctx Int32
id (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
s) Word64
length Ptr (Ptr ExtismFunction)
forall a. Ptr a
nullPtr Word64
0 CBool
wasi)
      if CBool
b CBool -> CBool -> Bool
forall a. Ord a => a -> a -> Bool
<= CBool
0 then do
        CString
err <- Ptr ExtismContext -> Int32 -> IO CString
extism_error Ptr ExtismContext
ctx (-Int32
1)
        String
e <- CString -> IO String
peekCString CString
err
        Result () -> IO (Result ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result () -> IO (Result ())) -> Result () -> IO (Result ())
forall a b. (a -> b) -> a -> b
$ Error -> Result ()
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
      else
        Result () -> IO (Result ())
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (() -> Result ()
forall a b. b -> Either a b
Right ()))

-- | Update a 'Plugin' with a new 'Manifest'
updateManifest :: Plugin -> Manifest -> Bool -> IO (Result ())
updateManifest :: Plugin -> Manifest -> Bool -> IO (Result ())
updateManifest Plugin
plugin Manifest
manifest Bool
useWasi =
  let wasm :: ByteString
wasm = String -> ByteString
toByteString (String -> ByteString) -> String -> ByteString
forall a b. (a -> b) -> a -> b
$ Manifest -> String
forall a. JSON a => a -> String
toString Manifest
manifest in
  Plugin -> ByteString -> Bool -> IO (Result ())
update Plugin
plugin ByteString
wasm Bool
useWasi

-- | Check if a 'Plugin' is valid
isValid :: Plugin -> Bool
isValid :: Plugin -> Bool
isValid (Plugin Context
_ Int32
p) = Int32
p Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Int32
0

-- | Set configuration values for a plugin
setConfig :: Plugin -> [(String, Maybe String)] -> IO Bool
setConfig :: Plugin -> [(String, Maybe String)] -> IO Bool
setConfig (Plugin (Context ForeignPtr ExtismContext
ctx) Int32
plugin) [(String, Maybe String)]
x =
  if Int32
plugin Int32 -> Int32 -> Bool
forall a. Ord a => a -> a -> Bool
< Int32
0
    then Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  else
    let obj :: JSObject JSValue
obj = [(String, JSValue)] -> JSObject JSValue
forall a. [(String, a)] -> JSObject a
toJSObject [(String
k, Maybe String -> JSValue
forall a. JSON a => a -> JSValue
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
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 -> do
      ForeignPtr ExtismContext
-> (Ptr ExtismContext -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismContext
ctx (\Ptr ExtismContext
ctx -> do
        CBool
b <- Ptr ExtismContext -> Int32 -> Ptr Word8 -> Int64 -> IO CBool
extism_plugin_config Ptr ExtismContext
ctx Int32
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
Error = String
"error"
levelStr LogLevel
Debug = String
"debug"
levelStr LogLevel
Warn = String
"warn"
levelStr LogLevel
Trace = String
"trace"
levelStr LogLevel
Info = 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 (Context ForeignPtr ExtismContext
ctx) Int32
plugin) String
name = do
  ForeignPtr ExtismContext
-> (Ptr ExtismContext -> IO Bool) -> IO Bool
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismContext
ctx (\Ptr ExtismContext
ctx -> do
    CBool
b <- String -> (CString -> IO CBool) -> IO CBool
forall a. String -> (CString -> IO a) -> IO a
withCString String
name (Ptr ExtismContext -> Int32 -> CString -> IO CBool
extism_plugin_function_exists Ptr ExtismContext
ctx Int32
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 :: Plugin -> String -> B.ByteString -> IO (Result B.ByteString)
call :: Plugin -> String -> ByteString -> IO (Result ByteString)
call (Plugin (Context ForeignPtr ExtismContext
ctx) Int32
plugin) String
name ByteString
input =
  let length :: Word64
length = Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
input) in
  do
    ForeignPtr ExtismContext
-> (Ptr ExtismContext -> IO (Result ByteString))
-> IO (Result ByteString)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismContext
ctx (\Ptr ExtismContext
ctx -> 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 ExtismContext
-> Int32 -> CString -> Ptr Word8 -> Word64 -> IO Int32
extism_plugin_call Ptr ExtismContext
ctx Int32
plugin CString
name (CString -> Ptr Word8
forall a b. Ptr a -> Ptr b
castPtr CString
input) Word64
length))
      CString
err <- Ptr ExtismContext -> Int32 -> IO CString
extism_error Ptr ExtismContext
ctx Int32
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 ByteString -> IO (Result ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result ByteString -> IO (Result ByteString))
-> Result ByteString -> IO (Result ByteString)
forall a b. (a -> b) -> a -> b
$ Error -> Result ByteString
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
length <- Ptr ExtismContext -> Int32 -> IO Word64
extism_plugin_output_length Ptr ExtismContext
ctx Int32
plugin
          Ptr Word8
ptr <- Ptr ExtismContext -> Int32 -> IO (Ptr Word8)
extism_plugin_output_data Ptr ExtismContext
ctx Int32
plugin
          ByteString
buf <- CStringLen -> IO ByteString
packCStringLen (Ptr Word8 -> CString
forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr, Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
length)
          Result ByteString -> IO (Result ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result ByteString -> IO (Result ByteString))
-> Result ByteString -> IO (Result ByteString)
forall a b. (a -> b) -> a -> b
$ ByteString -> Result ByteString
forall a b. b -> Either a b
Right ByteString
buf
      else Result ByteString -> IO (Result ByteString)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Result ByteString -> IO (Result ByteString))
-> Result ByteString -> IO (Result ByteString)
forall a b. (a -> b) -> a -> b
$ Error -> Result ByteString
forall a b. a -> Either a b
Left (String -> Error
ExtismError String
"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 -> IO ()
free (Plugin (Context ForeignPtr ExtismContext
ctx) Int32
plugin) =
  ForeignPtr ExtismContext -> (Ptr ExtismContext -> IO ()) -> IO ()
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismContext
ctx (Ptr ExtismContext -> Int32 -> IO ()
`extism_plugin_free` Int32
plugin)

cancelHandle :: Plugin -> IO CancelHandle
cancelHandle :: Plugin -> IO CancelHandle
cancelHandle (Plugin (Context ForeignPtr ExtismContext
ctx) Int32
plugin) = do
  Ptr ExtismCancelHandle
handle <- ForeignPtr ExtismContext
-> (Ptr ExtismContext -> IO (Ptr ExtismCancelHandle))
-> IO (Ptr ExtismCancelHandle)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismContext
ctx (\Ptr ExtismContext
ctx -> Ptr ExtismContext -> Int32 -> IO (Ptr ExtismCancelHandle)
extism_plugin_cancel_handle Ptr ExtismContext
ctx Int32
plugin)
  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 :: CancelHandle -> IO Bool
cancel :: CancelHandle -> IO Bool
cancel (CancelHandle Ptr ExtismCancelHandle
handle) = 
  Ptr ExtismCancelHandle -> IO Bool
extism_plugin_cancel Ptr ExtismCancelHandle
handle