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

module Network.QUIC.Receiver (
    receiver
  ) where

import qualified Data.ByteString as BS
import Foreign.Marshal.Alloc
import Network.TLS (AlertDescription(..))
import qualified UnliftIO.Exception as E

import Network.QUIC.Config
import Network.QUIC.Connection
import Network.QUIC.Connector
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.Stream
import Network.QUIC.Types

receiver :: Connection -> Receive -> IO ()
receiver :: Connection -> Receive -> IO ()
receiver Connection
conn Receive
recv = DebugLogger -> IO () -> IO ()
forall a. DebugLogger -> IO a -> IO a
handleLogT DebugLogger
logAction (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
    IO (Ptr Word8)
-> (Ptr Word8 -> IO ()) -> (Ptr Word8 -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracket (Int -> IO (Ptr Word8)
forall a. Int -> IO (Ptr a)
mallocBytes Int
maximumUdpPayloadSize)
              Ptr Word8 -> IO ()
forall a. Ptr a -> IO ()
free
              Ptr Word8 -> IO ()
forall b. Ptr Word8 -> IO b
body
  where
    body :: Ptr Word8 -> IO b
body Ptr Word8
buf = do
        Ptr Word8 -> IO ()
loopHandshake Ptr Word8
buf
        Ptr Word8 -> IO b
forall b. Ptr Word8 -> IO b
loopEstablished Ptr Word8
buf
    recvTimeout :: Receive
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 -> Receive -> IO (Maybe ReceivedPacket)
forall a. Microseconds -> IO a -> IO (Maybe a)
timeout Microseconds
ito Receive
recv -- fixme: taking minimum with peer's one
        case Maybe ReceivedPacket
mx of
          Maybe ReceivedPacket
Nothing -> QUICException -> Receive
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO QUICException
ConnectionIsTimeout
          Just ReceivedPacket
x  -> ReceivedPacket -> Receive
forall (m :: * -> *) a. Monad m => a -> m a
return ReceivedPacket
x
    loopHandshake :: Ptr Word8 -> IO ()
loopHandshake Ptr Word8
buf = do
        ReceivedPacket
rpkt <- Receive
recvTimeout
        Connection -> Ptr Word8 -> ReceivedPacket -> IO ()
processReceivedPacketHandshake Connection
conn Ptr Word8
buf 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 () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Ptr Word8 -> IO ()
loopHandshake Ptr Word8
buf
    loopEstablished :: Ptr Word8 -> IO b
loopEstablished Ptr Word8
buf = 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 <- Receive
recvTimeout
        let CryptPacket Header
hdr Crypt
_ = ReceivedPacket -> CryptPacket
rpCryptPacket ReceivedPacket
rpkt
            cid :: CID
cid = Header -> CID
headerMyCID Header
hdr
        Maybe Int
included <- Connection -> CID -> IO (Maybe Int)
myCIDsInclude Connection
conn CID
cid
        case Maybe Int
included of
          Just Int
nseq -> do
            Bool
shouldUpdate <- Connection -> Int -> IO Bool
shouldUpdateMyCID Connection
conn Int
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 -> Int -> Frame
NewConnectionID CIDInfo
cidInfo Int
0]
            Connection -> Ptr Word8 -> ReceivedPacket -> IO ()
processReceivedPacket Connection
conn Ptr Word8
buf ReceivedPacket
rpkt
            Bool
shouldUpdatePeer <- if Bool
shouldUpdate then Connection -> IO Bool
shouldUpdatePeerCID Connection
conn
                                                else Bool -> IO Bool
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 Int
_ -> 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 -> Buffer -> ReceivedPacket -> IO ()
processReceivedPacketHandshake :: Connection -> Ptr Word8 -> ReceivedPacket -> IO ()
processReceivedPacketHandshake Connection
conn Ptr Word8
buf ReceivedPacket
rpkt = do
    let CryptPacket Header
hdr Crypt
_ = ReceivedPacket -> CryptPacket
rpCryptPacket ReceivedPacket
rpkt
        lvl :: EncryptionLevel
lvl = ReceivedPacket -> EncryptionLevel
rpEncryptionLevel ReceivedPacket
rpkt
    Maybe ()
mx <- Microseconds -> IO () -> IO (Maybe ())
forall a. Microseconds -> IO a -> IO (Maybe a)
timeout (Int -> Microseconds
Microseconds Int
10000) (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 :: Maybe CID
initSrcCID = CID -> Maybe CID
forall a. a -> Maybe a
Just CID
newPeerCID }
              Connection -> Ptr Word8 -> ReceivedPacket -> IO ()
processReceivedPacket Connection
conn Ptr Word8
buf 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
$ 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 -> Ptr Word8 -> ReceivedPacket -> IO ()
processReceivedPacket Connection
conn Ptr Word8
buf ReceivedPacket
rpkt

processReceivedPacket :: Connection -> Buffer -> ReceivedPacket -> IO ()
processReceivedPacket :: Connection -> Ptr Word8 -> ReceivedPacket -> IO ()
processReceivedPacket Connection
conn Ptr Word8
buf 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
        bufsiz :: Int
bufsiz = Int
maximumUdpPayloadSize
    Maybe Plain
mplain <- Connection
-> Ptr Word8 -> Int -> Crypt -> EncryptionLevel -> IO (Maybe Plain)
decryptCrypt Connection
conn Ptr Word8
buf Int
bufsiz Crypt
crypt EncryptionLevel
lvl
    case Maybe Plain
mplain of
      Just plain :: Plain
plain@Plain{Int
[Frame]
Flags Raw
plainMarks :: Plain -> Int
plainFrames :: Plain -> [Frame]
plainPacketNumber :: Plain -> Int
plainFlags :: Plain -> Flags Raw
plainMarks :: Int
plainFrames :: [Frame]
plainPacketNumber :: Int
plainFlags :: Flags Raw
..} -> do
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int -> Bool
isIllegalReservedBits Int
plainMarks Bool -> Bool -> Bool
|| Int -> Bool
isNoFrames Int
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 (Int -> Bool
isUnknownFrame Int
plainMarks) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              TransportError -> ReasonPhrase -> IO ()
closeConnection TransportError
FrameEncodingError ReasonPhrase
"Unknown frame"
          -- For Ping, record PPN first, then send an ACK.
          LDCC -> EncryptionLevel -> Int -> IO ()
onPacketReceived (Connection -> LDCC
connLDCC Connection
conn) EncryptionLevel
lvl Int
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 -> Int -> IO ()
setPeerPacketNumber Connection
conn Int
plainPacketNumber
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (Crypt -> Bool
isCryptLogged Crypt
crypt) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
              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
              shouldDrop :: Bool
shouldDrop = ReceivedPacket -> Int
rpReceivedBytes ReceivedPacket
rpkt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
defaultQUICPacketSize
                        Bool -> Bool -> Bool
&& EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
InitialLevel Bool -> Bool -> Bool
&& Bool
ackEli
          if Bool
shouldDrop then do
              Connection -> DebugLogger
connDebugLog Connection
conn (Builder
"debug: drop packet whose size is " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Int -> Builder
forall a. Show a => a -> Builder
bhow (ReceivedPacket -> Int
rpReceivedBytes ReceivedPacket
rpkt))
              Connection -> Header -> IO ()
forall q a. (KeepQlog q, Qlog a) => q -> a -> IO ()
qlogDropped Connection
conn Header
hdr
            else do
              (Bool
ckp,Int
cpn) <- Connection -> IO (Bool, Int)
getCurrentKeyPhase Connection
conn
              let Flags Word8
flags = Flags Raw
plainFlags
                  nkp :: Bool
nkp = Word8
flags Word8 -> Int -> Bool
forall a. Bits a => a -> Int -> Bool
`testBit` Int
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
&& Int
plainPacketNumber Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
cpn) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                  Connection -> Bool -> Int -> IO ()
setCurrentKeyPhase Connection
conn Bool
nkp Int
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 (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
<> Int -> Builder
forall a. Show a => a -> Builder
bhow (ByteString -> Int
BS.length (ByteString -> Int) -> ByteString -> Int
forall a b. (a -> b) -> a -> b
$ Crypt -> ByteString
cryptPacket Crypt
crypt)
              -- fixme: sending statelss reset

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

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

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

guardStream :: Connection -> StreamId -> Maybe Stream -> IO ()
guardStream :: Connection -> Int -> Maybe Stream -> IO ()
guardStream Connection
conn Int
sid Maybe Stream
Nothing
  | Connection -> Int -> Bool
isInitiated Connection
conn Int
sid = do
        Int
curSid <- Connection -> IO Int
getMyStreamId Connection
conn
        Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
sid Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
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
_ Int
_ Maybe Stream
_ = () -> IO ()
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 (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
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 Int
sid ApplicationProtocolError
aerr Int
_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 -> Int -> Bool
isSendOnly Connection
conn Int
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 -> Int -> IO (Maybe Stream)
findStream Connection
conn Int
sid
    case Maybe Stream
mstrm of
      Maybe Stream
Nothing   -> () -> IO ()
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 Int
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 -> Int -> Bool
isReceiveOnly Connection
conn Int
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 -> Int -> IO (Maybe Stream)
findStream Connection
conn Int
sid
    case Maybe Stream
mstrm of
      Maybe Stream
Nothing   -> do
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> Int -> Bool
isInitiated Connection
conn Int
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 ()
sendFrames Connection
conn EncryptionLevel
lvl [Int -> ApplicationProtocolError -> Int -> Frame
ResetStream Int
sid ApplicationProtocolError
err Int
0]
processFrame Connection
_ EncryptionLevel
_ (CryptoF Int
_ ByteString
"") = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
processFrame Connection
conn EncryptionLevel
lvl (CryptoF Int
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 :: Int
len = ByteString -> Int
BS.length ByteString
cdat
        rx :: RxStreamData
rx = ByteString -> Int -> Int -> Bool -> RxStreamData
RxStreamData ByteString
cdat Int
off Int
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 Int
sid Int
off (ByteString
dat:[ByteString]
_) Bool
fin) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> Int -> Bool
isSendOnly Connection
conn Int
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 -> Int -> IO (Maybe Stream)
findStream Connection
conn Int
sid
    Connection -> Int -> Maybe Stream -> IO ()
guardStream Connection
conn Int
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 -> Int -> IO Stream
createStream Connection
conn Int
sid) Stream -> IO Stream
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Stream
mstrm
    let len :: Int
len = ByteString -> Int
BS.length ByteString
dat
        rx :: RxStreamData
rx = ByteString -> Int -> Int -> Bool -> RxStreamData
RxStreamData ByteString
dat Int
off Int
len Bool
fin
    Bool
ok <- Stream -> RxStreamData -> IO Bool
putRxStreamData Stream
strm RxStreamData
rx
    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 in 0-RTT"
processFrame Connection
conn EncryptionLevel
RTT1Level (StreamF Int
sid Int
_ [ByteString
""] Bool
False) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> Int -> Bool
isSendOnly Connection
conn Int
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 -> Int -> IO (Maybe Stream)
findStream Connection
conn Int
sid
    Connection -> Int -> Maybe Stream -> IO ()
guardStream Connection
conn Int
sid Maybe Stream
mstrm
processFrame Connection
conn EncryptionLevel
RTT1Level (StreamF Int
sid Int
off (ByteString
dat:[ByteString]
_) Bool
fin) = do
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> Int -> Bool
isSendOnly Connection
conn Int
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 -> Int -> IO (Maybe Stream)
findStream Connection
conn Int
sid
    Connection -> Int -> Maybe Stream -> IO ()
guardStream Connection
conn Int
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 -> Int -> IO Stream
createStream Connection
conn Int
sid) Stream -> IO Stream
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Stream
mstrm
    let len :: Int
