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

module Network.QUIC.Receiver (
    receiver,
) where

import qualified Data.ByteString as BS
import Network.Control
import Network.TLS (AlertDescription (..))
import UnliftIO.Concurrent (forkIO)
import qualified UnliftIO.Exception as E

import Network.QUIC.Config
import Network.QUIC.Connection
import Network.QUIC.Connector
import Network.QUIC.Crypto
import Network.QUIC.Exception
import Network.QUIC.Imports
import Network.QUIC.Logger
import Network.QUIC.Packet
import Network.QUIC.Parameters
import Network.QUIC.Qlog
import Network.QUIC.Recovery
import Network.QUIC.Server.Reader (runNewServerReader)
import Network.QUIC.Stream
import Network.QUIC.Types as QUIC

receiver :: Connection -> IO ()
receiver :: Connection -> IO ()
receiver Connection
conn = DebugLogger -> IO () -> IO ()
forall a. DebugLogger -> IO a -> IO a
handleLogT DebugLogger
logAction IO ()
forall {b}. IO b
body
  where
    body :: IO b
body = do
        IO ()
loopHandshake
        IO b
forall {b}. IO b
loopEstablished
    recvTimeout :: IO ReceivedPacket
recvTimeout = do
        -- The spec says that CC is not sent when timeout.
        -- But we intentionally sends CC when timeout.
        Microseconds
ito <- Connection -> IO Microseconds
readMinIdleTimeout Connection
conn
        Maybe ReceivedPacket
mx <- Microseconds
-> String -> IO ReceivedPacket -> IO (Maybe ReceivedPacket)
forall a. Microseconds -> String -> IO a -> IO (Maybe a)
timeout Microseconds
ito String
"recvTimeout" (IO ReceivedPacket -> IO (Maybe ReceivedPacket))
-> IO ReceivedPacket -> IO (Maybe ReceivedPacket)
forall a b. (a -> b) -> a -> b
$ Connection -> IO ReceivedPacket
connRecv Connection
conn -- fixme: taking minimum with peer's one
        case Maybe ReceivedPacket
mx of
            Maybe ReceivedPacket
Nothing -> do
                ConnectionState
st <- Connection -> IO ConnectionState
forall a. Connector a => a -> IO ConnectionState
getConnectionState Connection
conn
                let msg0 :: String
msg0
                        | Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn = String
"Client"
                        | Bool
otherwise = String
"Server"
                    msg :: String
msg = String
msg0 String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" " String -> String -> String
forall a. [a] -> [a] -> [a]
++ ConnectionState -> String
forall a. Show a => a -> String
show ConnectionState
st
                QUICException -> IO ReceivedPacket
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO (QUICException -> IO ReceivedPacket)
-> QUICException -> IO ReceivedPacket
forall a b. (a -> b) -> a -> b
$ String -> QUICException
ConnectionIsTimeout String
msg
            Just ReceivedPacket
x -> ReceivedPacket -> IO ReceivedPacket
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ReceivedPacket
x
    loopHandshake :: IO ()
loopHandshake = do
        ReceivedPacket
rpkt <- IO ReceivedPacket
recvTimeout
        Connection -> ReceivedPacket -> IO ()
processReceivedPacketHandshake Connection
conn ReceivedPacket
rpkt
        Bool
established <- Connection -> IO Bool
forall a. Connector a => a -> IO Bool
isConnectionEstablished Connection
conn
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
established IO ()
loopHandshake
    loopEstablished :: IO b
loopEstablished = IO () -> IO b
forall (f :: * -> *) a b. Applicative f => f a -> f b
forever (IO () -> IO b) -> IO () -> IO b
forall a b. (a -> b) -> a -> b
$ do
        ReceivedPacket
rpkt <- IO ReceivedPacket
recvTimeout
        let CryptPacket Header
hdr Crypt
_ = ReceivedPacket -> CryptPacket
rpCryptPacket ReceivedPacket
rpkt
            cid :: CID
cid = Header -> CID
headerMyCID Header
hdr
        Maybe StreamId
included <- Connection -> CID -> IO (Maybe StreamId)
myCIDsInclude Connection
conn CID
cid
        case Maybe StreamId
included of
            Just StreamId
nseq -> do
                Bool
shouldUpdate <- Connection -> StreamId -> IO Bool
shouldUpdateMyCID Connection
conn StreamId
nseq
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldUpdate (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    Connection -> CID -> IO ()
setMyCID Connection
conn CID
cid
                    CIDInfo
cidInfo <- Connection -> IO CIDInfo
getNewMyCID Connection
conn
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> Bool
forall a. Connector a => a -> Bool
isServer Connection
conn) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        CID -> Connection -> IO ()
register <- Connection -> IO (CID -> Connection -> IO ())
getRegister Connection
conn
                        CID -> Connection -> IO ()
register (CIDInfo -> CID
cidInfoCID CIDInfo
cidInfo) Connection
conn
                    Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
RTT1Level [CIDInfo -> StreamId -> Frame
NewConnectionID CIDInfo
cidInfo StreamId
0]
                Connection -> ReceivedPacket -> IO ()
processReceivedPacket Connection
conn ReceivedPacket
rpkt
                Bool
shouldUpdatePeer <-
                    if Bool
shouldUpdate
                        then Connection -> IO Bool
shouldUpdatePeerCID Connection
conn
                        else Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
