\begin{code}
{-# LANGUAGE StrictData                 #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE OverloadedStrings          #-}

module Tox.Transport.Reliability where

import           Data.Binary               (Binary, get, put)
import qualified Data.Binary.Get           as Get
import qualified Data.Binary.Put           as Put
import           Data.Word                 (Word32, Word8)
import           Data.Map                  (Map)
import qualified Data.Map                  as Map
import qualified Data.ByteString           as BS
import qualified Data.ByteString.Lazy      as LBS

-- | Sequence Number (32-bit with wrap-around).
newtype SeqNum = SeqNum Word32
  deriving (SeqNum -> SeqNum -> Bool
(SeqNum -> SeqNum -> Bool)
-> (SeqNum -> SeqNum -> Bool) -> Eq SeqNum
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SeqNum -> SeqNum -> Bool
$c/= :: SeqNum -> SeqNum -> Bool
== :: SeqNum -> SeqNum -> Bool
$c== :: SeqNum -> SeqNum -> Bool
Eq, Get SeqNum
[SeqNum] -> Put
SeqNum -> Put
(SeqNum -> Put) -> Get SeqNum -> ([SeqNum] -> Put) -> Binary SeqNum
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [SeqNum] -> Put
$cputList :: [SeqNum] -> Put
get :: Get SeqNum
$cget :: Get SeqNum
put :: SeqNum -> Put
$cput :: SeqNum -> Put
Binary, Int -> SeqNum -> ShowS
[SeqNum] -> ShowS
SeqNum -> String
(Int -> SeqNum -> ShowS)
-> (SeqNum -> String) -> ([SeqNum] -> ShowS) -> Show SeqNum
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SeqNum] -> ShowS
$cshowList :: [SeqNum] -> ShowS
show :: SeqNum -> String
$cshow :: SeqNum -> String
showsPrec :: Int -> SeqNum -> ShowS
$cshowsPrec :: Int -> SeqNum -> ShowS
Show, Integer -> SeqNum
SeqNum -> SeqNum
SeqNum -> SeqNum -> SeqNum
(SeqNum -> SeqNum -> SeqNum)
-> (SeqNum -> SeqNum -> SeqNum)
-> (SeqNum -> SeqNum -> SeqNum)
-> (SeqNum -> SeqNum)
-> (SeqNum -> SeqNum)
-> (SeqNum -> SeqNum)
-> (Integer -> SeqNum)
-> Num SeqNum
forall a.
(a -> a -> a)
-> (a -> a -> a)
-> (a -> a -> a)
-> (a -> a)
-> (a -> a)
-> (a -> a)
-> (Integer -> a)
-> Num a
fromInteger :: Integer -> SeqNum
$cfromInteger :: Integer -> SeqNum
signum :: SeqNum -> SeqNum
$csignum :: SeqNum -> SeqNum
abs :: SeqNum -> SeqNum
$cabs :: SeqNum -> SeqNum
negate :: SeqNum -> SeqNum
$cnegate :: SeqNum -> SeqNum
* :: SeqNum -> SeqNum -> SeqNum
$c* :: SeqNum -> SeqNum -> SeqNum
- :: SeqNum -> SeqNum -> SeqNum
$c- :: SeqNum -> SeqNum -> SeqNum
+ :: SeqNum -> SeqNum -> SeqNum
$c+ :: SeqNum -> SeqNum -> SeqNum
Num, Int -> SeqNum
SeqNum -> Int
SeqNum -> [SeqNum]
SeqNum -> SeqNum
SeqNum -> SeqNum -> [SeqNum]
SeqNum -> SeqNum -> SeqNum -> [SeqNum]
(SeqNum -> SeqNum)
-> (SeqNum -> SeqNum)
-> (Int -> SeqNum)
-> (SeqNum -> Int)
-> (SeqNum -> [SeqNum])
-> (SeqNum -> SeqNum -> [SeqNum])
-> (SeqNum -> SeqNum -> [SeqNum])
-> (SeqNum -> SeqNum -> SeqNum -> [SeqNum])
-> Enum SeqNum
forall a.
(a -> a)
-> (a -> a)
-> (Int -> a)
-> (a -> Int)
-> (a -> [a])
-> (a -> a -> [a])
-> (a -> a -> [a])
-> (a -> a -> a -> [a])
-> Enum a
enumFromThenTo :: SeqNum -> SeqNum -> SeqNum -> [SeqNum]
$cenumFromThenTo :: SeqNum -> SeqNum -> SeqNum -> [SeqNum]
enumFromTo :: SeqNum -> SeqNum -> [SeqNum]
$cenumFromTo :: SeqNum -> SeqNum -> [SeqNum]
enumFromThen :: SeqNum -> SeqNum -> [SeqNum]
$cenumFromThen :: SeqNum -> SeqNum -> [SeqNum]
enumFrom :: SeqNum -> [SeqNum]
$cenumFrom :: SeqNum -> [SeqNum]
fromEnum :: SeqNum -> Int
$cfromEnum :: SeqNum -> Int
toEnum :: Int -> SeqNum
$ctoEnum :: Int -> SeqNum
pred :: SeqNum -> SeqNum
$cpred :: SeqNum -> SeqNum
succ :: SeqNum -> SeqNum
$csucc :: SeqNum -> SeqNum
Enum)

