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

module Network.HTTP2.Frame.Decode (
    -- * Decoding
    decodeFrame,
    decodeFrameHeader,
    checkFrameHeader,
    FrameDecodeError (..),

    -- * Decoding payload
    decodeFramePayload,
    FramePayloadDecoder,
    decodeDataFrame,
    decodeHeadersFrame,
    decodePriorityFrame,
    decodeRSTStreamFrame,
    decodeSettingsFrame,
    decodePushPromiseFrame,
    decodePingFrame,
    decodeGoAwayFrame,
    decodeWindowUpdateFrame,
    decodeContinuationFrame,
) where

import qualified Control.Exception as E
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

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

data FrameDecodeError = FrameDecodeError ErrorCode StreamId ShortByteString
    deriving (FrameDecodeError -> FrameDecodeError -> Bool
(FrameDecodeError -> FrameDecodeError -> Bool)
-> (FrameDecodeError -> FrameDecodeError -> Bool)
-> Eq FrameDecodeError
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: FrameDecodeError -> FrameDecodeError -> Bool
== :: FrameDecodeError -> FrameDecodeError -> Bool
$c/= :: FrameDecodeError -> FrameDecodeError -> Bool
/= :: FrameDecodeError -> FrameDecodeError -> Bool
Eq, Int -> FrameDecodeError -> ShowS
[FrameDecodeError] -> ShowS
FrameDecodeError -> String
(Int -> FrameDecodeError -> ShowS)
-> (FrameDecodeError -> String)
-> ([FrameDecodeError] -> ShowS)
-> Show FrameDecodeError
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> FrameDecodeError -> ShowS
showsPrec :: Int -> FrameDecodeError -> ShowS
$cshow :: FrameDecodeError -> String
show :: FrameDecodeError -> String
$cshowList :: [FrameDecodeError] -> ShowS
showList :: [FrameDecodeError] -> ShowS
Show)

instance E.Exception FrameDecodeError

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

-- | Decoding an HTTP/2 frame to 'ByteString'.
-- The second argument must be include the entire of frame.
-- So, this function is not useful for real applications
-- but useful for testing.
decodeFrame
    :: ByteString
    -- ^ Input byte-stream
    -> Either FrameDecodeError Frame
    -- ^ Decoded frame
decodeFrame :: ByteString -> Either FrameDecodeError Frame
decodeFrame ByteString
bs =
    (FrameType, FrameHeader)
-> Either FrameDecodeError (FrameType, FrameHeader)
checkFrameHeader (ByteString -> (FrameType, FrameHeader)
decodeFrameHeader ByteString
bs0)
        Either FrameDecodeError (FrameType, FrameHeader)
-> ((FrameType, FrameHeader) -> Either FrameDecodeError Frame)
-> Either FrameDecodeError Frame
forall a b.
Either FrameDecodeError a
-> (a -> Either FrameDecodeError b) -> Either FrameDecodeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \(FrameType
typ, FrameHeader
header) ->
            FrameType -> FramePayloadDecoder
decodeFramePayload FrameType
typ FrameHeader
header ByteString
bs1
                Either FrameDecodeError FramePayload
-> (FramePayload -> Either FrameDecodeError Frame)
-> Either FrameDecodeError Frame
forall a b.
Either FrameDecodeError a
-> (a -> Either FrameDecodeError b) -> Either FrameDecodeError b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= \FramePayload
payload -> Frame -> Either FrameDecodeError Frame
forall a. a -> Either FrameDecodeError a
forall (m :: * -> *) a. Monad m => a -> m a
return (Frame -> Either FrameDecodeError Frame)
-> Frame -> Either FrameDecodeError 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

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

