{-# 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 = IO Context -> (Context -> IO ()) -> (Context -> IO a) -> IO a
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO 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 =
    Context -> (Handle -> IO a) -> IO a
forall a. Context -> (Handle -> IO a) -> IO a
withHandle Context
ctx ((Handle -> IO a) -> IO a) -> (Handle -> IO a) -> IO a
forall a b. (a -> b) -> a -> b
$ \Handle
th -> do
        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 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 -> 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 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