Partitioned friend-request transport from the onion transport.

6 files changed, 127 insertions, 22 deletions

diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 51ee0a4d..56c4b8e6 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -85,7 +85,7 @@ import Control.TriadCommittee
 import Network.BitTorrent.DHT.Token           as Token
 import GHC.TypeLits
 
-import Crypto.Tox hiding (Assym)
+import Crypto.Tox
 import Network.Tox.Transport
 import Network.Tox.NodeId
 import qualified Network.Tox.DHT.Transport as DHT
@@ -202,6 +202,7 @@ newClient drg net classify selfAddr handlers modifytbl modifynet = do
 data Tox = Tox
     { toxDHT :: DHT.Client
     , toxOnion :: Onion.Client RouteId
+    , toxToRoute :: Transport String Onion.Rendezvous (Assym (Encrypted Onion.DataToRoute))
     , toxCrypto :: Transport String SockAddr NetCrypto
     , toxRouting :: DHT.Routing
     , toxTokens :: TVar SessionTokens
@@ -249,7 +250,7 @@ newTox keydb addr = do
 
     routing <- DHT.newRouting addr crypto updateIP updateIP
     orouter <- newOnionRouter
-    (dhtcrypt,onioncrypt,cryptonet) <- toxTransport crypto orouter lookupClose udp
+    (dhtcrypt,onioncrypt,dtacrypt,cryptonet) <- toxTransport crypto orouter lookupClose udp
     let dhtnet0 = layerTransport (DHT.decrypt crypto) (DHT.encrypt crypto) dhtcrypt
     dhtclient <- newClient drg dhtnet0 DHT.classify (myAddr routing) (DHT.handlers routing) id
                     $ \client net -> onInbound (DHT.updateRouting client routing orouter) net
@@ -270,6 +271,7 @@ newTox keydb addr = do
     return Tox
         { toxDHT = dhtclient
         , toxOnion = onionclient
+        , toxToRoute = dtacrypt
         , toxCrypto = cryptonet
         , toxRouting = routing
         , toxTokens = toks
@@ -283,6 +285,7 @@ onionTimeout Tox { toxOnionRoutes = or } (DHT.TransactionId n8 _) od = lookupTim
 forkTox :: Tox -> IO (IO ())
 forkTox tox = do
     _ <- forkListener "toxCrypto" (toxCrypto tox)
+    _ <- forkListener "toxToRoute" (toxToRoute tox)
     _ <- forkListener "toxOnion" (clientNet $ toxOnion tox)
     forkListener "toxDHT" (clientNet $ toxDHT tox)
 
diff --git a/src/Network/Tox/DHT/Transport.hs b/src/Network/Tox/DHT/Transport.hs
index 187e23f2..16af0e3f 100644
--- a/src/Network/Tox/DHT/Transport.hs
+++ b/src/Network/Tox/DHT/Transport.hs
@@ -16,7 +16,8 @@ module Network.Tox.DHT.Transport
     , Pong(..)
     , GetNodes(..)
     , SendNodes(..)
-    , DHTPublicKey
+    , DHTPublicKey(..)
+    , FriendRequest(..)
     , CookieRequest
     , Cookie
     , DHTRequest
@@ -35,10 +36,12 @@ import Network.QueryResponse
 import Control.Arrow
 import Control.Monad
 import Data.Bool
-import qualified Data.ByteString as B
-         ;import Data.ByteString (ByteString)
+import qualified Data.ByteString  as B
+         ;import Data.ByteString  (ByteString)
+import Data.Functor.Contravariant
+import Data.Monoid
+import Data.Serialize             as S
 import Data.Tuple
-import Data.Serialize            as S
 import Data.Word
 import Network.Socket
 
@@ -203,6 +206,13 @@ data DHTPublicKey = DHTPublicKey
     , dhtpkNodes :: SendNodes -- other reachable nodes
     }
 
+-- int8_t (0x20 sent over onion, 0x12 for sent over net_crypto)
+-- [uint32_t nospam][Message (UTF8) 1 to ONION_CLIENT_MAX_DATA_SIZE bytes]
+data FriendRequest = FriendRequest
+    { friendNoSpam      :: Word32
+    , friendRequestText :: ByteString -- UTF8
+    }
+
 -- When sent as a DHT request packet (this is the data sent in the DHT request
 -- packet):
 --
@@ -231,6 +241,13 @@ instance Sized DHTPublicKey where
                                                     ConstSize nodes -> nodes
                                                     VarSize sznodes -> sznodes nodes
 
+instance Sized Word32 where size = ConstSize 4
+
+-- FIXME: Inconsitently, this type does not include the 0x20 or 0x12 tag byte
+-- where the DHTPublicKey type does include its tag.
+instance Sized FriendRequest where
+    size = contramap friendNoSpam size <> contramap friendRequestText (VarSize B.length)
+
 instance Serialize DHTPublicKey where
     -- TODO: This should agree with Sized instance.
     get = DHTPublicKey <$> get <*> getPublicKey <*> get
@@ -239,6 +256,10 @@ instance Serialize DHTPublicKey where
         putPublicKey key
         put nodes
 
+instance Serialize FriendRequest where
+    get = FriendRequest <$> get <*> (remaining >>= getBytes)
+    put (FriendRequest nospam txt) = put nospam >> putByteString txt
+
 newtype GetNodes = GetNodes NodeId
     deriving (Eq,Ord,Show,Read,S.Serialize)
 
diff --git a/src/Network/Tox/NodeId.hs b/src/Network/Tox/NodeId.hs
index bba56e27..20dc1854 100644
--- a/src/Network/Tox/NodeId.hs
+++ b/src/Network/Tox/NodeId.hs
@@ -213,8 +213,10 @@ instance FromJSON NodeInfo where
         ip <- maybe empty (return . IPv6) (ip6str >>= readMaybe)
               <|> maybe empty (return . IPv4) (ip4str >>= readMaybe)
         let (bs,_) = Base16.decode (C8.pack nidstr)
-        guard (B.length bs == 32)
-        return $ NodeInfo (bs2id bs) ip (fromIntegral (portnum :: Word16))
+            enid   = Base64.decode (C8.pack $ 'A' : map (nmtoken64 False) nidstr)
+        idbs <- (guard (B.length bs == 32) >> return bs)
+                <|> either fail (return . B.drop 1) enid
+        return $ NodeInfo (bs2id idbs) ip (fromIntegral (portnum :: Word16))
 
 getIP :: Word8 -> S.Get IP
 getIP 0x02 = IPv4 <$> S.get
diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index 167df336..439de709 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -130,7 +130,7 @@ toOnionDestination :: AnnouncedRoute -> OnionDestination r
 toOnionDestination (AnnouncedRoute ni rpath) = OnionToOwner ni rpath
 
 data AnnouncedKeys = AnnouncedKeys
-    { keyByAge :: !(PSQ NodeId (Down POSIXTime)) -- timeout of 300 seconds
+    { keyByAge :: !(PSQ NodeId (Down POSIXTime)) -- TODO: timeout of 300 seconds
     , keyAssoc :: !(MinMaxPSQ' NodeId NodeDistance (Int,AnnouncedRoute))
     }
 
@@ -160,15 +160,6 @@ handlers net routing toks keydb AnnounceType
 handlers net _ _ keydb _ = Just $ NoReply Right $ dataToRouteH keydb net
 
 
-data Rendezvous = Rendezvous
-    { rendezvousKey :: PublicKey
-    , rendezvousNode :: NodeInfo
-    }
- deriving Eq
-
-instance Show Rendezvous where
-    show (Rendezvous k ni) = concat [show $ key2id k, ":", show ni]
-
 toxidSearch :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
                -> Client r
                -> Search NodeId (IP, PortNumber) (Maybe Nonce32) NodeInfo Rendezvous
@@ -211,6 +202,25 @@ unwrapAnnounceResponse ni (AnnounceResponse is_stored (SendNodes ns))
         SendBackKey k    -> (ns, [Rendezvous k ni], Nothing)
         Acknowledged n32 -> (ns, [],  Just n32)
 
+-- TODO Announce key to announce peers.
+--
+--   Announce Peers are only put in the 8 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.
+--
+--   ...
+--
+--   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.
+
+-- TODO
+-- If toxcore goes offline (no onion traffic for 20 seconds) toxcore will
+-- aggressively reannounce itself and search for friends as if it was just
+-- started.
+
+
 announce :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
             -> Client r
             -> NodeId
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index 989b06fd..3e3596a6 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -17,9 +17,12 @@
 module Network.Tox.Onion.Transport
     ( parseOnionAddr
     , encodeOnionAddr
+    , parseDataToRoute
+    , encodeDataToRoute
     , forwardOnions
     , OnionDestination(..)
     , OnionMessage(..)
+    , Rendezvous(..)
     , DataToRoute(..)
     , AnnounceResponse(..)
     , AnnounceRequest(..)
@@ -44,7 +47,7 @@ import Network.QueryResponse
 import Crypto.Tox hiding (encrypt,decrypt)
 import Network.Tox.NodeId
 import qualified Crypto.Tox as ToxCrypto
-import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes(..),nodeInfo,DHTPublicKey,asymNodeInfo)
+import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes(..),nodeInfo,DHTPublicKey,FriendRequest,asymNodeInfo)
 
 import Debug.Trace
 import Control.Arrow
@@ -561,13 +564,39 @@ instance Serialize DataToRoute where
     get = DataToRoute <$> getPublicKey <*> get
     put (DataToRoute k dta) = putPublicKey k >> put dta
 
-data OnionData = OnionDHTPublicKey DHTPublicKey -- 0x9c
+data OnionData
+  = -- | type 0x9c
+    --
+    -- 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.
+    --
+    -- 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.
+    OnionDHTPublicKey DHTPublicKey
+  | -- | type 0x20
+    --
+    --
+    OnionFriendRequest FriendRequest -- 0x20
 
 instance Sized OnionData where
-    size = VarSize $ \(OnionDHTPublicKey dhtpk) -> case size of
+    size = VarSize $ \case
+        OnionDHTPublicKey dhtpk -> case size of
             ConstSize n -> n -- Override because OnionData probably
                              -- should be treated as variable sized.
             VarSize f   -> f dhtpk
+        -- FIXME: inconsitantly, we have to add in the tag byte for this case.
+        OnionFriendRequest req -> 1 + case size of
+            ConstSize n -> n
+            VarSize f   -> f req
 
 encrypt :: TransportCrypto -> OnionMessage Identity -> OnionDestination r -> (OnionMessage Encrypted, OnionDestination r)
 encrypt crypto msg rpath = ( transcode ( (. (runIdentity . either id assymData))
@@ -625,12 +654,14 @@ sequenceMessage (OnionAnnounce a)        = fmap OnionAnnounce $ sequenceA $ fmap
 sequenceMessage (OnionAnnounceResponse n8 n24 dta) = OnionAnnounceResponse n8 n24 <$> uncomposed dta
 sequenceMessage (OnionToRoute pub a)     = pure $ OnionToRoute pub a
 sequenceMessage (OnionToRouteResponse a) = pure $ OnionToRouteResponse a
+-- sequenceMessage (OnionToRouteResponse a) = fmap OnionToRouteResponse $ sequenceA $ fmap uncomposed a
 
 transcode :: forall f g. (forall a. Serialize a => Nonce24 -> Either (f a) (Assym (f a)) -> g a) -> OnionMessage f -> OnionMessage g
 transcode f (OnionAnnounce a)        = OnionAnnounce $ a { assymData = f (assymNonce a) (Right a) }
 transcode f (OnionAnnounceResponse n8 n24 dta) = OnionAnnounceResponse n8 n24 $ f n24 $ Left dta
 transcode f (OnionToRoute pub a)     = OnionToRoute pub     a
 transcode f (OnionToRouteResponse a) = OnionToRouteResponse a
+-- transcode f (OnionToRouteResponse a) = OnionToRouteResponse $ a { assymData = f (assymNonce a) (Right a) }
 
 
 data OnionRoute = OnionRoute
@@ -673,3 +704,38 @@ wrapOnion :: Serialize (Forwarding n msg) =>
            -> Forwarding (S n) msg
 wrapOnion skey nonce destkey saddr fwd =
     Forwarding (toPublic skey) $ encryptMessage skey destkey nonce (Addressed saddr fwd)
+
+
+-- TODO
+-- Two types of packets may be sent to Rendezvous via OnionToRoute requests.
+--
+--  (1) DHT public key packet (0x9c)
+--
+--  (2) Friend request
+data Rendezvous = Rendezvous
+    { rendezvousKey :: PublicKey
+    , rendezvousNode :: NodeInfo
+    }
+ deriving Eq
+
+instance Show Rendezvous where
+    show (Rendezvous k ni) = concat [show $ key2id k, ":", show ni]
+
+
+
+parseDataToRoute
+    :: TransportCrypto
+         -> (OnionMessage Encrypted,OnionDestination r)
+         -> Either (Assym (Encrypted DataToRoute),Rendezvous) (OnionMessage Encrypted, OnionDestination r)
+parseDataToRoute crypto (OnionToRouteResponse dta, od)
+                            = Left ( dta
+                                   , Rendezvous (onionAliasPublic crypto) $ onionNodeInfo od )
+parseDataToRoute _      msg = Right msg
+
+encodeDataToRoute :: TransportCrypto
+                     -> (Assym (Encrypted DataToRoute),Rendezvous)
+                     -> Maybe (OnionMessage Encrypted,OnionDestination r)
+encodeDataToRoute crypto (dta, Rendezvous pub ni)
+    = Just ( OnionToRoute pub -- Public key of destination node
+                          dta
+           , OnionDestination ni Nothing )
diff --git a/src/Network/Tox/Transport.hs b/src/Network/Tox/Transport.hs
index d4e1a754..d915561f 100644
--- a/src/Network/Tox/Transport.hs
+++ b/src/Network/Tox/Transport.hs
@@ -24,15 +24,18 @@ toxTransport ::
           -> UDPTransport
           -> IO ( Transport String NodeInfo (DHTMessage Encrypted8)
                 , Transport String (OnionDestination RouteId) (OnionMessage Encrypted)
+                , Transport String Rendezvous (Assym (Encrypted DataToRoute))
                 , Transport String SockAddr NetCrypto )
 toxTransport crypto orouter closeLookup udp = do
     (dht,udp1) <- partitionTransport parseDHTAddr (Just . encodeDHTAddr) $ forwardOnions crypto udp
-    (onion,udp2) <- partitionTransportM (parseOnionAddr $ lookupSender orouter)
+    (onion1,udp2) <- partitionTransportM (parseOnionAddr $ lookupSender orouter)
                                         (encodeOnionAddr $ lookupRoute orouter)
                                         udp1
+    (dta,onion) <- partitionTransport (parseDataToRoute crypto) (encodeDataToRoute crypto) onion1
     let netcrypto = layerTransport parseNetCrypto encodeNetCrypto udp2
     return ( forwardDHTRequests crypto closeLookup dht
            , onion
+           , dta
            , netcrypto
            )