{-# LANGUAGE RecordWildCards #-}

module Network.QUIC.Connection.Migration (
    getMyCID
  , getMyCIDs
  , getPeerCID
  , isMyCID
  , myCIDsInclude
  , shouldUpdateMyCID
  , shouldUpdatePeerCID
  , resetPeerCID
  , getNewMyCID
  , getMyCIDSeqNum
  , setMyCID
  , setPeerCIDAndRetireCIDs
  , retirePeerCID
  , retireMyCID
  , addPeerCID
  , waitPeerCID
  , choosePeerCIDForPrivacy
  , setPeerStatelessResetToken
  , isStatelessRestTokenValid
  , setMigrationStarted
  , isPathValidating
  , checkResponse
  , validatePath
  ) where

import Control.Concurrent.STM
import qualified Data.IntMap.Strict as IntMap
import qualified Data.Map.Strict as Map

import Network.QUIC.Connection.Queue
import Network.QUIC.Connection.Types
import Network.QUIC.Imports
import Network.QUIC.Qlog
import Network.QUIC.Types

----------------------------------------------------------------

getMyCID :: Connection -> IO CID
getMyCID :: Connection -> IO CID
getMyCID Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
..} = CIDInfo -> CID
cidInfoCID (CIDInfo -> CID) -> (CIDDB -> CIDInfo) -> CIDDB -> CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDDB -> CIDInfo
usedCIDInfo (CIDDB -> CID) -> IO CIDDB -> IO CID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef CIDDB -> IO CIDDB
forall a. IORef a -> IO a
readIORef IORef CIDDB
myCIDDB

getMyCIDs :: Connection -> IO [CID]
getMyCIDs :: Connection -> IO [CID]
getMyCIDs Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = Map CID Int -> [CID]
forall k a. Map k a -> [k]
Map.keys (Map CID Int -> [CID]) -> (CIDDB -> Map CID Int) -> CIDDB -> [CID]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDDB -> Map CID Int
revInfos (CIDDB -> [CID]) -> IO CIDDB -> IO [CID]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef CIDDB -> IO CIDDB
forall a. IORef a -> IO a
readIORef IORef CIDDB
myCIDDB

getMyCIDSeqNum :: Connection -> IO Int
getMyCIDSeqNum :: Connection -> IO Int
getMyCIDSeqNum Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = CIDInfo -> Int
cidInfoSeq (CIDInfo -> Int) -> (CIDDB -> CIDInfo) -> CIDDB -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDDB -> CIDInfo
usedCIDInfo (CIDDB -> Int) -> IO CIDDB -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef CIDDB -> IO CIDDB
forall a. IORef a -> IO a
readIORef IORef CIDDB
myCIDDB

getPeerCID :: Connection -> IO CID
getPeerCID :: Connection -> IO CID
getPeerCID Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = CIDInfo -> CID
cidInfoCID (CIDInfo -> CID) -> (CIDDB -> CIDInfo) -> CIDDB -> CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDDB -> CIDInfo
usedCIDInfo (CIDDB -> CID) -> IO CIDDB -> IO CID
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar CIDDB -> IO CIDDB
forall a. TVar a -> IO a
readTVarIO TVar CIDDB
peerCIDDB

isMyCID :: Connection -> CID -> IO Bool
isMyCID :: Connection -> CID -> IO Bool
isMyCID Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} CID
cid =
    (CID -> CID -> Bool
forall a. Eq a => a -> a -> Bool
== CID
cid) (CID -> Bool) -> (CIDDB -> CID) -> CIDDB -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDInfo -> CID
cidInfoCID (CIDInfo -> CID) -> (CIDDB -> CIDInfo) -> CIDDB -> CID
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDDB -> CIDInfo
usedCIDInfo (CIDDB -> Bool) -> IO CIDDB -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef CIDDB -> IO CIDDB
forall a. IORef a -> IO a
readIORef IORef CIDDB
myCIDDB

shouldUpdateMyCID :: Connection -> Int -> IO Bool
shouldUpdateMyCID :: Connection -> Int -> IO Bool
shouldUpdateMyCID Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} Int
nseq = do
    Int
useq <- CIDInfo -> Int
cidInfoSeq (CIDInfo -> Int) -> (CIDDB -> CIDInfo) -> CIDDB -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDDB -> CIDInfo
usedCIDInfo (CIDDB -> Int) -> IO CIDDB -> IO Int
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef CIDDB -> IO CIDDB
forall a. IORef a -> IO a
readIORef IORef CIDDB
myCIDDB
    Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Int
nseq Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
useq)

myCIDsInclude :: Connection -> CID -> IO (Maybe Int)
myCIDsInclude :: Connection -> CID -> IO (Maybe Int)
myCIDsInclude Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} CID
cid =
    CID -> Map CID Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CID
cid (Map CID Int -> Maybe Int)
-> (CIDDB -> Map CID Int) -> CIDDB -> Maybe Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDDB -> Map CID Int
revInfos (CIDDB -> Maybe Int) -> IO CIDDB -> IO (Maybe Int)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IORef CIDDB -> IO CIDDB
forall a. IORef a -> IO a
readIORef IORef CIDDB
myCIDDB

----------------------------------------------------------------

