6 files changed, 37 insertions, 73 deletions

diff --git a/src/Network/BitTorrent/DHT/ContactInfo.hs b/src/Network/BitTorrent/DHT/ContactInfo.hs
index baa240b4..4293506d 100644
--- a/src/Network/BitTorrent/DHT/ContactInfo.hs
+++ b/src/Network/BitTorrent/DHT/ContactInfo.hs
@@ -7,7 +7,6 @@ module Network.BitTorrent.DHT.ContactInfo
 import Data.Default
 import Data.List as L
 import Data.Maybe
-import Data.Monoid
 import Data.HashMap.Strict as HM
 import Data.Serialize
 
diff --git a/src/Network/BitTorrent/DHT/Message.hs b/src/Network/BitTorrent/DHT/Message.hs
index b8f272c3..9d66741f 100644
--- a/src/Network/BitTorrent/DHT/Message.hs
+++ b/src/Network/BitTorrent/DHT/Message.hs
@@ -94,7 +94,7 @@ import Network
 import Network.KRPC
 import Data.Maybe
 
-import Data.Torrent
+import Data.Torrent (InfoHash)
 import Network.BitTorrent.Address
 import Network.BitTorrent.DHT.Token
 import Network.KRPC ()
@@ -204,7 +204,7 @@ binary k = field (req k) >>= either (fail . format) return .
   where
     format str = "fail to deserialize " ++ show k ++ " field: " ++ str
 
-instance (Typeable ip, Address ip) => BEncode (NodeFound ip) where
+instance Address ip => BEncode (NodeFound ip) where
   toBEncode (NodeFound ns) = toDict $
        nodes_key .=! runPut (mapM_ put ns)
     .: endDict
diff --git a/src/Network/BitTorrent/DHT/Query.hs b/src/Network/BitTorrent/DHT/Query.hs
index d1fa36e5..e067ab52 100644
--- a/src/Network/BitTorrent/DHT/Query.hs
+++ b/src/Network/BitTorrent/DHT/Query.hs
@@ -49,7 +49,6 @@ module Network.BitTorrent.DHT.Query
        , (<@>)
        ) where
 
-import Control.Applicative
 import Control.Concurrent.Lifted hiding (yield)
 import Control.Exception.Lifted hiding (Handler)
 import Control.Monad.Reader
@@ -168,7 +167,7 @@ announceQ ih p NodeInfo {..} = do
     Left  ns
       | False     -> undefined -- TODO check if we can announce
       | otherwise -> return (Left ns)
-    Right ps -> do -- TODO *probably* add to peer cache
+    Right _ -> do -- TODO *probably* add to peer cache
       Announced <- Announce False ih p grantedToken <@> nodeAddr
       return (Right [nodeAddr])
 
@@ -179,7 +178,7 @@ announceQ ih p NodeInfo {..} = do
 type Search    ip o = Conduit [NodeInfo ip] (DHT ip) [o ip]
 
 -- TODO: use reorder and filter (Traversal option) leftovers
-search :: TableKey k => Address ip => k -> Iteration ip o -> Search ip o
+search :: k -> Iteration ip o -> Search ip o
 search _ action = do
   awaitForever $ \ batch -> unless (L.null batch) $ do
     $(logWarnS) "search" "start query"
@@ -196,11 +195,6 @@ publish ih p = do
   _ <- sourceList [nodes] $= search ih (announceQ ih p) $$ C.take r
   return ()
 
-republish :: DHT ip ThreadId
-republish = fork $ do
-  i <- asks (optReannounce . options)
-  error "DHT.republish: not implemented"
-
 getTimestamp :: DHT ip Timestamp
 getTimestamp = do
   utcTime <- liftIO $ getCurrentTime
@@ -229,7 +223,7 @@ refreshNodes nid = do
     -- nss <- sourceList [[addr]] $= search nid (findNodeQ nid) $$ C.consume
     nss <- sourceList [nodes] $= search nid (findNodeQ nid) $$ C.consume
     $(logWarnS) "refreshNodes" $ "received " <> T.pack (show (L.length (L.concat nss))) <> " nodes."
