{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE OverloadedStrings #-}
module Network.HTTP2.Frame.Decode (
decodeFrame
, decodeFrameHeader
, checkFrameHeader
, decodeFramePayload
, FramePayloadDecoder
, decodeDataFrame
, decodeHeadersFrame
, decodePriorityFrame
, decoderstStreamFrame
, decodeSettingsFrame
, decodePushPromiseFrame
, decodePingFrame
, decodeGoAwayFrame
, decodeWindowUpdateFrame
, decodeContinuationFrame
) where
import Data.Array (Array, listArray, (!))
import qualified Data.ByteString as BS
import Foreign.Ptr (Ptr, plusPtr)
import qualified Network.ByteOrder as N
import System.IO.Unsafe (unsafeDupablePerformIO)
import Imports
import Network.HTTP2.Frame.Types
decodeFrame :: Settings
-> ByteString
-> Either HTTP2Error Frame
decodeFrame :: Settings -> ByteString -> Either HTTP2Error Frame
decodeFrame Settings
settings ByteString
bs = Settings
-> (FrameTypeId, FrameHeader)
-> Either HTTP2Error (FrameTypeId, FrameHeader)
checkFrameHeader Settings
settings (ByteString -> (FrameTypeId, FrameHeader)
decodeFrameHeader ByteString
bs0)
Either HTTP2Error (FrameTypeId, FrameHeader)
-> ((FrameTypeId, FrameHeader) -> Either HTTP2Error Frame)
-> Either HTTP2Error Frame
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(FrameTypeId
typ,FrameHeader
header) -> FrameTypeId -> FramePayloadDecoder
decodeFramePayload FrameTypeId
typ FrameHeader
header ByteString
bs1
Either HTTP2Error FramePayload
-> (FramePayload -> Either HTTP2Error Frame)
-> Either HTTP2Error Frame
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FramePayload
payload -> Frame -> Either HTTP2Error Frame
forall (m :: * -> *) a. Monad m => a -> m a
return (Frame -> Either HTTP2Error Frame)
-> Frame -> Either HTTP2Error Frame
forall a b. (a -> b) -> a -> b
$ FrameHeader -> FramePayload -> Frame
Frame FrameHeader
header FramePayload
payload
where
(ByteString
bs0,ByteString
bs1) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
9 ByteString
bs
decodeFrameHeader :: ByteString -> (FrameTypeId, FrameHeader)
(PS ForeignPtr Word8
fptr Int
off Int
_) = IO (FrameTypeId, FrameHeader) -> (FrameTypeId, FrameHeader)
forall a. IO a -> a
unsafeDupablePerformIO (IO (FrameTypeId, FrameHeader) -> (FrameTypeId, FrameHeader))
-> IO (FrameTypeId, FrameHeader) -> (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8
-> (Ptr Word8 -> IO (FrameTypeId, FrameHeader))
-> IO (FrameTypeId, FrameHeader)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO (FrameTypeId, FrameHeader))
-> IO (FrameTypeId, FrameHeader))
-> (Ptr Word8 -> IO (FrameTypeId, FrameHeader))
-> IO (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
let p :: Ptr Word8
p = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
+. Int
off
Int
len <- Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word32 -> Int) -> IO Word32 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word32
N.peek24 Ptr Word8
p Int
0
FrameTypeId
typ <- Word8 -> FrameTypeId
toFrameTypeId (Word8 -> FrameTypeId) -> IO Word8 -> IO FrameTypeId
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Ptr Word8 -> Int -> IO Word8
N.peek8 Ptr Word8
p Int
3
Word8
flg <- Ptr Word8 -> Int -> IO Word8
N.peek8 Ptr Word8
p Int
4
Word32
w32 <- Ptr Word8 -> Int -> IO Word32
N.peek32 Ptr Word8
p Int
5
let sid :: Int
sid = Word32 -> Int
streamIdentifier Word32
w32
(FrameTypeId, FrameHeader) -> IO (FrameTypeId, FrameHeader)
forall (m :: * -> *) a. Monad m => a -> m a
return (FrameTypeId
typ, Int -> Word8 -> Int -> FrameHeader
FrameHeader Int
len Word8
flg Int
sid)
(+.) :: Ptr Word8 -> Int -> Ptr Word8
+. :: Ptr Word8 -> Int -> Ptr Word8
(+.) = Ptr Word8 -> Int -> Ptr Word8
forall a b. Ptr a -> Int -> Ptr b
plusPtr
checkFrameHeader :: Settings
-> (FrameTypeId, FrameHeader)
-> Either HTTP2Error (FrameTypeId, FrameHeader)
Settings {Bool
Int
Maybe Int
maxHeaderBlockSize :: Settings -> Maybe Int
maxFrameSize :: Settings -> Int
initialWindowSize :: Settings -> Int
maxConcurrentStreams :: Settings -> Maybe Int
enablePush :: Settings -> Bool
headerTableSize :: Settings -> Int
maxHeaderBlockSize :: Maybe Int
maxFrameSize :: Int
initialWindowSize :: Int
maxConcurrentStreams :: Maybe Int
enablePush :: Bool
headerTableSize :: Int
..} typfrm :: (FrameTypeId, FrameHeader)
typfrm@(FrameTypeId
typ,FrameHeader {Int
Word8
streamId :: FrameHeader -> Int
flags :: FrameHeader -> Word8
payloadLength :: FrameHeader -> Int
streamId :: Int
flags :: Word8
payloadLength :: Int
..})
| Int
payloadLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
maxFrameSize =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
FrameSizeError ByteString
"exceeds maximum frame size"
| FrameTypeId
typ FrameTypeId -> [FrameTypeId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FrameTypeId]
nonZeroFrameTypes Bool -> Bool -> Bool
&& Int -> Bool
isControl Int
streamId =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
ProtocolError ByteString
"cannot used in control stream"
| FrameTypeId
typ FrameTypeId -> [FrameTypeId] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FrameTypeId]
zeroFrameTypes Bool -> Bool -> Bool
&& Bool -> Bool
not (Int -> Bool
isControl Int
streamId) =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
ProtocolError ByteString
"cannot used in non-zero stream"
| Bool
otherwise = FrameTypeId -> Either HTTP2Error (FrameTypeId, FrameHeader)
checkType FrameTypeId
typ
where
checkType :: FrameTypeId -> Either HTTP2Error (FrameTypeId, FrameHeader)
checkType FrameTypeId
FrameHeaders
| Word8 -> Bool
testPadded Word8
flags Bool -> Bool -> Bool
&& Int
payloadLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
FrameSizeError ByteString
"insufficient payload for Pad Length"
| Word8 -> Bool
testPriority Word8
flags Bool -> Bool -> Bool
&& Int
payloadLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5 =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
FrameSizeError ByteString
"insufficient payload for priority fields"
| Word8 -> Bool
testPadded Word8
flags Bool -> Bool -> Bool
&& Word8 -> Bool
testPriority Word8
flags Bool -> Bool -> Bool
&& Int
payloadLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
6 =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
FrameSizeError ByteString
"insufficient payload for Pad Length and priority fields"
checkType FrameTypeId
FramePriority | Int
payloadLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
5 =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> Int -> HTTP2Error
StreamError ErrorCodeId
FrameSizeError Int
streamId
checkType FrameTypeId
FrameRSTStream | Int
payloadLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
4 =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
FrameSizeError ByteString
"payload length is not 4 in rst stream frame"
checkType FrameTypeId
FrameSettings
| Int
payloadLength Int -> Int -> Int
forall a. Integral a => a -> a -> a
`mod` Int
6 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
FrameSizeError ByteString
"payload length is not multiple of 6 in settings frame"
| Word8 -> Bool
testAck Word8
flags Bool -> Bool -> Bool
&& Int
payloadLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
FrameSizeError ByteString
"payload length must be 0 if ack flag is set"
checkType FrameTypeId
FramePushPromise
| Bool -> Bool
not Bool
enablePush =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
ProtocolError ByteString
"push not enabled"
| Int -> Bool
isClientInitiated Int
streamId =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
ProtocolError ByteString
"push promise must be used with even stream identifier"
checkType FrameTypeId
FramePing | Int
payloadLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
8 =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
FrameSizeError ByteString
"payload length is 8 in ping frame"
checkType FrameTypeId
FrameGoAway | Int
payloadLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
FrameSizeError ByteString
"goaway body must be 8 bytes or larger"
checkType FrameTypeId
FrameWindowUpdate | Int
payloadLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
4 =
HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader))
-> HTTP2Error -> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
FrameSizeError ByteString
"payload length is 4 in window update frame"
checkType FrameTypeId
_ = (FrameTypeId, FrameHeader)
-> Either HTTP2Error (FrameTypeId, FrameHeader)
forall a b. b -> Either a b
Right (FrameTypeId, FrameHeader)
typfrm
zeroFrameTypes :: [FrameTypeId]
zeroFrameTypes :: [FrameTypeId]
zeroFrameTypes = [
FrameTypeId
FrameSettings
, FrameTypeId
FramePing
, FrameTypeId
FrameGoAway
]
nonZeroFrameTypes :: [FrameTypeId]
nonZeroFrameTypes :: [FrameTypeId]
nonZeroFrameTypes = [
FrameTypeId
FrameData
, FrameTypeId
FrameHeaders
, FrameTypeId
FramePriority
, FrameTypeId
FrameRSTStream
, FrameTypeId
FramePushPromise
, FrameTypeId
FrameContinuation
]
type FramePayloadDecoder = FrameHeader -> ByteString
-> Either HTTP2Error FramePayload
payloadDecoders :: Array Word8 FramePayloadDecoder
payloadDecoders :: Array Word8 FramePayloadDecoder
payloadDecoders = (Word8, Word8)
-> [FramePayloadDecoder] -> Array Word8 FramePayloadDecoder
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray (Word8
minFrameType, Word8
maxFrameType)
[ FramePayloadDecoder
decodeDataFrame
, FramePayloadDecoder
decodeHeadersFrame
, FramePayloadDecoder
decodePriorityFrame
, FramePayloadDecoder
decoderstStreamFrame
, FramePayloadDecoder
decodeSettingsFrame
, FramePayloadDecoder
decodePushPromiseFrame
, FramePayloadDecoder
decodePingFrame
, FramePayloadDecoder
decodeGoAwayFrame
, FramePayloadDecoder
decodeWindowUpdateFrame
, FramePayloadDecoder
decodeContinuationFrame
]
decodeFramePayload :: FrameTypeId -> FramePayloadDecoder
decodeFramePayload :: FrameTypeId -> FramePayloadDecoder
decodeFramePayload (FrameUnknown Word8
typ) = FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize (FramePayloadDecoder -> FramePayloadDecoder)
-> FramePayloadDecoder -> FramePayloadDecoder
forall a b. (a -> b) -> a -> b
$ Word8 -> FramePayloadDecoder
decodeUnknownFrame Word8
typ
decodeFramePayload FrameTypeId
ftyp = FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize FramePayloadDecoder
decoder
where
decoder :: FramePayloadDecoder
decoder = Array Word8 FramePayloadDecoder
payloadDecoders Array Word8 FramePayloadDecoder -> Word8 -> FramePayloadDecoder
forall i e. Ix i => Array i e -> i -> e
! FrameTypeId -> Word8
fromFrameTypeId FrameTypeId
ftyp
decodeDataFrame :: FramePayloadDecoder
decodeDataFrame :: FramePayloadDecoder
decodeDataFrame FrameHeader
header ByteString
bs = FrameHeader
-> ByteString
-> (ByteString -> FramePayload)
-> Either HTTP2Error FramePayload
decodeWithPadding FrameHeader
header ByteString
bs ByteString -> FramePayload
DataFrame
decodeHeadersFrame :: FramePayloadDecoder
FrameHeader
header ByteString
bs = FrameHeader
-> ByteString
-> (ByteString -> FramePayload)
-> Either HTTP2Error FramePayload
decodeWithPadding FrameHeader
header ByteString
bs ((ByteString -> FramePayload) -> Either HTTP2Error FramePayload)
-> (ByteString -> FramePayload) -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ \ByteString
bs' ->
if Bool
hasPriority then
let (ByteString
bs0,ByteString
bs1) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
5 ByteString
bs'
p :: Priority
p = ByteString -> Priority
priority ByteString
bs0
in Maybe Priority -> ByteString -> FramePayload
HeadersFrame (Priority -> Maybe Priority
forall a. a -> Maybe a
Just Priority
p) ByteString
bs1
else
Maybe Priority -> ByteString -> FramePayload
HeadersFrame Maybe Priority
forall a. Maybe a
Nothing ByteString
bs'
where
hasPriority :: Bool
hasPriority = Word8 -> Bool
testPriority (Word8 -> Bool) -> Word8 -> Bool
forall a b. (a -> b) -> a -> b
$ FrameHeader -> Word8
flags FrameHeader
header
decodePriorityFrame :: FramePayloadDecoder
decodePriorityFrame :: FramePayloadDecoder
decodePriorityFrame FrameHeader
_ ByteString
bs = FramePayload -> Either HTTP2Error FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either HTTP2Error FramePayload)
-> FramePayload -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ Priority -> FramePayload
PriorityFrame (Priority -> FramePayload) -> Priority -> FramePayload
forall a b. (a -> b) -> a -> b
$ ByteString -> Priority
priority ByteString
bs
decoderstStreamFrame :: FramePayloadDecoder
decoderstStreamFrame :: FramePayloadDecoder
decoderstStreamFrame FrameHeader
_ ByteString
bs = FramePayload -> Either HTTP2Error FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either HTTP2Error FramePayload)
-> FramePayload -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> FramePayload
RSTStreamFrame (ErrorCodeId -> FramePayload) -> ErrorCodeId -> FramePayload
forall a b. (a -> b) -> a -> b
$ Word32 -> ErrorCodeId
toErrorCodeId (ByteString -> Word32
N.word32 ByteString
bs)
decodeSettingsFrame :: FramePayloadDecoder
decodeSettingsFrame :: FramePayloadDecoder
decodeSettingsFrame FrameHeader{Int
Word8
streamId :: Int
flags :: Word8
payloadLength :: Int
streamId :: FrameHeader -> Int
flags :: FrameHeader -> Word8
payloadLength :: FrameHeader -> Int
..} (PS ForeignPtr Word8
fptr Int
off Int
_)
| Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10 = HTTP2Error -> Either HTTP2Error FramePayload
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error FramePayload)
-> HTTP2Error -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
EnhanceYourCalm ByteString
"Settings is too large"
| Bool
otherwise = FramePayload -> Either HTTP2Error FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either HTTP2Error FramePayload)
-> FramePayload -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ SettingsList -> FramePayload
SettingsFrame SettingsList
alist
where
num :: Int
num = Int
payloadLength Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
6
alist :: SettingsList
alist = IO SettingsList -> SettingsList
forall a. IO a -> a
unsafeDupablePerformIO (IO SettingsList -> SettingsList)
-> IO SettingsList -> SettingsList
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8
-> (Ptr Word8 -> IO SettingsList) -> IO SettingsList
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO SettingsList) -> IO SettingsList)
-> (Ptr Word8 -> IO SettingsList) -> IO SettingsList
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
let p :: Ptr Word8
p = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
+. Int
off
Int
-> Ptr Word8 -> (SettingsList -> SettingsList) -> IO SettingsList
forall t b c.
(Eq t, Num t, Num b) =>
t -> Ptr Word8 -> ([(SettingsKeyId, b)] -> c) -> IO c
settings Int
num Ptr Word8
p SettingsList -> SettingsList
forall a. a -> a
id
settings :: t -> Ptr Word8 -> ([(SettingsKeyId, b)] -> c) -> IO c
settings t
0 Ptr Word8
_ [(SettingsKeyId, b)] -> c
builder = c -> IO c
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> IO c) -> c -> IO c
forall a b. (a -> b) -> a -> b
$ [(SettingsKeyId, b)] -> c
builder []
settings t
n Ptr Word8
p [(SettingsKeyId, b)] -> c
builder = do
Word16
rawSetting <- Ptr Word8 -> Int -> IO Word16
N.peek16 Ptr Word8
p Int
0
let msettings :: Maybe SettingsKeyId
msettings = Word16 -> Maybe SettingsKeyId
toSettingsKeyId Word16
rawSetting
n' :: t
n' = t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1
case Maybe SettingsKeyId
msettings of
Maybe SettingsKeyId
Nothing -> t -> Ptr Word8 -> ([(SettingsKeyId, b)] -> c) -> IO c
settings t
n' (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
+. Int
6) [(SettingsKeyId, b)] -> c
builder
Just SettingsKeyId
k -> do
Word32
w32 <- Ptr Word8 -> Int -> IO Word32
N.peek32 Ptr Word8
p Int
2
let v :: b
v = Word32 -> b
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w32
t -> Ptr Word8 -> ([(SettingsKeyId, b)] -> c) -> IO c
settings t
n' (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
+. Int
6) ([(SettingsKeyId, b)] -> c
builder([(SettingsKeyId, b)] -> c)
-> ([(SettingsKeyId, b)] -> [(SettingsKeyId, b)])
-> [(SettingsKeyId, b)]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SettingsKeyId
k,b
v)(SettingsKeyId, b) -> [(SettingsKeyId, b)] -> [(SettingsKeyId, b)]
forall a. a -> [a] -> [a]
:))
decodePushPromiseFrame :: FramePayloadDecoder
decodePushPromiseFrame :: FramePayloadDecoder
decodePushPromiseFrame FrameHeader
header ByteString
bs = FrameHeader
-> ByteString
-> (ByteString -> FramePayload)
-> Either HTTP2Error FramePayload
decodeWithPadding FrameHeader
header ByteString
bs ((ByteString -> FramePayload) -> Either HTTP2Error FramePayload)
-> (ByteString -> FramePayload) -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ \ByteString
bs' ->
let (ByteString
bs0,ByteString
bs1) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
4 ByteString
bs'
sid :: Int
sid = Word32 -> Int
streamIdentifier (ByteString -> Word32
N.word32 ByteString
bs0)
in Int -> ByteString -> FramePayload
PushPromiseFrame Int
sid ByteString
bs1
decodePingFrame :: FramePayloadDecoder
decodePingFrame :: FramePayloadDecoder
decodePingFrame FrameHeader
_ ByteString
bs = FramePayload -> Either HTTP2Error FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either HTTP2Error FramePayload)
-> FramePayload -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ ByteString -> FramePayload
PingFrame ByteString
bs
decodeGoAwayFrame :: FramePayloadDecoder
decodeGoAwayFrame :: FramePayloadDecoder
decodeGoAwayFrame FrameHeader
_ ByteString
bs = FramePayload -> Either HTTP2Error FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either HTTP2Error FramePayload)
-> FramePayload -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ Int -> ErrorCodeId -> ByteString -> FramePayload
GoAwayFrame Int
sid ErrorCodeId
ecid ByteString
bs2
where
(ByteString
bs0,ByteString
bs1') = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
4 ByteString
bs
(ByteString
bs1,ByteString
bs2) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
4 ByteString
bs1'
sid :: Int
sid = Word32 -> Int
streamIdentifier (ByteString -> Word32
N.word32 ByteString
bs0)
ecid :: ErrorCodeId
ecid = Word32 -> ErrorCodeId
toErrorCodeId (ByteString -> Word32
N.word32 ByteString
bs1)
decodeWindowUpdateFrame :: FramePayloadDecoder
decodeWindowUpdateFrame :: FramePayloadDecoder
decodeWindowUpdateFrame FrameHeader
_ ByteString
bs
| Int
wsi Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 = HTTP2Error -> Either HTTP2Error FramePayload
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error FramePayload)
-> HTTP2Error -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
ProtocolError ByteString
"window update must not be 0"
| Bool
otherwise = FramePayload -> Either HTTP2Error FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either HTTP2Error FramePayload)
-> FramePayload -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ Int -> FramePayload
WindowUpdateFrame Int
wsi
where
wsi :: Int
wsi = Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Word32
N.word32 ByteString
bs Word32 -> Int -> Word32
forall a. Bits a => a -> Int -> a
`clearBit` Int
31)
decodeContinuationFrame :: FramePayloadDecoder
decodeContinuationFrame :: FramePayloadDecoder
decodeContinuationFrame FrameHeader
_ ByteString
bs = FramePayload -> Either HTTP2Error FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either HTTP2Error FramePayload)
-> FramePayload -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ ByteString -> FramePayload
ContinuationFrame ByteString
bs
decodeUnknownFrame :: FrameType -> FramePayloadDecoder
decodeUnknownFrame :: Word8 -> FramePayloadDecoder
decodeUnknownFrame Word8
typ FrameHeader
_ ByteString
bs = FramePayload -> Either HTTP2Error FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either HTTP2Error FramePayload)
-> FramePayload -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ Word8 -> ByteString -> FramePayload
UnknownFrame Word8
typ ByteString
bs
checkFrameSize :: FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize :: FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize FramePayloadDecoder
func header :: FrameHeader
header@FrameHeader{Int
Word8
streamId :: Int
flags :: Word8
payloadLength :: Int
streamId :: FrameHeader -> Int
flags :: FrameHeader -> Word8
payloadLength :: FrameHeader -> Int
..} ByteString
body
| Int
payloadLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteString -> Int
BS.length ByteString
body =
HTTP2Error -> Either HTTP2Error FramePayload
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error FramePayload)
-> HTTP2Error -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
FrameSizeError ByteString
"payload is too short"
| Bool
otherwise = FramePayloadDecoder
func FrameHeader
header ByteString
body
decodeWithPadding :: FrameHeader -> ByteString -> (ByteString -> FramePayload) -> Either HTTP2Error FramePayload
decodeWithPadding :: FrameHeader
-> ByteString
-> (ByteString -> FramePayload)
-> Either HTTP2Error FramePayload
decodeWithPadding FrameHeader{Int
Word8
streamId :: Int
flags :: Word8
payloadLength :: Int
streamId :: FrameHeader -> Int
flags :: FrameHeader -> Word8
payloadLength :: FrameHeader -> Int
..} ByteString
bs ByteString -> FramePayload
body
| Bool
padded = let Just (Word8
w8,ByteString
rest) = ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs
padlen :: Int
padlen = Word8 -> Int
intFromWord8 Word8
w8
bodylen :: Int
bodylen = Int
payloadLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
padlen Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
in if Int
bodylen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 then
HTTP2Error -> Either HTTP2Error FramePayload
forall a b. a -> Either a b
Left (HTTP2Error -> Either HTTP2Error FramePayload)
-> HTTP2Error -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ ErrorCodeId -> ByteString -> HTTP2Error
ConnectionError ErrorCodeId
ProtocolError ByteString
"padding is not enough"
else
FramePayload -> Either HTTP2Error FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either HTTP2Error FramePayload)
-> (ByteString -> FramePayload)
-> ByteString
-> Either HTTP2Error FramePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FramePayload
body (ByteString -> Either HTTP2Error FramePayload)
-> ByteString -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
bodylen ByteString
rest
| Bool
otherwise = FramePayload -> Either HTTP2Error FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either HTTP2Error FramePayload)
-> FramePayload -> Either HTTP2Error FramePayload
forall a b. (a -> b) -> a -> b
$ ByteString -> FramePayload
body ByteString
bs
where
padded :: Bool
padded = Word8 -> Bool
testPadded Word8
flags
streamIdentifier :: Word32 -> StreamId
streamIdentifier :: Word32 -> Int
streamIdentifier Word32
w32 = Int -> Int
clearExclusive (Int -> Int) -> Int -> Int
forall a b. (a -> b) -> a -> b
$ Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w32
priority :: ByteString -> Priority
priority :: ByteString -> Priority
priority (PS ForeignPtr Word8
fptr Int
off Int
_) = IO Priority -> Priority
forall a. IO a -> a
unsafeDupablePerformIO (IO Priority -> Priority) -> IO Priority -> Priority
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8 -> (Ptr Word8 -> IO Priority) -> IO Priority
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO Priority) -> IO Priority)
-> (Ptr Word8 -> IO Priority) -> IO Priority
forall a b. (a -> b) -> a -> b
$ \Ptr Word8
ptr -> do
let p :: Ptr Word8
p = Ptr Word8
ptr Ptr Word8 -> Int -> Ptr Word8
+. Int
off
Word32
w32 <- Ptr Word8 -> Int -> IO Word32
N.peek32 Ptr Word8
p Int
0
let streamdId :: Int
streamdId = Word32 -> Int
streamIdentifier Word32
w32
exclusive :: Bool
exclusive = Int -> Bool
testExclusive (Word32 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
w32)
Word8
w8 <- Ptr Word8 -> Int -> IO Word8
N.peek8 Ptr Word8
p Int
4
let weight :: Int
weight = Word8 -> Int
intFromWord8 Word8
w8 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
Priority -> IO Priority
forall (m :: * -> *) a. Monad m => a -> m a
return (Priority -> IO Priority) -> Priority -> IO Priority
forall a b. (a -> b) -> a -> b
$ Bool -> Int -> Int -> Priority
Priority Bool
exclusive Int
streamdId Int
weight
intFromWord8 :: Word8 -> Int
intFromWord8 :: Word8 -> Int
intFromWord8 = Word8 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral