From 4b7f8e625d6cab8ae25074fc3339a5403ec5fb36 Mon Sep 17 00:00:00 2001 From: joe Date: Sat, 14 Oct 2017 16:34:24 -0400 Subject: Partitioned friend-request transport from the onion transport. --- src/Network/Tox.hs | 7 ++-- src/Network/Tox/DHT/Transport.hs | 29 ++++++++++++--- src/Network/Tox/NodeId.hs | 6 ++-- src/Network/Tox/Onion/Handlers.hs | 30 ++++++++++------ src/Network/Tox/Onion/Transport.hs | 72 ++++++++++++++++++++++++++++++++++++-- src/Network/Tox/Transport.hs | 5 ++- 6 files changed, 127 insertions(+), 22 deletions(-) (limited to 'src/Network') 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 ) -- cgit v1.2.3