{-# LANGUAGE OverloadedStrings #-}

module Network.QUIC.Sender (
    sender,
    mkHeader,
    sendFinal,
) where

import qualified Data.ByteString as BS
import Foreign.Ptr (plusPtr)
import UnliftIO.Concurrent
import qualified UnliftIO.Exception as E
import UnliftIO.STM

import Network.QUIC.Config
import Network.QUIC.Connection
import Network.QUIC.Connector
import Network.QUIC.Exception
import Network.QUIC.Imports
import Network.QUIC.Packet
import Network.QUIC.Qlog
import Network.QUIC.Recovery
import Network.QUIC.Stream
import Network.QUIC.Types

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

cryptoFrame :: Connection -> CryptoData -> EncryptionLevel -> IO Frame
cryptoFrame :: Connection -> Token -> EncryptionLevel -> IO Frame
cryptoFrame Connection
conn Token
crypto EncryptionLevel
lvl = do
    let len :: Length
len = Token -> Length
BS.length Token
crypto
    Maybe Stream
mstrm <- Connection -> EncryptionLevel -> IO (Maybe Stream)
getCryptoStream Connection
conn EncryptionLevel
lvl
    case Maybe Stream
mstrm of
        Maybe Stream
Nothing -> forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO InternalControl
MustNotReached
        Just Stream
strm -> do
            Length
off <- Stream -> Length -> IO Length
getTxStreamOffset Stream
strm Length
len
            forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ Length -> Token -> Frame
CryptoF Length
off Token
crypto

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

sendPacket :: Connection -> [SentPacket] -> IO ()
sendPacket :: Connection -> [SentPacket] -> IO ()
sendPacket Connection
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
sendPacket Connection
conn [SentPacket]
spkts0 = forall a. Connector a => a -> IO Length
getMaxPacketSize Connection
conn forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Length -> IO ()
go
  where
    SizedBuffer Buffer
buf0 Length
bufsiz0 = Connection -> SizedBuffer
encryptRes Connection
conn
    ldcc :: LDCC
ldcc = Connection -> LDCC
connLDCC Connection
conn
    go :: Length -> IO ()
go Length
maxSiz = do
        Maybe EncryptionLevel
mx <-
            forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically
                ( (forall a. a -> Maybe a
Just forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LDCC -> STM EncryptionLevel
takePingSTM LDCC
ldcc)
                    forall a. STM a -> STM a -> STM a
`orElse` (forall a. Maybe a
Nothing forall (f :: * -> *) a b. Functor f => a -> f b -> f a
<$ LDCC -> Length -> STM ()
checkWindowOpenSTM LDCC
ldcc Length
maxSiz)
                )
        case Maybe EncryptionLevel
mx of
            Just EncryptionLevel
lvl | EncryptionLevel
lvl forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [EncryptionLevel
InitialLevel, EncryptionLevel
HandshakeLevel] -> do
                Connection -> EncryptionLevel -> IO ()
sendPingPacket Connection
conn EncryptionLevel
lvl
                Length -> IO ()
go Length
maxSiz
            Maybe EncryptionLevel
_ -> do
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Maybe a -> Bool
isJust Maybe EncryptionLevel
mx) forall a b. (a -> b) -> a -> b
$ forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug Connection
conn forall a b. (a -> b) -> a -> b
$ LogStr -> Debug
Debug LogStr
"probe new"
                ([SentPacket]
sentPackets, Length
leftsiz) <- forall {a}.
Buffer
-> Length
-> Length
-> [SentPacket]
-> ([SentPacket] -> a)
-> IO (a, Length)
buildPackets Buffer
buf0 Length
bufsiz0 Length
maxSiz [SentPacket]
spkts0 forall a. a -> a
id
                let bytes :: Length
bytes = Length
bufsiz0 forall a. Num a => a -> a -> a
- Length
leftsiz
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall a. Connector a => a -> Bool
isServer Connection
conn) forall a b. (a -> b) -> a -> b
$ Connection -> Length -> IO ()
waitAntiAmplificationFree Connection
conn Length
bytes
                TimeMicrosecond
now <- IO TimeMicrosecond
getTimeMicrosecond
                Connection -> Send
connSend Connection
conn Buffer
buf0 Length
bytes
                Connection -> Length -> IO ()
addTxBytes Connection
conn Length
bytes
                forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
t a -> (a -> m b) -> m ()
forM_ [SentPacket]
sentPackets forall a b. (a -> b) -> a -> b
$ \SentPacket
sentPacket0 -> do
                    let sentPacket :: SentPacket
sentPacket = SentPacket
sentPacket0{spTimeSent :: TimeMicrosecond
spTimeSent = TimeMicrosecond
now}
                    forall q pkt.
(KeepQlog q, Qlog pkt) =>
q -> pkt -> TimeMicrosecond -> IO ()
qlogSent Connection
conn SentPacket
sentPacket TimeMicrosecond
now
                    LDCC -> SentPacket -> IO ()
onPacketSent LDCC
ldcc SentPacket
sentPacket
    buildPackets :: Buffer
-> Length
-> Length
-> [SentPacket]
-> ([SentPacket] -> a)
-> IO (a, Length)
buildPackets Buffer
_ Length
_ Length
_ [] [SentPacket] -> a
_ = forall a. HasCallStack => [Char] -> a
error [Char]
"sendPacket: buildPackets"
    buildPackets Buffer
buf Length
bufsiz Length
siz [SentPacket
spkt] [SentPacket] -> a
build0 = do
        let pkt :: PlainPacket
pkt = SentPacket -> PlainPacket
spPlainPacket SentPacket
spkt
        (Length
bytes, Length
padlen) <-
            Connection
-> SizedBuffer
-> PlainPacket
-> Maybe Length
-> IO (Length, Length)
encodePlainPacket Connection
conn (Buffer -> Length -> SizedBuffer
SizedBuffer Buffer
buf Length
bufsiz) PlainPacket
pkt forall a b. (a -> b) -> a -> b
$ forall a. a -> Maybe a
Just Length
siz
        if Length