-    queryParallel $ flip L.map (L.concat nss) $ \n -> do
+    _ <- queryParallel $ flip L.map (L.concat nss) $ \n -> do
         $(logWarnS) "refreshNodes" $ "received node: " <> T.pack (show (pPrint n))
         pingQ (nodeAddr n)
         -- pingQ takes care of inserting the node.
@@ -239,15 +233,14 @@ refreshNodes nid = do
 -- | This operation do not block but acquire exclusive access to
 --   routing table.
 insertNode :: Address ip => NodeInfo ip -> Maybe ReflectedIP -> DHT ip ThreadId
-insertNode info witnessed_ip = fork $ do
+insertNode info witnessed_ip0 = fork $ do
   var <- asks routingInfo
   tm <- getTimestamp
   let showTable = do
           t <- getTable
           let logMsg = "Routing table: " <> pPrint t
           $(logDebugS) "insertNode" (T.pack (render logMsg))
-  t <- liftIO $ atomically $ readTVar var
-  let arrival  = TryInsert info
+  let arrival0 = TryInsert info
       arrival4 = TryInsert (fmap fromAddr info) :: Event (Maybe IPv4)
   $(logDebugS) "insertNode" $ T.pack (show arrival4)
   maxbuckets <- asks (optBucketCount . options)
@@ -259,13 +252,13 @@ insertNode info witnessed_ip = fork $ do
                             $ rank id (nodeId $ foreignNode arrival)
                             $ bep42s ip fallbackid
           case minfo of