shouldUpdatePeer (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> IO ()
choosePeerCIDForPrivacy Connection
conn
            Maybe StreamId
_ -> do
                Connection -> Header -> IO ()
forall q a. (KeepQlog q, Qlog a) => q -> a -> IO ()
qlogDropped Connection
conn Header
hdr
                Connection -> DebugLogger
connDebugLog Connection
conn DebugLogger -> DebugLogger
forall a b. (a -> b) -> a -> b
$ CID -> Builder
forall a. Show a => a -> Builder
bhow CID
cid Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" is unknown"
    logAction :: DebugLogger
logAction Builder
msg = Connection -> DebugLogger
connDebugLog Connection
conn (Builder
"debug: receiver: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
msg)

processReceivedPacketHandshake :: Connection -> ReceivedPacket -> IO ()
processReceivedPacketHandshake :: Connection -> ReceivedPacket -> IO ()
processReceivedPacketHandshake Connection
conn ReceivedPacket
rpkt = do
    let CryptPacket Header
hdr Crypt
_ = ReceivedPacket -> CryptPacket
rpCryptPacket ReceivedPacket
rpkt
        lvl :: EncryptionLevel
lvl = ReceivedPacket -> EncryptionLevel
rpEncryptionLevel ReceivedPacket
rpkt
        msg :: String
msg =
            String
"processReceivedPacketHandshake "
                String -> String -> String
forall a. [a] -> [a] -> [a]
++ if Connection -> Bool
forall a. Connector a => a -> Bool
isServer Connection
conn then String
"Server" else String
"Client"
    Maybe ()
mx <- Microseconds -> String -> IO () -> IO (Maybe ())
forall a. Microseconds -> String -> IO a -> IO (Maybe a)
timeout (StreamId -> Microseconds
Microseconds StreamId
10000) String
msg (IO () -> IO (Maybe ())) -> IO () -> IO (Maybe ())
forall a b. (a -> b) -> a -> b
$ Connection -> EncryptionLevel -> IO ()
waitEncryptionLevel Connection
conn EncryptionLevel
lvl
    case Maybe ()
mx of
        Maybe ()
Nothing -> do
            Connection -> EncryptionLevel -> ReceivedPacket -> IO ()
putOffCrypto Connection
conn EncryptionLevel
lvl ReceivedPacket
rpkt
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                EncryptionLevel
lvl' <- Connection -> IO EncryptionLevel
forall a. Connector a => a -> IO EncryptionLevel
getEncryptionLevel Connection
conn
                LDCC -> EncryptionLevel -> LogStr -> IO ()
speedup (Connection -> LDCC
connLDCC Connection
conn) EncryptionLevel
lvl' LogStr
"not decryptable"
        Just ()
            | Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn -> do
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
InitialLevel) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    CID
peercid <- Connection -> IO CID
getPeerCID Connection
conn
                    let newPeerCID :: CID
newPeerCID = Header -> CID
headerPeerCID Header
hdr
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (CID
peercid CID -> CID -> Bool
forall a. Eq a => a -> a -> Bool
/= Header -> CID
headerPeerCID Header
hdr) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                        Connection -> CID -> IO ()
resetPeerCID Connection
conn CID
newPeerCID
                    Connection -> (AuthCIDs -> AuthCIDs) -> IO ()
setPeerAuthCIDs Connection
conn ((AuthCIDs -> AuthCIDs) -> IO ())
-> (AuthCIDs -> AuthCIDs) -> IO ()
forall a b. (a -> b) -> a -> b
$ \AuthCIDs
auth ->
                        AuthCIDs
auth{initSrcCID = Just newPeerCID}
                case Header
hdr of
                    Initial Version
peerVer CID
_ CID
_ ByteString
_ -> do
                        Version
myVer <- Connection -> IO Version
getVersion Connection
conn
                        let myOrigiVer :: Version
myOrigiVer = Connection -> Version
getOriginalVersion Connection
conn
                            firstTime :: Bool
firstTime = Version
myVer Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
== Version
myOrigiVer
                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
firstTime Bool -> Bool -> Bool
&& Version
myVer Version -> Version -> Bool
forall a. Eq a => a -> a -> Bool
/= Version
peerVer) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                            Connection -> Version -> IO ()
setVersion Connection
conn Version
peerVer
                            CID
dcid <- Connection -> IO CID
getClientDstCID Connection
conn
                            Connection
-> EncryptionLevel -> TrafficSecrets InitialSecret -> IO ()
forall a.
Connection -> EncryptionLevel -> TrafficSecrets a -> IO ()
initializeCoder Connection
conn EncryptionLevel
InitialLevel (TrafficSecrets InitialSecret -> IO ())
-> TrafficSecrets InitialSecret -> IO ()
forall a b. (a -> b) -> a -> b
$ Version -> CID -> TrafficSecrets InitialSecret
initialSecrets Version
peerVer CID
dcid
                    Header
_ -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Connection -> ReceivedPacket -> IO ()
processReceivedPacket Connection
conn ReceivedPacket
rpkt
            | Bool
otherwise -> do
                CID
mycid <- Connection -> IO CID
getMyCID Connection
conn
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when
                    ( EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
HandshakeLevel
                        Bool -> Bool -> Bool
|| (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
InitialLevel Bool -> Bool -> Bool
&& CID
mycid CID -> CID -> Bool
forall a. Eq a => a -> a -> Bool
== Header -> CID
headerMyCID Header
hdr)
                    )
                    (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        Connection -> IO ()
setAddressValidated Connection
conn
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
HandshakeLevel) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    let ldcc :: LDCC
ldcc = Connection -> LDCC
connLDCC Connection
conn
                    Bool
discarded <- LDCC -> EncryptionLevel -> IO Bool
getAndSetPacketNumberSpaceDiscarded LDCC
ldcc EncryptionLevel
InitialLevel
                    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
