module Extism.Manifest where

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
data Memory = Memory
  { Memory -> Nullable Int
memoryMaxPages :: Nullable Int,
    Memory -> Nullable Int
memoryMaxHttpResponseBytes :: Nullable Int,
    Memory -> Nullable Int
memoryMaxVarBytes :: Nullable Int
  }
  deriving (Memory -> Memory -> Bool
(Memory -> Memory -> Bool)
-> (Memory -> Memory -> Bool) -> Eq Memory
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Memory -> Memory -> Bool
== :: Memory -> Memory -> Bool
$c/= :: Memory -> Memory -> Bool
/= :: Memory -> Memory -> Bool
Eq, Int -> Memory -> ShowS
[Memory] -> ShowS
Memory -> String
(Int -> Memory -> ShowS)
-> (Memory -> String) -> ([Memory] -> ShowS) -> Show Memory
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Memory -> ShowS
showsPrec :: Int -> Memory -> ShowS
$cshow :: Memory -> String
show :: Memory -> String
$cshowList :: [Memory] -> ShowS
showList :: [Memory] -> ShowS
Show)

instance JSON Memory where
  showJSON :: Memory -> JSValue
showJSON (Memory Nullable Int
max Nullable Int
maxHttp Nullable Int
maxVar) =
    [(String, JSValue)] -> JSValue
object
      [ String
"max_pages" String -> Nullable Int -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable Int
max,
        String
"max_http_response_bytes" String -> Nullable Int -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable Int
maxHttp,
        String
"max_var_bytes" String -> Nullable Int -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable Int
maxVar
      ]
  readJSON :: JSValue -> Result Memory
readJSON JSValue
obj =
    let max :: Nullable Int
max = JSValue
obj JSValue -> String -> Nullable Int
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"max_pages"
        httpMax :: Nullable Int
httpMax = JSValue
obj JSValue -> String -> Nullable Int
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"max_http_response_bytes"
        maxVar :: Nullable Int
maxVar = JSValue
obj JSValue -> String -> Nullable Int
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"max_var_bytes"
     in Memory -> Result Memory
forall a. a -> Result a
Ok (Nullable Int -> Nullable Int -> Nullable Int -> Memory
Memory Nullable Int
max Nullable Int
httpMax Nullable Int
maxVar)

-- | HTTP request
data HTTPRequest = HTTPRequest
  { HTTPRequest -> String
url :: String,
    HTTPRequest -> Nullable [(String, String)]
headers :: Nullable [(String, String)],
    HTTPRequest -> Nullable String
method :: Nullable String
  }
  deriving (HTTPRequest -> HTTPRequest -> Bool
(HTTPRequest -> HTTPRequest -> Bool)
-> (HTTPRequest -> HTTPRequest -> Bool) -> Eq HTTPRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: HTTPRequest -> HTTPRequest -> Bool
== :: HTTPRequest -> HTTPRequest -> Bool
$c/= :: HTTPRequest -> HTTPRequest -> Bool
/= :: HTTPRequest -> HTTPRequest -> Bool
Eq, Int -> HTTPRequest -> ShowS
[HTTPRequest] -> ShowS
HTTPRequest -> String
(Int -> HTTPRequest -> ShowS)
-> (HTTPRequest -> String)
-> ([HTTPRequest] -> ShowS)
-> Show HTTPRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> HTTPRequest -> ShowS
showsPrec :: Int -> HTTPRequest -> ShowS
$cshow :: HTTPRequest -> String
show :: HTTPRequest -> String
$cshowList :: [HTTPRequest] -> ShowS
showList :: [HTTPRequest] -> ShowS
Show)

makeKV :: [(String, a)] -> JSValue
makeKV [(String, a)]
x =
  [(String, JSValue)] -> JSValue
object [(String
k, a -> JSValue
forall a. JSON a => a -> JSValue
showJSON a
v) | (String
k, a
v) <- [(String, a)]
x]