-- | Decoding an HTTP/2 frame header.
--   Must supply 9 bytes.
decodeFrameHeader :: ByteString -> (FrameType, FrameHeader)
decodeFrameHeader :: ByteString -> (FrameType, FrameHeader)
decodeFrameHeader (PS ForeignPtr Word8
fptr Int
off Int
_) = IO (FrameType, FrameHeader) -> (FrameType, FrameHeader)
forall a. IO a -> a
unsafeDupablePerformIO (IO (FrameType, FrameHeader) -> (FrameType, FrameHeader))
-> IO (FrameType, FrameHeader) -> (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ForeignPtr Word8
-> (Ptr Word8 -> IO (FrameType, FrameHeader))
-> IO (FrameType, FrameHeader)
forall a b. ForeignPtr a -> (Ptr a -> IO b) -> IO b
withForeignPtr ForeignPtr Word8
fptr ((Ptr Word8 -> IO (FrameType, FrameHeader))
 -> IO (FrameType, FrameHeader))
-> (Ptr Word8 -> IO (FrameType, FrameHeader))
-> IO (FrameType, 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
    FrameType
typ <- Word8 -> FrameType
toFrameType (Word8 -> FrameType) -> IO Word8 -> IO FrameType
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
    (FrameType, FrameHeader) -> IO (FrameType, FrameHeader)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (FrameType
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

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

-- | Checking a frame header and reporting an error if any.
--
-- >>> checkFrameHeader (FrameData,(FrameHeader 100 0 0))
-- Left (FrameDecodeError ProtocolError 0 "cannot used in control stream")
checkFrameHeader
    :: (FrameType, FrameHeader)
    -> Either FrameDecodeError (FrameType, FrameHeader)
checkFrameHeader :: (FrameType, FrameHeader)
-> Either FrameDecodeError (FrameType, FrameHeader)
checkFrameHeader typfrm :: (FrameType, FrameHeader)
typfrm@(FrameType
typ, FrameHeader{Int
Word8
payloadLength :: Int
flags :: Word8
streamId :: Int
streamId :: FrameHeader -> Int
flags :: FrameHeader -> Word8
payloadLength :: FrameHeader -> Int
..})
    | FrameType
typ FrameType -> [FrameType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FrameType]
nonZeroFrameTypes Bool -> Bool -> Bool
&& Int -> Bool
isControl Int
streamId =
        FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError ErrorCode
ProtocolError Int
streamId ShortByteString
"cannot used in control stream"
    | FrameType
typ FrameType -> [FrameType] -> Bool
forall a. Eq a => a -> [a] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [FrameType]
zeroFrameTypes Bool -> Bool -> Bool
&& Bool -> Bool
not (Int -> Bool
isControl Int
streamId) =
        FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$ ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError ErrorCode
ProtocolError Int
streamId ShortByteString
"cannot used in non-zero stream"
    | Bool
otherwise = FrameType -> Either FrameDecodeError (FrameType, FrameHeader)
checkType FrameType
typ
  where
    checkType :: FrameType -> Either FrameDecodeError (FrameType, FrameHeader)
checkType FrameType
FrameData
        | Word8 -> Bool
testPadded Word8
flags Bool -> Bool -> Bool
&& Int
payloadLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError ErrorCode
FrameSizeError Int
streamId ShortByteString
"insufficient payload for Pad Length"
    checkType FrameType
FrameHeaders
        | Word8 -> Bool
testPadded Word8
flags Bool -> Bool -> Bool
&& Int
payloadLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
1 =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError ErrorCode
FrameSizeError Int
streamId ShortByteString
"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 =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError
                    ErrorCode
FrameSizeError
                    Int
streamId
                    ShortByteString
"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 =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError
                    ErrorCode
FrameSizeError
                    Int
streamId
                    ShortByteString
"insufficient payload for Pad Length and priority fields"
    checkType FrameType
FramePriority
        | Int
payloadLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
5 =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError
                    ErrorCode
FrameSizeError
                    Int
streamId
                    ShortByteString
"payload length is not 5 in priority frame"
    checkType FrameType
FrameRSTStream
        | Int
payloadLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
4 =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError
                    ErrorCode
FrameSizeError
                    Int
streamId
                    ShortByteString
"payload length is not 4 in rst stream frame"
    checkType FrameType
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 =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError
                    ErrorCode
FrameSizeError
                    Int
streamId
                    ShortByteString
"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 =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError
                    ErrorCode
FrameSizeError
                    Int
streamId
                    ShortByteString
"payload length must be 0 if ack flag is set"
    checkType FrameType
FramePushPromise
        | Int -> Bool
isServerInitiated Int
streamId =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError
                    ErrorCode
ProtocolError
                    Int
streamId
                    ShortByteString
"push promise must be used with an odd stream identifier"
        | Word8 -> Bool
testPadded Word8
flags Bool -> Bool -> Bool
&& Int
payloadLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5 =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError
                    ErrorCode
FrameSizeError
                    Int
streamId
                    ShortByteString
"insufficient payload for Pad Length and promised stream id"
        | Bool -> Bool
not (Word8 -> Bool
testPadded Word8
flags) Bool -> Bool -> Bool
&& Int
payloadLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4 =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError
                    ErrorCode
FrameSizeError
                    Int
streamId
                    ShortByteString
"insufficient payload for promised stream id"
    checkType FrameType
FramePing
        | Int
payloadLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
8 =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError ErrorCode
FrameSizeError Int
streamId ShortByteString
"payload length is 8 in ping frame"
    checkType FrameType
FrameGoAway
        | Int
payloadLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
8 =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError ErrorCode
FrameSizeError Int
streamId ShortByteString
"goaway body must be 8 bytes or larger"
    checkType FrameType
FrameWindowUpdate
        | Int
payloadLength Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
4 =
            FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. a -> Either a b
Left (FrameDecodeError
 -> Either FrameDecodeError (FrameType, FrameHeader))
-> FrameDecodeError
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError
                    ErrorCode
FrameSizeError
                    Int
streamId
                    ShortByteString
"payload length is 4 in window update frame"
    checkType FrameType
_ = (FrameType, FrameHeader)
-> Either FrameDecodeError (FrameType, FrameHeader)
forall a b. b -> Either a b
Right (FrameType, FrameHeader)
typfrm

zeroFrameTypes :: [FrameType]
zeroFrameTypes :: [FrameType]
zeroFrameTypes =
    [ FrameType
FrameSettings
    , FrameType
FramePing
    , FrameType
FrameGoAway
    ]

nonZeroFrameTypes :: [FrameType]
nonZeroFrameTypes :: [FrameType]
nonZeroFrameTypes =
    [ FrameType
FrameData
    , FrameType
FrameHeaders
    , FrameType
FramePriority
    , FrameType
FrameRSTStream
    , FrameType
FramePushPromise
    , FrameType
FrameContinuation
    ]

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

-- | The type for frame payload decoder.
type FramePayloadDecoder =
    FrameHeader
    -> ByteString
    -> Either FrameDecodeError FramePayload

payloadDecoders :: Array FrameType FramePayloadDecoder
payloadDecoders :: Array FrameType FramePayloadDecoder
payloadDecoders =
    (FrameType, FrameType)
-> [FramePayloadDecoder] -> Array FrameType FramePayloadDecoder
forall i e. Ix i => (i, i) -> [e] -> Array i e
listArray
        (FrameType
minFrameType, FrameType
maxFrameType)
        [ FramePayloadDecoder
decodeDataFrame
        , FramePayloadDecoder
decodeHeadersFrame
        , FramePayloadDecoder
decodePriorityFrame
        , FramePayloadDecoder
decodeRSTStreamFrame
        , FramePayloadDecoder
decodeSettingsFrame
        , FramePayloadDecoder
decodePushPromiseFrame
        , FramePayloadDecoder
decodePingFrame
        , FramePayloadDecoder
decodeGoAwayFrame
        , FramePayloadDecoder
decodeWindowUpdateFrame
        , FramePayloadDecoder
decodeContinuationFrame
        ]

-- | Decoding an HTTP/2 frame payload.
--   This function is considered to return a frame payload decoder
--   according to a frame type.
decodeFramePayload :: FrameType -> FramePayloadDecoder
decodeFramePayload :: FrameType -> FramePayloadDecoder
decodeFramePayload FrameType
ftyp
    | FrameType
ftyp FrameType -> FrameType -> Bool
forall a. Ord a => a -> a -> Bool
> FrameType
maxFrameType = FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize (FramePayloadDecoder -> FramePayloadDecoder)
-> FramePayloadDecoder -> FramePayloadDecoder
forall a b. (a -> b) -> a -> b
$ FrameType -> FramePayloadDecoder
decodeUnknownFrame FrameType
ftyp
decodeFramePayload FrameType
ftyp = Array FrameType FramePayloadDecoder
payloadDecoders Array FrameType FramePayloadDecoder
-> FrameType -> FramePayloadDecoder
forall i e. Ix i => Array i e -> i -> e
! FrameType
ftyp -- each one checks its own size

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

-- | Frame payload decoder for DATA frame.
decodeDataFrame :: FramePayloadDecoder
decodeDataFrame :: FramePayloadDecoder
decodeDataFrame = FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize (FramePayloadDecoder -> FramePayloadDecoder)
-> FramePayloadDecoder -> FramePayloadDecoder
forall a b. (a -> b) -> a -> b
$ \FrameHeader
header ByteString
bs ->
    FrameHeader
-> ByteString
-> (ByteString -> Either FrameDecodeError FramePayload)
-> Either FrameDecodeError FramePayload
decodeWithPadding FrameHeader
header ByteString
bs ((ByteString -> Either FrameDecodeError FramePayload)
 -> Either FrameDecodeError FramePayload)
-> (ByteString -> Either FrameDecodeError FramePayload)
-> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ FramePayload -> Either FrameDecodeError FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either FrameDecodeError FramePayload)
-> (ByteString -> FramePayload)
-> ByteString
-> Either FrameDecodeError FramePayload
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> FramePayload
DataFrame

-- | Frame payload decoder for HEADERS frame.
decodeHeadersFrame :: FramePayloadDecoder
decodeHeadersFrame :: FramePayloadDecoder
decodeHeadersFrame = FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize (FramePayloadDecoder -> FramePayloadDecoder)
-> FramePayloadDecoder -> FramePayloadDecoder
forall a b. (a -> b) -> a -> b
$ \header :: FrameHeader
header@FrameHeader{Int
streamId :: FrameHeader -> Int
streamId :: Int
streamId} ByteString
bs ->
    FrameHeader
-> ByteString
-> (ByteString -> Either FrameDecodeError FramePayload)
-> Either FrameDecodeError FramePayload
decodeWithPadding FrameHeader
header ByteString
bs ((ByteString -> Either FrameDecodeError FramePayload)
 -> Either FrameDecodeError FramePayload)
-> (ByteString -> Either FrameDecodeError FramePayload)
-> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ \ByteString
bs' ->
        if Word8 -> Bool
testPriority (Word8 -> Bool) -> Word8 -> Bool
forall a b. (a -> b) -> a -> b
$ FrameHeader -> Word8
flags FrameHeader
header
            then
                -- The header check knows the payload is long enough to hold
                -- the priority fields, but not that the padding leaves them
                -- there: Pad Length may cover the lot.
                if ByteString -> Int
BS.length ByteString
bs' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
5
                    then
                        FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. a -> Either a b
Left (FrameDecodeError -> Either FrameDecodeError FramePayload)
-> FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$
                            ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError
                                ErrorCode
FrameSizeError
                                Int
streamId
                                ShortByteString
"no room for priority fields"
                    else
                        let (ByteString
bs0, ByteString
bs1) = Int -> ByteString -> (ByteString, ByteString)
BS.splitAt Int
5 ByteString
bs'
                         in FramePayload -> Either FrameDecodeError FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either FrameDecodeError FramePayload)
-> FramePayload -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ Maybe Priority -> ByteString -> FramePayload
HeadersFrame (Priority -> Maybe Priority
forall a. a -> Maybe a
Just (ByteString -> Priority
priority ByteString
bs0)) ByteString
bs1
            else FramePayload -> Either FrameDecodeError FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either FrameDecodeError FramePayload)
