2 files changed, 59 insertions, 49 deletions

diff --git a/src/Network/Tox/Onion/Handlers.hs b/src/Network/Tox/Onion/Handlers.hs
index 9702cbb8..047b902d 100644
--- a/src/Network/Tox/Onion/Handlers.hs
+++ b/src/Network/Tox/Onion/Handlers.hs
@@ -79,9 +79,15 @@ announceH routing toks keydb oaddr req = do
         let naddr = onionNodeInfo oaddr
         ns <- getNodesH routing naddr (GetNodes (announceSeeking req))
         tm <- getPOSIXTime
+
         let storing = case oaddr of
                         OnionToOwner _ pth -> guard (nodeId naddr == announceSeeking req) >> Just pth
                         _                  -> Nothing
+        hPutStrLn stderr $ unlines [ "announceH: nodeId          = " ++ show (nodeId naddr)
+                                   , "           announceSeeking = " ++ show (announceSeeking req)
+                                   , "           withTok         = " ++ show withTok
+                                   , "           storing         = " ++ maybe "False" (const "True") storing
+                                   ]
         record <- atomically $ do
             forM_ storing $ \retpath -> when withTok $ do
                 let toxpath = AnnouncedRoute naddr{ nodeId = announceKey req } retpath
@@ -186,7 +192,7 @@ announceSerializer getTimeout = MethodSerializer
             { -- The public key is our real long term public key if we want to
               -- announce ourselves, a temporary one if we are searching for
               -- friends.
-              senderKey = fromJust $ onionKey src -- TODO: FIXME: this should be a temporary alias key
+              senderKey = onionKey src
             , assymNonce = n24
             , assymData = Identity (req, n8)
             }
@@ -224,16 +230,15 @@ unwrapAnnounceResponse ni (AnnounceResponse is_stored (SendNodes ns))
 sendOnion :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
             -> Client r
             -> AnnounceRequest
-            -> NodeInfo
+            -> OnionDestination r
             -> (NodeInfo -> AnnounceResponse -> t)
             -> IO (Maybe t)
-sendOnion getTimeout client req ni unwrap =
+sendOnion getTimeout client req oaddr unwrap =
     -- Four tries and then we tap out.
     flip fix 4 $ \loop n -> do
-    let oaddr = OnionDestination ni Nothing
     mb <- QR.sendQuery client (announceSerializer getTimeout) req oaddr
     maybe (if n>0 then loop $! n - 1 else return Nothing)
-          (return . Just . unwrap ni)
+          (return . Just . unwrap (onionNodeInfo oaddr))
           $ join mb
 
 getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
@@ -241,8 +246,9 @@ getRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r
             -> NodeId
             -> NodeInfo
             -> IO (Maybe ([NodeInfo],[Rendezvous],Maybe Nonce32))
-getRendezvous getTimeout client nid ni =
-    sendOnion getTimeout client (AnnounceRequest zeros32 nid zeroID) ni unwrapAnnounceResponse
+getRendezvous getTimeout client nid ni = do
+    let oaddr = OnionDestination SearchingAlias ni Nothing
+    sendOnion getTimeout client (AnnounceRequest zeros32 nid zeroID) oaddr unwrapAnnounceResponse
 
 putRendezvous :: (TransactionId -> OnionDestination r -> STM (OnionDestination r, Int))
                -> TransportCrypto
@@ -255,5 +261,6 @@ putRendezvous getTimeout crypto client pubkey nonce32 ni = do
     let longTermKey   = key2id pubkey
         rkey          = rendezvousPublic crypto
         rendezvousKey = key2id rkey
-    sendOnion getTimeout client (AnnounceRequest nonce32 longTermKey rendezvousKey) ni
+    let oaddr = OnionDestination (AnnouncingAlias longTermKey) ni Nothing
+    sendOnion getTimeout client (AnnounceRequest nonce32 longTermKey rendezvousKey) oaddr
         $ \ni resp -> (Rendezvous rkey ni, resp)
diff --git a/src/Network/Tox/Onion/Transport.hs b/src/Network/Tox/Onion/Transport.hs
index 34ba23f6..e52c8faa 100644
--- a/src/Network/Tox/Onion/Transport.hs
+++ b/src/Network/Tox/Onion/Transport.hs
@@ -20,6 +20,7 @@ module Network.Tox.Onion.Transport
     , parseDataToRoute
     , encodeDataToRoute
     , forwardOnions
+    , AliasSelector(..)
     , OnionDestination(..)
     , OnionMessage(..)
     , Rendezvous(..)
