Bug fixes.

2 files changed, 46 insertions, 33 deletions

diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs
index 6d31eab2..fa8071d5 100644
--- a/src/Network/BitTorrent/DHT.hs
+++ b/src/Network/BitTorrent/DHT.hs
@@ -119,8 +119,8 @@ dht ::
     , Show (QueryMethod dht)
     , Pretty (NodeInfo dht ip u)
     , Kademlia dht
-    , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
-    , KRPC (Query dht (Ping dht)) (Response dht (Ping dht))
+    , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
+    , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
     , DataHandlers raw dht
     , WireFormat raw dht
     , Show u
@@ -227,8 +227,8 @@ bootstrap :: forall raw dht u ip.
     , Show (QueryMethod dht)
     , Pretty (NodeInfo dht ip u)
     , Kademlia dht
-    , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
-    , KRPC (Query dht (Ping dht)) (Response dht (Ping dht))
+    , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
+    , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
     , DataHandlers raw dht
     , WireFormat raw dht
     , Show u
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs
index 67dc4541..4c980e22 100644
--- a/src/Network/BitTorrent/DHT/Query.hs
+++ b/src/Network/BitTorrent/DHT/Query.hs
@@ -123,7 +123,7 @@ import Data.String
 
 {-
 nodeHandler :: ( Address ip
-               , KRPC (Query KMessageOf a) (Response KMessageOf b)
+               , KRPC dht (Query KMessageOf a) (Response KMessageOf b)
                )
            => (NodeInfo KMessageOf ip () -> Maybe ReflectedIP -> IO ()) -> (NodeAddr ip -> IO (NodeId KMessageOf)) -> (Char -> String -> Text -> IO ()) -> QueryMethod KMessageOf -> (NodeAddr ip -> a -> IO b) -> NodeHandler
 -}
@@ -197,10 +197,10 @@ kademliaHandlers :: forall raw dht u ip. (Eq ip, Ord ip, Address ip
                     , Serialize (TransactionID dht)
                     , WireFormat raw dht
                     , Kademlia dht
-                    , KRPC (Query dht (Ping dht)) (Response dht (Ping dht))
+                    , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
                     , Functor dht
                     , Pretty (NodeInfo dht ip u)
-                    , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
+                    , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
                     , SerializableTo raw (Response dht (NodeFound dht ip))
                     , SerializableTo raw (Query dht (FindNode dht ip))
                     ) => LogFun -> DHT raw dht u ip [Handler IO dht raw]
