{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE PatternSynonyms #-}
{-# LANGUAGE RecordWildCards #-}

module Network.QUIC.Parameters (
    Parameters (..),
    defaultParameters,
    baseParameters, -- only for Connection
    encodeParameters,
    decodeParameters,
    AuthCIDs (..),
    defaultAuthCIDs,
    setCIDsToParameters,
    getCIDsToParameters,
) where

import qualified Data.ByteString as BS
import qualified Data.ByteString.Short as Short
import Network.Control
import System.IO.Unsafe (unsafeDupablePerformIO)

import Network.QUIC.Imports
import Network.QUIC.Types

encodeParameters :: Parameters -> ByteString
encodeParameters :: Parameters -> Value
encodeParameters = ParameterList -> Value
encodeParameterList (ParameterList -> Value)
-> (Parameters -> ParameterList) -> Parameters -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Parameters -> ParameterList
toParameterList

decodeParameters :: ByteString -> Maybe Parameters
decodeParameters :: Value -> Maybe Parameters
decodeParameters Value
bs = ParameterList -> Parameters
fromParameterList (ParameterList -> Parameters)
-> Maybe ParameterList -> Maybe Parameters
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Value -> Maybe ParameterList
decodeParameterList Value
bs

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

type ParameterList = [(Key, Value)]

{- FOURMOLU_DISABLE -}
pattern OriginalDestinationConnectionId :: Key
pattern $mOriginalDestinationConnectionId :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bOriginalDestinationConnectionId :: Key
OriginalDestinationConnectionId  = Key 0x00
pattern MaxIdleTimeout                  :: Key
pattern $mMaxIdleTimeout :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bMaxIdleTimeout :: Key
MaxIdleTimeout                   = Key 0x01
pattern StateLessResetToken             :: Key
pattern $mStateLessResetToken :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bStateLessResetToken :: Key
StateLessResetToken              = Key 0x02
pattern MaxUdpPayloadSize               :: Key
pattern $mMaxUdpPayloadSize :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bMaxUdpPayloadSize :: Key
MaxUdpPayloadSize                = Key 0x03
pattern InitialMaxData                  :: Key
pattern $mInitialMaxData :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bInitialMaxData :: Key
InitialMaxData                   = Key 0x04
pattern InitialMaxStreamDataBidiLocal   :: Key
pattern $mInitialMaxStreamDataBidiLocal :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bInitialMaxStreamDataBidiLocal :: Key
InitialMaxStreamDataBidiLocal    = Key 0x05
pattern InitialMaxStreamDataBidiRemote  :: Key
pattern $mInitialMaxStreamDataBidiRemote :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bInitialMaxStreamDataBidiRemote :: Key
InitialMaxStreamDataBidiRemote   = Key 0x06
pattern InitialMaxStreamDataUni         :: Key
pattern $mInitialMaxStreamDataUni :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bInitialMaxStreamDataUni :: Key
InitialMaxStreamDataUni          = Key 0x07
pattern InitialMaxStreamsBidi           :: Key
pattern $mInitialMaxStreamsBidi :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bInitialMaxStreamsBidi :: Key
InitialMaxStreamsBidi            = Key 0x08
pattern InitialMaxStreamsUni            :: Key
pattern $mInitialMaxStreamsUni :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bInitialMaxStreamsUni :: Key
InitialMaxStreamsUni             = Key 0x09
pattern AckDelayExponent                :: Key
pattern $mAckDelayExponent :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bAckDelayExponent :: Key
AckDelayExponent                 = Key 0x0a
pattern MaxAckDelay                     :: Key
pattern $mMaxAckDelay :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bMaxAckDelay :: Key
MaxAckDelay                      = Key 0x0b
pattern DisableActiveMigration          :: Key
pattern $mDisableActiveMigration :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bDisableActiveMigration :: Key
DisableActiveMigration           = Key 0x0c
pattern PreferredAddress                :: Key
pattern $mPreferredAddress :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bPreferredAddress :: Key
PreferredAddress                 = Key 0x0d
pattern ActiveConnectionIdLimit         :: Key
pattern $mActiveConnectionIdLimit :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bActiveConnectionIdLimit :: Key
ActiveConnectionIdLimit          = Key 0x0e
pattern InitialSourceConnectionId       :: Key
pattern $mInitialSourceConnectionId :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bInitialSourceConnectionId :: Key
InitialSourceConnectionId        = Key 0x0f
pattern RetrySourceConnectionId         :: Key
pattern $mRetrySourceConnectionId :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bRetrySourceConnectionId :: Key
RetrySourceConnectionId          = Key 0x10
pattern VersionInformation              :: Key
pattern $mVersionInformation :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bVersionInformation :: Key
VersionInformation               = Key 0x11
pattern Grease                          :: Key
pattern $mGrease :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bGrease :: Key
Grease                           = Key 0xff
pattern GreaseQuicBit                   :: Key
pattern $mGreaseQuicBit :: forall {r}. Key -> ((# #) -> r) -> ((# #) -> r) -> r
$bGreaseQuicBit :: Key
GreaseQuicBit                    = Key 0x2ab2
{- FOURMOLU_ENABLE -}

-- | QUIC transport parameters.
data Parameters = Parameters
    { Parameters -> Maybe CID
originalDestinationConnectionId :: Maybe CID
    , Parameters -> Milliseconds
maxIdleTimeout :: Milliseconds
    , Parameters -> Maybe StatelessResetToken
statelessResetToken :: Maybe StatelessResetToken -- 16 bytes
    , Parameters -> Int
maxUdpPayloadSize :: Int
    , Parameters -> Int
initialMaxData :: Int
    , Parameters -> Int
initialMaxStreamDataBidiLocal :: Int
    , Parameters -> Int
initialMaxStreamDataBidiRemote :: Int
    , Parameters -> Int
initialMaxStreamDataUni :: Int
    , Parameters -> Int
initialMaxStreamsBidi :: Int
    , Parameters -> Int
initialMaxStreamsUni :: Int
    , Parameters -> Int
ackDelayExponent :: Int
    , Parameters -> Milliseconds
maxAckDelay :: Milliseconds
    , Parameters -> Bool
disableActiveMigration :: Bool
    , Parameters -> Maybe Value
preferredAddress :: Maybe ByteString -- fixme
    , Parameters -> Int
activeConnectionIdLimit :: Int
    , Parameters -> Maybe CID
initialSourceConnectionId :: Maybe CID
    , Parameters -> Maybe CID
retrySourceConnectionId :: Maybe CID
    , Parameters -> Maybe Value
grease :: Maybe ByteString
    , Parameters -> Bool
greaseQuicBit :: Bool
    , Parameters -> Maybe VersionInfo
versionInformation :: Maybe VersionInfo
    }
    deriving (Parameters -> Parameters -> Bool
(Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool) -> Eq Parameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: Parameters -> Parameters -> Bool
== :: Parameters -> Parameters -> Bool
$c/= :: Parameters -> Parameters -> Bool
/= :: Parameters -> Parameters -> Bool
Eq, Int -> Parameters -> ShowS
[Parameters] -> ShowS
Parameters -> String
(Int -> Parameters -> ShowS)
-> (Parameters -> String)
-> ([Parameters] -> ShowS)
-> Show Parameters
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> Parameters -> ShowS
showsPrec :: Int -> Parameters -> ShowS
$cshow :: Parameters -> String
show :: Parameters -> String
$cshowList :: [Parameters] -> ShowS
showList :: [Parameters] -> ShowS
Show)

-- | The default value for QUIC transport parameters.
baseParameters :: Parameters
baseParameters :: Parameters
baseParameters =
    Parameters
        { originalDestinationConnectionId :: Maybe CID
originalDestinationConnectionId = Maybe CID
forall a. Maybe a
Nothing
        , maxIdleTimeout :: Milliseconds
maxIdleTimeout = Int64 -> Milliseconds
Milliseconds Int64
0 -- disabled
        , statelessResetToken :: Maybe StatelessResetToken
statelessResetToken = Maybe StatelessResetToken
forall a. Maybe a
Nothing
        , maxUdpPayloadSize :: Int
maxUdpPayloadSize = Int
65527
        , initialMaxData :: Int
initialMaxData = Int
0
        , initialMaxStreamDataBidiLocal :: Int
initialMaxStreamDataBidiLocal = Int
0
        , initialMaxStreamDataBidiRemote :: Int
initialMaxStreamDataBidiRemote = Int
0
        , initialMaxStreamDataUni :: Int
initialMaxStreamDataUni = Int
0
        , initialMaxStreamsBidi :: Int
initialMaxStreamsBidi = Int
0
        , initialMaxStreamsUni :: Int
initialMaxStreamsUni = Int
0
        , ackDelayExponent :: Int
ackDelayExponent = Int
3
        , maxAckDelay :: Milliseconds
maxAckDelay = Int64 -> Milliseconds
Milliseconds Int64
25
        , disableActiveMigration :: Bool
disableActiveMigration = Bool
False
        , preferredAddress :: Maybe Value
preferredAddress = Maybe Value
forall a. Maybe a
Nothing
        , activeConnectionIdLimit :: Int
activeConnectionIdLimit = Int
2
        , initialSourceConnectionId :: Maybe CID
initialSourceConnectionId = Maybe CID
forall a. Maybe a
Nothing
        , retrySourceConnectionId :: Maybe CID
retrySourceConnectionId = Maybe CID
forall a. Maybe a
Nothing
        , grease :: Maybe Value
grease = Maybe Value
forall a. Maybe a
Nothing
        , greaseQuicBit :: Bool
greaseQuicBit = Bool
False
        , versionInformation :: Maybe VersionInfo
versionInformation = Maybe VersionInfo
forall a. Maybe a
Nothing
        }

decInt :: ByteString -> Int
decInt :: Value -> Int
decInt = Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> (Value -> Int64) -> Value -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Int64
decodeInt

encInt :: Int -> ByteString
encInt :: Int -> Value
encInt = Int64 -> Value
encodeInt (Int64 -> Value) -> (Int -> Int64) -> Int -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral

decMilliseconds :: ByteString -> Milliseconds
decMilliseconds :: Value -> Milliseconds
decMilliseconds = Int64 -> Milliseconds
Milliseconds (Int64 -> Milliseconds)
-> (Value -> Int64) -> Value -> Milliseconds
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int64) -> (Value -> Int64) -> Value -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Value -> Int64
decodeInt

encMilliseconds :: Milliseconds -> ByteString
encMilliseconds :: Milliseconds -> Value
encMilliseconds (Milliseconds Int64
n) = Int64 -> Value
encodeInt (Int64 -> Value) -> Int64 -> Value
forall a b. (a -> b) -> a -> b
$ Int64 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Int64
n

fromVersionInfo :: Maybe VersionInfo -> Value
fromVersionInfo :: Maybe VersionInfo -> Value
fromVersionInfo Maybe VersionInfo
Nothing = Value
"" -- never reach
fromVersionInfo (Just VersionInfo{[Version]
Version
chosenVersion :: Version
otherVersions :: [Version]
chosenVersion :: VersionInfo -> Version
otherVersions :: VersionInfo -> [Version]
..}) = IO Value -> Value
forall a. IO a -> a
unsafeDupablePerformIO (IO Value -> Value) -> IO Value -> Value
forall a b. (a -> b) -> a -> b
$
    Int -> (WriteBuffer -> IO ()) -> IO Value
withWriteBuffer Int
len ((WriteBuffer -> IO ()) -> IO Value)
-> (WriteBuffer -> IO ()) -> IO Value
forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf -> do
        let putVersion :: Version -> IO ()
putVersion (Version Word32
ver) = WriteBuffer -> Word32 -> IO ()
write32 WriteBuffer
wbuf Word32
ver
        Version -> IO ()
putVersion Version
chosenVersion
        (Version -> IO ()) -> [Version] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Version -> IO ()
putVersion [Version]
otherVersions
  where
    len :: Int
len = Int
4 Int -> Int -> Int
forall a. Num a => a -> a -> a
* ([Version] -> Int
forall a. [a] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [Version]
otherVersions Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1)

toVersionInfo :: Value -> Maybe VersionInfo
toVersionInfo :: Value -> Maybe VersionInfo
toVersionInfo Value
bs
    | Int
len Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 Bool -> Bool -> Bool
|| Int
remainder Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
/= Int
0 = VersionInfo -> Maybe VersionInfo
forall a. a -> Maybe a
Just VersionInfo
brokenVersionInfo
    | Bool
otherwise = VersionInfo -> Maybe VersionInfo
forall a. a -> Maybe a
Just (VersionInfo -> Maybe VersionInfo)
-> VersionInfo -> Maybe VersionInfo
forall a b. (a -> b) -> a -> b
$
        IO VersionInfo -> VersionInfo
forall a. IO a -> a
unsafeDupablePerformIO (IO VersionInfo -> VersionInfo) -> IO VersionInfo -> VersionInfo
forall a b. (a -> b) -> a -> b
$
            Value -> (ReadBuffer -> IO VersionInfo) -> IO VersionInfo
forall a. Value -> (ReadBuffer -> IO a) -> IO a
withReadBuffer Value
bs ((ReadBuffer -> IO VersionInfo) -> IO VersionInfo)
-> (ReadBuffer -> IO VersionInfo) -> IO VersionInfo
forall a b. (a -> b) -> a -> b
$ \ReadBuffer
rbuf -> do
                let getVersion :: IO Version
getVersion = Word32 -> Version
Version (Word32 -> Version) -> IO Word32 -> IO Version
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO Word32
forall a. Readable a => a -> IO Word32
read32 ReadBuffer
rbuf
                Version -> [Version] -> VersionInfo
VersionInfo (Version -> [Version] -> VersionInfo)
-> IO Version -> IO ([Version] -> VersionInfo)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO Version
getVersion IO ([Version] -> VersionInfo) -> IO [Version] -> IO VersionInfo
forall a b. IO (a -> b) -> IO a -> IO b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Int -> IO Version -> IO [Version]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Int
cnt Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
1) IO Version
getVersion
  where
    len :: Int
len = Value -> Int
BS.length Value
bs
    (Int
cnt, Int
remainder) = Int
len Int -> Int -> (Int, Int)
forall a. Integral a => a -> a -> (a, a)
`divMod` Int
4

fromParameterList :: ParameterList -> Parameters
fromParameterList :: ParameterList -> Parameters
fromParameterList ParameterList
kvs = (Parameters -> (Key, Value) -> Parameters)
-> Parameters -> ParameterList -> Parameters
forall b a. (b -> a -> b) -> b -> [a] -> b
forall (t :: * -> *) b a.
Foldable t =>
(b -> a -> b) -> b -> t a -> b
foldl' Parameters -> (Key, Value) -> Parameters
update Parameters
params ParameterList
kvs
  where
    params :: Parameters
params = Parameters
baseParameters
    update :: Parameters -> (Key, Value) -> Parameters
update Parameters
x (Key
OriginalDestinationConnectionId, Value
v) =
        Parameters
x{originalDestinationConnectionId = Just (toCID v)}
    update Parameters
x (Key
MaxIdleTimeout, Value
v) =
        Parameters
x{maxIdleTimeout = decMilliseconds v}
    update Parameters
x (Key
StateLessResetToken, Value
v) =
        Parameters
x{statelessResetToken = Just (StatelessResetToken $ Short.toShort v)}
    update Parameters
x (Key
MaxUdpPayloadSize, Value
v) =
        Parameters
x{maxUdpPayloadSize = decInt v}
    update Parameters
x (Key
InitialMaxData, Value
v) =
        Parameters
x{initialMaxData = decInt v}
    update Parameters
x (Key
InitialMaxStreamDataBidiLocal, Value
v) =
        Parameters
x{initialMaxStreamDataBidiLocal = decInt v}
    update Parameters
x (Key
InitialMaxStreamDataBidiRemote, Value
v) =
        Parameters
x{initialMaxStreamDataBidiRemote = decInt v}
    update Parameters
x (Key
InitialMaxStreamDataUni, Value
v) =
        Parameters
x{initialMaxStreamDataUni = decInt v}
    update Parameters
x (Key
InitialMaxStreamsBidi, Value
v) =
        Parameters
x{initialMaxStreamsBidi = decInt v}
    update Parameters
x (Key
InitialMaxStreamsUni, Value
v) =
        Parameters
x{initialMaxStreamsUni = decInt v}
    update Parameters
x (Key
AckDelayExponent, Value
v) =
        Parameters
x{ackDelayExponent = decInt v}
    update Parameters
x (Key
MaxAckDelay, Value
v) =
        Parameters
x{maxAckDelay = decMilliseconds v}
    update Parameters
x (Key
DisableActiveMigration, Value
_) =
        Parameters
x{disableActiveMigration = True}
    update Parameters
x (Key
PreferredAddress, Value
v) =
        Parameters
x{preferredAddress = Just v}
    update Parameters
x (Key
ActiveConnectionIdLimit, Value
v) =
        Parameters
x{activeConnectionIdLimit = decInt v}
    update Parameters
x (Key
InitialSourceConnectionId, Value
v) =
        Parameters
x{initialSourceConnectionId = Just (toCID v)}
    update Parameters
x (Key
RetrySourceConnectionId, Value
v) =
        Parameters
x{retrySourceConnectionId = Just (toCID v)}
    update Parameters
x (Key
Grease, Value
v) =
        Parameters
x{grease = Just v}
    update Parameters
x (Key
GreaseQuicBit, Value
_) =
        Parameters
x{greaseQuicBit = True}
    update Parameters
x (Key
VersionInformation, Value
v) =
        Parameters
x{versionInformation = toVersionInfo v}
    update Parameters
x (Key, Value)
_ = Parameters
x

diff
    :: Eq a
    => Parameters
    -> (Parameters -> a)
    -> Key
    -> (a -> Value)
    -> Maybe (Key, Value)
diff :: forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
params Parameters -> a
label Key
key a -> Value
enc
    | a
val a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
val0 = Maybe (Key, Value)
forall a. Maybe a
Nothing
    | Bool
otherwise = (Key, Value) -> Maybe (Key, Value)
forall a. a -> Maybe a
Just (Key
key, a -> Value
enc a
val)
  where
    val :: a
val = Parameters -> a
label Parameters
params
    val0 :: a
val0 = Parameters -> a
label Parameters
baseParameters

toParameterList :: Parameters -> ParameterList
toParameterList :: Parameters -> ParameterList
toParameterList Parameters
p =
    [Maybe (Key, Value)] -> ParameterList
forall a. [Maybe a] -> [a]
catMaybes
        [ Parameters
-> (Parameters -> Maybe CID)
-> Key
-> (Maybe CID -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff
            Parameters
p
            Parameters -> Maybe CID
originalDestinationConnectionId
            Key
OriginalDestinationConnectionId
            (CID -> Value
fromCID (CID -> Value) -> (Maybe CID -> CID) -> Maybe CID -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CID -> CID
forall a. HasCallStack => Maybe a -> a
fromJust)
        , Parameters
-> (Parameters -> Milliseconds)
-> Key
-> (Milliseconds -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Milliseconds
maxIdleTimeout Key
MaxIdleTimeout Milliseconds -> Value
encMilliseconds
        , Parameters
-> (Parameters -> Maybe StatelessResetToken)
-> Key
-> (Maybe StatelessResetToken -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Maybe StatelessResetToken
statelessResetToken Key
StateLessResetToken Maybe StatelessResetToken -> Value
encSRT
        , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Int
maxUdpPayloadSize Key
MaxUdpPayloadSize Int -> Value
encInt
        , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Int
initialMaxData Key
InitialMaxData Int -> Value
encInt
        , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Int
initialMaxStreamDataBidiLocal Key
InitialMaxStreamDataBidiLocal Int -> Value
encInt
        , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Int
initialMaxStreamDataBidiRemote Key
InitialMaxStreamDataBidiRemote Int -> Value
encInt
        , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Int
initialMaxStreamDataUni Key
InitialMaxStreamDataUni Int -> Value
encInt
        , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Int
initialMaxStreamsBidi Key
InitialMaxStreamsBidi Int -> Value
encInt
        , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Int
initialMaxStreamsUni Key
InitialMaxStreamsUni Int -> Value
encInt
        , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Int
ackDelayExponent Key
AckDelayExponent Int -> Value
encInt
        , Parameters
-> (Parameters -> Milliseconds)
-> Key
-> (Milliseconds -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Milliseconds
maxAckDelay Key
MaxAckDelay Milliseconds -> Value
encMilliseconds
        , Parameters
-> (Parameters -> Bool)
-> Key
-> (Bool -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Bool
disableActiveMigration Key
DisableActiveMigration (Value -> Bool -> Value
forall a b. a -> b -> a
const Value
"")
        , Parameters
-> (Parameters -> Maybe Value)
-> Key
-> (Maybe Value -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Maybe Value
preferredAddress Key
PreferredAddress Maybe Value -> Value
forall a. HasCallStack => Maybe a -> a
fromJust
        , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Int
activeConnectionIdLimit Key
ActiveConnectionIdLimit Int -> Value
encInt
        , Parameters
-> (Parameters -> Maybe CID)
-> Key
-> (Maybe CID -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff
            Parameters
p
            Parameters -> Maybe CID
initialSourceConnectionId
            Key
InitialSourceConnectionId
            (CID -> Value
fromCID (CID -> Value) -> (Maybe CID -> CID) -> Maybe CID -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CID -> CID
forall a. HasCallStack => Maybe a -> a
fromJust)
        , Parameters
-> (Parameters -> Maybe CID)
-> Key
-> (Maybe CID -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff
            Parameters
p
            Parameters -> Maybe CID
retrySourceConnectionId
            Key
RetrySourceConnectionId
            (CID -> Value
fromCID (CID -> Value) -> (Maybe CID -> CID) -> Maybe CID -> Value
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe CID -> CID
forall a. HasCallStack => Maybe a -> a
fromJust)
        , Parameters
-> (Parameters -> Bool)
-> Key
-> (Bool -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Bool
greaseQuicBit Key
GreaseQuicBit (Value -> Bool -> Value
forall a b. a -> b -> a
const Value
"")
        , Parameters
-> (Parameters -> Maybe Value)
-> Key
-> (Maybe Value -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Maybe Value
grease Key
Grease Maybe Value -> Value
forall a. HasCallStack => Maybe a -> a
fromJust
        , Parameters
-> (Parameters -> Maybe VersionInfo)
-> Key
-> (Maybe VersionInfo -> Value)
-> Maybe (Key, Value)
forall a.
Eq a =>
Parameters
-> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key, Value)
diff Parameters
p Parameters -> Maybe VersionInfo
versionInformation Key
VersionInformation Maybe VersionInfo -> Value
fromVersionInfo
        ]

encSRT :: Maybe StatelessResetToken -> ByteString
encSRT :: Maybe StatelessResetToken -> Value
encSRT (Just (StatelessResetToken Bytes
srt)) = Bytes -> Value
Short.fromShort Bytes
srt
encSRT Maybe StatelessResetToken
_ = String -> Value
forall a. HasCallStack => String -> a
error String
"encSRT"

encodeParameterList :: ParameterList -> ByteString
encodeParameterList :: ParameterList -> Value
encodeParameterList ParameterList
kvs = IO Value -> Value
forall a. IO a -> a
unsafeDupablePerformIO (IO Value -> Value) -> IO Value -> Value
forall a b. (a -> b) -> a -> b
$
    Int -> (WriteBuffer -> IO ()) -> IO Value
withWriteBuffer Int
4096 ((WriteBuffer -> IO ()) -> IO Value)
-> (WriteBuffer -> IO ()) -> IO Value
forall a b. (a -> b) -> a -> b
$ \WriteBuffer
wbuf -> do
        -- for grease
        ((Key, Value) -> IO ()) -> ParameterList -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (WriteBuffer -> (Key, Value) -> IO ()
put WriteBuffer
wbuf) ParameterList
kvs
  where
    put :: WriteBuffer -> (Key, Value) -> IO ()
put WriteBuffer
wbuf (Key Word32
k, Value
v) = do
        WriteBuffer -> Int64 -> IO ()
encodeInt' WriteBuffer
wbuf (Int64 -> IO ()) -> Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$ Word32 -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word32
k
        WriteBuffer -> Int64 -> IO ()
encodeInt' WriteBuffer
wbuf (Int64 -> IO ()) -> Int64 -> IO ()
forall a b. (a -> b) -> a -> b
$ Int -> Int64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Int64) -> Int -> Int64
forall a b. (a -> b) -> a -> b
$ Value -> Int
BS.length Value
v
        WriteBuffer -> Value -> IO ()
copyByteString WriteBuffer
wbuf Value
v

decodeParameterList :: ByteString -> Maybe ParameterList
decodeParameterList :: Value -> Maybe ParameterList
decodeParameterList Value
bs = IO (Maybe ParameterList) -> Maybe ParameterList
forall a. IO a -> a
unsafeDupablePerformIO (IO (Maybe ParameterList) -> Maybe ParameterList)
-> IO (Maybe ParameterList) -> Maybe ParameterList
forall a b. (a -> b) -> a -> b
$ Value
-> (ReadBuffer -> IO (Maybe ParameterList))
-> IO (Maybe ParameterList)
forall a. Value -> (ReadBuffer -> IO a) -> IO a
withReadBuffer Value
bs (ReadBuffer
-> (ParameterList -> ParameterList) -> IO (Maybe ParameterList)
forall {c}. ReadBuffer -> (ParameterList -> c) -> IO (Maybe c)
`go` ParameterList -> ParameterList
forall a. a -> a
id)
  where
    go :: ReadBuffer -> (ParameterList -> c) -> IO (Maybe c)
go ReadBuffer
rbuf ParameterList -> c
build = do
        Int
rest1 <- ReadBuffer -> IO Int
forall a. Readable a => a -> IO Int
remainingSize ReadBuffer
rbuf
        if Int
rest1 Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
0
            then Maybe c -> IO (Maybe c)
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe c -> IO (Maybe c)) -> Maybe c -> IO (Maybe c)
forall a b. (a -> b) -> a -> b
$ c -> Maybe c
forall a. a -> Maybe a
Just (ParameterList -> c
build [])
            else do
                Word32
key <- Int64 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word32) -> IO Int64 -> IO Word32
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO Int64
decodeInt' ReadBuffer
rbuf
                Int
len <- Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Int) -> IO Int64 -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ReadBuffer -> IO Int64
decodeInt' ReadBuffer
rbuf
                Value
val <- ReadBuffer -> Int -> IO Value
forall a. Readable a => a -> Int -> IO Value
extractByteString ReadBuffer
rbuf Int
len
                ReadBuffer -> (ParameterList -> c) -> IO (Maybe c)
go ReadBuffer
rbuf (ParameterList -> c
build (ParameterList -> c)
-> (ParameterList -> ParameterList) -> ParameterList -> c
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ((Word32 -> Key
Key Word32
key, Value
val) (Key, Value) -> ParameterList -> ParameterList
forall a. a -> [a] -> [a]
:))

-- | An example parameters obsoleted in the near future.
--
-- >>> defaultParameters
-- Parameters {originalDestinationConnectionId = Nothing, maxIdleTimeout = 30000, statelessResetToken = Nothing, maxUdpPayloadSize = 2048, initialMaxData = 1048576, initialMaxStreamDataBidiLocal = 262144, initialMaxStreamDataBidiRemote = 262144, initialMaxStreamDataUni = 262144, initialMaxStreamsBidi = 64, initialMaxStreamsUni = 3, ackDelayExponent = 3, maxAckDelay = 25, disableActiveMigration = False, preferredAddress = Nothing, activeConnectionIdLimit = 3, initialSourceConnectionId = Nothing, retrySourceConnectionId = Nothing, grease = Nothing, greaseQuicBit = True, versionInformation = Nothing}
defaultParameters :: Parameters
defaultParameters :: Parameters
defaultParameters =
    Parameters
baseParameters
        { maxIdleTimeout = microToMilli idleTimeout -- 30000
        , maxUdpPayloadSize = maximumUdpPayloadSize -- 2048
        , initialMaxData = defaultMaxData -- !M
        , initialMaxStreamDataBidiLocal = defaultMaxStreamData -- 256K
        , initialMaxStreamDataBidiRemote = defaultMaxStreamData -- 256K
        , initialMaxStreamDataUni = defaultMaxStreamData -- 256K
        , initialMaxStreamsBidi = defaultMaxStreams -- 64
        , initialMaxStreamsUni = 3
        , activeConnectionIdLimit = 3
        , greaseQuicBit = True
        }

data AuthCIDs = AuthCIDs
    { AuthCIDs -> Maybe CID
initSrcCID :: Maybe CID
    , AuthCIDs -> Maybe CID
origDstCID :: Maybe CID
    , AuthCIDs -> Maybe CID
retrySrcCID :: Maybe CID
    }
    deriving (AuthCIDs -> AuthCIDs -> Bool
(AuthCIDs -> AuthCIDs -> Bool)
-> (AuthCIDs -> AuthCIDs -> Bool) -> Eq AuthCIDs
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: AuthCIDs -> AuthCIDs -> Bool
== :: AuthCIDs -> AuthCIDs -> Bool
$c/= :: AuthCIDs -> AuthCIDs -> Bool
/= :: AuthCIDs -> AuthCIDs -> Bool
Eq, Int -> AuthCIDs -> ShowS
[AuthCIDs] -> ShowS
AuthCIDs -> String
(Int -> AuthCIDs -> ShowS)
-> (AuthCIDs -> String) -> ([AuthCIDs] -> ShowS) -> Show AuthCIDs
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> AuthCIDs -> ShowS
showsPrec :: Int -> AuthCIDs -> ShowS
$cshow :: AuthCIDs -> String
show :: AuthCIDs -> String
$cshowList :: [AuthCIDs] -> ShowS
showList :: [AuthCIDs] -> ShowS
Show)

defaultAuthCIDs :: AuthCIDs
defaultAuthCIDs :: AuthCIDs
defaultAuthCIDs = Maybe CID -> Maybe CID -> Maybe CID -> AuthCIDs
AuthCIDs Maybe CID
forall a. Maybe a
Nothing Maybe CID
forall a. Maybe a
Nothing Maybe CID
forall a. Maybe a
Nothing

setCIDsToParameters :: AuthCIDs -> Parameters -> Parameters
setCIDsToParameters :: AuthCIDs -> Parameters -> Parameters
setCIDsToParameters AuthCIDs{Maybe CID
initSrcCID :: AuthCIDs -> Maybe CID
origDstCID :: AuthCIDs -> Maybe CID
retrySrcCID :: AuthCIDs -> Maybe CID
initSrcCID :: Maybe CID
origDstCID :: Maybe CID
retrySrcCID :: Maybe CID
..} Parameters
params =
    Parameters
params
        { originalDestinationConnectionId = origDstCID
        , initialSourceConnectionId = initSrcCID
        , retrySourceConnectionId = retrySrcCID
        }

getCIDsToParameters :: Parameters -> AuthCIDs
getCIDsToParameters :: Parameters -> AuthCIDs
getCIDsToParameters Parameters{Bool
Int
Maybe Value
Maybe StatelessResetToken
Maybe CID
Maybe VersionInfo
Milliseconds
originalDestinationConnectionId :: Parameters -> Maybe CID
maxIdleTimeout :: Parameters -> Milliseconds
statelessResetToken :: Parameters -> Maybe StatelessResetToken
maxUdpPayloadSize :: Parameters -> Int
initialMaxData :: Parameters -> Int
initialMaxStreamDataBidiLocal :: Parameters -> Int
initialMaxStreamDataBidiRemote :: Parameters -> Int
initialMaxStreamDataUni :: Parameters -> Int
initialMaxStreamsBidi :: Parameters -> Int
initialMaxStreamsUni :: Parameters -> Int
ackDelayExponent :: Parameters -> Int
maxAckDelay :: Parameters -> Milliseconds
disableActiveMigration :: Parameters -> Bool
preferredAddress :: Parameters -> Maybe Value
activeConnectionIdLimit :: Parameters -> Int
initialSourceConnectionId :: Parameters -> Maybe CID
retrySourceConnectionId :: Parameters -> Maybe CID
grease :: Parameters -> Maybe Value
greaseQuicBit :: Parameters -> Bool
versionInformation :: Parameters -> Maybe VersionInfo
originalDestinationConnectionId :: Maybe CID
maxIdleTimeout :: Milliseconds
statelessResetToken :: Maybe StatelessResetToken
maxUdpPayloadSize :: Int
initialMaxData :: Int
initialMaxStreamDataBidiLocal :: Int
initialMaxStreamDataBidiRemote :: Int
initialMaxStreamDataUni :: Int
initialMaxStreamsBidi :: Int
initialMaxStreamsUni :: Int
ackDelayExponent :: Int
maxAckDelay :: Milliseconds
disableActiveMigration :: Bool
preferredAddress :: Maybe Value
activeConnectionIdLimit :: Int
initialSourceConnectionId :: Maybe CID
retrySourceConnectionId :: Maybe CID
grease :: Maybe Value
greaseQuicBit :: Bool
versionInformation :: Maybe VersionInfo
..} =
    AuthCIDs
        { origDstCID :: Maybe CID
origDstCID = Maybe CID
originalDestinationConnectionId
        , initSrcCID :: Maybe CID
initSrcCID = Maybe CID
initialSourceConnectionId
        , retrySrcCID :: Maybe CID
retrySrcCID = Maybe CID
retrySourceConnectionId
        }