3 files changed, 89 insertions, 15 deletions

diff --git a/src/Network/Tox/DHT/Transport.hs b/src/Network/Tox/DHT/Transport.hs
index 0787c2c1..47505a21 100644
--- a/src/Network/Tox/DHT/Transport.hs
+++ b/src/Network/Tox/DHT/Transport.hs
@@ -210,6 +210,8 @@ data DHTPublicKey = DHTPublicKey
     , dhtpk      :: PublicKey -- dht public key
     , dhtpkNodes :: SendNodes -- other reachable nodes
     }
+ deriving (Eq, Show)
+
 
 -- 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]
@@ -217,6 +219,7 @@ data FriendRequest = FriendRequest
     { friendNoSpam      :: Word32
     , friendRequestText :: ByteString -- UTF8
     }
+ deriving (Eq, Show)
 
 -- When sent as a DHT request packet (this is the data sent in the DHT request
 -- packet):
diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index 3eec0390..76908df8 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -117,13 +117,16 @@ dataToRouteH ::
           -> IO ()
 dataToRouteH keydb udp _ (OnionToRoute pub asymm) = do
     let k = key2id pub
+    hPutStrLn stderr $ "dataToRouteH "++ show k
     mb <- atomically $ do
         ks <- readTVar keydb
         forM (MinMaxPSQ.lookup' k (keyAssoc ks)) $ \(p,(cnt,rpath)) -> do
             writeTVar keydb $ ks { keyAssoc = MinMaxPSQ.insert' k (cnt + 1, rpath) p (keyAssoc ks) }
             return rpath
+    hPutStrLn stderr $ "dataToRouteH "++ show (fmap (const ()) mb)
     forM_ mb $ \rpath -> do
         -- forward
+        hPutStrLn stderr $ "dataToRouteH sendMessage"
         sendMessage udp (toOnionDestination rpath) $ OnionToRouteResponse asymm
         hPutStrLn stderr $ "Forwarding data-to-route -->"++show k
 
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index 6635fad1..85cf095d 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -44,6 +44,8 @@ module Network.Tox.Onion.Transport
     , onionKey
     , onionAliasSelector
     , selectAlias
+    , RouteId(..)
+    , routeId
     ) where
 
 import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort)
@@ -51,7 +53,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,FriendRequest,asymNodeInfo)
+import Network.Tox.DHT.Transport (NodeInfo(..),NodeId(..),SendNodes(..),nodeInfo,DHTPublicKey(..),FriendRequest,asymNodeInfo)
 
 import Control.Applicative
 import Control.Arrow
@@ -76,6 +78,7 @@ import GHC.TypeLits
 import Network.Socket
 import System.IO
 import qualified Text.ParserCombinators.ReadP as RP
+import Data.Hashable
 
 type HandleLo a = Maybe (Either String (ByteString, SockAddr)) -> IO a
 