-- | Custom ordering for sequence numbers to handle rollover.
-- A sequence number 'a' is considered less than 'b' if it is within
-- the first half of the 32-bit space following 'a' (circularly).
instance Ord SeqNum where
  compare :: SeqNum -> SeqNum -> Ordering
compare (SeqNum Word32
a) (SeqNum Word32
b)
    | Word32
a Word32 -> Word32 -> Bool
forall a. Eq a => a -> a -> Bool
== Word32
b = Ordering
EQ
    | Word32
b Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
a Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
< Word32
0x80000000 = Ordering
LT
    | Bool
otherwise = Ordering
GT


-- | Header for reliable transport (lossy or lossless).
data ReliablePacket = ReliablePacket
  { ReliablePacket -> SeqNum
rpRecvBufferStart :: SeqNum -- ^ Our next expected recv packet number
  , ReliablePacket -> SeqNum
rpPacketNumber    :: SeqNum -- ^ This packet's number (lossless) or next seq (lossy)
  , ReliablePacket -> Bool
rpIsLossless      :: Bool   -- ^ Discriminator for packet type
  , ReliablePacket -> ByteString
rpPayload         :: BS.ByteString
  } deriving (ReliablePacket -> ReliablePacket -> Bool
(ReliablePacket -> ReliablePacket -> Bool)
-> (ReliablePacket -> ReliablePacket -> Bool) -> Eq ReliablePacket
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReliablePacket -> ReliablePacket -> Bool
$c/= :: ReliablePacket -> ReliablePacket -> Bool
== :: ReliablePacket -> ReliablePacket -> Bool
$c== :: ReliablePacket -> ReliablePacket -> Bool
Eq, Int -> ReliablePacket -> ShowS
[ReliablePacket] -> ShowS
ReliablePacket -> String
(Int -> ReliablePacket -> ShowS)
-> (ReliablePacket -> String)
-> ([ReliablePacket] -> ShowS)
-> Show ReliablePacket
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReliablePacket] -> ShowS
$cshowList :: [ReliablePacket] -> ShowS
show :: ReliablePacket -> String
$cshow :: ReliablePacket -> String
showsPrec :: Int -> ReliablePacket -> ShowS
$cshowsPrec :: Int -> ReliablePacket -> ShowS
Show)

instance Binary ReliablePacket where
  put :: ReliablePacket -> Put
put ReliablePacket
rp = do
    SeqNum -> Put
forall t. Binary t => t -> Put
put (SeqNum -> Put) -> SeqNum -> Put
forall a b. (a -> b) -> a -> b
$ ReliablePacket -> SeqNum
rpRecvBufferStart ReliablePacket
rp
    SeqNum -> Put
forall t. Binary t => t -> Put
put (SeqNum -> Put) -> SeqNum -> Put
forall a b. (a -> b) -> a -> b
$ ReliablePacket -> SeqNum
rpPacketNumber ReliablePacket
rp
    -- The protocol doesn't explicitly flag lossless/lossy in the header,
    -- it relies on the first byte of payload (Data ID) or context.
    -- However, the spec says: "uint32_t packet number if lossless,
    -- sendbuffer buffer_end if lossy".
    ByteString -> Put
Put.putByteString (ByteString -> Put) -> ByteString -> Put
forall a b. (a -> b) -> a -> b
$ ReliablePacket -> ByteString
rpPayload ReliablePacket
rp

  get :: Get ReliablePacket
get = do
    SeqNum
recvStart <- Get SeqNum
forall t. Binary t => Get t
get
    SeqNum
