{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
module Network.HTTP2.Arch.HPACK (
hpackEncodeHeader
, hpackEncodeHeaderLoop
, hpackDecodeHeader
, hpackDecodeTrailer
, just
, fixHeaders
) where
import qualified Control.Exception as E
import Network.ByteOrder
import qualified Network.HTTP.Types as H
import Imports
import Network.HPACK
import Network.HPACK.Token
import Network.HTTP2.Arch.Context
import Network.HTTP2.Arch.Types
import Network.HTTP2.Frame
fixHeaders :: H.ResponseHeaders -> H.ResponseHeaders
ResponseHeaders
hdr = ResponseHeaders -> ResponseHeaders
deleteUnnecessaryHeaders ResponseHeaders
hdr
deleteUnnecessaryHeaders :: H.ResponseHeaders -> H.ResponseHeaders
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 :: [H.HeaderName]
= [ HeaderName
H.hConnection
, HeaderName
"Transfer-Encoding"
]
strategy :: EncodeStrategy
strategy :: EncodeStrategy
strategy = EncodeStrategy { compressionAlgo :: CompressionAlgo
compressionAlgo = CompressionAlgo
Linear, useHuffman :: Bool
useHuffman = Bool
False }
hpackEncodeHeader :: Context -> Buffer -> BufferSize
-> TokenHeaderList
-> IO (TokenHeaderList, Int)
Context{IORef Bool
IORef BufferSize
IORef (Maybe BufferSize)
IORef (Maybe SettingsList)
IORef Settings
DynamicTable
TVar BufferSize
TQueue Control
TQueue (Output Stream)
Rate
StreamTable
RoleInfo
Role
role :: Role
roleInfo :: RoleInfo
myFirstSettings :: IORef Bool
myPendingAlist :: IORef (Maybe SettingsList)
mySettings :: IORef Settings
peerSettings :: IORef Settings
streamTable :: StreamTable
concurrency :: IORef BufferSize
continued :: IORef (Maybe BufferSize)
myStreamId :: IORef BufferSize
peerStreamId :: IORef BufferSize
outputBufferLimit :: IORef BufferSize
outputQ :: TQueue (Output Stream)
outputQStreamID :: TVar BufferSize
controlQ :: TQueue Control
encodeDynamicTable :: DynamicTable
decodeDynamicTable :: DynamicTable
txConnectionWindow :: TVar BufferSize
rxConnectionInc :: IORef BufferSize
pingRate :: Rate
settingsRate :: Rate
emptyFrameRate :: Rate
role :: Context -> Role
roleInfo :: Context -> RoleInfo
myFirstSettings :: Context -> IORef Bool
myPendingAlist :: Context -> IORef (Maybe SettingsList)
mySettings :: Context -> IORef Settings
peerSettings :: Context -> IORef Settings
streamTable :: Context -> StreamTable
concurrency :: Context -> IORef BufferSize
continued :: Context -> IORef (Maybe BufferSize)
myStreamId :: Context -> IORef BufferSize
peerStreamId :: Context -> IORef BufferSize
outputBufferLimit :: Context -> IORef BufferSize
outputQ :: Context -> TQueue (Output Stream)
outputQStreamID :: Context -> TVar BufferSize
controlQ :: Context -> TQueue Control
encodeDynamicTable :: Context -> DynamicTable
decodeDynamicTable :: Context -> DynamicTable
txConnectionWindow :: Context -> TVar BufferSize
rxConnectionInc :: Context -> IORef BufferSize
pingRate :: Context -> Rate
settingsRate :: Context -> Rate
emptyFrameRate :: Context -> Rate
..} 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)
Context{IORef Bool
IORef BufferSize
IORef (Maybe BufferSize)
IORef (Maybe SettingsList)
IORef Settings
DynamicTable
TVar BufferSize
TQueue Control
TQueue (Output Stream)
Rate
StreamTable
RoleInfo
Role
role :: Context -> Role
roleInfo :: Context -> RoleInfo
myFirstSettings :: Context -> IORef Bool
myPendingAlist :: Context -> IORef (Maybe SettingsList)
mySettings :: Context -> IORef Settings
peerSettings :: Context -> IORef Settings
streamTable :: Context -> StreamTable
concurrency :: Context -> IORef BufferSize
continued :: Context -> IORef (Maybe BufferSize)
myStreamId :: Context -> IORef BufferSize
peerStreamId :: Context -> IORef BufferSize
outputBufferLimit :: Context -> IORef BufferSize
outputQ :: Context -> TQueue (Output Stream)
outputQStreamID :: Context -> TVar BufferSize
controlQ :: Context -> TQueue Control
encodeDynamicTable :: Context -> DynamicTable
decodeDynamicTable :: Context -> DynamicTable
txConnectionWindow :: Context -> TVar BufferSize
rxConnectionInc :: Context -> IORef BufferSize
pingRate :: Context -> Rate
settingsRate :: Context -> Rate
emptyFrameRate :: Context -> Rate
role :: Role
roleInfo :: RoleInfo
myFirstSettings :: IORef Bool
myPendingAlist :: IORef (Maybe SettingsList)
mySettings :: IORef Settings
peerSettings :: IORef Settings
streamTable :: StreamTable
concurrency :: IORef BufferSize
continued :: IORef (Maybe BufferSize)
myStreamId :: IORef BufferSize
peerStreamId :: IORef BufferSize
outputBufferLimit :: IORef BufferSize
outputQ :: TQueue (Output Stream)
outputQStreamID :: TVar BufferSize
controlQ :: TQueue Control
encodeDynamicTable :: DynamicTable
decodeDynamicTable :: DynamicTable
txConnectionWindow :: TVar BufferSize
rxConnectionInc :: IORef BufferSize
pingRate :: Rate
settingsRate :: Rate
emptyFrameRate :: Rate
..} 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 HeaderTable
ByteString
hdrblk BufferSize
sid Context
ctx = do
tbl :: HeaderTable
tbl@(TokenHeaderList
_,ValueTable
vt) <- ByteString -> BufferSize -> Context -> IO HeaderTable
hpackDecodeTrailer ByteString
hdrblk BufferSize
sid Context
ctx
if Context -> Bool
isClient Context
ctx Bool -> Bool -> Bool
|| ValueTable -> Bool
checkRequestHeader ValueTable
vt then
HeaderTable -> IO HeaderTable
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return HeaderTable
tbl
else
HTTP2Error -> IO HeaderTable
forall e a. Exception e => e -> IO a
E.throwIO (HTTP2Error -> IO HeaderTable) -> HTTP2Error -> IO HeaderTable
forall a b. (a -> b) -> a -> b
$ ErrorCode -> BufferSize -> ReasonPhrase -> HTTP2Error
StreamErrorIsSent ErrorCode
ProtocolError BufferSize
sid ReasonPhrase
"illegal header"
hpackDecodeTrailer :: HeaderBlockFragment -> StreamId -> Context -> IO HeaderTable
hpackDecodeTrailer :: ByteString -> BufferSize -> Context -> IO HeaderTable
hpackDecodeTrailer ByteString
hdrblk BufferSize
sid Context{IORef Bool
IORef BufferSize
IORef (Maybe BufferSize)
IORef (Maybe SettingsList)
IORef Settings
DynamicTable
TVar BufferSize
TQueue Control
TQueue (Output Stream)
Rate
StreamTable
RoleInfo
Role
role :: Context -> Role
roleInfo :: Context -> RoleInfo
myFirstSettings :: Context -> IORef Bool
myPendingAlist :: Context -> IORef (Maybe SettingsList)
mySettings :: Context -> IORef Settings
peerSettings :: Context -> IORef Settings
streamTable :: Context -> StreamTable
concurrency :: Context -> IORef BufferSize
continued :: Context -> IORef (Maybe BufferSize)
myStreamId :: Context -> IORef BufferSize
peerStreamId :: Context -> IORef BufferSize
outputBufferLimit :: Context -> IORef BufferSize
outputQ :: Context -> TQueue (Output Stream)
outputQStreamID :: Context -> TVar BufferSize
controlQ :: Context -> TQueue Control
encodeDynamicTable :: Context -> DynamicTable
decodeDynamicTable :: Context -> DynamicTable
txConnectionWindow :: Context -> TVar BufferSize
rxConnectionInc :: Context -> IORef BufferSize
pingRate :: Context -> Rate
settingsRate :: Context -> Rate
emptyFrameRate :: Context -> Rate
role :: Role
roleInfo :: RoleInfo
myFirstSettings :: IORef Bool
myPendingAlist :: IORef (Maybe SettingsList)
mySettings :: IORef Settings
peerSettings :: IORef Settings
streamTable :: StreamTable
concurrency :: IORef BufferSize
continued :: IORef (Maybe BufferSize)
myStreamId :: IORef BufferSize
peerStreamId :: IORef BufferSize
outputBufferLimit :: IORef BufferSize
outputQ :: TQueue (Output Stream)
outputQStreamID :: TVar BufferSize
controlQ :: TQueue Control
encodeDynamicTable :: DynamicTable
decodeDynamicTable :: DynamicTable
txConnectionWindow :: TVar BufferSize
rxConnectionInc :: IORef BufferSize
pingRate :: Rate
settingsRate :: Rate
emptyFrameRate :: Rate
..} = DynamicTable -> ByteString -> IO HeaderTable
decodeTokenHeader DynamicTable
decodeDynamicTable ByteString
hdrblk IO HeaderTable -> (DecodeError -> IO HeaderTable) -> IO HeaderTable
forall e a. Exception e => IO a -> (e -> IO a) -> IO a
`E.catch` DecodeError -> IO HeaderTable
forall {a}. DecodeError -> IO a
handl
where
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 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. 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
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
getHeaderValue Token
tokenStatus ValueTable
reqvt
mScheme :: Maybe ByteString
mScheme = Token -> ValueTable -> Maybe ByteString
getHeaderValue Token
tokenScheme ValueTable
reqvt
mPath :: Maybe ByteString
mPath = Token -> ValueTable -> Maybe ByteString
getHeaderValue Token
tokenPath ValueTable
reqvt
mMethod :: Maybe ByteString
mMethod = Token -> ValueTable -> Maybe ByteString
getHeaderValue Token
tokenMethod ValueTable
reqvt
mConnection :: Maybe ByteString
mConnection = Token -> ValueTable -> Maybe ByteString
getHeaderValue Token
tokenConnection ValueTable
reqvt
mTE :: Maybe ByteString
mTE = Token -> ValueTable -> Maybe ByteString
getHeaderValue Token
tokenTE ValueTable
reqvt
mAuthority :: Maybe ByteString
mAuthority = Token -> ValueTable -> Maybe ByteString
getHeaderValue Token
tokenAuthority ValueTable
reqvt
mHost :: Maybe ByteString
mHost = Token -> ValueTable -> Maybe ByteString
getHeaderValue 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