-> FramePayload -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ Maybe Priority -> ByteString -> FramePayload
HeadersFrame Maybe Priority
forall a. Maybe a
Nothing ByteString
bs'

-- | Frame payload decoder for PRIORITY frame.
decodePriorityFrame :: FramePayloadDecoder
decodePriorityFrame :: FramePayloadDecoder
decodePriorityFrame = FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize (FramePayloadDecoder -> FramePayloadDecoder)
-> FramePayloadDecoder -> FramePayloadDecoder
forall a b. (a -> b) -> a -> b
$ Int -> FramePayloadDecoder -> FramePayloadDecoder
requireBytes Int
5 (FramePayloadDecoder -> FramePayloadDecoder)
-> FramePayloadDecoder -> FramePayloadDecoder
forall a b. (a -> b) -> a -> b
$ \FrameHeader
_ ByteString
bs ->
    FramePayload -> Either FrameDecodeError FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either FrameDecodeError FramePayload)
-> FramePayload -> Either FrameDecodeError 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

-- | Frame payload decoder for RST_STREAM frame.
decodeRSTStreamFrame :: FramePayloadDecoder
decodeRSTStreamFrame :: FramePayloadDecoder
decodeRSTStreamFrame = FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize (FramePayloadDecoder -> FramePayloadDecoder)
-> FramePayloadDecoder -> FramePayloadDecoder
forall a b. (a -> b) -> a -> b
$ Int -> FramePayloadDecoder -> FramePayloadDecoder
requireBytes Int
4 (FramePayloadDecoder -> FramePayloadDecoder)
-> FramePayloadDecoder -> FramePayloadDecoder
forall a b. (a -> b) -> a -> b
$ \FrameHeader
_ ByteString
bs ->
    FramePayload -> Either FrameDecodeError FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either FrameDecodeError FramePayload)