pktNum <- Get SeqNum
forall t. Binary t => Get t
get
    ByteString
payload <- ByteString -> ByteString
LBS.toStrict (ByteString -> ByteString) -> Get ByteString -> Get ByteString
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get ByteString
Get.getRemainingLazyByteString
    -- Note: rpIsLossless needs to be determined by the caller based on Data ID.
    ReliablePacket -> Get ReliablePacket
forall (m :: * -> *) a. Monad m => a -> m a
return (ReliablePacket -> Get ReliablePacket)
-> ReliablePacket -> Get ReliablePacket
forall a b. (a -> b) -> a -> b
$ SeqNum -> SeqNum -> Bool -> ByteString -> ReliablePacket
ReliablePacket SeqNum
recvStart SeqNum
pktNum Bool
True ByteString
payload


-- | State for the reliability layer.
data ReliabilityState = ReliabilityState
  { ReliabilityState -> SeqNum
rsNextSendSeq     :: SeqNum            -- ^ Sequence number for next outgoing lossless packet
  , ReliabilityState -> SeqNum
rsNextRecvSeq     :: SeqNum            -- ^ Sequence number of next expected incoming packet
  , ReliabilityState -> SeqNum
rsPeerNextRecvSeq :: SeqNum            -- ^ Highest contiguous sequence peer has received
  , ReliabilityState -> Map SeqNum ByteString
rsSendWindow      :: Map SeqNum BS.ByteString -- ^ Sent packets awaiting ACK
  , ReliabilityState -> Map SeqNum ByteString
rsRecvWindow      :: Map SeqNum BS.ByteString -- ^ Out-of-order received packets
  } deriving (ReliabilityState -> ReliabilityState -> Bool
(ReliabilityState -> ReliabilityState -> Bool)
-> (ReliabilityState -> ReliabilityState -> Bool)
-> Eq ReliabilityState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReliabilityState -> ReliabilityState -> Bool
$c/= :: ReliabilityState -> ReliabilityState -> Bool
== :: ReliabilityState -> ReliabilityState -> Bool
$c== :: ReliabilityState -> ReliabilityState -> Bool
Eq, Int -> ReliabilityState -> ShowS
[ReliabilityState] -> ShowS
ReliabilityState -> String
(Int -> ReliabilityState -> ShowS)
-> (ReliabilityState -> String)
-> ([ReliabilityState] -> ShowS)
-> Show ReliabilityState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReliabilityState] -> ShowS
$cshowList :: [ReliabilityState] -> ShowS
show :: ReliabilityState -> String
$cshow :: ReliabilityState -> String
showsPrec :: Int -> ReliabilityState -> ShowS
$cshowsPrec :: Int -> ReliabilityState -> ShowS
Show)

-- | Initial state for a new connection.
initState :: ReliabilityState
initState :: ReliabilityState
initState = ReliabilityState :: SeqNum
-> SeqNum
-> SeqNum
-> Map SeqNum ByteString
-> Map SeqNum ByteString
-> ReliabilityState
ReliabilityState
  { rsNextSendSeq :: SeqNum
rsNextSendSeq     = SeqNum
0
  , rsNextRecvSeq :: SeqNum
rsNextRecvSeq     = SeqNum
0
  , rsPeerNextRecvSeq :: SeqNum
rsPeerNextRecvSeq = SeqNum
0
  , rsSendWindow :: Map SeqNum ByteString
rsSendWindow      = Map SeqNum ByteString
forall k a. Map k a
Map.empty
  , rsRecvWindow :: Map SeqNum ByteString
rsRecvWindow      = Map SeqNum ByteString
forall k a. Map k a
Map.empty
  }

-- | A request for missing packets.
data PacketRequest = PacketRequest
  { PacketRequest -> [Word32]
prMissingDeltas :: [Word32] -- ^ Deltas from the last missing packet
  } deriving (PacketRequest -> PacketRequest -> Bool
(PacketRequest -> PacketRequest -> Bool)
-> (PacketRequest -> PacketRequest -> Bool) -> Eq PacketRequest
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PacketRequest -> PacketRequest -> Bool
$c/= :: PacketRequest -> PacketRequest -> Bool
== :: PacketRequest -> PacketRequest -> Bool
$c== :: PacketRequest -> PacketRequest -> Bool
Eq, Int -> PacketRequest -> ShowS
[PacketRequest] -> ShowS
PacketRequest -> String
(Int -> PacketRequest -> ShowS)
-> (PacketRequest -> String)
-> ([PacketRequest] -> ShowS)
-> Show PacketRequest
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PacketRequest] -> ShowS
$cshowList :: [PacketRequest] -> ShowS
show :: PacketRequest -> String
$cshow :: PacketRequest -> String
showsPrec :: Int -> PacketRequest -> ShowS
$cshowsPrec :: Int -> PacketRequest -> ShowS
Show)

