WIP: Tox encryption.

2 files changed, 81 insertions, 28 deletions

diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs
index fa8071d5..2535c05c 100644
--- a/src/Network/BitTorrent/DHT.hs
+++ b/src/Network/BitTorrent/DHT.hs
@@ -234,7 +234,7 @@ bootstrap :: forall raw dht u ip.
     , Show u
     , Default u
     , Serialize u
-    ) => Maybe BS.ByteString -> [NodeAddr ip] -> DHT raw dht u ip ()
+    ) => Maybe BS.ByteString -> [PacketDestination dht] -> DHT raw dht u ip ()
 bootstrap mbs startNodes = do
   restored <-
     case decode <$> mbs of
@@ -250,7 +250,7 @@ bootstrap mbs startNodes = do
         return ( ns :: [NodeInfo dht ip u] )
   input_nodes <- (restored ++) . T.toList <$> getTable
   -- Step 1: Use iterative searches to flesh out the table..
-  do let knowns = map (map $ nodeAddr . fst) input_nodes
+  do let knowns = map (map $ fst) input_nodes
      -- Below, we reverse the nodes since the table serialization puts the
      -- nearest nodes last and we want to choose a similar node id to bootstrap
      -- faster.
@@ -265,7 +265,7 @@ bootstrap mbs startNodes = do
          when (null ns) $ do
             -- TODO filter duplicated in startNodes list
             -- TODO retransmissions for startNodes
-            (aliveNodes,_) <- unzip <$> queryParallel (pingQ <$> startNodes)
+            (aliveNodes,_) <- unzip <$> queryParallel (coldPingQ <$> startNodes)
             _ <- searchAll $ take 2 aliveNodes
             return ()
   -- Step 2: Repeatedly refresh incomplete buckets until the table is full.
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs
index 77fede94..60b772b3 100644
--- a/src/Network/BitTorrent/DHT/Query.hs
+++ b/src/Network/BitTorrent/DHT/Query.hs
@@ -35,6 +35,7 @@ module Network.BitTorrent.DHT.Query
          -- single response.
        , Iteration
        , pingQ
+       , coldPingQ
        , findNodeQ
        , getPeersQ
        , announceQ
@@ -316,44 +317,72 @@ pingQ :: forall raw dht u ip.
             , FiniteBits (NodeId dht)
             , Show (NodeId dht)
             , Show (QueryMethod dht)
-            ) => NodeAddr ip -> DHT raw dht u ip (NodeInfo dht ip u , Maybe ReflectedIP)
-pingQ addr = do
+            ) => NodeInfo dht ip u -> DHT raw dht u ip (NodeInfo dht ip u , Maybe ReflectedIP)
+pingQ ni = do
   let ping = DHT.pingMessage (Proxy :: Proxy dht)
-  (nid, pong, mip) <- queryNode' addr ping
+  (nid, pong, mip) <- queryNode' ni ping
   let _ = pong `asTypeOf` ping
   -- (nid, PingPayload{}, mip) <- queryNode' addr PingPayload {isPong=False, pingId=pid}
-  return (NodeInfo nid addr def, mip)
+  return (NodeInfo nid (nodeAddr ni) def, mip)
+
+-- | The most basic query. May be used to check if the given node is
+-- alive or get its 'NodeId'.
+coldPingQ :: forall raw dht u ip.
+            ( DHT.Kademlia dht
+            , Address ip
+            , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
+            , Default u
+            , Show u
+            , Ord (TransactionID dht)
+            , Serialize (TransactionID dht)
+            , WireFormat raw dht
+            , SerializableTo raw (Response dht (Ping dht))
+            , SerializableTo raw (Query dht (Ping dht))
+            , Ord (NodeId dht)
+            , FiniteBits (NodeId dht)
+            , Show (NodeId dht)
+            , Show (QueryMethod dht)
+            ) => PacketDestination dht -> DHT raw dht u ip (NodeInfo dht ip u , Maybe ReflectedIP)
+coldPingQ dest = do
+  let ping = DHT.pingMessage (Proxy :: Proxy dht)
+  naddr <- maybe (throwIO $ QueryFailed ProtocolError "unable to construct NodeAddr from PacketDestination")
+                 return
+                 $ fromAddr dest
+  (nid, pong, mip) <- coldQueryNode' naddr dest ping
+  let _ = pong `asTypeOf` ping
+  -- (nid, PingPayload{}, mip) <- queryNode' addr PingPayload {isPong=False, pingId=pid}
+  return (NodeInfo nid naddr def, mip)
 
 -- TODO [robustness] match range of returned node ids with the
 -- expected range and either filter bad nodes or discard response at
 -- all throwing an exception
 -- findNodeQ :: Address ip => TableKey key => key -> IterationI ip NodeInfo
