1 files changed, 27 insertions, 15 deletions

diff --git a/src/Network/BitTorrent/DHT.hs b/src/Network/BitTorrent/DHT.hs
index d9328cea..8bc423a3 100644
--- a/src/Network/BitTorrent/DHT.hs
+++ b/src/Network/BitTorrent/DHT.hs
@@ -15,9 +15,11 @@
 --   <http://www.bittorrent.org/beps/bep_0005.html>
 --
 {-# LANGUAGE FlexibleInstances #-}
+{-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE TemplateHaskell   #-}
 {-# LANGUAGE TypeOperators     #-}
 {-# LANGUAGE ScopedTypeVariables #-}
+{-# LANGUAGE CPP #-}
 module Network.BitTorrent.DHT
        ( -- * Distributed Hash Table
          DHT
@@ -37,7 +39,7 @@ module Network.BitTorrent.DHT
        , snapshot
 
          -- * Operations
-       , Network.BitTorrent.DHT.lookup
+       -- , Network.BitTorrent.DHT.lookup
        , Network.BitTorrent.DHT.insert
        , Network.BitTorrent.DHT.delete
 
@@ -50,7 +52,7 @@ module Network.BitTorrent.DHT
        , closeNode
 
          -- ** Monad
-       , MonadDHT (..)
+       -- , MonadDHT (..)
        , runDHT
        ) where
 
@@ -81,11 +83,13 @@ import qualified Network.DatagramServer as KRPC (listen, Protocol(..))
 --  DHT types
 -----------------------------------------------------------------------}
 
+#if 0
 class MonadDHT m where
-  liftDHT :: DHT IPv4 a -> m a
+  liftDHT :: DHT raw dht u IPv4 a -> m a
 
-instance MonadDHT (DHT IPv4) where
+instance MonadDHT (DHT raw dht u IPv4) where
   liftDHT = id
+#endif
 
 -- | Convenience method.  Pass this to 'dht' to enable full logging.
 fullLogging :: LogSource -> LogLevel -> Bool
@@ -96,7 +100,7 @@ dht :: (Ord ip, Address ip)
     => Options     -- ^ normally you need to use 'Data.Default.def';
     -> NodeAddr ip -- ^ address to bind this node;
     -> (LogSource -> LogLevel -> Bool) -- ^ use 'fullLogging' as a noisy default
-    -> DHT ip a    -- ^ actions to run: 'bootstrap', 'lookup', etc;
+    -> DHT raw dht u ip a    -- ^ actions to run: 'bootstrap', 'lookup', etc;
     -> IO a        -- ^ result.
 dht opts addr logfilter action = do
   runStderrLoggingT $ filterLogger logfilter $ LoggingT $ \ logger -> do
@@ -175,7 +179,7 @@ resolveHostName NodeAddr {..} = do
 --
 --   This operation do block, use
 --   'Control.Concurrent.Async.Lifted.async' if needed.
-bootstrap :: forall ip. Address ip => Maybe BS.ByteString -> [NodeAddr ip] -> DHT ip ()
+bootstrap :: forall raw dht u ip. Address ip => Maybe BS.ByteString -> [NodeAddr ip] -> DHT raw dht u ip ()
 bootstrap mbs startNodes = do
   restored <-
     case decode <$> mbs of
@@ -187,8 +191,8 @@ bootstrap mbs startNodes = do
   $(logInfoS) "bootstrap" "Start node bootstrapping"
   let searchAll aliveNodes = do
         nid <- myNodeIdAccordingTo (error "FIXME")
-        nss <- C.sourceList [aliveNodes] $= search nid (findNodeQ nid) $$ C.consume
-        return ( nss :: [[NodeInfo KMessageOf ip ()]] )
+        ns <- bgsearch ioFindNodes nid
+        return ( ns :: [NodeInfo KMessageOf ip ()] )
   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
@@ -200,10 +204,10 @@ bootstrap mbs startNodes = do
      -- If our cached nodes are alive and our IP address did not change, it's possible
      -- we are already bootsrapped, so no need to do any searches.
      when (not b) $ do
-         nss <- searchAll $ take 2 alive_knowns
+         ns <- searchAll $ take 2 alive_knowns
          -- We only use the supplied bootstrap nodes when we don't know of any
          -- others to try.
-         when (null nss) $ do
+         when (null ns) $ do
             -- TODO filter duplicated in startNodes list
             -- TODO retransmissions for startNodes
             (aliveNodes,_) <- unzip <$> queryParallel (pingQ <$> startNodes)
@@ -243,7 +247,7 @@ bootstrap mbs startNodes = do
 --
 --   This operation do not block.
 --
-isBootstrapped :: Eq ip => DHT ip Bool
+isBootstrapped :: Eq ip => DHT raw dht u ip Bool
 isBootstrapped = T.full <$> getTable
 
 {-----------------------------------------------------------------------
@@ -254,7 +258,11 @@ isBootstrapped = T.full <$> getTable
 --
 --   This is blocking operation, use
 -- 'Control.Concurrent.Async.Lifted.async' if needed.
-snapshot :: Address ip => DHT ip BS.ByteString
+snapshot :: ( Address ip
+            , Ord (NodeId dht)
+            , Serialize u
+            , Serialize (NodeId dht)
+            ) => DHT raw dht u ip BS.ByteString
 snapshot = do
     tbl <- getTable
     return $ encode tbl
@@ -263,15 +271,19 @@ snapshot = do
 --  Operations
 -----------------------------------------------------------------------}
 
+#if 0
+
 -- | Get list of peers which downloading this torrent.
 --
 --   This operation is incremental and do block.
 --
-lookup :: Address ip => InfoHash -> DHT ip `C.Source` [PeerAddr ip]
+lookup :: Address ip => InfoHash -> DHT raw dht u ip `C.Source` [PeerAddr ip]
 lookup topic = do      -- TODO retry getClosest if bucket is empty
   closest <- lift $ getClosest topic
   C.sourceList [closest] $= search topic (getPeersQ topic)
 
+#endif
+
 -- TODO do not republish if the topic is already in announceSet
 
 -- | Announce that /this/ peer may have some pieces of the specified
@@ -281,7 +293,7 @@ lookup topic = do      -- TODO retry getClosest if bucket is empty
 --   This operation is synchronous and do block, use
 --   'Control.Concurrent.Async.Lifted.async' if needed.
 --
-insert :: Address ip => InfoHash -> PortNumber -> DHT ip ()
+insert :: Address ip => InfoHash -> PortNumber -> DHT raw dht u ip ()
 insert ih p = do
   publish ih p
   insertTopic ih p
@@ -290,6 +302,6 @@ insert ih p = do
 --
 --   This operation is atomic and may block for a while.
 --
-delete :: InfoHash -> PortNumber -> DHT ip ()
+delete :: InfoHash -> PortNumber -> DHT raw dht u ip ()
 delete = deleteTopic
 {-# INLINE delete #-}