@@ -200,15 +203,44 @@ putOnionMsg (OnionToRoute pubkey          a) = putOnionAsymm 0x85 (putPublicKey
 putOnionMsg (OnionAnnounceResponse n8 n24 x) = put (0x84 :: Word8) >> put n8 >> put n24 >> put x
 putOnionMsg (OnionToRouteResponse         a) = putOnionAsymm 0x86 (return ()) a
 
-encodeOnionAddr :: (NodeInfo -> r -> IO (Maybe OnionRoute))
-                   -> (OnionMessage Encrypted,OnionDestination r)
+newtype RouteId = RouteId Int
+ deriving Show
+
+
+-- We used to derive the RouteId from the Nonce8 associated with the query.
+-- This is problematic because a nonce generated by toxcore will not validate
+-- if it is received via a different route than it was issued.  This is
+-- described by the Tox spec:
+--
+--   Toxcore generates `ping_id`s by taking a 32 byte sha hash of the current
+--   time, some secret bytes generated when the instance is created, the
+--   current time divided by a 20 second timeout, the public key of the
+--   requester and the source ip/port that the packet was received from. Since
+--   the ip/port that the packet was received from is in the `ping_id`, the
+--   announce packets being sent with a ping id must be sent using the same
+--   path as the packet that we received the `ping_id` from or announcing will
+--   fail.
+--
+-- The original idea was:
+--
+-- > routeId :: Nonce8 -> RouteId
+-- > routeId (Nonce8 w8) = RouteId $ mod (fromIntegral w8) 12
+--
+-- Instead, we'll just hash the destination node id.
+routeId :: NodeId -> RouteId
+routeId nid = RouteId $ mod (hash nid) 12
+
+
+encodeOnionAddr :: (NodeInfo -> RouteId -> IO (Maybe OnionRoute))
+                   -> (OnionMessage Encrypted,OnionDestination RouteId)
                    -> IO (Maybe (ByteString, SockAddr))
 encodeOnionAddr _ (msg,OnionToOwner ni p) =
     return $ Just ( runPut $ putResponse (OnionResponse p msg)
                   , nodeAddr ni )
-encodeOnionAddr _ (msg,OnionDestination _ _ Nothing) = do
-    hPutStrLn stderr $ "ONION encode missing routeid"
-    return Nothing
+encodeOnionAddr getRoute (msg,OnionDestination x ni Nothing) = do
+    encodeOnionAddr getRoute (msg,OnionDestination x ni (Just $ routeId $ nodeId ni) )
+    -- hPutStrLn stderr $ "ONION encode missing routeid"
+    -- return Nothing
 encodeOnionAddr getRoute (msg,OnionDestination _ ni (Just rid)) = do
     let go route = do
             return ( runPut $ putRequest $ wrapForRoute msg ni route
@@ -601,6 +633,7 @@ data OnionData
     --
     --
     OnionFriendRequest FriendRequest -- 0x20
+ deriving (Eq,Show)
 
 instance Sized OnionData where
     size = VarSize $ \case
@@ -790,26 +823,46 @@ parseDataToRoute
     :: TransportCrypto
          -> (OnionMessage Encrypted,OnionDestination r)
          -> IO (Either ((PublicKey,OnionData),AnnouncedRendezvous) (OnionMessage Encrypted, OnionDestination r))
-parseDataToRoute crypto (OnionToRouteResponse dta, od) =
-    return $ either (const $ Right (OnionToRouteResponse dta,od)) Left $ do
-        -- XXX: Do something with decryption failure?
-        dtr <- fmap runIdentity
+parseDataToRoute crypto (OnionToRouteResponse dta, od) = do
+  ks <- atomically $ readTVar $ userKeys crypto
+
+  let eOuter = do
+        fmap runIdentity
                  $ uncomposed
                  $ decryptMessage (rendezvousSecret crypto,rendezvousPublic crypto)
                                   (asymmNonce dta)
-                                  (Right dta)
-        let (sk,pk) = case onionAliasSelector od of
-                SearchingAlias        -> (onionAliasSecret &&& onionAliasPublic) crypto
-                AnnouncingAlias sk pk -> (sk,pk)
+                                  (Right dta) -- using Asymm{senderKey} as remote key
+
+      -- TODO: We don't currently have a way to look up which user key we
+      -- announced using along this onion route.  Therefore, for now, we will
+      -- try all our user keys to see if any can decrypt the packet.
+      eInners = flip map ks $ \(sk,pk) -> do
+        dtr <- eOuter
         omsg <- fmap runIdentity
                 $ uncomposed
                 $ decryptMessage (sk,pk)
                                  (asymmNonce dta)
                                  (Left (dataFromKey dtr, dataToRoute dtr))
+        return (pk,dtr,omsg)
+
+      eInner = foldr1 (<|>) eInners
+
+      e = do
+        (pk,dtr,omsg) <- eInner
         return ( (pk, omsg)
                , AnnouncedRendezvous
                     (dataFromKey dtr)
                     $ Rendezvous (rendezvousPublic crypto) $ onionNodeInfo od )
+      r = either (const $ Right (OnionToRouteResponse dta,od)) Left e
+  -- parseDataToRoute OnionToRouteResponse decipherAndAuth: auth fail
+  hPutStrLn stderr $ unlines
+        [ "parseDataToRoute " ++ either id (const "Right") e
+        , "       crypto inner.me =" ++ either id (\(pk,_,_) -> show $ key2id pk) eInner
+        , "              inner.you=" ++ either id (show . key2id . dataFromKey) eOuter
+        , "              outer.me =" ++ show (key2id $ rendezvousPublic crypto)
+        , "              outer.you=" ++ show (key2id $ senderKey dta)
+        ]
+  return r
 parseDataToRoute _ msg = return $ Right msg
 
 encodeDataToRoute :: TransportCrypto
@@ -825,7 +878,22 @@ encodeDataToRoute crypto ((me,omsg), AnnouncedRendezvous toxid (Rendezvous pub n
                             , dataToRoute = encryptMessage sk toxid nonce omsg
                             }
     let dta = encryptMessage (onionAliasSecret crypto) pub nonce plain
-    return $ Just ( OnionToRoute pub -- Public key of destination node
+    hPutStrLn stderr $ unlines
+        [ "encodeDataToRoute    me=" ++ show (key2id me)
+        , "                  dhtpk=" ++ case omsg of
+                                        OnionDHTPublicKey dmsg -> show (key2id $ dhtpk dmsg)
+                                        OnionFriendRequest fr  -> "friend request"
+        , "                     ns=" ++ case omsg of
+                                        OnionDHTPublicKey dmsg -> show (dhtpkNodes dmsg)
+                                        OnionFriendRequest fr  -> "friend request"
+        , "       crypto inner.me =" ++ show (key2id pk)
+        , "              inner.you=" ++ show (key2id toxid)
+        , "              outer.me =" ++ show (key2id $ onionAliasPublic crypto)
+        , "              outer.you=" ++ show (key2id pub)
+        , "                  " ++ show (AnnouncedRendezvous toxid (Rendezvous pub ni))
+        , "                  " ++ show dta
+        ]
+    return $ Just ( OnionToRoute toxid -- Public key of destination node
                                  Asymm { senderKey  = onionAliasPublic crypto
                                        , asymmNonce = nonce
                                        , asymmData  = dta