bytes forall a. Ord a => a -> a -> Bool
< Length
0
            then forall (m :: * -> *) a. Monad m => a -> m a
return ([SentPacket] -> a
build0 [], Length
bufsiz)
            else do
                let sentPacket :: SentPacket
sentPacket = SentPacket -> Length -> Length -> SentPacket
fixSentPacket SentPacket
spkt Length
bytes Length
padlen
                forall (m :: * -> *) a. Monad m => a -> m a
return ([SentPacket] -> a
build0 [SentPacket
sentPacket], Length
bufsiz forall a. Num a => a -> a -> a
- Length
bytes)
    buildPackets Buffer
buf Length
bufsiz Length
siz (SentPacket
spkt : [SentPacket]
spkts) [SentPacket] -> a
build0 = do
        let pkt :: PlainPacket
pkt = SentPacket -> PlainPacket
spPlainPacket SentPacket
spkt
        (Length
bytes, Length
padlen) <- Connection
-> SizedBuffer
-> PlainPacket
-> Maybe Length
-> IO (Length, Length)
encodePlainPacket Connection
conn (Buffer -> Length -> SizedBuffer
SizedBuffer Buffer
buf Length
bufsiz) PlainPacket
pkt forall a. Maybe a
Nothing
        if Length
bytes forall a. Ord a => a -> a -> Bool
< Length
0
            then Buffer
-> Length
-> Length
-> [SentPacket]
-> ([SentPacket] -> a)
-> IO (a, Length)
buildPackets Buffer
buf Length
bufsiz Length
siz [SentPacket]
spkts [SentPacket] -> a
build0
            else do
                let sentPacket :: SentPacket
sentPacket = SentPacket -> Length -> Length -> SentPacket
fixSentPacket SentPacket
spkt Length
bytes Length
padlen
                let build0' :: [SentPacket] -> a
build0' = [SentPacket] -> a
build0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SentPacket
sentPacket forall a. a -> [a] -> [a]
:)
                    buf' :: Ptr b
buf' = Buffer
buf forall a b. Ptr a -> Length -> Ptr b
`plusPtr` Length
bytes
                    bufsiz' :: Length
bufsiz' = Length
bufsiz forall a. Num a => a -> a -> a
- Length
bytes
                    siz' :: Length
siz' = Length
siz forall a. Num a => a -> a -> a
- SentPacket -> Length
spSentBytes SentPacket
sentPacket
                Buffer
-> Length
-> Length
-> [SentPacket]
-> ([SentPacket] -> a)
-> IO (a, Length)
buildPackets forall {b}. Ptr b
buf' Length
bufsiz' Length
siz' [SentPacket]
spkts [SentPacket] -> a
build0'

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

sendPingPacket :: Connection -> EncryptionLevel -> IO ()
sendPingPacket :: Connection -> EncryptionLevel -> IO ()
sendPingPacket Connection
conn EncryptionLevel
lvl = do
    Length
maxSiz <- forall a. Connector a => a -> IO Length
getMaxPacketSize Connection
conn
    Bool
ok <-
        if forall a. Connector a => a -> Bool
isClient Connection
conn
            then forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
            else Connection -> Length -> IO Bool
checkAntiAmplificationFree Connection
conn Length
maxSiz
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ok forall a b. (a -> b) -> a -> b
$ do
        let ldcc :: LDCC
ldcc = Connection -> LDCC
connLDCC Connection
conn
        Maybe SentPacket
mp <- LDCC -> EncryptionLevel -> IO (Maybe SentPacket)
releaseOldest LDCC
ldcc EncryptionLevel
lvl
        [Frame]
frames <- case Maybe SentPacket
mp of
            Maybe SentPacket
Nothing -> do
                forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug Connection
conn forall a b. (a -> b) -> a -> b
$ LogStr -> Debug
Debug LogStr
"probe ping"
                forall (m :: * -> *) a. Monad m => a -> m a
return [Frame
Ping]
            Just SentPacket
spkt -> do
                forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug Connection
conn forall a b. (a -> b) -> a -> b
$ LogStr -> Debug
Debug LogStr
"probe old"
                let PlainPacket Header
_ Plain
plain0 = SentPacket -> PlainPacket
spPlainPacket SentPacket
spkt
                Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
conn forall a b. (a -> b) -> a -> b
$ Plain -> [Frame]
plainFrames Plain
plain0
        [SentPacket]
xs <- Connection -> EncryptionLevel -> [Frame] -> IO [SentPacket]
construct Connection
conn EncryptionLevel
lvl [Frame]
frames
        if forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SentPacket]
xs
            then forall q. KeepQlog q => q -> Debug -> IO ()
qlogDebug Connection
conn forall a b. (a -> b) -> a -> b
$ LogStr -> Debug
Debug LogStr
"ping NULL"
            else do
                let spkt :: SentPacket
spkt = forall a. [a] -> a
last [SentPacket]
xs
                    ping :: PlainPacket
ping = SentPacket -> PlainPacket
spPlainPacket SentPacket
spkt
                let sizbuf :: SizedBuffer
sizbuf@(SizedBuffer Buffer
buf Length
_) = Connection -> SizedBuffer
encryptRes Connection
conn
                (Length
bytes, Length
padlen) <- Connection
-> SizedBuffer
-> PlainPacket
-> Maybe Length
-> IO (Length, Length)
encodePlainPacket Connection
conn SizedBuffer
sizbuf PlainPacket
ping (forall a. a -> Maybe a
Just Length
maxSiz)
                forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Length
bytes forall a. Ord a => a -> a -> Bool
>= Length
0) forall a b. (a -> b) -> a -> b
$ do
                    TimeMicrosecond
now <- IO TimeMicrosecond
getTimeMicrosecond
                    Connection -> Send
connSend Connection
conn Buffer
buf Length
bytes
                    Connection -> Length -> IO ()
addTxBytes Connection
conn Length
bytes
                    let sentPacket0 :: SentPacket