-> FramePayload -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ ErrorCode -> FramePayload
RSTStreamFrame (ErrorCode -> FramePayload) -> ErrorCode -> FramePayload
forall a b. (a -> b) -> a -> b
$ Word32 -> ErrorCode
toErrorCode (Word32 -> ErrorCode) -> Word32 -> ErrorCode
forall a b. (a -> b) -> a -> b
$ ByteString -> Word32
N.word32 ByteString
bs

-- | Frame payload decoder for SETTINGS frame.
decodeSettingsFrame :: FramePayloadDecoder
decodeSettingsFrame :: FramePayloadDecoder
decodeSettingsFrame = FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize FramePayloadDecoder
decodeSettingsFrame'

decodeSettingsFrame' :: FramePayloadDecoder
decodeSettingsFrame' :: FramePayloadDecoder
decodeSettingsFrame' FrameHeader{Int
Word8
streamId :: FrameHeader -> Int
flags :: FrameHeader -> Word8
payloadLength :: FrameHeader -> Int
payloadLength :: Int
flags :: Word8
streamId :: Int
..} (PS ForeignPtr Word8
fptr Int
off Int
_)
    | Int
num Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
10 =
        FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. a -> Either a b
Left (FrameDecodeError -> Either FrameDecodeError FramePayload)
-> FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError ErrorCode
EnhanceYourCalm Int
streamId ShortByteString
"Settings is too large"
    | Bool