-- | Reseting to Initial CID in the client side.
resetPeerCID :: Connection -> CID -> IO ()
resetPeerCID :: Connection -> CID -> IO ()
resetPeerCID Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} CID
cid = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar CIDDB -> CIDDB -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar CIDDB
peerCIDDB (CIDDB -> STM ()) -> CIDDB -> STM ()
forall a b. (a -> b) -> a -> b
$ CID -> CIDDB
newCIDDB CID
cid

----------------------------------------------------------------

-- | Sending NewConnectionID
getNewMyCID :: Connection -> IO CIDInfo
getNewMyCID :: Connection -> IO CIDInfo
getNewMyCID Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = do
    CID
cid <- IO CID
newCID
    StatelessResetToken
srt <- IO StatelessResetToken
newStatelessResetToken
    IORef CIDDB -> (CIDDB -> (CIDDB, CIDInfo)) -> IO CIDInfo
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef CIDDB
myCIDDB ((CIDDB -> (CIDDB, CIDInfo)) -> IO CIDInfo)
-> (CIDDB -> (CIDDB, CIDInfo)) -> IO CIDInfo
forall a b. (a -> b) -> a -> b
$ CID -> StatelessResetToken -> CIDDB -> (CIDDB, CIDInfo)
new CID
cid StatelessResetToken
srt

----------------------------------------------------------------

-- | Receiving NewConnectionID
addPeerCID :: Connection -> CIDInfo -> IO ()
addPeerCID :: Connection -> CIDInfo -> IO ()
addPeerCID Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} CIDInfo
cidInfo = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    CIDDB
db <- TVar CIDDB -> STM CIDDB
forall a. TVar a -> STM a
readTVar TVar CIDDB
peerCIDDB
    case CID -> Map CID Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup (CIDInfo -> CID
cidInfoCID CIDInfo
cidInfo) (CIDDB -> Map CID Int
revInfos CIDDB
db) of
      Maybe Int
Nothing -> TVar CIDDB -> (CIDDB -> CIDDB) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar CIDDB
peerCIDDB ((CIDDB -> CIDDB) -> STM ()) -> (CIDDB -> CIDDB) -> STM ()
forall a b. (a -> b) -> a -> b
$ CIDInfo -> CIDDB -> CIDDB
add CIDInfo
cidInfo
      Just Int
_  -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

shouldUpdatePeerCID :: Connection -> IO Bool
shouldUpdatePeerCID :: Connection -> IO Bool
shouldUpdatePeerCID Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} =
    Bool -> Bool
not (Bool -> Bool) -> (CIDDB -> Bool) -> CIDDB -> Bool
forall b c a. (b -> c) -> (a -> b) -> a -> c
. CIDDB -> Bool
triggeredByMe (CIDDB -> Bool) -> IO CIDDB -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar CIDDB -> IO CIDDB
forall a. TVar a -> IO a
readTVarIO TVar CIDDB
peerCIDDB

-- | Automatic CID update
choosePeerCIDForPrivacy :: Connection -> IO ()
choosePeerCIDForPrivacy :: Connection -> IO ()
choosePeerCIDForPrivacy Connection
conn = do
    Maybe CIDInfo
mr <- STM (Maybe CIDInfo) -> IO (Maybe CIDInfo)
forall a. STM a -> IO a
atomically (STM (Maybe CIDInfo) -> IO (Maybe CIDInfo))
-> STM (Maybe CIDInfo) -> IO (Maybe CIDInfo)
forall a b. (a -> b) -> a -> b
$ do
        Maybe CIDInfo
mncid <- Connection -> STM (Maybe CIDInfo)
pickPeerCID Connection
conn
        case Maybe CIDInfo
mncid of
          Maybe CIDInfo
Nothing   -> () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
          Just CIDInfo
ncid -> do
              Connection -> CIDInfo -> Bool -> STM ()
