Tracker: refactor the tracker loop code

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

diff --git a/src/FuncTorrent/Tracker/Udp.hs b/src/FuncTorrent/Tracker/Udp.hs
index aaa99472b44c3a9d72f955afd0f35a5e8c05d534..dfc1233a03934cd2a0ca36f920cca00016fb0767 100644 (file)
--- a/src/FuncTorrent/Tracker/Udp.hs
+++ b/src/FuncTorrent/Tracker/Udp.hs
@@ -34,6 +34,7 @@ import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BC
 import Data.ByteString.Lazy (fromStrict, toStrict)
 import Data.Word (Word16, Word32, Word64)
+import Network (PortNumber)
 import Network.Socket (Socket, Family( AF_INET ), SocketType( Datagram ), defaultProtocol, SockAddr(..), socket, close, getAddrInfo, addrAddress, SockAddr(..))
 import Network.Socket.ByteString (sendTo, recvFrom)
 import System.Random (randomIO)
@@ -208,7 +209,7 @@ startSession host port = do
 closeSession :: UDPTrackerHandle -> IO ()
 closeSession (UDPTrackerHandle s _ _) = close s
 
-trackerLoop :: String -> Port -> String -> ByteString -> FS.MsgChannel -> TState -> IO ()
+trackerLoop :: String -> PortNumber -> String -> ByteString -> FS.MsgChannel -> TState -> IO ()
 trackerLoop url sport peerId infohash fschan tstate = forever $ do
   st <- readMVar <$> FS.getStats fschan
   up <- fmap FS.bytesRead st