{-# LANGUAGE DeriveDataTypeable #-}

-- |
-- Contains bindings to the Extism PDK HTTP interface
module Extism.PDK.HTTP where

import Data.ByteString as B
import Data.Word
import Extism.JSON (Nullable (..))
import qualified Extism.Manifest (HTTPRequest (..))
import Extism.PDK
import Extism.PDK.Bindings
import Extism.PDK.Memory
import Extism.PDK.Util (fromByteString)
import Text.JSON (Result (..), decode, encode, makeObj)
import qualified Text.JSON.Generic

-- | HTTP Request
data Request = Request
  { Request -> String
url :: String,
    Request -> [(String, String)]
headers :: [(String, String)],
    Request -> String
method :: String
  }
  deriving (Text.JSON.Generic.Typeable, Typeable Request
Typeable Request =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> Request -> c Request)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c Request)
-> (Request -> Constr)
-> (Request -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c Request))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Request))
-> ((forall b. Data b => b -> b) -> Request -> Request)
-> (forall r r'.
    (r -> r' -> r)
    -> r -> (forall d. Data d => d -> r') -> Request -> r)
-> (forall r r'.
    (r' -> r -> r)
    -> r -> (forall d. Data d => d -> r') -> Request -> r)
-> (forall u. (forall d. Data d => d -> u) -> Request -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> Request -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> Request -> m Request)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Request -> m Request)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> Request -> m Request)
-> Data Request
Request -> Constr
Request -> DataType
(forall b. Data b => b -> b) -> Request -> Request
forall a.
Typeable a =>
(forall (c :: * -> *).
 (forall d b. Data d => c (d -> b) -> d -> c b)
 -> (forall g. g -> c g) -> a -> c a)
-> (forall (c :: * -> *).
    (forall b r. Data b => c (b -> r) -> c r)
    -> (forall r. r -> c r) -> Constr -> c a)
-> (a -> Constr)
-> (a -> DataType)
-> (forall (t :: * -> *) (c :: * -> *).
    Typeable t =>
    (forall d. Data d => c (t d)) -> Maybe (c a))
-> (forall (t :: * -> * -> *) (c :: * -> *).
    Typeable t =>
    (forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c a))
-> ((forall b. Data b => b -> b) -> a -> a)
-> (forall r r'.
    (r -> r' -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall r r'.
    (r' -> r -> r) -> r -> (forall d. Data d => d -> r') -> a -> r)
-> (forall u. (forall d. Data d => d -> u) -> a -> [u])
-> (forall u. Int -> (forall d. Data d => d -> u) -> a -> u)
-> (forall (m :: * -> *).
    Monad m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> (forall (m :: * -> *).
    MonadPlus m =>
    (forall d. Data d => d -> m d) -> a -> m a)
-> Data a
forall u. Int -> (forall d. Data d => d -> u) -> Request -> u
forall u. (forall d. Data d => d -> u) -> Request -> [u]
forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Request -> r
forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Request -> r
forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Request -> m Request
forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Request -> m Request
forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Request
forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Request -> c Request
forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Request)
forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Request)
$cgfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Request -> c Request
gfoldl :: forall (c :: * -> *).
(forall d b. Data d => c (d -> b) -> d -> c b)
-> (forall g. g -> c g) -> Request -> c Request
$cgunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Request
gunfold :: forall (c :: * -> *).
(forall b r. Data b => c (b -> r) -> c r)
-> (forall r. r -> c r) -> Constr -> c Request
$ctoConstr :: Request -> Constr
toConstr :: Request -> Constr
$cdataTypeOf :: Request -> DataType
dataTypeOf :: Request -> DataType
$cdataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Request)
dataCast1 :: forall (t :: * -> *) (c :: * -> *).
Typeable t =>
(forall d. Data d => c (t d)) -> Maybe (c Request)
$cdataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Request)
dataCast2 :: forall (t :: * -> * -> *) (c :: * -> *).
Typeable t =>
(forall d e. (Data d, Data e) => c (t d e)) -> Maybe (c Request)
$cgmapT :: (forall b. Data b => b -> b) -> Request -> Request
gmapT :: (forall b. Data b => b -> b) -> Request -> Request
$cgmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Request -> r
gmapQl :: forall r r'.
(r -> r' -> r)
-> r -> (forall d. Data d => d -> r') -> Request -> r
$cgmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Request -> r
gmapQr :: forall r r'.
(r' -> r -> r)
-> r -> (forall d. Data d => d -> r') -> Request -> r
$cgmapQ :: forall u. (forall d. Data d => d -> u) -> Request -> [u]
gmapQ :: forall u. (forall d. Data d => d -> u) -> Request -> [u]
$cgmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Request -> u
gmapQi :: forall u. Int -> (forall d. Data d => d -> u) -> Request -> u
$cgmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Request -> m Request
gmapM :: forall (m :: * -> *).
Monad m =>
(forall d. Data d => d -> m d) -> Request -> m Request
$cgmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Request -> m Request
gmapMp :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Request -> m Request
$cgmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Request -> m Request
gmapMo :: forall (m :: * -> *).
MonadPlus m =>
(forall d. Data d => d -> m d) -> Request -> m Request
Text.JSON.Generic.Data)

-- | HTTP Response
data Response = Response
  { Response -> Int
statusCode :: Int,
    Response -> ByteString
responseData :: ByteString,
    Response -> [(String, String)]
responseHeaders :: [(String, String)]
  }

-- | Creates a new 'Request'
newRequest :: String -> Request
newRequest :: String -> Request
newRequest String
url =
  String -> [(String, String)] -> String -> Request
Request String
url [] String
"GET"

-- | Update a 'Request' with the provided HTTP request method (GET, POST, PUT, DELETE, ...)
withMethod :: String -> Request -> Request
withMethod :: String -> Request -> Request
withMethod String
meth Request
req =
  Request
req {method = meth}

-- | Update a 'Request' with the provided HTTP request headers
withHeaders :: [(String, String)] -> Request -> Request
withHeaders :: [(String, String)] -> Request -> Request
withHeaders [(String, String)]
h Request
req =
  Request
req {headers = h}

-- | Get the 'Response' body as a 'ByteString'
responseByteString :: Response -> ByteString
responseByteString :: Response -> ByteString
responseByteString (Response Int
_ ByteString
mem [(String, String)]
_) = ByteString
mem

-- | Get the 'Response' body as a 'String'
responseString :: Response -> String
responseString :: Response -> String
responseString (Response Int
_ ByteString
mem [(String, String)]
_) = ByteString -> String
fromByteString ByteString
mem

-- | Get the 'Response' body as JSON
responseJSON :: (Text.JSON.Generic.Data a) => Response -> IO (Either String a)
responseJSON :: forall a. Data a => Response -> IO (Either String a)
responseJSON Response
res = do
  case Result JSValue
json of
    Ok JSValue
json ->
      case JSValue -> Result a
forall a. Data a => JSValue -> Result a
Text.JSON.Generic.fromJSON JSValue
json of
        Ok a
x -> Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Either String a -> IO (Either String a))
-> Either String a -> IO (Either String a)
forall a b. (a -> b) -> a -> b
$ a -> Either String a
forall a b. b -> Either a b
Right a
x
        Error String
msg -> Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String a
forall a b. a -> Either a b
Left String
msg)
    Error String
msg -> Either String a -> IO (Either String a)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either String a
forall a b. a -> Either a b
Left String
msg)
  where
    s :: String
s = Response -> String
responseString Response
res
    json :: Result JSValue
json = String -> Result JSValue
forall a. JSON a => String -> Result a
decode String
s

-- | Get the 'Response' body and decode it
response :: (FromBytes a) => Response -> Either String a
response :: forall a. FromBytes a => Response -> Either String a
response (Response Int
_ ByteString
mem [(String, String)]
_) = ByteString -> Either String a
forall a. FromBytes a => ByteString -> Either String a
fromBytes ByteString
mem

getHeaders :: IO [(String, String)]
getHeaders = do
  MemoryOffset
offs <- IO MemoryOffset
extismHTTPHeaders
  if MemoryOffset
offs MemoryOffset -> MemoryOffset -> Bool
forall a. Eq a => a -> a -> Bool
== MemoryOffset
0
    then
      [(String, String)] -> IO [(String, String)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
    else do
      Memory
mem <- MemoryOffset -> IO Memory
Extism.PDK.Memory.findMemory MemoryOffset
offs
      Either String (JSON [(String, String)])
h <- Memory -> IO (Either String (JSON [(String, String)]))
forall a. FromBytes a => Memory -> IO (Either String a)
Extism.PDK.Memory.load Memory
mem
      () <- Memory -> IO ()
Extism.PDK.Memory.free Memory
mem
      case Either String (JSON [(String, String)])
h of
        Left String
_ -> [(String, String)] -> IO [(String, String)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return []
        Right (JSON [(String, String)]
x) -> [(String, String)] -> IO [(String, String)]
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return [(String, String)]
x

-- | Send HTTP request with an optional request body
sendRequestWithBody :: (ToBytes a) => Request -> a -> IO Response
sendRequestWithBody :: forall a. ToBytes a => Request -> a -> IO Response
sendRequestWithBody Request
req a
b = do
  Memory
body <- a -> IO Memory
forall a. ToBytes a => a -> IO Memory
alloc a
b
  let json :: String
json =
        HTTPRequest -> String
forall a. JSON a => a -> String
encode
          Extism.Manifest.HTTPRequest
            { url :: String
Extism.Manifest.url = Request -> String
url Request
req,
              headers :: Nullable [(String, String)]
Extism.Manifest.headers = [(String, String)] -> Nullable [(String, String)]
forall a. a -> Nullable a
NotNull ([(String, String)] -> Nullable [(String, String)])
-> [(String, String)] -> Nullable [(String, String)]
forall a b. (a -> b) -> a -> b
$ Request -> [(String, String)]
headers Request
req,
              method :: Nullable String
Extism.Manifest.method = String -> Nullable String
forall a. a -> Nullable a
NotNull (String -> Nullable String) -> String -> Nullable String
forall a b. (a -> b) -> a -> b
$ Request -> String
method Request
req
            }
  Memory
j <- String -> IO Memory
allocString String
json
  MemoryOffset
res <- MemoryOffset -> MemoryOffset -> IO MemoryOffset
extismHTTPRequest (Memory -> MemoryOffset
memoryOffset Memory
j) (Memory -> MemoryOffset
memoryOffset Memory
body)
  Int32
code <- IO Int32
extismHTTPStatusCode
  [(String, String)]
h <- IO [(String, String)]
getHeaders
  if MemoryOffset
res MemoryOffset -> MemoryOffset -> Bool
forall a. Eq a => a -> a -> Bool
== MemoryOffset
0
    then Response -> IO Response
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ByteString -> [(String, String)] -> Response
Response (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
code) ByteString
empty [(String, String)]
h)
    else do
      Memory
mem <- MemoryOffset -> IO Memory
findMemory MemoryOffset
res
      ByteString
bs <- Memory -> IO ByteString
loadByteString Memory
mem
      Memory -> IO ()
free Memory
mem
      Response -> IO Response
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ByteString -> [(String, String)] -> Response
Response (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
code) ByteString
bs [(String, String)]
h)

-- | Send HTTP request with an optional request body
sendRequest :: (ToBytes a) => Request -> Maybe a -> IO Response
sendRequest :: forall a. ToBytes a => Request -> Maybe a -> IO Response
sendRequest Request
req Maybe a
b = do
  Memory
body <- IO Memory
bodyMem
  Memory
j <- String -> IO Memory
allocString String
json
  MemoryOffset
res <- MemoryOffset -> MemoryOffset -> IO MemoryOffset
extismHTTPRequest (Memory -> MemoryOffset
memoryOffset Memory
j) (Memory -> MemoryOffset
memoryOffset Memory
body)
  Int32
code <- IO Int32
extismHTTPStatusCode
  [(String, String)]
h <- IO [(String, String)]
getHeaders
  if MemoryOffset
res MemoryOffset -> MemoryOffset -> Bool
forall a. Eq a => a -> a -> Bool
== MemoryOffset
0
    then Response -> IO Response
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ByteString -> [(String, String)] -> Response
Response (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
code) ByteString
empty [(String, String)]
h)
    else do
      MemoryOffset
len <- MemoryOffset -> IO MemoryOffset
extismLengthUnsafe MemoryOffset
res
      let mem :: Memory
mem = MemoryOffset -> MemoryOffset -> Memory
Memory MemoryOffset
res MemoryOffset
len
      ByteString
bs <- Memory -> IO ByteString
loadByteString Memory
mem
      Memory -> IO ()
free Memory
mem
      Response -> IO Response
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> ByteString -> [(String, String)] -> Response
Response (Int32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int32
code) ByteString
bs [(String, String)]
h)
  where
    json :: String
