\begin{code}
{-# LANGUAGE DeriveGeneric         #-}
{-# LANGUAGE FlexibleContexts      #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE RecordWildCards       #-}
{-# LANGUAGE StrictData            #-}
module Tox.Onion.Path where

import           Control.Monad             (replicateM, replicateM_, unless)
import           Control.Monad.State          (MonadState, gets, modify)
import qualified Data.ByteString           as BS
import           Data.Word                 (Word32)
import           GHC.Generics              (Generic)
import           Test.QuickCheck.Arbitrary (Arbitrary (..))

import           Tox.Core.Time                (TimeDiff, Timestamp)
import qualified Tox.Core.Time                as Time
import           Tox.Core.Timed               (Timed, askTime)
import           Tox.Crypto.Core.Box               (CipherText)
import qualified Tox.Crypto.Core.Box               as Box
import           Tox.Crypto.Core.Key               (Nonce)
import           Tox.Crypto.Core.Keyed             (Keyed)
import qualified Tox.Crypto.Core.Keyed             as Keyed
import           Tox.Crypto.Core.KeyPair           (KeyPair(..))
import qualified Tox.Crypto.Core.KeyPair           as KeyPair
import qualified Tox.DHT.DhtState             as DhtState
import qualified Tox.DHT.NodeList             as NodeList
import           Tox.Crypto.Core.MonadRandomBytes (MonadRandomBytes, newKeyPair,
                                               uniform)
import qualified Tox.Crypto.Core.MonadRandomBytes as MonadRandomBytes (uniformSafe)
import           Tox.Network.Core.NodeInfo         (NodeInfo)
import qualified Tox.Network.Core.NodeInfo         as NodeInfo
import           Tox.Network.Core.SocketAddress    (SocketAddress)
import qualified Tox.Onion.Tunnel             as Tunnel


{-------------------------------------------------------------------------------
 -
 - :: Implementation.
 -
 ------------------------------------------------------------------------------}


class (MonadState OnionPathState m, Timed m, MonadRandomBytes m, Keyed m) => OnionPathMonad m


maxPaths :: Int
maxPaths :: Int
maxPaths = Int
6

pathLifetime :: TimeDiff
pathLifetime :: TimeDiff
pathLifetime = Integer -> TimeDiff
Time.seconds Integer
1200

unconfirmedPathTimeout :: TimeDiff
unconfirmedPathTimeout :: TimeDiff
unconfirmedPathTimeout = Integer -> TimeDiff
Time.seconds Integer
4

confirmedPathTimeout :: TimeDiff
confirmedPathTimeout :: TimeDiff
confirmedPathTimeout = Integer -> TimeDiff
Time.seconds Integer
10


data OnionPath = OnionPath
  { OnionPath -> [NodeInfo]
pathNodes       :: [NodeInfo] -- Exactly 3 nodes
  , OnionPath -> [KeyPair]
pathKeys        :: [KeyPair]  -- Temporary keypairs for each hop
  , OnionPath -> Bool
pathConfirmed   :: Bool
  , OnionPath -> Int
pathTries       :: Int
  , OnionPath -> Timestamp
pathExpires     :: Timestamp
  , OnionPath -> Maybe Timestamp
pathLastAttempt :: Maybe Timestamp
  , OnionPath -> Word32
pathNum         :: Word32
  }
  deriving (OnionPath -> OnionPath -> Bool
(OnionPath -> OnionPath -> Bool)
-> (OnionPath -> OnionPath -> Bool) -> Eq OnionPath
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OnionPath -> OnionPath -> Bool
$c/= :: OnionPath -> OnionPath -> Bool
== :: OnionPath -> OnionPath -> Bool
$c== :: OnionPath -> OnionPath -> Bool
Eq, Int -> OnionPath -> ShowS
[OnionPath] -> ShowS
OnionPath -> String
(Int -> OnionPath -> ShowS)
-> (OnionPath -> String)
-> ([OnionPath] -> ShowS)
-> Show OnionPath
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OnionPath] -> ShowS
$cshowList :: [OnionPath] -> ShowS
show :: OnionPath -> String
$cshow :: OnionPath -> String
showsPrec :: Int -> OnionPath -> ShowS
$cshowsPrec :: Int -> OnionPath -> ShowS
Show, ReadPrec [OnionPath]
ReadPrec OnionPath
Int -> ReadS OnionPath
ReadS [OnionPath]
(Int -> ReadS OnionPath)
-> ReadS [OnionPath]
-> ReadPrec OnionPath
-> ReadPrec [OnionPath]
-> Read OnionPath
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OnionPath]
$creadListPrec :: ReadPrec [OnionPath]
readPrec :: ReadPrec OnionPath
$creadPrec :: ReadPrec OnionPath
readList :: ReadS [OnionPath]
$creadList :: ReadS [OnionPath]
readsPrec :: Int -> ReadS OnionPath
$creadsPrec :: Int -> ReadS OnionPath
Read, (forall x. OnionPath -> Rep OnionPath x)
-> (forall x. Rep OnionPath x -> OnionPath) -> Generic OnionPath
forall x. Rep OnionPath x -> OnionPath
forall x. OnionPath -> Rep OnionPath x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OnionPath x -> OnionPath
$cfrom :: forall x. OnionPath -> Rep OnionPath x
Generic)

instance Arbitrary OnionPath where
  arbitrary :: Gen OnionPath
arbitrary = [NodeInfo]
-> [KeyPair]
-> Bool
-> Int
-> Timestamp
-> Maybe Timestamp
-> Word32
-> OnionPath
OnionPath ([NodeInfo]
 -> [KeyPair]
 -> Bool
 -> Int
 -> Timestamp
 -> Maybe Timestamp
 -> Word32
 -> OnionPath)
-> Gen [NodeInfo]
-> Gen
     ([KeyPair]
      -> Bool
      -> Int
      -> Timestamp
      -> Maybe Timestamp
      -> Word32
      -> OnionPath)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [NodeInfo]
forall a. Arbitrary a => Gen a
arbitrary Gen
  ([KeyPair]
   -> Bool
   -> Int
   -> Timestamp
   -> Maybe Timestamp
   -> Word32
   -> OnionPath)
-> Gen [KeyPair]
-> Gen
     (Bool
      -> Int -> Timestamp -> Maybe Timestamp -> Word32 -> OnionPath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [KeyPair]
forall a. Arbitrary a => Gen a
arbitrary Gen
  (Bool
   -> Int -> Timestamp -> Maybe Timestamp -> Word32 -> OnionPath)
-> Gen Bool
-> Gen (Int -> Timestamp -> Maybe Timestamp -> Word32 -> OnionPath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary Gen (Int -> Timestamp -> Maybe Timestamp -> Word32 -> OnionPath)
-> Gen Int
-> Gen (Timestamp -> Maybe Timestamp -> Word32 -> OnionPath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Int
forall a. Arbitrary a => Gen a
arbitrary Gen (Timestamp -> Maybe Timestamp -> Word32 -> OnionPath)
-> Gen Timestamp -> Gen (Maybe Timestamp -> Word32 -> OnionPath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Timestamp
forall a. Arbitrary a => Gen a
arbitrary Gen (Maybe Timestamp -> Word32 -> OnionPath)
-> Gen (Maybe Timestamp) -> Gen (Word32 -> OnionPath)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Maybe Timestamp)
forall a. Arbitrary a => Gen a
arbitrary Gen (Word32 -> OnionPath) -> Gen Word32 -> Gen OnionPath
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary


isPathAlive :: Timestamp -> OnionPath -> Bool
isPathAlive :: Timestamp -> OnionPath -> Bool
isPathAlive Timestamp
now OnionPath
path =
  OnionPath -> Timestamp
pathExpires OnionPath
path Timestamp -> Timestamp -> Bool
forall a. Ord a => a -> a -> Bool
> Timestamp
now Bool -> Bool -> Bool
&&
  case OnionPath -> Maybe Timestamp
pathLastAttempt OnionPath
path of
    Maybe Timestamp
Nothing -> Bool
True
    Just Timestamp
lastTime ->
      let timeout :: TimeDiff
timeout = if OnionPath -> Bool
pathConfirmed OnionPath
path then TimeDiff
confirmedPathTimeout else TimeDiff
unconfirmedPathTimeout
          maxTries :: Int
maxTries = if OnionPath -> Bool
pathConfirmed OnionPath
path then Int
4 else Int
2
      in Timestamp
now Timestamp -> Timestamp -> TimeDiff
`Time.diffTime` Timestamp
lastTime TimeDiff -> TimeDiff -> Bool
forall a. Ord a => a -> a -> Bool
< TimeDiff
timeout Bool -> Bool -> Bool
|| OnionPath -> Int
pathTries OnionPath
path Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
maxTries


data OnionPathState = OnionPathState
  { OnionPathState -> [OnionPath]
announcePaths :: [OnionPath]
  , OnionPathState -> [OnionPath]
searchPaths   :: [OnionPath]
  , OnionPathState -> Word32
lastPathNum   :: Word32
  }
  deriving (OnionPathState -> OnionPathState -> Bool
(OnionPathState -> OnionPathState -> Bool)
-> (OnionPathState -> OnionPathState -> Bool) -> Eq OnionPathState
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: OnionPathState -> OnionPathState -> Bool
$c/= :: OnionPathState -> OnionPathState -> Bool
== :: OnionPathState -> OnionPathState -> Bool
$c== :: OnionPathState -> OnionPathState -> Bool
Eq, Int -> OnionPathState -> ShowS
[OnionPathState] -> ShowS
OnionPathState -> String
(Int -> OnionPathState -> ShowS)
-> (OnionPathState -> String)
-> ([OnionPathState] -> ShowS)
-> Show OnionPathState
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [OnionPathState] -> ShowS
$cshowList :: [OnionPathState] -> ShowS
show :: OnionPathState -> String
$cshow :: OnionPathState -> String
showsPrec :: Int -> OnionPathState -> ShowS
$cshowsPrec :: Int -> OnionPathState -> ShowS
Show, ReadPrec [OnionPathState]
ReadPrec OnionPathState
Int -> ReadS OnionPathState
ReadS [OnionPathState]
(Int -> ReadS OnionPathState)
-> ReadS [OnionPathState]
-> ReadPrec OnionPathState
-> ReadPrec [OnionPathState]
-> Read OnionPathState
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [OnionPathState]
$creadListPrec :: ReadPrec [OnionPathState]
readPrec :: ReadPrec OnionPathState
$creadPrec :: ReadPrec OnionPathState
readList :: ReadS [OnionPathState]
$creadList :: ReadS [OnionPathState]
readsPrec :: Int -> ReadS OnionPathState
$creadsPrec :: Int -> ReadS OnionPathState
Read, (forall x. OnionPathState -> Rep OnionPathState x)
-> (forall x. Rep OnionPathState x -> OnionPathState)
-> Generic OnionPathState
forall x. Rep OnionPathState x -> OnionPathState
forall x. OnionPathState -> Rep OnionPathState x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep OnionPathState x -> OnionPathState
$cfrom :: forall x. OnionPathState -> Rep OnionPathState x
Generic)

instance Arbitrary OnionPathState where
  arbitrary :: Gen OnionPathState
arbitrary = [OnionPath] -> [OnionPath] -> Word32 -> OnionPathState
OnionPathState ([OnionPath] -> [OnionPath] -> Word32 -> OnionPathState)
-> Gen [OnionPath] -> Gen ([OnionPath] -> Word32 -> OnionPathState)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [OnionPath]
forall a. Arbitrary a => Gen a
arbitrary Gen ([OnionPath] -> Word32 -> OnionPathState)
-> Gen [OnionPath] -> Gen (Word32 -> OnionPathState)
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [OnionPath]
forall a. Arbitrary a => Gen a
arbitrary Gen (Word32 -> OnionPathState) -> Gen Word32 -> Gen OnionPathState
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary


createPath :: MonadRandomBytes m => [NodeInfo] -> Word32 -> Timestamp -> m OnionPath
createPath :: [NodeInfo] -> Word32 -> Timestamp -> m OnionPath
createPath [NodeInfo]
nodes Word32
pNum Timestamp
expires = do
  [KeyPair]
keys <- Int -> m KeyPair -> m [KeyPair]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 m KeyPair
forall (m :: * -> *). MonadRandomBytes m => m KeyPair
newKeyPair
  OnionPath -> m OnionPath
forall (m :: * -> *) a. Monad m => a -> m a
return (OnionPath -> m OnionPath) -> OnionPath -> m OnionPath
forall a b. (a -> b) -> a -> b
$ [NodeInfo]
-> [KeyPair]
-> Bool
-> Int
-> Timestamp
-> Maybe Timestamp
-> Word32
-> OnionPath
OnionPath [NodeInfo]
nodes [KeyPair]
keys Bool
False Int
0 Timestamp
expires Maybe Timestamp
forall a. Maybe a
Nothing Word32
pNum


-- | Maintain the set of onion paths.
maintainPaths :: OnionPathMonad m => [NodeInfo] -> m ()
maintainPaths :: [NodeInfo] -> m ()
maintainPaths [NodeInfo]
nodes = do
  Timestamp
now <- m Timestamp
forall (m :: * -> *). Timed m => m Timestamp
askTime
  -- Filter out expired or failed paths
  (OnionPathState -> OnionPathState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((OnionPathState -> OnionPathState) -> m ())
-> (OnionPathState -> OnionPathState) -> m ()
forall a b. (a -> b) -> a -> b
$ \OnionPathState{[OnionPath]
Word32
lastPathNum :: Word32
searchPaths :: [OnionPath]
announcePaths :: [OnionPath]
lastPathNum :: OnionPathState -> Word32
searchPaths :: OnionPathState -> [OnionPath]
announcePaths :: OnionPathState -> [OnionPath]
..} -> OnionPathState :: [OnionPath] -> [OnionPath] -> Word32 -> OnionPathState
OnionPathState
    { announcePaths :: [OnionPath]
announcePaths = (OnionPath -> Bool) -> [OnionPath] -> [OnionPath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Timestamp -> OnionPath -> Bool
isPathAlive Timestamp
now) [OnionPath]
announcePaths
    , searchPaths :: [OnionPath]
searchPaths   = (OnionPath -> Bool) -> [OnionPath] -> [OnionPath]
forall a. (a -> Bool) -> [a] -> [a]
filter (Timestamp -> OnionPath -> Bool
isPathAlive Timestamp
now) [OnionPath]
searchPaths
    , Word32
lastPathNum :: Word32
lastPathNum :: Word32
..
    }

  -- Fill up announce paths
  Int
numAnnounce <- (OnionPathState -> Int) -> m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([OnionPath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([OnionPath] -> Int)
-> (OnionPathState -> [OnionPath]) -> OnionPathState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnionPathState -> [OnionPath]
announcePaths)
  Int -> m () -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
maxPaths Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numAnnounce) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    [NodeInfo]
pNodes <- [NodeInfo] -> m [NodeInfo]
forall (m :: * -> *).
MonadRandomBytes m =>
[NodeInfo] -> m [NodeInfo]
pickNodes [NodeInfo]
nodes
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NodeInfo]
pNodes) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      Word32
pNum <- (OnionPathState -> Word32) -> m Word32
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets OnionPathState -> Word32
lastPathNum
      OnionPath
p <- [NodeInfo] -> Word32 -> Timestamp -> m OnionPath
forall (m :: * -> *).
MonadRandomBytes m =>
[NodeInfo] -> Word32 -> Timestamp -> m OnionPath
createPath [NodeInfo]
pNodes (Word32
pNum Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1) (Timestamp
now Timestamp -> TimeDiff -> Timestamp
`Time.addTime` TimeDiff
pathLifetime)
      (OnionPathState -> OnionPathState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((OnionPathState -> OnionPathState) -> m ())
-> (OnionPathState -> OnionPathState) -> m ()
forall a b. (a -> b) -> a -> b
$ \OnionPathState{[OnionPath]
Word32
lastPathNum :: Word32
searchPaths :: [OnionPath]
announcePaths :: [OnionPath]
lastPathNum :: OnionPathState -> Word32
searchPaths :: OnionPathState -> [OnionPath]
announcePaths :: OnionPathState -> [OnionPath]
..} -> OnionPathState :: [OnionPath] -> [OnionPath] -> Word32 -> OnionPathState
OnionPathState
        { announcePaths :: [OnionPath]
announcePaths = OnionPath
p OnionPath -> [OnionPath] -> [OnionPath]
forall a. a -> [a] -> [a]
: [OnionPath]
announcePaths
        , lastPathNum :: Word32
lastPathNum = Word32
pNum Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1
        , [OnionPath]
searchPaths :: [OnionPath]
searchPaths :: [OnionPath]
..
        }

  -- Fill up search paths
  Int
numSearch <- (OnionPathState -> Int) -> m Int
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets ([OnionPath] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([OnionPath] -> Int)
-> (OnionPathState -> [OnionPath]) -> OnionPathState -> Int
forall b c a. (b -> c) -> (a -> b) -> a -> c
. OnionPathState -> [OnionPath]
searchPaths)
  Int -> m () -> m ()
forall (m :: * -> *) a. Applicative m => Int -> m a -> m ()
replicateM_ (Int
maxPaths Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
numSearch) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
    [NodeInfo]
pNodes <- [NodeInfo] -> m [NodeInfo]
forall (m :: * -> *).
MonadRandomBytes m =>
[NodeInfo] -> m [NodeInfo]
pickNodes [NodeInfo]
nodes
    Bool -> m () -> m ()
forall (f :: * -> *). Applicative f => Bool -> f () -> f ()
unless ([NodeInfo] -> Bool
forall (t :: * -> *) a. Foldable t => t a -> Bool
null [NodeInfo]
pNodes) (m () -> m ()) -> m () -> m ()
forall a b. (a -> b) -> a -> b
$ do
      Word32
pNum <- (OnionPathState -> Word32) -> m Word32
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets OnionPathState -> Word32
lastPathNum
      OnionPath
p <- [NodeInfo] -> Word32 -> Timestamp -> m OnionPath
forall (m :: * -> *).
MonadRandomBytes m =>
[NodeInfo] -> Word32 -> Timestamp -> m OnionPath
createPath [NodeInfo]
pNodes (Word32
pNum Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1) (Timestamp
now Timestamp -> TimeDiff -> Timestamp
`Time.addTime` TimeDiff
pathLifetime)
      (OnionPathState -> OnionPathState) -> m ()
forall s (m :: * -> *). MonadState s m => (s -> s) -> m ()
modify ((OnionPathState -> OnionPathState) -> m ())
-> (OnionPathState -> OnionPathState) -> m ()
forall a b. (a -> b) -> a -> b
$ \OnionPathState{[OnionPath]
Word32
lastPathNum :: Word32
searchPaths :: [OnionPath]
announcePaths :: [OnionPath]
lastPathNum :: OnionPathState -> Word32
searchPaths :: OnionPathState -> [OnionPath]
announcePaths :: OnionPathState -> [OnionPath]
..} -> OnionPathState :: [OnionPath] -> [OnionPath] -> Word32 -> OnionPathState
OnionPathState
        { searchPaths :: [OnionPath]
searchPaths = OnionPath
p OnionPath -> [OnionPath] -> [OnionPath]
forall a. a -> [a] -> [a]
: [OnionPath]
searchPaths
        , lastPathNum :: Word32
lastPathNum = Word32
pNum Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1
        , [OnionPath]
announcePaths :: [OnionPath]
announcePaths :: [OnionPath]
..
        }

-- | Select a random path for sending.
selectPath :: OnionPathMonad m => Bool -> m (Maybe OnionPath)
selectPath :: Bool -> m (Maybe OnionPath)
selectPath Bool
forAnnounce = do
  [OnionPath]
paths <- (OnionPathState -> [OnionPath]) -> m [OnionPath]
forall s (m :: * -> *) a. MonadState s m => (s -> a) -> m a
gets (if Bool
forAnnounce then OnionPathState -> [OnionPath]
announcePaths else OnionPathState -> [OnionPath]
searchPaths)
  [OnionPath] -> m (Maybe OnionPath)
forall (m :: * -> *) a. MonadRandomBytes m => [a] -> m (Maybe a)
MonadRandomBytes.uniformSafe [OnionPath]
paths


-- | Pick 3 random nodes for a path. Returns empty list if not enough nodes.
pickNodes :: MonadRandomBytes m => [NodeInfo] -> m [NodeInfo]
pickNodes :: [NodeInfo] -> m [NodeInfo]
pickNodes [NodeInfo]
nodes | [NodeInfo] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length [NodeInfo]
nodes Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
< Int
3 = [NodeInfo] -> m [NodeInfo]
forall (m :: * -> *) a. Monad m => a -> m a
return []
pickNodes [NodeInfo]
nodes =
  -- Naive uniform selection.
  -- TODO: ensure uniqueness and diversity (different subnets).
  Int -> m NodeInfo -> m [NodeInfo]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
3 ([NodeInfo] -> m NodeInfo
forall (m :: * -> *) a. MonadRandomBytes m => [a] -> m a
uniform [NodeInfo]
nodes)


-- | Wrap data into a nested Onion Request payload.
wrapPath :: Keyed m
         => KeyPair        -- ^ Our DHT KeyPair
         -> OnionPath      -- ^ The path to follow (A, B, C)
         -> SocketAddress  -- ^ Final destination Node D
         -> Nonce          -- ^ Nonce for all layers
         -> CipherText     -- ^ Final encrypted payload for Node D
         -> m Tunnel.OnionRequest0
wrapPath :: KeyPair
-> OnionPath
-> SocketAddress
-> Nonce
-> CipherText
-> m OnionRequest0
wrapPath KeyPair
ourKeyPair OnionPath
path SocketAddress
destAddr Nonce
nonce CipherText
innerData =
  case (OnionPath -> [NodeInfo]
pathNodes OnionPath
path, OnionPath -> [KeyPair]
pathKeys OnionPath
path) of
    ([NodeInfo
nodeA, NodeInfo
nodeB, NodeInfo
nodeC], [KeyPair
kp1, KeyPair
kp2, KeyPair
kp3]) -> do
      -- Layer 3: Encrypted with kp2 (SK2) for Node C (nodeC)
      -- Decrypted by C to find D and the final payload.
      let p3 :: OnionRequestPayload
p3 = OnionIPPort -> PublicKey -> CipherText -> OnionRequestPayload
Tunnel.OnionRequestPayload (SocketAddress -> OnionIPPort
Tunnel.OnionIPPort SocketAddress
destAddr) (KeyPair -> PublicKey
KeyPair.publicKey KeyPair
kp3) CipherText
innerData
      CombinedKey
combined3 <- SecretKey -> PublicKey -> m CombinedKey
forall (m :: * -> *).
Keyed m =>
SecretKey -> PublicKey -> m CombinedKey
Keyed.getCombinedKey (KeyPair -> SecretKey
KeyPair.secretKey KeyPair
kp2) (NodeInfo -> PublicKey
NodeInfo.publicKey NodeInfo
nodeC)
      let enc3 :: CipherText
enc3 = CombinedKey -> Nonce -> PlainText -> CipherText
Box.encrypt CombinedKey
combined3 Nonce
nonce (OnionRequestPayload -> PlainText
forall a. Binary a => a -> PlainText
Box.encode OnionRequestPayload
p3)

      -- Layer 2: Encrypted with kp1 (SK1) for Node B (nodeB)
      -- Decrypted by B to find C and Layer 3.
      let p2 :: OnionRequestPayload
p2 = OnionIPPort -> PublicKey -> CipherText -> OnionRequestPayload
Tunnel.OnionRequestPayload (SocketAddress -> OnionIPPort
Tunnel.OnionIPPort (NodeInfo -> SocketAddress
NodeInfo.address NodeInfo
nodeC)) (KeyPair -> PublicKey
KeyPair.publicKey KeyPair
kp2) CipherText
enc3
      CombinedKey
combined2 <- SecretKey -> PublicKey -> m CombinedKey
forall (m :: * -> *).
Keyed m =>
SecretKey -> PublicKey -> m CombinedKey
Keyed.getCombinedKey (KeyPair -> SecretKey
secretKey KeyPair
kp1) (NodeInfo -> PublicKey
NodeInfo.publicKey NodeInfo
nodeB)
      let enc2 :: CipherText
enc2 = CombinedKey -> Nonce -> PlainText -> CipherText
Box.encrypt CombinedKey
combined2 Nonce
nonce (OnionRequestPayload -> PlainText
forall a. Binary a => a -> PlainText
Box.encode OnionRequestPayload
p2)

      -- Layer 1: Encrypted with our DHT key for Node A (nodeA)
      -- Decrypted by A to find B and Layer 2.
      let p1 :: OnionRequestPayload
p1 = OnionIPPort -> PublicKey -> CipherText -> OnionRequestPayload
Tunnel.OnionRequestPayload (SocketAddress -> OnionIPPort
Tunnel.OnionIPPort (NodeInfo -> SocketAddress
NodeInfo.address NodeInfo
nodeB)) (KeyPair -> PublicKey
KeyPair.publicKey KeyPair
kp1) CipherText
enc2
      KeyPair
-> PublicKey -> Nonce -> OnionRequestPayload -> m OnionRequest0
forall (m :: * -> *).
Keyed m =>
KeyPair
-> PublicKey -> Nonce -> OnionRequestPayload -> m OnionRequest0
Tunnel.wrapOnion0 KeyPair
ourKeyPair (NodeInfo -> PublicKey
NodeInfo.publicKey NodeInfo
nodeA) Nonce
nonce OnionRequestPayload
p1
    ([NodeInfo], [KeyPair])
_ -> String -> m OnionRequest0
forall a. HasCallStack => String -> a
error String
"wrapPath: OnionPath must have exactly 3 nodes and 3 keys"
\end{code}

In order to announce itself using onion announce packets toxcore first takes
DHT peers, picks random ones and builds onion paths with them by saving 3
nodes, calling it a path, generating some keypairs for encrypting the onion
packets and using them to send onion packets.  If the peer is only connected
with TCP, the initial nodes will be bootstrap nodes and connected TCP relays
(for the first peer in the path).  Once the peer is connected to the onion he
can fill up his list of known peers with peers sent in announce responses if
needed.

Onion paths have different timeouts depending on whether the path is confirmed
or unconfirmed.  Unconfirmed paths (paths that core has never received any
responses from) have a timeout of 4 seconds with 2 tries before they are deemed
non working.  This is because, due to network conditions, there may be a large
number of newly created paths that do not work and so trying them a lot would
make finding a working path take much longer.  The timeout for a confirmed path
(from which a response was received) is 10 seconds with 4 tries without a
response.  A confirmed path has a maximum lifetime of 1200 seconds to make
possible deanonimization attacks more difficult.

Toxcore saves a maximum of 12 paths: 6 paths are reserved for announcing
ourselves and 6 others are used to search for friends.  This may not be the
safest way (some nodes may be able to associate friends together) however it is
much more performant than having different paths for each friend.  The main
benefit is that the announcing and searching are done with different paths,
which makes it difficult to know that peer with real public key X is friends
with Y and Z.  More research is needed to find the best way to do this.  At
first toxcore did have different paths for each friend, however, that meant
that each friend path was almost never used (and checked).  When using a low
amount of paths for searching there is less resources needed to find good
paths.  6 paths are used because 4 was too low and caused some performance
issues because it took longer to find some good paths at the beginning because
only 4 could be tried at a time.  A too high number meanwhile would mean each
path is used (and tested) less.  The reason why the numbers are the same for
both types of paths is for code simplification purposes.

To search/announce itself to peers, toxcore keeps the 8 closest peers (12 for
announcing) to each key it is searching (or announcing itself to).  To
populate these it starts by sending announce requests to random peers for all
the public keys it is searching for.  It then recursively searches closer and
closer peers (DHT distance function) until it no longer finds any.  It is
important to make sure it is not too aggressive at searching the peers as some
might no longer be online but peers might still send announce responses with
their information. Toxcore keeps lists of last pinged nodes for each key
searched so as not to ping dead nodes too aggressively.

Toxcore decides if it will send an announce packet to one of the 4 peers in the
announce response by checking if the peer would be stored as one of the stored
closest peers if it responded; if it would not be it doesn't send an announce
request, if it would be it sends one.

Peers are only put in the closest peers array if they respond to an announce
request.  If the peers fail to respond to 3 announce requests they are deemed
timed out and removed.  When sending an announce request to a peer to which we
have been announcing ourselves for at least 90 seconds and which has failed to
respond to the previous 2 requests, toxcore uses a random path for the request.
This reduces the chances that a good node will be removed due to bad paths.

The reason for the numbers of peers being 8 and 12 is that lower numbers might
make searching for and announcing too unreliable and a higher number too
bandwidth/resource intensive.

Toxcore uses \texttt{ping\_array} (see \texttt{ping\_array}) for the 8 byte
sendback data in announce packets to store information that it will need to
handle the response (key to decrypt it, why was it sent? (to announce ourselves
or to search? For what key? and some other info)).  For security purposes it
checks to make sure the packet was received from the right ip/port and checks
if the key in the unencrypted part of the packet is the right public key.

For peers we are announcing ourselves to, if we are not announced to them
toxcore tries every 3 seconds to announce ourselves to them until they return
that we have announced ourselves to them, then initially toxcore sends an
announce request packet every 15 seconds to see if we are still announced and
reannounce ourselves at the same time.  Toxcore sends every announce packet
with the \texttt{ping\_id} previously received from that peer with the same
path (if possible).  Toxcore use a timeout of 120 seconds rather than 15
seconds if we have been announcing to the peer for at least 90 seconds, and
the onion path we are are using for the peer has also been alive for at least
90 seconds, and we have not been waiting for at least 15 seconds for a
response to a request sent to the peer, nor for at least 10 seconds for a
response to a request sent via the path. The timeout of at most 120 seconds
means a \texttt{ping\_id} received in the last packet will not have had time
to expire (300 second minimum timeout) before it is resent 120 seconds later.

For friends this is slightly different.  It is important to start searching for
friends after we are fully announced.  Assuming a perfect network, we would
only need to do a search for friend public keys only when first starting the
instance (or going offline and back online) as peers starting up after us would
be able to find us immediately just by searching for us.  If we start searching
for friends after we are announced we prevent a scenario where 2 friends start
their clients at the same time but are unable to find each other right away
because they start searching for each other while they have not announced
themselves.

For this reason, after the peer is announced successfully, for 17 seconds
announce packets are sent aggressively every 3 seconds to each known close peer
(in the list of 8 peers) to search aggressively for peers that know the peer we
are searching for.

After this, toxcore sends requests once per 15 seconds initially, then
uses linear backoff to increase the interval.  In detail, the interval used
when searching for a given friend is at least 15 and at most 2400 seconds, and
within these bounds is calculated as one quarter of the time since we began
searching for the friend, or since the friend was last seen. For this purpose,
a friend is considered to be seen when some peer reports that the friend is
announced, or we receive a DHT Public Key packet from the friend, or we obtain
a new DHT key for them from a group, or a friend connection for the friend
goes offline.

There are other ways this could be done and which would still work but, if
making your own implementation, keep in mind that these are likely not the most
optimized way to do things.

If we find peers (more than 1) that know a friend we will send them an onion
data packet with our DHT public key, up to 2 TCP relays we are connected to and
2 DHT peers close to us to help the friend connect back to us.

Onion data packets are packets sent as the data of data to route packets.

Onion data packets:

\begin{tabular}{l|l}
  Length             & Contents \\
  \hline
  \texttt{32}        & Long term public key of sender \\
  variable           & Payload \\
\end{tabular}

The payload is encrypted with long term private key of the sender, the long
term public key of the receiver and the nonce used in the data to route request
packet used to send this onion data packet (shaves off 24 bytes).

DHT public key packet:

\begin{tabular}{l|l}
  Length             & Contents \\
  \hline
  \texttt{1}         & \texttt{uint8\_t} (0x9c) \\
  \texttt{8}         & \texttt{uint64\_t} \texttt{no\_replay} \\
  \texttt{32}        & Our DHT public key \\
  \texttt{[39, 204]} & Maximum of 4 nodes in packed format \\
\end{tabular}

The packet will only be accepted if the \texttt{no\_replay} number is greater
than the \texttt{no\_replay} number in the last packet received.

The nodes sent in the packet comprise 2 TCP relays to which we are
connected (or fewer if there are not 2 available) and a number of DHT nodes
from our Close List, with the total number of nodes sent being at most 4. The
nodes chosen from the Close List are those closest in DHT distance to us. This
allows the friend to find us more easily in the DHT, or to connect to us via a
TCP relay.

Why another round of encryption? We have to prove to the receiver that we own
the long term public key we say we own when sending them our DHT public key.
Friend requests are also sent using onion data packets but their exact format
is explained in Messenger.

The \texttt{no\_replay} number is protection if someone tries to replay an older
packet and should be set to an always increasing number.  It is 8 bytes so you
should set a high resolution monotonic time as the value.

We send this packet every 30 seconds if there is more than one peer (in the 8)
that says they our friend is announced on them.  This packet can also be sent
through the DHT module as a DHT request packet (see DHT) if we know the DHT
public key of the friend and are looking for them in the DHT but have not
connected to them yet.  30 second is a reasonable timeout to not flood the
network with too many packets while making sure the other will eventually
receive the packet.  Since packets are sent through every peer that knows the
friend, resending it right away without waiting has a high likelihood of
failure as the chances of packet loss happening to all (up to to 8) packets
sent is low.

When sent as a DHT request packet (this is the data sent in the DHT request
packet):

\begin{tabular}{l|l}
  Length             & Contents \\
  \hline
  \texttt{1}         & \texttt{uint8\_t} (0x9c) \\
  \texttt{32}        & Long term public key of sender \\
  \texttt{24}        & Nonce \\
  variable           & Encrypted payload \\
\end{tabular}

The payload is encrypted with long term private key of sender, the long term
public key of receiver and the nonce, and contains the DHT public key packet.

When sent as a DHT request packet the DHT public key packet is (before being
sent as the data of a DHT request packet) encrypted with the long term keys of
both the sender and receiver and put in that format.  This is done for the same
reason as the double encryption of the onion data packet.

Toxcore tries to resend this packet through the DHT every 20 seconds.  20
seconds is a reasonable resend rate which isn't too aggressive.

Toxcore has a DHT request packet handler that passes received DHT public key
packets from the DHT module to this module.

If we receive a DHT public key packet, we will first check if the DHT packet is
from a friend, if it is not from a friend, it will be discarded.  The
\texttt{no\_replay} will then be checked to see if it is good and no packet with
a lower one was received during the session.  The DHT key, the TCP nodes in the
packed nodes and the DHT nodes in the packed nodes will be passed to their
relevant modules.  The fact that we have the DHT public key of a friend means
this module has achieved its goal.

If a friend is online and connected to us, the onion will stop all of its
actions for that friend.  If the peer goes offline it will restart searching
for the friend as if toxcore was just started.

If toxcore goes offline (no onion traffic for 75 seconds) toxcore will
aggressively reannounce itself and search for friends as if it was just
started.