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

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 System.IO.Unsafe (unsafeDupablePerformIO)

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

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

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

newtype Key = Key Word16 deriving (Key -> Key -> Bool
(Key -> Key -> Bool) -> (Key -> Key -> Bool) -> Eq Key
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Key -> Key -> Bool
$c/= :: Key -> Key -> Bool
== :: Key -> Key -> Bool
$c== :: 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
showList :: [Key] -> ShowS
$cshowList :: [Key] -> ShowS
show :: Key -> String
$cshow :: Key -> String
showsPrec :: Int -> Key -> ShowS
$cshowsPrec :: Int -> Key -> ShowS
Show)
type Value = ByteString

type ParameterList = [(Key,Value)]

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

-- | 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 ByteString
preferredAddress                :: Maybe ByteString -- fixme
  , Parameters -> Int
activeConnectionIdLimit         :: Int
  , Parameters -> Maybe CID
initialSourceConnectionId       :: Maybe CID
  , Parameters -> Maybe CID
retrySourceConnectionId         :: Maybe CID
  , Parameters -> Maybe ByteString
grease                          :: Maybe ByteString
  , Parameters -> Bool
greaseQuicBit                   :: Bool
  } deriving (Parameters -> Parameters -> Bool
(Parameters -> Parameters -> Bool)
-> (Parameters -> Parameters -> Bool) -> Eq Parameters
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Parameters -> Parameters -> Bool
$c/= :: Parameters -> Parameters -> Bool
== :: Parameters -> Parameters -> Bool
$c== :: 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
showList :: [Parameters] -> ShowS
$cshowList :: [Parameters] -> ShowS
show :: Parameters -> String
$cshow :: Parameters -> String
showsPrec :: Int -> Parameters -> ShowS
$cshowsPrec :: Int -> Parameters -> ShowS
Show)

-- | The default value for QUIC transport parameters.
baseParameters :: Parameters
baseParameters :: Parameters
baseParameters = Parameters :: Maybe CID
-> Milliseconds
-> Maybe StatelessResetToken
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Int
-> Milliseconds
-> Bool
-> Maybe ByteString
-> Int
-> Maybe CID
-> Maybe CID
-> Maybe ByteString
-> Bool
-> Parameters
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 ByteString
preferredAddress                   = Maybe ByteString
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 ByteString
grease                             = Maybe ByteString
forall a. Maybe a
Nothing
  , greaseQuicBit :: Bool
greaseQuicBit                      = Bool
False
  }

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

encInt :: Int -> ByteString
encInt :: Int -> ByteString
encInt = Int64 -> ByteString
encodeInt (Int64 -> ByteString) -> (Int -> Int64) -> Int -> ByteString
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 :: ByteString -> Milliseconds
decMilliseconds = Int64 -> Milliseconds
Milliseconds (Int64 -> Milliseconds)
-> (ByteString -> Int64) -> ByteString -> 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) -> (ByteString -> Int64) -> ByteString -> Int64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Int64
decodeInt

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

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

diff :: Eq a => Parameters -> (Parameters -> a) -> Key -> (a -> Value) -> Maybe (Key,Value)
diff :: Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
params Parameters -> a
label Key
key a -> ByteString
enc
  | a
val a -> a -> Bool
forall a. Eq a => a -> a -> Bool
== a
val0 = Maybe (Key, ByteString)
forall a. Maybe a
Nothing
  | Bool