instance Binary PacketRequest where
  put :: PacketRequest -> Put
put PacketRequest
pr = do
    Word8 -> Put
Put.putWord8 Word8
1 -- ID for packet request
    (Word32 -> Put) -> [Word32] -> Put
forall (t :: * -> *) (m :: * -> *) a b.
(Foldable t, Monad m) =>
(a -> m b) -> t a -> m ()
mapM_ Word32 -> Put
forall t. Integral t => t -> Put
putDelta (PacketRequest -> [Word32]
prMissingDeltas PacketRequest
pr)
    where
      putDelta :: t -> Put
putDelta t
d | t
d t -> t -> Bool
forall a. Ord a => a -> a -> Bool
< t
255 = Word8 -> Put
Put.putWord8 (t -> Word8
forall a b. (Integral a, Num b) => a -> b
fromIntegral t
d)
      putDelta t
d = do
        Word8 -> Put
Put.putWord8 Word8
0
        t -> Put
putDelta (t
d t -> t -> t
forall a. Num a => a -> a -> a
- t
255)

  get :: Get PacketRequest
get = do
    Word8
_ <- Get Word8
Get.getWord8 -- Skip ID
    [Word32]
deltas <- Get [Word32]
getDeltas
    PacketRequest -> Get PacketRequest
forall (m :: * -> *) a. Monad m => a -> m a
return (PacketRequest -> Get PacketRequest)
-> PacketRequest -> Get PacketRequest
forall a b. (a -> b) -> a -> b
$ [Word32] -> PacketRequest
PacketRequest [Word32]
deltas
    where
      getDeltas :: Get [Word32]
getDeltas = do
        Bool
empty <- Get Bool
Get.isEmpty
        if Bool
empty then [Word32] -> Get [Word32]
forall (m :: * -> *) a. Monad m => a -> m a
return [] else do
          Word8
d <- Get Word8
Get.getWord8
          if Word8
d Word8 -> Word8 -> Bool
forall a. Eq a => a -> a -> Bool
== Word8
0
            then do
              [Word32]
ds <- Get [Word32]
getDeltas
              case [Word32]
ds of
                []     -> [Word32] -> Get [Word32]
forall (m :: * -> *) a. Monad m => a -> m a
return [Word32
255]
                (Word32
x:[Word32]
xs) -> [Word32] -> Get [Word32]
forall (m :: * -> *) a. Monad m => a -> m a
return (Word32
x Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
255 Word32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
: [Word32]
xs)
            else (Word8 -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word8
d Word32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
:) ([Word32] -> [Word32]) -> Get [Word32] -> Get [Word32]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Get [Word32]
getDeltas


-- | Process an incoming reliable packet.
-- Returns the updated state and any newly deliverable payloads.
handleIncoming :: ReliablePacket -> ReliabilityState -> (ReliabilityState, [BS.ByteString])
handleIncoming :: ReliablePacket
-> ReliabilityState -> (ReliabilityState, [ByteString])
handleIncoming ReliablePacket
pkt ReliabilityState
state =
  let
    -- 1. Peer is telling us they received everything before rpRecvBufferStart pkt
    -- Clear acknowledged packets from our send window
    (Map SeqNum ByteString
_, Map SeqNum ByteString
remainingSend) = (SeqNum -> ByteString -> Bool)
-> Map SeqNum ByteString
-> (Map SeqNum ByteString, Map SeqNum ByteString)
forall k a. (k -> a -> Bool) -> Map k a -> (Map k a, Map k a)
Map.partitionWithKey (\SeqNum
k ByteString
_ -> SeqNum
k SeqNum -> SeqNum -> Bool
forall a. Ord a => a -> a -> Bool
< ReliablePacket -> SeqNum
rpRecvBufferStart ReliablePacket
pkt) (ReliabilityState -> Map SeqNum ByteString
rsSendWindow ReliabilityState
state)

    -- 2. Buffer this packet if it's new and in/after our window
    newRecvWindow :: Map SeqNum ByteString