otherwise = FramePayload -> Either FrameDecodeError FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either FrameDecodeError FramePayload)
-> FramePayload -> Either FrameDecodeError 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 -> ([(SettingsKey, b)] -> c) -> IO c
settings Int
num Ptr Word8
p SettingsList -> SettingsList
forall a. a -> a
id
    settings :: t -> Ptr Word8 -> ([(SettingsKey, b)] -> c) -> IO c
settings t
0 Ptr Word8
_ [(SettingsKey, b)] -> c
builder = c -> IO c
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (c -> IO c) -> c -> IO c
forall a b. (a -> b) -> a -> b
$ [(SettingsKey, b)] -> c
builder []
    settings t
n Ptr Word8
p [(SettingsKey, b)] -> c
builder = do
        Word16
rawSetting <- Ptr Word8 -> Int -> IO Word16
N.peek16 Ptr Word8
p Int
0
        let k :: SettingsKey
k = Word16 -> SettingsKey
toSettingsKey Word16
rawSetting
            n' :: t
n' = t
n t -> t -> t
forall a. Num a => a -> a -> a
- t
1
        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 -> ([(SettingsKey, b)] -> c) -> IO c
settings t
n' (Ptr Word8
p Ptr Word8 -> Int -> Ptr Word8
+. Int
6) ([(SettingsKey, b)] -> c
builder ([(SettingsKey, b)] -> c)
-> ([(SettingsKey, b)] -> [(SettingsKey, b)])
-> [(SettingsKey, b)]
-> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((SettingsKey
k, b
v) (SettingsKey, b) -> [(SettingsKey, b)] -> [(SettingsKey, b)]
forall a. a -> [a] -> [a]
:))