json =
      HTTPRequest -> String
forall a. JSON a => a -> String
encode
        Extism.Manifest.HTTPRequest
          { url :: String
Extism.Manifest.url = Request -> String
url Request
req,
            headers :: Nullable [(String, String)]
Extism.Manifest.headers = [(String, String)] -> Nullable [(String, String)]
forall a. a -> Nullable a
NotNull ([(String, String)] -> Nullable [(String, String)])
-> [(String, String)] -> Nullable [(String, String)]
forall a b. (a -> b) -> a -> b
$ Request -> [(String, String)]
headers Request
req,
            method :: Nullable String
Extism.Manifest.method = String -> Nullable String
forall a. a -> Nullable a
NotNull (String -> Nullable String) -> String -> Nullable String
forall a b. (a -> b) -> a -> b
$ Request -> String
method Request
req
          }
    bodyMem :: IO Memory
bodyMem = case Maybe a
b of
      Maybe a
Nothing -> Memory -> IO Memory
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Memory -> IO Memory) -> Memory -> IO Memory
forall a b. (a -> b) -> a -> b
$ MemoryOffset -> MemoryOffset -> Memory
Memory MemoryOffset
0 MemoryOffset
0
      Just a
b -> a -> IO Memory
forall a. ToBytes a => a -> IO Memory
alloc a
b