{-# LANGUAGE DeriveDataTypeable #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}

module Network.HTTP2.Frame.Types where

import Data.Ix
import Text.Read
import qualified Text.Read.Lex as L

import Imports

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

-- | The length of HTTP/2 frame header.
--
-- >>> frameHeaderLength
-- 9
frameHeaderLength :: Int
frameHeaderLength :: StreamId
frameHeaderLength = StreamId
9

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

-- | The type for raw error code.
newtype ErrorCode = ErrorCode Word32 deriving (ErrorCode -> ErrorCode -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ErrorCode -> ErrorCode -> Bool
$c/= :: ErrorCode -> ErrorCode -> Bool
== :: ErrorCode -> ErrorCode -> Bool
$c== :: ErrorCode -> ErrorCode -> Bool
Eq, Eq ErrorCode
ErrorCode -> ErrorCode -> Bool
ErrorCode -> ErrorCode -> Ordering
ErrorCode -> ErrorCode -> ErrorCode
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: ErrorCode -> ErrorCode -> ErrorCode
$cmin :: ErrorCode -> ErrorCode -> ErrorCode
max :: ErrorCode -> ErrorCode -> ErrorCode
$cmax :: ErrorCode -> ErrorCode -> ErrorCode
>= :: ErrorCode -> ErrorCode -> Bool
$c>= :: ErrorCode -> ErrorCode -> Bool
> :: ErrorCode -> ErrorCode -> Bool
$c> :: ErrorCode -> ErrorCode -> Bool
<= :: ErrorCode -> ErrorCode -> Bool
$c<= :: ErrorCode -> ErrorCode -> Bool
< :: ErrorCode -> ErrorCode -> Bool
$c< :: ErrorCode -> ErrorCode -> Bool
compare :: ErrorCode -> ErrorCode -> Ordering
$ccompare :: ErrorCode -> ErrorCode -> Ordering
Ord, ReadPrec [ErrorCode]
ReadPrec ErrorCode
StreamId -> ReadS ErrorCode
ReadS [ErrorCode]
forall a.
(StreamId -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ErrorCode]
$creadListPrec :: ReadPrec [ErrorCode]
readPrec :: ReadPrec ErrorCode
$creadPrec :: ReadPrec ErrorCode
readList :: ReadS [ErrorCode]
$creadList :: ReadS [ErrorCode]
readsPrec :: StreamId -> ReadS ErrorCode
$creadsPrec :: StreamId -> ReadS ErrorCode
Read)

fromErrorCode :: ErrorCode -> Word32
fromErrorCode :: ErrorCode -> Word32
fromErrorCode (ErrorCode Word32
w) = Word32
w

toErrorCode :: Word32 -> ErrorCode
toErrorCode :: Word32 -> ErrorCode
toErrorCode = Word32 -> ErrorCode
ErrorCode

-- | The type for error code. See <https://www.rfc-editor.org/rfc/rfc9113#ErrorCodes>.

pattern NoError            :: ErrorCode
pattern $bNoError :: ErrorCode
$mNoError :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
NoError             = ErrorCode 0x0

pattern ProtocolError      :: ErrorCode
pattern $bProtocolError :: ErrorCode
$mProtocolError :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
ProtocolError       = ErrorCode 0x1

pattern InternalError      :: ErrorCode
pattern $bInternalError :: ErrorCode
$mInternalError :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
InternalError       = ErrorCode 0x2

pattern FlowControlError   :: ErrorCode
pattern $bFlowControlError :: ErrorCode
$mFlowControlError :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
FlowControlError    = ErrorCode 0x3

pattern SettingsTimeout    :: ErrorCode
pattern $bSettingsTimeout :: ErrorCode
$mSettingsTimeout :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
SettingsTimeout     = ErrorCode 0x4

pattern StreamClosed       :: ErrorCode
pattern $bStreamClosed :: ErrorCode
$mStreamClosed :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
StreamClosed        = ErrorCode 0x5

pattern FrameSizeError     :: ErrorCode
pattern $bFrameSizeError :: ErrorCode
$mFrameSizeError :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
FrameSizeError      = ErrorCode 0x6

pattern RefusedStream      :: ErrorCode
pattern $bRefusedStream :: ErrorCode
$mRefusedStream :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
RefusedStream       = ErrorCode 0x7

pattern Cancel             :: ErrorCode
pattern $bCancel :: ErrorCode
$mCancel :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
Cancel              = ErrorCode 0x8

pattern CompressionError   :: ErrorCode
pattern $bCompressionError :: ErrorCode
$mCompressionError :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
CompressionError    = ErrorCode 0x9

pattern ConnectError       :: ErrorCode
pattern $bConnectError :: ErrorCode
$mConnectError :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
ConnectError        = ErrorCode 0xa

pattern EnhanceYourCalm    :: ErrorCode
pattern $bEnhanceYourCalm :: ErrorCode
$mEnhanceYourCalm :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
EnhanceYourCalm     = ErrorCode 0xb

pattern InadequateSecurity :: ErrorCode
pattern $bInadequateSecurity :: ErrorCode
$mInadequateSecurity :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
InadequateSecurity  = ErrorCode 0xc

pattern HTTP11Required     :: ErrorCode
pattern $bHTTP11Required :: ErrorCode
$mHTTP11Required :: forall {r}. ErrorCode -> ((# #) -> r) -> ((# #) -> r) -> r
HTTP11Required      = ErrorCode 0xd

instance Show ErrorCode where
    show :: ErrorCode -> String
show (ErrorCode Word32
0x0) = String
"NoError"
    show (ErrorCode Word32
0x1) = String
"ProtocolError"
    show (ErrorCode Word32
0x2) = String
"InternalError"
    show (ErrorCode Word32
0x3) = String
"FlowControlError"
    show (ErrorCode Word32
0x4) = String
"SettingsTimeout"
    show (ErrorCode Word32
0x5) = String
"StreamClosed"
    show (ErrorCode Word32
0x6) = String
"FrameSizeError"
    show (ErrorCode Word32
0x7) = String
"RefusedStream"
    show (ErrorCode Word32
0x8) = String
"Cancel"
    show (ErrorCode Word32
0x9) = String
"CompressionError"
    show (ErrorCode Word32
0xa) = String
"ConnectError"
    show (ErrorCode Word32
0xb) = String
"EnhanceYourCalm"
    show (ErrorCode Word32
0xc) = String
"InadequateSecurity"
    show (ErrorCode Word32
0xd) = String
"HTTP11Required"
    show (ErrorCode   Word32
x) = String
"ErrorCode " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word32
x

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

-- | The type for SETTINGS key.
newtype SettingsKey = SettingsKey Word16 deriving (SettingsKey -> SettingsKey -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SettingsKey -> SettingsKey -> Bool
$c/= :: SettingsKey -> SettingsKey -> Bool
== :: SettingsKey -> SettingsKey -> Bool
$c== :: SettingsKey -> SettingsKey -> Bool
Eq, Eq SettingsKey
SettingsKey -> SettingsKey -> Bool
SettingsKey -> SettingsKey -> Ordering
SettingsKey -> SettingsKey -> SettingsKey
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: SettingsKey -> SettingsKey -> SettingsKey
$cmin :: SettingsKey -> SettingsKey -> SettingsKey
max :: SettingsKey -> SettingsKey -> SettingsKey
$cmax :: SettingsKey -> SettingsKey -> SettingsKey
>= :: SettingsKey -> SettingsKey -> Bool
$c>= :: SettingsKey -> SettingsKey -> Bool
> :: SettingsKey -> SettingsKey -> Bool
$c> :: SettingsKey -> SettingsKey -> Bool
<= :: SettingsKey -> SettingsKey -> Bool
$c<= :: SettingsKey -> SettingsKey -> Bool
< :: SettingsKey -> SettingsKey -> Bool
$c< :: SettingsKey -> SettingsKey -> Bool
compare :: SettingsKey -> SettingsKey -> Ordering
$ccompare :: SettingsKey -> SettingsKey -> Ordering
Ord)

fromSettingsKey :: SettingsKey -> Word16
fromSettingsKey :: SettingsKey -> Word16
fromSettingsKey (SettingsKey Word16
x) = Word16
x

toSettingsKey :: Word16 -> SettingsKey
toSettingsKey :: Word16 -> SettingsKey
toSettingsKey = Word16 -> SettingsKey
SettingsKey

minSettingsKey :: SettingsKey
minSettingsKey :: SettingsKey
minSettingsKey = Word16 -> SettingsKey
SettingsKey Word16
1

maxSettingsKey :: SettingsKey
maxSettingsKey :: SettingsKey
maxSettingsKey = Word16 -> SettingsKey
SettingsKey Word16
6

pattern SettingsHeaderTableSize      :: SettingsKey
pattern $bSettingsHeaderTableSize :: SettingsKey
$mSettingsHeaderTableSize :: forall {r}. SettingsKey -> ((# #) -> r) -> ((# #) -> r) -> r
SettingsHeaderTableSize       = SettingsKey 1

pattern SettingsEnablePush           :: SettingsKey
pattern $bSettingsEnablePush :: SettingsKey
$mSettingsEnablePush :: forall {r}. SettingsKey -> ((# #) -> r) -> ((# #) -> r) -> r
SettingsEnablePush            = SettingsKey 2

pattern SettingsMaxConcurrentStreams :: SettingsKey
pattern $bSettingsMaxConcurrentStreams :: SettingsKey
$mSettingsMaxConcurrentStreams :: forall {r}. SettingsKey -> ((# #) -> r) -> ((# #) -> r) -> r
SettingsMaxConcurrentStreams  = SettingsKey 3

pattern SettingsInitialWindowSize    :: SettingsKey
pattern $bSettingsInitialWindowSize :: SettingsKey
$mSettingsInitialWindowSize :: forall {r}. SettingsKey -> ((# #) -> r) -> ((# #) -> r) -> r
SettingsInitialWindowSize     = SettingsKey 4

pattern SettingsMaxFrameSize         :: SettingsKey
pattern $bSettingsMaxFrameSize :: SettingsKey
$mSettingsMaxFrameSize :: forall {r}. SettingsKey -> ((# #) -> r) -> ((# #) -> r) -> r
SettingsMaxFrameSize          = SettingsKey 5 -- this means payload size

pattern SettingsMaxHeaderBlockSize   :: SettingsKey
pattern $bSettingsMaxHeaderBlockSize :: SettingsKey
$mSettingsMaxHeaderBlockSize :: forall {r}. SettingsKey -> ((# #) -> r) -> ((# #) -> r) -> r
SettingsMaxHeaderBlockSize    = SettingsKey 6

instance Show SettingsKey where
    show :: SettingsKey -> String
show SettingsKey
SettingsHeaderTableSize      = String
"SettingsHeaderTableSize"
    show SettingsKey
SettingsEnablePush           = String
"SettingsEnablePush"
    show SettingsKey
SettingsMaxConcurrentStreams = String
"SettingsMaxConcurrentStreams"
    show SettingsKey
SettingsInitialWindowSize    = String
"SettingsInitialWindowSize"
    show SettingsKey
SettingsMaxFrameSize         = String
"SettingsMaxFrameSize"
    show SettingsKey
SettingsMaxHeaderBlockSize   = String
"SettingsMaxHeaderBlockSize"
    show (SettingsKey Word16
x)              = String
"SettingsKey " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word16
x

instance Read SettingsKey where
    readListPrec :: ReadPrec [SettingsKey]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault
    readPrec :: ReadPrec SettingsKey
readPrec = do
        Ident String
idnt <- ReadPrec Lexeme
lexP
        forall {a}. (Eq a, IsString a) => a -> ReadPrec SettingsKey
readSK String
idnt
      where
        readSK :: a -> ReadPrec SettingsKey
readSK a
"SettingsHeaderTableSize"      = forall (m :: * -> *) a. Monad m => a -> m a
return SettingsKey
SettingsHeaderTableSize
        readSK a
"SettingsEnablePush"           = forall (m :: * -> *) a. Monad m => a -> m a
return SettingsKey
SettingsEnablePush
        readSK a
"SettingsMaxConcurrentStreams" = forall (m :: * -> *) a. Monad m => a -> m a
return SettingsKey
SettingsMaxConcurrentStreams
        readSK a
"SettingsInitialWindowSize"    = forall (m :: * -> *) a. Monad m => a -> m a
return SettingsKey
SettingsInitialWindowSize
        readSK a
"SettingsMaxFrameSize"         = forall (m :: * -> *) a. Monad m => a -> m a
return SettingsKey
SettingsMaxFrameSize
        readSK a
"SettingsMaxHeaderBlockSize"   = forall (m :: * -> *) a. Monad m => a -> m a
return SettingsKey
SettingsMaxHeaderBlockSize
        readSK a
"SettingsKey"         = do
              Number Number
ftyp <- ReadPrec Lexeme
lexP
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Word16 -> SettingsKey
SettingsKey forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Number -> Maybe Integer
L.numberToInteger Number
ftyp
        readSK a
_                   = forall a. HasCallStack => String -> a
error String
"Read for SettingsKey"

-- | The type for raw SETTINGS value.
type SettingsValue = Int -- Word32

-- | Association list of SETTINGS.
type SettingsList = [(SettingsKey,SettingsValue)]

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

-- | Cooked version of settings. This is suitable to be stored in a HTTP/2 context.
data Settings = Settings {
    Settings -> StreamId
headerTableSize :: Int
  , Settings -> Bool
enablePush :: Bool
  , Settings -> Maybe StreamId
maxConcurrentStreams :: Maybe Int
  , Settings -> StreamId
initialWindowSize :: WindowSize
  , Settings -> StreamId
maxFrameSize :: Int
  , Settings -> Maybe StreamId
maxHeaderListSize :: Maybe Int
  } deriving (StreamId -> Settings -> ShowS
[Settings] -> ShowS
Settings -> String
forall a.
(StreamId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Settings] -> ShowS
$cshowList :: [Settings] -> ShowS
show :: Settings -> String
$cshow :: Settings -> String
showsPrec :: StreamId -> Settings -> ShowS
$cshowsPrec :: StreamId -> Settings -> ShowS
Show)

-- | The default settings.
--
-- >>> defaultSettings
-- Settings {headerTableSize = 4096, enablePush = True, maxConcurrentStreams = Nothing, initialWindowSize = 65535, maxFrameSize = 16384, maxHeaderListSize = Nothing}
defaultSettings :: Settings
defaultSettings :: Settings
defaultSettings = Settings {
    headerTableSize :: StreamId
headerTableSize = StreamId
4096 -- defaultDynamicTableSize
  , enablePush :: Bool
enablePush = Bool
True
  , maxConcurrentStreams :: Maybe StreamId
maxConcurrentStreams = forall a. Maybe a
Nothing
  , initialWindowSize :: StreamId
initialWindowSize = StreamId
defaultWindowSize
  , maxFrameSize :: StreamId
maxFrameSize = StreamId
defaultPayloadLength
  , maxHeaderListSize :: Maybe StreamId
maxHeaderListSize = forall a. Maybe a
Nothing
  }

-- | Updating settings.
--
-- >>> updateSettings defaultSettings [(SettingsEnablePush,0),(SettingsMaxHeaderBlockSize,200)]
-- Settings {headerTableSize = 4096, enablePush = False, maxConcurrentStreams = Nothing, initialWindowSize = 65535, maxFrameSize = 16384, maxHeaderListSize = Just 200}
updateSettings :: Settings -> SettingsList -> Settings
updateSettings :: Settings -> SettingsList -> Settings
updateSettings Settings
settings SettingsList
kvs = forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Settings -> (SettingsKey, StreamId) -> Settings
update Settings
settings SettingsList
kvs
  where
    update :: Settings -> (SettingsKey, StreamId) -> Settings
update Settings
def (SettingsKey
SettingsHeaderTableSize,StreamId
x)      = Settings
def { headerTableSize :: StreamId
headerTableSize = StreamId
x }
    -- fixme: x should be 0 or 1
    update Settings
def (SettingsKey
SettingsEnablePush,StreamId
x)           = Settings
def { enablePush :: Bool
enablePush = StreamId
x forall a. Ord a => a -> a -> Bool
> StreamId
0 }
    update Settings
def (SettingsKey
SettingsMaxConcurrentStreams,StreamId
x) = Settings
def { maxConcurrentStreams :: Maybe StreamId
maxConcurrentStreams = forall a. a -> Maybe a
Just StreamId
x }
    update Settings
def (SettingsKey
SettingsInitialWindowSize,StreamId
x)    = Settings
def { initialWindowSize :: StreamId
initialWindowSize = StreamId
x }
    update Settings
def (SettingsKey
SettingsMaxFrameSize,StreamId
x)         = Settings
def { maxFrameSize :: StreamId
maxFrameSize = StreamId
x }
    update Settings
def (SettingsKey
SettingsMaxHeaderBlockSize,StreamId
x)   = Settings
def { maxHeaderListSize :: Maybe StreamId
maxHeaderListSize = forall a. a -> Maybe a
Just StreamId
x }
    update Settings
def (SettingsKey, StreamId)
_                                = Settings
def

-- | The type for window size.
type WindowSize = Int

-- | The default initial window size.
--
-- >>> defaultWindowSize
-- 65535
defaultWindowSize :: WindowSize
defaultWindowSize :: StreamId
defaultWindowSize = StreamId
65535

-- | The maximum window size.
--
-- >>> maxWindowSize
-- 2147483647
maxWindowSize :: WindowSize
maxWindowSize :: StreamId
maxWindowSize = StreamId
2147483647

-- | Checking if a window size exceeds the maximum window size.
--
-- >>> isWindowOverflow 10
-- False
-- >>> isWindowOverflow maxWindowSize
-- False
-- >>> isWindowOverflow (maxWindowSize + 1)
-- True
isWindowOverflow :: WindowSize -> Bool
isWindowOverflow :: StreamId -> Bool
isWindowOverflow StreamId
w = forall a. Bits a => a -> StreamId -> Bool
testBit StreamId
w StreamId
31


-- | Default concurrency.
--
-- >>> recommendedConcurrency
-- 100
recommendedConcurrency :: Int
recommendedConcurrency :: StreamId
recommendedConcurrency = StreamId
100

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

-- | The type for weight in priority. Its values are from 1 to 256.
--   Deprecated in RFC 9113.
type Weight = Int

-- | Type for stream priority. Deprecated in RFC 9113 but provided for 'FrameHeaders'.
data Priority = Priority {
    Priority -> Bool
exclusive :: Bool
  , Priority -> StreamId
streamDependency :: StreamId
  , Priority -> StreamId
weight :: Weight
  } deriving (StreamId -> Priority -> ShowS
[Priority] -> ShowS
Priority -> String
forall a.
(StreamId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Priority] -> ShowS
$cshowList :: [Priority] -> ShowS
show :: Priority -> String
$cshow :: Priority -> String
showsPrec :: StreamId -> Priority -> ShowS
$cshowsPrec :: StreamId -> Priority -> ShowS
Show, ReadPrec [Priority]
ReadPrec Priority
StreamId -> ReadS Priority
ReadS [Priority]
forall a.
(StreamId -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Priority]
$creadListPrec :: ReadPrec [Priority]
readPrec :: ReadPrec Priority
$creadPrec :: ReadPrec Priority
readList :: ReadS [Priority]
$creadList :: ReadS [Priority]
readsPrec :: StreamId -> ReadS Priority
$creadsPrec :: StreamId -> ReadS Priority
Read, Priority -> Priority -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Priority -> Priority -> Bool
$c/= :: Priority -> Priority -> Bool
== :: Priority -> Priority -> Bool
$c== :: Priority -> Priority -> Bool
Eq)

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

-- | The type for raw frame type.
newtype FrameType = FrameType Word8 deriving (FrameType -> FrameType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrameType -> FrameType -> Bool
$c/= :: FrameType -> FrameType -> Bool
== :: FrameType -> FrameType -> Bool
$c== :: FrameType -> FrameType -> Bool
Eq, Eq FrameType
FrameType -> FrameType -> Bool
FrameType -> FrameType -> Ordering
FrameType -> FrameType -> FrameType
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
min :: FrameType -> FrameType -> FrameType
$cmin :: FrameType -> FrameType -> FrameType
max :: FrameType -> FrameType -> FrameType
$cmax :: FrameType -> FrameType -> FrameType
>= :: FrameType -> FrameType -> Bool
$c>= :: FrameType -> FrameType -> Bool
> :: FrameType -> FrameType -> Bool
$c> :: FrameType -> FrameType -> Bool
<= :: FrameType -> FrameType -> Bool
$c<= :: FrameType -> FrameType -> Bool
< :: FrameType -> FrameType -> Bool
$c< :: FrameType -> FrameType -> Bool
compare :: FrameType -> FrameType -> Ordering
$ccompare :: FrameType -> FrameType -> Ordering
Ord, Ord FrameType
(FrameType, FrameType) -> StreamId
(FrameType, FrameType) -> [FrameType]
(FrameType, FrameType) -> FrameType -> Bool
(FrameType, FrameType) -> FrameType -> StreamId
forall a.
Ord a
-> ((a, a) -> [a])
-> ((a, a) -> a -> StreamId)
-> ((a, a) -> a -> StreamId)
-> ((a, a) -> a -> Bool)
-> ((a, a) -> StreamId)
-> ((a, a) -> StreamId)
-> Ix a
unsafeRangeSize :: (FrameType, FrameType) -> StreamId
$cunsafeRangeSize :: (FrameType, FrameType) -> StreamId
rangeSize :: (FrameType, FrameType) -> StreamId
$crangeSize :: (FrameType, FrameType) -> StreamId
inRange :: (FrameType, FrameType) -> FrameType -> Bool
$cinRange :: (FrameType, FrameType) -> FrameType -> Bool
unsafeIndex :: (FrameType, FrameType) -> FrameType -> StreamId
$cunsafeIndex :: (FrameType, FrameType) -> FrameType -> StreamId
index :: (FrameType, FrameType) -> FrameType -> StreamId
$cindex :: (FrameType, FrameType) -> FrameType -> StreamId
range :: (FrameType, FrameType) -> [FrameType]
$crange :: (FrameType, FrameType) -> [FrameType]
Ix)

-- | Converting 'FrameType' to 'Word8'.
--
-- >>> fromFrameType FrameData
-- 0
-- >>> fromFrameType FrameContinuation
-- 9
fromFrameType :: FrameType -> Word8
fromFrameType :: FrameType -> FrameFlags
fromFrameType (FrameType FrameFlags
x) = FrameFlags
x

toFrameType :: Word8 -> FrameType
toFrameType :: FrameFlags -> FrameType
toFrameType = FrameFlags -> FrameType
FrameType

minFrameType :: FrameType
minFrameType :: FrameType
minFrameType = FrameFlags -> FrameType
FrameType FrameFlags
0

maxFrameType :: FrameType
maxFrameType :: FrameType
maxFrameType = FrameFlags -> FrameType
FrameType FrameFlags
9

pattern FrameData         :: FrameType
pattern $bFrameData :: FrameType
$mFrameData :: forall {r}. FrameType -> ((# #) -> r) -> ((# #) -> r) -> r
FrameData          = FrameType 0

pattern FrameHeaders      :: FrameType
pattern $bFrameHeaders :: FrameType
$mFrameHeaders :: forall {r}. FrameType -> ((# #) -> r) -> ((# #) -> r) -> r
FrameHeaders       = FrameType 1

pattern FramePriority     :: FrameType
pattern $bFramePriority :: FrameType
$mFramePriority :: forall {r}. FrameType -> ((# #) -> r) -> ((# #) -> r) -> r
FramePriority      = FrameType 2

pattern FrameRSTStream    :: FrameType
pattern $bFrameRSTStream :: FrameType
$mFrameRSTStream :: forall {r}. FrameType -> ((# #) -> r) -> ((# #) -> r) -> r
FrameRSTStream     = FrameType 3

pattern FrameSettings     :: FrameType
pattern $bFrameSettings :: FrameType
$mFrameSettings :: forall {r}. FrameType -> ((# #) -> r) -> ((# #) -> r) -> r
FrameSettings      = FrameType 4

pattern FramePushPromise  :: FrameType
pattern $bFramePushPromise :: FrameType
$mFramePushPromise :: forall {r}. FrameType -> ((# #) -> r) -> ((# #) -> r) -> r
FramePushPromise   = FrameType 5

pattern FramePing         :: FrameType
pattern $bFramePing :: FrameType
$mFramePing :: forall {r}. FrameType -> ((# #) -> r) -> ((# #) -> r) -> r
FramePing          = FrameType 6

pattern FrameGoAway       :: FrameType
pattern $bFrameGoAway :: FrameType
$mFrameGoAway :: forall {r}. FrameType -> ((# #) -> r) -> ((# #) -> r) -> r
FrameGoAway        = FrameType 7

pattern FrameWindowUpdate :: FrameType
pattern $bFrameWindowUpdate :: FrameType
$mFrameWindowUpdate :: forall {r}. FrameType -> ((# #) -> r) -> ((# #) -> r) -> r
FrameWindowUpdate  = FrameType 8

pattern FrameContinuation :: FrameType
pattern $bFrameContinuation :: FrameType
$mFrameContinuation :: forall {r}. FrameType -> ((# #) -> r) -> ((# #) -> r) -> r
FrameContinuation  = FrameType 9

instance Show FrameType where
    show :: FrameType -> String
show (FrameType FrameFlags
0) = String
"FrameData"
    show (FrameType FrameFlags
1) = String
"FrameHeaders"
    show (FrameType FrameFlags
2) = String
"FramePriority"
    show (FrameType FrameFlags
3) = String
"FrameRSTStream"
    show (FrameType FrameFlags
4) = String
"FrameSettings"
    show (FrameType FrameFlags
5) = String
"FramePushPromise"
    show (FrameType FrameFlags
6) = String
"FramePing"
    show (FrameType FrameFlags
7) = String
"FrameGoAway"
    show (FrameType FrameFlags
8) = String
"FrameWindowUpdate"
    show (FrameType FrameFlags
9) = String
"FrameContinuation"
    show (FrameType FrameFlags
x) = String
"FrameType " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show FrameFlags
x

instance Read FrameType where
    readListPrec :: ReadPrec [FrameType]
readListPrec = forall a. Read a => ReadPrec [a]
readListPrecDefault
    readPrec :: ReadPrec FrameType
readPrec = do
        Ident String
idnt <- ReadPrec Lexeme
lexP
        forall {a}. (Eq a, IsString a) => a -> ReadPrec FrameType
readFT String
idnt
      where
        readFT :: a -> ReadPrec FrameType
readFT a
"FrameData"         = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
FrameData
        readFT a
"FrameHeaders"      = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
FrameHeaders
        readFT a
"FramePriority"     = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
FramePriority
        readFT a
"FrameRSTStream"    = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
FrameRSTStream
        readFT a
"FrameSettings"     = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
FrameSettings
        readFT a
"FramePushPromise"  = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
FramePushPromise
        readFT a
"FramePing"         = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
FramePing
        readFT a
"FrameGoAway"       = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
FrameGoAway
        readFT a
"FrameWindowUpdate" = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
FrameWindowUpdate
        readFT a
"FrameContinuation" = forall (m :: * -> *) a. Monad m => a -> m a
return FrameType
FrameContinuation
        readFT a
"FrameType"         = do
              Number Number
ftyp <- ReadPrec Lexeme
lexP
              forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ FrameFlags -> FrameType
FrameType forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral forall a b. (a -> b) -> a -> b
$ forall a. HasCallStack => Maybe a -> a
fromJust forall a b. (a -> b) -> a -> b
$ Number -> Maybe Integer
L.numberToInteger Number
ftyp
        readFT a
_                   = forall a. HasCallStack => String -> a
error String
"Read for FrameType"

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

-- | The maximum payload length of HTTP/2 payload.
--
-- >>> maxPayloadLength
-- 16777215
maxPayloadLength :: Int
maxPayloadLength :: StreamId
maxPayloadLength = StreamId
2forall a b. (Num a, Integral b) => a -> b -> a
^(StreamId
24::Int) forall a. Num a => a -> a -> a
- StreamId
1

-- | The default payload length of HTTP/2 payload.
--
-- >>> defaultPayloadLength
-- 16384
defaultPayloadLength :: Int
defaultPayloadLength :: StreamId
defaultPayloadLength = StreamId
2forall a b. (Num a, Integral b) => a -> b -> a
^(StreamId
14::Int)

----------------------------------------------------------------
-- Flags

-- | The type for flags.
type FrameFlags = Word8

-- | The initial value of flags. No flags are set.
--
-- >>> defaultFlags
-- 0
defaultFlags :: FrameFlags
defaultFlags :: FrameFlags
defaultFlags = FrameFlags
0

-- | Checking if the END_STREAM flag is set.
-- >>> testEndStream 0x1
-- True
testEndStream :: FrameFlags -> Bool
testEndStream :: FrameFlags -> Bool
testEndStream FrameFlags
x = FrameFlags
x forall a. Bits a => a -> StreamId -> Bool
`testBit` StreamId
0

-- | Checking if the ACK flag is set.
-- >>> testAck 0x1
-- True
testAck :: FrameFlags -> Bool
testAck :: FrameFlags -> Bool
testAck FrameFlags
x = FrameFlags
x forall a. Bits a => a -> StreamId -> Bool
`testBit` StreamId
0 -- fixme: is the spec intentional?

-- | Checking if the END_HEADERS flag is set.
--
-- >>> testEndHeader 0x4
-- True
testEndHeader :: FrameFlags -> Bool
testEndHeader :: FrameFlags -> Bool
testEndHeader FrameFlags
x = FrameFlags
x forall a. Bits a => a -> StreamId -> Bool
`testBit` StreamId
2

-- | Checking if the PADDED flag is set.
--
-- >>> testPadded 0x8
-- True
testPadded :: FrameFlags -> Bool
testPadded :: FrameFlags -> Bool
testPadded FrameFlags
x = FrameFlags
x forall a. Bits a => a -> StreamId -> Bool
`testBit` StreamId
3

-- | Checking if the PRIORITY flag is set.
--
-- >>> testPriority 0x20
-- True
testPriority :: FrameFlags -> Bool
testPriority :: FrameFlags -> Bool
testPriority FrameFlags
x = FrameFlags
x forall a. Bits a => a -> StreamId -> Bool
`testBit` StreamId
5

-- | Setting the END_STREAM flag.
--
-- >>> setEndStream 0
-- 1
setEndStream :: FrameFlags -> FrameFlags
setEndStream :: FrameFlags -> FrameFlags
setEndStream FrameFlags
x = FrameFlags
x forall a. Bits a => a -> StreamId -> a
`setBit` StreamId
0

-- | Setting the ACK flag.
--
-- >>> setAck 0
-- 1
setAck :: FrameFlags -> FrameFlags
setAck :: FrameFlags -> FrameFlags
setAck FrameFlags
x = FrameFlags
x forall a. Bits a => a -> StreamId -> a
`setBit` StreamId
0 -- fixme: is the spec intentional?

-- | Setting the END_HEADERS flag.
--
-- >>> setEndHeader 0
-- 4
setEndHeader :: FrameFlags -> FrameFlags
setEndHeader :: FrameFlags -> FrameFlags
setEndHeader FrameFlags
x = FrameFlags
x forall a. Bits a => a -> StreamId -> a
`setBit` StreamId
2

-- | Setting the PADDED flag.
--
-- >>> setPadded 0
-- 8
setPadded :: FrameFlags -> FrameFlags
setPadded :: FrameFlags -> FrameFlags
setPadded FrameFlags
x = FrameFlags
x forall a. Bits a => a -> StreamId -> a
`setBit` StreamId
3

-- | Setting the PRIORITY flag.
--
-- >>> setPriority 0
-- 32
setPriority :: FrameFlags -> FrameFlags
setPriority :: FrameFlags -> FrameFlags
setPriority FrameFlags
x = FrameFlags
x forall a. Bits a => a -> StreamId -> a
`setBit` StreamId
5

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

-- | The type for stream identifier
type StreamId = Int

-- | Checking if the stream identifier for control.
--
-- >>> isControl 0
-- True
-- >>> isControl 1
-- False
isControl :: StreamId -> Bool
isControl :: StreamId -> Bool
isControl StreamId
0 = Bool
True
isControl StreamId
_ = Bool
False

-- | Checking if the stream identifier is from a client.
--
-- >>> isClientInitiated 0
-- False
-- >>> isClientInitiated 1
-- True
isClientInitiated :: StreamId -> Bool
isClientInitiated :: StreamId -> Bool
isClientInitiated = forall a. Integral a => a -> Bool
odd

-- | Checking if the stream identifier is from a server.
--
-- >>> isServerInitiated 0
-- False
-- >>> isServerInitiated 2
-- True
isServerInitiated :: StreamId -> Bool
isServerInitiated :: StreamId -> Bool
isServerInitiated StreamId
0 = Bool
False
isServerInitiated StreamId
n = forall a. Integral a => a -> Bool
even StreamId
n

-- | Checking if the exclusive flag is set.
testExclusive :: StreamId -> Bool
testExclusive :: StreamId -> Bool
testExclusive StreamId
n = StreamId
n forall a. Bits a => a -> StreamId -> Bool
`testBit` StreamId
31

-- | Setting the exclusive flag.
setExclusive :: StreamId -> StreamId
setExclusive :: StreamId -> StreamId
setExclusive StreamId
n = StreamId
n forall a. Bits a => a -> StreamId -> a
`setBit` StreamId
31

-- | Clearing the exclusive flag.
clearExclusive :: StreamId -> StreamId
clearExclusive :: StreamId -> StreamId
clearExclusive StreamId
n = StreamId
n forall a. Bits a => a -> StreamId -> a
`clearBit` StreamId
31

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

-- | The type for fragments of a header encoded with HPACK.
type HeaderBlockFragment = ByteString

-- | The type for padding in payloads.
type Padding = ByteString

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

-- | The data type for HTTP/2 frames.
data Frame = Frame
    { Frame -> FrameHeader
frameHeader  :: FrameHeader
    , Frame -> FramePayload
framePayload :: FramePayload
    } deriving (StreamId -> Frame -> ShowS
[Frame] -> ShowS
Frame -> String
forall a.
(StreamId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Frame] -> ShowS
$cshowList :: [Frame] -> ShowS
show :: Frame -> String
$cshow :: Frame -> String
showsPrec :: StreamId -> Frame -> ShowS
$cshowsPrec :: StreamId -> Frame -> ShowS
Show, ReadPrec [Frame]
ReadPrec Frame
StreamId -> ReadS Frame
ReadS [Frame]
forall a.
(StreamId -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Frame]
$creadListPrec :: ReadPrec [Frame]
readPrec :: ReadPrec Frame
$creadPrec :: ReadPrec Frame
readList :: ReadS [Frame]
$creadList :: ReadS [Frame]
readsPrec :: StreamId -> ReadS Frame
$creadsPrec :: StreamId -> ReadS Frame
Read, Frame -> Frame -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Frame -> Frame -> Bool
$c/= :: Frame -> Frame -> Bool
== :: Frame -> Frame -> Bool
$c== :: Frame -> Frame -> Bool
Eq)

-- | The data type for HTTP/2 frame headers.
data FrameHeader = FrameHeader
    { FrameHeader -> StreamId
payloadLength :: Int
    , FrameHeader -> FrameFlags
flags         :: FrameFlags
    , FrameHeader -> StreamId
streamId      :: StreamId
    } deriving (StreamId -> FrameHeader -> ShowS
[FrameHeader] -> ShowS
FrameHeader -> String
forall a.
(StreamId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FrameHeader] -> ShowS
$cshowList :: [FrameHeader] -> ShowS
show :: FrameHeader -> String
$cshow :: FrameHeader -> String
showsPrec :: StreamId -> FrameHeader -> ShowS
$cshowsPrec :: StreamId -> FrameHeader -> ShowS
Show, ReadPrec [FrameHeader]
ReadPrec FrameHeader
StreamId -> ReadS FrameHeader
ReadS [FrameHeader]
forall a.
(StreamId -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FrameHeader]
$creadListPrec :: ReadPrec [FrameHeader]
readPrec :: ReadPrec FrameHeader
$creadPrec :: ReadPrec FrameHeader
readList :: ReadS [FrameHeader]
$creadList :: ReadS [FrameHeader]
readsPrec :: StreamId -> ReadS FrameHeader
$creadsPrec :: StreamId -> ReadS FrameHeader
Read, FrameHeader -> FrameHeader -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FrameHeader -> FrameHeader -> Bool
$c/= :: FrameHeader -> FrameHeader -> Bool
== :: FrameHeader -> FrameHeader -> Bool
$c== :: FrameHeader -> FrameHeader -> Bool
Eq)

-- | The data type for HTTP/2 frame payloads.
data FramePayload =
    DataFrame ByteString
  | HeadersFrame (Maybe Priority) HeaderBlockFragment
  | PriorityFrame Priority
  | RSTStreamFrame ErrorCode
  | SettingsFrame SettingsList
  | PushPromiseFrame StreamId HeaderBlockFragment
  | PingFrame ByteString
  | GoAwayFrame {- the last -}StreamId ErrorCode ByteString
  | WindowUpdateFrame WindowSize
  | ContinuationFrame HeaderBlockFragment
  | UnknownFrame FrameType ByteString
  deriving (StreamId -> FramePayload -> ShowS
[FramePayload] -> ShowS
FramePayload -> String
forall a.
(StreamId -> a -> ShowS)
-> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FramePayload] -> ShowS
$cshowList :: [FramePayload] -> ShowS
show :: FramePayload -> String
$cshow :: FramePayload -> String
showsPrec :: StreamId -> FramePayload -> ShowS
$cshowsPrec :: StreamId -> FramePayload -> ShowS
Show, ReadPrec [FramePayload]
ReadPrec FramePayload
StreamId -> ReadS FramePayload
ReadS [FramePayload]
forall a.
(StreamId -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FramePayload]
$creadListPrec :: ReadPrec [FramePayload]
readPrec :: ReadPrec FramePayload
$creadPrec :: ReadPrec FramePayload
readList :: ReadS [FramePayload]
$creadList :: ReadS [FramePayload]
readsPrec :: StreamId -> ReadS FramePayload
$creadsPrec :: StreamId -> ReadS FramePayload
Read, FramePayload -> FramePayload -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FramePayload -> FramePayload -> Bool
$c/= :: FramePayload -> FramePayload -> Bool
== :: FramePayload -> FramePayload -> Bool
$c== :: FramePayload -> FramePayload -> Bool
Eq)

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

-- | Getting 'FrameType' from 'FramePayload'.
--
-- >>> framePayloadToFrameType (DataFrame "body")
-- FrameData
framePayloadToFrameType :: FramePayload -> FrameType
framePayloadToFrameType :: FramePayload -> FrameType
framePayloadToFrameType DataFrame{}          = FrameType
FrameData
framePayloadToFrameType HeadersFrame{}       = FrameType
FrameHeaders
framePayloadToFrameType PriorityFrame{}      = FrameType
FramePriority
framePayloadToFrameType RSTStreamFrame{}     = FrameType
FrameRSTStream
framePayloadToFrameType SettingsFrame{}      = FrameType
FrameSettings
framePayloadToFrameType PushPromiseFrame{}   = FrameType
FramePushPromise
framePayloadToFrameType PingFrame{}          = FrameType
FramePing
framePayloadToFrameType GoAwayFrame{}        = FrameType
FrameGoAway
framePayloadToFrameType WindowUpdateFrame{}  = FrameType
FrameWindowUpdate
framePayloadToFrameType ContinuationFrame{}  = FrameType
FrameContinuation
framePayloadToFrameType (UnknownFrame FrameType
ft ByteString
_)  = FrameType
ft

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

-- | Checking if padding is defined in this frame type.
--
-- >>> isPaddingDefined $ DataFrame ""
-- True
-- >>> isPaddingDefined $ PingFrame ""
-- False
isPaddingDefined :: FramePayload -> Bool
isPaddingDefined :: FramePayload -> Bool
isPaddingDefined DataFrame{}         = Bool
True
isPaddingDefined HeadersFrame{}      = Bool
True
isPaddingDefined PriorityFrame{}     = Bool
False
isPaddingDefined RSTStreamFrame{}    = Bool
False
isPaddingDefined SettingsFrame{}     = Bool
False
isPaddingDefined PushPromiseFrame{}  = Bool
True
isPaddingDefined PingFrame{}         = Bool
False
isPaddingDefined GoAwayFrame{}       = Bool
False
isPaddingDefined WindowUpdateFrame{} = Bool
False
isPaddingDefined ContinuationFrame{} = Bool
False
isPaddingDefined UnknownFrame{}      = Bool
False

----------------------------------------------------------------
-- Deprecated

type ErrorCodeId   = ErrorCode
type SettingsKeyId = SettingsKey
type FrameTypeId   = FrameType
{- DEPRECATED ErrorCodeId   "Use ErrorCode instead" -}
{- DEPRECATED SettingsKeyId "Use SettingsKey instead" -}
{- DEPRECATED FrameTypeId   "Use FrameType instead" -}