Misc fixes to http tracker.

[functorrent.git] / src / FuncTorrent / Tracker / Http.hs

diff --git a/src/FuncTorrent/Tracker/Http.hs b/src/FuncTorrent/Tracker/Http.hs
index 840b7583d51a39fbdff0a513a264b26145e75b7f..abb4b32963e8812f25071d63f9bf9a4d00821e94 100644 (file)
--- a/src/FuncTorrent/Tracker/Http.hs
+++ b/src/FuncTorrent/Tracker/Http.hs
@@ -27,7 +27,7 @@ import Prelude hiding (lookup, splitAt)
 
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar)
 
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar)

-import Control.Monad (forever)
+import Control.Monad (forever, void)

 import qualified Data.ByteString.Base16 as B16 (encode)
 import Data.ByteString (ByteString)
 import Data.ByteString.Char8 as BC (pack, unpack, splitAt)
 import qualified Data.ByteString.Base16 as B16 (encode)
 import Data.ByteString (ByteString)
 import Data.ByteString.Char8 as BC (pack, unpack, splitAt)


@@ -85,17 +85,15 @@ trackerLoop url port peerId infohash fschan tstate = forever $ do
       return () -- $ pack (show e)
     Right trackerInfo ->
       case parseTrackerResponse trackerInfo of
       return () -- $ pack (show e)
     Right trackerInfo ->
       case parseTrackerResponse trackerInfo of

-        Left e -> return () -- e
+        Left e -> return ()

         Right tresp -> do
         Right tresp -> do

-          _ <- threadDelay $ fromIntegral (interval tresp)

           ps <- isEmptyMVar $ connectedPeers tstate
           if ps
           ps <- isEmptyMVar $ connectedPeers tstate
           if ps

-            then do
-            _ <- putMVar (connectedPeers tstate) (peers tresp)
-            return ()
-            else do
-            _ <- swapMVar (connectedPeers tstate) (peers tresp)
-            return ()
+            then
+            putMVar (connectedPeers tstate) (peers tresp)
+            else
+            void $ swapMVar (connectedPeers tstate) (peers tresp)
+          threadDelay $ fromIntegral (interval tresp)

 
 parseTrackerResponse :: BVal -> Either ByteString TrackerResponse
 parseTrackerResponse resp =
 
 parseTrackerResponse :: BVal -> Either ByteString TrackerResponse
 parseTrackerResponse resp =