Use alias for onion-routed queries for true anonymization.

4 files changed, 32 insertions, 10 deletions

diff --git a/src/Crypto/Tox.hs b/src/Crypto/Tox.hs
index 0df06054..6660fc13 100644
--- a/src/Crypto/Tox.hs
+++ b/src/Crypto/Tox.hs
@@ -93,7 +93,7 @@ instance Data Auth where
     -- Well, this is a little wonky... XXX
     gunfold k z c = k (z (Auth . Poly1305.Auth . (BA.convert :: ByteString -> Bytes)))
     toConstr _ = con_Auth
-    dataTypeOf _ = mkDataType "ToxCrypto" [con_Auth]
+    dataTypeOf _ = mkDataType "Crypto.Tox" [con_Auth]
 con_Auth :: Constr
 con_Auth = mkConstr (dataTypeOf (Auth (error "con_Auth"))) "Auth" [] Prefix
 instance Serialize Auth where
@@ -340,6 +340,8 @@ newtype SymmetricKey = SymmetricKey ByteString
 data TransportCrypto = TransportCrypto
     { transportSecret :: SecretKey
     , transportPublic :: PublicKey
+    , onionAliasSecret :: SecretKey
+    , onionAliasPublic :: PublicKey
     , transportSymmetric :: STM SymmetricKey
     , transportNewNonce :: STM Nonce24
     }
diff --git a/src/Network/QueryResponse.hs b/src/Network/QueryResponse.hs
index 70d981e2..27c89674 100644
--- a/src/Network/QueryResponse.hs
+++ b/src/Network/QueryResponse.hs
@@ -187,6 +187,9 @@ data Client err meth tid addr x = forall tbl. Client
       -- | An action yielding this client\'s own address.  It is invoked once
       -- on each outbound and inbound packet.  It is valid for this to always
       -- return the same value.
+      --
+      -- The argument, if supplied, is the remote address for the transaction.
+      -- This can be used to maintain consistent aliases for specific peers.
     , clientAddress :: Maybe addr -> IO addr
       -- | Transform a query /tid/ value to an appropriate response /tid/
       -- value.  Normally, this would be the identity transformation, but if
diff --git a/src/Network/Tox.hs b/src/Network/Tox.hs
index 3860d309..51ee0a4d 100644
--- a/src/Network/Tox.hs
+++ b/src/Network/Tox.hs
@@ -100,7 +100,9 @@ import Data.Word64Map (fitsInInt)
 newCrypto :: IO TransportCrypto
 newCrypto = do
     secret <- generateSecretKey
+    alias <- generateSecretKey
     let pubkey = toPublic secret
+        aliaspub = toPublic alias
     (symkey, drg) <- do
         drg0 <- getSystemDRG
         return $ randomBytesGenerate 32 drg0 :: IO (ByteString, SystemDRG)
@@ -111,6 +113,8 @@ newCrypto = do
     return TransportCrypto
         { transportSecret = secret
         , transportPublic = pubkey
+        , onionAliasSecret = alias
+        , onionAliasPublic = aliaspub
         , transportSymmetric = return $ SymmetricKey symkey
         , transportNewNonce = do
             drg1 <- readTVar noncevar
@@ -205,6 +209,7 @@ data Tox = Tox
     , toxOnionRoutes :: OnionRouter
     }
 
+isLocalHost :: SockAddr -> Bool
 isLocalHost (SockAddrInet _ host32) = (fromBE32 host32 == 0x7f000001)
 isLocalHost _                       = False
 
@@ -227,6 +232,14 @@ newKeysDatabase :: IO (TVar Onion.AnnouncedKeys)
 newKeysDatabase =
     atomically $ newTVar $ Onion.AnnouncedKeys PSQ.empty MinMaxPSQ.empty
 
+
+getOnionAlias :: TransportCrypto -> STM NodeInfo -> Maybe (Onion.OnionDestination r) -> IO (Onion.OnionDestination r)
+getOnionAlias crypto dhtself remoteNode = atomically $ do
+    ni <- dhtself
+    let alias = ni { nodeId = key2id (onionAliasPublic crypto) }
+    return $ Onion.OnionDestination alias Nothing
+
+
 newTox :: TVar Onion.AnnouncedKeys -> SockAddr -> IO Tox
 newTox keydb addr = do
     udp <- addVerbosity <$> udpTransport addr
