{-# LANGUAGE OverloadedStrings #-}

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

import Control.Concurrent
import Control.Concurrent.STM
import qualified Data.ByteString as BS
import Foreign.Marshal.Alloc
import Foreign.Ptr (plusPtr)
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.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 -> CryptoData -> EncryptionLevel -> IO Frame
cryptoFrame Connection
conn CryptoData
crypto EncryptionLevel
lvl = do
    let len :: Int
len = CryptoData -> Int
BS.length CryptoData
crypto
    Maybe Stream
mstrm <- Connection -> EncryptionLevel -> IO (Maybe Stream)
getCryptoStream Connection
conn EncryptionLevel
lvl
    case Maybe Stream
mstrm of
      Maybe Stream
Nothing   -> InternalControl -> IO Frame
forall (m :: * -> *) e a. (MonadIO m, Exception e) => e -> m a
E.throwIO InternalControl
MustNotReached
      Just Stream
strm -> do
          Int
off <- Stream -> Int -> IO Int
getTxStreamOffset Stream
strm Int
len
          Frame -> IO Frame
forall (m :: * -> *) a. Monad m => a -> m a
return (Frame -> IO Frame) -> Frame -> IO Frame
forall a b. (a -> b) -> a -> b
$ Int -> CryptoData -> Frame
CryptoF Int
off CryptoData
crypto

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

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

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

sendPingPacket :: Connection -> SendBuf -> Buffer -> EncryptionLevel -> IO ()
sendPingPacket :: Connection -> SendBuf -> Buffer -> EncryptionLevel -> IO ()
sendPingPacket Connection
conn SendBuf
send Buffer
buf EncryptionLevel
lvl = do
    Int
maxSiz <- Connection -> IO Int
forall a. Connector a => a -> IO Int
getMaxPacketSize Connection
conn
    Bool
ok <- if Connection -> Bool
forall a. Connector a => a -> Bool
isClient Connection
conn then Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
          else Connection -> Int -> IO Bool
checkAntiAmplificationFree Connection
conn Int
maxSiz
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
ok (IO () -> IO ()) -> IO () -> IO ()
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
              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
"probe ping"
              [Frame] -> IO [Frame]
forall (m :: * -> *) a. Monad m => a -> m a
return [Frame
Ping]
          Just SentPacket
spkt -> 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
"probe old"
              let PlainPacket Header
_ Plain
plain0 = SentPacket -> PlainPacket
spPlainPacket SentPacket
spkt
              Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
conn ([Frame] -> IO [Frame]) -> [Frame] -> IO [Frame]
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 [SentPacket] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SentPacket]
xs then
            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 NULL"
          else do
            let spkt :: SentPacket
spkt = [SentPacket] -> SentPacket
forall a. [a] -> a
last [SentPacket]
xs
                ping :: PlainPacket
ping = SentPacket -> PlainPacket
spPlainPacket SentPacket
spkt
                bufsiz :: Int
bufsiz = Int
maximumUdpPayloadSize
            (Int
bytes,Int
padlen) <- Connection
-> Buffer -> Int -> PlainPacket -> Maybe Int -> IO (Int, Int)
encodePlainPacket Connection
conn Buffer
buf Int
bufsiz PlainPacket
ping (Int -> Maybe Int
forall a. a -> Maybe a
Just Int
maxSiz)
            Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (Int
bytes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
0) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ do
                TimeMicrosecond
now <- IO TimeMicrosecond
getTimeMicrosecond
                SendBuf
send Buffer
buf Int
bytes
                Connection -> Int -> IO ()
addTxBytes Connection
conn Int
bytes
                let sentPacket0 :: SentPacket
sentPacket0 = SentPacket -> Int -> Int -> SentPacket
fixSentPacket SentPacket
spkt Int
bytes Int
padlen
                    sentPacket :: SentPacket
sentPacket = SentPacket
sentPacket0 { spTimeSent :: TimeMicrosecond
spTimeSent = TimeMicrosecond
now }
                Connection -> SentPacket -> TimeMicrosecond -> IO ()
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
        [SentPacket] -> IO [SentPacket]
forall (m :: * -> *) a. Monad m => a -> m a
return []
      else do
        Bool
established <- Connection -> IO Bool
forall a. Connector a => a -> IO Bool
isConnectionEstablished Connection
conn
        if Bool
established Bool -> Bool -> Bool
|| (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
HandshakeLevel) then do
            IO [SentPacket]
constructTargetPacket
          else do
            [SentPacket]
ppkt0 <- IO [SentPacket]
constructLowerAckPacket
            [SentPacket]
