{-# 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 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 qualified UnliftIO.Exception as E

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 = IO Context -> (Context -> IO ()) -> (Context -> IO a) -> IO a
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracket IO Context
open Context -> IO ()
close ((Context -> IO a) -> IO a) -> (Context -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Context
ctx -> do
    ThreadId
tid0 <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Connection -> Config -> IO ()
setupUnidirectional Connection
conn Config
conf
    Context -> ThreadId -> IO ()
addThreadId Context
ctx ThreadId
tid0
    ThreadId
tid1 <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Context -> IO ()
readerClient Context
ctx
    Context -> ThreadId -> IO ()
addThreadId Context
ctx ThreadId
tid1
    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
    open :: IO Context
open = do
        IORef IFrame
ref <- IFrame -> IO (IORef IFrame)
forall a. a -> IO (IORef a)
newIORef IFrame
IInit
        Connection -> Config -> InstructionHandler -> IO Context
newContext Connection
conn Config
conf (Connection -> IORef IFrame -> InstructionHandler
controlStream Connection
conn IORef IFrame
ref)
    close :: Context -> IO ()
close = Context -> IO ()
clearContext
    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 = do
            ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ Context -> Stream -> IO ()
unidirectional Context
ctx Stream
strm
            Context -> ThreadId -> IO ()
addThreadId Context
ctx ThreadId
tid
        | 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 = do
    Handle
th <- Context -> IO Handle
registerThread Context
ctx
    let hdr :: [Header]
hdr = OutObj -> [Header]
outObjHeaders OutObj
outobj
        hdr' :: [Header]
hdr' =
            (HeaderName
":scheme", Scheme
scm)
                Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: (HeaderName
":authority", Authority -> Scheme
C8.pack Authority
auth)
                Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: [Header]
hdr
    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 (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 -> Stream -> Handle -> [Header] -> IO ()
sendHeader Context
ctx Stream
strm Handle
th [Header]
hdr'
        ThreadId
tid <- IO () -> IO ThreadId
forkIO (IO () -> IO ThreadId) -> IO () -> IO ThreadId
forall a b. (a -> b) -> a -> b
$ do
            Context -> Stream -> Handle -> OutObj -> IO ()
sendBody Context
ctx Stream
strm Handle
th OutObj
outobj
            Stream -> IO ()
QUIC.shutdownStream Stream
strm
        Context -> ThreadId -> IO ()
addThreadId Context
ctx ThreadId
tid
        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 (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m 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
readB = Context
-> Source
-> IORef IFrame
-> IORef (Maybe TokenHeaderTable)
-> IO Scheme
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
-> IORef (Maybe TokenHeaderTable)
-> InpObj
InpObj TokenHeaderTable
vt Maybe Int
forall a. Maybe a
Nothing IO Scheme
readB IORef (Maybe TokenHeaderTable)
refH
                Response -> IO a
processResponse Response
rsp