{-# 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 { scheme :: Scheme , authority :: Authority } -- | Running an HTTP\/3 client. run :: Connection -> ClientConfig -> Config -> Client a -> IO a run conn ClientConfig{..} conf client = E.bracket open close $ \ctx -> do tid0 <- forkIO $ setupUnidirectional conn conf addThreadId ctx tid0 tid1 <- forkIO $ readerClient ctx addThreadId ctx tid1 client (sendRequest ctx scheme authority) aux where open = do ref <- newIORef IInit newContext conn conf (controlStream conn ref) close = clearContext aux = Aux { auxPossibleClientStreams = possibleMyStreams conn } readerClient :: Context -> IO () readerClient ctx = loop where loop = do accept ctx >>= process loop process strm | QUIC.isClientInitiatedUnidirectional sid = return () -- error | QUIC.isClientInitiatedBidirectional sid = return () | QUIC.isServerInitiatedUnidirectional sid = do tid <- forkIO $ unidirectional ctx strm addThreadId ctx tid | otherwise = return () -- push? where sid = QUIC.streamId strm sendRequest :: Context -> Scheme -> Authority -> Request -> (Response -> IO a) -> IO a sendRequest ctx scm auth (Request outobj) processResponse = do th <- registerThread ctx let hdr = outObjHeaders outobj hdr' = (":scheme", scm) : (":authority", C8.pack auth) : hdr E.bracket (newStream ctx) closeStream $ \strm -> do sendHeader ctx strm th hdr' tid <- forkIO $ do sendBody ctx strm th outobj QUIC.shutdownStream strm addThreadId ctx tid src <- newSource strm mvt <- recvHeader ctx src case mvt of Nothing -> do QUIC.resetStream strm H3MessageError threadDelay 100000 -- just for type inference E.throwIO $ QUIC.ApplicationProtocolErrorIsSent H3MessageError "" Just vt -> do refI <- newIORef IInit refH <- newIORef Nothing let readB = recvBody ctx src refI refH rsp = Response $ InpObj vt Nothing readB refH processResponse rsp