-findNodeQ proxy key NodeInfo {..} = do
-  closest <- fmap DHT.foundNodes $  DHT.findNodeMessage proxy key <@> nodeAddr
+findNodeQ proxy key ni = do
+  closest <- fmap DHT.foundNodes $  DHT.findNodeMessage proxy key <@> ni
   $(logInfoS) "findNodeQ" $ "NodeFound\n"
     <> T.pack (L.unlines $ L.map ((' ' :) . show . pPrint) closest)
   return $ Right closest
 
 #ifdef VERSION_bencoding
 getPeersQ :: Address ip => InfoHash -> Iteration BValue KMessageOf () ip PeerAddr
-getPeersQ topic NodeInfo {..} = do
-  GotPeers {..} <- GetPeers topic <@> nodeAddr
-  let dist = distance (toNodeId topic) nodeId
+getPeersQ topic ni = do
+  GotPeers {..} <- GetPeers topic <@> ni
+  let dist = distance (toNodeId topic) (nodeId ni)
   $(logInfoS) "getPeersQ" $ T.pack
          $ "distance: " <> render (pPrint dist) <> " , result: "
         <> case peers of { Left _ -> "NODES"; Right _ -> "PEERS" }
   return peers
 
 announceQ :: Address ip => InfoHash -> PortNumber -> Iteration BValue KMessageOf () ip NodeAddr
-announceQ ih p NodeInfo {..} = do
-  GotPeers {..} <- GetPeers ih <@> nodeAddr
+announceQ ih p ni = do
+  GotPeers {..} <- GetPeers ih <@> ni
   case peers of
     Left  ns
       | False     -> undefined -- TODO check if we can announce
       | otherwise -> return (Left ns)
     Right _ -> do -- TODO *probably* add to peer cache
-      Announced <- Announce False ih Nothing p grantedToken <@> nodeAddr
-      return (Right [nodeAddr])
+      Announced <- Announce False ih Nothing p grantedToken <@> ni
+      return (Right [nodeAddr ni])
 #endif
 
 {-----------------------------------------------------------------------
@@ -393,7 +422,7 @@ ioFindNode :: ( DHT.Kademlia dht
 ioFindNode ih = do
     session <- ask
     return $ \ni -> runDHT session $ do
-        ns <- fmap DHT.foundNodes $ DHT.findNodeMessage Proxy ih <@> nodeAddr ni
+        ns <- fmap DHT.foundNodes $ DHT.findNodeMessage Proxy ih <@> ni
         let ns' = L.map (fmap (const def)) ns
         return $ L.partition (\n -> nodeId n /= toNodeId ih) ns'
 
@@ -422,7 +451,7 @@ ioFindNodes :: ( DHT.Kademlia dht
 ioFindNodes ih = do
     session <- ask
     return $ \ni -> runDHT session $ do
-        ns <- fmap DHT.foundNodes $ DHT.findNodeMessage Proxy ih <@> nodeAddr ni
+        ns <- fmap DHT.foundNodes $ DHT.findNodeMessage Proxy ih <@> ni
         let ns' = L.map (fmap (const def)) ns
         return ([], ns')
 
@@ -504,9 +533,9 @@ probeNode :: ( Default u
             , FiniteBits (NodeId dht)
             , Show (NodeId dht)
             , Show (QueryMethod dht)
-            ) => NodeAddr ip -> DHT raw dht u ip (Bool , Maybe ReflectedIP)
+            ) => NodeInfo dht ip u -> DHT raw dht u ip (Bool , Maybe ReflectedIP)
 probeNode addr = do
-  $(logDebugS) "routing.questionable_node" (T.pack (render (pPrint addr)))
+  $(logDebugS) "routing.questionable_node" (T.pack (render (pPrint $ nodeAddr addr)))
   result <- try $ pingQ addr
   let _ = fmap (const ()) result :: Either QueryFailure ()
   return $ either (const (False,Nothing)) (\(_,mip)->(True,mip)) result
@@ -549,7 +578,7 @@ refreshNodes nid = do
     $(logWarnS) "refreshNodes" $ "received " <> T.pack (show (L.length ns)) <> " nodes."
     _ <- queryParallel $ flip L.map ns $ \n -> do
         $(logWarnS) "refreshNodes" $ "received node: " <> T.pack (show (pPrint n))
-        pingQ (nodeAddr n)
+        pingQ n
         -- pingQ takes care of inserting the node.
     return ()
   return () -- \$ L.concat nss
@@ -622,7 +651,7 @@ insertNode1 = do
         , fallbackID = nid :: NodeId dht
         , adjustID = dhtAdjustID Proxy (DHT.fallbackID params) :: SockAddr -> Event dht ip u -> NodeId dht
         , logMessage = logm :: Char -> String -> IO ()
-        , pingProbe = probe :: NodeAddr ip -> IO (Bool, Maybe ReflectedIP)
+        , pingProbe = probe :: NodeInfo dht ip u -> IO (Bool, Maybe ReflectedIP)
         }
   tbl <- asks routingInfo
   let state = DHT.TableKeeper
@@ -651,7 +680,7 @@ queryNode :: forall raw dht u a b ip.
     , Show (QueryMethod dht)
     , SerializableTo raw (Response dht (Ping dht))
     , SerializableTo raw (Query dht (Ping dht))
-    ) => NodeAddr ip -> a -> DHT raw dht u ip (NodeId dht, b)
+    ) => NodeInfo dht ip u -> a -> DHT raw dht u ip (NodeId dht, b)
 queryNode addr q = fmap (\(n,b,_) -> (n,b)) $ queryNode' addr q
 
 queryNode' :: forall raw dht u a b ip.