len = ByteString -> Int
BS.length ByteString
dat
        rx :: RxStreamData
rx = ByteString -> Int -> Int -> Bool -> RxStreamData
RxStreamData ByteString
dat Int
off Int
len Bool
fin
    Bool
ok <- Stream -> RxStreamData -> IO Bool
putRxStreamData Stream
strm RxStreamData
rx
    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 in 1-RTT"
processFrame Connection
conn EncryptionLevel
lvl (MaxData Int
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 -> Int -> IO ()
setTxMaxData Connection
conn Int
n
processFrame Connection
conn EncryptionLevel
lvl (MaxStreamData Int
sid Int
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 -> Int -> Bool
isReceiveOnly Connection
conn Int
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 -> Int -> IO (Maybe Stream)
findStream Connection
conn Int
sid
    case Maybe Stream
mstrm of
      Maybe Stream
Nothing   -> do
          Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Connection -> Int -> Bool
isInitiated Connection
conn Int
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 -> Int -> IO ()
setTxMaxStreamData Stream
strm Int
n
processFrame Connection
conn EncryptionLevel
lvl (MaxStreams Direction
dir Int
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 (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
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 -> Int -> IO ()
setMyMaxStreams Connection
conn Int
n
      else
        Connection -> Int -> IO ()
setMyUniMaxStreams Connection
conn Int
n
processFrame Connection
_conn EncryptionLevel
_lvl DataBlocked{} = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
processFrame Connection
_conn EncryptionLevel
_lvl (StreamDataBlocked Int
_sid Int
_) = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
processFrame Connection
_conn EncryptionLevel
lvl (StreamsBlocked Direction
_dir Int
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 (Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
2Int -> Int -> Int
forall a b. (Num a, Integral b) => a -> b -> a
^(Int
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 Int
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"
    Connection -> CIDInfo -> IO ()
addPeerCID Connection
conn CIDInfo
cidInfo
    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
|| Int
rpt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> CIDInfo -> Int
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 (Int
rpt Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
1) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
        [Int]
seqNums <- Connection -> Int -> IO [Int]
setPeerCIDAndRetireCIDs Connection
conn Int
rpt
        Connection -> EncryptionLevel -> [Frame] -> IO ()
sendFrames Connection
conn EncryptionLevel
RTT1Level ([Frame] -> IO ()) -> [Frame] -> IO ()
forall a b. (a -> b) -> a -> b
$ (Int -> Frame) -> [Int] -> [Frame]
forall a b. (a -> b) -> [a] -> [b]
map Int -> Frame
RetireConnectionID [Int]
seqNums
processFrame Connection
conn EncryptionLevel
RTT1Level (RetireConnectionID Int
sn) = do
    Maybe CIDInfo
mcidInfo <- Connection -> Int -> IO (Maybe CIDInfo)
retireMyCID Connection
conn Int
sn
    case Maybe CIDInfo
mcidInfo of
      Maybe CIDInfo
Nothing -> () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
      Just (CIDInfo Int
_ 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 ()
sendFrames 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 Int
_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 Int
_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 (Int -> Microseconds
Microseconds Int
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 (Int -> Microseconds
Microseconds Int
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{Int
ByteString
cryptMarks :: Crypt -> Int
cryptPktNumOffset :: Crypt -> Int
cryptMarks :: Int
cryptPacket :: ByteString
cryptPktNumOffset :: Int
cryptPacket :: Crypt -> ByteString
..} = do
    let cid :: CID
cid = Header -> CID
headerMyCID Header
hdr
    Maybe Int
included <- Connection -> CID -> IO (Maybe Int)
myCIDsInclude Connection
conn CID
cid
    case Maybe Int
included of
      Just Int
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
      Maybe Int
_      -> case ByteString -> Maybe StatelessResetToken
decodeStatelessResetToken ByteString
cryptPacket of
             Maybe StatelessResetToken
Nothing    -> Bool -> IO Bool
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 (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 (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
""