-- | Frame payload decoder for PUSH_PROMISE frame.
decodePushPromiseFrame :: FramePayloadDecoder
decodePushPromiseFrame :: FramePayloadDecoder
decodePushPromiseFrame = FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize (FramePayloadDecoder -> FramePayloadDecoder)
-> FramePayloadDecoder -> FramePayloadDecoder
forall a b. (a -> b) -> a -> b
$ \header :: FrameHeader
header@FrameHeader{Int
streamId :: FrameHeader -> Int
streamId :: Int
streamId} ByteString
bs ->
    FrameHeader
-> ByteString
-> (ByteString -> Either FrameDecodeError FramePayload)
-> Either FrameDecodeError FramePayload
decodeWithPadding FrameHeader
header ByteString
bs ((ByteString -> Either FrameDecodeError FramePayload)
 -> Either FrameDecodeError FramePayload)
-> (ByteString -> Either FrameDecodeError FramePayload)
-> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ \ByteString
bs' ->
        -- As in HEADERS: the padding may cover the promised stream id.
        if ByteString -> Int
BS.length ByteString
bs' Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
4
            then
                FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. a -> Either a b
Left (FrameDecodeError -> Either FrameDecodeError FramePayload)
-> FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$
                    ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError
                        ErrorCode
FrameSizeError
                        Int
streamId
                        ShortByteString
"no room for the promised stream id"
            else
                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 FramePayload -> Either FrameDecodeError FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either FrameDecodeError FramePayload)
-> FramePayload -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> FramePayload
PushPromiseFrame Int
sid ByteString
bs1

-- | Frame payload decoder for PING frame.
decodePingFrame :: FramePayloadDecoder
decodePingFrame :: FramePayloadDecoder
decodePingFrame = FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize (FramePayloadDecoder -> FramePayloadDecoder)
-> FramePayloadDecoder -> FramePayloadDecoder
forall a b. (a -> b) -> a -> b
$ \FrameHeader
_ ByteString
_bs -> FramePayload -> Either FrameDecodeError FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either FrameDecodeError FramePayload)
-> FramePayload -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ ByteString -> FramePayload
PingFrame (ByteString -> FramePayload) -> ByteString -> FramePayload
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.copy ByteString
_bs

-- | Frame payload decoder for GOAWAY frame.
decodeGoAwayFrame :: FramePayloadDecoder
decodeGoAwayFrame :: FramePayloadDecoder
decodeGoAwayFrame = FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize (FramePayloadDecoder -> FramePayloadDecoder)
-> FramePayloadDecoder -> FramePayloadDecoder
forall a b. (a -> b) -> a -> b
$ Int -> FramePayloadDecoder -> FramePayloadDecoder
requireBytes Int
8 FramePayloadDecoder
decodeGoAwayFrame'

decodeGoAwayFrame' :: FramePayloadDecoder
decodeGoAwayFrame' :: FramePayloadDecoder
decodeGoAwayFrame' FrameHeader
_ ByteString
_bs = FramePayload -> Either FrameDecodeError FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either FrameDecodeError FramePayload)
-> FramePayload -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ Int -> ErrorCode -> ByteString -> FramePayload
GoAwayFrame Int
sid ErrorCode
ecid ByteString
bs2
  where
    bs :: ByteString
