preparations to introduce Metainfo as an environment

[functorrent.git] / src / FuncTorrent / Peer.hs

diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs
index 5e23fa112574c0ca07f6ddfbde0f36212a932720..a7ce781ae5c5139fc34bb81f1e7f715c34e8e0ce 100644 (file)
--- a/src/FuncTorrent/Peer.hs
+++ b/src/FuncTorrent/Peer.hs
@@ -1,10 +1,11 @@
 {-# LANGUAGE OverloadedStrings #-}
 module FuncTorrent.Peer
     (Peer(..),
-     handlePeerMsgs
+     handlePeerMsgs,
+     bytesDownloaded
     ) where
 
-import Prelude hiding (lookup, concat, replicate, splitAt, take)
+import Prelude hiding (lookup, concat, replicate, splitAt, take, filter)
 
 import System.IO (Handle, BufferMode(..), hSetBuffering)
 import Data.ByteString (ByteString, unpack, concat, hGet, hPut, take, empty)
@@ -13,8 +14,9 @@ import Network (connectTo, PortID(..))
 import Control.Monad.State
 import Data.Bits
 import Data.Word (Word8)
-import Data.Map (Map, fromList, toList, (!), mapWithKey, adjust)
+import Data.Map (Map, fromList, toList, (!), mapWithKey, adjust, filter)
 import qualified Crypto.Hash.SHA1 as SHA1 (hash)
+import Safe (headMay)
 
 import FuncTorrent.Metainfo (Info(..), Metainfo(..))
 import FuncTorrent.Utils (splitN, splitNum)
@@ -31,11 +33,11 @@ data PState = PState { handle :: Handle
 type PeerState = State PState
 
 data PieceDlState = Pending
-                  | InProgress
+                  | Downloading
                   | Have
                   deriving (Show, Eq)
 
--- todo - map with index to a new data structure (peers who have that piece amd state)
+-- todo - map with index to a new data structure (peers who have that piece and state)
 data PieceData = PieceData { peers :: [Peer]        -- ^ list of peers who have this piece
                            , dlstate :: PieceDlState  -- ^ state of the piece from download perspective.
                            , hash  :: ByteString    -- ^ piece hash
@@ -102,13 +104,12 @@ toPeerState h p meCh meIn heCh heIn =
 -- simple algorithm to pick piece.
 -- pick the first piece from 0 that is not downloaded yet.
 pickPiece :: PieceMap -> Maybe Integer
-pickPiece m =
-  let pieceList = toList m
-      allPending = filter (\(_, v) -> dlstate v == Pending) pieceList
-  in
-   case allPending of
-    [] -> Nothing
-    ((i, _):_) -> Just i
+pickPiece =
+  (fst `liftM`) . headMay . toList . filter (\v -> dlstate v == Pending)
+
+bytesDownloaded :: PieceMap -> Integer
+bytesDownloaded =
+  sum . (map (len . snd)) . toList . filter (\v -> dlstate v == Have)
 
 updatePieceAvailability :: PieceMap -> Peer -> [Integer] -> PieceMap
 updatePieceAvailability pieceStatus p pieceList =
@@ -116,8 +117,8 @@ updatePieceAvailability pieceStatus p pieceList =
                        then (pd { peers = p : peers pd })
                        else pd) pieceStatus
 
-handlePeerMsgs :: Peer -> Metainfo -> String -> IO ()
-handlePeerMsgs p m peerId = do
+handlePeerMsgs :: Peer -> String -> Metainfo -> IO ()
+handlePeerMsgs p peerId m = do
   h <- connectToPeer p
   doHandshake h p (infoHash m) peerId
   let pstate = toPeerState h p False False True True
@@ -128,7 +129,7 @@ handlePeerMsgs p m peerId = do
       fileName = name (info m)
       pieceStatus = mkPieceMap numPieces pieceHash (splitNum fileLen pLen)
   createDummyFile fileName (fromIntegral fileLen)
-  (r, _) <- runStateT (msgLoop pieceStatus fileName) pstate
+  _ <- runStateT (msgLoop pieceStatus fileName) pstate
   return ()
 
 msgLoop :: PieceMap -> FilePath -> StateT PState IO ()
@@ -141,7 +142,7 @@ msgLoop pieceStatus file = do
       gets peer >>= (\p -> liftIO $ putStrLn $ "--> InterestedMsg to peer: " ++ show p)
       modify (\st -> st { meInterested = True })
       msgLoop pieceStatus file
-    PState { meInterested = True, heChoking = False } -> do
+    PState { meInterested = True, heChoking = False } ->
       case pickPiece pieceStatus of
         Nothing -> liftIO $ putStrLn "Nothing to download"
         Just workPiece -> do
@@ -181,22 +182,22 @@ msgLoop pieceStatus file = do
 downloadPiece :: Handle -> Integer -> Integer -> IO ByteString
 downloadPiece h index pieceLength = do
   let chunks = splitNum pieceLength 16384
-  liftM concat $ forM (zip [0..] chunks) (\(i, pLen) -> do
-                                             sendMsg h (RequestMsg index (i*pLen) pLen)
-                                             putStrLn $ "--> " ++ "RequestMsg for Piece "
-                                               ++ show index ++ ", part: " ++ show i ++ " of length: "
-                                               ++ show pLen
-                                             msg <- getMsg h
-                                             case msg of
-                                              PieceMsg index begin block -> do
-                                                putStrLn $ " <-- PieceMsg for Piece: "
-                                                  ++ show index
-                                                  ++ ", offset: "
-                                                  ++ show begin
-                                                return block
-                                              _ -> do
-                                                putStrLn "ignoring irrelevant msg"
-                                                return empty)
+  concat `liftM` forM (zip [0..] chunks) (\(i, pLen) -> do
+                                              sendMsg h (RequestMsg index (i*pLen) pLen)
+                                              putStrLn $ "--> " ++ "RequestMsg for Piece "
+                                                ++ show index ++ ", part: " ++ show i ++ " of length: "
+                                                ++ show pLen
+                                              msg <- getMsg h
+                                              case msg of
+                                                PieceMsg index begin block -> do
+                                                  putStrLn $ " <-- PieceMsg for Piece: "
+                                                    ++ show index
+                                                    ++ ", offset: "
+                                                    ++ show begin
+                                                  return block
+                                                _ -> do
+                                                  putStrLn "ignoring irrelevant msg"
+                                                  return empty)
 
 verifyHash :: ByteString -> ByteString -> Bool
 verifyHash bs pieceHash =