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

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

import qualified Control.Exception as E
import qualified Data.ByteString as BS
import Data.ByteString.Internal (create)
import qualified Data.ByteString.Lazy as BS.Lazy
import Foreign.Marshal.Alloc (free, mallocBytes)
import Foreign.Marshal.Utils (copyBytes)
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 (Maybe BufferSize)
TVar (Maybe SomeException)
TVar TxFlow
TVar EvenStreamTable
TVar OddStreamTable
IORef Bool
IORef BufferSize
IORef (Maybe HeaderContinuation)
IORef IntSet
IORef RxFlow
IORef Settings
STM Bool
SockAddr
Rate
TQueue Output
Manager
ThreadManager
DynamicTable
Settings
ControlQ
RoleInfo
Role
BufferSize -> TokenHeaderTable -> IO ()
role :: Role
roleInfo :: RoleInfo
mySettings :: Settings
myFirstSettings :: IORef Bool
peerSettings :: IORef Settings
oddStreamTable :: TVar OddStreamTable
evenStreamTable :: TVar EvenStreamTable
continued :: IORef (Maybe HeaderContinuation)
myStreamId :: TVar BufferSize
peerStreamId :: IORef BufferSize
peerLastStreamId :: IORef BufferSize
outputBufferLimit :: IORef BufferSize
outputQ :: TQueue Output
outputQStreamID :: TVar BufferSize
controlQ :: ControlQ
encodeDynamicTable :: DynamicTable
decodeDynamicTable :: DynamicTable
txFlow :: TVar TxFlow
rxFlow :: IORef RxFlow
pingRate :: Rate
settingsRate :: Rate
emptyFrameRate :: Rate
rstRate :: Rate
mySockAddr :: SockAddr
peerSockAddr :: SockAddr
threadManager :: ThreadManager
timeoutManager :: Manager
receiverDone :: TVar (Maybe SomeException)
appDone :: STM Bool
informationalCallback :: BufferSize -> TokenHeaderTable -> IO ()
peerGoAway :: TVar (Maybe BufferSize)
activeRequests :: TVar BufferSize
resetByMe :: IORef IntSet
resetByMe :: Context -> IORef IntSet
activeRequests :: Context -> TVar BufferSize
peerGoAway :: Context -> TVar (Maybe BufferSize)
informationalCallback :: Context -> BufferSize -> TokenHeaderTable -> IO ()
appDone :: Context -> STM Bool
receiverDone :: Context -> TVar (Maybe SomeException)
timeoutManager :: Context -> Manager
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 -> ControlQ
outputQStreamID :: Context -> TVar BufferSize
outputQ :: Context -> TQueue Output
outputBufferLimit :: Context -> IORef BufferSize
peerLastStreamId :: Context -> IORef BufferSize
peerStreamId :: Context -> IORef BufferSize
myStreamId :: Context -> TVar BufferSize
continued :: Context -> IORef (Maybe HeaderContinuation)
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 (Maybe BufferSize)
TVar (Maybe SomeException)
TVar TxFlow
TVar EvenStreamTable
TVar OddStreamTable
IORef Bool
IORef BufferSize
IORef (Maybe HeaderContinuation)
IORef IntSet
IORef RxFlow
IORef Settings
STM Bool
SockAddr
Rate
TQueue Output
Manager
ThreadManager
DynamicTable
Settings
ControlQ
RoleInfo
Role
BufferSize -> TokenHeaderTable -> IO ()
resetByMe :: Context -> IORef IntSet
activeRequests :: Context -> TVar BufferSize
peerGoAway :: Context -> TVar (Maybe BufferSize)
informationalCallback :: Context -> BufferSize -> TokenHeaderTable -> IO ()
appDone :: Context -> STM Bool
receiverDone :: Context -> TVar (Maybe SomeException)
timeoutManager :: Context -> Manager
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 -> ControlQ
outputQStreamID :: Context -> TVar BufferSize
outputQ :: Context -> TQueue Output
outputBufferLimit :: Context -> IORef BufferSize
peerLastStreamId :: Context -> IORef BufferSize
peerStreamId :: Context -> IORef BufferSize
myStreamId :: Context -> TVar BufferSize
continued :: Context -> IORef (Maybe HeaderContinuation)
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 HeaderContinuation)
myStreamId :: TVar BufferSize
peerStreamId :: IORef BufferSize
peerLastStreamId :: IORef BufferSize
outputBufferLimit :: IORef BufferSize
outputQ :: TQueue Output
outputQStreamID :: TVar BufferSize
controlQ :: ControlQ
encodeDynamicTable :: DynamicTable
decodeDynamicTable :: DynamicTable
txFlow :: TVar TxFlow
rxFlow :: IORef RxFlow
pingRate :: Rate
settingsRate :: Rate
emptyFrameRate :: Rate
rstRate :: Rate
mySockAddr :: SockAddr
peerSockAddr :: SockAddr
threadManager :: ThreadManager
timeoutManager :: Manager
receiverDone :: TVar (Maybe SomeException)
appDone :: STM Bool
informationalCallback :: BufferSize -> TokenHeaderTable -> IO ()
peerGoAway :: TVar (Maybe BufferSize)
activeRequests :: TVar BufferSize
resetByMe :: IORef IntSet
..} 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