sentPacket0 = SentPacket -> Length -> Length -> SentPacket
fixSentPacket SentPacket
spkt Length
bytes Length
padlen
                        sentPacket :: SentPacket
sentPacket = SentPacket
sentPacket0{spTimeSent :: TimeMicrosecond
spTimeSent = TimeMicrosecond
now}
                    forall q pkt.
(KeepQlog q, Qlog pkt) =>
q -> pkt -> TimeMicrosecond -> IO ()
qlogSent Connection
conn SentPacket
sentPacket TimeMicrosecond
now
                    LDCC -> SentPacket -> IO ()
onPacketSent LDCC
ldcc SentPacket
sentPacket

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

construct
    :: Connection
    -> EncryptionLevel
    -> [Frame]
    -> IO [SentPacket]
construct :: Connection -> EncryptionLevel -> [Frame] -> IO [SentPacket]
construct Connection
conn EncryptionLevel
lvl [Frame]
frames = do
    Bool
discarded <- LDCC -> EncryptionLevel -> IO Bool
getPacketNumberSpaceDiscarded LDCC
ldcc EncryptionLevel
lvl
    if Bool
discarded
        then forall (m :: * -> *) a. Monad m => a -> m a
return []
        else do
            Bool
established <- forall a. Connector a => a -> IO Bool
isConnectionEstablished Connection
conn
            if Bool
established Bool -> Bool -> Bool
|| (forall a. Connector a => a -> Bool
isServer Connection
conn Bool -> Bool -> Bool
&& EncryptionLevel
lvl forall a. Eq a => a -> a -> Bool
== EncryptionLevel
HandshakeLevel)
                then do
                    IO [SentPacket]
constructTargetPacket
                else do
                    [SentPacket]
ppkt0 <- IO [SentPacket]
constructLowerAckPacket
                    [SentPacket]
ppkt1 <- IO [SentPacket]
constructTargetPacket
                    forall (m :: * -> *) a. Monad m => a -> m a
return ([SentPacket]
ppkt0 forall a. [a] -> [a] -> [a]
++ [SentPacket]
ppkt1)
  where
    ldcc :: LDCC
ldcc = Connection -> LDCC
connLDCC Connection
conn
    constructLowerAckPacket :: IO [SentPacket]
constructLowerAckPacket = do
        let lvl' :: EncryptionLevel
lvl' = case EncryptionLevel
lvl of
                EncryptionLevel
HandshakeLevel -> EncryptionLevel
InitialLevel
                EncryptionLevel
RTT1Level -> EncryptionLevel
HandshakeLevel
                EncryptionLevel
_ -> EncryptionLevel
RTT1Level
        if EncryptionLevel
lvl' forall a. Eq a => a -> a -> Bool
== EncryptionLevel
RTT1Level
            then forall (m :: * -> *) a. Monad m => a -> m a
return []
            else do
                PeerPacketNumbers
ppns <- LDCC -> EncryptionLevel -> IO PeerPacketNumbers
getPeerPacketNumbers LDCC
ldcc EncryptionLevel
lvl'
                if PeerPacketNumbers -> Bool
nullPeerPacketNumbers PeerPacketNumbers
ppns
                    then forall (m :: * -> *) a. Monad m => a -> m a
return []
                    else Connection
-> EncryptionLevel
-> [Frame]
-> PeerPacketNumbers
-> IO [SentPacket]
mkPlainPacket Connection
conn EncryptionLevel
lvl' [] PeerPacketNumbers
ppns
    constructTargetPacket :: IO [SentPacket]
constructTargetPacket
        | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Frame]
frames = do
            -- ACK only packet
            Connection -> IO ()
resetDealyedAck Connection
conn
            PeerPacketNumbers
ppns <- LDCC -> EncryptionLevel -> IO PeerPacketNumbers
getPeerPacketNumbers LDCC
ldcc EncryptionLevel
lvl
            if PeerPacketNumbers -> Bool
nullPeerPacketNumbers PeerPacketNumbers
ppns
                then forall (m :: * -> *) a. Monad m => a -> m a
return []
                else
                    if EncryptionLevel
lvl forall a. Eq a => a -> a -> Bool
== EncryptionLevel
RTT1Level
                        then do
                            PeerPacketNumbers
prevppns <- LDCC -> IO PeerPacketNumbers
getPreviousRTT1PPNs LDCC
ldcc
                            if PeerPacketNumbers
ppns forall a. Eq a => a -> a -> Bool
/= PeerPacketNumbers
prevppns
                                then do
                                    LDCC -> PeerPacketNumbers -> IO ()
setPreviousRTT1PPNs LDCC
ldcc PeerPacketNumbers
ppns
                                    Connection
-> EncryptionLevel
-> [Frame]
-> PeerPacketNumbers
-> IO [SentPacket]
mkPlainPacket Connection
conn EncryptionLevel
lvl [] PeerPacketNumbers
ppns
                                else forall (m :: * -> *) a. Monad m => a -> m a
return []
                        else Connection
-> EncryptionLevel
-> [Frame]
-> PeerPacketNumbers
-> IO [SentPacket]
mkPlainPacket Connection
conn EncryptionLevel
lvl [] PeerPacketNumbers
ppns
        | Bool
otherwise = do
            Connection -> IO ()
resetDealyedAck Connection
conn
            PeerPacketNumbers
ppns <- LDCC -> EncryptionLevel -> IO PeerPacketNumbers
getPeerPacketNumbers LDCC
ldcc EncryptionLevel
lvl
            Connection
-> EncryptionLevel
-> [Frame]
-> PeerPacketNumbers
-> IO [SentPacket]
mkPlainPacket Connection
conn EncryptionLevel
lvl [Frame]
frames PeerPacketNumbers
ppns

mkPlainPacket
    :: Connection -> EncryptionLevel -> [Frame] -> PeerPacketNumbers -> IO [SentPacket]
mkPlainPacket :: Connection
-> EncryptionLevel
-> [Frame]
-> PeerPacketNumbers
-> IO [SentPacket]
mkPlainPacket Connection
conn EncryptionLevel
lvl [Frame]
frames0 PeerPacketNumbers
ppns = do
    let ackEli :: Bool