discarded (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> Microseconds -> IO () -> IO ()
fire Connection
conn (StreamId -> Microseconds
Microseconds StreamId
100000) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                        Connection -> EncryptionLevel -> IO ()
dropSecrets Connection
conn EncryptionLevel
InitialLevel
                        Connection -> EncryptionLevel -> IO ()
clearCryptoStream Connection
conn EncryptionLevel
InitialLevel
                        LDCC -> EncryptionLevel -> IO ()
onPacketNumberSpaceDiscarded LDCC
ldcc EncryptionLevel
InitialLevel
                Connection -> ReceivedPacket -> IO ()
processReceivedPacket Connection
conn ReceivedPacket
rpkt

rateLimit :: Int
rateLimit :: StreamId
rateLimit = StreamId
10

checkRate :: [Frame] -> Int
checkRate :: [Frame] -> StreamId
checkRate [Frame]
fs0 = [Frame] -> StreamId -> StreamId
forall {t}. Num t => [Frame] -> t -> t
go [Frame]
fs0 StreamId
0
  where
    go :: [Frame] -> t -> t
go [] t
n = t
n
    go (Frame
f : [Frame]
fs) t
n
        | Frame -> Bool
rateControled Frame
f = [Frame] -> t -> t
go [Frame]
fs (t
n t -> t -> t
forall a. Num a => a -> a -> a
+ t
1)
        | Bool
otherwise = [Frame] -> t -> t
go [Frame]
fs t
n

processReceivedPacket :: Connection -> ReceivedPacket -> IO ()
processReceivedPacket :: Connection -> ReceivedPacket -> IO ()
processReceivedPacket Connection
conn ReceivedPacket
rpkt = do
    let CryptPacket Header
hdr Crypt
crypt = ReceivedPacket -> CryptPacket
rpCryptPacket ReceivedPacket
rpkt
        lvl :: EncryptionLevel
lvl = ReceivedPacket -> EncryptionLevel
rpEncryptionLevel ReceivedPacket
rpkt
        tim :: TimeMicrosecond
tim = ReceivedPacket -> TimeMicrosecond
rpTimeRecevied ReceivedPacket
rpkt
    Maybe Plain
mplain <- Connection -> Crypt -> EncryptionLevel -> IO (Maybe Plain)
decryptCrypt Connection
conn Crypt
crypt EncryptionLevel
lvl
    case Maybe Plain
mplain of
        Just plain :: Plain
plain@Plain{StreamId
[Frame]
Flags Raw
plainFlags :: Flags Raw
plainPacketNumber :: StreamId
plainFrames :: [Frame]
plainMarks :: StreamId
plainFlags :: Plain -> Flags Raw
plainPacketNumber :: Plain -> StreamId
plainFrames :: Plain -> [Frame]
plainMarks :: Plain -> StreamId
..} -> do
            Connection -> StreamId -> IO ()
addRxBytes Connection
conn (StreamId -> IO ()) -> StreamId -> IO ()
forall a b. (a -> b) -> a -> b
$ ReceivedPacket -> StreamId
rpReceivedBytes ReceivedPacket
rpkt
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StreamId -> Bool
isIllegalReservedBits StreamId
plainMarks Bool -> Bool -> Bool
|| StreamId -> Bool
isNoFrames StreamId
plainMarks) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ProtocolViolation ReasonPhrase
"Non 0 RR bits or no frames"
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StreamId -> Bool
isUnknownFrame StreamId
plainMarks) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
FrameEncodingError ReasonPhrase
"Unknown frame"
            let controlled :: StreamId
controlled = [Frame] -> StreamId
checkRate [Frame]
plainFrames
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StreamId
controlled StreamId -> StreamId -> Bool
forall a. Eq a => a -> a -> Bool
/= StreamId
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                StreamId
rate <- Rate -> StreamId -> IO StreamId
addRate (Connection -> Rate
controlRate Connection
conn) StreamId
controlled
                Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StreamId
rate StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
> StreamId
rateLimit) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                    TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
QUIC.InternalError ReasonPhrase
"Rate control"
            -- For Ping, record PPN first, then send an ACK.
            LDCC -> EncryptionLevel -> StreamId -> IO ()
onPacketReceived (Connection -> LDCC
connLDCC Connection
conn) EncryptionLevel
lvl StreamId
plainPacketNumber
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
RTT1Level) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> StreamId -> IO ()
setPeerPacketNumber Connection
conn StreamId
plainPacketNumber
            Connection -> PlainPacket -> TimeMicrosecond -> IO ()
forall q a.
(KeepQlog q, Qlog a) =>
q -> a -> TimeMicrosecond -> IO ()
qlogReceived Connection
conn (Header -> Plain -> PlainPacket
PlainPacket Header
hdr Plain
plain) TimeMicrosecond
tim
            let ackEli :: Bool
ackEli = (Frame -> Bool) -> [Frame] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any Frame -> Bool
ackEliciting [Frame]
plainFrames
            case Crypt -> Maybe MigrationInfo
cryptMigraionInfo Crypt
crypt of
                Maybe MigrationInfo
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                Just MigrationInfo
miginfo ->
                    IO ThreadId -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO ThreadId -> IO ()) -> (IO () -> IO ThreadId) -> IO () -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. IO () -> IO ThreadId
forall (m :: * -> *). MonadUnliftIO m => m () -> m ThreadId
forkIO (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> MigrationInfo -> IO ()
runNewServerReader Connection
conn MigrationInfo
miginfo
            (Bool
ckp, StreamId
cpn) <- Connection -> IO (Bool, StreamId)
getCurrentKeyPhase Connection
conn
            let Flags Word8
flags = Flags Raw
plainFlags
                nkp :: Bool
nkp = Word8
flags Word8 -> StreamId -> Bool
forall a. Bits a => a -> StreamId -> Bool
`testBit` StreamId
2
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Bool
nkp Bool -> Bool -> Bool
forall a. Eq a => a -> a -> Bool
/= Bool
ckp Bool -> Bool -> Bool
&& StreamId
plainPacketNumber StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
> StreamId
cpn) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                Connection -> Bool -> StreamId -> IO ()
setCurrentKeyPhase Connection
conn Bool
nkp StreamId
plainPacketNumber
                Connection -> Bool -> IO ()