requestObj :: HTTPRequest -> [(String, JSValue)]
requestObj (HTTPRequest String
url Nullable [(String, String)]
headers Nullable String
method) =
  [ String
"url" String -> String -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= String
url,
    String
"headers" String -> Nullable JSValue -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= ([(String, String)] -> JSValue)
-> Nullable [(String, String)] -> Nullable JSValue
forall {t} {a}. (t -> a) -> Nullable t -> Nullable a
mapNullable [(String, String)] -> JSValue
forall {a}. JSON a => [(String, a)] -> JSValue
makeKV Nullable [(String, String)]
headers,
    String
"method" String -> Nullable String -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable String
method
  ]

instance JSON HTTPRequest where
  showJSON :: HTTPRequest -> JSValue
showJSON HTTPRequest
req = [(String, JSValue)] -> JSValue
object ([(String, JSValue)] -> JSValue) -> [(String, JSValue)] -> JSValue
forall a b. (a -> b) -> a -> b
$ HTTPRequest -> [(String, JSValue)]
requestObj HTTPRequest
req
  readJSON :: JSValue -> Result HTTPRequest
readJSON JSValue
x =
    let url :: Nullable String
url = JSValue
x JSValue -> String -> Nullable String
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"url"
        headers :: Nullable [(String, String)]
headers = JSValue
x JSValue -> String -> Nullable [(String, String)]
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"headers"
        method :: Nullable String
method = JSValue
x JSValue -> String -> Nullable String
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"method"
     in case Nullable String
url of
          Nullable String
Null -> String -> Result HTTPRequest
forall a. String -> Result a
Error String
"Missing 'url' field"
          NotNull String
url -> HTTPRequest -> Result HTTPRequest
forall a. a -> Result a
Ok (String
-> Nullable [(String, String)] -> Nullable String -> HTTPRequest
HTTPRequest String
url Nullable [(String, String)]
headers Nullable String
method)

-- | WASM from file
data WasmFile = WasmFile
  { WasmFile -> String
filePath :: String,
    WasmFile -> Nullable String
fileName :: Nullable String,
    WasmFile -> Nullable String
fileHash :: Nullable String
  }
  deriving (WasmFile -> WasmFile -> Bool
(WasmFile -> WasmFile -> Bool)
-> (WasmFile -> WasmFile -> Bool) -> Eq WasmFile
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WasmFile -> WasmFile -> Bool
== :: WasmFile -> WasmFile -> Bool
$c/= :: WasmFile -> WasmFile -> Bool
/= :: WasmFile -> WasmFile -> Bool
Eq, Int -> WasmFile -> ShowS
[WasmFile] -> ShowS
WasmFile -> String
(Int -> WasmFile -> ShowS)
-> (WasmFile -> String) -> ([WasmFile] -> ShowS) -> Show WasmFile
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WasmFile -> ShowS
showsPrec :: Int -> WasmFile -> ShowS
$cshow :: WasmFile -> String
show :: WasmFile -> String
$cshowList :: [WasmFile] -> ShowS
showList :: [WasmFile] -> ShowS
Show)

instance JSON WasmFile where
  showJSON :: WasmFile -> JSValue
showJSON (WasmFile String
path Nullable String
name Nullable String
hash) =
    [(String, JSValue)] -> JSValue
object
      [ String
"path" String -> String -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= String
path,
        String
"name" String -> Nullable String -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable String
name,
        String
"hash" String -> Nullable String -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable String
hash
      ]
  readJSON :: JSValue -> Result WasmFile
readJSON JSValue
x =
    let path :: Nullable String
path = JSValue
x JSValue -> String -> Nullable String
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"url"
        name :: Nullable String
name = JSValue
x JSValue -> String -> Nullable String
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"name"
        hash :: Nullable String
hash = JSValue
x JSValue -> String -> Nullable String
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"hash"
     in case Nullable String
path of
          Nullable String
Null -> String -> Result WasmFile
forall a. String -> Result a
Error String
"Missing 'path' field"
          NotNull String
path -> WasmFile -> Result WasmFile
forall a. a -> Result a
Ok (String -> Nullable String -> Nullable String -> WasmFile
WasmFile String
path Nullable String
name Nullable String
hash)

