{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE RecordWildCards #-}
module Network.HTTP3.Client (
run
, ClientConfig(..)
, Config(..)
, allocSimpleConfig
, freeSimpleConfig
, Hooks(..)
, defaultHooks
, Scheme
, Authority
, Client
, Request
, H2.requestNoBody
, H2.requestFile
, H2.requestStreaming
, H2.requestBuilder
, H2.TrailersMaker
, H2.NextTrailersMaker(..)
, H2.defaultTrailersMaker
, H2.setRequestTrailersMaker
, Response
, H2.responseStatus
, H2.responseHeaders
, H2.responseBodySize
, H2.getResponseBodyChunk
, H2.getResponseTrailers
, H2.Method
, H2.Path
, H2.FileSpec(..)
, H2.FileOffset
, H2.ByteCount
, H2.defaultReadN
, H2.PositionReadMaker
, H2.PositionRead
, H2.Sentinel(..)
, H2.defaultPositionReadMaker
) where
import Control.Concurrent
import Data.IORef
import Network.HTTP2.Client (Scheme, Authority, Client)
import qualified Network.HTTP2.Client as H2
import Network.HTTP2.Client.Internal (Request(..), Response(..))
import Network.HTTP2.Internal (InpObj(..))
import qualified Network.HTTP2.Internal as H2
import Network.QUIC (Connection)
import qualified Network.QUIC as QUIC
import qualified UnliftIO.Exception as E
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 -> Scheme
authority :: Authority
}
run :: Connection -> ClientConfig -> Config -> H2.Client a -> IO a
run :: forall a. Connection -> ClientConfig -> Config -> Client a -> IO a
run Connection
conn ClientConfig{Scheme
authority :: Scheme
scheme :: Scheme
authority :: ClientConfig -> Scheme
scheme :: ClientConfig -> Scheme
..} Config
conf Client a
client = 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 forall a b. (a -> b) -> a -> b
$ \Context
ctx -> do
ThreadId
tid0 <- IO () -> IO ThreadId
forkIO 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 forall a b. (a -> b) -> a -> b
$ Context -> IO ()
readerClient Context
ctx
Context -> ThreadId -> IO ()
addThreadId Context
ctx ThreadId
tid1
Client a
client forall a b. (a -> b) -> a -> b
$ forall a.
Context
-> Scheme -> Scheme -> Request -> (Response -> IO a) -> IO a
sendRequest Context
ctx Scheme
scheme Scheme
authority
where
open :: IO Context
open = do
IORef IFrame
ref <- 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
readerClient :: Context -> IO ()
readerClient :: Context -> IO ()
readerClient Context
ctx = forall {b}. IO b
loop
where
loop :: IO b
loop = do
Context -> IO Stream
accept Context
ctx 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
| StreamId -> Bool
QUIC.isClientInitiatedUnidirectional StreamId
sid = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| StreamId -> Bool
QUIC.isClientInitiatedBidirectional StreamId
sid = forall (m :: * -> *) a. Monad m => a -> m a
return ()
| StreamId -> Bool
QUIC.isServerInitiatedUnidirectional StreamId
sid = do
ThreadId
tid <- IO () -> IO ThreadId
forkIO 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 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
where
sid :: StreamId
sid = Stream -> StreamId
QUIC.streamId Stream
strm
sendRequest :: Context -> Scheme -> Authority -> Request -> (Response -> IO a) -> IO a
sendRequest :: forall a.
Context
-> Scheme -> Scheme -> Request -> (Response -> IO a) -> IO a
sendRequest Context
ctx Scheme
scm Scheme
auth (Request OutObj
outobj) Response -> IO a
processResponse = do
Handle
th <- Context -> IO Handle
registerThread Context
ctx
let hdr :: [Header]
hdr = OutObj -> [Header]
H2.outObjHeaders OutObj
outobj
hdr' :: [Header]
hdr' = (HeaderName
":scheme", Scheme
scm)
forall a. a -> [a] -> [a]
: (HeaderName
":authority", Scheme
auth)
forall a. a -> [a] -> [a]
: [Header]
hdr
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 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 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 HeaderTable
mvt <- Context -> Source -> IO (Maybe HeaderTable)
recvHeader Context
ctx Source
src
case Maybe HeaderTable
mvt of
Maybe HeaderTable
Nothing -> do
Stream -> ApplicationProtocolError -> IO ()
QUIC.resetStream Stream
strm ApplicationProtocolError
H3MessageError
StreamId -> IO ()
threadDelay StreamId
100000
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO forall a b. (a -> b) -> a -> b
$ ApplicationProtocolError -> ReasonPhrase -> QUICException
QUIC.ApplicationProtocolErrorIsSent ApplicationProtocolError
H3MessageError ReasonPhrase
""
Just HeaderTable
vt -> do
IORef IFrame
refI <- forall a. a -> IO (IORef a)
newIORef IFrame
IInit
IORef (Maybe HeaderTable)
refH <- forall a. a -> IO (IORef a)
newIORef forall a. Maybe a
Nothing
let readB :: IO Scheme
readB = Context
-> Source -> IORef IFrame -> IORef (Maybe HeaderTable) -> IO Scheme
recvBody Context
ctx Source
src IORef IFrame
refI IORef (Maybe HeaderTable)
refH
rsp :: Response
rsp = InpObj -> Response
Response forall a b. (a -> b) -> a -> b
$ HeaderTable
-> Maybe StreamId
-> IO Scheme
-> IORef (Maybe HeaderTable)
-> InpObj
InpObj HeaderTable
vt forall a. Maybe a
Nothing IO Scheme
readB IORef (Maybe HeaderTable)
refH
Response -> IO a
processResponse Response
rsp