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
  {
    Memory -> Nullable Int
memoryMaxPages :: Nullable Int
  }

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

-- | HTTP request
data HTTPRequest = HTTPRequest
  {
    HTTPRequest -> String
url :: String
  , HTTPRequest -> Nullable [(String, String)]
headers :: Nullable [(String, String)]
  , HTTPRequest -> Nullable String
method :: Nullable String
  }

makeKV :: [(String, a)] -> JSValue
makeKV [(String, a)]
x =
  [(String, JSValue)] -> JSValue
object [(String
k, 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" forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= String
url,
    String
"headers" forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= forall {t} {a}. (t -> a) -> Nullable t -> Nullable a
mapNullable forall {a}. JSON a => [(String, a)] -> JSValue
makeKV Nullable [(String, String)]
headers,
    String
"method" 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 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 forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"url" in
    let headers :: Nullable [(String, String)]
headers =  JSValue
x forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"headers" in
    let method :: Nullable String
method =  JSValue
x forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"method" in
    case Nullable String
url of
      Nullable String
Null -> forall a. String -> Result a
Error String
"Missing 'url' field"
      NotNull String
url -> 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
  }

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




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


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

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

wasmFile :: String -> Wasm
wasmFile :: String -> Wasm
wasmFile String
path =
  WasmFile -> Wasm
File WasmFile { filePath :: String
filePath = String
path, fileName :: Nullable String
fileName = forall {a}. Nullable a
null', fileHash :: Nullable String
fileHash = 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 = forall {a}. Nullable a
null', method :: Nullable String
method = forall {a}. a -> Nullable a
nonNull String
method } in
  WasmURL -> Wasm
URL WasmURL { req :: HTTPRequest
req = HTTPRequest
r, urlName :: Nullable String
urlName = forall {a}. Nullable a
null', urlHash :: Nullable String
urlHash = 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 = forall {a}. Nullable a
null', dataHash :: Nullable String
dataHash = 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 :: Nullable String
dataName = forall {a}. a -> Nullable a
nonNull String
name }
withName (URL WasmURL
url) String
name =  WasmURL -> Wasm
URL WasmURL
url { urlName :: Nullable String
urlName = forall {a}. a -> Nullable a
nonNull String
name }
withName (File WasmFile
f) String
name = WasmFile -> Wasm
File  WasmFile
f { fileName :: Nullable String
fileName = forall {a}. a -> Nullable a
nonNull String
name }


withHash :: Wasm -> String -> Wasm
withHash :: Wasm -> String -> Wasm
withHash (Data WasmData
d) String
hash = WasmData -> Wasm
Data WasmData
d { dataHash :: Nullable String
dataHash = forall {a}. a -> Nullable a
nonNull String
hash }
withHash (URL WasmURL
url) String
hash =  WasmURL -> Wasm
URL WasmURL
url { urlHash :: Nullable String
urlHash = forall {a}. a -> Nullable a
nonNull String
hash }
withHash (File WasmFile
f) String
hash = WasmFile -> Wasm
File  WasmFile
f { fileHash :: Nullable String
fileHash = forall {a}. a -> Nullable a
nonNull String
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
  }


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 = forall {a}. JSON a => [a] -> JSValue
makeArray [Wasm]
wasm in
    [(String, JSValue)] -> JSValue
object [
      String
"wasm" forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= JSValue
w,
      String
"memory" forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable Memory
memory,
      String
"config" forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= forall {t} {a}. (t -> a) -> Nullable t -> Nullable a
mapNullable forall {a}. JSON a => [(String, a)] -> JSValue
makeKV Nullable [(String, String)]
config,
      String
"allowed_hosts" forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= Nullable [String]
hosts,
      String
"allowed_paths" forall {a1} {a2}. JSON a1 => a2 -> a1 -> (a2, JSValue)
.= forall {t} {a}. (t -> a) -> Nullable t -> Nullable a
mapNullable forall {a}. JSON a => [(String, a)] -> JSValue
makeKV Nullable [(String, String)]
paths,
      String
"timeout_ms" 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 forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"wasm" in
    let memory :: Nullable Memory
memory = JSValue
x forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"memory" in
    let config :: Nullable [(String, String)]
config = JSValue
x forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"config" in
    let hosts :: Nullable [String]
hosts = JSValue
x forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"allowed_hosts" in
    let paths :: Nullable [(String, String)]
paths = JSValue
x forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"allowed_paths" in
    let timeout :: Nullable Int
timeout = JSValue
x forall {a}. JSON a => JSValue -> String -> Nullable a
.? String
"timeout_ms" in
    case forall {a}. Nullable a -> Maybe a
fromNullable Nullable [Wasm]
wasm of
      Maybe [Wasm]
Nothing -> forall a. String -> Result a
Error String
"Missing 'wasm' field"
      Just [Wasm]
wasm -> 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 = forall {a}. Nullable a
null',
    config :: Nullable [(String, String)]
config = forall {a}. Nullable a
null',
    allowedHosts :: Nullable [String]
allowedHosts = forall {a}. Nullable a
null',
    allowedPaths :: Nullable [(String, String)]
allowedPaths = forall {a}. Nullable a
null',
    timeout :: Nullable Int
timeout = 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 :: Nullable [(String, String)]
config = forall {a}. a -> Nullable a
nonNull [(String, String)]
config }


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


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

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

toString :: (JSON a) => a -> String
toString :: forall a. JSON a => a -> String
toString a
v =
  forall a. JSON a => a -> String
encode (forall a. JSON a => a -> JSValue
showJSON a
v)