newRecvWindow = if ReliablePacket -> SeqNum
rpPacketNumber ReliablePacket
pkt SeqNum -> SeqNum -> Bool
forall a. Ord a => a -> a -> Bool
>= ReliabilityState -> SeqNum
rsNextRecvSeq ReliabilityState
state Bool -> Bool -> Bool
&& SeqNum -> Map SeqNum ByteString -> Bool
forall k a. Ord k => k -> Map k a -> Bool
Map.notMember (ReliablePacket -> SeqNum
rpPacketNumber ReliablePacket
pkt) (ReliabilityState -> Map SeqNum ByteString
rsRecvWindow ReliabilityState
state)
                    then SeqNum
-> ByteString -> Map SeqNum ByteString -> Map SeqNum ByteString
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert (ReliablePacket -> SeqNum
rpPacketNumber ReliablePacket
pkt) (ReliablePacket -> ByteString
rpPayload ReliablePacket
pkt) (ReliabilityState -> Map SeqNum ByteString
rsRecvWindow ReliabilityState
state)
                    else ReliabilityState -> Map SeqNum ByteString
rsRecvWindow ReliabilityState
state

    -- 3. Pull deliverable packets from the recv window
    ([ByteString]
deliverable, Map SeqNum ByteString
finalRecvWindow, SeqNum
finalNextRecvSeq) = SeqNum
-> Map SeqNum ByteString
-> ([ByteString], Map SeqNum ByteString, SeqNum)
extractDeliverable (ReliabilityState -> SeqNum
rsNextRecvSeq ReliabilityState
state) Map SeqNum ByteString
newRecvWindow

    newState :: ReliabilityState
newState = ReliabilityState
state
      { rsSendWindow :: Map SeqNum ByteString
rsSendWindow  = Map SeqNum ByteString
remainingSend
      , rsRecvWindow :: Map SeqNum ByteString
rsRecvWindow  = Map SeqNum ByteString
finalRecvWindow
      , rsNextRecvSeq :: SeqNum
rsNextRecvSeq = SeqNum
finalNextRecvSeq
      }
  in
    (ReliabilityState
newState, [ByteString]
deliverable)


-- | Generate a request for all currently missing packets in our recv window.
createPacketRequest :: ReliabilityState -> Maybe PacketRequest
createPacketRequest :: ReliabilityState -> Maybe PacketRequest
createPacketRequest ReliabilityState
state =
  case Map SeqNum ByteString -> [SeqNum]
forall k a. Map k a -> [k]
Map.keys (ReliabilityState -> Map SeqNum ByteString
rsRecvWindow ReliabilityState
state) of
    [] -> Maybe PacketRequest
forall a. Maybe a
Nothing
    [SeqNum]
keys ->
      let highest :: SeqNum
highest = [SeqNum] -> SeqNum
forall (t :: * -> *) a. (Foldable t, Ord a) => t a -> a
maximum [SeqNum]
keys
          allExpected :: [SeqNum]
allExpected = [ReliabilityState -> SeqNum
rsNextRecvSeq ReliabilityState
state .. SeqNum
highest]
          missing :: [SeqNum]
missing = (SeqNum -> Bool) -> [SeqNum] -> [SeqNum]
forall a. (a -> Bool) -> [a] -> [a]
filter (SeqNum -> Map SeqNum ByteString -> Bool
forall k a. Ord k => k -> Map k a -> Bool
`Map.notMember` ReliabilityState -> Map SeqNum ByteString
rsRecvWindow ReliabilityState
state) [SeqNum]
allExpected
      in if [SeqNum] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [SeqNum]
missing
         then Maybe PacketRequest
forall a. Maybe a
Nothing
         else PacketRequest -> Maybe PacketRequest
forall a. a -> Maybe a
Just (PacketRequest -> Maybe PacketRequest)
-> PacketRequest -> Maybe PacketRequest
forall a b. (a -> b) -> a -> b
$ [Word32] -> PacketRequest
PacketRequest ([Word32] -> PacketRequest) -> [Word32] -> PacketRequest
forall a b. (a -> b) -> a -> b
$ SeqNum -> [SeqNum] -> [Word32]
calculateDeltas (ReliabilityState -> SeqNum
rsNextRecvSeq ReliabilityState
state) [SeqNum]
missing
  where
    calculateDeltas :: SeqNum -> [SeqNum] -> [Word32]
calculateDeltas SeqNum
_ [] = []
    calculateDeltas SeqNum
