WIP: udp tracker: get the peer ip, port pairs

diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs
index 7e64f82a4836ab8db13a832a5c7703a9db5593ce..f995f1be3d6e04663399a602ef72e3a177b596ee 100644 (file)
--- a/src/FuncTorrent/Tracker.hs
+++ b/src/FuncTorrent/Tracker.hs
@@ -12,7 +12,7 @@ import Control.Concurrent (threadDelay)
 import Control.Concurrent.MVar (MVar, newEmptyMVar, newMVar, readMVar, putMVar)
 import Data.Binary (Binary(..))
 import Data.Binary.Put (putWord16be, putWord32be, putWord64be, putByteString)
-import Data.Binary.Get (getWord16be, getWord32be)
+import Data.Binary.Get (Get, isEmpty, getByteString, getWord16be, getWord32be)
 import Data.ByteString (ByteString)
 import Data.ByteString.Char8 as BC (pack, unpack, splitAt)
 import Data.Char (chr)
@@ -56,13 +56,16 @@ data Action = Connect
             | Scrape
             deriving (Show, Eq)
 
+type IP = String
+type Port = Integer
+
 data UDPRequest = ConnectReq Integer
                 | AnnounceReq Integer Integer ByteString String Integer Integer Integer TrackerEventState Integer
                 | ScrapeReq Integer Integer ByteString
                 deriving (Show, Eq)
 
-data UDPResponse = ConnectResp Integer Integer
-                 | AnnounceResp Integer Integer Integer Integer Integer Integer
+data UDPResponse = ConnectResp Integer Integer -- transaction_id connection_id
+                 | AnnounceResp Integer Integer Integer Integer [(IP, Port)] -- transaction_id interval leechers seeders [(ip, port)]
                  | ScrapeResp Integer Integer Integer Integer
                  deriving (Show, Eq)
 
@@ -115,9 +118,8 @@ instance Binary UDPResponse where
         interval' <- fromIntegral <$> getWord32be
         _ <- getWord32be -- leechers
         _ <- getWord32be -- seeders
-        _ <- getWord32be -- ip
-        _ <- getWord16be -- port
-        return $ AnnounceResp tid interval' 0 0 0 0
+        ipportpairs <- getIPPortPairs -- [(ip, port)]
+        return $ AnnounceResp tid interval' 0 0 ipportpairs
       2 -> do
         tid <- fromIntegral <$> getWord32be
         _ <- getWord32be
@@ -126,6 +128,17 @@ instance Binary UDPResponse where
         return $ ScrapeResp tid 0 0 0
       _ -> error ("unknown response action type: " ++ show a)
 
+getIPPortPairs :: Get [(IP, Port)]
+getIPPortPairs = do
+  empty <- isEmpty
+  if empty
+    then return []
+    else do
+    ip <- toIP <$> getByteString 6
+    port <- toPort <$> getByteString 2
+    ipportpairs <- getIPPortPairs
+    return $ (ip, port) : ipportpairs
+
 initialTrackerState :: Integer -> IO TState
 initialTrackerState sz = do
   ps <- newEmptyMVar
@@ -156,20 +169,20 @@ mkTrackerResponse resp =
     where
       (Bdict body) = resp
 
-      toInt :: String -> Integer
-      toInt = read
+toInt :: String -> Integer
+toInt = read
 
-      toPort :: ByteString -> Integer
-      toPort = read . ("0x" ++) . unpack . B16.encode
+makePeer :: ByteString -> Peer
+makePeer peer = Peer "" (toIP ip') (toPort port')
+  where (ip', port') = splitAt 4 peer
 
-      toIP :: ByteString -> String
-      toIP = Data.List.intercalate "." .
-             map (show . toInt . ("0x" ++) . unpack) .
-                 splitN 2 . B16.encode
+toPort :: ByteString -> Port
+toPort = read . ("0x" ++) . unpack . B16.encode
 
-      makePeer :: ByteString -> Peer
-      makePeer peer = Peer "" (toIP ip') (toPort port')
-          where (ip', port') = splitAt 4 peer
+toIP :: ByteString -> IP
+toIP = Data.List.intercalate "." .
+       map (show . toInt . ("0x" ++) . unpack) .
+       splitN 2 . B16.encode
 
 --- | URL encode hash as per RFC1738
 --- TODO: Add tests