refactoring: return type of tracker

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

diff --git a/src/FuncTorrent/Tracker/Udp.hs b/src/FuncTorrent/Tracker/Udp.hs
index 4e541a932b2e17c5c20a8cb20cc48b7065689889..aaa99472b44c3a9d72f955afd0f35a5e8c05d534 100644 (file)
--- a/src/FuncTorrent/Tracker/Udp.hs
+++ b/src/FuncTorrent/Tracker/Udp.hs
@@ -23,24 +23,26 @@ module FuncTorrent.Tracker.Udp
        ) where
 
 import Control.Applicative (liftA2)
        ) where
 
 import Control.Applicative (liftA2)

-import Control.Monad (liftM)
-import Control.Concurrent.MVar (readMVar)
+import Control.Monad (liftM, forever, void)
+import Control.Concurrent (threadDelay)
+import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar)

 import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO)
 import Data.Binary (Binary(..), encode, decode)
 import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO)
 import Data.Binary (Binary(..), encode, decode)

-import Data.Binary.Get (Get, isEmpty, getWord32be, getByteString)
+import Data.Binary.Get (Get, isEmpty, getWord32be, getWord64be, getByteString)

 import Data.Binary.Put (putWord16be, putWord64be, putWord32be, putByteString)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BC
 import Data.ByteString.Lazy (fromStrict, toStrict)
 import Data.Word (Word16, Word32, Word64)
 import Data.Binary.Put (putWord16be, putWord64be, putWord32be, putByteString)
 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.Socket (Socket, Family( AF_INET ), SocketType( Datagram ), defaultProtocol, SockAddr(..), socket, inet_addr, close, getAddrInfo, addrAddress, SockAddr(..))
+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.ByteString (sendTo, recvFrom)
 import System.Random (randomIO)

+import System.Timeout (timeout)

 
 

-import FuncTorrent.Tracker.Types (TrackerEventState(..))
-import FuncTorrent.Utils (IP, Port, toIP, toPort)
+import FuncTorrent.PeerMsgs (Peer(..))
+import FuncTorrent.Tracker.Types (TrackerEventState(..), TState(..), UdpTrackerResponse(..))
+import FuncTorrent.Utils (IP, Port, toIP, toPort, getHostname, getPort)

 import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats)
 import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats)

-import FuncTorrent.Tracker.Types(TState(..))

 
 -- UDP tracker: http://bittorrent.org/beps/bep_0015.html
 data Action = Connect
 
 -- UDP tracker: http://bittorrent.org/beps/bep_0015.html
 data Action = Connect


@@ -54,7 +56,7 @@ data UDPRequest = ConnectReq Word32
                 deriving (Show, Eq)
 
 data UDPResponse = ConnectResp Word32 Word64 -- transaction_id connection_id
                 deriving (Show, Eq)
 
 data UDPResponse = ConnectResp Word32 Word64 -- transaction_id connection_id

-                 | AnnounceResp Word32 Word32 Word32 Word32 [(IP, Port)] -- transaction_id interval leechers seeders [(ip, port)]
+                 | AnnounceResp Word32 Word32 Word32 Word32 [Peer] -- transaction_id interval leechers seeders [(ip, port)]

                  | ScrapeResp Integer Integer Integer Integer
                  | ErrorResp Integer String
                  deriving (Show, Eq)
                  | ScrapeResp Integer Integer Integer Integer
                  | ErrorResp Integer String
                  deriving (Show, Eq)


@@ -94,10 +96,10 @@ instance Binary UDPRequest where
     putWord64be (fromIntegral down)
     putWord64be (fromIntegral left)
     putWord64be (fromIntegral up)
     putWord64be (fromIntegral down)
     putWord64be (fromIntegral left)
     putWord64be (fromIntegral up)

-    putWord32be $ fromIntegral (eventToInteger None)
+    putWord32be $ fromIntegral (eventToInteger event)

     putWord32be 0
     putWord32be 0

-    -- key is optional, we will not send it for now
-    putWord32be $ fromIntegral (-1)
+    putWord32be 0
+    putWord32be 10

     putWord16be $ fromIntegral port
   put (ScrapeReq _ _ _) = undefined
   get = undefined
     putWord16be $ fromIntegral port
   put (ScrapeReq _ _ _) = undefined
   get = undefined


@@ -107,7 +109,7 @@ instance Binary UDPResponse where
   get = do
     a <- getWord32be -- action
     case a of
   get = do
     a <- getWord32be -- action
     case a of

-      0 -> liftA2 ConnectResp (fromIntegral <$> getWord32be) (fromIntegral <$> getWord32be)
+      0 -> liftA2 ConnectResp (fromIntegral <$> getWord32be) (fromIntegral <$> getWord64be)

       1 -> do
         tid <- fromIntegral <$> getWord32be
         interval' <- fromIntegral <$> getWord32be
       1 -> do
         tid <- fromIntegral <$> getWord32be
         interval' <- fromIntegral <$> getWord32be


@@ -161,21 +163,15 @@ connectResponse tid = do
         return 0
     _                      -> return 0
 
         return 0
     _                      -> return 0
 

-announceRequest :: Word64 -> ByteString -> Word64 -> Word64 -> Word64 -> Word16 -> ReaderT UDPTrackerHandle IO Word32
-announceRequest cid infohash up down left port = do
+announceRequest :: Word64 -> ByteString -> String -> Word64 -> Word64 -> Word64 -> Word16 -> ReaderT UDPTrackerHandle IO Word32
+announceRequest cid infohash peerId up down left port = do

   h <- ask
   tidi <- liftIO randomIO
   h <- ask
   tidi <- liftIO randomIO

