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

    module Network.HTTP2.H2.HPACK (
        hpackEncodeHeader,
        hpackEncodeHeaderLoop,
        hpackDecodeHeader,
        hpackDecodeTrailer,
        just,
        fixHeaders,
    ) where

    import qualified Control.Exception as E
    import Network.ByteOrder
    import Network.HTTP.Semantics
    import Network.HTTP.Types

    import Imports
    import Network.HPACK
    import Network.HTTP2.Frame
    import Network.HTTP2.H2.Context
    import Network.HTTP2.H2.Types

    -- $setup
    -- >>> :set -XOverloadedStrings

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

    fixHeaders :: ResponseHeaders -> ResponseHeaders
    fixHeaders :: ResponseHeaders -> ResponseHeaders
    fixHeaders ResponseHeaders
    hdr = ResponseHeaders -> ResponseHeaders
    deleteUnnecessaryHeaders ResponseHeaders
    hdr

    deleteUnnecessaryHeaders :: ResponseHeaders -> ResponseHeaders
    deleteUnnecessaryHeaders :: ResponseHeaders -> ResponseHeaders
    deleteUnnecessaryHeaders ResponseHeaders
    hdr = (Header -> Bool) -> ResponseHeaders -> ResponseHeaders
    forall a. (a -> Bool) -> [a] -> [a]
    filter Header -> Bool
    forall {b}. (HeaderName, b) -> Bool
    del ResponseHeaders
    hdr
      where
        del :: (HeaderName, b) -> Bool
    del (HeaderName
    k, b
    _) = HeaderName
    k HeaderName -> [HeaderName] -> Bool
    forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
    `notElem` [HeaderName]
    headersToBeRemoved

    headersToBeRemoved :: [HeaderName]
    headersToBeRemoved :: [HeaderName]
    headersToBeRemoved =
        [ HeaderName
    hConnection
        , HeaderName
    "Transfer-Encoding"
        -- Keep-Alive
        -- Proxy-Connection
        -- Upgrade
        ]

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

    strategy :: EncodeStrategy
    strategy :: EncodeStrategy
    strategy = EncodeStrategy{compressionAlgo :: CompressionAlgo
    compressionAlgo = CompressionAlgo
    Linear, useHuffman :: Bool
    useHuffman = Bool
    False}

    -- Set-Cookie: contains only one cookie value.
    -- So, we don't need to split it.
    hpackEncodeHeader
        :: Context
        -> Buffer
        -> BufferSize
        -> TokenHeaderList
        -> IO (TokenHeaderList, Int)
    hpackEncodeHeader :: Context
    -> Buffer
    -> BufferSize
    -> TokenHeaderList
    -> IO (TokenHeaderList, BufferSize)
    hpackEncodeHeader Context{TVar BufferSize
    TVar TxFlow
    TVar EvenStreamTable
    TVar OddStreamTable
    IORef Bool
    IORef BufferSize
    IORef (Maybe BufferSize)
    IORef RxFlow
    IORef Settings
    SockAddr
    Rate
    TQueue Control
    TQueue Output
    ThreadManager
    DynamicTable
    Settings
    RoleInfo
    Role
    role :: Role
    roleInfo :: RoleInfo
    mySettings :: Settings
    myFirstSettings :: IORef Bool
    peerSettings :: IORef Settings
    oddStreamTable :: TVar OddStreamTable
    evenStreamTable :: TVar EvenStreamTable
    continued :: IORef (Maybe BufferSize)
    myStreamId :: TVar BufferSize
    peerStreamId :: IORef BufferSize
    outputBufferLimit :: IORef BufferSize
    outputQ :: TQueue Output
    outputQStreamID :: TVar BufferSize
    controlQ :: TQueue Control
    encodeDynamicTable :: DynamicTable
    decodeDynamicTable :: DynamicTable
    txFlow :: TVar TxFlow
    rxFlow :: IORef RxFlow
    pingRate :: Rate
    settingsRate :: Rate
    emptyFrameRate :: Rate
    rstRate :: Rate
    mySockAddr :: SockAddr
    peerSockAddr :: SockAddr
    threadManager :: ThreadManager
    threadManager :: Context -> ThreadManager
    peerSockAddr :: Context -> SockAddr
    mySockAddr :: Context -> SockAddr
    rstRate :: Context -> Rate
    emptyFrameRate :: Context -> Rate
    settingsRate :: Context -> Rate
    pingRate :: Context -> Rate
    rxFlow :: Context -> IORef RxFlow
    txFlow :: Context -> TVar TxFlow
    decodeDynamicTable :: Context -> DynamicTable
    encodeDynamicTable :: Context -> DynamicTable
    controlQ :: Context -> TQueue Control
    outputQStreamID :: Context -> TVar BufferSize
    outputQ :: Context -> TQueue Output
    outputBufferLimit :: Context -> IORef BufferSize
    peerStreamId :: Context -> IORef BufferSize
    myStreamId :: Context -> TVar BufferSize
    continued :: Context -> IORef (Maybe BufferSize)
    evenStreamTable :: Context -> TVar EvenStreamTable
    oddStreamTable :: Context -> TVar OddStreamTable
    peerSettings :: Context -> IORef Settings
    myFirstSettings :: Context -> IORef Bool
    mySettings :: Context -> Settings
    roleInfo :: Context -> RoleInfo
    role :: Context -> Role
    ..} Buffer
    buf BufferSize
    siz TokenHeaderList
    ths =
        Buffer
    -> BufferSize
    -> EncodeStrategy
    -> Bool
    -> DynamicTable
    -> TokenHeaderList
    -> IO (TokenHeaderList, BufferSize)
    encodeTokenHeader Buffer
    buf BufferSize
    siz EncodeStrategy
    strategy Bool
    True DynamicTable
    encodeDynamicTable TokenHeaderList
    ths

    hpackEncodeHeaderLoop
        :: Context
        -> Buffer
        -> BufferSize
        -> TokenHeaderList
        -> IO (TokenHeaderList, Int)
    hpackEncodeHeaderLoop :: Context
    -> Buffer
    -> BufferSize
    -> TokenHeaderList
    -> IO (TokenHeaderList, BufferSize)
    hpackEncodeHeaderLoop Context{TVar BufferSize
    TVar TxFlow
    TVar EvenStreamTable
    TVar OddStreamTable
    IORef Bool
    IORef BufferSize
    IORef (Maybe BufferSize)
    IORef RxFlow
    IORef Settings
    SockAddr
    Rate
    TQueue Control
    TQueue Output
    ThreadManager
    DynamicTable
    Settings
    RoleInfo
    Role
    threadManager :: Context -> ThreadManager
    peerSockAddr :: Context -> SockAddr
    mySockAddr :: Context -> SockAddr
    rstRate :: Context -> Rate
    emptyFrameRate :: Context -> Rate
    settingsRate :: Context -> Rate
    pingRate :: Context -> Rate
    rxFlow :: Context -> IORef RxFlow
    txFlow :: Context -> TVar TxFlow
    decodeDynamicTable :: Context -> DynamicTable
    encodeDynamicTable :: Context -> DynamicTable
    controlQ :: Context -> TQueue Control
    outputQStreamID :: Context -> TVar BufferSize
    outputQ :: Context -> TQueue Output
    outputBufferLimit :: Context -> IORef BufferSize
    peerStreamId :: Context -> IORef BufferSize
    myStreamId :: Context -> TVar BufferSize
    continued :: Context -> IORef (Maybe BufferSize)
    evenStreamTable :: Context -> TVar EvenStreamTable
    oddStreamTable :: Context -> TVar OddStreamTable
    peerSettings :: Context -> IORef Settings
    myFirstSettings :: Context -> IORef Bool
    mySettings :: Context -> Settings
    roleInfo :: Context -> RoleInfo
    role :: Context -> Role
    role :: Role
    roleInfo :: RoleInfo
    mySettings :: Settings
    myFirstSettings :: IORef Bool
    peerSettings :: IORef Settings
    oddStreamTable :: TVar OddStreamTable
    evenStreamTable :: TVar EvenStreamTable
    continued :: IORef (Maybe BufferSize)
    myStreamId :: TVar BufferSize
    peerStreamId :: IORef BufferSize
    outputBufferLimit :: IORef BufferSize
    outputQ :: TQueue Output
    outputQStreamID :: TVar BufferSize
    controlQ :: TQueue Control
    encodeDynamicTable :: DynamicTable
    decodeDynamicTable :: DynamicTable
    txFlow :: TVar TxFlow
    rxFlow :: IORef RxFlow
    pingRate :: Rate
    settingsRate :: Rate
    emptyFrameRate :: Rate
    rstRate :: Rate
    mySockAddr :: SockAddr
    peerSockAddr :: SockAddr
    threadManager :: ThreadManager
    ..} Buffer
    buf BufferSize
    siz TokenHeaderList
    hs =
        Buffer
    -> BufferSize
    -> EncodeStrategy
    -> Bool
    -> DynamicTable
    -> TokenHeaderList
    -> IO (TokenHeaderList, BufferSize)
    encodeTokenHeader Buffer
    buf BufferSize
    siz EncodeStrategy
    strategy Bool
    False DynamicTable
    encodeDynamicTable TokenHeaderList
    hs

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

    hpackDecodeHeader
        :: HeaderBlockFragment -> StreamId -> Context -> IO TokenHeaderTable
    hpackDecodeHeader :: ByteString -> BufferSize -> Context -> IO TokenHeaderTable
    hpackDecodeHeader ByteString
    hdrblk BufferSize
    sid Context
    ctx = do
        tbl@(_, vt) <- ByteString -> BufferSize -> Context -> IO TokenHeaderTable
    hpackDecodeTrailer ByteString
    hdrblk BufferSize
    sid Context
    ctx
        if isClient ctx || checkRequestHeader vt
            then return tbl
            else E.throwIO $ StreamErrorIsSent ProtocolError sid "illegal header"

    hpackDecodeTrailer
        :: HeaderBlockFragment -> StreamId -> Context -> IO TokenHeaderTable
    hpackDecodeTrailer :: ByteString -> BufferSize -> Context -> IO TokenHeaderTable
    hpackDecodeTrailer ByteString
    hdrblk BufferSize
    sid Context{TVar BufferSize
    TVar TxFlow
    TVar EvenStreamTable
    TVar OddStreamTable
    IORef Bool
    IORef BufferSize
    IORef (Maybe BufferSize)
    IORef RxFlow
    IORef Settings
    SockAddr
    Rate
    TQueue Control
    TQueue Output
    ThreadManager
    DynamicTable
    Settings
    RoleInfo
    Role
    threadManager :: Context -> ThreadManager
    peerSockAddr :: Context -> SockAddr
    mySockAddr :: Context -> SockAddr
    rstRate :: Context -> Rate
    emptyFrameRate :: Context -> Rate
    settingsRate :: Context -> Rate
    pingRate :: Context -> Rate
    rxFlow :: Context -> IORef RxFlow
    txFlow :: Context -> TVar TxFlow
    decodeDynamicTable :: Context -> DynamicTable
    encodeDynamicTable :: Context -> DynamicTable
    controlQ :: Context -> TQueue Control
    outputQStreamID :: Context -> TVar BufferSize
    outputQ :: Context -> TQueue Output
    outputBufferLimit :: Context -> IORef BufferSize
    peerStreamId :: Context -> IORef BufferSize
    myStreamId :: Context -> TVar BufferSize
    continued :: Context -> IORef (Maybe BufferSize)
    evenStreamTable :: Context -> TVar EvenStreamTable
    oddStreamTable :: Context -> TVar OddStreamTable
    peerSettings :: Context -> IORef Settings
    myFirstSettings :: Context -> IORef Bool
    mySettings :: Context -> Settings
    roleInfo :: Context -> RoleInfo
    role :: Context -> Role
    role :: Role
    roleInfo :: RoleInfo
    mySettings :: Settings
    myFirstSettings :: IORef Bool
    peerSettings :: IORef Settings
    oddStreamTable :: TVar OddStreamTable
    evenStreamTable :: TVar EvenStreamTable
    continued :: IORef (Maybe BufferSize)
    myStreamId :: TVar BufferSize
    peerStreamId :: IORef BufferSize
    outputBufferLimit :: IORef BufferSize
    outputQ :: TQueue Output
    outputQStreamID :: TVar BufferSize
    controlQ :: TQueue Control
    encodeDynamicTable :: DynamicTable
    decodeDynamicTable :: DynamicTable
    txFlow :: TVar TxFlow
    rxFlow :: IORef RxFlow
    pingRate :: Rate
    settingsRate :: Rate
    emptyFrameRate :: Rate
    rstRate :: Rate
    mySockAddr :: SockAddr
    peerSockAddr :: SockAddr
    threadManager :: ThreadManager
    ..} = DynamicTable -> ByteString -> IO TokenHeaderTable
    decodeTokenHeader DynamicTable
    decodeDynamicTable ByteString
    hdrblk IO TokenHeaderTable
    -> (DecodeError -> IO TokenHeaderTable) -> IO TokenHeaderTable
    forall e a. Exception e => IO a -> (e -> IO a) -> IO a
    `E.catch` DecodeError -> IO TokenHeaderTable
    forall {a}. DecodeError -> IO a
    handl
      where
        handl :: DecodeError -> IO a
    handl DecodeError
    IllegalHeaderName =
            HTTP2Error -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO (HTTP2Error -> IO a) -> HTTP2Error -> IO a
    forall a b. (a -> b) -> a -> b
    $ ErrorCode -> BufferSize -> ReasonPhrase -> HTTP2Error
    StreamErrorIsSent ErrorCode
    ProtocolError BufferSize
    sid ReasonPhrase
    "illegal trailer"
        handl DecodeError
    e = do
            let msg :: ReasonPhrase
    msg = String -> ReasonPhrase
    forall a. IsString a => String -> a
    fromString (String -> ReasonPhrase) -> String -> ReasonPhrase
    forall a b. (a -> b) -> a -> b
    $ DecodeError -> String
    forall a. Show a => a -> String
    show DecodeError
    e
            HTTP2Error -> IO a
    forall e a. (HasCallStack, Exception e) => e -> IO a
    E.throwIO (HTTP2Error -> IO a) -> HTTP2Error -> IO a
    forall a b. (a -> b) -> a -> b
    $ ErrorCode -> BufferSize -> ReasonPhrase -> HTTP2Error
    StreamErrorIsSent ErrorCode
    CompressionError BufferSize
    sid ReasonPhrase
    msg

    {-# INLINE checkRequestHeader #-}
    checkRequestHeader :: ValueTable -> Bool
    checkRequestHeader :: ValueTable -> Bool
    checkRequestHeader ValueTable
    reqvt
        | Maybe ByteString -> (ByteString -> Bool) -> Bool
    forall a. Maybe a -> (a -> Bool) -> Bool
    just Maybe ByteString
    mMethod (ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString
    "CONNECT") = Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe ByteString
    mPath Bool -> Bool -> Bool
    && Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe ByteString
    mScheme
        | Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe ByteString
    mStatus = Bool
    False
        | Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe ByteString
    mMethod = Bool
    False
        | Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe ByteString
    mScheme = Bool
    False
        | Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isNothing Maybe ByteString
    mPath = Bool
    False
        | Maybe ByteString
    mPath Maybe ByteString -> Maybe ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    == ByteString -> Maybe ByteString
    forall a. a -> Maybe a
    Just ByteString
    "" = Bool
    False
        | Maybe ByteString -> Bool
    forall a. Maybe a -> Bool
    isJust Maybe ByteString
    mConnection = Bool
    False
        | Maybe ByteString -> (ByteString -> Bool) -> Bool
    forall a. Maybe a -> (a -> Bool) -> Bool
    just Maybe ByteString
    mTE (ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString
    "trailers") = Bool
    False
        | Bool
    otherwise = Maybe ByteString -> Maybe ByteString -> Bool
    checkAuth Maybe ByteString
    mAuthority Maybe ByteString
    mHost
      where
        mStatus :: Maybe ByteString
    mStatus = Token -> ValueTable -> Maybe ByteString
    getFieldValue Token
    tokenStatus ValueTable
    reqvt
        mScheme :: Maybe ByteString
    mScheme = Token -> ValueTable -> Maybe ByteString
    getFieldValue Token
    tokenScheme ValueTable
    reqvt
        mPath :: Maybe ByteString
    mPath = Token -> ValueTable -> Maybe ByteString
    getFieldValue Token
    tokenPath ValueTable
    reqvt
        mMethod :: Maybe ByteString
    mMethod = Token -> ValueTable -> Maybe ByteString
    getFieldValue Token
    tokenMethod ValueTable
    reqvt
        mConnection :: Maybe ByteString
    mConnection = Token -> ValueTable -> Maybe ByteString
    getFieldValue Token
    tokenConnection ValueTable
    reqvt
        mTE :: Maybe ByteString
    mTE = Token -> ValueTable -> Maybe ByteString
    getFieldValue Token
    tokenTE ValueTable
    reqvt
        mAuthority :: Maybe ByteString
    mAuthority = Token -> ValueTable -> Maybe ByteString
    getFieldValue Token
    tokenAuthority ValueTable
    reqvt
        mHost :: Maybe ByteString
    mHost = Token -> ValueTable -> Maybe ByteString
    getFieldValue Token
    tokenHost ValueTable
    reqvt

    checkAuth :: Maybe ByteString -> Maybe ByteString -> Bool
    checkAuth :: Maybe ByteString -> Maybe ByteString -> Bool
    checkAuth Maybe ByteString
    Nothing Maybe ByteString
    Nothing = Bool
    False
    checkAuth (Just ByteString
    a) (Just ByteString
    h) | ByteString
    a ByteString -> ByteString -> Bool
    forall a. Eq a => a -> a -> Bool
    /= ByteString
    h = Bool
    False
    checkAuth Maybe ByteString
    _ Maybe ByteString
    _ = Bool
    True

    {-# INLINE just #-}
    just :: Maybe a -> (a -> Bool) -> Bool
    just :: forall a. Maybe a -> (a -> Bool) -> Bool
    just Maybe a
    Nothing a -> Bool
    _ = Bool
    False
    just (Just a
    x) a -> Bool
    p
        | a -> Bool
    p a
    x = Bool
    True
        | Bool
    otherwise = Bool
    False