otherwise   = (Key, ByteString) -> Maybe (Key, ByteString)
forall a. a -> Maybe a
Just (Key
key, a -> ByteString
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, ByteString)] -> ParameterList
forall a. [Maybe a] -> [a]
catMaybes [
    Parameters
-> (Parameters -> Maybe CID)
-> Key
-> (Maybe CID -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Maybe CID
originalDestinationConnectionId
         Key
OriginalDestinationConnectionId    (CID -> ByteString
fromCID (CID -> ByteString)
-> (Maybe CID -> CID) -> Maybe CID -> ByteString
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 -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Milliseconds
maxIdleTimeout          Key
MaxIdleTimeout          Milliseconds -> ByteString
encMilliseconds
  , Parameters
-> (Parameters -> Maybe StatelessResetToken)
-> Key
-> (Maybe StatelessResetToken -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Maybe StatelessResetToken
statelessResetToken     Key
StateLessResetToken     Maybe StatelessResetToken -> ByteString
encSRT
  , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Int
maxUdpPayloadSize       Key
MaxUdpPayloadSize       Int -> ByteString
encInt
  , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Int
initialMaxData          Key
InitialMaxData          Int -> ByteString
encInt
  , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Int
initialMaxStreamDataBidiLocal  Key
InitialMaxStreamDataBidiLocal  Int -> ByteString
encInt
  , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Int
initialMaxStreamDataBidiRemote Key
InitialMaxStreamDataBidiRemote Int -> ByteString
encInt
  , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Int
initialMaxStreamDataUni Key
InitialMaxStreamDataUni Int -> ByteString
encInt
  , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Int
initialMaxStreamsBidi   Key
InitialMaxStreamsBidi   Int -> ByteString
encInt
  , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Int
initialMaxStreamsUni    Key
InitialMaxStreamsUni    Int -> ByteString
encInt
  , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Int
ackDelayExponent        Key
AckDelayExponent        Int -> ByteString
encInt
  , Parameters
-> (Parameters -> Milliseconds)
-> Key
-> (Milliseconds -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Milliseconds
maxAckDelay             Key
MaxAckDelay             Milliseconds -> ByteString
encMilliseconds
  , Parameters
-> (Parameters -> Bool)
-> Key
-> (Bool -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Bool
disableActiveMigration  Key
DisableActiveMigration  (ByteString -> Bool -> ByteString
forall a b. a -> b -> a
const ByteString
"")
  , Parameters
-> (Parameters -> Maybe ByteString)
-> Key
-> (Maybe ByteString -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Maybe ByteString
preferredAddress        Key
PreferredAddress        Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust
  , Parameters
-> (Parameters -> Int)
-> Key
-> (Int -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Int
activeConnectionIdLimit Key
ActiveConnectionIdLimit Int -> ByteString
encInt
  , Parameters
-> (Parameters -> Maybe CID)
-> Key
-> (Maybe CID -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Maybe CID
initialSourceConnectionId
         Key
InitialSourceConnectionId    (CID -> ByteString
fromCID (CID -> ByteString)
-> (Maybe CID -> CID) -> Maybe CID -> ByteString
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 -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Maybe CID
retrySourceConnectionId
         Key
RetrySourceConnectionId      (CID -> ByteString
fromCID (CID -> ByteString)
-> (Maybe CID -> CID) -> Maybe CID -> ByteString
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 -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Bool
greaseQuicBit           Key
GreaseQuicBit           (ByteString -> Bool -> ByteString
forall a b. a -> b -> a
const ByteString
"")
  , Parameters
-> (Parameters -> Maybe ByteString)
-> Key
-> (Maybe ByteString -> ByteString)
-> Maybe (Key, ByteString)
forall a.
Eq a =>
Parameters
-> (Parameters -> a)
-> Key
-> (a -> ByteString)
-> Maybe (Key, ByteString)
diff Parameters
p Parameters -> Maybe ByteString
grease                  Key
Grease                  Maybe ByteString -> ByteString
forall a. HasCallStack => Maybe a -> a
fromJust
  ]

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

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

decodeParameterList :: ByteString -> Maybe ParameterList
decodeParameterList :: ByteString -> Maybe ParameterList
decodeParameterList ByteString
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
$ ByteString
-> (ReadBuffer -> IO (Maybe ParameterList))
-> IO (Maybe ParameterList)
forall a. ByteString -> (ReadBuffer -> IO a) -> IO a
withReadBuffer ByteString
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 (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
          Word16
key <- Int64 -> Word16
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int64 -> Word16) -> IO Int64 -> IO Word16
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
          ByteString
val <- ReadBuffer -> Int -> IO ByteString
forall a. Readable a => a -> Int -> IO ByteString
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
. ((Word16 -> Key
Key Word16
key,ByteString
val)(Key, ByteString) -> ParameterList -> ParameterList
forall a. a -> [a] -> [a]
:))

-- | An example parameters obsoleted in the near future.
defaultParameters :: Parameters
defaultParameters :: Parameters
defaultParameters = Parameters
baseParameters {
    maxIdleTimeout :: Milliseconds
maxIdleTimeout                 = Microseconds -> Milliseconds
microToMilli Microseconds
idleTimeout -- 30000
  , maxUdpPayloadSize :: Int
maxUdpPayloadSize              = Int
maximumUdpPayloadSize -- 2048
  , initialMaxData :: Int
initialMaxData                 = Int
1048576
  , initialMaxStreamDataBidiLocal :: Int
initialMaxStreamDataBidiLocal  =  Int
262144
  , initialMaxStreamDataBidiRemote :: Int
initialMaxStreamDataBidiRemote =  Int
262144
  , initialMaxStreamDataUni :: Int
initialMaxStreamDataUni        =  Int
262144
  , initialMaxStreamsBidi :: Int
initialMaxStreamsBidi          =     Int
100
  , initialMaxStreamsUni :: Int
initialMaxStreamsUni           =       Int
3
  , activeConnectionIdLimit :: Int
activeConnectionIdLimit        =       Int
3
  , greaseQuicBit :: Bool
greaseQuicBit                  = Bool
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
/= :: AuthCIDs -> AuthCIDs -> Bool
$c/= :: AuthCIDs -> AuthCIDs -> Bool
== :: AuthCIDs -> AuthCIDs -> Bool
$c== :: 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
showList :: [AuthCIDs] -> ShowS
$cshowList :: [AuthCIDs] -> ShowS
show :: AuthCIDs -> String
$cshow :: AuthCIDs -> String
showsPrec :: Int -> AuthCIDs -> ShowS
$cshowsPrec :: Int -> 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
retrySrcCID :: Maybe CID
origDstCID :: Maybe CID
initSrcCID :: Maybe CID
retrySrcCID :: AuthCIDs -> Maybe CID
origDstCID :: AuthCIDs -> Maybe CID
initSrcCID :: AuthCIDs -> Maybe CID
..} Parameters
params = Parameters
params {
    originalDestinationConnectionId :: Maybe CID
originalDestinationConnectionId = Maybe CID
origDstCID
  , initialSourceConnectionId :: Maybe CID
initialSourceConnectionId       = Maybe CID
initSrcCID
  , retrySourceConnectionId :: Maybe CID
retrySourceConnectionId         = Maybe CID
retrySrcCID
  }

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