-            Just info -> do
-              (ps,t') <- R.insert tm arrival $ myBuckets info
-              writeTVar var $ Just $ info { myBuckets = t' }
+            Just inf -> do
+              (ps,t') <- R.insert tm arrival $ myBuckets inf
+              writeTVar var $ Just $ inf { myBuckets = t' }
               return $ do
                 case witnessed_ip of
                     Just (ReflectedIP ip0)
-                      | fromSockAddr ip0 /= Just (myAddress info)
+                      | fromSockAddr ip0 /= Just (myAddress inf)
                         -> $(logInfo) ( T.pack $ L.unwords
                               $ [ "Possible NAT?"
                                 , show (toSockAddr $ nodeAddr $ foreignNode arrival)
@@ -298,15 +291,14 @@ insertNode info witnessed_ip = fork $ do
                                     <> ")"
                                 ] )
                            return ps
-  ps <- join $ liftIO $ atomically $ atomicInsert arrival witnessed_ip
+  ps <- join $ liftIO $ atomically $ atomicInsert arrival0 witnessed_ip0
   showTable
-  fork $ forM_ ps $ \(CheckPing ns)-> do
+  _ <- fork $ forM_ ps $ \(CheckPing ns)-> do
     forM_ ns $ \n -> do
         (b,mip) <- probeNode (nodeAddr n)
         let alive = PingResult n b
         $(logDebugS) "insertNode" $ T.pack ("PingResult "++show (nodeId n,b))
-        tm <- getTimestamp
-        join $ liftIO $ atomically $ atomicInsert alive mip
+        _ <- join $ liftIO $ atomically $ atomicInsert alive mip
         showTable
   return ()
 
@@ -323,7 +315,7 @@ queryNode' addr q = do
   (Response remoteId r, witnessed_ip) <- query' (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) witnessed_ip
+  _ <- insertNode (NodeInfo remoteId addr) witnessed_ip
   return (remoteId, r, witnessed_ip)
 
 -- | Infix version of 'queryNode' function.
diff --git a/src/Network/BitTorrent/DHT/Routing.hs b/src/Network/BitTorrent/DHT/Routing.hs
index 84e4d4ce..f9d64eea 100644
--- a/src/Network/BitTorrent/DHT/Routing.hs
+++ b/src/Network/BitTorrent/DHT/Routing.hs
@@ -144,7 +144,7 @@ instance Alternative (Routing ip) where
   Refresh  n f <|> m = Refresh  n (f <|> m)
 
 -- | Run routing table operation.
-runRouting :: (Monad m, Eq ip)
+runRouting :: Monad m
            => (NodeAddr ip -> m Bool) -- ^ ping the specific node;
            -> (NodeId      -> m ())   -- ^ refresh nodes;
            -> m Timestamp             -- ^ get current time;
@@ -166,18 +166,6 @@ runRouting ping_node find_nodes timestamper = go
       find_nodes nid
       go f
 
-getTime :: Routing ip Timestamp
-getTime = GetTime return
-{-# INLINE getTime #-}
-
-needPing :: NodeAddr ip -> Routing ip Bool
-needPing addr = NeedPing addr return
-{-# INLINE needPing #-}
-
-refresh :: NodeId -> Routing ip ()
-refresh nid = Refresh nid (Done ())
-{-# INLINE refresh #-}
-
 {-----------------------------------------------------------------------
     Bucket
 -----------------------------------------------------------------------}
@@ -213,6 +201,7 @@ data QueueMethods m elem fifo = QueueMethods
     , emptyQueue :: m fifo
     }
 
+{-
 fromQ :: Functor m =>
        ( a -> b )
        -> ( b -> a )
@@ -223,6 +212,7 @@ fromQ embed project QueueMethods{..} =
                  , popFront = fmap (second embed) . popFront . project
                  , emptyQueue = fmap embed emptyQueue
                  }
+-}
 
 seqQ :: QueueMethods Identity (NodeInfo ip) (Seq.Seq (NodeInfo ip))
 seqQ = QueueMethods
@@ -256,17 +246,6 @@ instance (Serialize k, Serialize v, Ord k, Ord v)
   get = PSQ.fromList <$> get
   put = put . PSQ.toList
 
--- | Get the most recently changed node entry, if any.
-lastChanged :: Eq ip => Bucket ip -> Maybe (NodeEntry ip)
-lastChanged bucket
-  | L.null timestamps = Nothing
-  |      otherwise    = Just (L.maximumBy (compare `on` prio) timestamps)
-  where
-    timestamps = PSQ.toList $ bktNodes bucket
-
-leastRecently :: Eq ip => Bucket ip -> Maybe (NodeEntry ip, Bucket ip)
-leastRecently b = fmap (\(e,ns) -> (e, b { bktNodes = ns })) $ minView $ bktNodes b
-
 -- | Update interval, in seconds.
 delta :: NominalDiffTime
 delta = 15 * 60
@@ -303,29 +282,30 @@ insertBucket curTime (TryInsert info) bucket
     map_q f = bucket { bktQ = runIdentity $ f (bktQ bucket) }
 
 insertBucket curTime (PingResult bad_node got_response) bucket
-    = pure ([], Bucket (update $ bktNodes bucket) popped)
+    = pure ([], Bucket (upd $ bktNodes bucket) popped)
  where
     (top, popped) = runIdentity $ popFront bucketQ (bktQ bucket)
-    update | got_response     = id
-           | Just info <- top = PSQ.insert info curTime . PSQ.delete bad_node
-           | otherwise        = id
+    upd | got_response     = id
+        | Just info <- top = PSQ.insert info curTime . PSQ.delete bad_node
+        | otherwise        = id
 
 type BitIx = Word
 
-partitionQ imp pred q = do
-    pass <- emptyQueue imp
-    fail <- emptyQueue imp
+partitionQ :: Monad f => QueueMethods f elem b -> (elem -> Bool) -> b -> f (b, b)
+partitionQ imp test q0 = do
+    pass0 <- emptyQueue imp
+    fail0 <- emptyQueue imp
     let flipfix a b f = fix f a b
-    flipfix q (pass,fail) $ \loop q qs -> do
+    flipfix q0 (pass0,fail0) $ \rec q qs -> do
         (mb,q') <- popFront imp q
         case mb of
             Nothing -> return qs
             Just e  -> do qs' <- select (pushBack imp e) qs
-                          loop q' qs'
+                          rec q' qs'
                 where
                     select :: Functor f => (b -> f b) -> (b, b) -> f (b, b)
-                    select f = if pred e then \(a,b) -> flip (,) b <$> f a
-                                           else \(a,b) ->      (,) a <$> f b
+                    select f = if test e then \(a,b) -> flip (,) b <$> f a
+                                         else \(a,b) ->      (,) a <$> f b
 
 split :: Eq ip => BitIx -> Bucket ip -> (Bucket ip, Bucket ip)
 split i b = (Bucket ns qs, Bucket ms rs)
@@ -529,7 +509,7 @@ splitTip nid n i bucket
 -- k nodes in them.  Which subtrees I mean is illustrated in Fig 1. of Kademlia
 -- paper.  The rule requiring additional splits is in section 2.4.
 modifyBucket
-  :: forall f ip xs. (Alternative f, Eq ip, Monoid xs) =>
+  :: forall f ip xs. (Alternative f, Eq ip) =>
      NodeId -> (Bucket ip -> f (xs, Bucket ip)) -> Table ip -> f (xs,Table ip)
 modifyBucket nodeId f = go (0 :: BitIx)
   where
@@ -552,6 +532,7 @@ data Event ip = TryInsert { foreignNode :: NodeInfo ip }
                            }
     deriving (Eq,Ord,Show)
 
+eventId :: Event ip -> NodeId
 eventId (TryInsert NodeInfo{..})    = nodeId
 eventId (PingResult NodeInfo{..} _) = nodeId
 
diff --git a/src/Network/BitTorrent/DHT/Session.hs b/src/Network/BitTorrent/DHT/Session.hs
index 44a5f0e9..d9a50a15 100644
--- a/src/Network/BitTorrent/DHT/Session.hs
+++ b/src/Network/BitTorrent/DHT/Session.hs
@@ -66,9 +66,7 @@ module Network.BitTorrent.DHT.Session
 
 import Prelude hiding (ioError)
 
-import Control.Applicative
 import Control.Concurrent.STM
-import Control.Concurrent.Lifted hiding (yield)
 import Control.Concurrent.Async.Lifted
 import Control.Exception.Lifted hiding (Handler)
 import Control.Monad.Base
@@ -82,16 +80,10 @@ import Data.Fixed
 import Data.Hashable
 import Data.List as L
 import Data.Maybe
-import Data.Monoid
 import Data.Set as S
-import Data.Text as T
 import Data.Time
-import Data.Time.Clock.POSIX
 import Network (PortNumber)
-import System.Log.FastLogger
 import System.Random (randomIO)
-import Text.PrettyPrint as PP hiding ((<>), ($$))
-import Text.PrettyPrint.HughesPJClass hiding ((<>),($$))
 
 import Data.Torrent as Torrent
 import Network.KRPC as KRPC hiding (Options, def)
@@ -118,7 +110,7 @@ defaultAlpha = 3
 
 -- TODO do not insert infohash -> peeraddr if infohash is too far from
 -- this node id
-
+{-
 data Order
   = NearFirst
   | FarFirst
@@ -127,6 +119,7 @@ data Order
 data Traversal
   = Greedy     -- ^ aggressive short-circuit traversal
   | Exhaustive -- ^
+-}
 
 -- | Original Kamelia DHT uses term /publish/ for data replication
 -- process. BitTorrent DHT uses term /announce/ since the purpose of
@@ -460,11 +453,11 @@ deleteTopic ih p = do
 -- Messaging
 -----------------------------------------------------------------------}
 
--- TODO: use alpha
 -- | Failed queries are ignored.
 queryParallel :: [DHT ip a] -> DHT ip [a]
 queryParallel queries = do
-    alpha <- asks (optAlpha . options)
+    -- TODO: use alpha
+    -- alpha <- asks (optAlpha . options)
     cleanup <$> mapConcurrently try queries
   where
     cleanup :: [Either QueryFailure a] -> [a]
diff --git a/src/Network/BitTorrent/DHT/Token.hs b/src/Network/BitTorrent/DHT/Token.hs
index a0ed428b..7aaaf2b7 100644
--- a/src/Network/BitTorrent/DHT/Token.hs
+++ b/src/Network/BitTorrent/DHT/Token.hs
@@ -37,7 +37,6 @@ module Network.BitTorrent.DHT.Token
        , Network.BitTorrent.DHT.Token.update
        ) where
 
-import Control.Applicative
 import Control.Monad.State
 import Data.BEncode (BEncode)
 import Data.ByteString as BS
@@ -119,4 +118,4 @@ update TokenMap {..} = TokenMap
     , generator  = newGen
     }
   where
-    (newSecret, newGen) = next generator
\ No newline at end of file
+    (newSecret, newGen) = next generator