~ Fix wall suggestions.

5 files changed, 37 insertions, 49 deletions

diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs
index 7ec0a067..85571470 100644
--- a/src/Network/BitTorrent.hs
+++ b/src/Network/BitTorrent.hs
@@ -29,12 +29,9 @@ module Network.BitTorrent
        , awaitEvent, yieldEvent
        ) where
 
-import Control.Concurrent
 import Control.Exception
 import Control.Monad
 
-import Data.IORef
-
 import Network
 
 import Data.Torrent
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs
index 0e2799b2..3235a626 100644
--- a/src/Network/BitTorrent/Exchange.hs
+++ b/src/Network/BitTorrent/Exchange.hs
@@ -22,19 +22,11 @@ module Network.BitTorrent.Exchange
        ) where
 
 import Control.Applicative
-import Control.Concurrent
-import Control.Concurrent.STM
 import Control.Exception
 import Control.Lens
 import Control.Monad.Reader
-import Control.Monad.State
 import Control.Monad.Trans.Resource
 
-import Data.IORef
-import Data.Function
-import Data.Ord
-import Data.Set as S
-
 import Data.Conduit as C
 import Data.Conduit.Cereal
 import Data.Conduit.Network
@@ -49,7 +41,6 @@ import Network.BitTorrent.Extension
 import Network.BitTorrent.Peer
 import Network.BitTorrent.Exchange.Protocol
 import Data.Bitfield as BF
-import Data.Torrent
 
 
 data Event = Available Bitfield
@@ -74,7 +65,7 @@ runConduit sock p2p =
 awaitMessage :: P2P Message
 awaitMessage = P2P (ReaderT go)
   where
-    go se = do
+    go _ = do
       liftIO $ putStrLn "trying recv:"
       mmsg <- await
       case mmsg of
@@ -169,10 +160,10 @@ awaitEvent = awaitMessage >>= go
       status.peerStatus.interested .= False
       awaitEvent
 
-    go (Have ix)      = do
-      new <- singletonBF ix
+    go (Have idx)      = do
+      new <- singletonBF idx
       bitfield %= BF.union new
-      revise
+      _ <- revise
 
       offer <- peerOffer
       if not (BF.null offer)
@@ -182,7 +173,7 @@ awaitEvent = awaitMessage >>= go
     go (Bitfield bf)  = do
       new <- adjustBF bf
       bitfield .= new
-      revise
+      _ <- revise
 
       offer <- peerOffer
       if not (BF.null offer)
@@ -205,38 +196,40 @@ awaitEvent = awaitMessage >>= go
         then return (Fragment blk)
         else awaitEvent
 
-{-
+    go (Cancel _) = do
+      error "cancel message not implemented"
+
     go (Port     _) = do
       requireExtension ExtDHT
-      undefined
+      error "port message not implemented"
 
     go HaveAll = do
       requireExtension ExtFast
       bitfield <~ fullBF
-      revise
+      _ <- revise
       awaitEvent
 
     go HaveNone = do
       requireExtension ExtFast
       bitfield <~ emptyBF
-      revise
+      _ <- revise
       awaitEvent
 
-    go (SuggestPiece ix) = do
+    go (SuggestPiece idx) = do
       requireExtension ExtFast
       bf <- use bitfield
-      if ix `BF.notMember` bf
-        then Available <$> singletonBF ix
+      if idx `BF.notMember` bf
+        then Available <$> singletonBF idx
         else awaitEvent
 
-    go (RejectRequest ix) = do
+    go (RejectRequest _) = do
        requireExtension ExtFast
-       awaitMessage
+       awaitEvent
 
-    go (AllowedFast pix) =
+    go (AllowedFast _) = do
        requireExtension ExtFast
-       awaitMessage
--}
+       awaitEvent
+
 
 
 -- |
@@ -251,7 +244,7 @@ awaitEvent = awaitMessage >>= go
 --   @
 --
 yieldEvent  :: Event -> P2P ()
-yieldEvent (Available bf)  = undefined
+yieldEvent (Available _  ) = undefined
 yieldEvent (Want      bix) = do
   offer <- peerOffer
   if ixPiece bix `BF.member` offer
