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

    module Network.Wai.Handler.Warp.HTTP2.Response (
        fromResponse,
    ) where

    import qualified Control.Exception as E
    import qualified Data.ByteString.Builder as BB
    import qualified Data.List as L (find)
    import qualified Network.HTTP.Types as H
    import qualified Network.HTTP2.Server as H2
    import Network.Wai hiding (responseBuilder, responseFile, responseStream)
    import Network.Wai.Internal (Response (..))

    import Network.Wai.Handler.Warp.File
    import Network.Wai.Handler.Warp.HTTP2.Request (getHTTP2Data)
    import Network.Wai.Handler.Warp.HTTP2.Types
    import Network.Wai.Handler.Warp.Header
    import qualified Network.Wai.Handler.Warp.Response as R
    import qualified Network.Wai.Handler.Warp.Settings as S
    import Network.Wai.Handler.Warp.Types

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

    fromResponse
        :: S.Settings
        -> InternalInfo
        -> Request
        -> Response
        -> IO (H2.Response, H.Status, Bool)
    fromResponse :: Settings
    -> InternalInfo
    -> Request
    -> Response
    -> IO (Response, Status, Bool)
    fromResponse Settings
    settings InternalInfo
    ii Request
    req Response
    rsp = do
        date <- InternalInfo -> IO Method
    getDate InternalInfo
    ii
        rspst@(h2rsp, st, hasBody) <- case rsp of
            ResponseFile Status
    st ResponseHeaders
    rsphdr FilePath
    path Maybe FilePart
    mpart -> do
                let rsphdr' :: ResponseHeaders
    rsphdr' = Method -> ResponseHeaders -> ResponseHeaders
    add Method
    date ResponseHeaders
    rsphdr
                Status
    -> ResponseHeaders
    -> Method
    -> FilePath
    -> Maybe FilePart
    -> InternalInfo
    -> ResponseHeaders
    -> IO (Response, Status, Bool)
    responseFile Status
    st ResponseHeaders
    rsphdr' Method
    method FilePath
    path Maybe FilePart
    mpart InternalInfo
    ii ResponseHeaders
    reqhdr
            ResponseBuilder Status
    st ResponseHeaders
    rsphdr Builder
    builder -> do
                let rsphdr' :: ResponseHeaders
    rsphdr' = Method -> ResponseHeaders -> ResponseHeaders
    add Method
    date ResponseHeaders
    rsphdr
                (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Response, Status, Bool) -> IO (Response, Status, Bool))
    -> (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a b. (a -> b) -> a -> b
    $ Status
    -> ResponseHeaders -> Method -> Builder -> (Response, Status, Bool)
    responseBuilder Status
    st ResponseHeaders
    rsphdr' Method
    method Builder
    builder
            ResponseStream Status
    st ResponseHeaders
    rsphdr StreamingBody
    strmbdy -> do
                let rsphdr' :: ResponseHeaders
    rsphdr' = Method -> ResponseHeaders -> ResponseHeaders
    add Method
    date ResponseHeaders
    rsphdr
                (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Response, Status, Bool) -> IO (Response, Status, Bool))
    -> (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a b. (a -> b) -> a -> b
    $ Status
    -> ResponseHeaders
    -> Method
    -> StreamingBody
    -> (Response, Status, Bool)
    responseStream Status
    st ResponseHeaders
    rsphdr' Method
    method StreamingBody
    strmbdy
            Response
    _ -> FilePath -> IO (Response, Status, Bool)
    forall a. HasCallStack => FilePath -> a
    error FilePath
    "ResponseRaw is not supported in HTTP/2"
        mh2data <- getHTTP2Data req
        case mh2data of
            Maybe HTTP2Data
    Nothing -> (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Response, Status, Bool)
    rspst
            Just HTTP2Data
    h2data -> do
                let !trailers :: TrailersMaker
    trailers = HTTP2Data -> TrailersMaker
    http2dataTrailers HTTP2Data
    h2data
                    !h2rsp' :: Response
    h2rsp' = Response -> TrailersMaker -> Response
    H2.setResponseTrailersMaker Response
    h2rsp TrailersMaker
    trailers
                (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return (Response
    h2rsp', Status
    st, Bool
    hasBody)
      where
        !method :: Method
    method = Request -> Method
    requestMethod Request
    req
        !reqhdr :: ResponseHeaders
    reqhdr = Request -> ResponseHeaders
    requestHeaders Request
    req
        !server :: Method
    server = Settings -> Method
    S.settingsServerName Settings
    settings
        add :: Method -> ResponseHeaders -> ResponseHeaders
    add Method
    date ResponseHeaders
    rsphdr =
            let hasServerHdr :: Maybe (HeaderName, Method)
    hasServerHdr = ((HeaderName, Method) -> Bool)
    -> ResponseHeaders -> Maybe (HeaderName, Method)
    forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Maybe a
    L.find ((HeaderName -> HeaderName -> Bool
    forall a. Eq a => a -> a -> Bool
    == HeaderName
    H.hServer) (HeaderName -> Bool)
    -> ((HeaderName, Method) -> HeaderName)
    -> (HeaderName, Method)
    -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . (HeaderName, Method) -> HeaderName
    forall a b. (a, b) -> a
    fst) ResponseHeaders
    rsphdr
                addSVR :: ResponseHeaders -> ResponseHeaders
    addSVR =
                    (ResponseHeaders -> ResponseHeaders)
    -> ((HeaderName, Method) -> ResponseHeaders -> ResponseHeaders)
    -> Maybe (HeaderName, Method)
    -> ResponseHeaders
    -> ResponseHeaders
    forall b a. b -> (a -> b) -> Maybe a -> b
    maybe ((HeaderName
    H.hServer, Method
    server) (HeaderName, Method) -> ResponseHeaders -> ResponseHeaders
    forall a. a -> [a] -> [a]
    :) ((ResponseHeaders -> ResponseHeaders)
    -> (HeaderName, Method) -> ResponseHeaders -> ResponseHeaders
    forall a b. a -> b -> a
    const ResponseHeaders -> ResponseHeaders
    forall a. a -> a
    id) Maybe (HeaderName, Method)
    hasServerHdr
             in Settings -> ResponseHeaders -> ResponseHeaders
    R.addAltSvc Settings
    settings (ResponseHeaders -> ResponseHeaders)
    -> ResponseHeaders -> ResponseHeaders
    forall a b. (a -> b) -> a -> b
    $
                    (HeaderName
    H.hDate, Method
    date) (HeaderName, Method) -> ResponseHeaders -> ResponseHeaders
    forall a. a -> [a] -> [a]
    : ResponseHeaders -> ResponseHeaders
    addSVR ResponseHeaders
    rsphdr

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

    responseFile
        :: H.Status
        -> H.ResponseHeaders
        -> H.Method
        -> FilePath
        -> Maybe FilePart
        -> InternalInfo
        -> H.RequestHeaders
        -> IO (H2.Response, H.Status, Bool)
    responseFile :: Status
    -> ResponseHeaders
    -> Method
    -> FilePath
    -> Maybe FilePart
    -> InternalInfo
    -> ResponseHeaders
    -> IO (Response, Status, Bool)
    responseFile Status
    st ResponseHeaders
    rsphdr Method
    _ FilePath
    _ Maybe FilePart
    _ InternalInfo
    _ ResponseHeaders
    _
        | Status -> Bool
    noBody Status
    st = (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Response, Status, Bool) -> IO (Response, Status, Bool))
    -> (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> (Response, Status, Bool)
    responseNoBody Status
    st ResponseHeaders
    rsphdr
    responseFile Status
    st ResponseHeaders
    rsphdr Method
    method FilePath
    path (Just FilePart
    fp) InternalInfo
    _ ResponseHeaders
    _ =
        (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Response, Status, Bool) -> IO (Response, Status, Bool))
    -> (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a b. (a -> b) -> a -> b
    $ Status
    -> ResponseHeaders
    -> Method
    -> FileSpec
    -> (Response, Status, Bool)
    responseFile2XX Status
    st ResponseHeaders
    rsphdr Method
    method FileSpec
    fileSpec
      where
        !off' :: FileOffset
    off' = Integer -> FileOffset
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> FileOffset) -> Integer -> FileOffset
    forall a b. (a -> b) -> a -> b
    $ FilePart -> Integer
    filePartOffset FilePart
    fp
        !bytes' :: FileOffset
    bytes' = Integer -> FileOffset
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral (Integer -> FileOffset) -> Integer -> FileOffset
    forall a b. (a -> b) -> a -> b
    $ FilePart -> Integer
    filePartByteCount FilePart
    fp
        !fileSpec :: FileSpec
    fileSpec = FilePath -> FileOffset -> FileOffset -> FileSpec
    H2.FileSpec FilePath
    path FileOffset
    off' FileOffset
    bytes'
    responseFile Status
    _ ResponseHeaders
    rsphdr Method
    method FilePath
    path Maybe FilePart
    Nothing InternalInfo
    ii ResponseHeaders
    reqhdr = do
        efinfo <- IO FileInfo -> IO (Either IOException FileInfo)
    forall e a. Exception e => IO a -> IO (Either e a)
    E.try (IO FileInfo -> IO (Either IOException FileInfo))
    -> IO FileInfo -> IO (Either IOException FileInfo)
    forall a b. (a -> b) -> a -> b
    $ InternalInfo -> FilePath -> IO FileInfo
    getFileInfo InternalInfo
    ii FilePath
    path
        case efinfo of
            Left (IOException
    _ex :: E.IOException) -> (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Response, Status, Bool) -> IO (Response, Status, Bool))
    -> (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a b. (a -> b) -> a -> b
    $ ResponseHeaders -> (Response, Status, Bool)
    response404 ResponseHeaders
    rsphdr
            Right FileInfo
    finfo -> do
                let reqidx :: IndexedHeader
    reqidx = ResponseHeaders -> IndexedHeader
    indexRequestHeader ResponseHeaders
    reqhdr
                    rspidx :: IndexedHeader
    rspidx = ResponseHeaders -> IndexedHeader
    indexResponseHeader ResponseHeaders
    rsphdr
                case FileInfo
    -> ResponseHeaders
    -> Method
    -> IndexedHeader
    -> IndexedHeader
    -> RspFileInfo
    conditionalRequest FileInfo
    finfo ResponseHeaders
    rsphdr Method
    method IndexedHeader
    rspidx IndexedHeader
    reqidx of
                    WithoutBody Status
    s -> (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Response, Status, Bool) -> IO (Response, Status, Bool))
    -> (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a b. (a -> b) -> a -> b
    $ Status -> ResponseHeaders -> (Response, Status, Bool)
    responseNoBody Status
    s ResponseHeaders
    rsphdr
                    WithBody Status
    s ResponseHeaders
    rsphdr' Integer
    off Integer
    bytes -> do
                        let !off' :: FileOffset
    off' = Integer -> FileOffset
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    off
                            !bytes' :: FileOffset
    bytes' = Integer -> FileOffset
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Integer
    bytes
                            !fileSpec :: FileSpec
    fileSpec = FilePath -> FileOffset -> FileOffset -> FileSpec
    H2.FileSpec FilePath
    path FileOffset
    off' FileOffset
    bytes'
                        (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a. a -> IO a
    forall (m :: * -> *) a. Monad m => a -> m a
    return ((Response, Status, Bool) -> IO (Response, Status, Bool))
    -> (Response, Status, Bool) -> IO (Response, Status, Bool)
    forall a b. (a -> b) -> a -> b
    $ Status
    -> ResponseHeaders
    -> Method
    -> FileSpec
    -> (Response, Status, Bool)
    responseFile2XX Status
    s ResponseHeaders
    rsphdr' Method
    method FileSpec
    fileSpec

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

    responseFile2XX
        :: H.Status
        -> H.ResponseHeaders
        -> H.Method
        -> H2.FileSpec
        -> (H2.Response, H.Status, Bool)
    responseFile2XX :: Status
    -> ResponseHeaders
    -> Method
    -> FileSpec
    -> (Response, Status, Bool)
    responseFile2XX Status
    st ResponseHeaders
    rsphdr Method
    method FileSpec
    fileSpec
        | Method
    method Method -> Method -> Bool
    forall a. Eq a => a -> a -> Bool
    == Method
    H.methodHead = Status -> ResponseHeaders -> (Response, Status, Bool)
    responseNoBody Status
    st ResponseHeaders
    rsphdr
        | Bool
    otherwise = (Status -> ResponseHeaders -> FileSpec -> Response
    H2.responseFile Status
    st ResponseHeaders
    rsphdr FileSpec
    fileSpec, Status
    st, Bool
    True)

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

    responseBuilder
        :: H.Status
        -> H.ResponseHeaders
        -> H.Method
        -> BB.Builder
        -> (H2.Response, H.Status, Bool)
    responseBuilder :: Status
    -> ResponseHeaders -> Method -> Builder -> (Response, Status, Bool)
    responseBuilder Status
    st ResponseHeaders
    rsphdr Method
    method Builder
    builder
        | Method
    method Method -> Method -> Bool
    forall a. Eq a => a -> a -> Bool
    == Method
    H.methodHead Bool -> Bool -> Bool
    || Status -> Bool
    noBody Status
    st = Status -> ResponseHeaders -> (Response, Status, Bool)
    responseNoBody Status
    st ResponseHeaders
    rsphdr
        | Bool
    otherwise = (Status -> ResponseHeaders -> Builder -> Response
    H2.responseBuilder Status
    st ResponseHeaders
    rsphdr Builder
    builder, Status
    st, Bool
    True)

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

    responseStream
        :: H.Status
        -> H.ResponseHeaders
        -> H.Method
        -> StreamingBody
        -> (H2.Response, H.Status, Bool)
    responseStream :: Status
    -> ResponseHeaders
    -> Method
    -> StreamingBody
    -> (Response, Status, Bool)
    responseStream Status
    st ResponseHeaders
    rsphdr Method
    method StreamingBody
    strmbdy
        | Method
    method Method -> Method -> Bool
    forall a. Eq a => a -> a -> Bool
    == Method
    H.methodHead Bool -> Bool -> Bool
    || Status -> Bool
    noBody Status
    st = Status -> ResponseHeaders -> (Response, Status, Bool)
    responseNoBody Status
    st ResponseHeaders
    rsphdr
        | Bool
    otherwise = (Status -> ResponseHeaders -> StreamingBody -> Response
    H2.responseStreaming Status
    st ResponseHeaders
    rsphdr StreamingBody
    strmbdy, Status
    st, Bool
    True)

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

    responseNoBody :: H.Status -> H.ResponseHeaders -> (H2.Response, H.Status, Bool)
    responseNoBody :: Status -> ResponseHeaders -> (Response, Status, Bool)
    responseNoBody Status
    st ResponseHeaders
    rsphdr = (Status -> ResponseHeaders -> Response
    H2.responseNoBody Status
    st ResponseHeaders
    rsphdr, Status
    st, Bool
    False)

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

    response404 :: H.ResponseHeaders -> (H2.Response, H.Status, Bool)
    response404 :: ResponseHeaders -> (Response, Status, Bool)
    response404 ResponseHeaders
    rsphdr = (Response
    h2rsp, Status
    st, Bool
    True)
      where
        h2rsp :: Response
    h2rsp = Status -> ResponseHeaders -> Builder -> Response
    H2.responseBuilder Status
    st ResponseHeaders
    rsphdr' Builder
    body
        st :: Status
    st = Status
    H.notFound404
        !rsphdr' :: ResponseHeaders
    rsphdr' = HeaderName -> Method -> ResponseHeaders -> ResponseHeaders
    R.replaceHeader HeaderName
    H.hContentType Method
    "text/plain; charset=utf-8" ResponseHeaders
    rsphdr
        !body :: Builder
    body = Method -> Builder
    BB.byteString Method
    "File not found"

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

    noBody :: H.Status -> Bool
    noBody :: Status -> Bool
    noBody = Bool -> Bool
    not (Bool -> Bool) -> (Status -> Bool) -> Status -> Bool
    forall b c a. (b -> c) -> (a -> b) -> a -> c
    . Status -> Bool
    R.hasBody