-- | WASM from raw bytes
data WasmData = WasmData
  { WasmData -> Base64
dataBytes :: Base64,
    WasmData -> Nullable String
dataName :: Nullable String,
    WasmData -> Nullable String
dataHash :: Nullable String
  }
  deriving (WasmData -> WasmData -> Bool
(WasmData -> WasmData -> Bool)
-> (WasmData -> WasmData -> Bool) -> Eq WasmData
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WasmData -> WasmData -> Bool
== :: WasmData -> WasmData -> Bool
$c/= :: WasmData -> WasmData -> Bool
/= :: WasmData -> WasmData -> Bool
Eq, Int -> WasmData -> ShowS
[WasmData] -> ShowS
WasmData -> String
(Int -> WasmData -> ShowS)
-> (WasmData -> String) -> ([WasmData] -> ShowS) -> Show WasmData
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WasmData -> ShowS
showsPrec :: Int -> WasmData -> ShowS
$cshow :: WasmData -> String
show :: WasmData -> String
$cshowList :: [WasmData] -> ShowS
showList :: [WasmData] -> ShowS
Show)

instance JSON WasmData where
  showJSON :: WasmData -> JSValue
showJSON (WasmData Base64
bytes Nullable String
name Nullable String
hash) =
    [(String, JSValue)] -> JSValue
object
      [ String
"data" String -> Base64 -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Base64
bytes,
        String
"name" String -> Nullable String -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable String
name,
        String
"hash" String -> Nullable String -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable String
hash
      ]
  readJSON :: JSValue -> Result WasmData
readJSON JSValue
x =
    let d :: Nullable JSValue
d = JSValue
x JSValue -> String -> Nullable JSValue
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"data"
        name :: Nullable String
name = JSValue
x JSValue -> String -> Nullable String
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"name"
        hash :: Nullable String
hash = JSValue
x JSValue -> String -> Nullable String
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"hash"
     in case Nullable JSValue
d of
          Nullable JSValue
Null -> String -> Result WasmData
forall a. String -> Result a
Error String
"Missing 'path' field"
          NotNull JSValue
d ->
            case JSValue -> Result Base64
forall a. JSON a => JSValue -> Result a
readJSON JSValue
d of
              Error String
msg -> String -> Result WasmData
forall a. String -> Result a
Error String
msg
              Ok Base64
d' -> WasmData -> Result WasmData
forall a. a -> Result a
Ok (Base64 -> Nullable String -> Nullable String -> WasmData
WasmData Base64
d' Nullable String
name Nullable String
hash)

-- | WASM from a URL
data WasmURL = WasmURL
  { WasmURL -> HTTPRequest
req :: HTTPRequest,
    WasmURL -> Nullable String
urlName :: Nullable String,
    WasmURL -> Nullable String
urlHash :: Nullable String
  }
  deriving (WasmURL -> WasmURL -> Bool
(WasmURL -> WasmURL -> Bool)
-> (WasmURL -> WasmURL -> Bool) -> Eq WasmURL
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: WasmURL -> WasmURL -> Bool
== :: WasmURL -> WasmURL -> Bool
$c/= :: WasmURL -> WasmURL -> Bool
/= :: WasmURL -> WasmURL -> Bool
Eq, Int -> WasmURL -> ShowS
[WasmURL] -> ShowS
WasmURL -> String
(Int -> WasmURL -> ShowS)
-> (WasmURL -> String) -> ([WasmURL] -> ShowS) -> Show WasmURL
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> WasmURL -> ShowS
showsPrec :: Int -> WasmURL -> ShowS
$cshow :: WasmURL -> String
show :: WasmURL -> String
$cshowList :: [WasmURL] -> ShowS
showList :: [WasmURL] -> ShowS
Show)

instance JSON WasmURL where
  showJSON :: WasmURL -> JSValue
showJSON (WasmURL HTTPRequest
req Nullable String
name Nullable String
hash) =
    [(String, JSValue)] -> JSValue
