refactor: remove peerid from Peer datatype

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

diff --git a/src/FuncTorrent/Tracker/Http.hs b/src/FuncTorrent/Tracker/Http.hs
index 0cb36b9e8955ae4ec738ea2ecde6b248c99cf1f4..9edf3fca6691149ed218f012df2a5784b826ef02 100644 (file)
--- a/src/FuncTorrent/Tracker/Http.hs
+++ b/src/FuncTorrent/Tracker/Http.hs
@@ -1,37 +1,37 @@
-{-# LANGUAGE OverloadedStrings #-}

 {-
 {-

-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.
+ - 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/>
+ -}

 
 

-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.Http
        (trackerLoop
        ) where
 
 
 module FuncTorrent.Tracker.Http
        (trackerLoop
        ) where
 

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

 
 import Control.Concurrent (threadDelay)
 
 import Control.Concurrent (threadDelay)

-import Control.Concurrent.MVar (readMVar, putMVar)
-import Control.Monad (forever)
+import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar)
+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)


@@ -40,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)
-import FuncTorrent.Tracker.Types(TState(..), TrackerResponse(..), Port, IP)
+import FuncTorrent.PeerMsgs (makePeer)
+import FuncTorrent.Utils (splitN, IP, Port)
+import FuncTorrent.Tracker.Types(TState(..), TrackerResponse(..))

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


@@ -73,21 +73,25 @@ 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
   case Benc.decode resp of

-    Left e -> return () -- $ pack (show e)
+    Left e ->
+      return () -- $ pack (show e)

     Right trackerInfo ->
       case parseTrackerResponse trackerInfo of
     Right trackerInfo ->
       case parseTrackerResponse trackerInfo of

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

         Right tresp -> do
         Right tresp -> do

-          _ <- threadDelay $ fromIntegral (interval tresp)
-          _ <- putMVar (connectedPeers tstate) (peers tresp)
-          return () -- trackerLoop port peerId st
+          ps <- isEmptyMVar $ connectedPeers tstate
+          if ps
+            then
+            putMVar (connectedPeers tstate) (peers tresp)
+            else
+            void $ swapMVar (connectedPeers tstate) (peers tresp)
+          threadDelay $ fromIntegral (interval tresp)

 
 parseTrackerResponse :: BVal -> Either ByteString TrackerResponse
 parseTrackerResponse resp =
 
 parseTrackerResponse :: BVal -> Either ByteString TrackerResponse
 parseTrackerResponse resp =


@@ -107,17 +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
-
-toPort :: ByteString -> Port
-toPort = read . ("0x" ++) . unpack . B16.encode
-
-toIP :: ByteString -> IP
-toIP = Data.List.intercalate "." .
-       map (show . toInt . ("0x" ++) . unpack) .
-       splitN 2 . B16.encode
-
-toInt :: String -> Integer
-toInt = read