bs = ByteString -> ByteString
BS.copy ByteString
_bs
    (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 :: ErrorCode
ecid = Word32 -> ErrorCode
toErrorCode (ByteString -> Word32
N.word32 ByteString
bs1)

-- | Frame payload decoder for WINDOW_UPDATE frame.
decodeWindowUpdateFrame :: FramePayloadDecoder
decodeWindowUpdateFrame :: FramePayloadDecoder
decodeWindowUpdateFrame = FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize (FramePayloadDecoder -> FramePayloadDecoder)
-> FramePayloadDecoder -> FramePayloadDecoder
forall a b. (a -> b) -> a -> b
$ Int -> FramePayloadDecoder -> FramePayloadDecoder
requireBytes Int
4 FramePayloadDecoder
decodeWindowUpdateFrame'

decodeWindowUpdateFrame' :: FramePayloadDecoder
decodeWindowUpdateFrame' :: FramePayloadDecoder
decodeWindowUpdateFrame' FrameHeader{Int
Word8
streamId :: FrameHeader -> Int
flags :: FrameHeader -> Word8
payloadLength :: FrameHeader -> Int
payloadLength :: Int
flags :: Word8
streamId :: Int
..} ByteString
bs
    | Int
wsi Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0 =
        FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. a -> Either a b
Left (FrameDecodeError -> Either FrameDecodeError FramePayload)
-> FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError ErrorCode
ProtocolError Int
streamId ShortByteString
"window update must not be 0"
    | Bool
otherwise = FramePayload -> Either FrameDecodeError FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either FrameDecodeError FramePayload)
-> FramePayload -> Either FrameDecodeError 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)

-- | Frame payload decoder for CONTINUATION frame.
decodeContinuationFrame :: FramePayloadDecoder
decodeContinuationFrame :: FramePayloadDecoder
decodeContinuationFrame = FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize (FramePayloadDecoder -> FramePayloadDecoder)
-> FramePayloadDecoder -> FramePayloadDecoder
forall a b. (a -> b) -> a -> b
$ \FrameHeader
_ ByteString
_bs -> FramePayload -> Either FrameDecodeError FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either FrameDecodeError FramePayload)
-> FramePayload -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ ByteString -> FramePayload
ContinuationFrame (ByteString -> FramePayload) -> ByteString -> FramePayload
forall a b. (a -> b) -> a -> b
$ ByteString -> ByteString
BS.copy ByteString
_bs

decodeUnknownFrame :: FrameType -> FramePayloadDecoder
decodeUnknownFrame :: FrameType -> FramePayloadDecoder
decodeUnknownFrame FrameType
typ FrameHeader
_ ByteString
_bs = FramePayload -> Either FrameDecodeError FramePayload
forall a b. b -> Either a b
Right (FramePayload -> Either FrameDecodeError FramePayload)
-> FramePayload -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ FrameType -> ByteString -> FramePayload
UnknownFrame FrameType
typ ByteString
bs
  where
    bs :: ByteString
bs = ByteString -> ByteString
BS.copy ByteString
_bs

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

checkFrameSize :: FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize :: FramePayloadDecoder -> FramePayloadDecoder
checkFrameSize FramePayloadDecoder
func header :: FrameHeader
header@FrameHeader{Int
Word8
streamId :: FrameHeader -> Int
flags :: FrameHeader -> Word8
payloadLength :: FrameHeader -> Int
payloadLength :: Int
flags :: Word8
streamId :: Int
..} ByteString
body
    | Int
payloadLength Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> ByteString -> Int
BS.length ByteString
body =
        FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. a -> Either a b
Left (FrameDecodeError -> Either FrameDecodeError FramePayload)
-> FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError ErrorCode
FrameSizeError Int
streamId ShortByteString
"payload is too short"
    | Bool