prev (SeqNum
x:[SeqNum]
xs) =
      let SeqNum Word32
lastVal = SeqNum
prev
          SeqNum Word32
xVal = SeqNum
x
      in (Word32
xVal Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
lastVal) Word32 -> [Word32] -> [Word32]
forall a. a -> [a] -> [a]
: SeqNum -> [SeqNum] -> [Word32]
calculateDeltas SeqNum
x [SeqNum]
xs


-- | Pull contiguous packets from the recv window starting at 'next'.
extractDeliverable :: SeqNum -> Map SeqNum BS.ByteString -> ([BS.ByteString], Map SeqNum BS.ByteString, SeqNum)
extractDeliverable :: SeqNum
-> Map SeqNum ByteString
-> ([ByteString], Map SeqNum ByteString, SeqNum)
extractDeliverable SeqNum
next Map SeqNum ByteString
window =
  case SeqNum -> Map SeqNum ByteString -> Maybe ByteString
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup SeqNum
next Map SeqNum ByteString
window of
    Maybe ByteString
Nothing -> ([], Map SeqNum ByteString
window, SeqNum
next)
    Just ByteString
payload ->
      let ([ByteString]
rest, Map SeqNum ByteString
finalWindow, SeqNum
finalNext) = SeqNum
-> Map SeqNum ByteString
-> ([ByteString], Map SeqNum ByteString, SeqNum)
extractDeliverable (SeqNum
next SeqNum -> SeqNum -> SeqNum
forall a. Num a => a -> a -> a
+ SeqNum
1) (SeqNum -> Map SeqNum ByteString -> Map SeqNum ByteString
forall k a. Ord k => k -> Map k a -> Map k a
Map.delete SeqNum
next Map SeqNum ByteString
window)
      in (ByteString
payload ByteString -> [ByteString] -> [ByteString]
forall a. a -> [a] -> [a]
: [ByteString]
rest, Map SeqNum ByteString
finalWindow, SeqNum
finalNext)


-- | Create a new outgoing lossless packet.
createLossless :: BS.ByteString -> ReliabilityState -> (ReliablePacket, ReliabilityState)
createLossless :: ByteString
-> ReliabilityState -> (ReliablePacket, ReliabilityState)
createLossless ByteString
payload ReliabilityState
state =
  let
    pktNum :: SeqNum
pktNum = ReliabilityState -> SeqNum
rsNextSendSeq ReliabilityState
state
    pkt :: ReliablePacket
pkt = ReliablePacket :: SeqNum -> SeqNum -> Bool -> ByteString -> ReliablePacket
ReliablePacket
      { rpRecvBufferStart :: SeqNum
rpRecvBufferStart = ReliabilityState -> SeqNum
rsNextRecvSeq ReliabilityState
state
      , rpPacketNumber :: SeqNum
rpPacketNumber    = SeqNum
pktNum
      , rpIsLossless :: Bool
rpIsLossless      = Bool
True
      , rpPayload :: ByteString
rpPayload         = ByteString
payload
      }
    newState :: ReliabilityState
newState = ReliabilityState
state
      { rsNextSendSeq :: SeqNum
rsNextSendSeq = SeqNum
pktNum SeqNum -> SeqNum -> SeqNum
forall a. Num a => a -> a -> a
+ SeqNum
1
      , rsSendWindow :: Map SeqNum ByteString
rsSendWindow  = SeqNum
-> ByteString -> Map SeqNum ByteString -> Map SeqNum ByteString
forall k a. Ord k => k -> a -> Map k a -> Map k a
Map.insert SeqNum
pktNum ByteString
payload (ReliabilityState -> Map SeqNum ByteString
rsSendWindow ReliabilityState
state)
      }
  in
    (ReliablePacket
pkt, ReliabilityState
newState)


-- | Process a packet request from the peer and identify packets to resend.
-- Returns the updated state and the list of packets that should be resent.
handlePacketRequest :: PacketRequest -> ReliabilityState -> ([ReliablePacket], ReliabilityState)
handlePacketRequest :: PacketRequest
-> ReliabilityState -> ([ReliablePacket], ReliabilityState)
handlePacketRequest PacketRequest
req ReliabilityState
state =
  let
    missingSeqs :: [SeqNum]
