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
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LogLevel] -> ShowS
$cshowList :: [LogLevel] -> ShowS
show :: LogLevel -> String
$cshow :: LogLevel -> String
showsPrec :: Int -> LogLevel -> ShowS
$cshowsPrec :: Int -> LogLevel -> ShowS
Show)

-- | Extism error
newtype Error = ExtismError String deriving Int -> Error -> ShowS
[Error] -> ShowS
Error -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Error] -> ShowS
$cshowList :: [Error] -> ShowS
show :: Error -> String
$cshow :: Error -> String
showsPrec :: Int -> Error -> ShowS
$cshowsPrec :: Int -> 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 (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 = forall a b. (a -> b) -> [a] -> [b]
Prelude.map Word8 -> Char
w2c 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) =
  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 <- forall a. FinalizerPtr a -> Ptr a -> IO (ForeignPtr a)
newForeignPtr FunPtr (Ptr ExtismContext -> IO ())
extism_context_free Ptr ExtismContext
ptr
  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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
wasm) in
  let wasi :: CBool
wasi = 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
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismContext
ctx (\Ptr ExtismContext
ctx -> do
      Int32
p <- 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 (forall a b. Ptr a -> Ptr b
castPtr CString
s) Word64
length forall a. Ptr a
nullPtr Word64
0 CBool
wasi )
      if Int32
p 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
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
      else
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right (Context -> Int32 -> Plugin
Plugin Context
c Int32
p))

-- | 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 forall a b. (a -> b) -> a -> b
$ forall a. JSON a => a -> String
toString Manifest
manifest in
  Context -> ByteString -> Bool -> IO (Result Plugin)
plugin Context
ctx ByteString
wasm 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
wasm) in
  let wasi :: CBool
wasi = forall a. Num a => Integer -> a
fromInteger (if Bool
useWasi then Integer
1 else Integer
0) in
  do
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismContext
ctx (\Ptr ExtismContext
ctx -> do
      CBool
b <- 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 (forall a b. Ptr a -> Ptr b
castPtr CString
s) Word64
length forall a. Ptr a
nullPtr Word64
0 CBool
wasi)
      if CBool
b 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
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
      else
        forall (m :: * -> *) a. Monad m => a -> m a
return (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 forall a b. (a -> b) -> a -> b
$ 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 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 forall a. Ord a => a -> a -> Bool
< Int32
0
    then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
  else
    let obj :: JSObject JSValue
obj = forall a. [(String, a)] -> JSObject a
toJSObject [(String
k, 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 (forall a. JSON a => a -> String
encode JSObject JSValue
obj) in
    let length :: Int64
length = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
bs) in
    forall a. ByteString -> (CString -> IO a) -> IO a
unsafeUseAsCString ByteString
bs (\CString
s -> do
      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 (forall a b. Ptr a -> Ptr b
castPtr CString
s) Int64
length
        forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CBool
b 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
  forall a. String -> (CString -> IO a) -> IO a
withCString String
filename (\CString
f ->
    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
      forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ CBool
b 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
  forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismContext
ctx (\Ptr ExtismContext
ctx -> do
    CBool
b <- 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 forall a. Eq a => a -> a -> Bool
== CBool
1 then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True else 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 = forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
B.length ByteString
input) in
  do
    forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr ExtismContext
ctx (\Ptr ExtismContext
ctx -> do
      Int32
rc <- forall a. String -> (CString -> IO a) -> IO a
withCString String
name (\CString
name ->
        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 (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 forall a. Eq a => a -> a -> Bool
/= forall a. Ptr a
nullPtr
        then do String
e <- CString -> IO String
peekCString CString
err
                forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. a -> Either a b
Left (String -> Error
ExtismError String
e)
      else if Int32
rc 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 (forall a b. Ptr a -> Ptr b
castPtr Ptr Word8
ptr, forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
length)
          forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ forall a b. b -> Either a b
Right ByteString
buf
      else forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ 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) =
  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 <- 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)
  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