otherwise = FramePayloadDecoder
func FrameHeader
header ByteString
body

-- | Require the payload to actually hold the fixed fields about to be read
-- from it.
--
-- The reads below sit at fixed offsets and never consult the length of the
-- 'ByteString' they read from, so a payload shorter than the field runs off
-- the end of the buffer -- and an empty one is the shared empty
-- 'ByteString', whose pointer is null.  'checkFrameHeader' pins these lengths
-- down, but it is a separate function that a caller of the decoders is free
-- not to have used, and 'checkFrameSize' only compares the payload against
-- the length the frame header claims, which may itself be wrong.
requireBytes :: Int -> FramePayloadDecoder -> FramePayloadDecoder
requireBytes :: Int -> FramePayloadDecoder -> FramePayloadDecoder
requireBytes Int
n FramePayloadDecoder
func header :: FrameHeader
header@FrameHeader{Int
streamId :: FrameHeader -> Int
streamId :: Int
streamId} ByteString
body
    | ByteString -> Int
BS.length ByteString
body Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n =
        FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. a -> Either a b
Left (FrameDecodeError -> Either FrameDecodeError FramePayload)
-> FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError ErrorCode
FrameSizeError Int
streamId ShortByteString
"payload is too short"
    | Bool
otherwise = FramePayloadDecoder
func FrameHeader
header ByteString
body

-- | Helper function to pull off the padding if its there, and will
-- eat up the trailing padding automatically. Calls the decoder func
-- passed in with the length of the unpadded portion between the
-- padding octet and the actual padding
decodeWithPadding
    :: FrameHeader
    -> ByteString
    -> (ByteString -> Either FrameDecodeError FramePayload)
    -> Either FrameDecodeError FramePayload
decodeWithPadding :: FrameHeader
-> ByteString
-> (ByteString -> Either FrameDecodeError FramePayload)
-> Either FrameDecodeError FramePayload
decodeWithPadding FrameHeader{Int
Word8
streamId :: FrameHeader -> Int
flags :: FrameHeader -> Word8
payloadLength :: FrameHeader -> Int
payloadLength :: Int
flags :: Word8
streamId :: Int
..} ByteString
bs ByteString -> Either FrameDecodeError FramePayload
body
    | Bool
padded = case ByteString -> Maybe (Word8, ByteString)
BS.uncons ByteString
bs' of
        -- The header checks rule this out for every frame type that can be
        -- padded, but the type does not, and the reply to a payload with no
        -- room for its Pad Length is an error, never a crash.
        Maybe (Word8, ByteString)
Nothing ->
            FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. a -> Either a b
Left (FrameDecodeError -> Either FrameDecodeError FramePayload)
-> FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$
                ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError ErrorCode
FrameSizeError Int
streamId ShortByteString
"insufficient payload for Pad Length"
        Just (Word8
w8, ByteString
rest)
            | Int
bodylen Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
0 ->
                FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. a -> Either a b
Left (FrameDecodeError -> Either FrameDecodeError FramePayload)
-> FrameDecodeError -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ ErrorCode -> Int -> ShortByteString -> FrameDecodeError
FrameDecodeError ErrorCode
ProtocolError Int
streamId ShortByteString
"padding is not enough"
            | Bool
otherwise -> ByteString -> Either FrameDecodeError FramePayload
body (ByteString -> Either FrameDecodeError FramePayload)
-> ByteString -> Either FrameDecodeError FramePayload
forall a b. (a -> b) -> a -> b
$ Int -> ByteString -> ByteString
BS.take Int
bodylen ByteString
rest
          where
            bodylen :: Int
bodylen = Int
payloadLength Int -> Int -> Int
forall a. Num a => a -> a -> a
- Word8 -> Int
intFromWord8 Word8
w8 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1
    | Bool
otherwise = ByteString -> Either FrameDecodeError FramePayload
body ByteString
bs'
  where
    bs' :: ByteString
bs' = ByteString -> ByteString
BS.copy ByteString
bs
    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) -- fixme
    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 a. a -> IO a
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