extism-pdk 0.1.0.0 → 0.2.0.0

raw patch · 12 files changed

+602/−339 lines, 12 filesdep +binarydep ~extism-manifestPVP ok

version bump matches the API change (PVP)

Dependencies added: binary

Dependency ranges changed: extism-manifest

API changes (from Hackage documentation)

Files

• CHANGELOG.md +7/−2
• examples/CountVowels.hs +12/−7
• examples/HTTPGet.hs +17/−6
• examples/Hello.hs +4/−4
• extism-pdk.cabal +14/−6
• src/Extism/PDK.hs +71/−171
• src/Extism/PDK/Bindings.hs +80/−44
• src/Extism/PDK/HTTP.hs +57/−33
• src/Extism/PDK/JSON.hs +5/−4
• src/Extism/PDK/Memory.hs +261/−0
• src/Extism/PDK/MsgPack.hs +62/−62
• src/Extism/PDK/Util.hs +12/−0

@@ -1,5 +1,10 @@-# Revision history for haskell-wasm+# Revision history for extism-pdk -## 0.1.0.0 -- YYYY-mm-dd+## 0.2.0.0 +* API redesign, add automatic Haskell encoding using `ToMemory` and `FromMemory` classes++## 0.1.0.0 -- 2023-09-28+ * First version. Released on an unsuspecting world.+

@@ -3,12 +3,17 @@ import Extism.PDK import Extism.PDK.JSON -isVowel c = -  c == 'a' || c == 'A' ||-  c == 'e' || c == 'E' ||-  c == 'i' || c == 'I' ||-  c == 'o' || c == 'O' ||-  c == 'u' || c == 'U'+isVowel c =+  c == 'a'+    || c == 'A'+    || c == 'e'+    || c == 'E'+    || c == 'i'+    || c == 'I'+    || c == 'o'+    || c == 'O'+    || c == 'u'+    || c == 'U'  countVowels = do   -- Get input string from Extism host@@ -18,4 +23,4 @@   -- Return a JSON object {"count": count} back to the host   output $ JSONValue $ object ["count" .= count] -foreign export ccall "count_vowels" countVowels ::  IO ()+foreign export ccall "count_vowels" countVowels :: IO ()

@@ -1,16 +1,27 @@ module HTTPGet where +import Data.Int import Extism.PDK import Extism.PDK.HTTP+import Extism.PDK.Memory +getInput = do+  req <- tryInput+  case req of+    Right (JSONValue x) -> return x+    Left e -> do+      putStrLn e+      url <- inputString+      return $ newRequest url+ httpGet = do-  -- Get URL from the host-  url <- input-  -- Create a new 'Request'-  let req = newRequest url+  -- Get URL or JSON encoded request from host+  req <- getInput   -- Send the request, get a 'Response'-  res <- sendRequest req Nothing+  res <- sendRequest req (Nothing :: Maybe String)   -- Save response body to memory   outputMemory (memory res)+  -- Return code+  return 0 -foreign export ccall "http_get" httpGet ::  IO ()+foreign export ccall "http_get" httpGet :: IO Int32

@@ -1,20 +1,20 @@ module Hello where -import Extism.PDK import Data.Maybe+import Extism.PDK import Foreign.C.Types  defaultGreeting = "Hello"  greet g n =   output $ g ++ ", " ++ n-  + testing = do   -- Get a name from the Extism runtime-  name <- input+  name <- inputString   -- Get  configured greeting   greeting <- getConfig "greeting"   -- Greet the user, if no greeting is configured then "Hello" is used   greet (fromMaybe defaultGreeting greeting) name -foreign export ccall "testing" testing ::  IO ()+foreign export ccall "testing" testing :: IO ()

@@ -1,12 +1,12 @@ cabal-version:      3.0 name:               extism-pdk-version:            0.1.0.0+version:            0.2.0.0  -- A short (one-line) description of the package. synopsis: Extism Plugin Development Kit  -- A longer description of the package.-description: Haskell bindings to the Extism runtime+description: Haskell bindings to the Extism runtime for use with wasm32-wasi-ghc  -- A URL where users can report bugs. bug-reports: https://github.com/extism/haskell-pdk@@ -20,7 +20,14 @@ extra-doc-files: CHANGELOG.md  library-    exposed-modules: Extism.PDK Extism.PDK.Bindings Extism.PDK.HTTP Extism.PDK.JSON Extism.PDK.MsgPack+    exposed-modules:+      Extism.PDK+      Extism.PDK.Bindings+      Extism.PDK.HTTP+      Extism.PDK.JSON+      Extism.PDK.MsgPack+      Extism.PDK.Util+      Extism.PDK.Memory      -- Modules included in this executable, other than Main.     -- other-modules:@@ -32,9 +39,10 @@       bytestring >= 0.11.4 && <= 0.12,       cereal >= 0.5.8 && < 0.6,       containers >= 0.6.7 && < 0.7,-      extism-manifest >= 0.3.0 && <= 0.4,+      extism-manifest >= 0.3.0 && <= 1.0.0,       json >= 0.11 && < 0.12,-      messagepack >= 0.5.5 && < 0.6+      messagepack >= 0.5.5 && < 0.6,+      binary >= 0.8.9 && < 0.9.0      hs-source-dirs:   src     default-language: Haskell2010@@ -45,7 +53,7 @@     build-depends: base, extism-pdk     default-language: Haskell2010     ghc-options:-      -optl -Wl,--export=testing+      -optl -Wl,--export=testing   executable http_get     scope: private