setPeerCID Connection
conn CIDInfo
ncid Bool
False
              () -> STM ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Maybe CIDInfo -> STM (Maybe CIDInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CIDInfo
mncid
    case Maybe CIDInfo
mr of
      Maybe CIDInfo
Nothing   -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just CIDInfo
ncid -> Connection -> LR -> IO ()
forall q. KeepQlog q => q -> LR -> IO ()
qlogCIDUpdate Connection
conn (LR -> IO ()) -> LR -> IO ()
forall a b. (a -> b) -> a -> b
$ CID -> LR
Remote (CID -> LR) -> CID -> LR
forall a b. (a -> b) -> a -> b
$ CIDInfo -> CID
cidInfoCID CIDInfo
ncid

-- | Only for the internal "migration" API
waitPeerCID :: Connection -> IO CIDInfo
waitPeerCID :: Connection -> IO CIDInfo
waitPeerCID conn :: Connection
conn@Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = do
    CIDInfo
r <- STM CIDInfo -> IO CIDInfo
forall a. STM a -> IO a
atomically (STM CIDInfo -> IO CIDInfo) -> STM CIDInfo -> IO CIDInfo
forall a b. (a -> b) -> a -> b
$ do
        let ref :: TVar CIDDB
ref = TVar CIDDB
peerCIDDB
        CIDDB
db <- TVar CIDDB -> STM CIDDB
forall a. TVar a -> STM a
readTVar TVar CIDDB
ref
        Maybe CIDInfo
mncid <- Connection -> STM (Maybe CIDInfo)
pickPeerCID Connection
conn
        Bool -> STM ()
check (Bool -> STM ()) -> Bool -> STM ()
forall a b. (a -> b) -> a -> b
$ Maybe CIDInfo -> Bool
forall a. Maybe a -> Bool
isJust Maybe CIDInfo
mncid
        let u :: CIDInfo
u = CIDDB -> CIDInfo
usedCIDInfo CIDDB
db
        Connection -> CIDInfo -> Bool -> STM ()
setPeerCID Connection
conn (Maybe CIDInfo -> CIDInfo
forall a. HasCallStack => Maybe a -> a
fromJust Maybe CIDInfo
mncid) Bool
True
        CIDInfo -> STM CIDInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CIDInfo
u
    Connection -> LR -> IO ()
forall q. KeepQlog q => q -> LR -> IO ()
qlogCIDUpdate Connection
conn (LR -> IO ()) -> LR -> IO ()
forall a b. (a -> b) -> a -> b
$ CID -> LR
Remote (CID -> LR) -> CID -> LR
forall a b. (a -> b) -> a -> b
$ CIDInfo -> CID
cidInfoCID CIDInfo
r
    CIDInfo -> IO CIDInfo
forall (m :: * -> *) a. Monad m => a -> m a
return CIDInfo
r

pickPeerCID :: Connection -> STM (Maybe CIDInfo)
pickPeerCID :: Connection -> STM (Maybe CIDInfo)
pickPeerCID Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = do
    CIDDB
db <- TVar CIDDB -> STM CIDDB
forall a. TVar a -> STM a
readTVar TVar CIDDB
peerCIDDB
    let n :: Int
n = CIDInfo -> Int
cidInfoSeq (CIDInfo -> Int) -> CIDInfo -> Int
forall a b. (a -> b) -> a -> b
$ CIDDB -> CIDInfo
usedCIDInfo CIDDB
db
        mcidinfo :: Maybe CIDInfo
mcidinfo = Int -> IntMap CIDInfo -> Maybe CIDInfo
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1) (IntMap CIDInfo -> Maybe CIDInfo)
-> IntMap CIDInfo -> Maybe CIDInfo
forall a b. (a -> b) -> a -> b
$ CIDDB -> IntMap CIDInfo
cidInfos CIDDB
db
    Maybe CIDInfo -> STM (Maybe CIDInfo)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe CIDInfo
mcidinfo

setPeerCID :: Connection -> CIDInfo -> Bool -> STM ()
setPeerCID :: Connection -> CIDInfo -> Bool -> STM ()
setPeerCID Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} CIDInfo
cidInfo Bool
pri =
    TVar CIDDB -> (CIDDB -> CIDDB) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar CIDDB
peerCIDDB ((CIDDB -> CIDDB) -> STM ()) -> (CIDDB -> CIDDB) -> STM ()
forall a b. (a -> b) -> a -> b
$ CIDInfo -> Bool -> CIDDB -> CIDDB
set CIDInfo
cidInfo Bool
pri

-- | After sending RetireConnectionID
retirePeerCID :: Connection -> Int -> IO ()
retirePeerCID :: Connection -> Int -> IO ()
retirePeerCID Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} Int
n =
    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar CIDDB -> (CIDDB -> CIDDB) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar CIDDB
peerCIDDB ((CIDDB -> CIDDB) -> STM ()) -> (CIDDB -> CIDDB) -> STM ()
forall a b. (a -> b) -> a -> b
$ Int -> CIDDB -> CIDDB
del Int
n

----------------------------------------------------------------

-- | Receiving NewConnectionID
setPeerCIDAndRetireCIDs :: Connection -> Int -> IO [Int]
setPeerCIDAndRetireCIDs :: Connection -> Int -> IO [Int]
setPeerCIDAndRetireCIDs Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} Int
n = STM [Int] -> IO [Int]
forall a. STM a -> IO a
atomically (STM [Int] -> IO [Int]) -> STM [Int] -> IO [Int]
forall a b. (a -> b) -> a -> b
$ do
    CIDDB
db <- TVar CIDDB -> STM CIDDB
forall a. TVar a -> STM a
readTVar TVar CIDDB
peerCIDDB
    let (CIDDB
db', [Int]
ns) = Int -> CIDDB -> (CIDDB, [Int])
arrange Int
n CIDDB
db
    TVar CIDDB -> CIDDB -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar CIDDB
peerCIDDB CIDDB
db'
    [Int] -> STM [Int]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int]
ns

