WIP: UDP tracker

diff --git a/src/FuncTorrent/Tracker/Udp.hs b/src/FuncTorrent/Tracker/Udp.hs
new file mode 100644 (file)
index 0000000..aa7bfd5
--- /dev/null
+++ b/src/FuncTorrent/Tracker/Udp.hs
@@ -0,0 +1,175 @@
+{-
+ - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
+ -
+ - This file is part of FuncTorrent.
+ -
+ - FuncTorrent is free software; you can redistribute it and/or modify
+ - it under the terms of the GNU General Public License as published by
+ - the Free Software Foundation; either version 3 of the License, or
+ - (at your option) any later version.
+ -
+ - FuncTorrent is distributed in the hope that it will be useful,
+ - but WITHOUT ANY WARRANTY; without even the implied warranty of
+ - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
+ - GNU General Public License for more details.
+ -
+ - You should have received a copy of the GNU General Public License
+ - along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
+ -}
+
+{-# LANGUAGE OverloadedStrings #-}
+module Functorrent.Tracker.Udp
+       (
+       ) where
+
+import Control.Applicative (liftA2)
+import Control.Monad.Error (ErrorT)
+import Control.Monad.Reader (ReaderT, runReaderT, ask)
+import Data.Binary (Binary(..), encode, decode)
+import Data.Binary.Get (Get, isEmpty, getWord32be, getByteString)
+import Data.Binary.Put (putWord16be, putWord64be, putWord32be, putByteString)
+import Data.ByteString.Char8 as BC
+import Data.ByteString.Lazy (fromStrict)
+import Data.Word (Word32)
+import Network.Socket (Socket, SockAddr, sendTo, recvFrom)
+import System.Random (randomIO)
+
+import FuncTorrent.Tracker.Types (TrackerEventState(..), IP, Port)
+
+-- UDP tracker: http://bittorrent.org/beps/bep_0015.html
+data Action = Connect
+            | Announce
+            | Scrape
+            deriving (Show, Eq)
+
+data UDPRequest = ConnectReq Word32
+                | AnnounceReq Integer Integer ByteString String Integer Integer Integer TrackerEventState Integer
+                | ScrapeReq Integer Integer ByteString
+                deriving (Show, Eq)
+
+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
+                 | ErrorResp Integer String
+                 deriving (Show, Eq)
+
+data UDPTrackerHandle = UDPTrackerHandle { sock :: Socket
+                                         , addr :: SockAddr
+                                         , tid  :: Word32
+                                         }
+
+actionToInteger :: Action -> Integer
+actionToInteger Connect  = 0
+actionToInteger Announce = 1
+actionToInteger Scrape   = 2
+
+intToAction :: Integer -> Action
+intToAction 0 = Connect
+intToAction 1 = Announce
+intToAction 2 = Scrape
+
+eventToInteger :: TrackerEventState -> Integer
+eventToInteger None = 0
+eventToInteger Completed = 1
+eventToInteger Started = 2
+
+instance Binary UDPRequest where
+  put (ConnectReq transId) = do
+    putWord64be 0x41727101980
+    putWord32be $ fromIntegral (actionToInteger Connect)
+    putWord32be (fromIntegral transId)
+  put (AnnounceReq connId transId infohash peerId down left up event port) = do
+    putWord64be $ fromIntegral connId
+    putWord32be $ fromIntegral (actionToInteger Announce)
+    putWord32be $ fromIntegral transId
+    putByteString infohash
+    putByteString (BC.pack peerId)
+    putWord64be (fromIntegral down)
+    putWord64be (fromIntegral left)
+    putWord64be (fromIntegral up)
+    putWord32be $ fromIntegral (eventToInteger None)
+    putWord32be 0
+    -- key is optional, we will not send it for now
+    putWord32be $ fromIntegral (-1)
+    putWord16be $ fromIntegral port
+  put (ScrapeReq _ _ _) = undefined
+  get = undefined
+
+instance Binary UDPResponse where
+  put = undefined
+  get = do
+    a <- getWord32be -- action
+    case a of
+      0 -> liftA2 ConnectResp (fromIntegral <$> getWord32be) (fromIntegral <$> getWord32be)
+      1 -> do
+        tid <- fromIntegral <$> getWord32be
+        interval' <- fromIntegral <$> getWord32be
+        _ <- getWord32be -- leechers
+        _ <- getWord32be -- seeders
+        ipportpairs <- getIPPortPairs -- [(ip, port)]
+        return $ AnnounceResp tid interval' 0 0 ipportpairs
+      2 -> do
+        tid <- fromIntegral <$> getWord32be
+        _ <- getWord32be
+        _ <- getWord32be
+        _ <- getWord32be
+        return $ ScrapeResp tid 0 0 0
+      3 -> do -- error response
+        tid <- fromIntegral <$> getWord32be
+        bs  <- getByteString 4
+        return $ ErrorResp tid $ unpack bs
+      _ -> error ("unknown response action type: " ++ show a)
+
+sendRequest :: UDPTrackerHandle -> UDPRequest -> IO ()
+sendRequest h req = do
+  n <- sendTo (sock h) req (addr h)
+  -- sanity check with n?
+  return ()
+
+recvResponse :: UDPTrackerHandle -> ErrorT String IO UDPResponse
+recvResponse h = do
+  (bs, nbytes, saddr) <- recvFrom (sock h) 20
+  -- check if nbytes is at least 16 bytes long
+  return $ decode $ fromStrict bs
+
+connectRequest :: ReaderT UDPTrackerHandle IO Integer
+connectRequest = do
+  h <- ask
+  let pkt = encode $ ConnectReq (tid h)
+  sendRequest h pkt
+
+connectResponse :: ReaderT UDPTrackerHandle IO Bool
+connectResponse = do
+  h <- ask
+  
+
+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
+
+getResponse :: Socket -> IO UDPResponse
+getResponse s = do
+  -- connect packet is 16 bytes long
+  -- announce packet is atleast 20 bytes long
+  bs <- recv s (16*1024)
+  return $ decode $ fromStrict bs
+
+
+udpTrackerLoop :: PortNumber -> String -> Metainfo -> TState -> IO String
+udpTrackerLoop port peerId m st = do
+  -- h <- connectTo "exodus.desync.com" (PortNumber 6969)
+  s <- socket AF_INET Datagram defaultProtocol
+  hostAddr <- inet_addr "185.37.101.229"
+  putStrLn "connected to tracker"
+  _ <- sendTo s (toStrict $ encode (ConnectReq 42)) (SockAddrInet 2710 hostAddr)
+  putStrLn "--> sent ConnectReq to tracker"
+  resp <- recv s 16
+  putStrLn "<-- recv ConnectResp from tracker"
+  return $ show resp