diff --git a/src/Network/BitTorrent/Exchange/Protocol.hs b/src/Network/BitTorrent/Exchange/Protocol.hs
index d2d3da6c..5ea104cc 100644
--- a/src/Network/BitTorrent/Exchange/Protocol.hs
+++ b/src/Network/BitTorrent/Exchange/Protocol.hs
@@ -220,9 +220,9 @@ instance Serialize BlockIx where
   get = BlockIx <$> getInt <*> getInt <*> getInt
   {-# INLINE get #-}
 
-  put ix = do putInt (ixPiece ix)
-              putInt (ixOffset ix)
-              putInt (ixLength ix)
+  put i = do putInt (ixPiece i)
+             putInt (ixOffset i)
+             putInt (ixLength i)
   {-# INLINE put #-}
 
 -- | Format block index in human readable form.
@@ -277,11 +277,11 @@ blockRange pieceSize blk = (offset, offset + len)
 {-# SPECIALIZE blockRange :: Int -> Block -> (Int64, Int64) #-}
 
 ixRange :: (Num a, Integral a) => Int -> BlockIx -> (a, a)
-ixRange pieceSize ix = (offset, offset + len)
+ixRange pieceSize i = (offset, offset + len)
   where
-    offset = fromIntegral  pieceSize * fromIntegral (ixPiece ix)
-           + fromIntegral (ixOffset ix)
-    len    = fromIntegral (ixLength ix)
+    offset = fromIntegral  pieceSize * fromIntegral (ixPiece i)
+           + fromIntegral (ixOffset i)
+    len    = fromIntegral (ixLength i)
 {-# INLINE ixRange #-}
 {-# SPECIALIZE ixRange :: Int -> BlockIx -> (Int64, Int64) #-}
 
@@ -410,8 +410,8 @@ instance Serialize Message where
   put  HaveAll           = putInt 1  >> putWord8 0x0E
   put  HaveNone          = putInt 1  >> putWord8 0x0F
   put (SuggestPiece pix) = putInt 5  >> putWord8 0x0D >> putInt pix
-  put (RejectRequest ix) = putInt 13 >> putWord8 0x10 >> put ix
-  put (AllowedFast   ix) = putInt 5  >> putWord8 0x11 >> putInt ix
+  put (RejectRequest i ) = putInt 13 >> putWord8 0x10 >> put i
+  put (AllowedFast   i ) = putInt 5  >> putWord8 0x11 >> putInt i
 
 
 -- | Format messages in human readable form. Note that output is
@@ -421,9 +421,9 @@ instance Serialize Message where
 ppMessage :: Message -> Doc
 ppMessage (Bitfield _)       = "Bitfield"
 ppMessage (Piece blk)        = "Piece"    <+> ppBlock blk
-ppMessage (Cancel ix)        = "Cancel"   <+> ppBlockIx ix
+ppMessage (Cancel i )        = "Cancel"   <+> ppBlockIx i
 ppMessage (SuggestPiece pix) = "Suggest"  <+> int pix
-ppMessage (RejectRequest ix) = "Reject"   <+> ppBlockIx ix
+ppMessage (RejectRequest i ) = "Reject"   <+> ppBlockIx i
 ppMessage msg = text (show msg)
 
 {-----------------------------------------------------------------------
diff --git a/src/Network/BitTorrent/Internal.hs b/src/Network/BitTorrent/Internal.hs
index a3e1a5cd..0355c147 100644
--- a/src/Network/BitTorrent/Internal.hs
+++ b/src/Network/BitTorrent/Internal.hs
@@ -133,7 +133,8 @@ getCurrentProgress = liftIO . readTVarIO . currentProgress
 newClient :: [Extension] -> IO ClientSession
 newClient exts = do
   mgr <- Ev.new
-  forkIO $ loop mgr
+  -- TODO kill this thread when leave client
+  _   <- forkIO $ loop mgr
 
   ClientSession
     <$> newPeerID
@@ -178,11 +179,8 @@ newLeacher :: ClientSession -> Torrent -> IO SwarmSession
 newLeacher cs t @ Torrent {..}
   = newSwarmSession (haveNone (pieceCount tInfo)) cs t
 
-isLeacher :: SwarmSession -> IO Bool
-isLeacher = undefined
-
-getClientBitfield :: MonadIO m => SwarmSession -> m Bitfield
-getClientBitfield = liftIO . readTVarIO .  clientBitfield
+--isLeacher :: SwarmSession -> IO Bool
+--isLeacher = undefined
 
 {-
 haveDone :: MonadIO m => PieceIx -> SwarmSession -> m ()
@@ -306,7 +304,7 @@ fullBF ::  (MonadReader PeerSession m) => m Bitfield
 fullBF = liftM haveAll getPieceCount
 
 singletonBF :: (MonadReader PeerSession m) => PieceIx -> m Bitfield
-singletonBF ix = liftM (BF.singleton ix) getPieceCount
+singletonBF i = liftM (BF.singleton i) getPieceCount
 
 adjustBF :: (MonadReader PeerSession m) => Bitfield -> m Bitfield
 adjustBF bf = (`adjustSize` bf) `liftM` getPieceCount
diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs
index 11bc52de..c3bce63a 100644
--- a/src/Network/BitTorrent/Tracker.hs
+++ b/src/Network/BitTorrent/Tracker.hs
@@ -188,7 +188,7 @@ withTracker initProgress conn action = bracket start end (action . fst)
         resp <- tryJust isIOException $ do
                     askTracker (regularReq defaultNumWant conn pr)
         case resp of
-          Right (ok @ OK {..}) -> do
+          Right (OK {..}) -> do
             writeIORef seInterval respInterval
             writeList2Chan sePeers respPeers
           _ -> return ()