arrange :: Int -> CIDDB -> (CIDDB, [Int])
arrange :: Int -> CIDDB -> (CIDDB, [Int])
arrange Int
n db :: CIDDB
db@CIDDB{Bool
Int
IntMap CIDInfo
Map CID Int
CIDInfo
nextSeqNum :: CIDDB -> Int
triggeredByMe :: Bool
nextSeqNum :: Int
revInfos :: Map CID Int
cidInfos :: IntMap CIDInfo
usedCIDInfo :: CIDInfo
cidInfos :: CIDDB -> IntMap CIDInfo
triggeredByMe :: CIDDB -> Bool
revInfos :: CIDDB -> Map CID Int
usedCIDInfo :: CIDDB -> CIDInfo
..} = (CIDDB
db', [Int]
dropSeqnums)
  where
    (IntMap CIDInfo
toDrops, IntMap CIDInfo
cidInfos') = (Int -> CIDInfo -> Bool)
-> IntMap CIDInfo -> (IntMap CIDInfo, IntMap CIDInfo)
forall a. (Int -> a -> Bool) -> IntMap a -> (IntMap a, IntMap a)
IntMap.partitionWithKey (\Int
k CIDInfo
_ -> Int
k Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
n) IntMap CIDInfo
cidInfos
    dropSeqnums :: [Int]
dropSeqnums = (Int -> CIDInfo -> [Int] -> [Int])
-> [Int] -> IntMap CIDInfo -> [Int]
forall a b. (Int -> a -> b -> b) -> b -> IntMap a -> b
IntMap.foldrWithKey (\Int
k CIDInfo
_ [Int]
ks -> Int
kInt -> [Int] -> [Int]
forall a. a -> [a] -> [a]
:[Int]
ks) [] IntMap CIDInfo
toDrops
    dropCIDs :: [CID]
dropCIDs = (CIDInfo -> [CID] -> [CID]) -> [CID] -> IntMap CIDInfo -> [CID]
forall a b. (a -> b -> b) -> b -> IntMap a -> b
IntMap.foldr (\CIDInfo
c [CID]
r -> CIDInfo -> CID
cidInfoCID CIDInfo
c CID -> [CID] -> [CID]
forall a. a -> [a] -> [a]
: [CID]
r) [] IntMap CIDInfo
toDrops
    -- IntMap.findMin is a partial function.
    -- But receiver guarantees that there is at least one cidinfo.
    usedCIDInfo' :: CIDInfo
usedCIDInfo' | CIDInfo -> Int
cidInfoSeq CIDInfo
usedCIDInfo Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
n = CIDInfo
usedCIDInfo
                 | Bool
otherwise            = (Int, CIDInfo) -> CIDInfo
forall a b. (a, b) -> b
snd ((Int, CIDInfo) -> CIDInfo) -> (Int, CIDInfo) -> CIDInfo
forall a b. (a -> b) -> a -> b
$ IntMap CIDInfo -> (Int, CIDInfo)
forall a. IntMap a -> (Int, a)
IntMap.findMin IntMap CIDInfo
cidInfos'
    revInfos' :: Map CID Int
revInfos' = (CID -> Map CID Int -> Map CID Int)
-> Map CID Int -> [CID] -> Map CID Int
forall (t :: * -> *) a b.
Foldable t =>
(a -> b -> b) -> b -> t a -> b
foldr CID -> Map CID Int -> Map CID Int
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete Map CID Int
revInfos [CID]
dropCIDs
    db' :: CIDDB
db' = CIDDB
db {
        usedCIDInfo :: CIDInfo
usedCIDInfo = CIDInfo
usedCIDInfo'
      , cidInfos :: IntMap CIDInfo
cidInfos    = IntMap CIDInfo
cidInfos'
      , revInfos :: Map CID Int
revInfos    = Map CID Int
revInfos'
      }

----------------------------------------------------------------

-- | Peer starts using a new CID.
setMyCID :: Connection -> CID -> IO ()
setMyCID :: Connection -> CID -> IO ()
setMyCID conn :: Connection
conn@Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} CID
ncid = do
    Bool
r <- IORef CIDDB -> (CIDDB -> (CIDDB, Bool)) -> IO Bool
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef CIDDB
myCIDDB CIDDB -> (CIDDB, Bool)
findSet
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
r (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> LR -> IO ()
forall q. KeepQlog q => q -> LR -> IO ()
qlogCIDUpdate Connection
conn (LR -> IO ()) -> LR -> IO ()
forall a b. (a -> b) -> a -> b
$ CID -> LR
Local CID
ncid
  where
    findSet :: CIDDB -> (CIDDB, Bool)
findSet db :: CIDDB
db@CIDDB{Bool
Int
IntMap CIDInfo
Map CID Int
CIDInfo
triggeredByMe :: Bool
nextSeqNum :: Int
revInfos :: Map CID Int
cidInfos :: IntMap CIDInfo
usedCIDInfo :: CIDInfo
nextSeqNum :: CIDDB -> Int
cidInfos :: CIDDB -> IntMap CIDInfo
triggeredByMe :: CIDDB -> Bool
revInfos :: CIDDB -> Map CID Int
usedCIDInfo :: CIDDB -> CIDInfo
..}
      | CIDInfo -> CID
cidInfoCID CIDInfo
usedCIDInfo CID -> CID -> Bool
forall a. Eq a => a -> a -> Bool
== CID
ncid = (CIDDB
db, Bool
False)
      | Bool
otherwise = case CID -> Map CID Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CID
ncid Map CID Int
revInfos of
          Maybe Int
Nothing -> (CIDDB
db, Bool
False)
          Just Int
n -> case Int -> IntMap CIDInfo -> Maybe CIDInfo
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n IntMap CIDInfo
cidInfos of
            Maybe CIDInfo
Nothing -> (CIDDB
db, Bool
False)
            Just CIDInfo
ncidinfo -> (CIDInfo -> Bool -> CIDDB -> CIDDB
set CIDInfo
ncidinfo Bool
False CIDDB
db, Bool
True)

-- | Receiving RetireConnectionID
retireMyCID :: Connection -> Int -> IO (Maybe CIDInfo)
retireMyCID :: Connection -> Int -> IO (Maybe CIDInfo)
retireMyCID Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} Int
n = IORef CIDDB
-> (CIDDB -> (CIDDB, Maybe CIDInfo)) -> IO (Maybe CIDInfo)
forall a b. IORef a -> (a -> (a, b)) -> IO b
atomicModifyIORef' IORef CIDDB
myCIDDB ((CIDDB -> (CIDDB, Maybe CIDInfo)) -> IO (Maybe CIDInfo))
-> (CIDDB -> (CIDDB, Maybe CIDInfo)) -> IO (Maybe CIDInfo)
forall a b. (a -> b) -> a -> b
$ Int -> CIDDB -> (CIDDB, Maybe CIDInfo)
del' Int
n

