├── .github
    ├── CODEOWNERS
    ├── actions
    │   └── libextism
    │   │   └── action.yml
    └── workflows
    │   ├── release.yml
    │   └── ci.yml
├── .gitignore
├── test-host
    ├── Cargo.toml
    └── src
    │   └── main.rs
├── cabal.project
├── src
    ├── Extism
    │   ├── PDK
    │   │   ├── JSON.hs
    │   │   ├── Util.hs
    │   │   ├── HTTP.hs
    │   │   ├── MsgPack.hs
    │   │   ├── Bindings.hs
    │   │   └── Memory.hs
    │   └── PDK.hs
    └── extism-pdk.c
├── Makefile
├── CHANGELOG.md
├── examples
    ├── Hello.hs
    ├── HTTPGet.hs
    └── CountVowels.hs
├── LICENSE
├── extism-pdk.cabal
└── README.md


/.github/CODEOWNERS:
--------------------------------------------------------------------------------
1 | * @zshipko
2 | 


--------------------------------------------------------------------------------
/.gitignore:
--------------------------------------------------------------------------------
1 | dist-newstyle
2 | *.wasm
3 | target
4 | Cargo.lock
5 | 


--------------------------------------------------------------------------------
/test-host/Cargo.toml:
--------------------------------------------------------------------------------
1 | [package]
2 | name = "test-host"
3 | version = "0.1.0"
4 | edition = "2021"
5 | 
6 | [dependencies]
7 | extism = "*"
8 | 


--------------------------------------------------------------------------------
/cabal.project:
--------------------------------------------------------------------------------
1 | packages:
2 |   ./extism-pdk.cabal
3 | 
4 | package extism-pdk
5 |   ghc-options:
6 |     -optl -Wl,--export=hs_init -optl -Wl,--allow-undefined -no-hs-main -optl-mexec-model=reactor 
7 | 


--------------------------------------------------------------------------------
/src/Extism/PDK/JSON.hs:
--------------------------------------------------------------------------------
 1 | module Extism.PDK.JSON
 2 |   ( module Extism.PDK.JSON,
 3 |     module Extism.JSON,
 4 |     module Text.JSON.Generic,
 5 |   )
 6 | where
 7 | 
 8 | import qualified Extism.JSON
 9 | import Text.JSON.Generic
10 | 


--------------------------------------------------------------------------------
/test-host/src/main.rs:
--------------------------------------------------------------------------------
 1 | use extism::*;
 2 | 
 3 | fn main() {
 4 |     let args: Vec<String> = std::env::args().skip(1).collect();
 5 |     let wasm = std::fs::read(&args[0]).unwrap();
 6 |     let manifest = Manifest::new([wasm]).with_config_key("greeting", "Hi there");
 7 |     let mut plugin = Plugin::new(manifest, [], true).unwrap();
 8 |     let res: String = plugin.call(&args[1], &args[2]).unwrap();
 9 |     println!("{}", res);
10 | }
11 | 


--------------------------------------------------------------------------------
/src/Extism/PDK/Util.hs:
--------------------------------------------------------------------------------
 1 | module Extism.PDK.Util where
 2 | 
 3 | import qualified Data.ByteString as B
 4 | import Data.ByteString.Internal (c2w, w2c)
 5 | 
 6 | -- | Helper function to convert a string to a bytestring
 7 | toByteString :: String -> B.ByteString
 8 | toByteString x = B.pack (Prelude.map c2w x)
 9 | 
10 | -- | Helper function to convert a bytestring to a string
11 | fromByteString :: B.ByteString -> String
12 | fromByteString bs = Prelude.map w2c $ B.unpack bs
13 | 


--------------------------------------------------------------------------------
/Makefile:
--------------------------------------------------------------------------------
 1 | all: hello.example http_get.example count_vowels.example
 2 | 
 3 | update:
 4 | 	wasm32-wasi-cabal update
 5 | 
 6 | build:
 7 | 	wasm32-wasi-cabal build
 8 | 	
 9 | %.example: build
10 | 	cp `find dist-newstyle/build/wasm32-wasi/ -name $*.wasm` ./$*.wasm
11 | 
12 | test:
13 | 	extism call ./hello.wasm testing --wasi --input "World" --config greeting="Hello"
14 | 
15 | clean:
16 | 	cabal clean
17 | 
18 | publish: clean
19 | 	cabal update
20 | 	cabal v2-haddock --haddock-for-hackage
21 | 	cabal sdist
22 | 
23 | 


--------------------------------------------------------------------------------
/CHANGELOG.md:
--------------------------------------------------------------------------------
 1 | # Revision history for extism-pdk
 2 | 
 3 | ## 1.2.0.0
 4 | 
 5 | * Add bindings to `http_headers` Extism host funtion
 6 | * Add `trace` level logging
 7 | 
 8 | ## 1.1.0.0
 9 | 
10 | * Remove calls to free where Extism host expects to take ownership
11 | 
12 | ## 1.0.0.0
13 | 
14 | * Extism 1.0 compatible release
15 | 
16 | ## 0.2.0.0
17 | 
18 | * API redesign, add automatic Haskell encoding using `ToMemory` and `FromMemory` classes
19 | 
20 | ## 0.1.0.0 -- 2023-09-28
21 | 
22 | * First version. Released on an unsuspecting world.
23 | 
24 | 


--------------------------------------------------------------------------------
/.github/actions/libextism/action.yml:
--------------------------------------------------------------------------------
 1 | on: [workflow_call]
 2 | 
 3 | name: libextism
 4 | 
 5 | inputs:
 6 |   gh-token:
 7 |     description: "A GitHub PAT"
 8 |     default: ${{ github.token }}
 9 | 
10 | runs:
11 |   using: composite
12 |   steps:
13 |     - uses: actions/checkout@v3
14 |       with:
15 |         repository: extism/cli
16 |         path: .extism-cli
17 |     - uses: ./.extism-cli/.github/actions/extism-cli
18 |     - name: Install
19 |       shell: bash
20 |       run: sudo extism lib install --version git --github-token ${{ inputs.gh-token }}
21 | 


--------------------------------------------------------------------------------
/examples/Hello.hs:
--------------------------------------------------------------------------------
 1 | module Hello where
 2 | 
 3 | import Data.Maybe
 4 | import Extism.PDK
 5 | import Extism.PDK.JSON
 6 | 
 7 | defaultGreeting = "Hello"
 8 | 
 9 | greet g n =
10 |   output $ g ++ ", " ++ n
11 | 
12 | testing = do
13 |   -- Get a name from the Extism runtime
14 |   name <- inputString
15 |   -- Get  configured greeting
16 |   greeting <- getConfig "greeting"
17 |   -- Greet the user, if no greeting is configured then "Hello" is used
18 |   greet (fromMaybe defaultGreeting greeting) name
19 | 
20 | foreign export ccall "testing" testing :: IO ()
21 | 


--------------------------------------------------------------------------------
/.github/workflows/release.yml:
--------------------------------------------------------------------------------
 1 | name: "Release"
 2 | on:
 3 |   release:
 4 |     types: [created]
 5 |   workflow_dispatch:
 6 | 
 7 | jobs:
 8 |   release:
 9 |     runs-on: ubuntu-latest
10 |     steps:
11 |       - uses: actions/checkout@v3
12 |       - name: Setup Haskell env
13 |         uses: haskell/actions/setup@v2
14 |         with:
15 |           enable-stack: false
16 |       - run: make publish
17 |       - uses: haskell-actions/hackage-publish@v1
18 |         with:
19 |           hackageToken: "${{ secrets.HACKAGE_AUTH_TOKEN }}"
20 |           packagesPath: dist-newstyle/sdist
21 |           docsPath: dist-newstyle
22 |           publish: true
23 | 


--------------------------------------------------------------------------------
/examples/HTTPGet.hs:
--------------------------------------------------------------------------------
 1 | module HTTPGet where
 2 | 
 3 | import Data.Int
 4 | import Extism.PDK
 5 | import Extism.PDK.HTTP
 6 | import Extism.PDK.Memory
 7 | 
 8 | getInput = do
 9 |   req <- tryInput
10 |   case req of
11 |     Right (JSON x) -> return x
12 |     Left e -> do
13 |       putStrLn e
14 |       url <- inputString
15 |       return $ newRequest url
16 | 
17 | httpGet = do
18 |   -- Get URL or JSON encoded request from host
19 |   req <- getInput
20 |   -- Send the request, get a 'Response'
21 |   res <- sendRequest req (Nothing :: Maybe String)
22 |   -- Save response body to memory
23 |   output (responseString res)
24 |   -- Return code
25 |   return 0
26 | 
27 | foreign export ccall "http_get" httpGet :: IO Int32
28 | 