@@ -1,196 +1,95 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}+{-# LANGUAGE Rank2Types #-} -module Extism.PDK (module Extism.PDK, module Extism.Manifest) where+-- |+-- Extism plugin development kit, used with the [wasm32-wasi-ghc](https://gitlab.haskell.org/ghc/ghc-wasm-meta) backend to make Extism plugins+module Extism.PDK+  ( module Extism.PDK,+    ToBytes (..),+    FromBytes (..),+    JSONValue (..),+    MsgPackValue (..),+  )+where -import Extism.PDK.Bindings-import Extism.JSON(JSValue, JSON)-import Extism.Manifest(toString)-import Data.Word-import Data.Int import Data.ByteString as B-import Data.ByteString.Internal (c2w, w2c)-import Data.ByteString.Unsafe (unsafeUseAsCString)-import Text.JSON(JSON, decode, encode, resultToEither)-import qualified Extism.PDK.MsgPack(MsgPack, decode, encode)--newtype JSONValue a = JSONValue a-newtype MsgPackValue a = MsgPackValue a---- | Represents a block of memory-data Memory = Memory MemoryOffset MemoryLength---- | 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--class FromBytes a where-  fromBytes :: ByteString -> a--class ToBytes a where-  toBytes :: a -> ByteString--instance FromBytes ByteString where-  fromBytes bs = bs--instance ToBytes ByteString where-  toBytes bs = bs--instance FromBytes String where-  fromBytes = fromByteString--instance ToBytes String where-  toBytes = toByteString--instance JSON a => FromBytes (JSONValue a) where-  fromBytes x =-    case resultToEither $ decode (fromByteString x) of-      Left e -> error e-      Right y -> JSONValue y--instance JSON a => ToBytes (JSONValue a) where-  toBytes (JSONValue x) = toByteString (encode x)--instance Extism.PDK.MsgPack.MsgPack a => FromBytes (MsgPackValue a) where-  fromBytes x =-    case Extism.PDK.MsgPack.decode x of-      Left e -> error e-      Right y -> MsgPackValue y+import Extism.PDK.Bindings+import Extism.PDK.Memory+import qualified Extism.PDK.MsgPack (MsgPack, decode, encode)+import Extism.PDK.Util+import Text.JSON (JSON, decode, encode, resultToEither) -instance Extism.PDK.MsgPack.MsgPack a => ToBytes (MsgPackValue a) where-  toBytes (MsgPackValue x) = Extism.PDK.MsgPack.encode x+-- | Get plugin input, returning an error message if the encoding is invalid+tryInput :: (FromBytes a) => IO (Either String a)+tryInput = fromBytes <$> inputByteString --- | Get plugin input as 'ByteString'-input :: FromBytes a => IO a+-- | Get plugin input+input :: forall a. (FromBytes a) => IO a input = do+  i <- inputByteString+  let x = fromBytes i+  case x of+    Left e -> error e+    Right y -> return y++-- | Get plugin input as a String+inputString :: IO String+inputString = do   len <- extismInputLength-  fromBytes <$> readInputBytes len+  fromByteString <$> readInputBytes len --- | Get plugin input as 'Memory' block-inputMemory :: IO Memory-inputMemory = do+-- | Get plugin input as a ByteString+inputByteString :: IO ByteString+inputByteString = do   len <- extismInputLength-  offs <- extismAlloc len-  Prelude.mapM_ (\x ->-    extismStoreU8 (offs + x) <$> extismInputLoadU8 x) [0, 1 .. len]-  return $ Memory offs len+  readInputBytes len --- | Get input as 'JSON'-inputJSON :: JSON a => IO (Maybe a)+-- | Get input as 'JSON', this is similar to calling `input (JsonValue ...)`+inputJSON :: (JSON a) => IO (Either String a) inputJSON = do-  s <- input :: IO String-  case resultToEither $ decode s of-    Left _ -> return Nothing-    Right x -> return (Just x)---- | Load data from 'Memory' block-load :: FromBytes a => Memory -> IO a-load (Memory offs len) =-  fromBytes <$> readBytes offs len---- | Store data into a 'Memory' block-store :: ToBytes a => Memory -> a -> IO ()-store (Memory offs len) a =-  let bs = toBytes a in-  writeBytes offs len bs+  s <- tryInput :: IO (Either String String)+  case s of+    Left e -> return (Left e)+    Right x ->+      case resultToEither $ decode x of+        Left e -> return (Left e)+        Right y -> return (Right y) --- | Set plugin output to the provided 'Memory' block-outputMemory :: Memory -> IO ()-outputMemory (Memory offs len) =+-- | Set plugin output+output :: (ToBytes a) => a -> IO ()+output x = do+  Memory offs len <- alloc x   extismSetOutput offs len --- | Set plugin output to the provided 'ByteString'-output :: ToBytes a => a -> IO ()-output x =-  let bs = toBytes x in-  let len = fromIntegral $ B.length bs in-  do-    offs <- extismAlloc len-    b <- store (Memory offs len) bs-    extismSetOutput offs len- -- | Set plugin output to a JSON encoded version of the provided value-outputJSON :: JSON a => a -> IO ()+outputJSON :: (JSON a) => a -> IO () outputJSON x =-  output (toString x)---- | Load string from 'Memory' block-loadString :: Memory -> IO String-loadString mem = do-  bs <- load mem-  return $ fromByteString bs---- | Store string in 'Memory' block-storeString :: Memory -> String -> IO ()-storeString mem s =-  let bs = toByteString s in-  store mem bs---- | Allocate a new 'Memory' block-alloc :: Int -> IO Memory-alloc n =-  let len = fromIntegral n in-  do-    offs <- extismAlloc len-    return $ Memory offs len---- | Free a 'Memory' block-free :: Memory -> IO ()-free (Memory 0 _) = return ()-free (Memory _ 0) = return ()-free (Memory offs _) =-  extismFree offs---- | Allocate a new 'Memory' block and copy the contents of the provided 'ByteString'-allocByteString :: ByteString -> IO Memory-allocByteString bs = do-  mem <- alloc (B.length bs)-  store mem bs-  return mem---- | Allocate a new 'Memory' block and copy the contents of the provided 'String'-allocString :: String -> IO Memory-allocString s =-  let bs = toByteString s in-  allocByteString bs---- | Get the offset of a 'Memory' block-memoryOffset (Memory offs _) = offs---- | Get the length of a 'Memory' block-memoryLength (Memory _ len) = len---- | Find 'Memory' block by offset-findMemory offs = do-  len <- extismLength offs-  return $ Memory offs len+  output (encode x)  -- | Get a variable from the Extism runtime-getVar :: String -> IO (Maybe ByteString)+getVar :: (FromBytes a) => String -> IO (Maybe a) getVar key = do   k <- allocString key   v <- extismGetVar (memoryOffset k)   free k-  if v == 0 then-    return Nothing-  else do-    mem <- findMemory v-    bs <- load mem-    free mem-    return (Just bs)+  if v == 0+    then return Nothing+    else do+      mem <- findMemory v+      bs <- load mem+      free k+      case bs of+        Left _ -> return Nothing+        Right x -> return (Just x)  -- | Set a variable-setVar :: ToBytes a => String -> Maybe a -> IO ()+setVar :: (ToBytes a) => String -> Maybe a -> IO () setVar key Nothing = do   k <- allocString key   extismSetVar (memoryOffset k) 0   free k setVar key (Just v) = do   k <- allocString key-  x <- allocByteString (toBytes v)+  x <- alloc v   extismSetVar (memoryOffset k) (memoryOffset x)   free k   free x@@ -201,23 +100,24 @@   k <- allocString key   v <- extismGetConfig (memoryOffset k)   free k-  if v == 0 then-    return Nothing-  else do-    mem <- findMemory v-    s <- loadString mem-    free mem-    return $ Just s+  if v == 0+    then return Nothing+    else do+      mem <- findMemory v+      s <- loadString mem+      free mem+      return $ Just s  -- | Set the current error message setError :: String -> IO () setError msg = do   s <- allocString msg   extismSetError $ memoryOffset s-  free s +-- | Log level data LogLevel = Info | Debug | Warn | Error +-- | Log to configured log file log :: LogLevel -> String -> IO () log Info msg = do   s <- allocString msg

@@ -2,75 +2,109 @@  module Extism.PDK.Bindings where +import Control.Monad+import Data.ByteString as B import Data.ByteString.Internal+import Data.Int+import Data.Word+import Foreign.C.Types import Foreign.ForeignPtr import Foreign.Ptr import Foreign.Storable-import Control.Monad- import System.Exit-import Data.Word-import Data.Int-import Foreign.C.Types -import Data.ByteString as B--+-- | Offset in Extism memory type MemoryOffset = Word64++-- | Offset of input from 0 to 'InputLength' type InputOffset = Word64++-- | Length of allocated block of memory type MemoryLength = Word64++-- | Total length of the input type InputLength = Word64  foreign import ccall "extism_output_set" extismSetOutput :: MemoryOffset -> MemoryLength -> IO ()+ foreign import ccall "extism_error_set" extismSetError :: MemoryOffset -> IO ()+ foreign import ccall "extism_log_info" extismLogInfo :: MemoryOffset -> IO ()+ foreign import ccall "extism_log_warn" extismLogWarn :: MemoryOffset -> IO ()+ foreign import ccall "extism_log_debug" extismLogDebug :: MemoryOffset -> IO ()+ foreign import ccall "extism_log_error" extismLogError :: MemoryOffset -> IO ()+ foreign import ccall "extism_store_u8" extismStoreU8 :: MemoryOffset -> Word8 -> IO ()+ foreign import ccall "extism_store_u64" extismStoreU64 :: MemoryOffset -> Word64 -> IO ()+ foreign import ccall "extism_load_u8" extismLoadU8 :: MemoryOffset -> IO Word8+ foreign import ccall "extism_load_u64" extismLoadU64 :: MemoryOffset -> IO Word64+ foreign import ccall "extism_alloc" extismAlloc :: MemoryLength -> IO MemoryOffset+ foreign import ccall "extism_length" extismLength :: MemoryOffset -> IO MemoryLength+ foreign import ccall "extism_free" extismFree :: MemoryOffset -> IO ()+ foreign import ccall "extism_input_length" extismInputLength :: IO InputLength+ foreign import ccall "extism_input_load_u8" extismInputLoadU8 :: InputOffset -> IO Word8+ foreign import ccall "extism_input_load_u64" extismInputLoadU64 :: InputOffset -> IO Word64+ foreign import ccall "extism_config_get" extismGetConfig :: MemoryOffset -> IO MemoryOffset+ foreign import ccall "extism_var_get" extismGetVar :: MemoryOffset -> IO MemoryOffset+ foreign import ccall "extism_var_set" extismSetVar :: MemoryOffset -> MemoryOffset -> IO ()+ foreign import ccall "extism_http_request" extismHTTPRequest :: MemoryOffset -> MemoryOffset -> IO MemoryOffset+ foreign import ccall "extism_http_status_code" extismHTTPStatusCode :: IO Int32+ foreign import ccall "__wasm_call_ctors" wasmConstructor :: IO ()-foreign import ccall "__wasm_call_dtors" wasmDestructor :: IO () +foreign import ccall "__wasm_call_dtors" wasmDestructor :: IO ()  bsToWord64 :: ByteString -> IO Word64 bsToWord64 (BS fp len) =-  if len /= 8 then error "invalid bytestring"-  else-    withForeignPtr fp (\p ->-      peek $ castPtr @Word8 @Word64 p)+  if len /= 8+    then error "invalid bytestring"+    else+      withForeignPtr+        fp+        ( peek . castPtr @Word8 @Word64+        )  word64ToBS :: Word64 -> ByteString-word64ToBS word = unsafeCreate 8 (\p ->-  poke (castPtr @Word8 @Word64 p) word)+word64ToBS word =+  unsafeCreate+    8+    ( \p ->+        poke (castPtr @Word8 @Word64 p) word+    )  readLoop :: (Word64 -> IO Word8) -> (Word64 -> IO Word64) -> Word64 -> Word64 -> [ByteString] -> IO ByteString readLoop f1 f8 total index acc =-  if index >= total then-    return $ B.concat . Prelude.reverse $ acc-  else-    let diff = total - index in-    do-      (n, x) <- if diff >= 8 then do-                    u <- f8 index-                    return (8, word64ToBS u)-                  else do-                    b <- f1 index-                    return (1, B.singleton b)-      readLoop f1 f8 total (index + n) (x : acc)+  if index >= total+    then return $ B.concat . Prelude.reverse $ acc+    else+      let diff = total - index+       in do+            (n, x) <-+              if diff >= 8+                then do+                  u <- f8 index+                  return (8, word64ToBS u)+                else do+                  b <- f1 index+                  return (1, B.singleton b)+            readLoop f1 f8 total (index + n) (x : acc)  readInputBytes :: InputLength -> IO ByteString readInputBytes len =@@ -82,22 +116,24 @@  writeBytesLoop :: MemoryOffset -> MemoryOffset -> ByteString -> IO () writeBytesLoop index total src =-  if index >= total then-    return ()-  else-    let diff = total - index in-    do-      (n, sub) <- if diff >= 8 then do-                    let (curr, next) = B.splitAt 8 src-                    u <- bsToWord64 curr-                    extismStoreU64 index u-                    return (8, next)-                  else do-                    let u = B.head src-                    extismStoreU8 index u-                    return (1, B.tail src)-      writeBytesLoop (index + n) total sub+  if index >= total+    then return ()+    else+      let diff = total - index+       in do+            (n, sub) <-+              if diff >= 8+                then do+                  let (curr, next) = B.splitAt 8 src+                  u <- bsToWord64 curr+                  extismStoreU64 index u+                  return (8, next)+                else do+                  let u = B.head src+                  extismStoreU8 index u+                  return (1, B.tail src)+            writeBytesLoop (index + n) total sub  writeBytes :: MemoryOffset -> MemoryLength -> ByteString -> IO ()-writeBytes offs len src =-  writeBytesLoop offs (offs + len) src+writeBytes offs len =+  writeBytesLoop offs (offs + len)

@@ -1,40 +1,42 @@+-- |+-- Contains bindings to the Extism PDK HTTP interface module Extism.PDK.HTTP where -import Extism.Manifest(toString, HTTPRequest(..), method, headers, url)-import Extism.JSON(Nullable(..), decode, JSON, Result(..))-import Extism.PDK.Bindings-import Extism.PDK-import Data.Word import Data.ByteString as B+import Data.Word+import Extism.JSON (JSON, Nullable (..), Result (..), decode)+import Extism.Manifest (HTTPRequest (..), headers, method, toString, url)+import Extism.PDK+import Extism.PDK.Bindings+import Extism.PDK.Memory  -- | HTTP Request type Request = HTTPRequest  -- | HTTP Response data Response = Response-  {-    statusCode :: Int-  , memory :: Memory+  { statusCode :: Int,+    memory :: Memory   }  -- | Creates a new 'Request' newRequest :: String -> Request newRequest url =-  HTTPRequest {-    url = url-  , headers = Null-  , method = Null-  }+  HTTPRequest+    { url = url,+      headers = Null,+      method = Null+    }  -- | Update a 'Request' with the provided HTTP request method (GET, POST, PUT, DELETE, ...) withMethod :: String -> Request -> Request withMethod meth req =-  req { method = NotNull meth }+  req {method = NotNull meth}  -- | Update a 'Request' with the provided HTTP request headers withHeaders :: [(String, String)] -> Request -> Request withHeaders h req =-  req { headers = NotNull h }+  req {headers = NotNull h}  -- | Access the Memory block associated with a 'Response' responseMemory :: Response -> Memory@@ -42,38 +44,60 @@  -- | Get the 'Response' body as a 'ByteString' responseByteString :: Response -> IO ByteString-responseByteString (Response _ mem) = load mem+responseByteString (Response _ mem) = do+  a <- load mem+  case a of+    Left e -> error e+    Right x -> return x  -- | Get the 'Response' body as a 'String' responseString :: Response -> IO String responseString (Response _ mem) = loadString mem  -- | Get the 'Response' body as JSON-responseJSON :: JSON a => Response -> IO (Either String a)+responseJSON :: (JSON a) => Response -> IO (Either String a) responseJSON (Response _ mem) = do   json <- decode <$> loadString mem   case json of     Ok json -> return $ Right json     Extism.JSON.Error msg -> return (Left msg) +-- | Get the 'Response' body and decode it+response :: (FromBytes a) => Response -> IO (Either String a)+response (Response _ mem) = load mem  -- | Send HTTP request with an optional request body-sendRequest :: Request -> Maybe ByteString -> IO Response-sendRequest req b =-  let json = Extism.Manifest.toString req in-  let bodyMem = case b of-               Nothing -> return $ Memory 0 0-               Just b -> allocByteString b-  in-  do-    body <- bodyMem-    j <- allocString json-    res <- extismHTTPRequest (memoryOffset j) (memoryOffset body)-    free j-    free body-    code <- extismHTTPStatusCode-    if res == 0 then-      return (Response (fromIntegral code) (Memory 0 0))+sendRequestWithBody :: (ToBytes a) => Request -> a -> IO Response+sendRequestWithBody req b = do+  body <- alloc b+  let json = Extism.Manifest.toString req+  j <- allocString json+  res <- extismHTTPRequest (memoryOffset j) (memoryOffset body)+  free j+  free body+  code <- extismHTTPStatusCode+  if res == 0+    then return (Response (fromIntegral code) (Memory 0 0))     else do       mem <- findMemory res       return (Response (fromIntegral code) mem)++-- | Send HTTP request with an optional request body+sendRequest :: (ToBytes a) => Request -> Maybe a -> IO Response+sendRequest req b =+  let json = Extism.Manifest.toString req+   in let bodyMem = case b of+            Nothing -> return $ Memory 0 0+            Just b -> alloc b+       in do+            body <- bodyMem+            j <- allocString json+            res <- extismHTTPRequest (memoryOffset j) (memoryOffset body)+            free j+            free body+            code <- extismHTTPStatusCode+            if res == 0+              then return (Response (fromIntegral code) (Memory 0 0))+              else do+                mem <- findMemory res+                return (Response (fromIntegral code) mem)

@@ -1,6 +1,7 @@-module Extism.PDK.JSON (-  module Extism.PDK.JSON,-  module Extism.JSON-) where+module Extism.PDK.JSON+  ( module Extism.PDK.JSON,+    module Extism.JSON,+  )+where  import Extism.JSON

@@ -0,0 +1,261 @@+{-# LANGUAGE FlexibleInstances #-}++-- |+-- Extism.PDK.Memory implements a low-level interface for interacting with Extism memory+module Extism.PDK.Memory+  ( Memory (..),+    MemoryOffset,+    MemoryLength,+    FromBytes (..),+    ToBytes (..),+    JSONValue (..),+    MsgPackValue (..),+    load,+    loadString,+    loadByteString,+    outputMemory,+    memAlloc,+    free,+    alloc,+    allocString,+    allocByteString,+    memoryOffset,+    memoryLength,+    findMemory,+  )+where++import Data.Binary.Get+import Data.Binary.Put+import qualified Data.ByteString as B+import Data.ByteString.Internal (c2w, w2c)+import Data.Int+import Data.Word+import Extism.PDK.Bindings+import qualified Extism.PDK.MsgPack (MsgPack, decode, encode)+import Extism.PDK.Util+import Text.JSON (JSON, decode, encode, resultToEither)++-- | Represents a block of memory by offset and length+data Memory = Memory MemoryOffset MemoryLength++-- | Load data from 'Memory' block+load :: (FromBytes a) => Memory -> IO (Either String a)+load (Memory offs len) = do+  x <- readBytes offs len+  return $ fromBytes x++-- | Store data into a 'Memory' block+store :: (ToBytes a) => Memory -> a -> IO ()+store (Memory offs len) a =+  let bs = toBytes a+   in writeBytes offs len bs++-- | Set plugin output to the provided 'Memory' block+outputMemory :: Memory -> IO ()+outputMemory (Memory offs len) =+  extismSetOutput offs len++-- | Load ByteString from 'Memory' block+loadByteString :: Memory -> IO B.ByteString+loadByteString (Memory offs len) = do+  readBytes offs len++-- | Load string from 'Memory' block+loadString :: Memory -> IO String+loadString (Memory offs len) =+  fromByteString <$> readBytes offs len++-- | Store string in 'Memory' block+storeString :: Memory -> String -> IO ()+storeString mem s =+  let bs = toByteString s+   in storeByteString mem bs++-- | Store byte string in 'Memory' block+storeByteString :: Memory -> B.ByteString -> IO ()+storeByteString (Memory offs len) =+  writeBytes offs len++-- | Encode a value and copy it into Extism memory, returning the Memory block+alloc :: (ToBytes a) => a -> IO Memory+alloc x =+  let bs = toBytes x+   in do+        Memory offs len <- memAlloc (B.length bs)+        writeBytes offs len bs+        return $ Memory offs len++-- | Allocate a new 'Memory' block+memAlloc :: Int -> IO Memory+memAlloc n =+  let len = fromIntegral n+   in do+        offs <- extismAlloc len+        return $ Memory offs len++-- | Free a 'Memory' block+free :: Memory -> IO ()+free (Memory 0 _) = return ()+free (Memory _ 0) = return ()+free (Memory offs _) =+  extismFree offs++-- | Allocate a new 'Memory' block and copy the encoded value+allocByteString :: B.ByteString -> IO Memory+allocByteString bs = do+  Memory offs len <- memAlloc (B.length bs)+  writeBytes offs len bs+  return (Memory offs len)++-- | Allocate a new 'Memory' block and copy the contents of the provided 'String'+allocString :: String -> IO Memory+allocString = allocByteString . toByteString++-- | Get the offset of a 'Memory' block+memoryOffset :: Memory -> MemoryOffset+memoryOffset (Memory offs _) = offs++-- | Get the length of a 'Memory' block+memoryLength :: Memory -> MemoryLength+memoryLength (Memory _ len) = len++-- | Find 'Memory' block by offset+findMemory :: MemoryOffset -> IO Memory+findMemory offs = do+  len <- extismLength offs+  return $ Memory offs len++-- | A class used to convert values from bytes read from linear memory+class FromBytes a where+  fromBytes :: B.ByteString -> Either String a++-- | A class used to convert values to bytes to be written into linear memory+class ToBytes a where+  toBytes :: a -> B.ByteString++-- | A wrapper type for JSON encoded values+newtype JSONValue a = JSONValue a++-- | A wrapper type for MsgPack encoded values+newtype MsgPackValue a = MsgPackValue a++instance FromBytes B.ByteString where+  fromBytes = Right++instance ToBytes B.ByteString where+  toBytes = id++instance FromBytes String where+  fromBytes mem =+    let s = fromBytes mem+     in case s of+          Left e -> Left e+          Right x -> Right $ fromByteString x++instance ToBytes String where+  toBytes = toByteString++instance (JSON a) => FromBytes (JSONValue a) where+  fromBytes mem =+    let a = fromBytes mem+     in case a of+          Left e -> Left e+          Right x ->+            case resultToEither $ decode x of+              Left e -> Left e+              Right y -> Right (JSONValue y)++instance (JSON a) => ToBytes (JSONValue a) where+  toBytes (JSONValue x) = toBytes (encode x)++instance (Extism.PDK.MsgPack.MsgPack a) => FromBytes (MsgPackValue a) where+  fromBytes mem =+    let a = fromBytes mem+     in case a of+          Left e -> Left e+          Right x ->+            case Extism.PDK.MsgPack.decode x of+              Left e -> Left e+              Right y -> Right (MsgPackValue y)++instance (Extism.PDK.MsgPack.MsgPack a) => ToBytes (MsgPackValue a) where+  toBytes (MsgPackValue x) = toBytes $ Extism.PDK.MsgPack.encode x++instance ToBytes Int32 where+  toBytes i = toBytes $ B.toStrict (runPut (putInt32le i))++instance FromBytes Int32 where+  fromBytes mem =+    let bs = fromBytes mem+     in case bs of+          Left e -> Left e+          Right x ->+            case runGetOrFail getInt32le (B.fromStrict x) of+              Left (_, _, e) -> Left e+              Right (_, _, x) -> Right x++instance ToBytes Int64 where+  toBytes i = toBytes $ B.toStrict (runPut (putInt64le i))++instance FromBytes Int64 where+  fromBytes mem =+    let bs = fromBytes mem+     in case bs of+          Left e -> Left e+          Right x ->+            case runGetOrFail getInt64le (B.fromStrict x) of+              Left (_, _, e) -> Left e+              Right (_, _, x) -> Right x++instance ToBytes Word32 where+  toBytes i = toBytes $ B.toStrict (runPut (putWord32le i))++instance FromBytes Word32 where+  fromBytes mem =+    let bs = fromBytes mem+     in case bs of+          Left e -> Left e+          Right x ->+            case runGetOrFail getWord32le (B.fromStrict x) of+              Left (_, _, e) -> Left e+              Right (_, _, x) -> Right x++instance ToBytes Word64 where+  toBytes i = toBytes $ B.toStrict (runPut (putWord64le i))++instance FromBytes Word64 where+  fromBytes mem =+    let bs = fromBytes mem+     in case bs of+          Left e -> Left e+          Right x ->+            case runGetOrFail getWord64le (B.fromStrict x) of+              Left (_, _, e) -> Left e+              Right (_, _, x) -> Right x++instance ToBytes Float where+  toBytes i = toBytes $ B.toStrict (runPut (putFloatle i))++instance FromBytes Float where+  fromBytes mem =+    let bs = fromBytes mem+     in case bs of+          Left e -> Left e+          Right x ->+            case runGetOrFail getFloatle (B.fromStrict x) of+              Left (_, _, e) -> Left e+              Right (_, _, x) -> Right x++instance ToBytes Double where+  toBytes i = toBytes $ B.toStrict (runPut (putDoublele i))++instance FromBytes Double where+  fromBytes mem =+    let bs = fromBytes mem+     in case bs of+          Left e -> Left e+          Right x ->+            case runGetOrFail getDoublele (B.fromStrict x) of+              Left (_, _, e) -> Left e+              Right (_, _, x) -> Right x

@@ -1,93 +1,97 @@-{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, TypeOperators #-}--module Extism.PDK.MsgPack (-  module Extism.PDK.MsgPack, -  module Data.MessagePack,-  module Map,-) where+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE TypeOperators #-} -import GHC.Generics-import Data.MessagePack-import Data.Int-import Data.Word-import qualified Data.Map.Strict as Map+-- |+-- Provides the ability to use MessagePack for plugin input/output+module Extism.PDK.MsgPack+  ( module Extism.PDK.MsgPack,+    module Data.MessagePack,+    module Map,+  )+where +import Data.Bifunctor (bimap) import qualified Data.ByteString as B import Data.ByteString.Internal (c2w, w2c)+import Data.Int+import qualified Data.Map.Strict as Map+import Data.MessagePack import qualified Data.Serialize as S+import Data.Word+import GHC.Generics  class MsgPack a where   toMsgPack :: a -> Object   fromMsgPack :: Object -> Maybe a -class GMsgPack f  where+class GMsgPack f where   toGMsgPack :: f a -> Object   fromGMsgPack :: Object -> Maybe (f a)   fromGMsgPack _ = Nothing-  + instance GMsgPack U1 where   toGMsgPack U1 = ObjectNil   fromGMsgPack ObjectNil = Just U1-  -instance (GMsgPack a, GMsgPack b) => GMsgPack ( a :*: b) where++instance (GMsgPack a, GMsgPack b) => GMsgPack (a :*: b) where   toGMsgPack (x :*: y) = array [toGMsgPack x, toGMsgPack y]-  -- fromGMsgPack (ObjectArray [a, b]) = Just (a :*: b)-  -instance (GMsgPack a, GMsgPack b) => GMsgPack ( a :+: b) where++-- fromGMsgPack (ObjectArray [a, b]) = Just (a :*: b)++instance (GMsgPack a, GMsgPack b) => GMsgPack (a :+: b) where   toGMsgPack (L1 x) = toGMsgPack x   toGMsgPack (R1 x) = toGMsgPack x-  -instance GMsgPack a => GMsgPack (M1 i c a) where++instance (GMsgPack a) => GMsgPack (M1 i c a) where   toGMsgPack (M1 x) = toGMsgPack x-  + instance (MsgPack a) => GMsgPack (K1 i a) where   toGMsgPack (K1 x) = toMsgPack x  toByteString x = B.pack (Prelude.map c2w x)+ fromByteString bs = Prelude.map w2c $ B.unpack bs  instance MsgPack Bool where-  toMsgPack b = ObjectBool b+  toMsgPack = ObjectBool   fromMsgPack (ObjectBool b) = Just b   fromMsgPack _ = Nothing-    instance MsgPack String where   toMsgPack s = ObjectString (toByteString s)   fromMsgPack (ObjectString s) = Just (fromByteString s)   fromMsgPack _ = Nothing-  -  + instance MsgPack B.ByteString where-  toMsgPack s = ObjectBinary s+  toMsgPack = ObjectBinary   fromMsgPack (ObjectString s) = Just s   fromMsgPack (ObjectBinary s) = Just s   fromMsgPack _ = Nothing-  + instance MsgPack Int where   toMsgPack i = ObjectInt (fromIntegral i)   fromMsgPack (ObjectInt i) = Just (fromIntegral i)   fromMsgPack _ = Nothing-    + instance MsgPack Int64 where-  toMsgPack i = ObjectInt i+  toMsgPack = ObjectInt   fromMsgPack (ObjectInt i) = Just i   fromMsgPack _ = Nothing-  + instance MsgPack Word where   toMsgPack w = ObjectUInt (fromIntegral w)   fromMsgPack (ObjectUInt x) = Just (fromIntegral x)   fromMsgPack _ = Nothing-  + instance MsgPack Word64 where-  toMsgPack w = ObjectUInt w+  toMsgPack = ObjectUInt   fromMsgPack (ObjectUInt x) = Just x   fromMsgPack _ = Nothing-  -instance MsgPack a => MsgPack (Maybe a) where++instance (MsgPack a) => MsgPack (Maybe a) where   toMsgPack Nothing = ObjectNil   toMsgPack (Just a) = toMsgPack a-  fromMsgPack bs = fromMsgPack bs+  fromMsgPack = fromMsgPack  instance MsgPack () where   toMsgPack () = ObjectNil@@ -95,53 +99,49 @@   fromMsgPack _ = Nothing  instance MsgPack Float where-  toMsgPack f = ObjectFloat f+  toMsgPack = ObjectFloat   fromMsgPack (ObjectFloat f) = Just f   fromMsgPack _ = Nothing-  + instance MsgPack Double where-  toMsgPack d = ObjectDouble d+  toMsgPack = ObjectDouble   fromMsgPack (ObjectDouble d) = Just d   fromMsgPack _ = Nothing-  + instance MsgPack Object where   toMsgPack x = x-  fromMsgPack x = Just x-  +  fromMsgPack = Just -( .= ) :: MsgPack a => MsgPack b => a -> b -> (Object, Object)-( .= ) k v = (toMsgPack k, toMsgPack v)+(.=) :: (MsgPack a) => (MsgPack b) => a -> b -> (Object, Object)+(.=) k v = (toMsgPack k, toMsgPack v) -lookup :: MsgPack a => MsgPack b => a -> Object -> Maybe b-lookup k (ObjectMap map) = -  let x = Map.lookup (toMsgPack k) map in-  case x of-    Nothing -> Nothing-    Just x -> fromMsgPack x+lookup :: (MsgPack a) => (MsgPack b) => a -> Object -> Maybe b+lookup k (ObjectMap map) =+  let x = Map.lookup (toMsgPack k) map+   in fromMsgPack =<< x lookup _ _ = Nothing  set k v (ObjectMap map) =   ObjectMap $ Map.insert (toMsgPack k) (toMsgPack v) map -( .? ) :: MsgPack a => MsgPack b => Object -> a -> Maybe b-( .? ) a b = Extism.PDK.MsgPack.lookup b a+(.?) :: (MsgPack a) => (MsgPack b) => Object -> a -> Maybe b+(.?) a b = Extism.PDK.MsgPack.lookup b a -object :: MsgPack a => MsgPack b => [(a, b)] -> Object-object l = ObjectMap (Map.fromList $ map (\(k, v) -> (toMsgPack k, toMsgPack v)) l)+object :: (MsgPack a) => (MsgPack b) => [(a, b)] -> Object+object l = ObjectMap (Map.fromList $ map (bimap toMsgPack toMsgPack) l) -array :: MsgPack a => [a] -> Object+array :: (MsgPack a) => [a] -> Object array l = ObjectArray (map toMsgPack l) -encode :: MsgPack a => a -> B.ByteString+encode :: (MsgPack a) => a -> B.ByteString encode x =-  let y = toMsgPack x in-  S.encode y+  let y = toMsgPack x+   in S.encode y -decode :: MsgPack a => B.ByteString -> Either String a+decode :: (MsgPack a) => B.ByteString -> Either String a decode bs =   case S.decode bs of     Right a -> case fromMsgPack a of-                 Nothing -> Left "Invalid type conversion"-                 Just x -> Right x+      Nothing -> Left "Invalid type conversion"+      Just x -> Right x     Left s -> Left s-    

@@ -0,0 +1,12 @@+module Extism.PDK.Util where++import qualified Data.ByteString as B+import Data.ByteString.Internal (c2w, w2c)++-- | Helper function to convert a string to a bytestring+toByteString :: String -> B.ByteString+toByteString x = B.pack (Prelude.map c2w x)++-- | Helper function to convert a bytestring to a string+fromByteString :: B.ByteString -> String+fromByteString bs = Prelude.map w2c $ B.unpack bs