ackEli
            | forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Frame]
frames0 = Bool
False
            | Bool
otherwise = Bool
True
        frames :: [Frame]
frames
            | PeerPacketNumbers -> Bool
nullPeerPacketNumbers PeerPacketNumbers
ppns = [Frame]
frames0
            | Bool
otherwise = PeerPacketNumbers -> Frame
mkAck PeerPacketNumbers
ppns forall a. a -> [a] -> [a]
: [Frame]
frames0
    Header
header <- Connection -> EncryptionLevel -> IO Header
mkHeader Connection
conn EncryptionLevel
lvl
    Length
mypn <- Connection -> IO Length
nextPacketNumber Connection
conn
    let convert :: EncryptionLevel -> Plain -> Plain
convert = Hooks -> EncryptionLevel -> Plain -> Plain
onPlainCreated forall a b. (a -> b) -> a -> b
$ Connection -> Hooks
connHooks Connection
conn
        plain :: Plain
plain = EncryptionLevel -> Plain -> Plain
convert EncryptionLevel
lvl forall a b. (a -> b) -> a -> b
$ Flags Raw -> Length -> [Frame] -> Length -> Plain
Plain (forall a. Word8 -> Flags a
Flags Word8
0) Length
mypn [Frame]
frames Length
0
        ppkt :: PlainPacket
ppkt = Header -> Plain -> PlainPacket
PlainPacket Header
header Plain
plain
    forall (m :: * -> *) a. Monad m => a -> m a
return [Length
-> EncryptionLevel
-> PlainPacket
-> PeerPacketNumbers
-> Bool
-> SentPacket
mkSentPacket Length
mypn EncryptionLevel
lvl PlainPacket
ppkt PeerPacketNumbers
ppns Bool
ackEli]
  where
    mkAck :: PeerPacketNumbers -> Frame
mkAck PeerPacketNumbers
ps = AckInfo -> Delay -> Frame
Ack ([Length] -> AckInfo
toAckInfo forall a b. (a -> b) -> a -> b
$ PeerPacketNumbers -> [Length]
fromPeerPacketNumbers PeerPacketNumbers
ps) Delay
0

mkHeader :: Connection -> EncryptionLevel -> IO Header
mkHeader :: Connection -> EncryptionLevel -> IO Header
mkHeader Connection
conn EncryptionLevel
lvl = do
    Version
ver <- Connection -> IO Version
getVersion Connection
conn
    CID
mycid <- Connection -> IO CID
getMyCID Connection
conn
    CID
peercid <- Connection -> IO CID
getPeerCID Connection
conn
    Token
token <- if EncryptionLevel
lvl forall a. Eq a => a -> a -> Bool
== EncryptionLevel
InitialLevel then Connection -> IO Token
getToken Connection
conn else forall (m :: * -> *) a. Monad m => a -> m a
return Token
""
    forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$ case EncryptionLevel
lvl of
        EncryptionLevel
InitialLevel -> Version -> CID -> CID -> Token -> Header
Initial Version
ver CID
peercid CID
mycid Token
token
        EncryptionLevel
RTT0Level -> Version -> CID -> CID -> Header
RTT0 Version
ver CID
peercid CID
mycid
        EncryptionLevel
HandshakeLevel -> Version -> CID -> CID -> Header
Handshake Version
ver CID
peercid CID
mycid
        EncryptionLevel
RTT1Level -> CID -> Header
Short CID
peercid

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

data Switch
    = SwPing EncryptionLevel
    | SwOut Output
    | SwStrm TxStreamData

sender :: Connection -> IO ()
sender :: Connection -> IO ()
sender Connection
conn = forall a. DebugLogger -> IO a -> IO a
handleLogT DebugLogger
logAction forall a b. (a -> b) -> a -> b
$ forall (f :: * -> *) a b. Applicative f => f a -> f b
forever forall a b. (a -> b) -> a -> b
$ Connection -> IO ()
sendP Connection
conn
  where
    logAction :: DebugLogger
logAction Builder
msg = Connection -> DebugLogger
connDebugLog Connection
conn (Builder
"debug: sender: " forall a. Semigroup a => a -> a -> a
<> Builder
msg)

sendP :: Connection -> IO ()
sendP :: Connection -> IO ()
sendP Connection
conn = do
    Switch
x <-
        forall (m :: * -> *) a. MonadIO m => STM a -> m a
atomically
            ( (EncryptionLevel -> Switch
SwPing forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LDCC -> STM EncryptionLevel
takePingSTM (Connection -> LDCC
connLDCC Connection
conn))
                forall a. STM a -> STM a -> STM a
`orElse` (Output -> Switch
SwOut forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> STM Output
takeOutputSTM Connection
conn)
                forall a. STM a -> STM a -> STM a
`orElse` (Output -> Switch
SwOut forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> STM Output
takeOutput1STM Connection
conn)
                forall a. STM a -> STM a -> STM a
`orElse` (TxStreamData -> Switch
SwStrm forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> STM TxStreamData
takeSendStreamQSTM Connection
conn)
            )
    case Switch
x of
        SwPing EncryptionLevel
lvl -> Connection -> EncryptionLevel -> IO ()
sendPingPacket Connection
conn EncryptionLevel
lvl
        SwOut Output
out -> Connection -> Output -> IO ()
sendOutput Connection
conn Output
out
        SwStrm TxStreamData
tx -> Connection -> TxStreamData -> IO ()
sendTxStreamData Connection
conn TxStreamData
tx

sendFinal :: Connection -> IO ()
sendFinal :: Connection -> IO ()
sendFinal Connection
conn = Length -> IO ()
loop Length
30
  where
    msg :: [Char]
msg = [Char]
"sendFinal " forall a. [a] -> [a] -> [a]
++ if forall a. Connector a => a -> Bool
isServer Connection
conn then [Char]
"Server" else [Char]
"Client"
    loop :: Int -> IO ()
    loop :: Length -> IO ()