missingSeqs = SeqNum -> [Word32] -> [SeqNum]
reconstructMissing (ReliabilityState -> SeqNum
rsNextRecvSeq ReliabilityState
state) (PacketRequest -> [Word32]
prMissingDeltas PacketRequest
req)
    -- We use our current nextRecvSeq as the base for the resent packets' headers
    toResend :: Map SeqNum ByteString
toResend = (SeqNum -> ByteString -> Bool)
-> Map SeqNum ByteString -> Map SeqNum ByteString
forall k a. (k -> a -> Bool) -> Map k a -> Map k a
Map.filterWithKey (\SeqNum
k ByteString
_ -> SeqNum
k SeqNum -> [SeqNum] -> Bool
forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [SeqNum]
missingSeqs) (ReliabilityState -> Map SeqNum ByteString
rsSendWindow ReliabilityState
state)
    res :: Map SeqNum ByteString -> [ReliablePacket]
res Map SeqNum ByteString
packets = (SeqNum -> ByteString -> [ReliablePacket] -> [ReliablePacket])
-> [ReliablePacket] -> Map SeqNum ByteString -> [ReliablePacket]
forall k a b. (k -> a -> b -> b) -> b -> Map k a -> b
Map.foldrWithKey (\SeqNum
s ByteString
payload [ReliablePacket]
acc ->
      SeqNum -> SeqNum -> Bool -> ByteString -> ReliablePacket
ReliablePacket (ReliabilityState -> SeqNum
rsNextRecvSeq ReliabilityState
state) SeqNum
s Bool
True ByteString
payload ReliablePacket -> [ReliablePacket] -> [ReliablePacket]
forall a. a -> [a] -> [a]
: [ReliablePacket]
acc) [] Map SeqNum ByteString
packets
  in
    (Map SeqNum ByteString -> [ReliablePacket]
res Map SeqNum ByteString
toResend, ReliabilityState
state)
  where
    reconstructMissing :: SeqNum -> [Word32] -> [SeqNum]
reconstructMissing SeqNum
_ [] = []
    reconstructMissing SeqNum
base (Word32
d:[Word32]
ds) =
      let SeqNum Word32
baseVal = SeqNum
base
          next :: SeqNum
next = Word32 -> SeqNum
SeqNum (Word32
baseVal Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
d)
      in SeqNum
next SeqNum -> [SeqNum] -> [SeqNum]
forall a. a -> [a] -> [a]
: SeqNum -> [Word32] -> [SeqNum]
reconstructMissing SeqNum
next [Word32]
ds
\end{code}

Data in the encrypted packets:

\begin{verbatim}
[our recvbuffers buffer_start, (highest packet number handled + 1), (big endian)]
[uint32_t packet number if lossless, sendbuffer buffer_end if lossy, (big endian)]
[data]
\end{verbatim}

Encrypted packets may be lossy or lossless.  Lossy packets are simply encrypted
packets that are sent to the other.  If they are lost, arrive in the wrong
order or even if an attacker duplicates them (be sure to take this into account
for anything that uses lossy packets) they will simply be decrypted as they
arrive and passed upwards to what should handle them depending on the data id.

Lossless packets are packets containing data that will be delivered in order by
the implementation of the protocol.  In this protocol, the receiver tells the
sender which packet numbers he has received and which he has not and the sender
must resend any packets that are dropped.  Any attempt at doubling packets will
cause all (except the first received) to be ignored.

Each lossless packet contains both a 4 byte number indicating the highest
packet number received and processed and a 4 byte packet number which is the
packet number of the data in the packet.

In lossy packets, the layout is the same except that instead of a packet
number, the second 4 byte number represents the packet number of a lossless
packet if one were sent right after.  This number is used by the receiver to
know if any packets have been lost.  (for example if it receives 4 packets with
numbers (0, 1, 2, 5) and then later a lossy packet with this second number as:
8 it knows that packets: 3, 4, 6, 7 have been lost and will request them)

How the reliability is achieved:

First it is important to say that packet numbers do roll over, the next number
after 0xFFFFFFFF (maximum value in 4 bytes) is 0.  Hence, all the mathematical
operations dealing with packet numbers are assumed to be done only on unsigned
32 bit integer unless said otherwise.  For example 0 - 0xFFFFFFFF would equal
to 1 because of the rollover.

When sending a lossless packet, the packet is created with its packet number
being the number of the last lossless packet created + 1 (starting at 0).  The
packet numbers are used for both reliability and in ordered delivery and so
must be sequential.

The packet is then stored along with its packet number in order for the peer to
be able to send it again if the receiver does not receive it.  Packets are only
removed from storage when the receiver confirms they have received them.

