diff --git a/.github/workflows/ci.yml b/.github/workflows/ci.yml index d3cd70d..5bbac96 100644 --- a/.github/workflows/ci.yml +++ b/.github/workflows/ci.yml @@ -57,11 +57,11 @@ jobs: python-version: '3.9' check-latest: true - - name: Load cached Poetry installation - uses: actions/cache@v2 - with: - path: ~/.local - key: poetry-0 + # - name: Load cached Poetry installation + # uses: actions/cache@v2 + # with: + # path: ~/.local + # key: poetry-0 - name: Install Poetry uses: snok/install-poetry@v1 @@ -107,5 +107,11 @@ jobs: # opam install -y . # cd ocaml # opam exec -- dune exec extism - - \ No newline at end of file + + - name: Setup Haskell env + uses: haskell/actions/setup@v2 + + - name: Test Haskell SDK + run: | + cd haskell + LD_LIBRARY_PATH=/usr/local/lib cabal test diff --git a/.gitignore b/.gitignore index 83b1f6f..6ff209f 100644 --- a/.gitignore +++ b/.gitignore @@ -27,3 +27,5 @@ rust/target ocaml/duniverse ocaml/_build wasm/rust-pdk/target +dist-newstyle +.stack-work diff --git a/haskell/CHANGELOG.md b/haskell/CHANGELOG.md new file mode 100644 index 0000000..e6392dd --- /dev/null +++ b/haskell/CHANGELOG.md @@ -0,0 +1,5 @@ +# Revision history for extism + +## 0.1.0.0 -- YYYY-mm-dd + +* First version. Released on an unsuspecting world. diff --git a/haskell/Example.hs b/haskell/Example.hs new file mode 100644 index 0000000..9532671 --- /dev/null +++ b/haskell/Example.hs @@ -0,0 +1,17 @@ +module Main where + +import System.Exit (exitFailure, exitSuccess) +import qualified Data.ByteString as B +import Extism +import Extism.Manifest + +main = do + plugin <- Extism.registerManifest (manifest [wasmFile "../wasm/code.wasm"]) False + res <- Extism.call plugin "count_vowels" (Extism.toByteString "this is a test") + case res of + Right (Error msg) -> do + _ <- putStrLn msg + exitFailure + Left bs -> do + _ <- putStrLn (Extism.fromByteString bs) + exitSuccess diff --git a/haskell/extism.cabal b/haskell/extism.cabal new file mode 100644 index 0000000..44e1e86 --- /dev/null +++ b/haskell/extism.cabal @@ -0,0 +1,47 @@ +cabal-version: 2.4 +name: extism +version: 0.0.1.0 + +-- A short (one-line) description of the package. +synopsis: Extism bindings + +-- A longer description of the package. +description: Bindings to Extism, the universal plugin system + +-- A URL where users can report bugs. +bug-reports: https://github.com/extism/extism + +-- The license under which the package is released. +license: BSD-3-Clause + +author: Extism authors +maintainer: oss@extism.org + +-- A copyright notice. +-- copyright: +category: Plugins +extra-source-files: CHANGELOG.md + +library + exposed-modules: Extism Extism.Manifest + + -- Modules included in this library but not exported. + other-modules: + + -- LANGUAGE extensions used by modules in this package. + -- other-extensions: + build-depends: + base ^>=4.16.1.0 + , bytestring + , base64-bytestring + , json + hs-source-dirs: src + default-language: Haskell2010 + extra-libraries: extism + extra-lib-dirs: /usr/local/lib + +Test-Suite extism-example + type: exitcode-stdio-1.0 + main-is: Example.hs + build-depends: base, extism, bytestring + default-language: Haskell2010 diff --git a/haskell/src/Extism.hs b/haskell/src/Extism.hs new file mode 100644 index 0000000..de9abc2 --- /dev/null +++ b/haskell/src/Extism.hs @@ -0,0 +1,91 @@ +{-# LANGUAGE ForeignFunctionInterface #-} + +module Extism (module Extism, module Extism.Manifest) where +import GHC.Int +import GHC.Word +import Foreign.C.Types +import Foreign.Ptr +import Foreign.C.String +import Control.Monad (void) +import Data.ByteString as B +import Data.ByteString.Internal (c2w, w2c) +import Data.ByteString.Unsafe (unsafeUseAsCString) +import Text.JSON (JSON, toJSObject, encode) +import Extism.Manifest (Manifest, toString) + +foreign import ccall unsafe "extism.h extism_plugin_register" extism_plugin_register :: Ptr Word8 -> Word64 -> CBool -> IO Int32 +foreign import ccall unsafe "extism.h extism_call" extism_call :: Int32 -> CString -> Ptr Word8 -> Word64 -> IO Int32 +foreign import ccall unsafe "extism.h extism_function_exists" extism_function_exists :: Int32 -> CString -> IO CBool +foreign import ccall unsafe "extism.h extism_error" extism_error :: Int32 -> IO CString +foreign import ccall unsafe "extism.h extism_output_length" extism_output_length :: Int32 -> IO Word64 +foreign import ccall unsafe "extism.h extism_output_get" extism_output_get :: Int32 -> Ptr Word8 -> Word64 -> IO () +foreign import ccall unsafe "extism.h extism_log_file" extism_log_file :: CString -> CString -> IO CBool +foreign import ccall unsafe "extism.h extism_plugin_config" extism_plugin_config :: Int32 -> Ptr Word8 -> Int64 -> IO CBool + +newtype Plugin = Plugin Int32 deriving Show +newtype Error = Error String deriving Show + +toByteString :: String -> ByteString +toByteString x = B.pack (Prelude.map c2w x) + +fromByteString :: ByteString -> String +fromByteString bs = Prelude.map w2c $ B.unpack bs + +register :: B.ByteString -> Bool -> IO Plugin +register wasm useWasi = + let length = fromIntegral (B.length wasm) in + let wasi = fromInteger (if useWasi then 1 else 0) in + do + p <- unsafeUseAsCString wasm (\s -> + extism_plugin_register (castPtr s) length wasi) + return $ Plugin p + +registerManifest :: Manifest -> Bool -> IO Plugin +registerManifest manifest useWasi = + let wasm = toByteString $ toString manifest in + register wasm useWasi + +isValid :: Plugin -> Bool +isValid (Plugin p) = p >= 0 + +setConfig :: Plugin -> [(String, String)] -> IO () +setConfig (Plugin plugin) x = + if plugin < 0 + then return () + else + let obj = toJSObject x in + let bs = toByteString (encode obj) in + let length = fromIntegral (B.length bs) in + unsafeUseAsCString bs (\s -> do + void $ extism_plugin_config plugin (castPtr s) length) + +setLogFile :: String -> String -> IO () +setLogFile filename level = + withCString filename (\f -> + withCString level (\l -> do + void $ extism_log_file f l)) + +functionExists :: Plugin -> String -> IO Bool +functionExists (Plugin plugin) name = do + b <- withCString name (extism_function_exists plugin) + if b == 1 then return True else return False + +call :: Plugin -> String -> B.ByteString -> IO (Either B.ByteString Error) +call (Plugin plugin) name input = + let length = fromIntegral (B.length input) in + do + rc <- withCString name (\name -> + unsafeUseAsCString input (\input -> + extism_call plugin name (castPtr input) length)) + err <- extism_error plugin + if err /= nullPtr + then do e <- peekCString err + return $ Right (Error e) + else if rc == 0 + then do + length <- extism_output_length plugin + let output = B.replicate (fromIntegral length) 0 + () <- unsafeUseAsCString output (\a -> + extism_output_get plugin (castPtr a) length) + return $ Left output + else return $ Right (Error "Call failed") diff --git a/haskell/src/Extism/Manifest.hs b/haskell/src/Extism/Manifest.hs new file mode 100644 index 0000000..ddb7928 --- /dev/null +++ b/haskell/src/Extism/Manifest.hs @@ -0,0 +1,168 @@ +module Extism.Manifest where + +import Text.JSON + ( + JSValue(JSNull, JSString, JSArray), + toJSString, showJSON, makeObj, encode + ) +import qualified Data.ByteString as B +import qualified Data.ByteString.Base64 as B64 +import qualified Data.ByteString.Char8 as BS (unpack) + +valueOrNull f Nothing = JSNull +valueOrNull f (Just x) = f x +makeString s = JSString (toJSString s) +stringOrNull = valueOrNull makeString +makeArray f x = JSArray [f a | a <- x] +filterNulls obj = [(a, b) | (a, b) <- obj, not (isNull b)] +mapObj f x = makeObj (filterNulls [(a, f b) | (a, b) <- x]) +isNull JSNull = True +isNull _ = False + +newtype Memory = Memory + { + memoryMax :: Maybe Int + } + +class JSONValue a where + toJSONValue :: a -> JSValue + +instance JSONValue Memory where + toJSONValue x = + case memoryMax x of + Nothing -> makeObj [] + Just max -> makeObj [("max", showJSON max)] + +data HttpRequest = HttpRequest + { + url :: String + , header :: [(String, String)] + , method :: Maybe String + } + +requestObj x = + let meth = stringOrNull $ method x in + let h = mapObj makeString $ header x in + filterNulls [ + ("url", makeString $ url x), + ("header", h), + ("method", meth) + ] + +instance JSONValue HttpRequest where + toJSONValue x = + makeObj $ requestObj x + +data WasmFile = WasmFile + { + filePath :: String + , fileName :: Maybe String + , fileHash :: Maybe String + } + +instance JSONValue WasmFile where + toJSONValue x = + let path = makeString $ filePath x in + let name = stringOrNull $ fileName x in + let hash = stringOrNull $ fileHash x in + makeObj $ filterNulls [ + ("path", path), + ("name", name), + ("hash", hash) + ] + +data WasmCode = WasmCode + { + codeBytes :: B.ByteString + , codeName :: Maybe String + , codeHash :: Maybe String + } + + +instance JSONValue WasmCode where + toJSONValue x = + let bytes = makeString $ BS.unpack $ B64.encode $ codeBytes x in + let name = stringOrNull $ codeName x in + let hash = stringOrNull $ codeHash x in + makeObj $ filterNulls [ + ("data", bytes), + ("name", name), + ("hash", hash) + ] + +data WasmURL = WasmURL + { + req :: HttpRequest + , urlName :: Maybe String + , urlHash :: Maybe String + } + + +instance JSONValue WasmURL where + toJSONValue x = + let request = requestObj $ req x in + let name = stringOrNull $ urlName x in + let hash = stringOrNull $ urlHash x in + makeObj $ filterNulls $ ("name", name) : ("hash", hash) : request + +data Wasm = File WasmFile | Code WasmCode | URL WasmURL + +instance JSONValue Wasm where + toJSONValue x = + case x of + File f -> toJSONValue f + Code d -> toJSONValue d + URL u -> toJSONValue u + +wasmFile :: String -> Wasm +wasmFile path = + File WasmFile { filePath = path, fileName = Nothing, fileHash = Nothing} + +wasmURL :: String -> String -> Wasm +wasmURL method url = + let r = HttpRequest { url = url, header = [], method = Just method } in + URL WasmURL { req = r, urlName = Nothing, urlHash = Nothing } + +wasmCode :: B.ByteString -> Wasm +wasmCode code = + Code WasmCode { codeBytes = code, codeName = Nothing, codeHash = Nothing } + +withName :: Wasm -> String -> Wasm +withName (Code code) name = Code code { codeName = Just name } +withName (URL url) name = URL url { urlName = Just name } +withName (File f) name = File f { fileName = Just name } + + +withHash :: Wasm -> String -> Wasm +withHash (Code code) hash = Code code { codeHash = Just hash } +withHash (URL url) hash = URL url { urlHash = Just hash } +withHash (File f) hash = File f { fileHash = Just hash } + +data Manifest = Manifest + { + wasm :: [Wasm] + , memory :: Maybe Memory + , config :: [(String, String)] + } + +manifest :: [Wasm] -> Manifest +manifest wasm = Manifest {wasm = wasm, memory = Nothing, config = []} + +withConfig :: Manifest -> [(String, String)] -> Manifest +withConfig m config = + m { config = config } + +instance JSONValue Manifest where + toJSONValue x = + let w = makeArray toJSONValue $ wasm x in + let mem = valueOrNull toJSONValue $ memory x in + let c = mapObj makeString $ config x in + makeObj $ filterNulls [ + ("wasm", w), + ("memory", mem), + ("config", c) + ] + +toString :: Manifest -> String +toString manifest = + encode (toJSONValue manifest) diff --git a/haskell/stack.yaml b/haskell/stack.yaml new file mode 100644 index 0000000..6e21afc --- /dev/null +++ b/haskell/stack.yaml @@ -0,0 +1,69 @@ +# This file was automatically generated by 'stack init' +# +# Some commonly used options have been documented as comments in this file. +# For advanced use and comprehensive documentation of the format, please see: +# https://docs.haskellstack.org/en/stable/yaml_configuration/ + +# Resolver to choose a 'specific' stackage snapshot or a compiler version. +# A snapshot resolver dictates the compiler version and the set of packages +# to be used for project dependencies. For example: +# +# resolver: lts-3.5 +# resolver: nightly-2015-09-21 +# resolver: ghc-7.10.2 +# +# The location of a snapshot can be provided as a file or url. Stack assumes +# a snapshot provided as a file might change, whereas a url resource does not. +# +# resolver: ./custom-snapshot.yaml +# resolver: https://example.com/snapshots/2018-01-01.yaml +resolver: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/8/30.yaml + +# User packages to be built. +# Various formats can be used as shown in the example below. +# +# packages: +# - some-directory +# - https://example.com/foo/bar/baz-0.0.2.tar.gz +# subdirs: +# - auto-update +# - wai +packages: +- . +- dist-newstyle/tmp/src-3036517/semialign-1.2.0.1 +- dist-newstyle/tmp/src-3036516/witherable-0.4.2 +# Dependency packages to be pulled from upstream that are not in the resolver. +# These entries can reference officially published versions as well as +# forks / in-progress versions pinned to a git hash. For example: +# +# extra-deps: +# - acme-missiles-0.3 +# - git: https://github.com/commercialhaskell/stack.git +# commit: e7b331f14bcffb8367cd58fbfc8b40ec7642100a +# +# extra-deps: [] + +# Override default flag values for local packages and extra-deps +# flags: {} + +# Extra package databases containing global packages +# extra-package-dbs: [] + +# Control whether we use the GHC we find on the path +# system-ghc: true +# +# Require a specific version of stack, using version ranges +# require-stack-version: -any # Default +# require-stack-version: ">=2.7" +# +# Override the architecture used by stack, especially useful on Windows +# arch: i386 +# arch: x86_64 +# +# Extra directories used by stack for building +# extra-include-dirs: [/path/to/dir] +# extra-lib-dirs: [/path/to/dir] +# +# Allow a newer minor version of GHC than the snapshot specifies +# compiler-check: newer-minor diff --git a/haskell/stack.yaml.lock b/haskell/stack.yaml.lock new file mode 100644 index 0000000..8a4b526 --- /dev/null +++ b/haskell/stack.yaml.lock @@ -0,0 +1,13 @@ +# This file was autogenerated by Stack. +# You should not edit this file by hand. +# For more information, please see the documentation at: +# https://docs.haskellstack.org/en/stable/lock_files + +packages: [] +snapshots: +- completed: + size: 632828 + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/8/30.yaml + sha256: 5b02c2ce430ac62843fb884126765628da2ca2280bb9de0c6635c723e32a9f6b + original: + url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/nightly/2022/8/30.yaml