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 8090feb99ea868eb328dc1811332b550984e277c..ac99ce288d23b208319abf0972a8c78255b1c0f9 100644 (file)
--- a/src/FuncTorrent/Tracker.hs
+++ b/src/FuncTorrent/Tracker.hs
@@ -49,22 +49,18 @@ runTracker :: MsgChannel -> FS.MsgChannel -> ByteString -> PortNumber
            -> 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 turl port peerId infohash fsChan initialTState
-      runStateT (msgHandler msgChannel) initialTState
-      return ()
-    Udp -> do
-      _ <- forkIO $ UT.trackerLoop turl (fromIntegral port) peerId infohash fsChan initialTState
-      runStateT (msgHandler msgChannel) 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