-- | Encode the rest of a header block whose start 'hpackEncodeHeader' wrote
--
-- For a block that did not fit where it was being written.  Grows the buffer
-- as needed: a header that does not fit is retried with a larger buffer (the
-- encoder does not modify the dynamic table for a header it could not write).
hpackEncodeHeaderRest
    :: Context
    -> BufferSize
    -- ^ Initial buffer size
    -> TokenHeaderList
    -> IO BS.Lazy.ByteString
hpackEncodeHeaderRest :: Context -> BufferSize -> TokenHeaderList -> IO ByteString
hpackEncodeHeaderRest Context
ctx = [ByteString] -> BufferSize -> TokenHeaderList -> IO ByteString
go []
  where
    go :: [ByteString] -> BufferSize -> TokenHeaderList -> IO ByteString
go [ByteString]
acc BufferSize
_ [] = ByteString -> IO ByteString
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> IO ByteString) -> ByteString -> IO ByteString
forall a b. (a -> b) -> a -> b
$ [ByteString] -> ByteString
BS.Lazy.fromChunks ([ByteString] -> [ByteString]
forall a. [a] -> [a]
reverse [ByteString]
acc)
    go [ByteString]
acc BufferSize
siz TokenHeaderList
ths = do
        (ByteString
chunk, TokenHeaderList
ths') <- IO Buffer
-> (Buffer -> IO ())
-> (Buffer -> IO (ByteString, TokenHeaderList))
-> IO (ByteString, TokenHeaderList)
forall a b c. IO a -> (a -> IO b) -> (a -> IO c) -> IO c
E.bracket (BufferSize -> IO Buffer
forall a. BufferSize -> IO (Ptr a)
mallocBytes BufferSize
siz) Buffer -> IO ()
forall a. Ptr a -> IO ()
free ((Buffer -> IO (ByteString, TokenHeaderList))
 -> IO (ByteString, TokenHeaderList))
-> (Buffer -> IO (ByteString, TokenHeaderList))
-> IO (ByteString, TokenHeaderList)
forall a b. (a -> b) -> a -> b
$ \Buffer
buf -> do
            (TokenHeaderList
ths', BufferSize
len) <- Context
-> Buffer
-> BufferSize
-> TokenHeaderList
-> IO (TokenHeaderList, BufferSize)
hpackEncodeHeaderLoop Context
ctx Buffer
buf BufferSize
siz TokenHeaderList
ths
            ByteString
chunk <- BufferSize -> (Buffer -> IO ()) -> IO ByteString
create BufferSize
len ((Buffer -> IO ()) -> IO ByteString)
-> (Buffer -> IO ()) -> IO ByteString
forall a b. (a -> b) -> a -> b
$ \Buffer
p -> Buffer -> Buffer -> BufferSize -> IO ()
forall a. Ptr a -> Ptr a -> BufferSize -> IO ()
copyBytes Buffer
p Buffer
buf BufferSize
len
            (ByteString, TokenHeaderList) -> IO (ByteString, TokenHeaderList)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString
chunk, TokenHeaderList
ths')
        if ByteString -> Bool
BS.null ByteString
chunk
            then [ByteString] -> BufferSize -> TokenHeaderList -> IO ByteString
go [ByteString]
acc (BufferSize
siz BufferSize -> BufferSize -> BufferSize
forall a. Num a => a -> a -> a
* BufferSize
2) TokenHeaderList
ths -- no progress: grow
            else [ByteString] -> BufferSize -> TokenHeaderList -> IO ByteString
go (ByteString
chunk ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
acc) BufferSize
siz TokenHeaderList
ths'

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

hpackDecodeHeader
    :: HeaderBlockFragment -> StreamId -> Context -> IO TokenHeaderTable
hpackDecodeHeader :: ByteString -> BufferSize -> Context -> IO TokenHeaderTable
hpackDecodeHeader ByteString
hdrblk BufferSize
sid Context
ctx = do
    tbl :: TokenHeaderTable
tbl@(TokenHeaderList
_, ValueTable
vt) <- ReasonPhrase
-> ByteString -> BufferSize -> Context -> IO TokenHeaderTable
hpackDecode ReasonPhrase
"illegal header" ByteString
hdrblk BufferSize
sid Context
ctx
    if Context -> Bool
isClient Context
ctx Bool -> Bool -> Bool
|| ValueTable -> Bool
checkRequestHeader ValueTable
vt
        then TokenHeaderTable -> IO TokenHeaderTable
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return TokenHeaderTable
tbl
        else HTTP2Error -> IO TokenHeaderTable
forall e a. Exception e => e -> IO a
E.throwIO (HTTP2Error -> IO TokenHeaderTable)
-> HTTP2Error -> IO TokenHeaderTable
forall a b. (a -> b) -> a -> b
$ ErrorCode -> BufferSize -> ReasonPhrase -> HTTP2Error
StreamErrorIsSent ErrorCode
ProtocolError BufferSize
sid ReasonPhrase
"illegal header"

hpackDecodeTrailer
    :: HeaderBlockFragment -> StreamId -> Context -> IO TokenHeaderTable
hpackDecodeTrailer :: ByteString -> BufferSize -> Context -> IO TokenHeaderTable
hpackDecodeTrailer = ReasonPhrase
-> ByteString -> BufferSize -> Context -> IO TokenHeaderTable
hpackDecode ReasonPhrase
"illegal trailer"

-- | Decode a field block for a stream we no longer have, and discard the result
--
-- The block must still be decoded: it may modify the dynamic table.
hpackDiscardHeader :: HeaderBlockFragment -> StreamId -> Context -> IO ()
hpackDiscardHeader :: ByteString -> BufferSize -> Context -> IO ()
hpackDiscardHeader ByteString
hdrblk BufferSize
sid Context
ctx =
    IO TokenHeaderTable -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (ReasonPhrase
-> ByteString -> BufferSize -> Context -> IO TokenHeaderTable
hpackDecode ReasonPhrase
"illegal header" ByteString
hdrblk BufferSize
sid Context
ctx) IO () -> (HTTP2Error -> IO ()) -> IO ()
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` HTTP2Error -> IO ()
ignore
  where
    -- Decoded to the end, so there is nothing to refuse: the message goes
    -- nowhere anyway.
    ignore :: HTTP2Error -> IO ()
ignore StreamErrorIsSent{} = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    ignore HTTP2Error
e = HTTP2Error -> IO ()
forall e a. Exception e => e -> IO a
E.throwIO HTTP2Error
e

-- | Decode a field block, reporting a block we could not get through as a
-- connection error, and a malformed message in a block decoded to the end
-- as a stream error.
--
-- The first argument says which kind of block it was, since the peer reads
-- this in the GOAWAY and "illegal trailer" about a request's headers is a
-- confusing thing to be told.
hpackDecode
    :: ReasonPhrase
    -> HeaderBlockFragment
    -> StreamId
    -> Context
    -> IO TokenHeaderTable
hpackDecode :: ReasonPhrase
-> ByteString -> BufferSize -> Context -> IO TokenHeaderTable
hpackDecode ReasonPhrase
illegal ByteString
hdrblk BufferSize
sid Context{TVar BufferSize
TVar (Maybe BufferSize)
TVar (Maybe SomeException)
TVar TxFlow
TVar EvenStreamTable
TVar OddStreamTable
IORef Bool
IORef BufferSize
IORef (Maybe HeaderContinuation)
IORef IntSet
IORef RxFlow
IORef Settings
STM Bool
SockAddr
Rate
TQueue Output
Manager
ThreadManager
DynamicTable
Settings
ControlQ
RoleInfo
Role
BufferSize -> TokenHeaderTable -> IO ()
resetByMe :: Context -> IORef IntSet
activeRequests :: Context -> TVar BufferSize
peerGoAway :: Context -> TVar (Maybe BufferSize)
informationalCallback :: Context -> BufferSize -> TokenHeaderTable -> IO ()
appDone :: Context -> STM Bool
receiverDone :: Context -> TVar (Maybe SomeException)
timeoutManager :: Context -> Manager
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 -> ControlQ
outputQStreamID :: Context -> TVar BufferSize
outputQ :: Context -> TQueue Output
outputBufferLimit :: Context -> IORef BufferSize
peerLastStreamId :: Context -> IORef BufferSize
peerStreamId :: Context -> IORef BufferSize
myStreamId :: Context -> TVar BufferSize
continued :: Context -> IORef (Maybe HeaderContinuation)
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 HeaderContinuation)
myStreamId :: TVar BufferSize
peerStreamId :: IORef BufferSize
peerLastStreamId :: IORef BufferSize
outputBufferLimit :: IORef BufferSize
outputQ :: TQueue Output
outputQStreamID :: TVar BufferSize
controlQ :: ControlQ
encodeDynamicTable :: DynamicTable
decodeDynamicTable :: DynamicTable
txFlow :: TVar TxFlow
rxFlow :: IORef RxFlow
pingRate :: Rate
settingsRate :: Rate
emptyFrameRate :: Rate
rstRate :: Rate
mySockAddr :: SockAddr
peerSockAddr :: SockAddr
threadManager :: ThreadManager
timeoutManager :: Manager
receiverDone :: TVar (Maybe SomeException)
appDone :: STM Bool
informationalCallback :: BufferSize -> TokenHeaderTable -> IO ()
peerGoAway :: TVar (Maybe BufferSize)
activeRequests :: TVar BufferSize
resetByMe :: IORef IntSet
..} =
    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
    -- A malformed message: 'decodeTokenHeader' says so only once it has
    -- decoded the whole block, so the dynamic table is up to date and the
    -- connection can go on.  A stream error, as RFC 9113 section 8.1.1 has
    -- it.  This used to be a connection error, as the block was abandoned
    -- at the malformed field; one request with an upper-case field name
    -- closed the connection, every other stream on it with it.
    handl :: DecodeError -> IO a
handl DecodeError
IllegalHeaderName =
        HTTP2Error -> IO a
forall e a. 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
    -- Too many fields, or too large a decoded size (RFC 9113 section
    -- 6.5.2): either way, the header list is too large.
    handl DecodeError
TooLargeHeader =
        HTTP2Error -> IO a
forall e a. 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
"header list too large"
    -- A block we could not get through: our dynamic table now holds the
    -- entries decoded before the throw and nothing after them -- no longer
    -- what the peer's encoder believes we have.  Section 10.5.1: "The field
    -- block MUST be processed to ensure a consistent connection state,
    -- unless the connection is closed."  We did not, so it must be.
    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. Exception e => e -> IO a
E.throwIO (HTTP2Error -> IO a) -> HTTP2Error -> IO a
forall a b. (a -> b) -> a -> b
$ ErrorCode -> BufferSize -> ReasonPhrase -> HTTP2Error
ConnectionErrorIsSent 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