object
      ( String
"name" String -> Nullable String -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable String
name
          (String, JSValue) -> [(String, JSValue)] -> [(String, JSValue)]
forall a. a -> [a] -> [a]
: String
"hash" String -> Nullable String -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable String
hash
          (String, JSValue) -> [(String, JSValue)] -> [(String, JSValue)]
forall a. a -> [a] -> [a]
: HTTPRequest -> [(String, JSValue)]
requestObj HTTPRequest
req
      )
  readJSON :: JSValue -> Result WasmURL
readJSON JSValue
x =
    let req :: Nullable HTTPRequest
req = JSValue
x JSValue -> String -> Nullable HTTPRequest
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"req"
        name :: Nullable String
name = JSValue
x JSValue -> String -> Nullable String
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"name"
        hash :: Nullable String
hash = JSValue
x JSValue -> String -> Nullable String
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"hash"
     in case Nullable HTTPRequest -> Maybe HTTPRequest
forall {a}. Nullable a -> Maybe a
fromNullable Nullable HTTPRequest
req of
          Maybe HTTPRequest
Nothing -> String -> Result WasmURL
forall a. String -> Result a
Error String
"Missing 'req' field"
          Just HTTPRequest
req -> WasmURL -> Result WasmURL
forall a. a -> Result a
Ok (HTTPRequest -> Nullable String -> Nullable String -> WasmURL
WasmURL HTTPRequest
req Nullable String
name Nullable String
hash)

-- | Specifies where to get WASM module data
data Wasm = File WasmFile | Data WasmData | URL WasmURL deriving (Wasm -> Wasm -> Bool
(Wasm -> Wasm -> Bool) -> (Wasm -> Wasm -> Bool) -> Eq Wasm
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Wasm -> Wasm -> Bool
== :: Wasm -> Wasm -> Bool
$c/= :: Wasm -> Wasm -> Bool
/= :: Wasm -> Wasm -> Bool
Eq, Int -> Wasm -> ShowS
[Wasm] -> ShowS
Wasm -> String
(Int -> Wasm -> ShowS)
-> (Wasm -> String) -> ([Wasm] -> ShowS) -> Show Wasm
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Wasm -> ShowS
showsPrec :: Int -> Wasm -> ShowS
$cshow :: Wasm -> String
show :: Wasm -> String
$cshowList :: [Wasm] -> ShowS
showList :: [Wasm] -> ShowS
Show)

instance JSON Wasm where
  showJSON :: Wasm -> JSValue
showJSON Wasm
x =
    case Wasm
x of
      File WasmFile
f -> WasmFile -> JSValue
forall a. JSON a => a -> JSValue
showJSON WasmFile
f
      Data WasmData
d -> WasmData -> JSValue
forall a. JSON a => a -> JSValue
showJSON WasmData
d
      URL WasmURL
u -> WasmURL -> JSValue
forall a. JSON a => a -> JSValue
showJSON WasmURL
u
  readJSON :: JSValue -> Result Wasm
readJSON JSValue
x =
    case Result WasmFile
file of
      Ok WasmFile
x -> Wasm -> Result Wasm
forall a. a -> Result a
Ok (WasmFile -> Wasm
File WasmFile
x)
      Error String
_ ->
        let data' :: Result WasmData
data' = (JSValue -> Result WasmData
forall a. JSON a => JSValue -> Result a
readJSON JSValue
x :: Result WasmData)
         in case Result WasmData
data' of
              Ok WasmData
x -> Wasm -> Result Wasm
forall a. a -> Result a
Ok (WasmData -> Wasm
Data WasmData
x)
              Error String
_ ->
                let url :: Result WasmURL
url = (JSValue -> Result WasmURL
forall a. JSON a => JSValue -> Result a
readJSON JSValue
x :: Result WasmURL)
                 in case Result WasmURL
url of
                      Ok WasmURL
x -> Wasm -> Result Wasm
forall a. a -> Result a
Ok (WasmURL -> Wasm
URL WasmURL
x)
                      Error String
_ -> String -> Result Wasm
forall a. String -> Result a
Error String
"JSON does not match any of the Wasm types"
    where
      file :: Result WasmFile
