Tracker/Udp.hs: connect and annouce works and gets response

diff --git a/src/FuncTorrent/Tracker/Udp.hs b/src/FuncTorrent/Tracker/Udp.hs
index 7db020281403304f6e7cc92ea7dcefc673f1c481..2060454fb7836872d016dd5a25c737ee6aa7c00c 100644 (file)
--- a/src/FuncTorrent/Tracker/Udp.hs
+++ b/src/FuncTorrent/Tracker/Udp.hs
@@ -27,7 +27,7 @@ import Control.Monad (liftM)
 import Control.Concurrent.MVar (readMVar)
 import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO)
 import Data.Binary (Binary(..), encode, decode)
 import Control.Concurrent.MVar (readMVar)
 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.Binary.Put (putWord16be, putWord64be, putWord32be, putByteString)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Char8 as BC


@@ -93,10 +93,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
     putWord32be 0
     putWord32be 0

-    putWord32be $ fromIntegral (-1)
+    putWord32be 20

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


@@ -106,7 +106,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


@@ -166,7 +166,6 @@ announceRequest :: Word64 -> ByteString -> String -> Word64 -> Word64 -> Word64
 announceRequest cid infohash peerId up down left port = do
   h <- ask
   tidi <- liftIO randomIO
 announceRequest cid infohash peerId up down left port = do
   h <- ask
   tidi <- liftIO randomIO

-  -- connId transId infohash peerId down left up event port)

   let pkt = encode $ AnnounceReq cid tidi infohash peerId down left up None port
   liftIO $ sendRequest h (toStrict pkt)
   return tidi
   let pkt = encode $ AnnounceReq cid tidi infohash peerId down left up None port
   liftIO $ sendRequest h (toStrict pkt)
   return tidi


@@ -226,10 +225,11 @@ trackerLoop url sport peerId infohash fschan tstate = do
   flip runReaderT handle $ do
     t1 <- connectRequest
     cid <- connectResponse t1
   flip runReaderT handle $ do
     t1 <- connectRequest
     cid <- connectResponse t1

-    liftIO $ print "connect response"
+    liftIO $ print "connected: connect id"

     liftIO $ print cid
     t2 <- announceRequest cid infohash peerId (fromIntegral up) (fromIntegral down) (fromIntegral (left tstate)) (fromIntegral sport)
     liftIO $ print "announce request"
     liftIO $ print t2
     liftIO $ print cid
     t2 <- announceRequest cid infohash peerId (fromIntegral up) (fromIntegral down) (fromIntegral (left tstate)) (fromIntegral sport)
     liftIO $ print "announce request"
     liftIO $ print t2

+    liftIO $ print "waiting for announce response"

     stats <- announceResponse t2
     liftIO $ print stats
     stats <- announceResponse t2
     liftIO $ print stats