extism-manifest (empty) → 0.1.0
raw patch · 4 files changed
+333/−0 lines, 4 filesdep +basedep +base64-bytestringdep +bytestring
Dependencies added: base, base64-bytestring, bytestring, json
Files
- CHANGELOG.md +5/−0
- Extism/JSON.hs +60/−0
- Extism/Manifest.hs +247/−0
- extism-manifest.cabal +21/−0
+ CHANGELOG.md view
@@ -0,0 +1,5 @@+# Revision history for extism-manifest++## 0.1.0.0 -- YYYY-mm-dd++* First version. Released on an unsuspecting world.
+ Extism/JSON.hs view
@@ -0,0 +1,60 @@+module Extism.JSON (+ module Extism.JSON,+ module Text.JSON+) where++import Text.JSON+import qualified Data.ByteString as B+import Data.ByteString.Internal (c2w, w2c)+import qualified Data.ByteString.Base64 as B64+import qualified Data.ByteString.Char8 as BS (unpack)++data Nullable a = Null | NotNull a++makeArray x = JSArray [showJSON a | a <- x]+isNull JSNull = True+isNull _ = False+filterNulls obj = [(a, b) | (a, b) <- obj, not (isNull b)]+object x = makeObj $ filterNulls x+objectWithNulls x = makeObj x+nonNull x = NotNull x+null' = Null+(.=) a b = (a, showJSON b)+toNullable (Just x) = NotNull x+toNullable Nothing = Null+fromNullable (NotNull x) = Just x+fromNullable Null = Nothing+fromNotNull (NotNull x) = x+fromNotNull Null = error "Value is Null"+mapNullable f Null = Null+mapNullable f (NotNull x) = NotNull (f x)++(.?) (JSObject a) k =+ case valFromObj k a of+ Ok x -> NotNull x+ Error _ -> Null+(.?) _ _ = Null+(.??) a k = toNullable $ lookup k a++find :: JSON a => String -> JSValue -> Nullable a+find k obj = obj .? k++update :: JSON a => String -> a -> JSValue -> JSValue+update k v (JSObject obj) = object $ (fromJSObject obj) ++ [k .= v]++instance JSON a => JSON (Nullable a) where+ showJSON (NotNull x) = showJSON x+ showJSON Null = JSNull+ readJSON JSNull = Ok Null+ readJSON x = readJSON x+++newtype Base64 = Base64 B.ByteString++instance JSON Base64 where+ showJSON (Base64 bs) = showJSON (BS.unpack $ B64.encode bs)+ readJSON (JSString s) =+ let toByteString x = B.pack (Prelude.map c2w x) in+ case B64.decode (toByteString (fromJSString s)) of+ Left msg -> Error msg+ Right d -> Ok (Base64 d)
+ Extism/Manifest.hs view
@@ -0,0 +1,247 @@+module Extism.Manifest where++import Extism.JSON+import qualified Data.ByteString as B+import qualified Data.ByteString.Char8 as BS (unpack)++-- | Memory options+newtype Memory = Memory+ {+ memoryMaxPages :: Nullable Int+ }++instance JSON Memory where+ showJSON (Memory max) =+ object [+ "max_pages" .= max+ ]+ readJSON obj =+ let max = obj .? "max_pages" in+ Ok (Memory max)++-- | HTTP request+data HTTPRequest = HTTPRequest+ {+ url :: String+ , headers :: Nullable [(String, String)]+ , method :: Nullable String+ }++makeKV x =+ object [(k, showJSON v) | (k, v) <- x]++requestObj (HTTPRequest url headers method) =+ [+ "url" .= url,+ "headers" .= mapNullable makeKV headers,+ "method" .= method+ ]++instance JSON HTTPRequest where+ showJSON req = object $ requestObj req+ readJSON x =+ let url = x .? "url" in+ let headers = x .? "headers" in+ let method = x .? "method" in+ case url of+ Null -> Error "Missing 'url' field"+ NotNull url -> Ok (HTTPRequest url headers method)+++-- | WASM from file+data WasmFile = WasmFile+ {+ filePath :: String+ , fileName :: Nullable String+ , fileHash :: Nullable String+ }++instance JSON WasmFile where+ showJSON (WasmFile path name hash) =+ object [+ "path" .= path,+ "name" .= name,+ "hash" .= hash+ ]+ readJSON x =+ let path = x .? "url" in+ let name = x .? "name" in+ let hash = x .? "hash" in+ case path of+ Null -> Error "Missing 'path' field"+ NotNull path -> Ok (WasmFile path name hash)++++-- | WASM from raw bytes+data WasmData = WasmData+ {+ dataBytes :: Base64+ , dataName :: Nullable String+ , dataHash :: Nullable String+ }+++++instance JSON WasmData where+ showJSON (WasmData bytes name hash) =+ object [+ "data" .= bytes,+ "name" .= name,+ "hash" .= hash+ ]+ readJSON x =+ let d = x .? "data" in+ let name = x .? "name" in+ let hash = x .? "hash" in+ case d of+ Null -> Error "Missing 'path' field"+ NotNull d ->+ case readJSON d of+ Error msg -> Error msg+ Ok d' -> Ok (WasmData d' name hash)+++-- | WASM from a URL+data WasmURL = WasmURL+ {+ req :: HTTPRequest+ , urlName :: Nullable String+ , urlHash :: Nullable String+ }+++instance JSON WasmURL where+ showJSON (WasmURL req name hash) =+ object (+ "name" .= name :+ "hash" .= hash :+ requestObj req)+ readJSON x =+ let req = x .? "req" in+ let name = x .? "name" in+ let hash = x .? "hash" in+ case fromNullable req of+ Nothing -> Error "Missing 'req' field"+ Just req -> Ok (WasmURL req name hash)++-- | Specifies where to get WASM module data+data Wasm = File WasmFile | Data WasmData | URL WasmURL++instance JSON Wasm where+ showJSON x =+ case x of+ File f -> showJSON f+ Data d -> showJSON d+ URL u -> showJSON u+ readJSON x =+ let file = (readJSON x :: Result WasmFile) in+ case file of+ Ok x -> Ok (File x)+ Error _ ->+ let data' = (readJSON x :: Result WasmData) in+ case data' of+ Ok x -> Ok (Data x)+ Error _ ->+ let url = (readJSON x :: Result WasmURL) in+ case url of+ Ok x -> Ok (URL x)+ Error _ -> Error "JSON does not match any of the Wasm types"++wasmFile :: String -> Wasm+wasmFile path =+ File WasmFile { filePath = path, fileName = null', fileHash = null'}++wasmURL :: String -> String -> Wasm+wasmURL method url =+ let r = HTTPRequest { url = url, headers = null', method = nonNull method } in+ URL WasmURL { req = r, urlName = null', urlHash = null' }++wasmData :: B.ByteString -> Wasm+wasmData d =+ Data WasmData { dataBytes = Base64 d, dataName = null', dataHash = null' }++withName :: Wasm -> String -> Wasm+withName (Data d) name = Data d { dataName = nonNull name }+withName (URL url) name = URL url { urlName = nonNull name }+withName (File f) name = File f { fileName = nonNull name }+++withHash :: Wasm -> String -> Wasm+withHash (Data d) hash = Data d { dataHash = nonNull hash }+withHash (URL url) hash = URL url { urlHash = nonNull hash }+withHash (File f) hash = File f { fileHash = nonNull hash }++-- | The 'Manifest' type is used to provide WASM data and configuration to the+-- | Extism runtime+data Manifest = Manifest+ {+ wasm :: [Wasm]+ , memory :: Nullable Memory+ , config :: Nullable [(String, String)]+ , allowedHosts :: Nullable [String]+ , allowedPaths :: Nullable [(String, String)]+ , timeout :: Nullable Int+ }+++instance JSON Manifest where+ showJSON (Manifest wasm memory config hosts paths timeout) =+ let w = makeArray wasm in+ object [+ "wasm" .= w,+ "memory" .= memory,+ "config" .= mapNullable makeKV config,+ "allowed_hosts" .= hosts,+ "allowed_paths" .= mapNullable makeKV paths,+ "timeout_ms" .= timeout+ ]+ readJSON x =+ let wasm = x .? "wasm" in+ let memory = x .? "memory" in+ let config = x .? "config" in+ let hosts = x .? "allowed_hosts" in+ let paths = x .? "allowed_paths" in+ let timeout = x .? "timeout_ms" in+ case fromNullable wasm of+ Nothing -> Error "Missing 'wasm' field"+ Just wasm -> Ok (Manifest wasm memory config hosts paths timeout)++-- | Create a new 'Manifest' from a list of 'Wasm'+manifest :: [Wasm] -> Manifest+manifest wasm =+ Manifest {+ wasm = wasm,+ memory = null',+ config = null',+ allowedHosts = null',+ allowedPaths = null',+ timeout = null'+ }++-- | Update the config values+withConfig :: Manifest -> [(String, String)] -> Manifest+withConfig m config =+ m { config = nonNull config }+++-- | Update allowed hosts for `extism_http_request`+withHosts :: Manifest -> [String] -> Manifest+withHosts m hosts =+ m { allowedHosts = nonNull hosts }+++-- | Update allowed paths+withPaths :: Manifest -> [(String, String)] -> Manifest+withPaths m p =+ m { allowedPaths = nonNull p }++-- | Update plugin timeout (in milliseconds)+withTimeout :: Manifest -> Int -> Manifest+withTimeout m t =+ m { timeout = nonNull t }++toString :: (JSON a) => a -> String+toString v =+ encode (showJSON v)
+ extism-manifest.cabal view
@@ -0,0 +1,21 @@+cabal-version: 3.0+name: extism-manifest+version: 0.1.0+license: BSD-3-Clause+maintainer: oss@extism.org+author: Extism authors+bug-reports: https://github.com/extism/extism+synopsis: Extism manifest bindings+description: Bindings to Extism WebAssembly manifest+category: Plugins, WebAssembly+extra-source-files: CHANGELOG.md++library+ exposed-modules: Extism.Manifest Extism.JSON+ hs-source-dirs: .+ default-language: Haskell2010+ build-depends:+ base >= 4.16.1 && < 4.18.0,+ bytestring >= 0.11.3 && < 0.12,+ json >= 0.10 && < 0.11,+ base64-bytestring >= 1.2.1 && < 1.3,