extism-manifest 0.3.0 → 1.0.0.0

raw patch · 4 files changed

+185/−163 lines, 4 filesPVP ok

version bump matches the API change (PVP)

API changes (from Hackage documentation)

Files

• CHANGELOG.md +2/−2
• Extism/JSON.hs +30/−16
• Extism/Manifest.hs +151/−143
• extism-manifest.cabal +2/−2

@@ -1,5 +1,5 @@ # Revision history for extism-manifest -## 0.1.0.0 -- YYYY-mm-dd+## 1.0.0.0 -- 2024-01-08 -* First version. Released on an unsuspecting world.+* Extism 1.0 compatible release

@@ -1,31 +1,45 @@-module Extism.JSON (-  module Extism.JSON,-  module Text.JSON-) where+module Extism.JSON+  ( module Extism.JSON,+    Data,+    Typeable,+  )+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)+import Data.ByteString.Internal (c2w, w2c)+import Text.JSON+import Text.JSON.Generic -data Nullable a = Null | NotNull a+data Nullable a = Null | NotNull a deriving (Eq, Show)  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 = makeObj+ nonNull = NotNull+ 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) @@ -34,27 +48,27 @@     Ok x -> NotNull x     Error _ -> Null (.?) _ _ = Null+ (.??) a k = toNullable $ lookup k a -find :: JSON a => String -> JSValue -> Nullable a+find :: (JSON a) => String -> JSValue -> Nullable a find k obj = obj .? k -update :: JSON a => String -> a -> JSValue -> JSValue+update :: (JSON a) => String -> a -> JSValue -> JSValue update k v (JSObject obj) = object $ fromJSObject obj ++ [k .= v] -instance JSON a => JSON (Nullable a) where+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+newtype Base64 = Base64 B.ByteString deriving (Eq, Show)  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)+    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)

@@ -1,133 +1,127 @@ module Extism.Manifest where -import Extism.JSON import qualified Data.ByteString as B import qualified Data.ByteString.Char8 as BS (unpack)+import Extism.JSON+import Text.JSON+import Text.JSON.Generic  -- | Memory options newtype Memory = Memory-  {-    memoryMaxPages :: Nullable Int+  { memoryMaxPages :: Nullable Int   }+  deriving (Eq, Show)  instance JSON Memory where   showJSON (Memory max) =-    object [-      "max_pages" .= max-    ]+    object+      [ "max_pages" .= max+      ]   readJSON obj =-    let max = obj .? "max_pages" in-    Ok (Memory max)+    let max = obj .? "max_pages"+     in Ok (Memory max)  -- | HTTP request data HTTPRequest = HTTPRequest-  {-    url :: String-  , headers :: Nullable [(String, String)]-  , method :: Nullable String+  { url :: String,+    headers :: Nullable [(String, String)],+    method :: Nullable String   }+  deriving (Eq, Show)  makeKV x =   object [(k, showJSON v) | (k, v) <- x]  requestObj (HTTPRequest url headers method) =-  [-    "url" .= url,+  [ "url" .= url,     "headers" .= mapNullable makeKV headers,     "method" .= method   ]  instance JSON HTTPRequest where-  showJSON req =  object $ requestObj req+  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)-+    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+  { filePath :: String,+    fileName :: Nullable String,+    fileHash :: Nullable String   }+  deriving (Eq, Show)  instance JSON WasmFile where   showJSON (WasmFile path name hash) =-    object [-      "path" .= path,-      "name" .= name,-      "hash" .= 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)--+    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+  { dataBytes :: Base64,+    dataName :: Nullable String,+    dataHash :: Nullable String   }---+  deriving (Eq, Show)  instance JSON WasmData where   showJSON (WasmData bytes name hash) =-    object [-      "data" .= bytes,-      "name" .= name,-      "hash" .= 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)-+    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+  { req :: HTTPRequest,+    urlName :: Nullable String,+    urlHash :: Nullable String   }-+  deriving (Eq, Show)  instance JSON WasmURL where   showJSON (WasmURL req name hash) =-    object (-      "name" .= name :-      "hash" .= hash :-      requestObj req)+    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)+    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+data Wasm = File WasmFile | Data WasmData | URL WasmURL deriving (Eq, Show)  instance JSON Wasm where   showJSON x =@@ -136,112 +130,126 @@       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"+    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'}+  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' }+  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' }+  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 }-+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 }+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+  { wasm :: [Wasm],+    memory :: Nullable Memory,+    config :: Nullable [(String, String)],+    allowedHosts :: Nullable [String],+    allowedPaths :: Nullable [(String, String)],+    timeout :: Nullable Int   }-+  deriving (Eq, Show)  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-    ]+    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)+    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'-  }+  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 }-+  m {config = nonNull config}  -- | Update allowed hosts for `extism_http_request` withHosts :: Manifest -> [String] -> Manifest withHosts m hosts =-  m { allowedHosts = nonNull hosts }-+  m {allowedHosts = nonNull hosts}  -- | Update allowed paths withPaths :: Manifest -> [(String, String)] -> Manifest withPaths m p =-  m { allowedPaths = nonNull p }+  m {allowedPaths = nonNull p}  -- | Update plugin timeout (in milliseconds) withTimeout :: Manifest -> Int -> Manifest withTimeout m t =-  m { timeout = nonNull t }+  m {timeout = nonNull t} -toString :: (JSON a) => a -> String-toString v =-  encode (showJSON v)+-- | Set memory.max_pages+withMaxPages :: Manifest -> Int -> Manifest+withMaxPages m pages =+  m {memory = NotNull $ Memory (NotNull pages)}++fromString :: String -> Either String Manifest+fromString s = do+  let x = decode s+  resultToEither x++fromFile :: FilePath -> IO (Either String Manifest)+fromFile path = do+  s <- readFile path+  return $ fromString s++toString :: Manifest -> String+toString = encode++toFile :: FilePath -> Manifest -> IO ()+toFile path m = do+  writeFile path (toString m)

@@ -1,10 +1,10 @@ cabal-version:      3.0 name:               extism-manifest-version:            0.3.0+version:            1.0.0.0 license:            BSD-3-Clause maintainer:         oss@extism.org author:             Extism authors-bug-reports:        https://github.com/extism/extism+bug-reports:        https://github.com/extism/haskell-sdk synopsis:           Extism manifest bindings description:        Bindings to Extism WebAssembly manifest category:           Plugins, WebAssembly