@@ -208,7 +208,7 @@ kademliaHandlers :: forall raw dht u ip. (Eq ip, Ord ip, Address ip
 kademliaHandlers logger = do
     groknode <- insertNode1
     mynid <- myNodeIdAccordingTo1
-    let handler :: ( KRPC (Query dht a) (Response dht b)
+    let handler :: ( KRPC dht (Query dht a) (Response dht b)
                    , SerializableTo raw (Response dht b)
                    , SerializableTo raw (Query dht a)
                    ) => QueryMethod dht -> (NodeAddr ip -> a -> IO b) -> Handler IO dht raw
@@ -264,10 +264,10 @@ defaultHandlers :: forall raw dht u ip.
                     , Serialize (TransactionID dht)
                     , WireFormat raw dht
                     , Kademlia dht
-                    , KRPC (Query dht (Ping dht)) (Response dht (Ping dht))
+                    , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
                     , Functor dht
                     , Pretty (NodeInfo dht ip u)
-                    , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
+                    , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
                     , SerializableTo raw (Response dht (NodeFound dht ip))
                     , SerializableTo raw (Query dht (FindNode dht ip))
                     , Eq ip, Ord ip, Address ip, DataHandlers raw dht
@@ -293,7 +293,7 @@ type Iteration raw dht u ip o = NodeInfo dht ip u -> DHT raw dht u ip (Either [N
 pingQ :: forall raw dht u ip.
             ( DHT.Kademlia dht
             , Address ip
-            , KRPC (Query dht (Ping dht)) (Response dht (Ping dht))
+            , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
             , Default u
             , Show u
             , Ord (TransactionID dht)
@@ -361,7 +361,7 @@ ioGetPeers ih = do
 
 ioFindNode :: ( DHT.Kademlia dht
               , WireFormat raw dht
-              , KRPC (Query dht (Ping dht)) (Response dht (Ping dht))
+              , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
               , Address ip
               , Default u
               , Show u
@@ -371,7 +371,7 @@ ioFindNode :: ( DHT.Kademlia dht
               , Ord (NodeId dht)
               , FiniteBits (NodeId dht)
               , Show (NodeId dht)
-              , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
+              , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
               , Ord (TransactionID dht)
               , Serialize (TransactionID dht)
               , SerializableTo raw (Response dht (NodeFound dht ip))
@@ -390,7 +390,7 @@ ioFindNode ih = do
 -- | Like ioFindNode, but considers all found nodes to be 'Right' results.
 ioFindNodes :: ( DHT.Kademlia dht
               , WireFormat raw dht
-              , KRPC (Query dht (Ping dht)) (Response dht (Ping dht))
+              , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
               , Address ip
               , Default u
               , Show u
@@ -400,7 +400,7 @@ ioFindNodes :: ( DHT.Kademlia dht
               , Ord (NodeId dht)
               , FiniteBits (NodeId dht)
               , Show (NodeId dht)
-              , KRPC (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
+              , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
               , Ord (TransactionID dht)
               , Serialize (TransactionID dht)
               , SerializableTo raw (Response dht (NodeFound dht ip))
@@ -481,7 +481,7 @@ publish = error "todo"
 
 probeNode :: ( Default u
             , Show u
-            , KRPC (Query dht (Ping dht)) (Response dht (Ping dht))
+            , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
             , DHT.Kademlia dht
             , Address ip
             , Ord (TransactionID dht)
@@ -507,9 +507,22 @@ refreshNodes :: forall raw dht u ip.
                 , Default u
                 , FiniteBits (NodeId dht)
                 , Pretty (NodeId dht)
-                , DHT.Kademlia dht )  => NodeId dht -> DHT raw dht u ip () -- [NodeInfo KMessageOf ip ()]
-refreshNodes _  = return () -- TODO
-#if 0
+                , DHT.Kademlia dht
+                , Ord ip
+                , Ord (TransactionID dht)
+                , SerializableTo raw (Response dht (NodeFound dht ip))
+                , SerializableTo raw (Query dht (FindNode dht ip))
+                , SerializableTo raw (Response dht (Ping dht))
+                , SerializableTo raw (Query dht (Ping dht))
+                , Pretty (NodeInfo dht ip u)
+                , Show (NodeId dht)
+                , Show u
+                , Show (QueryMethod dht)
+                , Serialize (TransactionID dht)
+                , WireFormat raw dht
+                , KRPC dht (Query dht (FindNode dht ip)) (Response dht (NodeFound dht ip))
+                , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
+                )  => NodeId dht -> DHT raw dht u ip () -- [NodeInfo KMessageOf ip ()]
 -- FIXME do not use getClosest sinse we should /refresh/ them
 refreshNodes nid = do
   $(logDebugS) "routing.refresh_bucket" (T.pack (render (pPrint nid)))
@@ -520,15 +533,15 @@ refreshNodes nid = do
     -- Expected type: ConduitM [NodeAddr ip] [NodeInfo KMessageOf ip ()] (DHT ip) ()
     --   Actual type: ConduitM [NodeInfo KMessageOf ip ()] [NodeInfo KMessageOf ip ()] (DHT ip) ()
     -- nss <- sourceList [[addr]] \$= search nid (findNodeQ nid) $$ C.consume
-    nss <- sourceList [nodes] $= search nid (findNodeQ (Proxy :: Proxy dht) nid) $$ C.consume
-    $(logWarnS) "refreshNodes" $ "received " <> T.pack (show (L.length (L.concat nss))) <> " nodes."
-    _ <- queryParallel $ flip L.map (L.concat nss) $ \n -> do
+    -- nss <- sourceList [nodes] \$= search nid (findNodeQ (Proxy :: Proxy dht) nid) $$ C.consume
+    ns <- bgsearch ioFindNodes nid
+    $(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 takes care of inserting the node.
     return ()
   return () -- \$ L.concat nss
-#endif
 
 logc :: Char -> String -> DHT raw dht u ip ()
 logc 'D' = $(logDebugS) "insertNode" . T.pack
@@ -546,7 +559,7 @@ insertNode :: forall raw dht u ip.
               , Default u
               , Show u
               , DHT.Kademlia dht
-              , KRPC (Query dht (Ping dht)) (Response dht (Ping dht))
+              , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
               , Ord (TransactionID dht)
               , WireFormat raw dht
               , Serialize (TransactionID dht)
@@ -567,7 +580,7 @@ insertNode1 :: forall raw dht u ip.
                , Ord (NodeId dht)
                , FiniteBits (NodeId dht)
                , Show (NodeId dht)
-               , KRPC (Query dht (Ping dht)) (Response dht (Ping dht))
+               , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
                , DHT.Kademlia dht
                , Ord (TransactionID dht)
                , WireFormat raw dht
@@ -611,8 +624,8 @@ insertNode1 = do
 -- | Throws exception if node is not responding.
 queryNode :: forall raw dht u a b ip.
     ( Address ip
-    , KRPC (Query dht a) (Response dht b)
-    , KRPC (Query dht (Ping dht)) (Response dht (Ping dht))
+    , KRPC dht (Query dht a) (Response dht b)
+    , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
     , Default u
     , Show u
     , DHT.Kademlia dht
@@ -635,8 +648,8 @@ queryNode' :: forall raw dht u a b ip.
     , Default u
     , Show u
     , DHT.Kademlia dht
-    , KRPC (Query dht a) (Response dht b)
-    , KRPC (Query dht (Ping dht)) (Response dht (Ping 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
@@ -652,9 +665,9 @@ queryNode' :: forall raw dht u a b ip.
 queryNode' addr q = do
   nid <- myNodeIdAccordingTo addr
   let read_only = False -- TODO: check for NAT issues. (BEP 43)
-  let KRPC.Method name = KRPC.method :: KRPC.Method (Query dht a) (Response dht b)
+  let KRPC.Method name = KRPC.method :: KRPC.Method dht (Query dht a) (Response dht b)
   mgr <- asks manager
-  (Response remoteId r, witnessed_ip) <- liftIO $ query' mgr (error "TODO: name") (toSockAddr addr) (Query nid read_only q)
+  (Response remoteId r, witnessed_ip) <- liftIO $ query' mgr name (toSockAddr addr) (Query nid read_only q)
   -- \$(logDebugS) "queryNode" $ "Witnessed address: " <> T.pack (show witnessed_ip)
   --                             <> " by " <> T.pack (show (toSockAddr addr))
   _ <- insertNode (NodeInfo remoteId addr def) witnessed_ip
@@ -662,8 +675,8 @@ queryNode' addr q = do
 
 -- | Infix version of 'queryNode' function.
 (<@>) :: ( Address ip
-         , KRPC (Query dht a) (Response dht b)
-         , KRPC (Query dht (Ping dht)) (Response dht (Ping dht))
+         , KRPC dht (Query dht a) (Response dht b)
+         , KRPC dht (Query dht (Ping dht)) (Response dht (Ping dht))
          , Default u
          , Show u
          , Show (QueryMethod dht)