@@ -249,10 +262,7 @@ newTox keydb addr = do
     oniondrg <- drgNew
     let onionnet = layerTransport (Onion.decrypt crypto) (Onion.encrypt crypto) onioncrypt
     onionclient <- newClient oniondrg onionnet Onion.classify
-                    (const $ atomically
-                           $ flip Onion.OnionDestination Nothing
-                           . R.thisNode
-                           <$> readTVar (DHT.routing4 routing))
+                    (getOnionAlias crypto $ R.thisNode <$> readTVar (DHT.routing4 routing))
                     (Onion.handlers onionnet routing toks keydb)
                     (hookQueries orouter DHT.transactionKey)
                     (const id)
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index b5ac748a..eabd9473 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -457,7 +457,7 @@ peelOnion :: Serialize (Addressed (Forwarding n t))
               -> Forwarding (S n) t
               -> Either String (Addressed (Forwarding n t))
 peelOnion crypto nonce (Forwarding k fwd) =
-    fmap runIdentity $ uncomposed $ decryptMessage crypto nonce (Right $ Assym k nonce fwd)
+    fmap runIdentity $ uncomposed $ decryptMessage (dhtKey crypto) nonce (Right $ Assym k nonce fwd)
 
 handleOnionResponse :: (KnownPeanoNat n, Sized (ReturnPath n), Serialize (ReturnPath n)) => proxy (S n) -> TransportCrypto -> SockAddr -> UDPTransport -> IO a -> OnionResponse (S n) -> IO a
 handleOnionResponse proxy crypto saddr udp kont (OnionResponse path msg) = do
@@ -576,7 +576,7 @@ encrypt crypto msg rpath = ( transcode ( (. (runIdentity . either id assymData))
                                        msg
                            , rpath)
     where
-        skey = transportSecret crypto
+        skey = fst $ aliasKey crypto rpath
 
         -- The OnionToMe case shouldn't happen, but we'll use our own public
         -- key in this situation.
@@ -592,14 +592,21 @@ encryptMessage skey destKey n a = ToxCrypto.encrypt secret plain
 
 decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionDestination r -> Either String (OnionMessage Identity, OnionDestination r)
 decrypt crypto msg addr = do
-    msg <- sequenceMessage $ transcode (\n -> decryptMessage crypto n . left (senderkey addr)) msg
+    msg <- sequenceMessage $ transcode (\n -> decryptMessage (aliasKey crypto addr) n . left (senderkey addr)) msg
     Right (msg, addr)
 
 senderkey :: OnionDestination r -> t -> (Maybe PublicKey, t)
 senderkey addr e = (onionKey addr, e)
 
+aliasKey :: TransportCrypto -> OnionDestination r -> (SecretKey,PublicKey)
+aliasKey crypto (OnionToOwner {})     = (transportSecret &&& transportPublic) crypto
+aliasKey crypto (OnionDestination {}) = (onionAliasSecret &&& onionAliasPublic) crypto
+
+dhtKey :: TransportCrypto -> (SecretKey,PublicKey)
+dhtKey crypto = (transportSecret &&& transportPublic) crypto
+
 decryptMessage :: Serialize x =>
-                  TransportCrypto
+                  (SecretKey,PublicKey)
                   -> Nonce24
                   -> Either (Maybe PublicKey, Encrypted x)
                             (Assym (Encrypted x))
@@ -609,7 +616,7 @@ decryptMessage crypto n arg
     | otherwise              = Composed $ Left "decryptMessage: Unknown sender"
  where
     msecret  = do sender <- mkey
-                  Just $ computeSharedSecret (transportSecret crypto) sender n
+                  Just $ computeSharedSecret (fst crypto) sender n
     (mkey,e) = either id (Just . senderKey &&& assymData) arg
     plain    = Composed . fmap Identity . (>>= decodePlain)