loop Length
0 = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    loop Length
n = do
        Maybe ()
mx <- forall a. Microseconds -> [Char] -> IO a -> IO (Maybe a)
timeout (Length -> Microseconds
Microseconds Length
10) [Char]
msg forall a b. (a -> b) -> a -> b
$ Connection -> IO ()
sendP Connection
conn
        case Maybe ()
mx of
            Maybe ()
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ()
            Just () -> Length -> IO ()
loop (Length
n forall a. Num a => a -> a -> a
- Length
1)

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

discardClientInitialPacketNumberSpace :: Connection -> IO ()
discardClientInitialPacketNumberSpace :: Connection -> IO ()
discardClientInitialPacketNumberSpace Connection
conn
    | forall a. Connector a => a -> Bool
isClient Connection
conn = do
        let ldcc :: LDCC
ldcc = Connection -> LDCC
connLDCC Connection
conn
        Bool
discarded <- LDCC -> EncryptionLevel -> IO Bool
getAndSetPacketNumberSpaceDiscarded LDCC
ldcc EncryptionLevel
InitialLevel
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless Bool
discarded forall a b. (a -> b) -> a -> b
$ Connection -> Microseconds -> IO () -> IO ()
fire Connection
conn (Length -> Microseconds
Microseconds Length
100000) 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
    | Bool
otherwise = forall (m :: * -> *) a. Monad m => a -> m a
return ()

sendOutput :: Connection -> Output -> IO ()
sendOutput :: Connection -> Output -> IO ()
sendOutput Connection
conn (OutControl EncryptionLevel
lvl [Frame]
frames IO ()
action) = do
    Connection -> EncryptionLevel -> [Frame] -> IO [SentPacket]
construct Connection
conn EncryptionLevel
lvl [Frame]
frames forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Connection -> [SentPacket] -> IO ()
sendPacket Connection
conn
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (EncryptionLevel
lvl forall a. Eq a => a -> a -> Bool
== EncryptionLevel
HandshakeLevel) forall a b. (a -> b) -> a -> b
$ Connection -> IO ()
discardClientInitialPacketNumberSpace Connection
conn
    IO ()
action
sendOutput Connection
conn (OutHandshake [(EncryptionLevel, Token)]
lcs0) = do
    let convert :: [(EncryptionLevel, Token)] -> ([(EncryptionLevel, Token)], Bool)
convert = Hooks
-> [(EncryptionLevel, Token)] -> ([(EncryptionLevel, Token)], Bool)
onTLSHandshakeCreated forall a b. (a -> b) -> a -> b
$ Connection -> Hooks
connHooks Connection
conn
        ([(EncryptionLevel, Token)]
lcs, Bool
wait) = [(EncryptionLevel, Token)] -> ([(EncryptionLevel, Token)], Bool)
convert [(EncryptionLevel, Token)]
lcs0
    -- only for h3spec
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
wait forall a b. (a -> b) -> a -> b
$ Connection -> IO ()
wait0RTTReady Connection
conn
    Connection -> [(EncryptionLevel, Token)] -> IO ()
sendCryptoFragments Connection
conn [(EncryptionLevel, Token)]
lcs
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(EncryptionLevel
l, Token
_) -> EncryptionLevel
l forall a. Eq a => a -> a -> Bool
== EncryptionLevel
HandshakeLevel) [(EncryptionLevel, Token)]
lcs) forall a b. (a -> b) -> a -> b
$
        Connection -> IO ()
discardClientInitialPacketNumberSpace Connection
conn
sendOutput Connection
conn (OutRetrans (PlainPacket Header
hdr0 Plain
plain0)) = do
    [Frame]
frames <- Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
conn forall a b. (a -> b) -> a -> b
$ Plain -> [Frame]
plainFrames Plain
plain0
    let lvl :: EncryptionLevel
lvl = Header -> EncryptionLevel
levelFromHeader Header
hdr0
    Connection -> EncryptionLevel -> [Frame] -> IO [SentPacket]
construct Connection
conn EncryptionLevel
lvl [Frame]
frames forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Connection -> [SentPacket] -> IO ()
sendPacket Connection
conn

levelFromHeader :: Header -> EncryptionLevel
levelFromHeader :: Header -> EncryptionLevel
levelFromHeader Header
hdr
    | EncryptionLevel
lvl forall a. Eq a => a -> a -> Bool
== EncryptionLevel
RTT0Level = EncryptionLevel
RTT1Level
    | Bool
otherwise = EncryptionLevel
lvl
  where
    lvl :: EncryptionLevel
lvl = Header -> EncryptionLevel
packetEncryptionLevel Header
hdr

adjustForRetransmit :: Connection -> [Frame] -> IO [Frame]
adjustForRetransmit :: Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return []
adjustForRetransmit Connection
conn (Padding{} : [Frame]
xs) = Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
conn [Frame]
xs
adjustForRetransmit Connection
conn (Ack{} : [Frame]
xs) = Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
conn [Frame]
xs
adjustForRetransmit Connection
conn (MaxStreamData Length
sid Length
_ : [Frame]
xs) = do
    Maybe Stream
mstrm <- Connection -> Length -> IO (Maybe Stream)
findStream Connection
conn Length
sid
    case Maybe Stream
mstrm of
        Maybe Stream
Nothing -> Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
conn [Frame]
xs
        Just Stream
strm -> do
            Length
newMax <- Stream -> IO Length
getRxMaxStreamData Stream
strm
            let r :: Frame
r = Length -> Length -> Frame
MaxStreamData Length
sid Length
newMax
            [Frame]
rs <- Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
conn [Frame]
xs
            forall (m :: * -> *) a. Monad m => a -> m a
return (Frame
r forall a. a -> [a] -> [a]
: [Frame]
rs)
adjustForRetransmit Connection
conn (MaxData{} : [Frame]
xs) = do
    Length
newMax <- Connection -> IO Length
getRxMaxData Connection
conn
    let r :: Frame
r = Length -> Frame
MaxData Length
newMax
    [Frame]
