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

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

    -- * Runner arguments
    ClientConfig (..),
    Config (..),
    allocSimpleConfig,
    freeSimpleConfig,
    Hooks (..),
    defaultHooks,
    module Network.HTTP.Semantics.Client,
) where

import Control.Concurrent
import qualified Control.Exception as E
import qualified Data.ByteString.Char8 as C8
import Data.IORef
import Network.HTTP.Semantics.Client
import Network.HTTP.Semantics.Client.Internal
import Network.QUIC (Connection)
import qualified Network.QUIC as QUIC
import Network.QUIC.Internal (possibleMyStreams)

import Imports
import Network.HTTP3.Config
import Network.HTTP3.Context
import Network.HTTP3.Control
import Network.HTTP3.Error
import Network.HTTP3.Frame
import Network.HTTP3.Recv
import Network.HTTP3.Send

-- | Configuration for HTTP\/3 or HQ client. For HQ, 'authority' is
--   not used and an server's IP address is used in 'Request'.
data ClientConfig = ClientConfig
    { ClientConfig -> Scheme
scheme :: Scheme
    , ClientConfig -> Authority
authority :: Authority
    }

-- | Running an HTTP\/3 client.
run :: Connection -> ClientConfig -> Config -> Client a -> IO a
run :: forall a. Connection -> ClientConfig -> Config -> Client a -> IO a
run Connection
conn ClientConfig{Authority
Scheme
authority :: ClientConfig -> Authority
scheme :: ClientConfig -> Scheme
scheme :: Scheme
authority :: Authority
..} Config
conf Client a
client = Connection -> Config -> (Context -> IO a) -> IO a
forall a. Connection -> Config -> (Context -> IO a) -> IO a
withContext Connection
conn Config
conf ((Context -> IO a) -> IO a) -> (Context -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Context
ctx -> do
    Context -> Authority -> IO () -> IO ()
forkManaged Context
ctx Authority
"H3 client: unidirectional setter" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Connection -> Config -> IO ()
setupUnidirectional Connection
conn Config
conf
    Context -> Authority -> IO () -> IO ()
forkManaged Context
ctx Authority
"H3 client: readerClient" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Context -> IO ()
readerClient Context
ctx
    Client a
client (Context
-> Scheme -> Authority -> Request -> (Response -> IO r) -> IO r
forall a.
Context
-> Scheme -> Authority -> Request -> (Response -> IO a) -> IO a
sendRequest Context
ctx Scheme
scheme Authority
authority) Aux
aux
  where
    aux :: Aux
aux =
        Aux
            { auxPossibleClientStreams :: IO Int
auxPossibleClientStreams = Connection -> IO Int
possibleMyStreams Connection
conn
            }

readerClient :: Context -> IO ()
readerClient :: Context -> IO ()
readerClient Context
ctx = IO ()
forall {b}. IO b
loop
  where
    loop :: IO b
loop = do
        Context -> IO Stream
accept Context
ctx IO Stream -> (Stream -> IO ()) -> IO ()
forall a b. IO a -> (a -> IO b) -> IO b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Stream -> IO ()
process
        IO b
loop
    process :: Stream -> IO ()
process Stream
strm
        | Int -> Bool
QUIC.isClientInitiatedUnidirectional Int
sid = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- error
        | Int -> Bool
QUIC.isClientInitiatedBidirectional Int
sid = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        | Int -> Bool
QUIC.isServerInitiatedUnidirectional Int
sid =
            Context -> Authority -> IO () -> IO ()
forkManaged Context
ctx Authority
"H3 client: unidirectional handler" (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                Context -> Stream -> IO ()
unidirectional Context
ctx Stream
strm
        | Bool
otherwise = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return () -- push?
      where
        sid :: Int
sid = Stream -> Int
QUIC.streamId Stream
strm

sendRequest
    :: Context -> Scheme -> Authority -> Request -> (Response -> IO a) -> IO a
sendRequest :: forall a.
Context
-> Scheme -> Authority -> Request -> (Response -> IO a) -> IO a
sendRequest Context
ctx Scheme
scm Authority
auth (Request OutObj
outobj) Response -> IO a
processResponse =
    IO Stream -> (Stream -> IO ()) -> (Stream -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (Context -> IO Stream
newStream Context
ctx) Stream -> IO ()
closeStream ((Stream -> IO a) -> IO a) -> (Stream -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Stream
strm -> do
        Context -> Authority -> (Handle -> IO ()) -> IO ()
forkManagedTimeout Context
ctx Authority
"H3 client: sendRequest" ((Handle -> IO ()) -> IO ()) -> (Handle -> IO ()) -> IO ()
forall a b. (a -> b) -> a -> b
$ \Handle
th -> do
            Context -> Stream -> Handle -> ResponseHeaders -> IO ()
sendHeader Context
ctx Stream
strm Handle
th ResponseHeaders
hdr'
            Context -> Stream -> Handle -> OutObj -> IO ()
sendBody Context
ctx Stream
strm Handle
th OutObj
outobj
            Stream -> IO ()
QUIC.shutdownStream Stream
strm
        Source
src <- Stream -> IO Source
newSource Stream
strm
        Maybe TokenHeaderTable
mvt <- Context -> Source -> IO (Maybe TokenHeaderTable)
recvHeader Context
ctx Source
src
        case Maybe TokenHeaderTable
mvt of
            Maybe TokenHeaderTable
Nothing -> do
                Stream -> ApplicationProtocolError -> IO ()
QUIC.resetStream Stream
strm ApplicationProtocolError
H3MessageError
                Int -> IO ()
threadDelay Int
100000
                -- just for type inference
                QUICException -> IO a
forall e a. Exception e => e -> IO a
E.throwIO (QUICException -> IO a) -> QUICException -> IO a
forall a b. (a -> b) -> a -> b
$ ApplicationProtocolError -> ReasonPhrase -> QUICException
QUIC.ApplicationProtocolErrorIsSent ApplicationProtocolError
H3MessageError ReasonPhrase
""
            Just TokenHeaderTable
vt -> do
                IORef IFrame
refI <- IFrame -> IO (IORef IFrame)
forall a. a -> IO (IORef a)
newIORef IFrame
IInit
                IORef (Maybe TokenHeaderTable)
refH <- Maybe TokenHeaderTable -> IO (IORef (Maybe TokenHeaderTable))
forall a. a -> IO (IORef a)
newIORef Maybe TokenHeaderTable
forall a. Maybe a
Nothing
                let readB :: IO (Scheme, Bool)
readB = Context
-> Source
-> IORef IFrame
-> IORef (Maybe TokenHeaderTable)
-> IO (Scheme, Bool)
recvBody Context
ctx Source
src IORef IFrame
refI IORef (Maybe TokenHeaderTable)
refH
                    rsp :: Response
rsp = InpObj -> Response
Response (InpObj -> Response) -> InpObj -> Response
forall a b. (a -> b) -> a -> b
$ TokenHeaderTable
-> Maybe Int
-> IO (Scheme, Bool)
-> IORef (Maybe TokenHeaderTable)
-> InpObj
InpObj TokenHeaderTable
vt Maybe Int
forall a. Maybe a
Nothing IO (Scheme, Bool)
readB IORef (Maybe TokenHeaderTable)
refH
                Response -> IO a
processResponse Response
rsp
  where
    hdr :: ResponseHeaders
hdr = OutObj -> ResponseHeaders
outObjHeaders OutObj
outobj
    hdr' :: ResponseHeaders
hdr' = (HeaderName
":scheme", Scheme
scm) (HeaderName, Scheme) -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
: (HeaderName
":authority", Authority -> Scheme
C8.pack Authority
auth) (HeaderName, Scheme) -> ResponseHeaders -> ResponseHeaders
forall a. a -> [a] -> [a]
: ResponseHeaders
hdr