Tracker: refactor the tracker loop code

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

diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs
index 39ed2982f51bed44181ce73fca3eb7217330c4f9..ac99ce288d23b208319abf0972a8c78255b1c0f9 100644 (file)
--- a/src/FuncTorrent/Tracker.hs
+++ b/src/FuncTorrent/Tracker.hs
@@ -38,7 +38,7 @@ import qualified FuncTorrent.Tracker.Udp as UT (trackerLoop)
 import FuncTorrent.Tracker.Types (TState(..), TrackerEventState(..), TrackerProtocol(..), TrackerMsg(..))
 import FuncTorrent.Utils (Port, toPort, getHostname)
 import qualified FuncTorrent.FileSystem as FS (MsgChannel)
 import FuncTorrent.Tracker.Types (TState(..), TrackerEventState(..), TrackerProtocol(..), TrackerMsg(..))
 import FuncTorrent.Utils (Port, toPort, getHostname)
 import qualified FuncTorrent.FileSystem as FS (MsgChannel)

-import FuncTorrent.Peer (Peer)
+import FuncTorrent.PeerMsgs (Peer)

 
 type MsgChannel = Chan TrackerMsg
 
 
 type MsgChannel = Chan TrackerMsg
 


@@ -49,26 +49,23 @@ runTracker :: MsgChannel -> FS.MsgChannel -> ByteString -> PortNumber
            -> String -> [String] -> Integer -> IO ()
 runTracker msgChannel fsChan infohash port peerId announceList sz = do
   ps <- newEmptyMVar
            -> String -> [String] -> Integer -> IO ()
 runTracker msgChannel fsChan infohash port peerId announceList sz = do
   ps <- newEmptyMVar

-  let initialTState = TState { currentState = None
-                             , connectedPeers = ps
-                             , left = sz }
-      turl = head announceList
-      host = getHostname turl
-  case getTrackerType turl of
-    Http -> do
-      _ <- forkIO $ HT.trackerLoop host port peerId infohash fsChan initialTState
-      runStateT (msgHandler msgChannel) initialTState
-      return ()
-    Udp -> do
-      _ <- forkIO $ UT.trackerLoop turl (fromIntegral port) peerId infohash fsChan initialTState
-      return ()
-    _ ->
-      error "Tracker Protocol unimplemented"
+  forkIO $ (getTrackerLoopFn turl) turl port peerId infohash fsChan (initialTState ps)
+  runStateT (msgHandler msgChannel) (initialTState ps)
+  return ()
+    where getTrackerLoopFn turl =
+            case getTrackerType turl of
+              Http -> HT.trackerLoop
+              Udp -> UT.trackerLoop
+              _ -> error "Tracker Protocol unimplemented"
+          initialTState ps' = TState { currentState = None
+                                     , connectedPeers = ps'
+                                     , left = sz }
+          turl = head announceList

 
 getTrackerType :: String -> TrackerProtocol
 getTrackerType url | "http://" `isPrefixOf` url = Http
                    | "udp://" `isPrefixOf` url  = Udp
 
 getTrackerType :: String -> TrackerProtocol
 getTrackerType url | "http://" `isPrefixOf` url = Http
                    | "udp://" `isPrefixOf` url  = Udp

-                   | otherwise                = UnknownProtocol
+                   | otherwise                  = UnknownProtocol

 
 
 msgHandler :: MsgChannel -> StateT TState IO ()
 
 
 msgHandler :: MsgChannel -> StateT TState IO ()