{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Network.HTTP3.Client (
run,
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
data ClientConfig = ClientConfig
{ ClientConfig -> Scheme
scheme :: Scheme
, ClientConfig -> Authority
authority :: Authority
}
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 ()
| 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 ()
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
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