----------------------------------------------------------------

set :: CIDInfo -> Bool -> CIDDB -> CIDDB
set :: CIDInfo -> Bool -> CIDDB -> CIDDB
set CIDInfo
cidInfo Bool
pri CIDDB
db = CIDDB
db'
  where
    db' :: CIDDB
db' = CIDDB
db {
        usedCIDInfo :: CIDInfo
usedCIDInfo = CIDInfo
cidInfo
      , triggeredByMe :: Bool
triggeredByMe = Bool
pri
      }

add :: CIDInfo -> CIDDB -> CIDDB
add :: CIDInfo -> CIDDB -> CIDDB
add cidInfo :: CIDInfo
cidInfo@CIDInfo{Int
StatelessResetToken
CID
cidInfoSRT :: CIDInfo -> StatelessResetToken
cidInfoSRT :: StatelessResetToken
cidInfoCID :: CID
cidInfoSeq :: Int
cidInfoSeq :: CIDInfo -> Int
cidInfoCID :: CIDInfo -> CID
..} db :: CIDDB
db@CIDDB{Bool
Int
IntMap CIDInfo
Map CID Int
CIDInfo
triggeredByMe :: Bool
nextSeqNum :: Int
revInfos :: Map CID Int
cidInfos :: IntMap CIDInfo
usedCIDInfo :: CIDInfo
nextSeqNum :: CIDDB -> Int
cidInfos :: CIDDB -> IntMap CIDInfo
triggeredByMe :: CIDDB -> Bool
revInfos :: CIDDB -> Map CID Int
usedCIDInfo :: CIDDB -> CIDInfo
..} = CIDDB
db'
  where
    db' :: CIDDB
db' = CIDDB
db {
        cidInfos :: IntMap CIDInfo
cidInfos = Int -> CIDInfo -> IntMap CIDInfo -> IntMap CIDInfo
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
cidInfoSeq CIDInfo
cidInfo IntMap CIDInfo
cidInfos
      , revInfos :: Map CID Int
revInfos = CID -> Int -> Map CID Int -> Map CID Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CID
cidInfoCID Int
cidInfoSeq Map CID Int
revInfos
      }

new :: CID -> StatelessResetToken -> CIDDB -> (CIDDB, CIDInfo)
new :: CID -> StatelessResetToken -> CIDDB -> (CIDDB, CIDInfo)
new CID
cid StatelessResetToken
srt db :: CIDDB
db@CIDDB{Bool
Int
IntMap CIDInfo
Map CID Int
CIDInfo
triggeredByMe :: Bool
nextSeqNum :: Int
revInfos :: Map CID Int
cidInfos :: IntMap CIDInfo
usedCIDInfo :: CIDInfo
nextSeqNum :: CIDDB -> Int
cidInfos :: CIDDB -> IntMap CIDInfo
triggeredByMe :: CIDDB -> Bool
revInfos :: CIDDB -> Map CID Int
usedCIDInfo :: CIDDB -> CIDInfo
..} = (CIDDB
db', CIDInfo
cidInfo)
  where
   cidInfo :: CIDInfo
cidInfo = Int -> CID -> StatelessResetToken -> CIDInfo
CIDInfo Int
nextSeqNum CID
cid StatelessResetToken
srt
   db' :: CIDDB
db' = CIDDB
db {
       nextSeqNum :: Int
nextSeqNum = Int
nextSeqNum Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
1
     , cidInfos :: IntMap CIDInfo
cidInfos = Int -> CIDInfo -> IntMap CIDInfo -> IntMap CIDInfo
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
nextSeqNum CIDInfo
cidInfo IntMap CIDInfo
cidInfos
     , revInfos :: Map CID Int
revInfos = CID -> Int -> Map CID Int -> Map CID Int
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert CID
cid Int
nextSeqNum Map CID Int
revInfos
     }

del :: Int -> CIDDB -> CIDDB
del :: Int -> CIDDB -> CIDDB
del Int
n db :: CIDDB
db@CIDDB{Bool
Int
IntMap CIDInfo
Map CID Int
CIDInfo
triggeredByMe :: Bool
nextSeqNum :: Int
revInfos :: Map CID Int
cidInfos :: IntMap CIDInfo
usedCIDInfo :: CIDInfo
nextSeqNum :: CIDDB -> Int
cidInfos :: CIDDB -> IntMap CIDInfo
triggeredByMe :: CIDDB -> Bool
revInfos :: CIDDB -> Map CID Int
usedCIDInfo :: CIDDB -> CIDInfo
..} = CIDDB
db'
  where
    db' :: CIDDB