rs <- Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
conn [Frame]
xs
    forall (m :: * -> *) a. Monad m => a -> m a
return (Frame
r forall a. a -> [a] -> [a]
: [Frame]
rs)
adjustForRetransmit Connection
conn (Frame
x : [Frame]
xs) = do
    [Frame]
rs <- Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
conn [Frame]
xs
    forall (m :: * -> *) a. Monad m => a -> m a
return (Frame
x forall a. a -> [a] -> [a]
: [Frame]
rs)

limitationC :: Int
limitationC :: Length
limitationC = Length
1024

thresholdC :: Int
thresholdC :: Length
thresholdC = Length
200

sendCryptoFragments :: Connection -> [(EncryptionLevel, CryptoData)] -> IO ()
sendCryptoFragments :: Connection -> [(EncryptionLevel, Token)] -> IO ()
sendCryptoFragments Connection
_ [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
sendCryptoFragments Connection
conn [(EncryptionLevel, Token)]
lcs = do
    Length
-> ([SentPacket] -> [SentPacket])
-> [(EncryptionLevel, Token)]
-> IO ()
loop Length
limitationC forall a. a -> a
id [(EncryptionLevel, Token)]
lcs
  where
    loop
        :: Int
        -> ([SentPacket] -> [SentPacket])
        -> [(EncryptionLevel, CryptoData)]
        -> IO ()
    loop :: Length
-> ([SentPacket] -> [SentPacket])
-> [(EncryptionLevel, Token)]
-> IO ()
loop Length
_ [SentPacket] -> [SentPacket]
build0 [] = do
        let spkts0 :: [SentPacket]
spkts0 = [SentPacket] -> [SentPacket]
build0 []
        forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless (forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SentPacket]
spkts0) forall a b. (a -> b) -> a -> b
$ Connection -> [SentPacket] -> IO ()
sendPacket Connection
conn [SentPacket]
spkts0
    loop Length
len0 [SentPacket] -> [SentPacket]
build0 ((EncryptionLevel
lvl, Token
bs) : [(EncryptionLevel, Token)]
xs) | Token -> Length
BS.length Token
bs forall a. Ord a => a -> a -> Bool
> Length
len0 = do
        let (Token
target, Token
rest) = Length -> Token -> (Token, Token)
BS.splitAt Length
len0 Token
bs
        Frame
frame1 <- Connection -> Token -> EncryptionLevel -> IO Frame
cryptoFrame Connection
conn Token
target EncryptionLevel
lvl
        [SentPacket]
spkts1 <- Connection -> EncryptionLevel -> [Frame] -> IO [SentPacket]
construct Connection
conn EncryptionLevel
lvl [Frame
frame1]
        Connection -> [SentPacket] -> IO ()
sendPacket Connection
conn forall a b. (a -> b) -> a -> b
$ [SentPacket] -> [SentPacket]
build0 [SentPacket]
spkts1
        Length
-> ([SentPacket] -> [SentPacket])
-> [(EncryptionLevel, Token)]
-> IO ()
loop Length
limitationC forall a. a -> a
id ((EncryptionLevel
lvl, Token
rest) forall a. a -> [a] -> [a]
: [(EncryptionLevel, Token)]
xs)
    loop Length
_ [SentPacket] -> [SentPacket]
build0 [(EncryptionLevel
lvl, Token
bs)] = do
        Frame
frame1 <- Connection -> Token -> EncryptionLevel -> IO Frame
cryptoFrame Connection
conn Token
bs EncryptionLevel
lvl
        [SentPacket]
spkts1 <- Connection -> EncryptionLevel -> [Frame] -> IO [SentPacket]
construct Connection
conn EncryptionLevel
lvl [Frame
frame1]
        Connection -> [SentPacket] -> IO ()
sendPacket Connection
conn forall a b. (a -> b) -> a -> b
$ [SentPacket] -> [SentPacket]
build0 [SentPacket]
spkts1
    loop Length
len0 [SentPacket] -> [SentPacket]
build0 ((EncryptionLevel
lvl, Token
bs) : [(EncryptionLevel, Token)]
xs) | Length
len0 forall a. Num a => a -> a -> a
- Token -> Length
BS.length Token
bs forall a. Ord a => a -> a -> Bool
< Length
thresholdC = do
        Frame
frame1 <- Connection -> Token -> EncryptionLevel -> IO Frame
cryptoFrame Connection
conn Token
bs EncryptionLevel
lvl
        [SentPacket]
spkts1 <- Connection -> EncryptionLevel -> [Frame] -> IO [SentPacket]
construct Connection
conn EncryptionLevel
lvl [Frame
frame1]
        Connection -> [SentPacket] -> IO ()
sendPacket Connection
conn forall a b. (a -> b) -> a -> b
$ [SentPacket] -> [SentPacket]
build0 [SentPacket]
spkts1
        Length
-> ([SentPacket] -> [SentPacket])
-> [(EncryptionLevel, Token)]
-> IO ()
loop Length
limitationC forall a. a -> a
id [(EncryptionLevel, Token)]
xs
    loop Length
len0 [SentPacket] -> [SentPacket]
build0 ((EncryptionLevel
lvl, Token
bs) : [(EncryptionLevel, Token)]
xs) = do
        Frame
frame1 <- Connection -> Token -> EncryptionLevel -> IO Frame
cryptoFrame Connection
conn Token
bs EncryptionLevel
lvl
        [SentPacket]
spkts1 <- Connection -> EncryptionLevel -> [Frame] -> IO [SentPacket]
construct Connection
conn EncryptionLevel
lvl [Frame
frame1]
        let len1 :: Length
len1 = Length
len0 forall a. Num a => a -> a -> a
- Token -> Length
BS.length Token
bs
            build1 :: [SentPacket] -> [SentPacket]
build1 = [SentPacket] -> [SentPacket]
build0 forall b c a. (b -> c) -> (a -> b) -> a -> c
. ([SentPacket]
spkts1 forall a. [a] -> [a] -> [a]
++)
        Length