updateCoder1RTT Connection
conn Bool
ckp -- ckp is now next
            (Frame -> IO ()) -> [Frame] -> IO ()
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ (Connection -> EncryptionLevel -> Frame -> IO ()
processFrame Connection
conn EncryptionLevel
lvl) [Frame]
plainFrames
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ackEli (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                case EncryptionLevel
lvl of
                    EncryptionLevel
RTT0Level -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
                    EncryptionLevel
RTT1Level -> Connection -> IO ()
delayedAck Connection
conn
                    EncryptionLevel
_ -> do
                        Bool
sup <- LDCC -> IO Bool
getSpeedingUp (Connection -> LDCC
connLDCC Connection
conn)
                        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
sup (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                            Connection -> Debug -> IO ()
forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug Connection
conn (Debug -> IO ()) -> Debug -> IO ()
forall a b. (a -> b) -> a -> b
$ LogStr -> Debug
Debug LogStr
"ping for speedup"
                            Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
lvl [Frame
Ping]
        Maybe Plain
Nothing -> do
            Bool
statelessReset <- Connection -> Header -> Crypt -> IO Bool
isStatelessReset Connection
conn Header
hdr Crypt
crypt
            if Bool
statelessReset
                then do
                    Connection -> StatelessReset -> TimeMicrosecond -> IO ()
forall q a.
(KeepQlog q, Qlog a) =>
q -> a -> TimeMicrosecond -> IO ()
qlogReceived Connection
conn StatelessReset
StatelessReset TimeMicrosecond
tim
                    Connection -> DebugLogger
connDebugLog Connection
conn Builder
"debug: connection is reset statelessly"
                    QUICException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO QUICException
ConnectionIsReset
                else do
                    Connection -> Header -> IO ()
forall q a. (KeepQlog q, Qlog a) => q -> a -> IO ()
qlogDropped Connection
conn Header
hdr
                    Connection -> DebugLogger
connDebugLog Connection
conn DebugLogger -> DebugLogger
forall a b. (a -> b) -> a -> b
$
                        Builder
"debug: cannot decrypt: "
                            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> EncryptionLevel -> Builder
forall a. Show a => a -> Builder
bhow EncryptionLevel
lvl
                            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
" size = "
                            Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> StreamId -> Builder
forall a. Show a => a -> Builder
bhow (ByteString -> StreamId
BS.length (ByteString -> StreamId) -> ByteString -> StreamId
forall a b. (a -> b) -> a -> b
$ Crypt -> ByteString
cryptPacket Crypt
crypt)

-- fixme: sending statelss reset

isSendOnly :: Connection -> StreamId -> Bool
isSendOnly :: Connection -> StreamId -> Bool
isSendOnly Connection
conn StreamId
sid
    | Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn = StreamId -> Bool
isClientInitiatedUnidirectional StreamId
sid
    | Bool
otherwise = StreamId -> Bool
isServerInitiatedUnidirectional StreamId
sid

isReceiveOnly :: Connection -> StreamId -> Bool
isReceiveOnly :: Connection -> StreamId -> Bool
isReceiveOnly Connection
conn StreamId
sid
    | Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn = StreamId -> Bool
isServerInitiatedUnidirectional StreamId
sid
    | Bool
otherwise = StreamId -> Bool
isClientInitiatedUnidirectional StreamId
sid

isInitiated :: Connection -> StreamId -> Bool
isInitiated :: Connection -> StreamId -> Bool
isInitiated Connection
conn StreamId
sid
    | Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn = StreamId -> Bool
isClientInitiated StreamId
sid
    | Bool
otherwise = StreamId -> Bool
isServerInitiated StreamId
sid

guardStream :: Connection -> StreamId -> Maybe Stream -> IO ()
guardStream :: Connection -> StreamId -> Maybe Stream -> IO ()
guardStream Connection
conn StreamId
sid Maybe Stream
Nothing
    | Connection -> StreamId -> Bool
isInitiated Connection
conn StreamId
sid = do
        StreamId
curSid <- Connection -> IO StreamId
getMyStreamId Connection
conn
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StreamId
sid StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
> StreamId
curSid) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
            TransportError -> ReasonPhrase -> IO ()
closeConnection
                TransportError
StreamStateError
                ReasonPhrase
"a locally-initiated stream that has not yet been created"
guardStream Connection
_ StreamId
_ Maybe Stream
_ = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()

processFrame :: Connection -> EncryptionLevel -> Frame -> IO ()
processFrame :: Connection -> EncryptionLevel -> Frame -> IO ()
processFrame Connection
_ EncryptionLevel
_ Padding{} = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
processFrame Connection
conn EncryptionLevel
lvl Frame
Ping = do
    -- see ackEli above
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
/= EncryptionLevel
InitialLevel Bool -> Bool -> Bool
&& EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
/= EncryptionLevel
RTT1Level) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
lvl []
processFrame Connection
conn EncryptionLevel
lvl (Ack AckInfo
ackInfo Delay
ackDelay) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
RTT0Level) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ProtocolViolation ReasonPhrase
"ACK"
    LDCC -> EncryptionLevel -> AckInfo -> Microseconds -> IO ()
onAckReceived (Connection -> LDCC
connLDCC Connection
conn) EncryptionLevel
lvl AckInfo
ackInfo (Microseconds -> IO ()) -> Microseconds -> IO ()
forall a b. (a -> b) -> a -> b
$ Delay -> Microseconds
milliToMicro Delay
ackDelay
processFrame Connection
conn EncryptionLevel
lvl (ResetStream StreamId
sid ApplicationProtocolError
aerr StreamId
_finlen) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
InitialLevel Bool -> Bool -> Bool
|| EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
HandshakeLevel) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ProtocolViolation ReasonPhrase
"RESET_STREAM"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> StreamId -> Bool
isSendOnly Connection
conn StreamId
sid) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
StreamStateError ReasonPhrase
"Received in a send-only stream"
    Maybe Stream
