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
            -> 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
 
 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 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)
 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
 
 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
 trackerLoop url sport peerId infohash fschan tstate = forever $ do
   st <- readMVar <$> FS.getStats fschan
   up <- fmap FS.bytesRead st