-> ([SentPacket] -> [SentPacket])
-> [(EncryptionLevel, Token)]
-> IO ()
loop Length
len1 [SentPacket] -> [SentPacket]
build1 [(EncryptionLevel, Token)]
xs

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

threshold :: Int
threshold :: Length
threshold = Length
832

limitation :: Int
limitation :: Length
limitation = Length
1040

packFin :: Connection -> Stream -> Bool -> IO Bool
packFin :: Connection -> Stream -> Bool -> IO Bool
packFin Connection
_ Stream
_ Bool
True = forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
packFin Connection
conn Stream
s Bool
False = do
    Maybe TxStreamData
mx <- Connection -> IO (Maybe TxStreamData)
tryPeekSendStreamQ Connection
conn
    case Maybe TxStreamData
mx of
        Just (TxStreamData Stream
s1 [] Length
0 Bool
True)
            | Stream -> Length
streamId Stream
s forall a. Eq a => a -> a -> Bool
== Stream -> Length
streamId Stream
s1 -> do
                TxStreamData
_ <- Connection -> IO TxStreamData
takeSendStreamQ Connection
conn
                forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
        Maybe TxStreamData
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

sendTxStreamData :: Connection -> TxStreamData -> IO ()
sendTxStreamData :: Connection -> TxStreamData -> IO ()
sendTxStreamData Connection
conn (TxStreamData Stream
s [Token]
dats Length
len Bool
fin0) = do
    Bool
fin <- Connection -> Stream -> Bool -> IO Bool
packFin Connection
conn Stream
s Bool
fin0
    if Length
len forall a. Ord a => a -> a -> Bool
< Length
limitation
        then Connection -> Stream -> [Token] -> Bool -> Length -> IO ()
sendStreamSmall Connection
conn Stream
s [Token]
dats Bool
fin Length
len
        else Connection -> Stream -> [Token] -> Bool -> IO ()
sendStreamLarge Connection
conn Stream
s [Token]
dats Bool
fin

sendStreamSmall :: Connection -> Stream -> [StreamData] -> Bool -> Int -> IO ()
sendStreamSmall :: Connection -> Stream -> [Token] -> Bool -> Length -> IO ()
sendStreamSmall Connection
conn Stream
s0 [Token]
dats0 Bool
fin0 Length
len0 = do
    Length
off0 <- Stream -> Length -> IO Length
getTxStreamOffset Stream
s0 Length
len0
    let sid0 :: Length
sid0 = Stream -> Length
streamId Stream
s0
        frame0 :: Frame
frame0 = Length -> Length -> [Token] -> Bool -> Frame
StreamF Length
sid0 Length
off0 [Token]
dats0 Bool
fin0
        sb :: [Stream] -> [Stream]
sb = if Bool
fin0 then (Stream
s0 forall a. a -> [a] -> [a]
:) else forall a. a -> a
id
    ([Frame]
frames, [Stream]
streams) <- Stream
-> Frame
-> Length
-> ([Frame] -> [Frame])
-> ([Stream] -> [Stream])
-> IO ([Frame], [Stream])
loop Stream
s0 Frame
frame0 Length
len0 forall a. a -> a
id [Stream] -> [Stream]
sb
    Bool
ready <- Connection -> IO Bool
isConnection1RTTReady Connection
conn
    let lvl :: EncryptionLevel
lvl
            | Bool
ready = EncryptionLevel
RTT1Level
            | Bool
otherwise = EncryptionLevel
RTT0Level
    Connection -> EncryptionLevel -> [Frame] -> IO [SentPacket]
construct Connection
conn EncryptionLevel
lvl [Frame]
frames forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Connection -> [SentPacket] -> IO ()
sendPacket Connection
conn
    forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Stream -> IO ()
syncFinTx [Stream]
streams
  where
    tryPeek :: IO (Maybe TxStreamData)
tryPeek = do
        Maybe TxStreamData
mx <- Connection -> IO (Maybe TxStreamData)
tryPeekSendStreamQ Connection
conn
        case Maybe TxStreamData
mx of
            Maybe TxStreamData
Nothing -> do
                forall (m :: * -> *). MonadIO m => m ()
yield
                Connection -> IO (Maybe TxStreamData)
tryPeekSendStreamQ Connection
conn
            Just TxStreamData
_ -> forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TxStreamData
mx
    loop
        :: Stream
        -> Frame
        -> Int
        -> ([Frame] -> [Frame])
        -> ([Stream] -> [Stream])
        -> IO ([Frame], [Stream])
    loop :: Stream
-> Frame
-> Length
-> ([Frame] -> [Frame])
-> ([Stream] -> [Stream])
-> IO ([Frame], [Stream])
loop Stream
s Frame
frame Length
total [Frame] -> [Frame]
build [Stream] -> [Stream]
sb = do
        Maybe TxStreamData
mx <- IO (Maybe TxStreamData)
tryPeek
        case Maybe TxStreamData
mx of
            Maybe TxStreamData
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return ([Frame] -> [Frame]
build [Frame
frame], [Stream] -> [Stream]
sb [])
            Just (TxStreamData Stream
s1 [Token]
dats1 Length
len1 Bool
fin1) -> do
                let total1 :: Length
total1 = Length
len1 forall a. Num a => a -> a -> a
+ Length
total
                if Length
total1 forall a. Ord a => a -> a -> Bool
< Length
limitation
                    then do
                        TxStreamData
_ <- Connection -> IO TxStreamData
takeSendStreamQ Connection
conn -- cf tryPeek
                        Bool
fin1' <- Connection -> Stream -> Bool -> IO Bool
packFin Connection
conn Stream
s Bool
fin1 -- must be after takeSendStreamQ
                        Length
off1 <- Stream -> Length -> IO Length
getTxStreamOffset Stream
s1 Length
len1
                        let sid :: Length
sid = Stream -> Length
streamId Stream
s
                            sid1 :: Length
sid1 = Stream -> Length
streamId Stream
s1
                        if Length
sid forall a. Eq a => a -> a -> Bool
== Length
sid1
                            then do
                                let (Length
off, [Token]
dats) = case Frame
frame of
                                        StreamF Length
