    {-# 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 Control.Exception (Exception)
    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 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
        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
        typ <- toFrameType <$> N.peek8 p 3
        flg <- N.peek8 p 4
        w32 <- N.peek32 p 5
        let sid = Word32 -> Int
    streamIdentifier Word32
    w32
        return (typ, FrameHeader len flg 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
    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"
        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 = FramePayloadDecoder -> FramePayloadDecoder
    checkFrameSize FramePayloadDecoder
    decoder
      where
        decoder :: FramePayloadDecoder
    decoder = Array FrameType FramePayloadDecoder
    payloadDecoders Array FrameType FramePayloadDecoder
    -> FrameType -> FramePayloadDecoder
    forall i e. Ix i => Array i e -> i -> e
    ! FrameType
    ftyp

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

    -- | Frame payload decoder for DATA frame.
    decodeDataFrame :: FramePayloadDecoder
    decodeDataFrame :: FramePayloadDecoder
    decodeDataFrame FrameHeader
    header ByteString
    bs = FrameHeader
    -> ByteString
    -> (ByteString -> FramePayload)
    -> Either FrameDecodeError FramePayload
    decodeWithPadding FrameHeader
    header ByteString
    bs ByteString -> FramePayload
    DataFrame

    -- | Frame payload decoder for HEADERS frame.
    decodeHeadersFrame :: FramePayloadDecoder
    decodeHeadersFrame :: FramePayloadDecoder
    decodeHeadersFrame FrameHeader
    header ByteString
    bs = FrameHeader
    -> ByteString
    -> (ByteString -> FramePayload)
    -> Either FrameDecodeError FramePayload
    decodeWithPadding FrameHeader
    header ByteString
    bs ((ByteString -> FramePayload)
     -> Either FrameDecodeError FramePayload)
    -> (ByteString -> FramePayload)
    -> Either FrameDecodeError 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

    -- | Frame payload decoder for PRIORITY frame.
    decodePriorityFrame :: FramePayloadDecoder
    decodePriorityFrame :: FramePayloadDecoder
    decodePriorityFrame 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 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 (ByteString -> Word32
    N.word32 ByteString
    bs)

    -- | Frame payload decoder for SETTINGS frame.
    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
            rawSetting <- Ptr Word8 -> Int -> IO Word16
    N.peek16 Ptr Word8
    p Int
    0
            let k = Word16 -> SettingsKey
    toSettingsKey Word16
    rawSetting
                n' = t
    n t -> t -> t
    forall a. Num a => a -> a -> a
    - t
    1
            w32 <- N.peek32 p 2
            let v = Word32 -> b
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    w32
            settings n' (p +. 6) (builder . ((k, v) :))

    -- | Frame payload decoder for PUSH_PROMISE frame.
    decodePushPromiseFrame :: FramePayloadDecoder
    decodePushPromiseFrame :: FramePayloadDecoder
    decodePushPromiseFrame FrameHeader
    header ByteString
    bs = FrameHeader
    -> ByteString
    -> (ByteString -> FramePayload)
    -> Either FrameDecodeError FramePayload
    decodeWithPadding FrameHeader
    header ByteString
    bs ((ByteString -> FramePayload)
     -> Either FrameDecodeError FramePayload)
    -> (ByteString -> FramePayload)
    -> Either FrameDecodeError 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

    -- | Frame payload decoder for PING frame.
    decodePingFrame :: FramePayloadDecoder
    decodePingFrame :: FramePayloadDecoder
    decodePingFrame 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
    bs

    -- | Frame payload decoder for GOAWAY frame.
    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
        (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 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 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
    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

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

    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

    -- | 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 -> FramePayload)
        -> Either FrameDecodeError FramePayload
    decodeWithPadding :: FrameHeader
    -> ByteString
    -> (ByteString -> 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 -> FramePayload
    body
        | Bool
    padded =
            let (Word8
    w8, ByteString
    rest) = (Word8, ByteString)
    -> Maybe (Word8, ByteString) -> (Word8, ByteString)
    forall a. a -> Maybe a -> a
    fromMaybe (String -> (Word8, ByteString)
    forall a. HasCallStack => String -> a
    error String
    "decodeWithPadding") (Maybe (Word8, ByteString) -> (Word8, ByteString))
    -> Maybe (Word8, ByteString) -> (Word8, ByteString)
    forall a b. (a -> b) -> a -> b
    $ 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 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"
                    else 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
    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
        | 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
    $ 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
        w32 <- Ptr Word8 -> Int -> IO Word32
    N.peek32 Ptr Word8
    p Int
    0
        let streamdId = Word32 -> Int
    streamIdentifier Word32
    w32
            exclusive = Int -> Bool
    testExclusive (Word32 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral Word32
    w32) -- fixme
        w8 <- N.peek8 p 4
        let weight = Word8 -> Int
    intFromWord8 Word8
    w8 Int -> Int -> Int
    forall a. Num a => a -> a -> a
    + Int
    1
        return $ Priority exclusive streamdId weight

    intFromWord8 :: Word8 -> Int
    intFromWord8 :: Word8 -> Int
    intFromWord8 = Word8 -> Int
    forall a b. (Integral a, Num b) => a -> b
    fromIntegral