{-# 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
  , 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 :: 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 () -- error
      | 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 () -- push?
      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
              -- just for type inference
              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