module Network.HTTP2.Types (
SettingsKey
, SettingsKeyId(..)
, SettingsValue
, fromSettingsKeyId
, toSettingsKeyId
, Settings
, defaultSettings
, toSettings
, fromSettings
, ErrorCode
, ErrorCodeId(..)
, fromErrorCodeId
, toErrorCodeId
, FrameType
, FrameTypeId(..)
, fromFrameTypeId
, toFrameTypeId
, Frame(..)
, FrameHeader(..)
, FramePayload(..)
, framePayloadToFrameType
, StreamIdentifier(..)
, StreamDependency
, PromisedStreamId
, LastStreamId
, fromStreamIdentifier
, toStreamIdentifier
, streamIdentifierForSeetings
, testExclusive
, setExclusive
, FrameFlags
, defaultFlags
, testEndStream
, testAck
, testEndHeader
, testPadded
, testPriority
, setEndStream
, setAck
, setEndHeader
, setPadded
, setPriority
, PayloadLength
, maxPayloadLength
, WindowSizeIncrement
, HeaderBlockFragment
, Priority(..)
, Padding
) where
import Control.Arrow (second)
import Control.Monad (forM_)
import Data.Array (Array, Ix, listArray, assocs)
import Data.Array.ST (newArray, writeArray, runSTArray)
import Data.Bits (setBit, testBit, clearBit)
import Data.ByteString (ByteString)
import Data.Maybe (fromJust, isJust)
import Data.Word (Word8, Word16, Word32)
type ErrorCode = Word32
data ErrorCodeId = NoError
| ProtocolError
| InternalError
| FlowControlError
| SettingsTimeout
| StreamClosed
| FrameSizeError
| RefusedStream
| Cancel
| CompressionError
| ConnectError
| EnhanceYourCalm
| InadequateSecurity
| UnknownErrorCode ErrorCode
| UnknownError String
deriving (Show, Read, Eq, Ord)
fromErrorCodeId :: ErrorCodeId -> ErrorCode
fromErrorCodeId NoError = 0x0
fromErrorCodeId ProtocolError = 0x1
fromErrorCodeId InternalError = 0x2
fromErrorCodeId FlowControlError = 0x3
fromErrorCodeId SettingsTimeout = 0x4
fromErrorCodeId StreamClosed = 0x5
fromErrorCodeId FrameSizeError = 0x6
fromErrorCodeId RefusedStream = 0x7
fromErrorCodeId Cancel = 0x8
fromErrorCodeId CompressionError = 0x9
fromErrorCodeId ConnectError = 0xa
fromErrorCodeId EnhanceYourCalm = 0xb
fromErrorCodeId InadequateSecurity = 0xc
fromErrorCodeId (UnknownErrorCode w) = w
fromErrorCodeId _ = 255
toErrorCodeId :: ErrorCode -> ErrorCodeId
toErrorCodeId 0x0 = NoError
toErrorCodeId 0x1 = ProtocolError
toErrorCodeId 0x2 = InternalError
toErrorCodeId 0x3 = FlowControlError
toErrorCodeId 0x4 = SettingsTimeout
toErrorCodeId 0x5 = StreamClosed
toErrorCodeId 0x6 = FrameSizeError
toErrorCodeId 0x7 = RefusedStream
toErrorCodeId 0x8 = Cancel
toErrorCodeId 0x9 = CompressionError
toErrorCodeId 0xa = ConnectError
toErrorCodeId 0xb = EnhanceYourCalm
toErrorCodeId 0xc = InadequateSecurity
toErrorCodeId w = UnknownErrorCode w
type SettingsKey = Word16
type SettingsValue = Word32
data SettingsKeyId = SettingsHeaderTableSize
| SettingsEnablePush
| SettingsMaxConcurrentStreams
| SettingsInitialWindowSize
| SettingsMaxFrameSize
| SettingsMaxHeaderBlockSize
deriving (Show, Read, Eq, Ord, Enum, Bounded, Ix)
fromSettingsKeyId :: SettingsKeyId -> Word16
fromSettingsKeyId x = fromIntegral (fromEnum x) + 1
minSettingsKeyId :: Word16
minSettingsKeyId = fromIntegral $ fromEnum (minBound :: SettingsKeyId)
maxSettingsKeyId :: Word16
maxSettingsKeyId = fromIntegral $ fromEnum (maxBound :: SettingsKeyId)
toSettingsKeyId :: Word16 -> Maybe SettingsKeyId
toSettingsKeyId x
| minSettingsKeyId <= n && n <= maxSettingsKeyId = Just . toEnum . fromIntegral $ n
| otherwise = Nothing
where
n = x 1
type Settings = Array SettingsKeyId (Maybe SettingsValue)
defaultSettings :: Settings
defaultSettings = listArray settingsRange [Nothing|_<-xs]
where
xs = [minBound :: SettingsKeyId .. maxBound :: SettingsKeyId]
toSettings :: [(SettingsKeyId,SettingsValue)] -> Settings
toSettings kvs = runSTArray $ do
arr <- newArray settingsRange Nothing
forM_ kvs $ \(k,v) -> writeArray arr k (Just v)
return arr
settingsRange :: (SettingsKeyId, SettingsKeyId)
settingsRange = (minBound, maxBound)
data Priority = Priority {
exclusive :: Bool
, streamDependency :: StreamIdentifier
, weight :: Int
} deriving (Show, Read, Eq)
fromSettings :: Settings -> [(SettingsKeyId,SettingsValue)]
fromSettings = map (second fromJust) . filter (isJust.snd) . assocs
type FrameType = Word8
data FrameTypeId = FrameData
| FrameHeaders
| FramePriority
| FrameRSTStream
| FrameSettings
| FramePushPromise
| FramePing
| FrameGoAway
| FrameWindowUpdate
| FrameContinuation
deriving (Show, Eq, Ord, Enum, Bounded, Ix)
fromFrameTypeId :: FrameTypeId -> FrameType
fromFrameTypeId = fromIntegral . fromEnum
minFrameType :: FrameType
minFrameType = fromIntegral $ fromEnum (minBound :: FrameTypeId)
maxFrameType :: FrameType
maxFrameType = fromIntegral $ fromEnum (maxBound :: FrameTypeId)
toFrameTypeId :: FrameType -> Maybe FrameTypeId
toFrameTypeId x
| minFrameType <= x && x <= maxFrameType = Just . toEnum . fromIntegral $ x
| otherwise = Nothing
type PayloadLength = Int
maxPayloadLength :: PayloadLength
maxPayloadLength = 2^(14::Int)
type FrameFlags = Word8
defaultFlags :: FrameFlags
defaultFlags = 0
testEndStream :: FrameFlags -> Bool
testEndStream x = x `testBit` 0
testAck :: FrameFlags -> Bool
testAck x = x `testBit` 0
testEndHeader :: FrameFlags -> Bool
testEndHeader x = x `testBit` 2
testPadded :: FrameFlags -> Bool
testPadded x = x `testBit` 3
testPriority :: FrameFlags -> Bool
testPriority x = x `testBit` 5
setEndStream :: FrameFlags -> FrameFlags
setEndStream x = x `setBit` 0
setAck :: FrameFlags -> FrameFlags
setAck x = x `setBit` 0
setEndHeader :: FrameFlags -> FrameFlags
setEndHeader x = x `setBit` 2
setPadded :: FrameFlags -> FrameFlags
setPadded x = x `setBit` 3
setPriority :: FrameFlags -> FrameFlags
setPriority x = x `setBit` 5
newtype StreamIdentifier = StreamIdentifier Word32 deriving (Show, Read, Eq)
type StreamDependency = StreamIdentifier
type LastStreamId = StreamIdentifier
type PromisedStreamId = StreamIdentifier
toStreamIdentifier :: Word32 -> StreamIdentifier
toStreamIdentifier w = StreamIdentifier (w `clearBit` 31)
fromStreamIdentifier :: StreamIdentifier -> Word32
fromStreamIdentifier (StreamIdentifier w32) = w32
testExclusive :: Word32 -> Bool
testExclusive w = w `testBit` 31
setExclusive :: Word32 -> Word32
setExclusive w = w `setBit` 31
streamIdentifierForSeetings :: StreamIdentifier
streamIdentifierForSeetings = StreamIdentifier 0
type WindowSizeIncrement = Word32
type HeaderBlockFragment = ByteString
type Padding = ByteString
data Frame = Frame
{ frameHeader :: FrameHeader
, framePayload :: FramePayload
} deriving (Show, Read, Eq)
data FrameHeader = FrameHeader
{ payloadLength :: PayloadLength
, flags :: FrameFlags
, streamId :: StreamIdentifier
} deriving (Show, Read, Eq)
data FramePayload =
DataFrame ByteString
| HeadersFrame (Maybe Priority) HeaderBlockFragment
| PriorityFrame Priority
| RSTStreamFrame ErrorCodeId
| SettingsFrame Settings
| PushPromiseFrame PromisedStreamId HeaderBlockFragment
| PingFrame ByteString
| GoAwayFrame LastStreamId ErrorCodeId ByteString
| WindowUpdateFrame WindowSizeIncrement
| ContinuationFrame HeaderBlockFragment
| UnknownFrame FrameType ByteString
deriving (Show, Read, Eq)
framePayloadToFrameType :: FramePayload -> FrameType
framePayloadToFrameType (DataFrame _) = fromFrameTypeId FrameData
framePayloadToFrameType (HeadersFrame _ _) = fromFrameTypeId FrameHeaders
framePayloadToFrameType (PriorityFrame _) = fromFrameTypeId FramePriority
framePayloadToFrameType (RSTStreamFrame _) = fromFrameTypeId FrameRSTStream
framePayloadToFrameType (SettingsFrame _) = fromFrameTypeId FrameSettings
framePayloadToFrameType (PushPromiseFrame _ _) = fromFrameTypeId FramePushPromise
framePayloadToFrameType (PingFrame _) = fromFrameTypeId FramePing
framePayloadToFrameType (GoAwayFrame _ _ _) = fromFrameTypeId FrameGoAway
framePayloadToFrameType (WindowUpdateFrame _) = fromFrameTypeId FrameWindowUpdate
framePayloadToFrameType (ContinuationFrame _) = fromFrameTypeId FrameContinuation
framePayloadToFrameType (UnknownFrame w8 _) = w8