mstrm <- Connection -> StreamId -> IO (Maybe Stream)
findStream Connection
conn StreamId
sid
    case Maybe Stream
mstrm of
        Maybe Stream
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just Stream
strm -> do
            Hooks -> Stream -> ApplicationProtocolError -> IO ()
onResetStreamReceived (Connection -> Hooks
connHooks Connection
conn) Stream
strm ApplicationProtocolError
aerr
            Stream -> IO ()
setTxStreamClosed Stream
strm
            Stream -> IO ()
setRxStreamClosed Stream
strm
            Connection -> Stream -> IO ()
delStream Connection
conn Stream
strm
processFrame Connection
conn EncryptionLevel
lvl (StopSending StreamId
sid ApplicationProtocolError
err) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
InitialLevel Bool -> Bool -> Bool
|| EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
HandshakeLevel) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ProtocolViolation ReasonPhrase
"STOP_SENDING"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> StreamId -> Bool
isReceiveOnly Connection
conn StreamId
sid) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
StreamStateError ReasonPhrase
"Receive-only stream"
    Maybe Stream
mstrm <- Connection -> StreamId -> IO (Maybe Stream)
findStream Connection
conn StreamId
sid
    case Maybe Stream
mstrm of
        Maybe Stream
Nothing -> do
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> StreamId -> Bool
isInitiated Connection
conn StreamId
sid) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
StreamStateError ReasonPhrase
"No such stream for STOP_SENDING"
        Just Stream
_strm -> Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFramesLim Connection
conn EncryptionLevel
lvl [StreamId -> ApplicationProtocolError -> StreamId -> Frame
ResetStream StreamId
sid ApplicationProtocolError
err StreamId
0]
processFrame Connection
_ EncryptionLevel
_ (CryptoF StreamId
_ ByteString
"") = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
processFrame Connection
conn EncryptionLevel
lvl (CryptoF StreamId
off ByteString
cdat) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
RTT0Level) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ProtocolViolation ReasonPhrase
"CRYPTO in 0-RTT"
    let len :: StreamId
len = ByteString -> StreamId
BS.length ByteString
cdat
        rx :: RxStreamData
rx = ByteString -> StreamId -> StreamId -> Bool -> RxStreamData
RxStreamData ByteString
cdat StreamId
off StreamId
len Bool
False
    case EncryptionLevel
lvl of
        EncryptionLevel
InitialLevel -> do
            Bool
dup <- Connection -> EncryptionLevel -> RxStreamData -> IO Bool
putRxCrypto Connection
conn EncryptionLevel
lvl RxStreamData
rx
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
dup (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LDCC -> EncryptionLevel -> LogStr -> IO ()
speedup (Connection -> LDCC
connLDCC Connection
conn) EncryptionLevel
lvl LogStr
"duplicated"
        EncryptionLevel
RTT0Level -> do
            Connection -> DebugLogger
connDebugLog Connection
conn DebugLogger -> DebugLogger
forall a b. (a -> b) -> a -> b
$ Builder
"processFrame: invalid packet type " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> EncryptionLevel -> Builder
forall a. Show a => a -> Builder
bhow EncryptionLevel
lvl
        EncryptionLevel
HandshakeLevel -> do
            Bool
dup <- Connection -> EncryptionLevel -> RxStreamData -> IO Bool
putRxCrypto Connection
conn EncryptionLevel
lvl RxStreamData
rx
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
dup (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ LDCC -> EncryptionLevel -> LogStr -> IO ()
speedup (Connection -> LDCC
connLDCC Connection
conn) EncryptionLevel
lvl LogStr
"duplicated"
        EncryptionLevel
RTT1Level
            | Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn ->
                IO Bool -> IO ()
forall (f :: * -> *) a. Functor f => f a -> f ()
void (IO Bool -> IO ()) -> IO Bool -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> EncryptionLevel -> RxStreamData -> IO Bool
putRxCrypto Connection
conn EncryptionLevel
lvl RxStreamData
rx
            | Bool
otherwise ->
                TransportError -> ReasonPhrase -> IO ()
closeConnection (AlertDescription -> TransportError
cryptoError AlertDescription
UnexpectedMessage) ReasonPhrase
"CRYPTO in 1-RTT"
processFrame Connection
conn EncryptionLevel
lvl (NewToken ByteString
token) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> Bool
forall a. Connector a => a -> Bool
isServer Connection
conn Bool -> Bool -> Bool
|| EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
/= EncryptionLevel
RTT1Level) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ProtocolViolation ReasonPhrase
"NEW_TOKEN for server or in 1-RTT"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> ByteString -> IO ()
setNewToken Connection
conn ByteString
token
processFrame Connection
conn EncryptionLevel
RTT0Level (StreamF StreamId
sid StreamId
off (ByteString
dat : [ByteString]
_) Bool
fin) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StreamId
off StreamId -> StreamId -> Bool
forall a. Eq a => a -> a -> Bool
== StreamId
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> StreamId -> IO ()
updatePeerStreamId Connection
conn StreamId
sid
    -- FLOW CONTROL: MAX_STREAMS: recv: rejecting if over my limit
    Bool
ok <- Connection -> StreamId -> IO Bool
checkRxMaxStreams Connection
conn StreamId
sid
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
StreamLimitError ReasonPhrase
"stream id is too large"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> StreamId -> Bool
isSendOnly Connection
conn StreamId
sid) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
StreamStateError ReasonPhrase
"send-only stream"
    Maybe Stream
mstrm <- Connection -> StreamId -> IO (Maybe Stream)
findStream Connection
conn StreamId
sid
    Connection -> StreamId -> Maybe Stream -> IO ()