@@ -672,15 +701,39 @@ queryNode' :: forall raw dht u a b ip.
     , Show (QueryMethod dht)
     , SerializableTo raw (Response dht (Ping dht))
     , SerializableTo raw (Query dht (Ping dht))
-    ) => NodeAddr ip -> a -> DHT raw dht u ip (NodeId dht, b, Maybe ReflectedIP)
-queryNode' addr q = do
-  nid <- myNodeIdAccordingTo addr
+    ) => NodeInfo dht ip u -> a -> DHT raw dht u ip (NodeId dht, b, Maybe ReflectedIP)
+queryNode' ni q = do
+  let addr = nodeAddr ni
+      dest = makeAddress (Left $ nodeId ni) (toSockAddr addr)
+  coldQueryNode' addr dest q
+
+coldQueryNode' :: forall raw dht u a b ip.
+    ( Address ip
+    , Default u
+    , Show u
+    , DHT.Kademlia dht
+    , KRPC dht (Query dht a) (Response dht b)
+    , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
+    , Ord (TransactionID dht)
+    , Serialize (TransactionID dht)
+    , WireFormat raw dht
+    , SerializableTo raw (Response dht b)
+    , SerializableTo raw (Query dht a)
+    , Ord (NodeId dht)
+    , FiniteBits (NodeId dht)
+    , Show (NodeId dht)
+    , Show (QueryMethod dht)
+    , SerializableTo raw (Response dht (Ping dht))
+    , SerializableTo raw (Query dht (Ping dht))
+    ) => NodeAddr ip -> PacketDestination dht -> a -> DHT raw dht u ip (NodeId dht, b, Maybe ReflectedIP)
+coldQueryNode' addr dest q = do
+  nid <- myNodeIdAccordingTo $ fromMaybe (error "TODO: coldQueryNode' myNodeIdAccordingTo") $ fromAddr dest
   dta <- asks dhtData
   qextra <- liftIO $ makeQueryExtra dta nid (Proxy :: Proxy (Query dht q)) (Proxy :: Proxy (Response dht b))
   let read_only = False -- TODO: check for NAT issues. (BEP 43)
   -- let KRPC.Method name = KRPC.method :: KRPC.Method dht (Query dht a) (Response dht b)
   mgr <- asks manager
-  (Response rextra r, remoteId, witnessed_ip) <- liftIO $ query' mgr (toSockAddr addr) (Query qextra q)
+  (Response rextra r, remoteId, witnessed_ip) <- liftIO $ query' mgr dest (Query qextra q)
   -- \$(logDebugS) "queryNode" $ "Witnessed address: " <> T.pack (show witnessed_ip)
   --                             <> " by " <> T.pack (show (toSockAddr addr))
   _ <- insertNode (NodeInfo remoteId addr def) witnessed_ip
@@ -704,6 +757,6 @@ queryNode' addr q = do
          , SerializableTo raw (Query dht (Ping dht))
          , WireFormat raw dht
          , Kademlia dht
-         ) => a -> NodeAddr ip -> DHT raw dht u ip b
+         ) => a -> NodeInfo dht ip u -> DHT raw dht u ip b
 q <@> addr = snd <$> queryNode addr q
 {-# INLINE (<@>) #-}