{-# LANGUAGE PatternSynonyms #-}

module Network.HTTP3.Settings where

import Network.ByteOrder
import Network.QUIC.Internal

type H3Settings = [(H3SettingsKey,Int)]

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

pattern SettingsQpackMaxTableCapacity :: H3SettingsKey
pattern $bSettingsQpackMaxTableCapacity :: H3SettingsKey
$mSettingsQpackMaxTableCapacity :: forall {r}. H3SettingsKey -> ((# #) -> r) -> ((# #) -> r) -> r
SettingsQpackMaxTableCapacity  = H3SettingsKey 0x1

pattern SettingsMaxFieldSectionSize   :: H3SettingsKey
pattern $bSettingsMaxFieldSectionSize :: H3SettingsKey
$mSettingsMaxFieldSectionSize :: forall {r}. H3SettingsKey -> ((# #) -> r) -> ((# #) -> r) -> r
SettingsMaxFieldSectionSize    = H3SettingsKey 0x6

pattern SettingsQpackBlockedStreams   :: H3SettingsKey
pattern $bSettingsQpackBlockedStreams :: H3SettingsKey
$mSettingsQpackBlockedStreams :: forall {r}. H3SettingsKey -> ((# #) -> r) -> ((# #) -> r) -> r
SettingsQpackBlockedStreams    = H3SettingsKey 0x7

encodeH3Settings :: H3Settings -> IO ByteString
encodeH3Settings :: H3Settings -> IO ByteString
encodeH3Settings H3Settings
kvs = Int -> (WriteBuffer -> IO ()) -> IO ByteString
withWriteBuffer Int
128 forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf -> do
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (forall {a}.
Integral a =>
WriteBuffer -> (H3SettingsKey, a) -> IO ()
enc WriteBuffer
wbuf) H3Settings
kvs
  where
    enc :: WriteBuffer -> (H3SettingsKey, a) -> IO ()
enc WriteBuffer
wbuf (H3SettingsKey Int
k,a
v) = do
        WriteBuffer -> Int64 -> IO ()
encodeInt' WriteBuffer
wbuf forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
k
        WriteBuffer -> Int64 -> IO ()
encodeInt' WriteBuffer
wbuf forall a b. (a -> b) -> a -> b
$ forall a b. (Integral a, Num b) => a -> b
fromIntegral a
v

decodeH3Settings :: ByteString -> IO H3Settings
decodeH3Settings :: ByteString -> IO H3Settings
decodeH3Settings ByteString
bs = forall a. ByteString -> (ReadBuffer -> IO a) -> IO a
withReadBuffer ByteString
bs forall a b. (a -> b) -> a -> b
$ \ReadBuffer
rbuf -> forall {b} {c}.
Num b =>
ReadBuffer -> ([(H3SettingsKey, b)] -> c) -> IO c
loop ReadBuffer
rbuf forall a. a -> a
id
  where
    dec :: ReadBuffer -> IO (H3SettingsKey, b)
dec ReadBuffer
rbuf = do
        H3SettingsKey
k <- Int -> H3SettingsKey
H3SettingsKey forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO Int64
decodeInt' ReadBuffer
rbuf
        b
v <- forall a b. (Integral a, Num b) => a -> b
fromIntegral forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO Int64
decodeInt' ReadBuffer
rbuf
        forall (m :: * -> *) a. Monad m => a -> m a
return (H3SettingsKey
k,b
v)
    loop :: ReadBuffer -> ([(H3SettingsKey, b)] -> c) -> IO c
loop ReadBuffer
rbuf [(H3SettingsKey, b)] -> c
build = do
        Int
r <- forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
        if Int
r forall a. Ord a => a -> a -> Bool
<= Int
0 then
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ [(H3SettingsKey, b)] -> c
build []
          else do
            (H3SettingsKey, b)
kv <- forall {b}. Num b => ReadBuffer -> IO (H3SettingsKey, b)
dec ReadBuffer
rbuf
            ReadBuffer -> ([(H3SettingsKey, b)] -> c) -> IO c
loop ReadBuffer
rbuf ([(H3SettingsKey, b)] -> c
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((H3SettingsKey, b)
kv forall a. a -> [a] -> [a]
:))