guardStream Connection
conn StreamId
sid Maybe Stream
mstrm
    Stream
strm <- IO Stream -> (Stream -> IO Stream) -> Maybe Stream -> IO Stream
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Connection -> StreamId -> IO Stream
createStream Connection
conn StreamId
sid) Stream -> IO Stream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Stream
mstrm
    let len :: StreamId
len = ByteString -> StreamId
BS.length ByteString
dat
        rx :: RxStreamData
rx = ByteString -> StreamId -> StreamId -> Bool -> RxStreamData
RxStreamData ByteString
dat StreamId
off StreamId
len Bool
fin
    FlowCntl
fc <- Stream -> RxStreamData -> IO FlowCntl
putRxStreamData Stream
strm RxStreamData
rx
    case FlowCntl
fc of
        -- FLOW CONTROL: MAX_STREAM_DATA: recv: rejecting if over my limit
        FlowCntl
OverLimit -> TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
FlowControlError ReasonPhrase
"Flow control error for stream in 0-RTT"
        FlowCntl
Duplicated -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        FlowCntl
Reassembled -> do
            Bool
ok' <- Connection -> StreamId -> IO Bool
checkRxMaxData Connection
conn StreamId
len
            -- FLOW CONTROL: MAX_DATA: send: respecting peer's limit
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok' (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
FlowControlError ReasonPhrase
"Flow control error for connection in 0-RTT"
processFrame Connection
conn EncryptionLevel
RTT1Level (StreamF StreamId
sid StreamId
_ [ByteString
""] Bool
False) = do
    -- FLOW CONTROL: MAX_STREAMS: recv: rejecting if over my limit
    Bool
ok <- Connection -> StreamId -> IO Bool
checkRxMaxStreams Connection
conn StreamId
sid
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
StreamLimitError ReasonPhrase
"stream id is too large"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> StreamId -> Bool
isSendOnly Connection
conn StreamId
sid) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
StreamStateError ReasonPhrase
"send-only stream"
    Maybe Stream
mstrm <- Connection -> StreamId -> IO (Maybe Stream)
findStream Connection
conn StreamId
sid
    Connection -> StreamId -> Maybe Stream -> IO ()
guardStream Connection
conn StreamId
sid Maybe Stream
mstrm
processFrame Connection
conn EncryptionLevel
RTT1Level (StreamF StreamId
sid StreamId
off (ByteString
dat : [ByteString]
_) Bool
fin) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StreamId
off StreamId -> StreamId -> Bool
forall a. Eq a => a -> a -> Bool
== StreamId
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> StreamId -> IO ()
updatePeerStreamId Connection
conn StreamId
sid
    -- FLOW CONTROL: MAX_STREAMS: recv: rejecting if over my limit
    Bool
ok <- Connection -> StreamId -> IO Bool
checkRxMaxStreams Connection
conn StreamId
sid
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
StreamLimitError ReasonPhrase
"stream id is too large"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> StreamId -> Bool
isSendOnly Connection
conn StreamId
sid) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
StreamStateError ReasonPhrase
"send-only stream"
    Maybe Stream
mstrm <- Connection -> StreamId -> IO (Maybe Stream)
findStream Connection
conn StreamId
sid
    Connection -> StreamId -> Maybe Stream -> IO ()
guardStream Connection
conn StreamId
sid Maybe Stream
mstrm
    Stream
strm <- IO Stream -> (Stream -> IO Stream) -> Maybe Stream -> IO Stream
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (Connection -> StreamId -> IO Stream
createStream Connection
conn StreamId
sid) Stream -> IO Stream
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Stream
mstrm
    let len :: StreamId
len = ByteString -> StreamId
BS.length ByteString
dat
        rx :: RxStreamData
rx = ByteString -> StreamId -> StreamId -> Bool -> RxStreamData
RxStreamData ByteString
dat StreamId
off StreamId
len Bool
fin
    FlowCntl
fc <- Stream -> RxStreamData -> IO FlowCntl
putRxStreamData Stream
strm RxStreamData
rx
    case FlowCntl
fc of
        -- FLOW CONTROL: MAX_STREAM_DATA: recv: rejecting if over my limit
        FlowCntl
OverLimit -> TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
FlowControlError ReasonPhrase
"Flow control error for stream in 1-RTT"
        FlowCntl
Duplicated -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        FlowCntl
Reassembled -> do
            Bool
ok' <- Connection -> StreamId -> IO Bool
checkRxMaxData Connection
conn StreamId
len
            -- FLOW CONTROL: MAX_DATA: send: respecting peer's limit
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok' (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
FlowControlError ReasonPhrase
"Flow control error for connection in 1-RTT"
processFrame Connection
conn EncryptionLevel
lvl (MaxData StreamId
n) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
InitialLevel Bool -> Bool -> Bool
|| EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
HandshakeLevel) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ProtocolViolation ReasonPhrase
"MAX_DATA in Initial or Handshake"
    Connection -> StreamId -> IO ()
setTxMaxData Connection
conn StreamId
n
processFrame Connection
conn EncryptionLevel
lvl (MaxStreamData StreamId
sid StreamId
n) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
InitialLevel Bool -> Bool -> Bool
|| EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
HandshakeLevel) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ProtocolViolation ReasonPhrase
"MAX_STREAM_DATA in Initial or Handshake"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> StreamId -> Bool
isReceiveOnly Connection
conn StreamId
sid) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
StreamStateError ReasonPhrase
"Receive-only stream"
    Maybe Stream
mstrm <- Connection -> StreamId -> IO (Maybe Stream)
findStream Connection
conn StreamId
sid
    case Maybe Stream
mstrm of
        Maybe Stream
Nothing -> do
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> StreamId -> Bool
isInitiated Connection
conn StreamId
sid) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
                TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
StreamStateError ReasonPhrase
"No such stream for MAX_STREAM_DATA"
        Just Stream
