{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}

-- | A client library for HTTP/0.9.
module Network.HQ.Client (
    -- * Runner
    run,

    -- * Runner arguments
    H3.ClientConfig (..),
    H3.Config (..),
    H3.allocSimpleConfig,
    H3.freeSimpleConfig,
    H3.Scheme,
    H3.Authority,

    -- * HQ client
    H2.Client,

    -- * Request
    Request,

    -- * Creating request
    H2.requestNoBody,

    -- * Response
    Response,

    -- ** Accessing response
    H2.getResponseBodyChunk,
) where

import qualified Data.ByteString as BS
import Data.IORef
import Data.Maybe (fromJust)
import Network.HPACK
import qualified Network.HTTP2.Client as H2
import Network.HTTP2.Client.Internal (Request (..), Response (..), Aux (..))
import Network.HTTP2.Internal (InpObj (..))
import qualified Network.HTTP2.Internal as H2
import Network.QUIC (Connection)
import Network.QUIC.Internal (possibleMyStreams)
import qualified Network.QUIC as QUIC
import qualified UnliftIO.Exception as E

import qualified Network.HTTP3.Client as H3
import Network.HTTP3.Recv (newSource, readSource)

-- | Running an HQ client.
run :: Connection -> H3.ClientConfig -> H3.Config -> H2.Client a -> IO a
run :: forall a. Connection -> ClientConfig -> Config -> Client a -> IO a
run Connection
conn ClientConfig
_ Config
_ Client a
client = Client a
client (Connection -> Request -> (Response -> IO r) -> IO r
forall a. Connection -> Request -> (Response -> IO a) -> IO a
sendRequest Connection
conn) Aux
aux
  where
    aux :: Aux
aux =
        Aux
            { auxPossibleClientStreams :: IO Int
auxPossibleClientStreams = Connection -> IO Int
possibleMyStreams Connection
conn
            }

sendRequest :: Connection -> Request -> (Response -> IO a) -> IO a
sendRequest :: forall a. Connection -> Request -> (Response -> IO a) -> IO a
sendRequest Connection
conn (Request OutObj
outobj) Response -> IO a
processResponse = IO Stream -> (Stream -> IO ()) -> (Stream -> IO a) -> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracket IO Stream
open Stream -> IO ()
close ((Stream -> IO a) -> IO a) -> (Stream -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Stream
strm -> do
    let hdr :: [Header]
hdr = OutObj -> [Header]
H2.outObjHeaders OutObj
outobj
        path :: ByteString
path = Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe ByteString -> ByteString) -> Maybe ByteString -> ByteString
forall a b. (a -> b) -> a -> b
$ HeaderName -> [Header] -> Maybe ByteString
forall a b. Eq a => a -> [(a, b)] -> Maybe b
lookup HeaderName
":path" [Header]
hdr
        requestLine :: ByteString
requestLine = [ByteString] -> ByteString
BS.concat [ByteString
"GET ", ByteString
path, ByteString
"\r\n"]
    Stream -> ByteString -> IO ()
QUIC.sendStream Stream
strm ByteString
requestLine
    Stream -> IO ()
QUIC.shutdownStream Stream
strm
    Source
src <- Stream -> IO Source
newSource Stream
strm
    IORef (Maybe HeaderTable)
refH <- Maybe HeaderTable -> IO (IORef (Maybe HeaderTable))
forall a. a -> IO (IORef a)
newIORef Maybe HeaderTable
forall a. Maybe a
Nothing
    HeaderTable
vt <- [Header] -> IO HeaderTable
toHeaderTable []
    let readB :: IO ByteString
readB = Source -> IO ByteString
readSource Source
src
        rsp :: Response
rsp = InpObj -> Response
Response (InpObj -> Response) -> InpObj -> Response
forall a b. (a -> b) -> a -> b
$ HeaderTable
-> Maybe Int
-> IO ByteString
-> IORef (Maybe HeaderTable)
-> InpObj
InpObj HeaderTable
vt Maybe Int
forall a. Maybe a
Nothing IO ByteString
readB IORef (Maybe HeaderTable)
refH
    Response -> IO a
processResponse Response
rsp
  where
    open :: IO Stream
open = Connection -> IO Stream
QUIC.stream Connection
conn
    close :: Stream -> IO ()
close = Stream -> IO ()
QUIC.closeStream