extism-pdk (empty) → 0.1.0.0
raw patch · 10 files changed
+698/−0 lines, 10 filesdep +basedep +bytestringdep +cereal
Dependencies added: base, bytestring, cereal, containers, extism-manifest, extism-pdk, json, messagepack
Files
- CHANGELOG.md +5/−0
- examples/CountVowels.hs +21/−0
- examples/HTTPGet.hs +16/−0
- examples/Hello.hs +20/−0
- extism-pdk.cabal +64/−0
- src/Extism/PDK.hs +237/−0
- src/Extism/PDK/Bindings.hs +103/−0
- src/Extism/PDK/HTTP.hs +79/−0
- src/Extism/PDK/JSON.hs +6/−0
- src/Extism/PDK/MsgPack.hs +147/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for haskell-wasm++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ examples/CountVowels.hs view
@@ -0,0 +1,21 @@+module CountVowels where++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'++countVowels = do+ -- Get input string from Extism host+ s <- input+ -- Calculate the number of vowels+ let count = length (filter isVowel s)+ -- Return a JSON object {"count": count} back to the host+ output $ JSONValue $ object ["count" .= count]++foreign export ccall "count_vowels" countVowels :: IO ()
+ examples/HTTPGet.hs view
@@ -0,0 +1,16 @@+module HTTPGet where++import Extism.PDK+import Extism.PDK.HTTP++httpGet = do+ -- Get URL from the host+ url <- input+ -- Create a new 'Request'+ let req = newRequest url+ -- Send the request, get a 'Response'+ res <- sendRequest req Nothing+ -- Save response body to memory+ outputMemory (memory res)++foreign export ccall "http_get" httpGet :: IO ()
+ examples/Hello.hs view
@@ -0,0 +1,20 @@+module Hello where++import Extism.PDK+import Data.Maybe+import Foreign.C.Types++defaultGreeting = "Hello"++greet g n =+ output $ g ++ ", " ++ n+ +testing = do+ -- Get a name from the Extism runtime+ name <- input+ -- 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 ()
+ extism-pdk.cabal view
@@ -0,0 +1,64 @@+cabal-version: 3.0+name: extism-pdk+version: 0.1.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++-- A URL where users can report bugs.+bug-reports: https://github.com/extism/haskell-pdk++-- The license under which the package is released.+license: BSD-3-Clause+author: Extism Authors+maintainer: oss@dylib.so++category: WASM, plugins+extra-doc-files: CHANGELOG.md++library+ exposed-modules: Extism.PDK Extism.PDK.Bindings Extism.PDK.HTTP Extism.PDK.JSON Extism.PDK.MsgPack++ -- Modules included in this executable, other than Main.+ -- other-modules:++ -- LANGUAGE extensions used by modules in this package.+ -- other-extensions:+ build-depends:+ base >= 4.15.0 && < 5,+ 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,+ json >= 0.11 && < 0.12,+ messagepack >= 0.5.5 && < 0.6++ hs-source-dirs: src+ default-language: Haskell2010++executable hello+ scope: private+ main-is: examples/Hello.hs+ build-depends: base, extism-pdk+ default-language: Haskell2010+ ghc-options:+ -optl -Wl,--export=testing++executable http_get+ scope: private+ main-is: examples/HTTPGet.hs+ build-depends: base, extism-pdk+ default-language: Haskell2010+ ghc-options:+ -optl -Wl,--export=http_get++executable count_vowels+ scope: private+ main-is: examples/CountVowels.hs+ build-depends: base, extism-pdk+ default-language: Haskell2010+ ghc-options:+ -optl -Wl,--export=count_vowels
+ src/Extism/PDK.hs view
@@ -0,0 +1,237 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances #-}++module Extism.PDK (module Extism.PDK, module Extism.Manifest) 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++instance Extism.PDK.MsgPack.MsgPack a => ToBytes (MsgPackValue a) where+ toBytes (MsgPackValue x) = Extism.PDK.MsgPack.encode x++-- | Get plugin input as 'ByteString'+input :: FromBytes a => IO a+input = do+ len <- extismInputLength+ fromBytes <$> readInputBytes len++-- | Get plugin input as 'Memory' block+inputMemory :: IO Memory+inputMemory = do+ len <- extismInputLength+ offs <- extismAlloc len+ Prelude.mapM_ (\x ->+ extismStoreU8 (offs + x) <$> extismInputLoadU8 x) [0, 1 .. len]+ return $ Memory offs len++-- | Get input as 'JSON'+inputJSON :: JSON a => IO (Maybe 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++-- | Set plugin output to the provided 'Memory' block+outputMemory :: Memory -> IO ()+outputMemory (Memory offs len) =+ 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 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++-- | Get a variable from the Extism runtime+getVar :: String -> IO (Maybe ByteString)+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)++-- | Set a variable+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)+ extismSetVar (memoryOffset k) (memoryOffset x)+ free k+ free x++-- | Get a configuration value+getConfig :: String -> IO (Maybe String)+getConfig key = do+ 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++-- | Set the current error message+setError :: String -> IO ()+setError msg = do+ s <- allocString msg+ extismSetError $ memoryOffset s+ free s++data LogLevel = Info | Debug | Warn | Error++log :: LogLevel -> String -> IO ()+log Info msg = do+ s <- allocString msg+ extismLogInfo (memoryOffset s)+ free s+log Debug msg = do+ s <- allocString msg+ extismLogDebug (memoryOffset s)+ free s+log Warn msg = do+ s <- allocString msg+ extismLogWarn (memoryOffset s)+ free s+log Error msg = do+ s <- allocString msg+ extismLogError (memoryOffset s)+ free s
+ src/Extism/PDK/Bindings.hs view
@@ -0,0 +1,103 @@+{-# LANGUAGE TypeApplications #-}++module Extism.PDK.Bindings where++import Data.ByteString.Internal+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+++type MemoryOffset = Word64+type InputOffset = Word64+type MemoryLength = Word64+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 ()+++bsToWord64 :: ByteString -> IO Word64+bsToWord64 (BS fp len) =+ if len /= 8 then error "invalid bytestring"+ else+ withForeignPtr fp (\p ->+ peek $ castPtr @Word8 @Word64 p)++word64ToBS :: Word64 -> ByteString+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)++readInputBytes :: InputLength -> IO ByteString+readInputBytes len =+ readLoop extismInputLoadU8 extismInputLoadU64 len 0 []++readBytes :: MemoryOffset -> MemoryLength -> IO ByteString+readBytes offs len =+ readLoop extismLoadU8 extismLoadU64 (offs + len) offs []++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++writeBytes :: MemoryOffset -> MemoryLength -> ByteString -> IO ()+writeBytes offs len src =+ writeBytesLoop offs (offs + len) src
+ src/Extism/PDK/HTTP.hs view
@@ -0,0 +1,79 @@+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++-- | HTTP Request+type Request = HTTPRequest++-- | HTTP Response+data Response = Response+ {+ statusCode :: Int+ , memory :: Memory+ }++-- | Creates a new 'Request'+newRequest :: String -> Request+newRequest url =+ 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 }++-- | Update a 'Request' with the provided HTTP request headers+withHeaders :: [(String, String)] -> Request -> Request+withHeaders h req =+ req { headers = NotNull h }++-- | Access the Memory block associated with a 'Response'+responseMemory :: Response -> Memory+responseMemory (Response _ mem) = mem++-- | Get the 'Response' body as a 'ByteString'+responseByteString :: Response -> IO ByteString+responseByteString (Response _ mem) = load mem++-- | 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 (Response _ mem) = do+ json <- decode <$> loadString mem+ case json of+ Ok json -> return $ Right json+ Extism.JSON.Error msg -> return (Left msg)+++-- | 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))+ else do+ mem <- findMemory res+ return (Response (fromIntegral code) mem)
+ src/Extism/PDK/JSON.hs view
@@ -0,0 +1,6 @@+module Extism.PDK.JSON (+ module Extism.PDK.JSON,+ module Extism.JSON+) where++import Extism.JSON
+ src/Extism/PDK/MsgPack.hs view
@@ -0,0 +1,147 @@+{-# LANGUAGE TypeSynonymInstances, FlexibleInstances, TypeOperators #-}++module Extism.PDK.MsgPack (+ module Extism.PDK.MsgPack, + module Data.MessagePack,+ module Map,+) where++import GHC.Generics+import Data.MessagePack+import Data.Int+import Data.Word+import qualified Data.Map.Strict as Map++import qualified Data.ByteString as B+import Data.ByteString.Internal (c2w, w2c)+import qualified Data.Serialize as S++class MsgPack a where+ toMsgPack :: a -> Object+ fromMsgPack :: Object -> Maybe a++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+ toGMsgPack (x :*: y) = array [toGMsgPack x, toGMsgPack y]+ -- 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+ 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+ 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+ 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+ 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+ fromMsgPack (ObjectUInt x) = Just x+ fromMsgPack _ = Nothing+ +instance MsgPack a => MsgPack (Maybe a) where+ toMsgPack Nothing = ObjectNil+ toMsgPack (Just a) = toMsgPack a+ fromMsgPack bs = fromMsgPack bs++instance MsgPack () where+ toMsgPack () = ObjectNil+ fromMsgPack ObjectNil = Just ()+ fromMsgPack _ = Nothing++instance MsgPack Float where+ toMsgPack f = ObjectFloat f+ fromMsgPack (ObjectFloat f) = Just f+ fromMsgPack _ = Nothing+ +instance MsgPack Double where+ toMsgPack d = ObjectDouble d+ fromMsgPack (ObjectDouble d) = Just d+ fromMsgPack _ = Nothing+ +instance MsgPack Object where+ toMsgPack x = x+ fromMsgPack x = Just x+ ++( .= ) :: 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 _ _ = 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++object :: MsgPack a => MsgPack b => [(a, b)] -> Object+object l = ObjectMap (Map.fromList $ map (\(k, v) -> (toMsgPack k, toMsgPack v)) l)++array :: MsgPack a => [a] -> Object+array l = ObjectArray (map toMsgPack l)++encode :: MsgPack a => a -> B.ByteString+encode x =+ let y = toMsgPack x in+ S.encode y++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+ Left s -> Left s+