strm -> Stream -> StreamId -> IO ()
setTxMaxStreamData Stream
strm StreamId
n
processFrame Connection
conn EncryptionLevel
lvl (MaxStreams Direction
dir StreamId
n) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
InitialLevel Bool -> Bool -> Bool
|| EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
HandshakeLevel) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ProtocolViolation ReasonPhrase
"MAX_STREAMS in Initial or Handshake"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StreamId
n StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
> StreamId
2 StreamId -> StreamId -> StreamId
forall a b. (Num a, Integral b) => a -> b -> a
^ (StreamId
60 :: Int)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
FrameEncodingError ReasonPhrase
"Too large MAX_STREAMS"
    if Direction
dir Direction -> Direction -> Bool
forall a. Eq a => a -> a -> Bool
== Direction
Bidirectional
        then Connection -> StreamId -> IO ()
setTxMaxStreams Connection
conn StreamId
n
        else Connection -> StreamId -> IO ()
setTxUniMaxStreams Connection
conn StreamId
n
processFrame Connection
_conn EncryptionLevel
_lvl DataBlocked{} = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
processFrame Connection
_conn EncryptionLevel
_lvl (StreamDataBlocked StreamId
_sid StreamId
_) = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
processFrame Connection
_conn EncryptionLevel
lvl (StreamsBlocked Direction
_dir StreamId
n) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
InitialLevel Bool -> Bool -> Bool
|| EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
HandshakeLevel) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ProtocolViolation ReasonPhrase
"STREAMS_BLOCKED in Initial or Handshake"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StreamId
n StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
> StreamId
2 StreamId -> StreamId -> StreamId
forall a b. (Num a, Integral b) => a -> b -> a
^ (StreamId
60 :: Int)) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
FrameEncodingError ReasonPhrase
"Too large STREAMS_BLOCKED"
processFrame Connection
conn EncryptionLevel
lvl (NewConnectionID CIDInfo
cidInfo StreamId
rpt) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
InitialLevel Bool -> Bool -> Bool
|| EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
HandshakeLevel) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ProtocolViolation ReasonPhrase
"NEW_CONNECTION_ID in Initial or Handshake"
    Bool
ok <- Connection -> CIDInfo -> IO Bool
addPeerCID Connection
conn CIDInfo
cidInfo
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
ok (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ConnectionIdLimitError ReasonPhrase
"NEW_CONNECTION_ID limit error"
    let (ReasonPhrase
_, Word8
cidlen) = CID -> (ReasonPhrase, Word8)
unpackCID (CID -> (ReasonPhrase, Word8)) -> CID -> (ReasonPhrase, Word8)
forall a b. (a -> b) -> a -> b
$ CIDInfo -> CID
cidInfoCID CIDInfo
cidInfo
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Word8
cidlen Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
1 Bool -> Bool -> Bool
|| Word8
20 Word8 -> Word8 -> Bool
forall a. Ord a => a -> a -> Bool
< Word8
cidlen Bool -> Bool -> Bool
|| StreamId
rpt StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
> CIDInfo -> StreamId
cidInfoSeq CIDInfo
cidInfo) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
FrameEncodingError ReasonPhrase
"NEW_CONNECTION_ID parameter error"
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (StreamId
rpt StreamId -> StreamId -> Bool
forall a. Ord a => a -> a -> Bool
>= StreamId
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        [StreamId]
seqNums <- Connection -> StreamId -> IO [StreamId]
setPeerCIDAndRetireCIDs Connection
conn StreamId
rpt
        Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFramesLim Connection
conn EncryptionLevel
RTT1Level ([Frame] -> IO ()) -> [Frame] -> IO ()
forall a b. (a -> b) -> a -> b
$ (StreamId -> Frame) -> [StreamId] -> [Frame]
forall a b. (a -> b) -> [a] -> [b]
map StreamId -> Frame
RetireConnectionID [StreamId]
seqNums
processFrame Connection
conn EncryptionLevel
RTT1Level (RetireConnectionID StreamId
sn) = do
    Maybe CIDInfo
mcidInfo <- Connection -> StreamId -> IO (Maybe CIDInfo)
retireMyCID Connection
conn StreamId
sn
    case Maybe CIDInfo
mcidInfo of
        Maybe CIDInfo
Nothing -> () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
        Just (CIDInfo StreamId
_ CID
cid StatelessResetToken
_) -> do
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> Bool
forall a. Connector a => a -> Bool
isServer Connection
conn) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                CID -> IO ()
unregister <- Connection -> IO (CID -> IO ())
getUnregister Connection
conn
                CID -> IO ()
unregister CID
cid
processFrame Connection
conn EncryptionLevel
RTT1Level (PathChallenge PathData
dat) =
    Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFramesLim Connection
conn EncryptionLevel
RTT1Level [PathData -> Frame
PathResponse PathData
dat]
processFrame Connection
conn EncryptionLevel
RTT1Level (PathResponse PathData
dat) =
    -- RTT0Level falls intentionally
    Connection -> PathData -> IO ()
checkResponse Connection
conn PathData
dat
processFrame Connection
conn EncryptionLevel
_lvl (ConnectionClose TransportError
NoError StreamId
_ftyp ReasonPhrase
_reason) =
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> Bool
forall a. Connector a => a -> Bool
isServer Connection
conn) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ QUICException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO QUICException
ConnectionIsClosed
processFrame Connection
_conn EncryptionLevel
_lvl (ConnectionClose TransportError
err StreamId
_ftyp ReasonPhrase
reason) = do
    let quicexc :: QUICException
quicexc = TransportError -> ReasonPhrase -> QUICException
TransportErrorIsReceived TransportError
err ReasonPhrase
reason
    QUICException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO QUICException
