module Network.HTTP3.Stream where

import Network.QUIC (StreamId)

import Imports

data H3StreamType
    = H3ControlStreams
    | H3PushStreams
    | QPACKEncoderStream
    | QPACKDecoderStream
    | H3StreamTypeUnknown Int64
    deriving (H3StreamType -> H3StreamType -> Bool
(H3StreamType -> H3StreamType -> Bool)
-> (H3StreamType -> H3StreamType -> Bool) -> Eq H3StreamType
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: H3StreamType -> H3StreamType -> Bool
== :: H3StreamType -> H3StreamType -> Bool
$c/= :: H3StreamType -> H3StreamType -> Bool
/= :: H3StreamType -> H3StreamType -> Bool
Eq, Int -> H3StreamType -> ShowS
[H3StreamType] -> ShowS
H3StreamType -> String
(Int -> H3StreamType -> ShowS)
-> (H3StreamType -> String)
-> ([H3StreamType] -> ShowS)
-> Show H3StreamType
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> H3StreamType -> ShowS
showsPrec :: Int -> H3StreamType -> ShowS
$cshow :: H3StreamType -> String
show :: H3StreamType -> String
$cshowList :: [H3StreamType] -> ShowS
showList :: [H3StreamType] -> ShowS
Show)

{- FOURMOLU_DISABLE -}
fromH3StreamType :: H3StreamType -> Int64
fromH3StreamType :: H3StreamType -> Int64
fromH3StreamType H3StreamType
H3ControlStreams        = Int64
0x00
fromH3StreamType H3StreamType
H3PushStreams           = Int64
0x01
fromH3StreamType H3StreamType
QPACKEncoderStream      = Int64
0x02
fromH3StreamType H3StreamType
QPACKDecoderStream      = Int64
0x03
fromH3StreamType (H3StreamTypeUnknown Int64
i) = Int64
i

toH3StreamType :: Int64 -> H3StreamType
toH3StreamType :: Int64 -> H3StreamType
toH3StreamType Int64
0x00 = H3StreamType
H3ControlStreams
toH3StreamType Int64
0x01 = H3StreamType
H3PushStreams
toH3StreamType Int64
0x02 = H3StreamType
QPACKEncoderStream
toH3StreamType Int64
0x03 = H3StreamType
QPACKDecoderStream
toH3StreamType Int64
i    = Int64 -> H3StreamType
H3StreamTypeUnknown Int64
i
{- FOURMOLU_ENABLE -}

clientControlStream, clientEncoderStream, clientDecoderStream :: StreamId
clientControlStream :: Int
clientControlStream = Int
2
clientEncoderStream :: Int
clientEncoderStream = Int
6
clientDecoderStream :: Int
clientDecoderStream = Int
10

serverControlStream, serverEncoderStream, serverDecoderStream :: StreamId
serverControlStream :: Int
serverControlStream = Int
3
serverEncoderStream :: Int
serverEncoderStream = Int
7
serverDecoderStream :: Int
serverDecoderStream = Int
11