_ Length
o [Token]
d Bool
_ -> (Length
o, [Token]
d)
                                        Frame
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"sendStreamSmall"
                                    frame1 :: Frame
frame1 = Length -> Length -> [Token] -> Bool -> Frame
StreamF Length
sid Length
off ([Token]
dats forall a. [a] -> [a] -> [a]
++ [Token]
dats1) Bool
fin1'
                                    sb1 :: [Stream] -> [Stream]
sb1 = if Bool
fin1 then ([Stream] -> [Stream]
sb forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stream
s1 forall a. a -> [a] -> [a]
:)) else [Stream] -> [Stream]
sb
                                Stream
-> Frame
-> Length
-> ([Frame] -> [Frame])
-> ([Stream] -> [Stream])
-> IO ([Frame], [Stream])
loop Stream
s1 Frame
frame1 Length
total1 [Frame] -> [Frame]
build [Stream] -> [Stream]
sb1
                            else do
                                let frame1 :: Frame
frame1 = Length -> Length -> [Token] -> Bool -> Frame
StreamF Length
sid1 Length
off1 [Token]
dats1 Bool
fin1'
                                    build1 :: [Frame] -> [Frame]
build1 = [Frame] -> [Frame]
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Frame
frame forall a. a -> [a] -> [a]
:)
                                    sb1 :: [Stream] -> [Stream]
sb1 = if Bool
fin1 then ([Stream] -> [Stream]
sb forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Stream
s1 forall a. a -> [a] -> [a]
:)) else [Stream] -> [Stream]
sb
                                Stream
-> Frame
-> Length
-> ([Frame] -> [Frame])
-> ([Stream] -> [Stream])
-> IO ([Frame], [Stream])
loop Stream
s1 Frame
frame1 Length
total1 [Frame] -> [Frame]
build1 [Stream] -> [Stream]
sb1
                    else forall (m :: * -> *) a. Monad m => a -> m a
return ([Frame] -> [Frame]
build [Frame
frame], [Stream] -> [Stream]
sb [])

sendStreamLarge :: Connection -> Stream -> [ByteString] -> Bool -> IO ()
sendStreamLarge :: Connection -> Stream -> [Token] -> Bool -> IO ()
sendStreamLarge Connection
conn Stream
s [Token]
dats0 Bool
fin0 = do
    [Token] -> IO ()
loop [Token]
dats0
    forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
fin0 forall a b. (a -> b) -> a -> b
$ Stream -> IO ()
syncFinTx Stream
s
  where
    sid :: Length
sid = Stream -> Length
streamId Stream
s
    loop :: [Token] -> IO ()
loop [] = forall (m :: * -> *) a. Monad m => a -> m a
return ()
    loop [Token]
dats = do
        let ([Token]
dats1, [Token]
dats2) = [Token] -> ([Token], [Token])
splitChunks [Token]
dats
            len :: Length
len = [Token] -> Length
totalLen [Token]
dats1
        Length
off <- Stream -> Length -> IO Length
getTxStreamOffset Stream
s Length
len
        let fin :: Bool
fin = Bool
fin0 Bool -> Bool -> Bool
&& forall (t :: * -> *) a. Foldable t => t a -> Bool
null [Token]
dats2
            frame :: Frame
frame = Length -> Length -> [Token] -> Bool -> Frame
StreamF Length
sid Length
off [Token]
dats1 Bool
fin
        Bool
ready <- Connection -> IO Bool
isConnection1RTTReady Connection
conn
        let lvl :: EncryptionLevel
lvl
                | Bool
ready = EncryptionLevel
RTT1Level
                | Bool
otherwise = EncryptionLevel
RTT0Level
        Connection -> EncryptionLevel -> [Frame] -> IO [SentPacket]
construct Connection
conn EncryptionLevel
lvl [Frame
frame] forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Connection -> [SentPacket] -> IO ()
sendPacket Connection
conn
        [Token] -> IO ()
loop [Token]
dats2

-- Typical case: [3, 1024, 1024, 1024, 200]
splitChunks :: [ByteString] -> ([ByteString], [ByteString])
splitChunks :: [Token] -> ([Token], [Token])
splitChunks [Token]
bs0 = forall {a}. [Token] -> Length -> ([Token] -> a) -> (a, [Token])
loop [Token]
bs0 Length
0 forall a. a -> a
id
  where
    loop :: [Token] -> Length -> ([Token] -> a) -> (a, [Token])
loop [] Length
_ [Token] -> a
build = let curr :: a
curr = [Token] -> a
build [] in (a
curr, [])
    loop bbs :: [Token]
bbs@(Token
b : [Token]
bs) Length
siz0 [Token] -> a
build
        | Length
siz forall a. Ord a => a -> a -> Bool
<= Length
threshold = let build' :: [Token] -> a
build' = [Token] -> a
build forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Token
b forall a. a -> [a] -> [a]
:) in [Token] -> Length -> ([Token] -> a) -> (a, [Token])
loop [Token]
bs Length
siz [Token] -> a
build'
        | Length
siz forall a. Ord a => a -> a -> Bool
<= Length
limitation = let curr :: a
curr = [Token] -> a
build [Token
b] in (a
curr, [Token]
bs)
        | Length
len forall a. Ord a => a -> a -> Bool
> Length
limitation =
            let (Token
u, Token
b') = Length -> Token -> (Token, Token)
BS.splitAt (Length
limitation forall a. Num a => a -> a -> a
- Length
siz0) Token
b
                curr :: a
curr = [Token] -> a
build [Token
u]
                bs' :: [Token]
bs' = Token
b' forall a. a -> [a] -> [a]
: [Token]
bs
             in (a
curr, [Token]
bs')
        | Bool
otherwise = let curr :: a
curr = [Token] -> a
build [] in (a
curr, [Token]
bbs)
      where
        len :: Length
len = Token -> Length
BS.length Token
b
        siz :: Length
siz = Length
siz0 forall a. Num a => a -> a -> a
+ Length
len