db' = case Int -> IntMap CIDInfo -> Maybe CIDInfo
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n IntMap CIDInfo
cidInfos of
      Maybe CIDInfo
Nothing -> CIDDB
db
      Just CIDInfo
cidInfo -> CIDDB
db {
          cidInfos :: IntMap CIDInfo
cidInfos = Int -> IntMap CIDInfo -> IntMap CIDInfo
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
n IntMap CIDInfo
cidInfos
        , revInfos :: Map CID Int
revInfos = CID -> Map CID Int -> Map CID Int
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (CIDInfo -> CID
cidInfoCID CIDInfo
cidInfo) Map CID Int
revInfos
        }

del' :: Int -> CIDDB -> (CIDDB, Maybe CIDInfo)
del' :: Int -> CIDDB -> (CIDDB, Maybe CIDInfo)
del' Int
n db :: CIDDB
db@CIDDB{Bool
Int
IntMap CIDInfo
Map CID Int
CIDInfo
triggeredByMe :: Bool
nextSeqNum :: Int
revInfos :: Map CID Int
cidInfos :: IntMap CIDInfo
usedCIDInfo :: CIDInfo
nextSeqNum :: CIDDB -> Int
cidInfos :: CIDDB -> IntMap CIDInfo
triggeredByMe :: CIDDB -> Bool
revInfos :: CIDDB -> Map CID Int
usedCIDInfo :: CIDDB -> CIDInfo
..} = (CIDDB
db', Maybe CIDInfo
mcidInfo)
  where
    mcidInfo :: Maybe CIDInfo
mcidInfo = Int -> IntMap CIDInfo -> Maybe CIDInfo
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n IntMap CIDInfo
cidInfos
    db' :: CIDDB
db' = case Maybe CIDInfo
mcidInfo of
      Maybe CIDInfo
Nothing -> CIDDB
db
      Just CIDInfo
cidInfo -> CIDDB
db {
          cidInfos :: IntMap CIDInfo
cidInfos = Int -> IntMap CIDInfo -> IntMap CIDInfo
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
n IntMap CIDInfo
cidInfos
        , revInfos :: Map CID Int
revInfos = CID -> Map CID Int -> Map CID Int
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete (CIDInfo -> CID
cidInfoCID CIDInfo
cidInfo) Map CID Int
revInfos
        }

----------------------------------------------------------------

setPeerStatelessResetToken :: Connection -> StatelessResetToken -> IO ()
setPeerStatelessResetToken :: Connection -> StatelessResetToken -> IO ()
setPeerStatelessResetToken Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} StatelessResetToken
srt =
    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar CIDDB -> (CIDDB -> CIDDB) -> STM ()
forall a. TVar a -> (a -> a) -> STM ()
modifyTVar' TVar CIDDB
peerCIDDB CIDDB -> CIDDB
adjust
  where
    adjust :: CIDDB -> CIDDB
adjust db :: CIDDB
db@CIDDB{Bool
Int
IntMap CIDInfo
Map CID Int
CIDInfo
triggeredByMe :: Bool
nextSeqNum :: Int
revInfos :: Map CID Int
cidInfos :: IntMap CIDInfo
usedCIDInfo :: CIDInfo
nextSeqNum :: CIDDB -> Int
cidInfos :: CIDDB -> IntMap CIDInfo
triggeredByMe :: CIDDB -> Bool
revInfos :: CIDDB -> Map CID Int
usedCIDInfo :: CIDDB -> CIDInfo
..} = CIDDB
db'
      where
        db' :: CIDDB
db' = case Int -> IntMap CIDInfo -> Maybe CIDInfo
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
0 IntMap CIDInfo
cidInfos of
          Maybe CIDInfo
Nothing      -> CIDDB
db
          Just CIDInfo
cidinfo -> let cidinfo' :: CIDInfo
cidinfo' = CIDInfo
cidinfo { cidInfoSRT :: StatelessResetToken
cidInfoSRT = StatelessResetToken
srt }
                          in CIDDB
db {
                               cidInfos :: IntMap CIDInfo
cidInfos = Int -> CIDInfo -> IntMap CIDInfo -> IntMap CIDInfo
forall a. Int -> a -> IntMap a -> IntMap a
IntMap.insert Int
0 CIDInfo
cidinfo'
                                        (IntMap CIDInfo -> IntMap CIDInfo)
-> IntMap CIDInfo -> IntMap CIDInfo
forall a b. (a -> b) -> a -> b
$ Int -> IntMap CIDInfo -> IntMap CIDInfo
forall a. Int -> IntMap a -> IntMap a
IntMap.delete Int
0 IntMap CIDInfo
cidInfos
                             , usedCIDInfo :: CIDInfo
usedCIDInfo = CIDInfo
cidinfo'
                             }

isStatelessRestTokenValid :: Connection -> CID -> StatelessResetToken -> IO Bool
isStatelessRestTokenValid :: Connection -> CID -> StatelessResetToken -> IO Bool
isStatelessRestTokenValid Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} CID
cid StatelessResetToken
srt = CIDDB -> Bool
srtCheck (CIDDB -> Bool) -> IO CIDDB -> IO Bool
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TVar CIDDB -> IO CIDDB
forall a. TVar a -> IO a
readTVarIO TVar CIDDB
peerCIDDB
  where
    srtCheck :: CIDDB -> Bool