@@ -39,7 +40,7 @@ module Network.Tox.Onion.Transport
     , OnionRoute(..)
     , N3
     , onionKey
-    , onionNodeInfo
+    , onionAliasSelector
     ) where
 
 import Network.Address (fromSockAddr,toSockAddr,setPort,either4or6,sockAddrPort)
@@ -100,17 +101,27 @@ msgNonce (OnionAnnounceResponse _ n24 _) = n24
 msgNonce (OnionToRoute _ a)              = assymNonce a
 msgNonce (OnionToRouteResponse a)        = assymNonce a
 
+data AliasSelector = SearchingAlias | AnnouncingAlias NodeId
+    deriving (Eq,Ord,Show)
+
 data OnionDestination r
-    = OnionToOwner     NodeInfo (ReturnPath N3) -- ^ Somebody else's path to us.
-    | OnionDestination NodeInfo (Maybe r)       -- ^ Our own onion-path.
+    = OnionToOwner
+        { onionNodeInfo   :: NodeInfo
+        , onionReturnPath :: ReturnPath N3 -- ^ Somebody else's path to us.
+        }
+    | OnionDestination
+        { onionAliasSelector' :: AliasSelector
+        , onionNodeInfo       :: NodeInfo
+        , onionRouteSpec      :: Maybe r    -- ^ Our own onion-path.
+        }
     deriving Show
 
