    {-# LANGUAGE RecordWildCards #-}
    {-# LANGUAGE BangPatterns #-}
    {-# LANGUAGE OverloadedStrings #-}
    {-# LANGUAGE PatternGuards #-}
    {-# LANGUAGE ScopedTypeVariables #-}

    module Network.Wai.Handler.Warp.HTTP2 (
        http2
      , http2server
      ) where

    import qualified Data.IORef as I
    import qualified Control.Exception as E
    import qualified Network.HTTP2.Server as H2
    import Network.Socket (SockAddr)
    import Network.Wai
    import Network.Wai.Internal (ResponseReceived(..))
    import qualified System.TimeManager as T

    import Network.Wai.Handler.Warp.HTTP2.File
    import Network.Wai.Handler.Warp.HTTP2.PushPromise
    import Network.Wai.Handler.Warp.HTTP2.Request
    import Network.Wai.Handler.Warp.HTTP2.Response
    import Network.Wai.Handler.Warp.Imports
    import qualified Network.Wai.Handler.Warp.Settings as S
    import Network.Wai.Handler.Warp.Types

    ----------------------------------------------------------------

    http2 :: S.Settings
          -> InternalInfo
          -> Connection
          -> Transport
          -> SockAddr
          -> (BufSize -> IO ByteString)
          -> (ByteString -> IO ())
          -> Application
          -> IO ()
    http2 :: Settings
    -> InternalInfo
    -> Connection
    -> Transport
    -> SockAddr
    -> (BufSize -> IO ByteString)
    -> (ByteString -> IO ())
    -> Application
    -> IO ()
    http2 settings :: Settings
    settings ii :: InternalInfo
    ii conn :: Connection
    conn transport :: Transport
    transport addr :: SockAddr
    addr readN :: BufSize -> IO ByteString
    readN send :: ByteString -> IO ()
    send app :: Application
    app =
        Config -> Server -> IO ()
    H2.run Config
    conf (Server -> IO ()) -> Server -> IO ()
    forall a b. (a -> b) -> a -> b
    $ Settings
    -> InternalInfo -> Transport -> SockAddr -> Application -> Server
    http2server Settings
    settings InternalInfo
    ii Transport
    transport SockAddr
    addr Application
    app
      where
        conf :: Config
    conf = $WConfig :: Buffer
    -> BufSize
    -> (ByteString -> IO ())
    -> (BufSize -> IO ByteString)
    -> PositionReadMaker
    -> Config
    H2.Config {
            confWriteBuffer :: Buffer
    confWriteBuffer       = Connection -> Buffer
    connWriteBuffer Connection
    conn
          , confBufferSize :: BufSize
    confBufferSize        = Connection -> BufSize
    connBufferSize Connection
    conn
          , confSendAll :: ByteString -> IO ()
    confSendAll           = ByteString -> IO ()
    send
          , confReadN :: BufSize -> IO ByteString
    confReadN             = BufSize -> IO ByteString
    readN
          , confPositionReadMaker :: PositionReadMaker
    confPositionReadMaker = InternalInfo -> PositionReadMaker
    pReadMaker InternalInfo
    ii
          }

    -- | Converting WAI application to the server type of http2 library.
    --
    -- Since 3.3.11
    http2server :: S.Settings
                -> InternalInfo
                -> Transport
                -> SockAddr
                -> Application
                -> H2.Server
    http2server :: Settings
    -> InternalInfo -> Transport -> SockAddr -> Application -> Server
    http2server settings :: Settings
    settings ii :: InternalInfo
    ii transport :: Transport
    transport addr :: SockAddr
    addr app :: Application
    app h2req0 :: Request
    h2req0 aux0 :: Aux
    aux0 response :: Response -> [PushPromise] -> IO ()
    response = do
        Request
    req <- Request -> Aux -> IO Request
    toWAIRequest Request
    h2req0 Aux
    aux0
        IORef (Maybe (Response, [PushPromise], Status))
    ref <- Maybe (Response, [PushPromise], Status)
    -> IO (IORef (Maybe (Response, [PushPromise], Status)))
    forall a. a -> IO (IORef a)
    I.newIORef Maybe (Response, [PushPromise], Status)
    forall a. Maybe a
    Nothing
        Either SomeException ResponseReceived
    eResponseReceived <- IO ResponseReceived -> IO (Either SomeException ResponseReceived)
    forall e a. Exception e => IO a -> IO (Either e a)
    E.try (IO ResponseReceived -> IO (Either SomeException ResponseReceived))
    -> IO ResponseReceived
    -> IO (Either SomeException ResponseReceived)
    forall a b. (a -> b) -> a -> b
    $ Application
    app Request
    req ((Response -> IO ResponseReceived) -> IO ResponseReceived)
    -> (Response -> IO ResponseReceived) -> IO ResponseReceived
    forall a b. (a -> b) -> a -> b
    $ \rsp :: Response
    rsp -> do
            (h2rsp :: Response
    h2rsp,st :: Status
    st,hasBody :: Bool
    hasBody) <- Settings
    -> InternalInfo
    -> Request
    -> Response
    -> IO (Response, Status, Bool)
    fromResponse Settings
    settings InternalInfo
    ii Request
    req Response
    rsp
            [PushPromise]
    pps <- if Bool
    hasBody then InternalInfo -> Request -> IO [PushPromise]
    fromPushPromises InternalInfo
    ii Request
    req else [PushPromise] -> IO [PushPromise]
    forall (m :: * -> *) a. Monad m => a -> m a
    return []
            IORef (Maybe (Response, [PushPromise], Status))
    -> Maybe (Response, [PushPromise], Status) -> IO ()
    forall a. IORef a -> a -> IO ()
    I.writeIORef IORef (Maybe (Response, [PushPromise], Status))
    ref (Maybe (Response, [PushPromise], Status) -> IO ())
    -> Maybe (Response, [PushPromise], Status) -> IO ()
    forall a b. (a -> b) -> a -> b
    $ (Response, [PushPromise], Status)
    -> Maybe (Response, [PushPromise], Status)
    forall a. a -> Maybe a
    Just (Response
    h2rsp, [PushPromise]
    pps, Status
    st)
            ()
    _ <- Response -> [PushPromise] -> IO ()
    response Response
    h2rsp [PushPromise]
    pps
            ResponseReceived -> IO ResponseReceived
    forall (m :: * -> *) a. Monad m => a -> m a
    return ResponseReceived
    ResponseReceived
        case Either SomeException ResponseReceived
    eResponseReceived of
          Right ResponseReceived -> do
              Just (h2rsp :: Response
    h2rsp, pps :: [PushPromise]
    pps, st :: Status
    st) <- IORef (Maybe (Response, [PushPromise], Status))
    -> IO (Maybe (Response, [PushPromise], Status))
    forall a. IORef a -> IO a
    I.readIORef IORef (Maybe (Response, [PushPromise], Status))
    ref
              let msiz :: Maybe Integer
    msiz = BufSize -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (BufSize -> Integer) -> Maybe BufSize -> Maybe Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Response -> Maybe BufSize
    H2.responseBodySize Response
    h2rsp
              Request -> Status -> Maybe Integer -> IO ()
    logResponse Request
    req Status
    st Maybe Integer
    msiz
              (PushPromise -> IO ()) -> [PushPromise] -> IO ()
    forall (t :: * -> *) (m :: * -> *) a b.
    (Foldable t, Monad m) =>
    (a -> m b) -> t a -> m ()
    mapM_ (Request -> PushPromise -> IO ()
    logPushPromise Request
    req) [PushPromise]
    pps
          Left e :: SomeException
    e@(E.SomeException _)
            -- killed by the local worker manager
            | Just E.ThreadKilled  <- SomeException -> Maybe AsyncException
    forall e. Exception e => SomeException -> Maybe e
    E.fromException SomeException
    e -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            -- killed by the local timeout manager
            | Just T.TimeoutThread <- SomeException -> Maybe TimeoutThread
    forall e. Exception e => SomeException -> Maybe e
    E.fromException SomeException
    e -> () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
            | Bool
    otherwise -> do
                Settings -> Maybe Request -> SomeException -> IO ()
    S.settingsOnException Settings
    settings (Request -> Maybe Request
    forall a. a -> Maybe a
    Just Request
    req) SomeException
    e
                let ersp :: Response
    ersp = Settings -> SomeException -> Response
    S.settingsOnExceptionResponse Settings
    settings SomeException
    e
                    st :: Status
    st = Response -> Status
    responseStatus Response
    ersp
                (h2rsp' :: Response
    h2rsp',_,_) <- Settings
    -> InternalInfo
    -> Request
    -> Response
    -> IO (Response, Status, Bool)
    fromResponse Settings
    settings InternalInfo
    ii Request
    req Response
    ersp
                let msiz :: Maybe Integer
    msiz = BufSize -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (BufSize -> Integer) -> Maybe BufSize -> Maybe Integer
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
    <$> Response -> Maybe BufSize
    H2.responseBodySize Response
    h2rsp'
                ()
    _ <- Response -> [PushPromise] -> IO ()
    response Response
    h2rsp' []
                Request -> Status -> Maybe Integer -> IO ()
    logResponse Request
    req Status
    st Maybe Integer
    msiz
        () -> IO ()
    forall (m :: * -> *) a. Monad m => a -> m a
    return ()
      where
        toWAIRequest :: Request -> Aux -> IO Request
    toWAIRequest h2req :: Request
    h2req aux :: Aux
    aux = InternalInfo -> Settings -> SockAddr -> ToReq
    toRequest InternalInfo
    ii Settings
    settings SockAddr
    addr HeaderTable
    hdr Maybe BufSize
    bdylen IO ByteString
    bdy Handle
    th Transport
    transport
          where
            !hdr :: HeaderTable
    hdr = Request -> HeaderTable
    H2.requestHeaders Request
    h2req
            !bdy :: IO ByteString
    bdy = Request -> IO ByteString
    H2.getRequestBodyChunk Request
    h2req
            !bdylen :: Maybe BufSize
    bdylen = Request -> Maybe BufSize
    H2.requestBodySize Request
    h2req
            !th :: Handle
    th = Aux -> Handle
    H2.auxTimeHandle Aux
    aux

        logResponse :: Request -> Status -> Maybe Integer -> IO ()
    logResponse = Settings -> Request -> Status -> Maybe Integer -> IO ()
    S.settingsLogger Settings
    settings

        logPushPromise :: Request -> PushPromise -> IO ()
    logPushPromise req :: Request
    req pp :: PushPromise
    pp = Request -> ByteString -> Integer -> IO ()
    logger Request
    req ByteString
    path Integer
    siz
          where
            !logger :: Request -> ByteString -> Integer -> IO ()
    logger = Settings -> Request -> ByteString -> Integer -> IO ()
    S.settingsServerPushLogger Settings
    settings
            !path :: ByteString
    path = PushPromise -> ByteString
    H2.promiseRequestPath PushPromise
    pp
            !siz :: Integer
    siz = case Response -> Maybe BufSize
    H2.responseBodySize (Response -> Maybe BufSize) -> Response -> Maybe BufSize
    forall a b. (a -> b) -> a -> b
    $ PushPromise -> Response
    H2.promiseResponse PushPromise
    pp of
                Nothing -> 0
                Just s :: BufSize
    s  -> BufSize -> Integer
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral BufSize
    s