-  -- connId transId infohash peerId down left up event port)
-  let pkt = encode $ AnnounceReq cid tidi infohash "foo" down left up None port
+  let pkt = encode $ AnnounceReq cid tidi infohash peerId down left up None port

   liftIO $ sendRequest h (toStrict pkt)
   return tidi
 
   liftIO $ sendRequest h (toStrict pkt)
   return tidi
 

-data PeerStats = PeerStats { leechers :: Word32
-                           , seeders :: Word32
-                           , peers :: [(IP, Port)]
-                           } deriving (Show)
-
-announceResponse :: Word32 -> ReaderT UDPTrackerHandle IO PeerStats
+announceResponse :: Word32 -> ReaderT UDPTrackerHandle IO UdpTrackerResponse

 announceResponse tid = do
   h <- ask
   resp <- liftIO $ recvResponse h
 announceResponse tid = do
   h <- ask
   resp <- liftIO $ recvResponse h


@@ -184,45 +180,58 @@ announceResponse tid = do
       if tidr == tid
       then do
         liftIO $ putStrLn "announce succeeded"
       if tidr == tid
       then do
         liftIO $ putStrLn "announce succeeded"

-        return $ PeerStats ls ss xs
+        return $ UdpTrackerResponse ls ss interval xs

       else
       else

-        return $ PeerStats 0 0 []
-    _ -> return $ PeerStats 0 0 []
+        return $ UdpTrackerResponse 0 0 0 []
+    _ -> return $ UdpTrackerResponse 0 0 0 []

 
 

-getIPPortPairs :: Get [(IP, Port)]
+getIPPortPairs :: Get [Peer]

 getIPPortPairs = do
   empty <- isEmpty
   if empty
     then return []
     else do
 getIPPortPairs = do
   empty <- isEmpty
   if empty
     then return []
     else do

-    ip <- toIP <$> getByteString 6
+    ip <- toIP <$> getByteString 4

     port <- toPort <$> getByteString 2
     ipportpairs <- getIPPortPairs
     port <- toPort <$> getByteString 2
     ipportpairs <- getIPPortPairs

-    return $ (ip, port) : ipportpairs
+    return $ (Peer ip port) : ipportpairs

 
 startSession :: String -> Port -> IO UDPTrackerHandle
 startSession host port = do
   s <- socket AF_INET Datagram defaultProtocol
   addrinfos <- getAddrInfo Nothing (Just host) (Just (show port))
   let (SockAddrInet p ip) = addrAddress $ head addrinfos
 
 startSession :: String -> Port -> IO UDPTrackerHandle
 startSession host port = do
   s <- socket AF_INET Datagram defaultProtocol
   addrinfos <- getAddrInfo Nothing (Just host) (Just (show port))
   let (SockAddrInet p ip) = addrAddress $ head addrinfos

-  hostAddr <- inet_addr (show ip)

   putStrLn "connected to tracker"
   putStrLn "connected to tracker"

-  return $ UDPTrackerHandle { sock = s
-                            , addr = (SockAddrInet (fromIntegral port) hostAddr) }
+  return UDPTrackerHandle { sock = s
+                          , addr = (SockAddrInet (fromIntegral port) ip) }

   
 closeSession :: UDPTrackerHandle -> IO ()
 closeSession (UDPTrackerHandle s _ _) = close s
 
 trackerLoop :: String -> Port -> String -> ByteString -> FS.MsgChannel -> TState -> IO ()
   
 closeSession :: UDPTrackerHandle -> IO ()
 closeSession (UDPTrackerHandle s _ _) = close s
 
 trackerLoop :: String -> Port -> String -> ByteString -> FS.MsgChannel -> TState -> IO ()

-trackerLoop host port peerId infohash fschan tstate = do
-  st' <- FS.getStats fschan
-  st <- readMVar st'
-  let up = FS.bytesRead st
-      down = FS.bytesWritten st
-  handle <- startSession host 2710
-  flip runReaderT handle $ do
-    t1 <- connectRequest
-    cid <- connectResponse t1
-    t2 <- announceRequest cid infohash (fromIntegral up) (fromIntegral down) (fromIntegral (left tstate)) (fromIntegral port)
-    stats <- announceResponse t2
-    liftIO $ print stats
+trackerLoop url sport peerId infohash fschan tstate = forever $ do
+  st <- readMVar <$> FS.getStats fschan
+  up <- fmap FS.bytesRead st
+  down <- fmap FS.bytesWritten st
+  handle <- startSession host port
+  stats <- timeout (15*(10^6)) $ worker handle up down
+  case stats of
+    Nothing -> closeSession handle
+    Just stats' -> do
+      ps <- isEmptyMVar $ connectedPeers tstate
+      if ps
+        then
+        putMVar (connectedPeers tstate) (peers stats')
+        else
+        void $ swapMVar (connectedPeers tstate) (peers stats')
+      threadDelay $ fromIntegral (interval stats') * (10^6)
+      return ()
+  where
+    port = getPort url
+    host = getHostname url
+    worker handle up down = flip runReaderT handle $ do
+      t1 <- connectRequest
+      cid <- connectResponse t1
+      t2 <- announceRequest cid infohash peerId (fromIntegral up) (fromIntegral down) (fromIntegral (left tstate)) (fromIntegral sport)
+      stats <- announceResponse t2
+      return stats