refactoring: return type of tracker

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

diff --git a/src/FuncTorrent/Tracker/Http.hs b/src/FuncTorrent/Tracker/Http.hs
index 840b7583d51a39fbdff0a513a264b26145e75b7f..13395cc72dfc789940646eb3fb5c8f2aae3e6c7f 100644 (file)
--- a/src/FuncTorrent/Tracker/Http.hs
+++ b/src/FuncTorrent/Tracker/Http.hs
@@ -23,16 +23,15 @@ module FuncTorrent.Tracker.Http
        (trackerLoop
        ) where
 
        (trackerLoop
        ) where
 

-import Prelude hiding (lookup, splitAt)
+import Prelude hiding (lookup)

 
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar)
 
 import Control.Concurrent (threadDelay)
 import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar)

-import Control.Monad (forever)
+import Control.Monad (forever, void)

 import qualified Data.ByteString.Base16 as B16 (encode)
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Base16 as B16 (encode)
 import Data.ByteString (ByteString)

-import Data.ByteString.Char8 as BC (pack, unpack, splitAt)
+import Data.ByteString.Char8 as BC (pack, unpack)

 import Data.Char (chr)
 import Data.Char (chr)

-import Data.List (intercalate)

 import Data.Map as M (lookup)
 import Network (PortNumber)
 import Network.HTTP.Base (urlEncode)
 import Data.Map as M (lookup)
 import Network (PortNumber)
 import Network.HTTP.Base (urlEncode)


@@ -41,9 +40,9 @@ import qualified FuncTorrent.Bencode as Benc
 import FuncTorrent.Bencode (BVal(..))
 import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats)
 import FuncTorrent.Network (sendGetRequest)
 import FuncTorrent.Bencode (BVal(..))
 import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats)
 import FuncTorrent.Network (sendGetRequest)

-import FuncTorrent.Peer (Peer(..))
-import FuncTorrent.Utils (splitN, toIP, toPort, IP, Port)
-import FuncTorrent.Tracker.Types(TState(..), TrackerResponse(..))
+import FuncTorrent.PeerMsgs (makePeer)
+import FuncTorrent.Utils (splitN, IP, Port)
+import FuncTorrent.Tracker.Types(TState(..), HttpTrackerResponse(..))

 
 
 --- | URL encode hash as per RFC1738
 
 
 --- | URL encode hash as per RFC1738


@@ -74,30 +73,27 @@ mkArgs port peer_id up down left' infoHash =
    ("event", "started")]
 
 trackerLoop :: String -> PortNumber -> String -> ByteString -> FS.MsgChannel -> TState -> IO ()
    ("event", "started")]
 
 trackerLoop :: String -> PortNumber -> String -> ByteString -> FS.MsgChannel -> TState -> IO ()

-trackerLoop url port peerId infohash fschan tstate = forever $ do
-  st' <- FS.getStats fschan
-  st <- readMVar st'
-  let up = FS.bytesRead st
-      down = FS.bytesWritten st
-  resp <- sendGetRequest url $ mkArgs port peerId up down (left tstate) infohash
+trackerLoop url sport peerId infohash fschan tstate = forever $ do
+  st <- readMVar <$> FS.getStats fschan
+  up <- fmap FS.bytesRead st
+  down <- fmap FS.bytesWritten st
+  resp <- sendGetRequest url $ mkArgs sport peerId up down (left tstate) infohash

   case Benc.decode resp of
     Left e ->
       return () -- $ pack (show e)
     Right trackerInfo ->
       case parseTrackerResponse trackerInfo of
   case Benc.decode resp of
     Left e ->
       return () -- $ pack (show e)
     Right trackerInfo ->
       case parseTrackerResponse trackerInfo of

-        Left e -> return () -- e
+        Left e -> return ()

         Right tresp -> do
         Right tresp -> do

-          _ <- threadDelay $ fromIntegral (interval tresp)

           ps <- isEmptyMVar $ connectedPeers tstate
           if ps
           ps <- isEmptyMVar $ connectedPeers tstate
           if ps

-            then do
-            _ <- putMVar (connectedPeers tstate) (peers tresp)
-            return ()
-            else do
-            _ <- swapMVar (connectedPeers tstate) (peers tresp)
-            return ()
+            then
+            putMVar (connectedPeers tstate) (peers tresp)
+            else
+            void $ swapMVar (connectedPeers tstate) (peers tresp)
+          threadDelay $ fromIntegral (interval tresp)

 
 

-parseTrackerResponse :: BVal -> Either ByteString TrackerResponse
+parseTrackerResponse :: BVal -> Either ByteString HttpTrackerResponse

 parseTrackerResponse resp =
     case lookup "failure reason" body of
       Just (Bstr err) -> Left err
 parseTrackerResponse resp =
     case lookup "failure reason" body of
       Just (Bstr err) -> Left err


@@ -106,7 +102,7 @@ parseTrackerResponse resp =
           let (Just (Bint i)) = lookup "interval" body
               (Just (Bstr peersBS)) = lookup "peers" body
               pl = map makePeer (splitN 6 peersBS)
           let (Just (Bint i)) = lookup "interval" body
               (Just (Bstr peersBS)) = lookup "peers" body
               pl = map makePeer (splitN 6 peersBS)

-          in Right TrackerResponse {
+          in Right HttpTrackerResponse {

                    interval = i
                  , peers = pl
                  , complete = Nothing
                    interval = i
                  , peers = pl
                  , complete = Nothing


@@ -115,6 +111,3 @@ parseTrackerResponse resp =
     where
       (Bdict body) = resp
 
     where
       (Bdict body) = resp
 

-makePeer :: ByteString -> Peer
-makePeer peer = Peer "" (toIP ip') (toPort port')
-  where (ip', port') = splitAt 4 peer