-onionNodeInfo :: OnionDestination r -> NodeInfo
-onionNodeInfo (OnionToOwner     ni _) = ni
-onionNodeInfo (OnionDestination ni _) = ni
+onionAliasSelector :: OnionDestination r -> AliasSelector
+onionAliasSelector (OnionToOwner    {}                         ) = SearchingAlias
+onionAliasSelector (OnionDestination{onionAliasSelector' = sel}) = sel
 
-onionKey :: OnionDestination r -> Maybe PublicKey
-onionKey od = Just $ id2key . nodeId $ onionNodeInfo od
+onionKey :: OnionDestination r -> PublicKey
+onionKey od = id2key . nodeId $ onionNodeInfo od
 
 instance Sized (OnionMessage Encrypted) where
     size = VarSize $ \case
@@ -152,7 +163,7 @@ onion bs saddr getf = do (f,(assym,ret3)) <- runGet ((,) <$> getf <*> getOnionRe
                          oaddr <- onionToOwner assym ret3 saddr
                          return (f assym, oaddr)
 
-parseOnionAddr :: (SockAddr -> Nonce8 -> IO (Maybe (NodeInfo,r)))
+parseOnionAddr :: (SockAddr -> Nonce8 -> IO (Maybe (OnionDestination r)))
                   -> (ByteString, SockAddr)
                   -> IO (Either (OnionMessage Encrypted,OnionDestination r)
                                 (ByteString,SockAddr))
@@ -167,11 +178,11 @@ parseOnionAddr lookupSender (msg,saddr)
             Just (Right msg@(OnionAnnounceResponse n8 _ _)) -> do
                 maddr <- lookupSender saddr n8
                 maybe (return right) -- Response unsolicited or too late.
-                      (return . Left . \(ni,r) -> (msg,OnionDestination ni (Just r)))
+                      (return . Left . \od -> (msg,od))
                       maddr
             Just (Right msg@(OnionToRouteResponse asym)) -> do
                 let ni = asymNodeInfo saddr asym
-                return $ Left (msg, OnionDestination ni Nothing)
+                return $ Left (msg, OnionDestination SearchingAlias ni Nothing)
             _ -> return right
 
 getOnionReply :: Word8 -> Maybe (Get (OnionMessage Encrypted))
@@ -191,10 +202,10 @@ encodeOnionAddr :: (NodeInfo -> r -> IO (Maybe OnionRoute))
 encodeOnionAddr _ (msg,OnionToOwner ni p) =
     return $ Just ( runPut $ putResponse (OnionResponse p msg)
                   , nodeAddr ni )
-encodeOnionAddr _        (msg,OnionDestination _  Nothing   ) = do
+encodeOnionAddr _ (msg,OnionDestination _ _ Nothing) = do
     hPutStrLn stderr $ "ONION encode missing routeid"
     return Nothing
-encodeOnionAddr getRoute (msg,OnionDestination ni (Just rid)) = do
+encodeOnionAddr getRoute (msg,OnionDestination _ ni (Just rid)) = do
     let go route = do
             return ( runPut $ putRequest $ wrapForRoute msg ni route
                    , nodeAddr $ routeNodeA route)
@@ -599,26 +610,19 @@ instance Sized OnionData where
             VarSize f   -> f req
 
 
-selectKey :: TransportCrypto -> OnionMessage Identity -> OnionDestination r -> IO (SecretKey, PublicKey)
-selectKey crypto
-          (OnionAnnounce a@Assym { assymData = Identity (AnnounceRequest _ pkey akey, _) })
-          rpath
-    | (akey /= zeroID) = atomically $ do
-                            ks <- filter (\(sk,pk) -> pk == id2key pkey)
-                                    <$> readTVar (userKeys crypto)
-                            maybe (return $ aliasKey crypto rpath)
-                                  return
-                                  (listToMaybe ks)
+selectKey :: TransportCrypto -> OnionMessage f -> OnionDestination r -> IO (SecretKey, PublicKey)
+selectKey crypto _ rpath@(OnionDestination (AnnouncingAlias pkey) _ _)
+    = atomically $ do ks <- filter (\(sk,pk) -> pk == id2key pkey)
+                                <$> readTVar (userKeys crypto)
+                      maybe (return $ aliasKey crypto rpath)
+                            return
+                            (listToMaybe ks)
 selectKey crypto msg rpath = return $ aliasKey crypto rpath
 
 encrypt :: TransportCrypto -> OnionMessage Identity -> OnionDestination r -> IO (OnionMessage Encrypted, OnionDestination r)
 encrypt crypto msg rpath = do
-    (skey,pkey) <- selectKey crypto msg rpath
-    let skey = fst $ aliasKey crypto rpath
-
-        -- The OnionToMe case shouldn't happen, but we'll use our own public
-        -- key in this situation.
-        okey = fromMaybe (transportPublic crypto) $ onionKey rpath
+    (skey,pkey) <- selectKey crypto msg rpath -- source key
+    let okey = onionKey rpath                 -- destination key
     return ( transcode ( (. (runIdentity . either id assymData))
                                          . encryptMessage skey okey)
                                        msg
@@ -632,11 +636,13 @@ encryptMessage skey destKey n a = ToxCrypto.encrypt secret plain
     plain  = encodePlain a
 
 decrypt :: TransportCrypto -> OnionMessage Encrypted -> OnionDestination r -> IO (Either String (OnionMessage Identity, OnionDestination r))
-decrypt crypto msg addr = return $ do
-    msg <- sequenceMessage $ transcode (\n -> decryptMessage (aliasKey crypto addr) n . left (senderkey addr)) msg
+decrypt crypto msg addr = do
+    (skey,pkey) <- selectKey crypto msg addr
+    return $ do
+    msg <- sequenceMessage $ transcode (\n -> decryptMessage (skey,pkey) n . left (senderkey addr)) msg
     Right (msg, addr)
 
-senderkey :: OnionDestination r -> t -> (Maybe PublicKey, t)
+senderkey :: OnionDestination r -> t -> (PublicKey, t)
 senderkey addr e = (onionKey addr, e)
 
 aliasKey :: TransportCrypto -> OnionDestination r -> (SecretKey,PublicKey)
@@ -649,17 +655,14 @@ dhtKey crypto = (transportSecret &&& transportPublic) crypto
 decryptMessage :: Serialize x =>
                   (SecretKey,PublicKey)
                   -> Nonce24
-                  -> Either (Maybe PublicKey, Encrypted x)
+                  -> Either (PublicKey, Encrypted x)
                             (Assym (Encrypted x))
                   -> (Either String ∘ Identity) x
-decryptMessage crypto n arg
-    | Just secret <- msecret = plain $ ToxCrypto.decrypt secret e
-    | otherwise              = Composed $ Left "decryptMessage: Unknown sender"
+decryptMessage crypto n arg = plain $ ToxCrypto.decrypt secret e
  where
-    msecret  = do sender <- mkey
-                  Just $ computeSharedSecret (fst crypto) sender n
-    (mkey,e) = either id (Just . senderKey &&& assymData) arg
-    plain    = Composed . fmap Identity . (>>= decodePlain)
+    secret     = computeSharedSecret (fst crypto) sender n
+    (sender,e) = either id (senderKey &&& assymData) arg
+    plain      = Composed . fmap Identity . (>>= decodePlain)
 
 
 sequenceMessage :: Applicative m => OnionMessage (m ∘ f) -> m (OnionMessage f)
@@ -751,4 +754,4 @@ encodeDataToRoute :: TransportCrypto
 encodeDataToRoute crypto (dta, Rendezvous pub ni)
     = Just ( OnionToRoute pub -- Public key of destination node
                           dta
-           , OnionDestination ni Nothing )
+           , OnionDestination SearchingAlias ni Nothing )