refactoring: return type of tracker

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

diff --git a/src/FuncTorrent/Tracker/Http.hs b/src/FuncTorrent/Tracker/Http.hs
index fe1f3e1e55ace932acc4463943ca73def0f0c31c..13395cc72dfc789940646eb3fb5c8f2aae3e6c7f 100644 (file)
--- a/src/FuncTorrent/Tracker/Http.hs
+++ b/src/FuncTorrent/Tracker/Http.hs
@@ -23,16 +23,15 @@ module FuncTorrent.Tracker.Http
        (trackerLoop
        ) where
 
-import Prelude hiding (lookup, splitAt)
+import Prelude hiding (lookup)
 
 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 Data.ByteString.Char8 as BC (pack, unpack)
 import Data.Char (chr)
-import Data.List (intercalate)
 import Data.Map as M (lookup)
 import Network (PortNumber)
 import Network.HTTP.Base (urlEncode)
@@ -41,9 +40,9 @@ import qualified FuncTorrent.Bencode as Benc
 import FuncTorrent.Bencode (BVal(..))
 import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats)
 import FuncTorrent.Network (sendGetRequest)
-import FuncTorrent.Peer (Peer(..))
-import FuncTorrent.Utils (splitN, toIP, toPort, IP, Port)
-import FuncTorrent.Tracker.Types(TState(..), TrackerResponse(..))
+import FuncTorrent.PeerMsgs (makePeer)
+import FuncTorrent.Utils (splitN, IP, Port)
+import FuncTorrent.Tracker.Types(TState(..), HttpTrackerResponse(..))
 
 
 --- | URL encode hash as per RFC1738
@@ -74,30 +73,27 @@ mkArgs port peer_id up down left' infoHash =
    ("event", "started")]
 
 trackerLoop :: String -> PortNumber -> String -> ByteString -> FS.MsgChannel -> TState -> IO ()
-trackerLoop url port peerId infohash fschan tstate = forever $ do
-  st' <- FS.getStats fschan
-  st <- readMVar st'
-  let up = FS.bytesRead st
-      down = FS.bytesWritten st
-  resp <- sendGetRequest url $ mkArgs port peerId up down (left tstate) infohash
+trackerLoop url sport peerId infohash fschan tstate = forever $ do
+  st <- readMVar <$> FS.getStats fschan
+  up <- fmap FS.bytesRead st
+  down <- fmap FS.bytesWritten st
+  resp <- sendGetRequest url $ mkArgs sport peerId up down (left tstate) infohash
   case Benc.decode resp of
-    Left e -> do
+    Left e ->
       return () -- $ pack (show e)
     Right trackerInfo ->
       case parseTrackerResponse trackerInfo of
-        Left e -> return () -- e
+        Left e -> return ()
         Right tresp -> do
-          _ <- threadDelay $ fromIntegral (interval tresp)
           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 :: BVal -> Either ByteString HttpTrackerResponse
 parseTrackerResponse resp =
     case lookup "failure reason" body of
       Just (Bstr err) -> Left err
@@ -106,7 +102,7 @@ parseTrackerResponse resp =
           let (Just (Bint i)) = lookup "interval" body
               (Just (Bstr peersBS)) = lookup "peers" body
               pl = map makePeer (splitN 6 peersBS)
-          in Right TrackerResponse {
+          in Right HttpTrackerResponse {
                    interval = i
                  , peers = pl
                  , complete = Nothing
@@ -115,6 +111,3 @@ parseTrackerResponse resp =
     where
       (Bdict body) = resp
 
-makePeer :: ByteString -> Peer
-makePeer peer = Peer "" (toIP ip') (toPort port')
-  where (ip', port') = splitAt 4 peer