quicexc
processFrame Connection
_conn EncryptionLevel
_lvl (ConnectionCloseApp ApplicationProtocolError
err ReasonPhrase
reason) = do
    let quicexc :: QUICException
quicexc = ApplicationProtocolError -> ReasonPhrase -> QUICException
ApplicationProtocolErrorIsReceived ApplicationProtocolError
err ReasonPhrase
reason
    QUICException -> IO ()
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO QUICException
quicexc
processFrame Connection
conn EncryptionLevel
lvl Frame
HandshakeDone = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> Bool
forall a. Connector a => a -> Bool
isServer Connection
conn Bool -> Bool -> Bool
|| EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
/= EncryptionLevel
RTT1Level) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ProtocolViolation ReasonPhrase
"HANDSHAKE_DONE for server"
    Connection -> Microseconds -> IO () -> IO ()
fire Connection
conn (StreamId -> Microseconds
Microseconds StreamId
100000) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        let ldcc :: LDCC
ldcc = Connection -> LDCC
connLDCC Connection
conn
        Bool
discarded0 <- LDCC -> EncryptionLevel -> IO Bool
getAndSetPacketNumberSpaceDiscarded LDCC
ldcc EncryptionLevel
RTT0Level
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
discarded0 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> EncryptionLevel -> IO ()
dropSecrets Connection
conn EncryptionLevel
RTT0Level
        Bool
discarded1 <- LDCC -> EncryptionLevel -> IO Bool
getAndSetPacketNumberSpaceDiscarded LDCC
ldcc EncryptionLevel
HandshakeLevel
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
discarded1 (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
            Connection -> EncryptionLevel -> IO ()
dropSecrets Connection
conn EncryptionLevel
HandshakeLevel
            LDCC -> EncryptionLevel -> IO ()
onPacketNumberSpaceDiscarded LDCC
ldcc EncryptionLevel
HandshakeLevel
        Connection -> EncryptionLevel -> IO ()
clearCryptoStream Connection
conn EncryptionLevel
HandshakeLevel
        Connection -> EncryptionLevel -> IO ()
clearCryptoStream Connection
conn EncryptionLevel
RTT1Level
    Connection -> IO ()
setConnectionEstablished Connection
conn
    -- to receive NewSessionTicket
    Connection -> Microseconds -> IO () -> IO ()
fire Connection
conn (StreamId -> Microseconds
Microseconds StreamId
1000000) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> EncryptionLevel -> IO ()
killHandshaker Connection
conn EncryptionLevel
lvl
processFrame Connection
_ EncryptionLevel
_ Frame
_ = TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
ProtocolViolation ReasonPhrase
"Frame is not allowed"

-- QUIC version 1 uses only short packets for stateless reset.
-- But we should check other packets, too.
isStatelessReset :: Connection -> Header -> Crypt -> IO Bool
isStatelessReset :: Connection -> Header -> Crypt -> IO Bool
isStatelessReset Connection
conn Header
hdr Crypt{StreamId
Maybe MigrationInfo
ByteString
cryptMigraionInfo :: Crypt -> Maybe MigrationInfo
cryptPacket :: Crypt -> ByteString
cryptPktNumOffset :: StreamId
cryptPacket :: ByteString
cryptMarks :: StreamId
cryptMigraionInfo :: Maybe MigrationInfo
cryptPktNumOffset :: Crypt -> StreamId
cryptMarks :: Crypt -> StreamId
..} = do
    let cid :: CID
cid = Header -> CID
headerMyCID Header
hdr
    Maybe StreamId
included <- Connection -> CID -> IO (Maybe StreamId)
myCIDsInclude Connection
conn CID
cid
    case Maybe StreamId
included of
        Just StreamId
_ -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Maybe StreamId
_ -> case ByteString -> Maybe StatelessResetToken
decodeStatelessResetToken ByteString
cryptPacket of
            Maybe StatelessResetToken
Nothing -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
            Just StatelessResetToken
token -> Connection -> CID -> StatelessResetToken -> IO Bool
isStatelessRestTokenValid Connection
conn CID
cid StatelessResetToken
token

-- Return value indicates duplication.
putRxCrypto :: Connection -> EncryptionLevel -> RxStreamData -> IO Bool
putRxCrypto :: Connection -> EncryptionLevel -> RxStreamData -> IO Bool
putRxCrypto Connection
conn EncryptionLevel
lvl RxStreamData
rx = do
    Maybe Stream
mstrm <- Connection -> EncryptionLevel -> IO (Maybe Stream)
getCryptoStream Connection
conn EncryptionLevel
lvl
    case Maybe Stream
mstrm of
        Maybe Stream
Nothing -> Bool -> IO Bool
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
        Just Stream
strm -> do
            let put :: ByteString -> IO ()
put = Connection -> Crypto -> IO ()
putCrypto Connection
conn (Crypto -> IO ()) -> (ByteString -> Crypto) -> ByteString -> IO ()
forall b c a. (b -> c) -> (a -> b) -> a -> c
. EncryptionLevel -> ByteString -> Crypto
InpHandshake EncryptionLevel
lvl
                putFin :: IO ()
putFin = () -> IO ()
forall a. a -> IO a
forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Stream -> RxStreamData -> (ByteString -> IO ()) -> IO () -> IO Bool
tryReassemble Stream
strm RxStreamData
rx ByteString -> IO ()
put IO ()
putFin

killHandshaker :: Connection -> EncryptionLevel -> IO ()
killHandshaker :: Connection -> EncryptionLevel -> IO ()
killHandshaker Connection
conn EncryptionLevel
lvl = Connection -> Crypto -> IO ()
putCrypto Connection
conn (Crypto -> IO ()) -> Crypto -> IO ()
forall a b. (a -> b) -> a -> b
$ EncryptionLevel -> ByteString -> Crypto
InpHandshake EncryptionLevel
lvl ByteString
""