--------------------------------------------------------------------------------
/examples/CountVowels.hs:
--------------------------------------------------------------------------------
 1 | {-# LANGUAGE DeriveDataTypeable #-}
 2 | 
 3 | module CountVowels where
 4 | 
 5 | import Extism.PDK
 6 | import Extism.PDK.JSON
 7 | 
 8 | data Output = Output {count :: Int} deriving (Data)
 9 | 
10 | isVowel c =
11 |   c == 'a'
12 |     || c == 'A'
13 |     || c == 'e'
14 |     || c == 'E'
15 |     || c == 'i'
16 |     || c == 'I'
17 |     || c == 'o'
18 |     || c == 'O'
19 |     || c == 'u'
20 |     || c == 'U'
21 | 
22 | countVowels = do
23 |   -- Get input string from Extism host
24 |   s <- input
25 | 
26 |   -- Log input
27 |   () <- Extism.PDK.log LogInfo ("Got input: " ++ s)
28 | 
29 |   -- Calculate the number of vowels
30 |   let count = length (filter isVowel s)
31 |   -- Return a JSON object {"count": count} back to the host
32 |   output $ JSON $ Output count
33 | 
34 | foreign export ccall "count_vowels" countVowels :: IO ()
35 | 


--------------------------------------------------------------------------------
/LICENSE:
--------------------------------------------------------------------------------
 1 | Copyright 2022 Dylibso, Inc.
 2 | 
 3 | Redistribution and use in source and binary forms, with or without modification, are permitted provided that the following conditions are met:
 4 | 
 5 | 1. Redistributions of source code must retain the above copyright notice, this list of conditions and the following disclaimer.
 6 | 
 7 | 2. Redistributions in binary form must reproduce the above copyright notice, this list of conditions and the following disclaimer in the documentation and/or other materials provided with the distribution.
 8 | 
 9 | 3. Neither the name of the copyright holder nor the names of its contributors may be used to endorse or promote products derived from this software without specific prior written permission.
10 | 
11 | THIS SOFTWARE IS PROVIDED BY THE COPYRIGHT HOLDERS AND CONTRIBUTORS "AS IS" AND ANY EXPRESS OR IMPLIED WARRANTIES, INCLUDING, BUT NOT LIMITED TO, THE IMPLIED WARRANTIES OF MERCHANTABILITY AND FITNESS FOR A PARTICULAR PURPOSE ARE DISCLAIMED. IN NO EVENT SHALL THE COPYRIGHT HOLDER OR CONTRIBUTORS BE LIABLE FOR ANY DIRECT, INDIRECT, INCIDENTAL, SPECIAL, EXEMPLARY, OR CONSEQUENTIAL DAMAGES (INCLUDING, BUT NOT LIMITED TO, PROCUREMENT OF SUBSTITUTE GOODS OR SERVICES; LOSS OF USE, DATA, OR PROFITS; OR BUSINESS INTERRUPTION) HOWEVER CAUSED AND ON ANY THEORY OF LIABILITY, WHETHER IN CONTRACT, STRICT LIABILITY, OR TORT (INCLUDING NEGLIGENCE OR OTHERWISE) ARISING IN ANY WAY OUT OF THE USE OF THIS SOFTWARE, EVEN IF ADVISED OF THE POSSIBILITY OF SUCH DAMAGE.


--------------------------------------------------------------------------------
/.github/workflows/ci.yml:
--------------------------------------------------------------------------------
 1 | name: CI
 2 | on: [push, pull_request]
 3 | 
 4 | jobs:
 5 |   test-example:
 6 |     runs-on: ${{ matrix.os }}
 7 |     strategy:
 8 |       matrix:
 9 |         os: [ubuntu-latest]
10 |         rust:
11 |           - stable
12 |     steps:
13 |       - uses: actions/checkout@v3
14 |       - uses: ./.github/actions/libextism
15 |       - uses: actions-rs/toolchain@v1
16 |         with:
17 |           toolchain: stable
18 | 
19 |       - name: Install wasm32-wasi-ghc (main)
20 |         run: |
21 |           git clone https://gitlab.haskell.org/ghc/ghc-wasm-meta
22 |           pushd ghc-wasm-meta
23 |           FLAVOUR=9.12 ./setup.sh
24 | 
25 |       - name: Build examples with tail-call support
26 |         run: |
27 |           source ~/.ghc-wasm/env
28 |           make
29 | 
30 |       - name: Test with tail-call support
31 |         run: |
32 |           pushd test-host
33 |           TEST=$(cargo run --release ../count_vowels.wasm count_vowels "this is a test")
34 |           echo $TEST | grep '"count":4'
35 |           TEST=$(cargo run ../hello.wasm testing "Name")
36 |           echo $TEST | grep 'Hi there, Name'
37 |       
38 |       - name: Install wasm32-wasi-ghc with no tail-call support
39 |         run: |
40 |           pushd ghc-wasm-meta
41 |           git checkout ada3b8fa0f763e4dccb2b1f6bbf2518bff2a7c6e
42 |           FLAVOUR=9.12 ./setup.sh
43 |       
44 |       - name: Build examples with no tail-call support
45 |         run: |
46 |           source ~/.ghc-wasm/env
47 |           make clean
48 |           make
49 | 
50 |       - name: Test call command with no tail-call support
51 |         run: |
52 |           TEST=$(extism call ./count_vowels.wasm count_vowels --wasi --input "this is a test")
53 |           echo $TEST | grep '"count":4'
54 | 
55 |           TEST=$(extism call ./hello.wasm testing --wasi --input "Name" --config greeting="Hi there")
56 |           echo $TEST | grep 'Hi there, Name'
57 | 
58 |           TEST=$(extism call ./http_get.wasm http_get --wasi --input "https://jsonplaceholder.typicode.com/todos/1" --allow-host '*.typicode.com')
59 |           echo $TEST | grep '"userId": 1'
60 | 


--------------------------------------------------------------------------------
/extism-pdk.cabal:
--------------------------------------------------------------------------------
 1 | cabal-version:      3.0
 2 | name:               extism-pdk
 3 | version:            1.2.0.0
 4 | 
 5 | -- A short (one-line) description of the package.
 6 | synopsis: Extism Plugin Development Kit
 7 | 
 8 | -- A longer description of the package.
 9 | description: Haskell bindings to the Extism runtime for use with wasm32-wasi-ghc
10 | 
11 | -- A URL where users can report bugs.
12 | bug-reports: https://github.com/extism/haskell-pdk
13 | 
14 | -- The license under which the package is released.
15 | license: BSD-3-Clause
16 | author:             Extism Authors
17 | maintainer:         oss@dylib.so
18 | 
19 | category: WASM, plugins
20 | extra-doc-files: CHANGELOG.md
21 | 
22 | library
23 |     exposed-modules:
24 |       Extism.PDK
25 |       Extism.PDK.Bindings
26 |       Extism.PDK.HTTP
27 |       Extism.PDK.JSON
28 |       Extism.PDK.MsgPack
29 |       Extism.PDK.Util
30 |       Extism.PDK.Memory
31 | 
32 |     -- Modules included in this executable, other than Main.
33 |     -- other-modules:
34 | 
35 |     -- LANGUAGE extensions used by modules in this package.
36 |     -- other-extensions:
37 |     build-depends:
38 |       base >= 4.15.0 && < 5,
39 |       bytestring >= 0.11.4 && <= 0.12,
40 |       cereal >= 0.5.8 && < 0.6,
41 |       containers >= 0.6.7 && < 0.7,
42 |       extism-manifest >= 1.0.0 && < 2.0.0,
43 |       json >= 0.11 && < 0.12,
44 |       messagepack >= 0.5.5 && < 0.6,
45 |       binary >= 0.8.9 && < 0.9.0
46 | 
47 |     hs-source-dirs:   src
48 |     default-language: Haskell2010
49 |     c-sources: src/extism-pdk.c
50 | 
51 | executable hello
52 |     scope: private
53 |     main-is: examples/Hello.hs
54 |     build-depends: base, extism-pdk
55 |     default-language: Haskell2010
56 |     ghc-options:
57 |       -optl -Wl,--export=testing 
58 | 
59 | executable http_get
60 |     scope: private
61 |     main-is: examples/HTTPGet.hs
62 |     build-depends: base, extism-pdk
63 |     default-language: Haskell2010
64 |     ghc-options:
65 |       -optl -Wl,--export=http_get
66 | 
67 | executable count_vowels
68 |     scope: private
69 |     main-is: examples/CountVowels.hs
70 |     build-depends: base, extism-pdk
71 |     default-language: Haskell2010
72 |     ghc-options:
73 |       -optl -Wl,--export=count_vowels
74 | 


--------------------------------------------------------------------------------
/src/extism-pdk.c:
--------------------------------------------------------------------------------
 1 | #include <stdint.h>
 2 | 
 3 | #define IMPORT(a, b) __attribute__((import_module(a), import_name(b)))
 4 | 
 5 | typedef uint64_t ExtismPointer;
 6 | 
 7 | #define DEFINE(name, t, ...)                                                   \
 8 |   IMPORT("extism:host/env", #name) extern t _##name(__VA_ARGS__);
 9 | 
10 | DEFINE(input_length, uint64_t)
11 | uint64_t extism_input_length() { return _input_length(); }
12 | 
13 | DEFINE(length, uint64_t, ExtismPointer)
14 | uint64_t extism_length(ExtismPointer p) { return _length(p); }
15 | 
16 | DEFINE(length_unsafe, uint64_t, ExtismPointer)
17 | uint64_t extism_length_unsafe(ExtismPointer p) { return _length_unsafe(p); }
18 | 
19 | DEFINE(alloc, ExtismPointer, uint64_t)
20 | uint64_t extism_alloc(uint64_t n) { return _alloc(n); }
21 | 
22 | DEFINE(free, void, ExtismPointer)
23 | void extism_free(uint64_t n) { return _free(n); }
24 | 
25 | DEFINE(input_load_u8, uint8_t, ExtismPointer)
26 | uint8_t extism_input_load_u8(ExtismPointer p) { return _input_load_u8(p); }
27 | 
28 | DEFINE(input_load_u64, uint64_t, ExtismPointer)
29 | uint64_t extism_input_load_u64(ExtismPointer p) { return _input_load_u64(p); }
30 | 
31 | DEFINE(output_set, void, ExtismPointer, uint64_t)
32 | void extism_output_set(ExtismPointer p, uint64_t n) {
33 |   return _output_set(p, n);
34 | }
35 | 
36 | DEFINE(error_set, void, ExtismPointer)
37 | void extism_error_set(ExtismPointer p) { _error_set(p); }
38 | 
39 | DEFINE(config_get, ExtismPointer, ExtismPointer)
40 | ExtismPointer extism_config_get(ExtismPointer p) { return _config_get(p); }
41 | 
42 | DEFINE(var_get, ExtismPointer, ExtismPointer)
43 | ExtismPointer extism_var_get(ExtismPointer p) { return _var_get(p); }
44 | 
45 | DEFINE(var_set, void, ExtismPointer, ExtismPointer)
46 | void extism_var_set(ExtismPointer k, ExtismPointer v) { return _var_set(k, v); }
47 | 
48 | DEFINE(store_u8, void, ExtismPointer, uint8_t)
49 | void extism_store_u8(ExtismPointer p, uint8_t x) { return _store_u8(p, x); }
50 | 
51 | DEFINE(load_u8, uint8_t, ExtismPointer)
52 | uint8_t extism_load_u8(ExtismPointer p) { return _load_u8(p); }
53 | 
54 | DEFINE(store_u64, void, ExtismPointer, uint64_t)
55 | void extism_store_u64(ExtismPointer p, uint64_t x) { return _store_u64(p, x); }
56 | 
57 | DEFINE(load_u64, uint64_t, ExtismPointer)
58 | uint64_t extism_load_u64(ExtismPointer p) { return _load_u64(p); }
59 | 
60 | DEFINE(http_request, ExtismPointer, ExtismPointer, ExtismPointer)
61 | ExtismPointer extism_http_request(ExtismPointer req, ExtismPointer body) {
62 |   return _http_request(req, body);
63 | }
64 | 
65 | DEFINE(http_status_code, int32_t)
66 | int32_t extism_http_status_code() { return _http_status_code(); }
67 | 
68 | DEFINE(http_headers, ExtismPointer)
69 | ExtismPointer extism_http_headers() { return _http_headers(); }
70 | 
71 | DEFINE(log_info, void, ExtismPointer)
72 | void extism_log_info(ExtismPointer p) { return _log_info(p); }
73 | DEFINE(log_debug, void, ExtismPointer)
74 | void extism_log_debug(ExtismPointer p) { return _log_debug(p); }
75 | DEFINE(log_warn, void, ExtismPointer)
76 | void extism_log_warn(ExtismPointer p) { return _log_warn(p); }
77 | DEFINE(log_error, void, ExtismPointer)
78 | void extism_log_error(ExtismPointer p) { return _log_error(p); }
79 | DEFINE(log_trace, void, ExtismPointer)
80 | void extism_log_trace(ExtismPointer p) { return _log_trace(p); }
81 | DEFINE(get_log_level, int32_t)
82 | int32_t extism_get_log_level() { return _get_log_level(); }
83 | 


--------------------------------------------------------------------------------
/src/Extism/PDK.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE Rank2Types #-}
  2 | 
  3 | -- |
  4 | -- Extism plugin development kit, used with the [wasm32-wasi-ghc](https://gitlab.haskell.org/ghc/ghc-wasm-meta) backend to make Extism plugins
  5 | module Extism.PDK
  6 |   ( module Extism.PDK,
  7 |     ToBytes (..),
  8 |     FromBytes (..),
  9 |     JSON (..),
 10 |     MsgPack (..),
 11 |   )
 12 | where
 13 | 
 14 | import Data.ByteString as B
 15 | import Extism.PDK.Bindings
 16 | import Extism.PDK.Memory
 17 | import qualified Extism.PDK.MsgPack (MsgPack, decode, encode)
 18 | import Extism.PDK.Util
 19 | import qualified Text.JSON (decode, encode, resultToEither)
 20 | import qualified Text.JSON.Generic
 21 | 
 22 | -- | Get plugin input, returning an error message if the encoding is invalid
 23 | tryInput :: (FromBytes a) => IO (Either String a)
 24 | tryInput = fromBytes <$> inputByteString
 25 | 
 26 | -- | Get plugin input
 27 | input :: forall a. (FromBytes a) => IO a
 28 | input = do
 29 |   i <- inputByteString
 30 |   case fromBytes i of
 31 |     Left e -> error e
 32 |     Right y -> return y
 33 | 
 34 | -- | Get plugin input as a String
 35 | inputString :: IO String
 36 | inputString = do
 37 |   len <- extismInputLength
 38 |   fromByteString <$> readInputBytes len
 39 | 
 40 | -- | Get plugin input as a ByteString
 41 | inputByteString :: IO ByteString
 42 | inputByteString = do
 43 |   len <- extismInputLength
 44 |   readInputBytes len
 45 | 
 46 | -- | Get input as 'JSON', this is similar to calling `input (JsonValue ...)`
 47 | inputJSON :: (Text.JSON.Generic.Data a) => IO a
 48 | inputJSON = do
 49 |   Text.JSON.Generic.decodeJSON <$> input
 50 | 
 51 | -- | Set plugin output
 52 | output :: (ToBytes a) => a -> IO ()
 53 | output x = do
 54 |   Memory offs len <- alloc x
 55 |   extismSetOutput offs len
 56 | 
 57 | -- | Set plugin output to a JSON encoded version of the provided value
 58 | outputJSON :: (Text.JSON.Generic.Data a) => a -> IO ()
 59 | outputJSON x =
 60 |   output (Text.JSON.Generic.encodeJSON x)
 61 | 
 62 | -- | Get a variable from the Extism runtime
 63 | getVar :: (FromBytes a) => String -> IO (Maybe a)
 64 | getVar key = do
 65 |   k <- allocString key
 66 |   v <- extismGetVar (memoryOffset k)
 67 |   if v == 0
 68 |     then return Nothing
 69 |     else do
 70 |       mem <- findMemory v
 71 |       bs <- load mem
 72 |       case bs of
 73 |         Left _ -> return Nothing
 74 |         Right x -> return (Just x)
 75 | 
 76 | -- | Set a variable
 77 | setVar :: (ToBytes a) => String -> Maybe a -> IO ()
 78 | setVar key Nothing = do
 79 |   k <- allocString key
 80 |   extismSetVar (memoryOffset k) 0
 81 | setVar key (Just v) = do
 82 |   k <- allocString key
 83 |   x <- alloc v
 84 |   extismSetVar (memoryOffset k) (memoryOffset x)
 85 | 
 86 | -- | Get a configuration value
 87 | getConfig :: String -> IO (Maybe String)
 88 | getConfig key = do
 89 |   k <- allocString key
 90 |   v <- extismGetConfig (memoryOffset k)
 91 |   if v == 0
 92 |     then return Nothing
 93 |     else do
 94 |       mem <- findMemory v
 95 |       s <- loadString mem
 96 |       free mem
 97 |       return $ Just s
 98 | 
 99 | -- | Set the current error message
100 | setError :: String -> IO ()
101 | setError msg = do
102 |   s <- allocString msg
103 |   extismSetError $ memoryOffset s
104 | 
105 | -- | Log level
106 | data LogLevel = LogTrace | LogDebug | LogInfo | LogWarn | LogError deriving (Enum)
107 | 
108 | -- | Log to configured log file
109 | log :: LogLevel -> String -> IO ()
110 | log level msg = do
111 |   configuredLevel <- extismGetLogLevel
112 |   if fromIntegral (fromEnum level) < configuredLevel
113 |     then return ()
114 |     else do
115 |       s <- allocString msg
116 |       let offs = memoryOffset s
117 |       case level of
118 |         LogTrace -> extismLogTrace offs
119 |         LogDebug -> extismLogDebug offs
120 |         LogInfo -> extismLogInfo offs
121 |         LogWarn -> extismLogWarn offs
122 |         LogError -> extismLogError offs
123 | 
124 | -- Log with "error" level
125 | logError :: String -> IO ()
126 | logError = Extism.PDK.log LogError
127 | 
128 | -- Log with "info" level
129 | logInfo :: String -> IO ()
130 | logInfo = Extism.PDK.log LogInfo
131 | 
132 | -- Log with "debug" level
133 | logDebug :: String -> IO ()
134 | logDebug = Extism.PDK.log LogDebug
135 | 
136 | -- Log with "warn" level
137 | logWarn :: String -> IO ()
138 | logWarn = Extism.PDK.log LogWarn
139 | 
140 | -- Log with "trace" level
141 | logTrace :: String -> IO ()
142 | logTrace = Extism.PDK.log LogTrace
143 | 


--------------------------------------------------------------------------------
/src/Extism/PDK/HTTP.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE DeriveDataTypeable #-}
  2 | 
  3 | -- |
  4 | -- Contains bindings to the Extism PDK HTTP interface
  5 | module Extism.PDK.HTTP where
  6 | 
  7 | import Data.ByteString as B
  8 | import Data.Word
  9 | import Extism.JSON (Nullable (..))
 10 | import qualified Extism.Manifest (HTTPRequest (..))
 11 | import Extism.PDK
 12 | import Extism.PDK.Bindings
 13 | import Extism.PDK.Memory
 14 | import Extism.PDK.Util (fromByteString)
 15 | import Text.JSON (Result (..), decode, encode, makeObj)
 16 | import qualified Text.JSON.Generic
 17 | 
 18 | -- | HTTP Request
 19 | data Request = Request
 20 |   { url :: String,
 21 |     headers :: [(String, String)],
 22 |     method :: String
 23 |   }
 24 |   deriving (Text.JSON.Generic.Typeable, Text.JSON.Generic.Data)
 25 | 
 26 | -- | HTTP Response
 27 | data Response = Response
 28 |   { statusCode :: Int,
 29 |     responseData :: ByteString,
 30 |     responseHeaders :: [(String, String)]
 31 |   }
 32 | 
 33 | -- | Creates a new 'Request'
 34 | newRequest :: String -> Request
 35 | newRequest url =
 36 |   Request url [] "GET"
 37 | 
 38 | -- | Update a 'Request' with the provided HTTP request method (GET, POST, PUT, DELETE, ...)
 39 | withMethod :: String -> Request -> Request
 40 | withMethod meth req =
 41 |   req {method = meth}
 42 | 
 43 | -- | Update a 'Request' with the provided HTTP request headers
 44 | withHeaders :: [(String, String)] -> Request -> Request
 45 | withHeaders h req =
 46 |   req {headers = h}
 47 | 
 48 | -- | Get the 'Response' body as a 'ByteString'
 49 | responseByteString :: Response -> ByteString
 50 | responseByteString (Response _ mem _) = mem
 51 | 
 52 | -- | Get the 'Response' body as a 'String'
 53 | responseString :: Response -> String
 54 | responseString (Response _ mem _) = fromByteString mem
 55 | 
 56 | -- | Get the 'Response' body as JSON
 57 | responseJSON :: (Text.JSON.Generic.Data a) => Response -> IO (Either String a)
 58 | responseJSON res = do
 59 |   case json of
 60 |     Ok json ->
 61 |       case Text.JSON.Generic.fromJSON json of
 62 |         Ok x -> return $ Right x
 63 |         Error msg -> return (Left msg)
 64 |     Error msg -> return (Left msg)
 65 |   where
 66 |     s = responseString res
 67 |     json = decode s
 68 | 
 69 | -- | Get the 'Response' body and decode it
 70 | response :: (FromBytes a) => Response -> Either String a
 71 | response (Response _ mem _) = fromBytes mem
 72 | 
 73 | getHeaders = do
 74 |   offs <- extismHTTPHeaders
 75 |   if offs == 0
 76 |     then
 77 |       return []
 78 |     else do
 79 |       mem <- Extism.PDK.Memory.findMemory offs
 80 |       h <- Extism.PDK.Memory.load mem
 81 |       () <- Extism.PDK.Memory.free mem
 82 |       case h of
 83 |         Left _ -> return []
 84 |         Right (JSON x) -> return x
 85 | 
 86 | -- | Send HTTP request with an optional request body
 87 | sendRequestWithBody :: (ToBytes a) => Request -> a -> IO Response
 88 | sendRequestWithBody req b = do
 89 |   body <- alloc b
 90 |   let json =
 91 |         encode
 92 |           Extism.Manifest.HTTPRequest
 93 |             { Extism.Manifest.url = url req,
 94 |               Extism.Manifest.headers = NotNull $ headers req,
 95 |               Extism.Manifest.method = NotNull $ method req
 96 |             }
 97 |   j <- allocString json
 98 |   res <- extismHTTPRequest (memoryOffset j) (memoryOffset body)
 99 |   code <- extismHTTPStatusCode
100 |   h <- getHeaders
101 |   if res == 0
102 |     then return (Response (fromIntegral code) empty h)
103 |     else do
104 |       mem <- findMemory res
105 |       bs <- loadByteString mem
106 |       free mem
107 |       return (Response (fromIntegral code) bs h)
108 | 
109 | -- | Send HTTP request with an optional request body
110 | sendRequest :: (ToBytes a) => Request -> Maybe a -> IO Response
111 | sendRequest req b = do
112 |   body <- bodyMem
113 |   j <- allocString json
114 |   res <- extismHTTPRequest (memoryOffset j) (memoryOffset body)
115 |   code <- extismHTTPStatusCode
116 |   h <- getHeaders
117 |   if res == 0
118 |     then return (Response (fromIntegral code) empty h)
119 |     else do
120 |       len <- extismLengthUnsafe res
121 |       let mem = Memory res len
122 |       bs <- loadByteString mem
123 |       free mem
124 |       return (Response (fromIntegral code) bs h)
125 |   where
126 |     json =
127 |       encode
128 |         Extism.Manifest.HTTPRequest
129 |           { Extism.Manifest.url = url req,
130 |             Extism.Manifest.headers = NotNull $ headers req,
131 |             Extism.Manifest.method = NotNull $ method req
132 |           }
133 |     bodyMem = case b of
134 |       Nothing -> return $ Memory 0 0
135 |       Just b -> alloc b
136 | 


--------------------------------------------------------------------------------
/src/Extism/PDK/MsgPack.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE FlexibleInstances #-}
  2 | {-# LANGUAGE TypeOperators #-}
  3 | 
  4 | -- |
  5 | -- Provides the ability to use MessagePack for plugin input/output
  6 | module Extism.PDK.MsgPack
  7 |   ( module Extism.PDK.MsgPack,
  8 |     module Data.MessagePack,
  9 |     module Map,
 10 |   )
 11 | where
 12 | 
 13 | import Data.Bifunctor (bimap)
 14 | import qualified Data.ByteString as B
 15 | import Data.ByteString.Internal (c2w, w2c)
 16 | import Data.Int
 17 | import qualified Data.Map.Strict as Map
 18 | import Data.MessagePack
 19 | import qualified Data.Serialize as S
 20 | import Data.Word
 21 | import GHC.Generics
 22 | 
 23 | class MsgPack a where
 24 |   toMsgPack :: a -> Object
 25 |   fromMsgPack :: Object -> Maybe a
 26 | 
 27 | class GMsgPack f where
 28 |   toGMsgPack :: f a -> Object
 29 |   fromGMsgPack :: Object -> Maybe (f a)
 30 |   fromGMsgPack _ = Nothing
 31 | 
 32 | instance GMsgPack U1 where
 33 |   toGMsgPack U1 = ObjectNil
 34 |   fromGMsgPack ObjectNil = Just U1
 35 | 
 36 | instance (GMsgPack a, GMsgPack b) => GMsgPack (a :*: b) where
 37 |   toGMsgPack (x :*: y) = array [toGMsgPack x, toGMsgPack y]
 38 | 
 39 | -- fromGMsgPack (ObjectArray [a, b]) = Just (a :*: b)
 40 | 
 41 | instance (GMsgPack a, GMsgPack b) => GMsgPack (a :+: b) where
 42 |   toGMsgPack (L1 x) = toGMsgPack x
 43 |   toGMsgPack (R1 x) = toGMsgPack x
 44 | 
 45 | instance (GMsgPack a) => GMsgPack (M1 i c a) where
 46 |   toGMsgPack (M1 x) = toGMsgPack x
 47 | 
 48 | instance (MsgPack a) => GMsgPack (K1 i a) where
 49 |   toGMsgPack (K1 x) = toMsgPack x
 50 | 
 51 | toByteString x = B.pack (Prelude.map c2w x)
 52 | 
 53 | fromByteString bs = Prelude.map w2c $ B.unpack bs
 54 | 
 55 | instance MsgPack Bool where
 56 |   toMsgPack = ObjectBool
 57 |   fromMsgPack (ObjectBool b) = Just b
 58 |   fromMsgPack _ = Nothing
 59 | 
 60 | instance MsgPack String where
 61 |   toMsgPack s = ObjectString (toByteString s)
 62 |   fromMsgPack (ObjectString s) = Just (fromByteString s)
 63 |   fromMsgPack _ = Nothing
 64 | 
 65 | instance MsgPack B.ByteString where
 66 |   toMsgPack = ObjectBinary
 67 |   fromMsgPack (ObjectString s) = Just s
 68 |   fromMsgPack (ObjectBinary s) = Just s
 69 |   fromMsgPack _ = Nothing
 70 | 
 71 | instance MsgPack Int where
 72 |   toMsgPack i = ObjectInt (fromIntegral i)
 73 |   fromMsgPack (ObjectInt i) = Just (fromIntegral i)
 74 |   fromMsgPack _ = Nothing
 75 | 
 76 | instance MsgPack Int64 where
 77 |   toMsgPack = ObjectInt
 78 |   fromMsgPack (ObjectInt i) = Just i
 79 |   fromMsgPack _ = Nothing
 80 | 
 81 | instance MsgPack Word where
 82 |   toMsgPack w = ObjectUInt (fromIntegral w)
 83 |   fromMsgPack (ObjectUInt x) = Just (fromIntegral x)
 84 |   fromMsgPack _ = Nothing
 85 | 
 86 | instance MsgPack Word64 where
 87 |   toMsgPack = ObjectUInt
 88 |   fromMsgPack (ObjectUInt x) = Just x
 89 |   fromMsgPack _ = Nothing
 90 | 
 91 | instance (MsgPack a) => MsgPack (Maybe a) where
 92 |   toMsgPack Nothing = ObjectNil
 93 |   toMsgPack (Just a) = toMsgPack a
 94 |   fromMsgPack = fromMsgPack
 95 | 
 96 | instance MsgPack () where
 97 |   toMsgPack () = ObjectNil
 98 |   fromMsgPack ObjectNil = Just ()
 99 |   fromMsgPack _ = Nothing
100 | 
101 | instance MsgPack Float where
102 |   toMsgPack = ObjectFloat
103 |   fromMsgPack (ObjectFloat f) = Just f
104 |   fromMsgPack _ = Nothing
105 | 
106 | instance MsgPack Double where
107 |   toMsgPack = ObjectDouble
108 |   fromMsgPack (ObjectDouble d) = Just d
109 |   fromMsgPack _ = Nothing
110 | 
111 | instance MsgPack Object where
112 |   toMsgPack x = x
113 |   fromMsgPack = Just
114 | 
115 | (.=) :: (MsgPack a) => (MsgPack b) => a -> b -> (Object, Object)
116 | (.=) k v = (toMsgPack k, toMsgPack v)
117 | 
118 | lookup :: (MsgPack a) => (MsgPack b) => a -> Object -> Maybe b
119 | lookup k (ObjectMap map) =
120 |   let x = Map.lookup (toMsgPack k) map
121 |    in fromMsgPack =<< x
122 | lookup _ _ = Nothing
123 | 
124 | set k v (ObjectMap map) =
125 |   ObjectMap $ Map.insert (toMsgPack k) (toMsgPack v) map
126 | 
127 | (.?) :: (MsgPack a) => (MsgPack b) => Object -> a -> Maybe b
128 | (.?) a b = Extism.PDK.MsgPack.lookup b a
129 | 
130 | object :: (MsgPack a) => (MsgPack b) => [(a, b)] -> Object
131 | object l = ObjectMap (Map.fromList $ map (bimap toMsgPack toMsgPack) l)
132 | 
133 | array :: (MsgPack a) => [a] -> Object
134 | array l = ObjectArray (map toMsgPack l)
135 | 
136 | encode :: (MsgPack a) => a -> B.ByteString
137 | encode x =
138 |   let y = toMsgPack x
139 |    in S.encode y
140 | 
141 | decode :: (MsgPack a) => B.ByteString -> Either String a
142 | decode bs =
143 |   case S.decode bs of
144 |     Right a -> case fromMsgPack a of
145 |       Nothing -> Left "Invalid type conversion"
146 |       Just x -> Right x
147 |     Left s -> Left s
148 | 


--------------------------------------------------------------------------------
/src/Extism/PDK/Bindings.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE TypeApplications #-}
  2 | 
  3 | module Extism.PDK.Bindings where
  4 | 
  5 | import Control.Monad
  6 | import Data.ByteString as B
  7 | import Data.ByteString.Internal
  8 | import Data.Int
  9 | import Data.Word
 10 | import Foreign.C.Types
 11 | import Foreign.ForeignPtr
 12 | import Foreign.Ptr
 13 | import Foreign.Storable
 14 | import System.Exit
 15 | 
 16 | -- | Offset in Extism memory
 17 | type MemoryOffset = Word64
 18 | 
 19 | -- | Offset of input from 0 to 'InputLength'
 20 | type InputOffset = Word64
 21 | 
 22 | -- | Length of allocated block of memory
 23 | type MemoryLength = Word64
 24 | 
 25 | -- | Total length of the input
 26 | type InputLength = Word64
 27 | 
 28 | foreign import ccall "extism_output_set" extismSetOutput :: MemoryOffset -> MemoryLength -> IO ()
 29 | 
 30 | foreign import ccall "extism_error_set" extismSetError :: MemoryOffset -> IO ()
 31 | 
 32 | foreign import ccall "extism_log_info" extismLogInfo :: MemoryOffset -> IO ()
 33 | 
 34 | foreign import ccall "extism_log_warn" extismLogWarn :: MemoryOffset -> IO ()
 35 | 
 36 | foreign import ccall "extism_log_debug" extismLogDebug :: MemoryOffset -> IO ()
 37 | 
 38 | foreign import ccall "extism_log_error" extismLogError :: MemoryOffset -> IO ()
 39 | 
 40 | foreign import ccall "extism_log_trace" extismLogTrace :: MemoryOffset -> IO ()
 41 | 
 42 | foreign import ccall "extism_get_log_level" extismGetLogLevel :: IO Int32
 43 | 
 44 | foreign import ccall "extism_store_u8" extismStoreU8 :: MemoryOffset -> Word8 -> IO ()
 45 | 
 46 | foreign import ccall "extism_store_u64" extismStoreU64 :: MemoryOffset -> Word64 -> IO ()
 47 | 
 48 | foreign import ccall "extism_load_u8" extismLoadU8 :: MemoryOffset -> IO Word8
 49 | 
 50 | foreign import ccall "extism_load_u64" extismLoadU64 :: MemoryOffset -> IO Word64
 51 | 
 52 | foreign import ccall "extism_alloc" extismAlloc :: MemoryLength -> IO MemoryOffset
 53 | 
 54 | foreign import ccall "extism_length" extismLength :: MemoryOffset -> IO MemoryLength
 55 | 
 56 | foreign import ccall "extism_length_unsafe" extismLengthUnsafe :: MemoryOffset -> IO MemoryLength
 57 | 
 58 | foreign import ccall "extism_free" extismFree :: MemoryOffset -> IO ()
 59 | 
 60 | foreign import ccall "extism_input_length" extismInputLength :: IO InputLength
 61 | 
 62 | foreign import ccall "extism_input_load_u8" extismInputLoadU8 :: InputOffset -> IO Word8
 63 | 
 64 | foreign import ccall "extism_input_load_u64" extismInputLoadU64 :: InputOffset -> IO Word64
 65 | 
 66 | foreign import ccall "extism_config_get" extismGetConfig :: MemoryOffset -> IO MemoryOffset
 67 | 
 68 | foreign import ccall "extism_var_get" extismGetVar :: MemoryOffset -> IO MemoryOffset
 69 | 
 70 | foreign import ccall "extism_var_set" extismSetVar :: MemoryOffset -> MemoryOffset -> IO ()
 71 | 
 72 | foreign import ccall "extism_http_request" extismHTTPRequest :: MemoryOffset -> MemoryOffset -> IO MemoryOffset
 73 | 
 74 | foreign import ccall "extism_http_status_code" extismHTTPStatusCode :: IO Int32
 75 | 
 76 | foreign import ccall "extism_http_headers" extismHTTPHeaders :: IO MemoryOffset
 77 | 
 78 | foreign import ccall "__wasm_call_ctors" wasmConstructor :: IO ()
 79 | 
 80 | foreign import ccall "__wasm_call_dtors" wasmDestructor :: IO ()
 81 | 
 82 | bsToWord64 :: ByteString -> IO Word64
 83 | bsToWord64 (BS fp len) =
 84 |   if len /= 8
 85 |     then error "invalid bytestring"
 86 |     else
 87 |       withForeignPtr fp $ peek . castPtr @Word8 @Word64
 88 | 
 89 | word64ToBS :: Word64 -> ByteString
 90 | word64ToBS word =
 91 |   unsafeCreate 8 $ \p ->
 92 |     poke (castPtr @Word8 @Word64 p) word
 93 | 
 94 | readLoop :: (Word64 -> IO Word8) -> (Word64 -> IO Word64) -> Word64 -> Word64 -> [ByteString] -> IO ByteString
 95 | readLoop f1 f8 total index acc =
 96 |   if index >= total
 97 |     then return $ B.concat . Prelude.reverse $ acc
 98 |     else do
 99 |       (n, x) <-
100 |         if total - index >= 8
101 |           then do
102 |             u <- f8 index
103 |             return (8, word64ToBS u)
104 |           else do
105 |             b <- f1 index
106 |             return (1, B.singleton b)
107 |       readLoop f1 f8 total (index + n) (x : acc)
108 | 
109 | readInputBytes :: InputLength -> IO ByteString
110 | readInputBytes len =
111 |   readLoop extismInputLoadU8 extismInputLoadU64 len 0 []
112 | 
113 | readBytes :: MemoryOffset -> MemoryLength -> IO ByteString
114 | readBytes offs len =
115 |   readLoop extismLoadU8 extismLoadU64 (offs + len) offs []
116 | 
117 | writeBytesLoop :: MemoryOffset -> MemoryOffset -> ByteString -> IO ()
118 | writeBytesLoop index total src =
119 |   if index >= total
120 |     then pure ()
121 |     else do
122 |       (n, sub) <-
123 |         if total - index >= 8
124 |           then do
125 |             let (curr, next) = B.splitAt 8 src
126 |             u <- bsToWord64 curr
127 |             extismStoreU64 index u
128 |             return (8, next)
129 |           else do
130 |             let u = B.head src
131 |             extismStoreU8 index u
132 |             return (1, B.tail src)
133 |       writeBytesLoop (index + n) total sub
134 | 
135 | writeBytes :: MemoryOffset -> MemoryLength -> ByteString -> IO ()
136 | writeBytes offs len =
137 |   writeBytesLoop offs (offs + len)
138 | 


--------------------------------------------------------------------------------
/src/Extism/PDK/Memory.hs:
--------------------------------------------------------------------------------
  1 | {-# LANGUAGE FlexibleInstances #-}
  2 | 
  3 | -- |
  4 | -- Extism.PDK.Memory implements a low-level interface for interacting with Extism memory
  5 | module Extism.PDK.Memory
  6 |   ( Memory (..),
  7 |     MemoryOffset,
  8 |     MemoryLength,
  9 |     FromBytes (..),
 10 |     ToBytes (..),
 11 |     JSON (..),
 12 |     MsgPack (..),
 13 |     load,
 14 |     loadString,
 15 |     loadByteString,
 16 |     outputMemory,
 17 |     memAlloc,
 18 |     free,
 19 |     alloc,
 20 |     allocString,
 21 |     allocByteString,
 22 |     memoryOffset,
 23 |     memoryLength,
 24 |     findMemory,
 25 |   )
 26 | where
 27 | 
 28 | import Data.Binary.Get
 29 | import Data.Binary.Put
 30 | import qualified Data.ByteString as B
 31 | import Data.ByteString.Internal (c2w, w2c)
 32 | import Data.Int
 33 | import Data.Word
 34 | import Extism.PDK.Bindings
 35 | import qualified Extism.PDK.MsgPack (MsgPack, decode, encode)
 36 | import Extism.PDK.Util
 37 | import qualified Text.JSON (JSON, Result (..), decode, encode)
 38 | import qualified Text.JSON.Generic
 39 | 
 40 | -- | Represents a block of memory by offset and length
 41 | data Memory = Memory MemoryOffset MemoryLength
 42 | 
 43 | -- | Load data from 'Memory' block
 44 | load :: (FromBytes a) => Memory -> IO (Either String a)
 45 | load (Memory offs len) = do
 46 |   x <- readBytes offs len
 47 |   return $ fromBytes x
 48 | 
 49 | -- | Store data into a 'Memory' block
 50 | store :: (ToBytes a) => Memory -> a -> IO ()
 51 | store (Memory offs len) a =
 52 |   writeBytes offs len $ toBytes a
 53 | 
 54 | -- | Set plugin output to the provided 'Memory' block
 55 | outputMemory :: Memory -> IO ()
 56 | outputMemory (Memory offs len) =
 57 |   extismSetOutput offs len
 58 | 
 59 | -- | Load ByteString from 'Memory' block
 60 | loadByteString :: Memory -> IO B.ByteString
 61 | loadByteString (Memory offs len) = do
 62 |   readBytes offs len
 63 | 
 64 | -- | Load string from 'Memory' block
 65 | loadString :: Memory -> IO String
 66 | loadString (Memory offs len) =
 67 |   fromByteString <$> readBytes offs len
 68 | 
 69 | -- | Store string in 'Memory' block
 70 | storeString :: Memory -> String -> IO ()
 71 | storeString mem s =
 72 |   storeByteString mem $ toByteString s
 73 | 
 74 | -- | Store byte string in 'Memory' block
 75 | storeByteString :: Memory -> B.ByteString -> IO ()
 76 | storeByteString (Memory offs len) =
 77 |   writeBytes offs len
 78 | 
 79 | -- | Encode a value and copy it into Extism memory, returning the Memory block
 80 | alloc :: (ToBytes a) => a -> IO Memory
 81 | alloc x = do
 82 |   Memory offs len <- memAlloc (B.length bs)
 83 |   writeBytes offs len bs
 84 |   return $ Memory offs len
 85 |   where
 86 |     bs = toBytes x
 87 | 
 88 | -- | Allocate a new 'Memory' block
 89 | memAlloc :: Int -> IO Memory
 90 | memAlloc n = do
 91 |   offs <- extismAlloc len
 92 |   return $ Memory offs len
 93 |   where
 94 |     len = fromIntegral n
 95 | 
 96 | -- | Free a 'Memory' block
 97 | free :: Memory -> IO ()
 98 | free (Memory 0 _) = return ()
 99 | free (Memory _ 0) = return ()
100 | free (Memory offs _) =
101 |   extismFree offs
102 | 
103 | -- | Allocate a new 'Memory' block and copy the encoded value
104 | allocByteString :: B.ByteString -> IO Memory
105 | allocByteString bs = do
106 |   Memory offs len <- memAlloc (B.length bs)
107 |   writeBytes offs len bs
108 |   return (Memory offs len)
109 | 
110 | -- | Allocate a new 'Memory' block and copy the contents of the provided 'String'
111 | allocString :: String -> IO Memory
112 | allocString = allocByteString . toByteString
113 | 
114 | -- | Get the offset of a 'Memory' block
115 | memoryOffset :: Memory -> MemoryOffset
116 | memoryOffset (Memory offs _) = offs
117 | 
118 | -- | Get the length of a 'Memory' block
119 | memoryLength :: Memory -> MemoryLength
120 | memoryLength (Memory _ len) = len
121 | 
122 | -- | Find 'Memory' block by offset
123 | findMemory :: MemoryOffset -> IO Memory
124 | findMemory offs = do
125 |   len <- extismLength offs
126 |   return $ Memory offs len
127 | 
128 | -- | A class used to convert values from bytes read from linear memory
129 | class FromBytes a where
130 |   fromBytes :: B.ByteString -> Either String a
131 | 
132 | -- | A class used to convert values to bytes to be written into linear memory
133 | class ToBytes a where
134 |   toBytes :: a -> B.ByteString
135 | 
136 | -- | A wrapper type for JSON encoded values
137 | newtype JSON a = JSON a
138 | 
139 | -- | A wrapper type for MsgPack encoded values
140 | newtype MsgPack a = MsgPack a
141 | 
142 | instance FromBytes B.ByteString where
143 |   fromBytes = Right
144 | 
145 | instance ToBytes B.ByteString where
146 |   toBytes = id
147 | 
148 | instance FromBytes String where
149 |   fromBytes mem =
150 |     case fromBytes mem of
151 |       Left e -> Left e
152 |       Right x -> Right $ fromByteString x
153 | 
154 | instance ToBytes String where
155 |   toBytes = toByteString
156 | 
157 | instance (Text.JSON.Generic.Data a) => FromBytes (JSON a) where
158 |   fromBytes mem =
159 |     case fromBytes mem of
160 |       Left e -> Left e
161 |       Right x ->
162 |         case Text.JSON.decode x of
163 |           Text.JSON.Error e -> Left e
164 |           Text.JSON.Ok y ->
165 |             case Text.JSON.Generic.fromJSON y of
166 |               Text.JSON.Error e -> Left e
167 |               Text.JSON.Ok z -> Right (JSON z)
168 | 
169 | instance (Text.JSON.Generic.Data a) => ToBytes (JSON a) where
170 |   toBytes (JSON x) = toBytes (Text.JSON.Generic.encodeJSON x)
171 | 
172 | instance (Extism.PDK.MsgPack.MsgPack a) => FromBytes (MsgPack a) where
173 |   fromBytes mem =
174 |     case fromBytes mem of
175 |       Left e -> Left e
176 |       Right x ->
177 |         case Extism.PDK.MsgPack.decode x of
178 |           Left e -> Left e
179 |           Right y -> Right (MsgPack y)
180 | 
181 | instance (Extism.PDK.MsgPack.MsgPack a) => ToBytes (MsgPack a) where
182 |   toBytes (MsgPack x) = toBytes $ Extism.PDK.MsgPack.encode x
183 | 
184 | instance ToBytes Int32 where
185 |   toBytes i = toBytes $ B.toStrict (runPut (putInt32le i))
186 | 
187 | instance FromBytes Int32 where
188 |   fromBytes mem =
189 |     case fromBytes mem of
190 |       Left e -> Left e
191 |       Right x ->
192 |         case runGetOrFail getInt32le (B.fromStrict x) of
193 |           Left (_, _, e) -> Left e
194 |           Right (_, _, x) -> Right x
195 | 
196 | instance ToBytes Int64 where
197 |   toBytes i = toBytes $ B.toStrict (runPut (putInt64le i))
198 | 
199 | instance FromBytes Int64 where
200 |   fromBytes mem =
201 |     case fromBytes mem of
202 |       Left e -> Left e
203 |       Right x ->
204 |         case runGetOrFail getInt64le (B.fromStrict x) of
205 |           Left (_, _, e) -> Left e
206 |           Right (_, _, x) -> Right x
207 | 
208 | instance ToBytes Word32 where
209 |   toBytes i = toBytes $ B.toStrict (runPut (putWord32le i))
210 | 
211 | instance FromBytes Word32 where
212 |   fromBytes mem =
213 |     case fromBytes mem of
214 |       Left e -> Left e
215 |       Right x ->
216 |         case runGetOrFail getWord32le (B.fromStrict x) of
217 |           Left (_, _, e) -> Left e
218 |           Right (_, _, x) -> Right x
219 | 
220 | instance ToBytes Word64 where
221 |   toBytes i = toBytes $ B.toStrict (runPut (putWord64le i))
222 | 
223 | instance FromBytes Word64 where
224 |   fromBytes mem =
225 |     case fromBytes mem of
226 |       Left e -> Left e
227 |       Right x ->
228 |         case runGetOrFail getWord64le (B.fromStrict x) of
229 |           Left (_, _, e) -> Left e
230 |           Right (_, _, x) -> Right x
231 | 
232 | instance ToBytes Float where
233 |   toBytes i = toBytes $ B.toStrict (runPut (putFloatle i))
234 | 
235 | instance FromBytes Float where
236 |   fromBytes mem =
237 |     case fromBytes mem of
238 |       Left e -> Left e
239 |       Right x ->
240 |         case runGetOrFail getFloatle (B.fromStrict x) of
241 |           Left (_, _, e) -> Left e
242 |           Right (_, _, x) -> Right x
243 | 
244 | instance ToBytes Double where
245 |   toBytes i = toBytes $ B.toStrict (runPut (putDoublele i))
246 | 
247 | instance FromBytes Double where
248 |   fromBytes mem =
249 |     case fromBytes mem of
250 |       Left e -> Left e
251 |       Right x ->
252 |         case runGetOrFail getDoublele (B.fromStrict x) of
253 |           Left (_, _, e) -> Left e
254 |           Right (_, _, x) -> Right x
255 | 


--------------------------------------------------------------------------------
/README.md:
--------------------------------------------------------------------------------
  1 | # Extism Haskell PDK
  2 | 
  3 | This library can be used to write [Extism Plug-ins](https://extism.org/docs/concepts/plug-in) in Haskell.
  4 | 
  5 | Docs are available on Hackage: [https://hackage.haskell.org/package/extism-pdk](https://hackage.haskell.org/package/extism-pdk)
  6 | 
  7 | ## Install
  8 | 
  9 | Make sure you have [wasm32-wasi-ghc](https://gitlab.haskell.org/haskell-wasm/ghc-wasm-meta) installed, then generate an `Executable` project with cabal:
 10 | 
 11 | ```bash
 12 | cabal init
 13 | ```
 14 | 
 15 | **Note**: As of [aa2d85dc](https://gitlab.haskell.org/haskell-wasm/ghc-wasm-meta/-/commit/aa2d85dccbce5e18a9ce31ac92511dcdd9a95b6c) the Wasm tail-call
 16 | proposal is enabled by default. Some Wasm runtimes, like the go-sdk, don't support this yet so it might be necesarry to pin ghc-wasm-meta to
 17 | [ada3b8fa](https://gitlab.haskell.org/haskell-wasm/ghc-wasm-meta/-/commit/ada3b8fa0f763e4dccb2b1f6bbf2518bff2a7c6e), which seems to be the last commit to not
 18 | require tail-calls.
 19 | 
 20 | Add the library from [Hackage](https://hackage.haskell.org/package/extism-pdk) to your cabal file:
 21 | 
 22 | ```bash
 23 | build-depends: extism-pdk
 24 | ```
 25 | 
 26 | We will also need to add some additional ghc options to expose the correct functions:
 27 | 
 28 | ```
 29 | ghc-options:
 30 |   -optl -Wl,--export=greet -optl -Wl,--export=hs_init -optl -Wl,--allow-undefined -no-hs-main -optl-mexec-model=reactor 
 31 | ```
 32 | 
 33 | ## Getting Started
 34 | 
 35 | The goal of writing an [Extism plug-in](https://extism.org/docs/concepts/plug-in) is to compile your Haskell code to a Wasm module with exported functions that the host application can invoke. The first thing you should understand is creating an export. Let's write a simple program that exports a `greet` function which will take a name as a string and return a greeting string. 
 36 | 
 37 | ```haskell
 38 | {-# LANGUAGE DeriveDataTypeable #-}
 39 | 
 40 | module Hello where
 41 | 
 42 | import Data.Maybe
 43 | import Extism.PDK
 44 | import Extism.PDK.JSON
 45 | 
 46 | defaultGreeting = "Hello"
 47 | 
 48 | greet g n =
 49 |   output $ g ++ ", " ++ n
 50 | 
 51 | testing = do
 52 |   -- Get a name from the Extism runtime
 53 |   name <- inputString
 54 |   -- Get  configured greeting
 55 |   greeting <- getConfig "greeting"
 56 |   -- Greet the user, if no greeting is configured then "Hello" is used
 57 |   greet (fromMaybe defaultGreeting greeting) name
 58 | 
 59 | foreign export ccall "greet" testing :: IO ()
 60 | ```
 61 | 
 62 | This example also shows how to use the `getConfig` function to load runtime configuration values set by the host.
 63 | 
 64 | Despite not needing any system access for this plugin, we will still compile it for `wasm32-wasi`, since there is no Haskell compiler targeting `wasm32-unknown-unknown`:
 65 | 
 66 | ```bash
 67 | wasm32-wasi-cabal build
 68 | ```
 69 | 
 70 | This will put your compiled wasm somewhere in the `dist-newstyle` directory:
 71 | 
 72 | ```bash
 73 | cp `find dist-newstyle -name example.wasm` .
 74 | ```
 75 | 
 76 | We can now test it using the [Extism CLI](https://github.com/extism/cli)'s `run`
 77 | command:
 78 | 
 79 | ```bash
 80 | extism call ./example.wasm greet --input "Benjamin"
 81 | # => Hello, Benjamin!
 82 | ```
 83 | 
 84 | Configure a new greeting we can update the `greeting` config key using the [Extism CLI](https://github.com/extism/cli)'s `--config` option that lets you pass in `key=value` pairs:
 85 | 
 86 | ```bash
 87 | extism call ./example.wasm greet --input "Benjamin" --config greeting="Hi there"
 88 | # => Hi there, Benjamin!
 89 | ```
 90 | 
 91 | > **Note**: We also have a web-based, plug-in tester called the [Extism Playground](https://playground.extism.org/)
 92 | 
 93 | ### More About Exports
 94 | 
 95 | For a function to be available from your Wasm plug-in, you will need to add a `foreign export`:
 96 | 
 97 | ```haskell
 98 | foreign export ccall "greet" greet:: IO Int32
 99 | ```
100 | 
101 | And there are some flags to make the function public on the linker side:
102 | 
103 | ```
104 | ghc-options:
105 |     -optl -Wl,--export=greet -optl -Wl,--export=hs_init -optl -Wl,--allow-undefined -no-hs-main -optl-mexec-model=reactor 
106 | ```
107 | 
108 | This will export the `greet` function, the `hs_init` function and compile a reactor module instead of a command-style module.
109 | 
110 | ### Primitive Types
111 | 
112 | A common thing you may want to do is pass some primitive Haskell data back and forth.
113 | 
114 | ```haskell
115 | -- Float
116 | addPi = do
117 |   -- Get float value
118 |   value <- (input :: IO Float)
119 |   output $ value + 3.14
120 |   return 0
121 | 
122 | -- Integers
123 | sum42 = do
124 |   value <- (input :: IO Int)
125 |   output $ value + 42
126 |   return 0
127 | 
128 | -- ByteString
129 | processBytes = do
130 |   bytes <- inputByteString
131 |   -- process bytes here
132 |   output bytes
133 |   return 0
134 | 
135 | -- String
136 | processString = do
137 |   s <- inputString
138 |   output s
139 |   return 0
140 | ```
141 | 
142 | ### Json
143 | 
144 | We provide a [JSON](https://hackage.haskell.org/package/extism-manifest-0.3.0/docs/Extism-JSON.html) class that allows you to pass JSON encoded values into 
145 | and out of plug-in functions:
146 | 
147 | ```haskell
148 | {-# LANGUAGE DeriveDataTypeable #-}
149 | 
150 | module Add where
151 | import Extism.PDK
152 | import Extism.PDK.JSON
153 | 
154 | data Add = Add
155 |   { a :: Int,
156 |     b :: Int
157 |   } deriving (Data)
158 | 
159 | data Sum = Sum { sum :: Int } deriving (Data)
160 | 
161 | add = do
162 |   value <- input
163 |   output $ JSON $ Sum (a value + b value)
164 |   return 0
165 | 
166 | foreign export ccall "add" add :: IO Int32
167 | ```
168 | 
169 | ## Variables
170 | 
171 | Variables are another key-value mechanism but it's a mutable data store that
172 | will persist across function calls. These variables will persist as long as the
173 | host has loaded and not freed the plug-in. You can use [getVar](https://hackage.haskell.org/package/extism-pdk-0.2.0.0/docs/Extism-PDK.html#v:getVar) and [setVar](https://hackage.haskell.org/package/extism-pdk/docs/Extism-PDK.html#v:setVar) to manipulate them.
174 | 
175 | ```haskell
176 | count = do
177 |   c <- fromMaybe 0 <$> getVar "count"
178 |   setVar "count" (c + 1)
179 |   output c
180 |   return 0
181 | ```
182 | 
183 | ## Logging
184 | 
185 | Because Wasm modules by default do not have access to the system, printing to stdout won't work (unless you use WASI). Extism provides some simple logging macros that allow you to use the host application to log without having to give the plug-in permission to make syscalls:
186 | 
187 | ```haskell
188 | module Log where
189 | import Extism.PDK
190 | logStuff = do
191 |   logInfo "Some info!"
192 |   logWarn "A warning!"
193 |   logError "An error!" 
194 |   return 0
195 | foreign export ccall "logStuff" logStuff:: IO Int32
196 | ```
197 | 
198 | From [Extism CLI](https://github.com/extism/cli):
199 | 
200 | ```bash
201 | extism call my_plugin.wasm logStuff --log-level=info
202 | 2023/09/30 11:52:17 Some info!
203 | 2023/09/30 11:52:17 A warning!
204 | 2023/09/30 11:52:17 An error!
205 | ```
206 | 
207 | > *Note*: From the CLI you need to pass a level with `--log-level`. If you are running the plug-in in your own host using one of our SDKs, you need to make sure that you call `set_log_file` to `"stdout"` or some file location.
208 | 
209 | ## HTTP
210 | 
211 | Sometimes it is useful to let a plug-in make HTTP calls.
212 | 
213 | > **Note**: See [Request](https://hackage.haskell.org/package/extism-pdk/docs/Extism-PDK-HTTP.html#t:Request) docs for more info on the request and response types:
214 | 
215 | ```haskell
216 |  module HTTPGet where
217 | 
218 | import Data.Int
219 | import Extism.PDK
220 | import Extism.PDK.HTTP
221 | import Extism.PDK.Memory
222 | 
223 | httpGet = do
224 |   -- Get JSON encoded request from host
225 |   JSON req <- input
226 |   -- Send the request, get a 'Response'
227 |   res <- sendRequest req (Nothing :: Maybe String)
228 |   -- Save response body to output
229 |   output $ responseData res
230 |   -- Return code
231 |   return 0
232 | 
233 | foreign export ccall "httpGet" httpGet :: IO Int32
234 | ```
235 | 
236 | ## Imports (Host Functions)
237 | 
238 | Like any other code module, Wasm not only let's you export functions to the outside world, you can
239 | import them too. Host Functions allow a plug-in to import functions defined in the host. For example,
240 | if you host application is written in Python, it can pass a Python function down to your Haskell plug-in
241 | where you can invoke it.
242 | 
243 | This topic can get fairly complicated and we have not yet fully abstracted the Wasm knowledge you need
244 | to do this correctly. So we recommend reading out [concept doc on Host Functions](https://extism.org/docs/concepts/host-functions) before you get started.
245 | 
246 | ### A Simple Example
247 | 
248 | Host functions in the Haskell PDK require C stubs to import a function from a particular namespace:
249 | 
250 | ```c
251 | #include <stdint.h>
252 | 
253 | #define IMPORT(a, b) __attribute__((import_module(a), import_name(b)))
254 | IMPORT("extism:host/user", "a_python_func")
255 | uint64_t a_python_func_impl(uint64_t input);
256 | 
257 | uint64_t a_python_func(uint64_t input) {
258 |   return a_python_func_impl(input);
259 | }
260 | ```
261 | 
262 | This C file should be added to the `extra-source-files` and `c-sources` fields in your cabal file.
263 | 
264 | From there we can use `foreign import ccall` to call our stub:
265 | 
266 | ```haskell
267 | import Extism.PDK.Memory
268 | import Extism.PDK
269 | 
270 | foreign import ccall "a_python_func" aPythonFunc :: Word64 -> IO Word64
271 | 
272 | helloFromPython :: String -> IO String
273 | helloFromPython = do
274 |   s' <- allocString "Hello!"
275 |   resOffset <- aPythonFunc (memoryOffset s')
276 |   resMem <- findMemory resOffset
277 |   logInfo =<< loadString resMem
278 |   return 0
279 | 
280 | foreign export ccall "helloFromPython" helloFromPython :: IO Int32
281 | ```
282 | 
283 | To call this function, we write our input string into memory using `allocString` and call the function with the returned memory handle. We then have
284 | to load the result string from memory to access it from our Haskell program.
285 | 
286 | ### Testing it out
287 | 
288 | We can't really test this from the Extism CLI as something must provide the implementation. So let's
289 | write out the Python side here. Check out the [docs for Host SDKs](https://extism.org/docs/concepts/host-sdk) to implement a host function in a language of your choice.
290 | 
291 | ```python
292 | from extism import host_fn, Plugin
293 | 
294 | @host_fn()
295 | def a_python_func(input: str) -> str:
296 |     # just printing this out to prove we're in Python land
297 |     print("Hello from Python!")
298 | 
299 |     # let's just add "!" to the input string
300 |     # but you could imagine here we could add some
301 |     # applicaiton code like query or manipulate the database
302 |     # or our application APIs
303 |     return input + "!"
304 | ```
305 | 
306 | Now when we load the plug-in we pass the host function:
307 |  
308 | ```python
309 | manifest = {"wasm": [{"path": "/path/to/plugin.wasm"}]}
310 | plugin = Plugin(manifest, functions=[a_python_func], wasi=True)
311 | result = plugin.call('helloFromPython', b'').decode('utf-8')
312 | print(result)
313 | ```
314 | 
315 | ```bash
316 | python3 app.py
317 | # => Hello from Python!
318 | # => An argument to send to Python!
319 | ```
320 | 
321 | ### Reach Out!
322 | 
323 | Have a question or just want to drop in and say hi? [Hop on the Discord](https://extism.org/discord)!
324 | 


--------------------------------------------------------------------------------