feat: add haskell bindings

.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
-        
-    
+     
+    - name: Setup Haskell env   
+      uses: haskell/actions/setup@v2
+      
+    - name: Test Haskell SDK
+      run: |
+        cd haskell
+        LD_LIBRARY_PATH=/usr/local/lib cabal test

.gitignore

@@ -27,3 +27,5 @@ rust/target
 ocaml/duniverse
 ocaml/_build
 wasm/rust-pdk/target
+dist-newstyle
+.stack-work

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.

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

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

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

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)

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

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