{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}

-- | A client library for HTTP/3.

module Network.HTTP3.Client (
  -- * Runner
    run
  -- * Runner arguments
  , ClientConfig(..)
  , Config(..)
  , allocSimpleConfig
  , freeSimpleConfig
  , Hooks(..)
  , defaultHooks
  , Scheme
  , Authority
  -- * HTTP\/3 client
  , Client
  -- * Request
  , Request
  -- * Creating request
  , H2.requestNoBody
  , H2.requestFile
  , H2.requestStreaming
  , H2.requestBuilder
  -- ** Trailers maker
  , H2.TrailersMaker
  , H2.NextTrailersMaker(..)
  , H2.defaultTrailersMaker
  , H2.setRequestTrailersMaker
  -- * Response
  , Response
  -- ** Accessing response
  , H2.responseStatus
  , H2.responseHeaders
  , H2.responseBodySize
  , H2.getResponseBodyChunk
  , H2.getResponseTrailers
  -- * Types
  , H2.Method
  , H2.Path
  , H2.FileSpec(..)
  , H2.FileOffset
  , H2.ByteCount
  -- * RecvN
  , H2.defaultReadN
  -- * Position read for files
  , 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

-- | 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 -> Scheme
authority :: Authority
  }

-- | Running an HTTP\/3 client.
run :: Connection -> ClientConfig -> Config -> H2.Client a -> IO a
run :: 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 = 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 Client a -> Client a
forall a b. (a -> b) -> a -> b
$ Context
-> Scheme -> Scheme -> Request -> (Response -> IO a) -> IO a
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 <- 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

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 (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 = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return () -- error
      | StreamId -> Bool
QUIC.isClientInitiatedBidirectional  StreamId
sid = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      | StreamId -> Bool
QUIC.isServerInitiatedUnidirectional StreamId
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 (m :: * -> *) a. Monad m => a -> m a
return () -- push?
      where
        sid :: StreamId
sid = Stream -> StreamId
QUIC.streamId Stream
strm

sendRequest :: Context -> Scheme -> Authority -> Request -> (Response -> IO a) -> IO a
sendRequest :: 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)
             Header -> [Header] -> [Header]
forall a. a -> [a] -> [a]
: (HeaderName
":authority", Scheme
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 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
              -- 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 HeaderTable
vt -> do
              IORef IFrame
refI <- IFrame -> IO (IORef IFrame)
forall a. a -> IO (IORef a)
newIORef IFrame
IInit
              IORef (Maybe HeaderTable)
refH <- Maybe HeaderTable -> IO (IORef (Maybe HeaderTable))
forall a. a -> IO (IORef a)
newIORef Maybe HeaderTable
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 (InpObj -> Response) -> InpObj -> Response
forall a b. (a -> b) -> a -> b
$ HeaderTable
-> Maybe StreamId
-> IO Scheme
-> IORef (Maybe HeaderTable)
-> InpObj
InpObj HeaderTable
vt Maybe StreamId
forall a. Maybe a
Nothing IO Scheme
readB IORef (Maybe HeaderTable)
refH
              Response -> IO a
processResponse Response
rsp