ppkt1 <- IO [SentPacket]
constructTargetPacket
            [SentPacket] -> IO [SentPacket]
forall (m :: * -> *) a. Monad m => a -> m a
return ([SentPacket]
ppkt0 [SentPacket] -> [SentPacket] -> [SentPacket]
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' EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
RTT1Level then
            [SentPacket] -> IO [SentPacket]
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
                [SentPacket] -> IO [SentPacket]
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
      | [Frame] -> Bool
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
                [SentPacket] -> IO [SentPacket]
forall (m :: * -> *) a. Monad m => a -> m a
return []
              else
                if EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
RTT1Level then do
                    PeerPacketNumbers
prevppns <- LDCC -> IO PeerPacketNumbers
getPreviousRTT1PPNs LDCC
ldcc
                    if PeerPacketNumbers
ppns PeerPacketNumbers -> PeerPacketNumbers -> Bool
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
                       [SentPacket] -> IO [SentPacket]
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 | [Frame] -> Bool
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 Frame -> [Frame] -> [Frame]
forall a. a -> [a] -> [a]
: [Frame]
frames0
    Header
header <- Connection -> EncryptionLevel -> IO Header
mkHeader Connection
conn EncryptionLevel
lvl
    Int
mypn <- Connection -> IO Int
nextPacketNumber Connection
conn
    let convert :: EncryptionLevel -> Plain -> Plain
convert = Hooks -> EncryptionLevel -> Plain -> Plain
onPlainCreated (Hooks -> EncryptionLevel -> Plain -> Plain)
-> Hooks -> EncryptionLevel -> Plain -> Plain
forall a b. (a -> b) -> a -> b
$ Connection -> Hooks
connHooks Connection
conn
        plain :: Plain
plain = EncryptionLevel -> Plain -> Plain
convert EncryptionLevel
lvl (Plain -> Plain) -> Plain -> Plain
forall a b. (a -> b) -> a -> b
$ Flags Raw -> Int -> [Frame] -> Int -> Plain
Plain (Word8 -> Flags Raw
forall a. Word8 -> Flags a
Flags Word8
0) Int
mypn [Frame]
frames Int
0
        ppkt :: PlainPacket
ppkt = Header -> Plain -> PlainPacket
PlainPacket Header
header Plain
plain
    [SentPacket] -> IO [SentPacket]
forall (m :: * -> *) a. Monad m => a -> m a
return [Int
-> EncryptionLevel
-> PlainPacket
-> PeerPacketNumbers
-> Bool
-> SentPacket
mkSentPacket Int
mypn EncryptionLevel
lvl PlainPacket
ppkt PeerPacketNumbers
ppns Bool
ackEli]
  where
    mkAck :: PeerPacketNumbers -> Frame
mkAck PeerPacketNumbers
ps = AckInfo -> Delay -> Frame
Ack ([Int] -> AckInfo
toAckInfo ([Int] -> AckInfo) -> [Int] -> AckInfo
forall a b. (a -> b) -> a -> b
$ PeerPacketNumbers -> [Int]
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
    CryptoData
token <- if EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
InitialLevel then Connection -> IO CryptoData
getToken Connection
conn else CryptoData -> IO CryptoData
forall (m :: * -> *) a. Monad m => a -> m a
return CryptoData
""
    Header -> IO Header
forall (m :: * -> *) a. Monad m => a -> m a
return (Header -> IO Header) -> Header -> IO Header
forall a b. (a -> b) -> a -> b
$ case EncryptionLevel
lvl of
      EncryptionLevel
InitialLevel   -> Version -> CID -> CID -> CryptoData -> Header
Initial   Version
ver CID
peercid CID
mycid CryptoData
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 -> SendBuf -> IO ()
sender :: Connection -> SendBuf -> IO ()
sender Connection
conn SendBuf
send = 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 Buffer -> (Buffer -> IO ()) -> (Buffer -> IO ()) -> IO ()
forall (m :: * -> *) a b c.
MonadUnliftIO m =>
m a -> (a -> m b) -> (a -> m c) -> m c
E.bracket (Int -> IO Buffer
forall a. Int -> IO (Ptr a)
mallocBytes (Int
maximumUdpPayloadSize Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
2))
              Buffer -> IO ()
forall a. Ptr a -> IO ()
free
              Buffer -> IO ()
forall b. Buffer -> IO b
body
  where
    body :: Buffer -> IO b
body Buffer
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
        Switch
x <- STM Switch -> IO Switch
forall a. STM a -> IO a
atomically ((EncryptionLevel -> Switch
SwPing (EncryptionLevel -> Switch) -> STM EncryptionLevel -> STM Switch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> LDCC -> STM EncryptionLevel
takePingSTM (Connection -> LDCC
connLDCC Connection
conn))
                STM Switch -> STM Switch -> STM Switch
forall a. STM a -> STM a -> STM a
`orElse` (Output -> Switch
SwOut  (Output -> Switch) -> STM Output -> STM Switch
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Connection -> STM Output
takeOutputSTM Connection
conn)
                STM Switch -> STM Switch -> STM Switch
forall a. STM a -> STM a -> STM a
`orElse` (TxStreamData -> Switch
SwStrm (TxStreamData -> Switch) -> STM TxStreamData -> STM Switch
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 -> SendBuf -> Buffer -> EncryptionLevel -> IO ()
sendPingPacket   Connection
conn SendBuf
send Buffer
buf EncryptionLevel
lvl
          SwOut  Output
out -> Connection -> SendBuf -> Buffer -> Output -> IO ()
sendOutput       Connection
conn SendBuf
send Buffer
buf Output
out
          SwStrm TxStreamData
tx  -> Connection -> SendBuf -> Buffer -> TxStreamData -> IO ()
sendTxStreamData Connection
conn SendBuf
send Buffer
buf TxStreamData
tx
    logAction :: DebugLogger
logAction Builder
msg = Connection -> DebugLogger
connDebugLog Connection
conn (Builder
"debug: sender: " Builder -> Builder -> Builder
forall a. Semigroup a => a -> a -> a
<> Builder
msg)

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

discardClientInitialPacketNumberSpace :: Connection -> IO ()
discardClientInitialPacketNumberSpace :: Connection -> IO ()
discardClientInitialPacketNumberSpace Connection
conn
  | Connection -> Bool
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
        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
  | Bool
otherwise = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()

sendOutput :: Connection -> SendBuf -> Buffer -> Output -> IO ()
sendOutput :: Connection -> SendBuf -> Buffer -> Output -> IO ()
sendOutput Connection
conn SendBuf
send Buffer
buf (OutControl EncryptionLevel
lvl [Frame]
frames IO ()
action) = do
    Connection -> EncryptionLevel -> [Frame] -> IO [SentPacket]
construct Connection
conn EncryptionLevel
lvl [Frame]
frames IO [SentPacket] -> ([SentPacket] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Connection -> SendBuf -> Buffer -> [SentPacket] -> IO ()
sendPacket Connection
conn SendBuf
send Buffer
buf
    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
$ Connection -> IO ()
discardClientInitialPacketNumberSpace Connection
conn
    IO ()
action

sendOutput Connection
conn SendBuf
send Buffer
buf (OutHandshake [(EncryptionLevel, CryptoData)]
lcs0) = do
    let convert :: [(EncryptionLevel, CryptoData)]
-> ([(EncryptionLevel, CryptoData)], Bool)
convert = Hooks
-> [(EncryptionLevel, CryptoData)]
-> ([(EncryptionLevel, CryptoData)], Bool)
onTLSHandshakeCreated (Hooks
 -> [(EncryptionLevel, CryptoData)]
 -> ([(EncryptionLevel, CryptoData)], Bool))
-> Hooks
-> [(EncryptionLevel, CryptoData)]
-> ([(EncryptionLevel, CryptoData)], Bool)
forall a b. (a -> b) -> a -> b
$ Connection -> Hooks
connHooks Connection
conn
        ([(EncryptionLevel, CryptoData)]
lcs,Bool
wait) = [(EncryptionLevel, CryptoData)]
-> ([(EncryptionLevel, CryptoData)], Bool)
convert [(EncryptionLevel, CryptoData)]
lcs0
    -- only for h3spec
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when Bool
wait (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$ Connection -> IO ()
wait0RTTReady Connection
conn
    Connection
-> SendBuf -> Buffer -> [(EncryptionLevel, CryptoData)] -> IO ()
sendCryptoFragments Connection
conn SendBuf
send Buffer
buf [(EncryptionLevel, CryptoData)]
lcs
    Bool -> IO () -> IO ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
when (((EncryptionLevel, CryptoData) -> Bool)
-> [(EncryptionLevel, CryptoData)] -> Bool
forall (t :: * -> *) a. Foldable t => (a -> Bool) -> t a -> Bool
any (\(EncryptionLevel
l,CryptoData
_) -> EncryptionLevel
l EncryptionLevel -> EncryptionLevel -> Bool
forall a. Eq a => a -> a -> Bool
== EncryptionLevel
HandshakeLevel) [(EncryptionLevel, CryptoData)]
lcs) (IO () -> IO ()) -> IO () -> IO ()
forall a b. (a -> b) -> a -> b
$
        Connection -> IO ()
discardClientInitialPacketNumberSpace Connection
conn
sendOutput Connection
conn SendBuf
send Buffer
buf (OutRetrans (PlainPacket Header
hdr0 Plain
plain0)) = do
    [Frame]
frames <- Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
conn ([Frame] -> IO [Frame]) -> [Frame] -> IO [Frame]
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 IO [SentPacket] -> ([SentPacket] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Connection -> SendBuf -> Buffer -> [SentPacket] -> IO ()
sendPacket Connection
conn SendBuf
send Buffer
buf

levelFromHeader :: Header -> EncryptionLevel
levelFromHeader :: Header -> EncryptionLevel
levelFromHeader Header
hdr
    | EncryptionLevel
lvl EncryptionLevel -> EncryptionLevel -> Bool
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
_    [] = [Frame] -> IO [Frame]
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 Int
sid Int
_:[Frame]
xs) = do
    Maybe Stream
mstrm <- Connection -> Int -> IO (Maybe Stream)
findStream Connection
conn Int
sid
    case Maybe Stream
mstrm of
      Maybe Stream
Nothing   -> Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
conn [Frame]
xs
      Just Stream
strm -> do
          Int
newMax <- Stream -> IO Int
getRxMaxStreamData Stream
strm
          let r :: Frame
r = Int -> Int -> Frame
MaxStreamData Int
sid Int
newMax
          [Frame]
rs <- Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
conn [Frame]
xs
          [Frame] -> IO [Frame]
forall (m :: * -> *) a. Monad m => a -> m a
return (Frame
r Frame -> [Frame] -> [Frame]
forall a. a -> [a] -> [a]
: [Frame]
rs)
adjustForRetransmit Connection
conn (MaxData{}:[Frame]
xs) = do
    Int
newMax <- Connection -> IO Int
getRxMaxData Connection
conn
    let r :: Frame
r = Int -> Frame
MaxData Int
newMax
    [Frame]
rs <- Connection -> [Frame] -> IO [Frame]
adjustForRetransmit Connection
conn [Frame]
xs
    [Frame] -> IO [Frame]
forall (m :: * -> *) a. Monad m => a -> m a
return (Frame
r Frame -> [Frame] -> [Frame]
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
    [Frame] -> IO [Frame]
forall (m :: * -> *) a. Monad m => a -> m a
return (Frame
x Frame -> [Frame] -> [Frame]
forall a. a -> [a] -> [a]
: [Frame]
rs)

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

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

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

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

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

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

packFin :: Connection -> Stream -> Bool -> IO Bool
packFin :: Connection -> Stream -> Bool -> IO Bool
packFin Connection
_    Stream
_ Bool
True  = Bool -> IO Bool
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 [] Int
0 Bool
True)
          | Stream -> Int
streamId Stream
s Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Stream -> Int
streamId Stream
s1 -> do
                TxStreamData
_ <- Connection -> IO TxStreamData
takeSendStreamQ Connection
conn
                Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
True
      Maybe TxStreamData
_ -> Bool -> IO Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False

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

sendStreamSmall :: Connection -> SendBuf -> Buffer -> Stream -> [StreamData] -> Bool -> Int -> IO ()
sendStreamSmall :: Connection
-> SendBuf
-> Buffer
-> Stream
-> [CryptoData]
-> Bool
-> Int
-> IO ()
sendStreamSmall Connection
conn SendBuf
send Buffer
buf Stream
s0 [CryptoData]
dats0 Bool
fin0 Int
len0 = do
    Int
off0 <- Stream -> Int -> IO Int
getTxStreamOffset Stream
s0 Int
len0
    let sid0 :: Int
sid0 = Stream -> Int
streamId Stream
s0
        frame0 :: Frame
frame0 = Int -> Int -> [CryptoData] -> Bool -> Frame
StreamF Int
sid0 Int
off0 [CryptoData]
dats0 Bool
fin0
    [Frame]
frames <- Stream -> Frame -> Int -> ([Frame] -> [Frame]) -> IO [Frame]
loop Stream
s0 Frame
frame0 Int
len0 [Frame] -> [Frame]
forall a. a -> a
id
    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 IO [SentPacket] -> ([SentPacket] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Connection -> SendBuf -> Buffer -> [SentPacket] -> IO ()
sendPacket Connection
conn SendBuf
send Buffer
buf
  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
              IO ()
yield
              Connection -> IO (Maybe TxStreamData)
tryPeekSendStreamQ Connection
conn
          Just TxStreamData
_ -> Maybe TxStreamData -> IO (Maybe TxStreamData)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe TxStreamData
mx
    loop :: Stream -> Frame -> Int -> ([Frame] -> [Frame]) -> IO [Frame]
    loop :: Stream -> Frame -> Int -> ([Frame] -> [Frame]) -> IO [Frame]
loop Stream
s Frame
frame Int
total [Frame] -> [Frame]
build = do
        Maybe TxStreamData
mx <- IO (Maybe TxStreamData)
tryPeek
        case Maybe TxStreamData
mx of
          Maybe TxStreamData
Nothing -> [Frame] -> IO [Frame]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Frame] -> IO [Frame]) -> [Frame] -> IO [Frame]
forall a b. (a -> b) -> a -> b
$ [Frame] -> [Frame]
build [Frame
frame]
          Just (TxStreamData Stream
s1 [CryptoData]
dats1 Int
len1 Bool
fin1) -> do
              let total1 :: Int
total1 = Int
len1 Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
total
              if Int
total1 Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
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
                  Int
off1 <- Stream -> Int -> IO Int
getTxStreamOffset Stream
s1 Int
len1
                  let sid :: Int
sid  = Stream -> Int
streamId Stream
s
                      sid1 :: Int
sid1 = Stream -> Int
streamId Stream
s1
                  if Int
sid Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
sid1 then do
                      let StreamF Int
_ Int
off [CryptoData]
dats Bool
_ = Frame
frame
                          frame1 :: Frame
frame1 = Int -> Int -> [CryptoData] -> Bool -> Frame
StreamF Int
sid Int
off ([CryptoData]
dats [CryptoData] -> [CryptoData] -> [CryptoData]
forall a. [a] -> [a] -> [a]
++ [CryptoData]
dats1) Bool
fin1'
                      Stream -> Frame -> Int -> ([Frame] -> [Frame]) -> IO [Frame]
loop Stream
s1 Frame
frame1 Int
total1 [Frame] -> [Frame]
build
                    else do
                      let frame1 :: Frame
frame1 = Int -> Int -> [CryptoData] -> Bool -> Frame
StreamF Int
sid1 Int
off1 [CryptoData]
dats1 Bool
fin1'
                          build1 :: [Frame] -> [Frame]
build1 = [Frame] -> [Frame]
build ([Frame] -> [Frame]) -> ([Frame] -> [Frame]) -> [Frame] -> [Frame]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Frame
frame Frame -> [Frame] -> [Frame]
forall a. a -> [a] -> [a]
:)
                      Stream -> Frame -> Int -> ([Frame] -> [Frame]) -> IO [Frame]
loop Stream
s1 Frame
frame1 Int
total1 [Frame] -> [Frame]
build1
                else
                  [Frame] -> IO [Frame]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Frame] -> IO [Frame]) -> [Frame] -> IO [Frame]
forall a b. (a -> b) -> a -> b
$ [Frame] -> [Frame]
build [Frame
frame]

sendStreamLarge :: Connection -> SendBuf -> Buffer -> Stream -> [ByteString] -> Bool -> IO ()
sendStreamLarge :: Connection
-> SendBuf -> Buffer -> Stream -> [CryptoData] -> Bool -> IO ()
sendStreamLarge Connection
conn SendBuf
send Buffer
buf Stream
s [CryptoData]
dats0 Bool
fin0 = [CryptoData] -> IO ()
loop [CryptoData]
dats0
  where
    sid :: Int
sid = Stream -> Int
streamId Stream
s
    loop :: [CryptoData] -> IO ()
loop [] = () -> IO ()
forall (m :: * -> *) a. Monad m => a -> m a
return ()
    loop [CryptoData]
dats = do
        let ([CryptoData]
dats1,[CryptoData]
dats2) = [CryptoData] -> ([CryptoData], [CryptoData])
splitChunks [CryptoData]
dats
            len :: Int
len = [CryptoData] -> Int
totalLen [CryptoData]
dats1
        Int
off <- Stream -> Int -> IO Int
getTxStreamOffset Stream
s Int
len
        let fin :: Bool
fin = Bool
fin0 Bool -> Bool -> Bool
&& [CryptoData] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [CryptoData]
dats2
            frame :: Frame
frame = Int -> Int -> [CryptoData] -> Bool -> Frame
StreamF Int
sid Int
off [CryptoData]
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] IO [SentPacket] -> ([SentPacket] -> IO ()) -> IO ()
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Connection -> SendBuf -> Buffer -> [SentPacket] -> IO ()
sendPacket Connection
conn SendBuf
send Buffer
buf
        [CryptoData] -> IO ()
loop [CryptoData]
dats2

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