The receiver receives packets and stores them along with their packet number.
When a receiver receives a packet he stores the packet along with its packet
number in an array.  If there is already a packet with that number in the
buffer, the packet is dropped.  If the packet number is smaller than the last
packet number that was processed, the packet is dropped.  A processed packet
means it was removed from the buffer and passed upwards to the relevant module.

Assuming a new connection, the sender sends 5 lossless packets to the receiver:
0, 1, 2, 3, 4 are the packet numbers sent and the receiver receives: 3, 2, 0, 2
in that order.

The receiver will save the packets and discards the second packet with the
number 2, he has: 0, 2, 3 in his buffer.  He will pass the first packet to the
relevant module and remove it from the array but since packet number 1 is
missing he will stop there.  Contents of the buffer are now: 2, 3.  The
receiver knows packet number 1 is missing and will request it from the sender
by using a packet request packet:

data ids:

\begin{tabular}{l|l}
  ID   & Data \\
  \hline
  0    & padding (skipped until we hit a non zero (data id) byte) \\
  1    & packet request packet (lossy packet) \\
  2    & connection kill packet (lossy packet) \\
  ...  & ... \\
  16+  & reserved for Messenger usage (lossless packets) \\
  192+ & reserved for Messenger usage (lossy packets) \\
  255  & reserved for Messenger usage (lossless packet) \\
\end{tabular}

Connection kill packets tell the other that the connection is over.

Packet numbers are the first byte of data in the packet.

packet request packet:

\begin{verbatim}
[uint8_t (1)][uint8_t num][uint8_t num][uint8_t num]...[uint8_t num]
\end{verbatim}

Packet request packets are used by one side of the connection to request
packets from the other.  To create a full packet request packet, the one
requesting the packet takes the last packet number that was processed (sent to
the relevant module and removed from the array (0 in the example above)).
Subtract the number of the first missing packet from that number (1 - 0) = 1.
Which means the full packet to request packet number 1 will look like:

\begin{verbatim}
[uint32_t 1]
[uint32_t 0]
[uint8_t 1][uint8_t 1]
\end{verbatim}

If packet number 4 was being requested as well, take the difference between the
packet number and the last packet number being requested (4 - 1) = 3.  So the
packet will look like:

\begin{verbatim}
[uint32_t 1]
[uint32_t 0]
[uint8_t 1][uint8_t 1][uint8_t 3]
\end{verbatim}

But what if the number is greater than 255? Let's say the peer needs to request
packets 3, 6, 1024, the packet will look like:

\begin{verbatim}
[uint32_t 1]
[uint32_t 2]
[uint8_t 1][uint8_t 3][uint8_t 3][uint8_t 0][uint8_t 0][uint8_t 0][uint8_t 253]
\end{verbatim}

Each 0 in the packet represents adding 255 until a non 0 byte is reached which
is then added and the resulting requested number is what is left.

This request is designed to be small when requesting packets in real network
conditions where the requested packet numbers will be close to each other.
Putting each requested 4 byte packet number would be very simple but would make
the request packets unnecessarily large which is why the packets look like
this.

When a request packet is received, it will be decoded and all packets in
between the requested packets will be assumed to be successfully received by
the other.

Packet request packets are sent at least every 1 second in toxcore and more
when packets are being received.

The current formula used is (note that this formula is likely sub-optimal):

\begin{verbatim}
REQUEST_PACKETS_COMPARE_CONSTANT = 50.0 double request_packet_interval =
(REQUEST_PACKETS_COMPARE_CONSTANT /
(((double)num_packets_array(&conn->recv_array) + 1.0) / (conn->packet_recv_rate
+ 1.0)));
\end{verbatim}

\texttt{num\_packets\_array(&conn->recv\_array)} returns the difference between
the highest packet number received and the last one handled.  In the toxcore
code it refers to the total size of the current array (with the holes which are
the placeholders for not yet received packets that are known to be missing).

\texttt{conn->packet\_recv\_rate} is the number of data packets successfully
received per second.

This formula was created with the logic that the higher the 'delay' in packets
(\texttt{num\_packets\_array(&conn->recv\_array)}) vs the speed of packets
received, the more request packets should be sent.

Requested packets are resent every time they can be resent as in they will obey
the congestion control and not bypass it.  They are resent once, subsequent
request packets will be used to know if the packet was received or if it should
be resent.