file = (JSValue -> Result WasmFile
forall a. JSON a => JSValue -> Result a
readJSON JSValue
x :: Result WasmFile)

wasmFile :: String -> Wasm
wasmFile :: String -> Wasm
wasmFile String
path =
  WasmFile -> Wasm
File WasmFile {filePath :: String
filePath = String
path, fileName :: Nullable String
fileName = Nullable String
forall {a}. Nullable a
null', fileHash :: Nullable String
fileHash = Nullable String
forall {a}. Nullable a
null'}

wasmURL :: String -> String -> Wasm
wasmURL :: String -> String -> Wasm
wasmURL String
method String
url =
  let r :: HTTPRequest
r = HTTPRequest {url :: String
url = String
url, headers :: Nullable [(String, String)]
headers = Nullable [(String, String)]
forall {a}. Nullable a
null', method :: Nullable String
method = String -> Nullable String
forall {a}. a -> Nullable a
nonNull String
method}
   in WasmURL -> Wasm
URL WasmURL {req :: HTTPRequest
req = HTTPRequest
r, urlName :: Nullable String
urlName = Nullable String
forall {a}. Nullable a
null', urlHash :: Nullable String
urlHash = Nullable String
forall {a}. Nullable a
null'}

wasmData :: B.ByteString -> Wasm
wasmData :: ByteString -> Wasm
wasmData ByteString
d =
  WasmData -> Wasm
Data WasmData {dataBytes :: Base64
dataBytes = ByteString -> Base64
Base64 ByteString
d, dataName :: Nullable String
dataName = Nullable String
forall {a}. Nullable a
null', dataHash :: Nullable String
dataHash = Nullable String
forall {a}. Nullable a
null'}

withName :: Wasm -> String -> Wasm
withName :: Wasm -> String -> Wasm
withName (Data WasmData
d) String
name = WasmData -> Wasm
Data WasmData
d {dataName = nonNull name}
withName (URL WasmURL
url) String
name = WasmURL -> Wasm
URL WasmURL
url {urlName = nonNull name}
withName (File WasmFile
f) String
name = WasmFile -> Wasm
File WasmFile
f {fileName = nonNull name}

withHash :: Wasm -> String -> Wasm
withHash :: Wasm -> String -> Wasm
withHash (Data WasmData
d) String
hash = WasmData -> Wasm
Data WasmData
d {dataHash = nonNull hash}
withHash (URL WasmURL
url) String
hash = WasmURL -> Wasm
URL WasmURL
url {urlHash = nonNull hash}
withHash (File WasmFile
f) String
hash = WasmFile -> Wasm
File WasmFile
f {fileHash = nonNull hash}

-- | The 'Manifest' type is used to provide WASM data and configuration to the
-- | Extism runtime
data Manifest = Manifest
  { Manifest -> [Wasm]
wasm :: [Wasm],
    Manifest -> Nullable Memory
memory :: Nullable Memory,
    Manifest -> Nullable [(String, String)]
config :: Nullable [(String, String)],
    Manifest -> Nullable [String]
allowedHosts :: Nullable [String],
    Manifest -> Nullable [(String, String)]
allowedPaths :: Nullable [(String, String)],
    Manifest -> Nullable Int
timeout :: Nullable Int
  }
  deriving (Manifest -> Manifest -> Bool
(Manifest -> Manifest -> Bool)
-> (Manifest -> Manifest -> Bool) -> Eq Manifest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Manifest -> Manifest -> Bool
== :: Manifest -> Manifest -> Bool
$c/= :: Manifest -> Manifest -> Bool
/= :: Manifest -> Manifest -> Bool
Eq, Int -> Manifest -> ShowS
[Manifest] -> ShowS
Manifest -> String
(Int -> Manifest -> ShowS)
-> (Manifest -> String) -> ([Manifest] -> ShowS) -> Show Manifest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Manifest -> ShowS
showsPrec :: Int -> Manifest -> ShowS
$cshow :: Manifest -> String
show :: Manifest -> String
$cshowList :: [Manifest] -> ShowS
showList :: [Manifest] -> ShowS
Show)

instance JSON Manifest where
  showJSON :: Manifest -> JSValue
showJSON (Manifest [Wasm]
wasm Nullable Memory
memory Nullable [(String, String)]
config Nullable [String]
hosts Nullable [(String, String)]
paths Nullable Int
timeout) =
    let w :: JSValue
w = [Wasm] -> JSValue
forall {a}. JSON a => [a] -> JSValue
makeArray [Wasm]
wasm
     in [(String, JSValue)] -> JSValue
object
          [ String
"wasm" String -> JSValue -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= JSValue
w,
            String
"memory" String -> Nullable Memory -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable Memory
memory,
            String
"config" String -> Nullable JSValue -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= ([(String, String)] -> JSValue)
-> Nullable [(String, String)] -> Nullable JSValue
forall {t} {a}. (t -> a) -> Nullable t -> Nullable a
mapNullable [(String, String)] -> JSValue
forall {a}. JSON a => [(String, a)] -> JSValue
makeKV Nullable [(String, String)]
config,
            String
"allowed_hosts" String -> Nullable [String] -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable [String]
hosts,
            String
"allowed_paths" String -> Nullable JSValue -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= ([(String, String)] -> JSValue)
-> Nullable [(String, String)] -> Nullable JSValue
forall {t} {a}. (t -> a) -> Nullable t -> Nullable a
mapNullable [(String, String)] -> JSValue
forall {a}. JSON a => [(String, a)] -> JSValue
makeKV Nullable [(String, String)]
paths,
            String
"timeout_ms" String -> Nullable Int -> (String, JSValue)
forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable Int
timeout
          ]
  readJSON :: JSValue -> Result Manifest
readJSON JSValue
x =
    let wasm :: Nullable [Wasm]
wasm = JSValue
x JSValue -> String -> Nullable [Wasm]
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"wasm"
        memory :: Nullable Memory
memory = JSValue
x JSValue -> String -> Nullable Memory
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"memory"
        config :: Nullable [(String, String)]
config = JSValue
x JSValue -> String -> Nullable [(String, String)]
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"config"
        hosts :: Nullable [String]
hosts = JSValue
x JSValue -> String -> Nullable [String]
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"allowed_hosts"
        paths :: Nullable [(String, String)]
paths = JSValue
x JSValue -> String -> Nullable [(String, String)]
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"allowed_paths"
        timeout :: Nullable Int
timeout = JSValue
x JSValue -> String -> Nullable Int
forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"timeout_ms"
     in case Nullable [Wasm] -> Maybe [Wasm]
forall {a}. Nullable a -> Maybe a
fromNullable Nullable [Wasm]
wasm of
          Maybe [Wasm]
Nothing -> String -> Result Manifest
forall a. String -> Result a
Error String
"Missing 'wasm' field"
          Just [Wasm]
wasm -> Manifest -> Result Manifest
forall a. a -> Result a
Ok ([Wasm]
-> Nullable Memory
-> Nullable [(String, String)]
-> Nullable [String]
-> Nullable [(String, String)]
-> Nullable Int
-> Manifest
Manifest [Wasm]
wasm Nullable Memory
memory Nullable [(String, String)]
config Nullable [String]
hosts Nullable [(String, String)]
paths Nullable Int
timeout)

-- | Create a new 'Manifest' from a list of 'Wasm'
manifest :: [Wasm] -> Manifest
manifest :: [Wasm] -> Manifest
manifest [Wasm]
wasm =
  Manifest
    { wasm :: [Wasm]
wasm = [Wasm]
wasm,
      memory :: Nullable Memory
memory = Nullable Memory
forall {a}. Nullable a
null',
      config :: Nullable [(String, String)]
config = Nullable [(String, String)]
forall {a}. Nullable a
null',
      allowedHosts :: Nullable [String]
allowedHosts = Nullable [String]
forall {a}. Nullable a
null',
      allowedPaths :: Nullable [(String, String)]
allowedPaths = Nullable [(String, String)]
forall {a}. Nullable a
null',
      timeout :: Nullable Int
timeout = Nullable Int
forall {a}. Nullable a
null'
    }

-- | Update the config values
withConfig :: Manifest -> [(String, String)] -> Manifest
withConfig :: Manifest -> [(String, String)] -> Manifest
withConfig Manifest
m [(String, String)]
config =
  Manifest
m {config = nonNull config}

-- | Update allowed hosts for `extism_http_request`
withHosts :: Manifest -> [String] -> Manifest
withHosts :: Manifest -> [String] -> Manifest
withHosts Manifest
m [String]
hosts =
  Manifest
m {allowedHosts = nonNull hosts}

-- | Update allowed paths
withPaths :: Manifest -> [(String, String)] -> Manifest
withPaths :: Manifest -> [(String, String)] -> Manifest
withPaths Manifest
m [(String, String)]
p =
  Manifest
m {allowedPaths = nonNull p}

-- | Update plugin timeout (in milliseconds)
withTimeout :: Manifest -> Int -> Manifest
withTimeout :: Manifest -> Int -> Manifest
withTimeout Manifest
m Int
t =
  Manifest
m {timeout = nonNull t}

-- | Set memory.max_pages
withMaxPages :: Manifest -> Int -> Manifest
withMaxPages :: Manifest -> Int -> Manifest
withMaxPages Manifest
m Int
pages =
  case Manifest -> Nullable Memory
memory Manifest
m of
    Nullable Memory
Null ->
      Manifest
m {memory = NotNull $ Memory (NotNull pages) Null Null}
    NotNull (Memory Nullable Int
_ Nullable Int
x Nullable Int
y) ->
      Manifest
m {memory = NotNull $ Memory (NotNull pages) x y}

-- | Set memory.max_http_response_bytes
withMaxHttpResponseBytes :: Manifest -> Int -> Manifest
withMaxHttpResponseBytes :: Manifest -> Int -> Manifest
withMaxHttpResponseBytes Manifest
m Int
max =
  case Manifest -> Nullable Memory
memory Manifest
m of
    Nullable Memory
Null ->
      Manifest
m {memory = NotNull $ Memory Null (NotNull max) Null}
    NotNull (Memory Nullable Int
x Nullable Int
_ Nullable Int
y) ->
      Manifest
m {memory = NotNull $ Memory x (NotNull max) y}

-- | Set memory.max_var_bytes
withMaxVarBytes :: Manifest -> Int -> Manifest
withMaxVarBytes :: Manifest -> Int -> Manifest
withMaxVarBytes Manifest
m Int
max =
  case Manifest -> Nullable Memory
memory Manifest
m of
    Nullable Memory
Null ->
      Manifest
m {memory = NotNull $ Memory Null Null (NotNull max)}
    NotNull (Memory Nullable Int
x Nullable Int
y Nullable Int
_) ->
      Manifest
m {memory = NotNull $ Memory x y (NotNull max)}

fromString :: String -> Either String Manifest
fromString :: String -> Either String Manifest
fromString String
s = do
  let x :: Result Manifest
x = String -> Result Manifest
forall a. JSON a => String -> Result a
decode String
s
  Result Manifest -> Either String Manifest
forall a. Result a -> Either String a
resultToEither Result Manifest
x

fromFile :: FilePath -> IO (Either String Manifest)
fromFile :: String -> IO (Either String Manifest)
fromFile String
path = do
  String
s <- String -> IO String
readFile String
path
  Either String Manifest -> IO (Either String Manifest)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String Manifest -> IO (Either String Manifest))
-> Either String Manifest -> IO (Either String Manifest)
forall a b. (a -> b) -> a -> b
$ String -> Either String Manifest
fromString String
s

toString :: Manifest -> String
toString :: Manifest -> String
toString = Manifest -> String
forall a. JSON a => a -> String
encode

toFile :: FilePath -> Manifest -> IO ()
toFile :: String -> Manifest -> IO ()
toFile String
path Manifest
m = do
  String -> String -> IO ()
writeFile String
path (Manifest -> String
toString Manifest
m)