srtCheck CIDDB{Bool
Int
IntMap CIDInfo
Map CID Int
CIDInfo
triggeredByMe :: Bool
nextSeqNum :: Int
revInfos :: Map CID Int
cidInfos :: IntMap CIDInfo
usedCIDInfo :: CIDInfo
nextSeqNum :: CIDDB -> Int
cidInfos :: CIDDB -> IntMap CIDInfo
triggeredByMe :: CIDDB -> Bool
revInfos :: CIDDB -> Map CID Int
usedCIDInfo :: CIDDB -> CIDInfo
..} = case CID -> Map CID Int -> Maybe Int
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup CID
cid Map CID Int
revInfos of
      Maybe Int
Nothing -> Bool
False
      Just Int
n  -> case Int -> IntMap CIDInfo -> Maybe CIDInfo
forall a. Int -> IntMap a -> Maybe a
IntMap.lookup Int
n IntMap CIDInfo
cidInfos of
        Maybe CIDInfo
Nothing -> Bool
False
        Just (CIDInfo Int
_ CID
_ StatelessResetToken
srt0) -> StatelessResetToken
srt StatelessResetToken -> StatelessResetToken -> Bool
forall a. Eq a => a -> a -> Bool
== StatelessResetToken
srt0

----------------------------------------------------------------

validatePath :: Connection -> Maybe CIDInfo -> IO ()
validatePath :: Connection -> Maybe CIDInfo -> IO ()
validatePath Connection
conn Maybe CIDInfo
Nothing = do
    PathData
pdat <- IO PathData
newPathData
    Connection -> [PathData] -> IO ()
setChallenges Connection
conn [PathData
pdat]
    Connection -> Output -> IO ()
putOutput Connection
conn (Output -> IO ()) -> Output -> IO ()
forall a b. (a -> b) -> a -> b
$ EncryptionLevel -> [Frame] -> IO () -> Output
OutControl EncryptionLevel
RTT1Level [PathData -> Frame
PathChallenge PathData
pdat] (IO () -> Output) -> IO () -> Output
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Connection -> IO ()
waitResponse Connection
conn
validatePath Connection
conn (Just (CIDInfo Int
retiredSeqNum CID
_ StatelessResetToken
_)) = do
    PathData
pdat <- IO PathData
newPathData
    Connection -> [PathData] -> IO ()
setChallenges Connection
conn [PathData
pdat]
    Connection -> Output -> IO ()
putOutput Connection
conn (Output -> IO ()) -> Output -> IO ()
forall a b. (a -> b) -> a -> b
$ EncryptionLevel -> [Frame] -> IO () -> Output
OutControl EncryptionLevel
RTT1Level [PathData -> Frame
PathChallenge PathData
pdat, Int -> Frame
RetireConnectionID Int
retiredSeqNum] (IO () -> Output) -> IO () -> Output
forall a b. (a -> b) -> a -> b
$ () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    Connection -> IO ()
waitResponse Connection
conn
    Connection -> Int -> IO ()
retirePeerCID Connection
conn Int
retiredSeqNum

setChallenges :: Connection -> [PathData] -> IO ()
setChallenges :: Connection -> [PathData] -> IO ()
setChallenges Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} [PathData]
pdats =
    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar MigrationState -> MigrationState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar MigrationState
migrationState (MigrationState -> STM ()) -> MigrationState -> STM ()
forall a b. (a -> b) -> a -> b
$ [PathData] -> MigrationState
SendChallenge [PathData]
pdats

setMigrationStarted :: Connection -> IO ()
setMigrationStarted :: Connection -> IO ()
setMigrationStarted Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} =
    STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar MigrationState -> MigrationState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar MigrationState
migrationState MigrationState
MigrationStarted

isPathValidating :: Connection -> IO Bool
isPathValidating :: Connection -> IO Bool
isPathValidating Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = do
    MigrationState
s <- TVar MigrationState -> IO MigrationState
forall a. TVar a -> IO a
readTVarIO TVar MigrationState
migrationState
    case MigrationState
s of
      SendChallenge [PathData]
_  -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      MigrationState
MigrationStarted -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      MigrationState
_                -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

waitResponse :: Connection -> IO ()
waitResponse :: Connection -> IO ()
waitResponse Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} = STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
    MigrationState
state <- TVar MigrationState -> STM MigrationState
forall a. TVar a -> STM a
readTVar TVar MigrationState
migrationState
    Bool -> STM ()
check (MigrationState
state MigrationState -> MigrationState -> Bool
forall a. Eq a => a -> a -> Bool
== MigrationState
RecvResponse)
    TVar MigrationState -> MigrationState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar MigrationState
migrationState MigrationState
NonMigration

checkResponse :: Connection -> PathData -> IO ()
checkResponse :: Connection -> PathData -> IO ()
checkResponse Connection{Array EncryptionLevel (TVar [ReceivedPacket])
IOArray Bool Coder1RTT
IOArray EncryptionLevel Cipher
IOArray EncryptionLevel Protector
IOArray EncryptionLevel Coder
ThreadId
TVar Bool
TVar Int
TVar Flow
TVar Concurrency
TVar MigrationState
TVar CIDDB
IORef Int
IORef [Socket]
IORef (IO ())
IORef (Bool, Int)
IORef Microseconds
IORef Version
IORef Flow
IORef StreamTable
IORef AuthCIDs
IORef Parameters
IORef Concurrency
IORef Negotiated
IORef CIDDB
IORef RoleInfo
MigrationQ
OutputQ
CryptoQ
InputQ
RecvQ
ConnState
Parameters
LDCC
Hooks
Shared
DebugLogger
QLogger
connLDCC :: LDCC
connResources :: IORef (IO ())
handshakeCIDs :: IORef AuthCIDs
negotiated :: IORef Negotiated
currentKeyPhase :: IORef (Bool, Int)
protectors :: IOArray EncryptionLevel Protector
coders1RTT :: IOArray Bool Coder1RTT
coders :: IOArray EncryptionLevel Coder
ciphers :: IOArray EncryptionLevel Cipher
pendingQ :: Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: TVar Bool
bytesRx :: TVar Int
bytesTx :: TVar Int
minIdleTimeout :: IORef Microseconds
migrationState :: TVar MigrationState
flowRx :: IORef Flow
flowTx :: TVar Flow
peerStreamId :: IORef Concurrency
myUniStreamId :: TVar Concurrency
myStreamId :: TVar Concurrency
streamTable :: IORef StreamTable
peerPacketNumber :: IORef Int
delayedAckCancel :: IORef (IO ())
delayedAckCount :: IORef Int
shared :: Shared
migrationQ :: MigrationQ
outputQ :: OutputQ
cryptoQ :: CryptoQ
inputQ :: InputQ
peerCIDDB :: TVar CIDDB
peerParameters :: IORef Parameters
myCIDDB :: IORef CIDDB
myParameters :: Parameters
quicVersion :: IORef Version
roleInfo :: IORef RoleInfo
mainThreadId :: ThreadId
tmouter :: IORef (IO ())
readers :: IORef (IO ())
sockets :: IORef [Socket]
connRecvQ :: RecvQ
connHooks :: Hooks
connQLog :: QLogger
connDebugLog :: DebugLogger
connState :: ConnState
connLDCC :: Connection -> LDCC
connResources :: Connection -> IORef (IO ())
handshakeCIDs :: Connection -> IORef AuthCIDs
negotiated :: Connection -> IORef Negotiated
currentKeyPhase :: Connection -> IORef (Bool, Int)
protectors :: Connection -> IOArray EncryptionLevel Protector
coders1RTT :: Connection -> IOArray Bool Coder1RTT
coders :: Connection -> IOArray EncryptionLevel Coder
ciphers :: Connection -> IOArray EncryptionLevel Cipher
pendingQ :: Connection -> Array EncryptionLevel (TVar [ReceivedPacket])
addressValidated :: Connection -> TVar Bool
bytesRx :: Connection -> TVar Int
bytesTx :: Connection -> TVar Int
minIdleTimeout :: Connection -> IORef Microseconds
migrationState :: Connection -> TVar MigrationState
flowRx :: Connection -> IORef Flow
flowTx :: Connection -> TVar Flow
peerStreamId :: Connection -> IORef Concurrency
myUniStreamId :: Connection -> TVar Concurrency
myStreamId :: Connection -> TVar Concurrency
streamTable :: Connection -> IORef StreamTable
peerPacketNumber :: Connection -> IORef Int
delayedAckCancel :: Connection -> IORef (IO ())
delayedAckCount :: Connection -> IORef Int
shared :: Connection -> Shared
migrationQ :: Connection -> MigrationQ
outputQ :: Connection -> OutputQ
cryptoQ :: Connection -> CryptoQ
inputQ :: Connection -> InputQ
peerCIDDB :: Connection -> TVar CIDDB
peerParameters :: Connection -> IORef Parameters
myCIDDB :: Connection -> IORef CIDDB
myParameters :: Connection -> Parameters
quicVersion :: Connection -> IORef Version
roleInfo :: Connection -> IORef RoleInfo
mainThreadId :: Connection -> ThreadId
tmouter :: Connection -> IORef (IO ())
readers :: Connection -> IORef (IO ())
sockets :: Connection -> IORef [Socket]
connRecvQ :: Connection -> RecvQ
connHooks :: Connection -> Hooks
connQLog :: Connection -> QLogger
connDebugLog :: Connection -> DebugLogger
connState :: Connection -> ConnState
..} PathData
pdat = do
    MigrationState
state <- TVar MigrationState -> IO MigrationState
forall a. TVar a -> IO a
readTVarIO TVar MigrationState
migrationState
    case MigrationState
state of
      SendChallenge [PathData]
pdats
        | PathData
pdat PathData -> [PathData] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [PathData]
pdats -> STM () -> IO ()
forall a. STM a -> IO a
atomically (STM () -> IO ()) -> STM () -> IO ()
forall a b. (a -> b) -> a -> b
$ TVar MigrationState -> MigrationState -> STM ()
forall a. TVar a -> a -> STM ()
writeTVar TVar MigrationState
migrationState MigrationState
RecvResponse
      MigrationState
_ -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()