refactor file operations into Fileops module

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

diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs
index 62090175fc193dae18ffb39933834fd107e83c1e..f7ccfcfcee4889bb36c674eff015b9cbc664dd9a 100644 (file)
--- a/src/FuncTorrent/Peer.hs
+++ b/src/FuncTorrent/Peer.hs
@@ -4,10 +4,10 @@ module FuncTorrent.Peer
      handlePeerMsgs
     ) where
 
-import Prelude hiding (lookup, concat, replicate, splitAt, writeFile, take)
+import Prelude hiding (lookup, concat, replicate, splitAt, take)
 
-import System.IO (Handle, BufferMode(..), IOMode(..), SeekMode(..), withFile, hSeek, hSetBuffering)
-import Data.ByteString (ByteString, pack, unpack, concat, hGet, hPut, singleton, writeFile, take, empty)
+import System.IO (Handle, BufferMode(..), hSetBuffering)
+import Data.ByteString (ByteString, pack, unpack, concat, hGet, hPut, singleton, take, empty)
 import Data.ByteString.Lazy (fromStrict, fromChunks, toStrict)
 import qualified Data.ByteString.Char8 as BC (replicate, pack, length)
 import Network (connectTo, PortID(..))
@@ -23,6 +23,7 @@ import qualified Crypto.Hash.SHA1 as SHA1 (hash)
 
 import FuncTorrent.Metainfo (Info(..), Metainfo(..))
 import FuncTorrent.Utils (splitN, splitNum)
+import FuncTorrent.Fileops (createDummyFile, writeFileAtOffset)
 
 type ID = String
 type IP = String
@@ -76,7 +77,7 @@ mkPieceMap numPieces pieceHash pLengths = fromList kvs
                              , hash = h
                              , len = pLen })
               | (i, h, pLen) <- zip3 [0..numPieces] hashes pLengths]
-        hashes = splitN (fromIntegral numPieces) pieceHash
+        hashes = splitN 20 pieceHash
 
 havePiece :: PieceMap -> Integer -> Bool
 havePiece pm index =
@@ -185,42 +186,32 @@ bitfieldToList bs = go bs 0
           in
            setBits ++ go bs' (pos + 1)
 
-createDummyFile :: FilePath -> Int -> IO ()
-createDummyFile path size =
-  writeFile path (BC.replicate size '\0')
-
--- write into a file at a specific offet
-writeFileAtOffset :: FilePath -> Integer -> ByteString -> IO ()
-writeFileAtOffset path offset block =
-  withFile path ReadWriteMode $ (\h -> do
-                                 _ <- hSeek h AbsoluteSeek offset
-                                 hPut h block)
-
 -- recvMsg :: Peer -> Handle -> Msg
 msgLoop :: PeerState -> PieceMap -> IO ()
-msgLoop pState pieceStatus | meInterested pState == False &&
-                            heChoking pState == True = do
-                              -- if me NOT Interested and she is Choking, tell her that
-                              -- I am interested.
-                              let h = handle pState
-                              sendMsg h InterestedMsg
-                              putStrLn $ "--> InterestedMsg to peer: " ++ show (peer pState)
-                              msgLoop (pState { meInterested = True }) pieceStatus
-                          | meInterested pState == True &&
-                            heChoking pState == False =
+msgLoop pState pieceStatus | not (meInterested pState) && heChoking pState = do
+                               -- if me NOT Interested and she is Choking, tell her that
+                               -- I am interested.
+                               let h = handle pState
+                               sendMsg h InterestedMsg
+                               putStrLn $ "--> InterestedMsg to peer: " ++ show (peer pState)
+                               msgLoop (pState { meInterested = True }) pieceStatus
+                          | meInterested pState && not (heChoking pState) =
                               -- if me Interested and she not Choking, send her a request
                               -- for a piece.
                               case pickPiece pieceStatus of
                                Nothing -> putStrLn "Nothing to download"
                                Just workPiece -> do
                                  let pLen = len (pieceStatus ! workPiece)
+                                 putStrLn $ "piece length = " ++ show pLen
                                  pBS <- downloadPiece (handle pState) workPiece pLen
-                                 -- if not $ verifyHash pBS (hash (pieceStatus ! workPiece))
-                                 --  then
-                                 --  putStrLn $ "Hash mismatch: " ++ show (hash (pieceStatus ! workPiece)) ++ " vs " ++ show (take 20 (SHA1.hash pBS))
-                                 --  else do
-                                 writeFileAtOffset "/tmp/download.file" (workPiece * pLen) pBS
-                                 msgLoop pState (adjust (\pieceData -> pieceData { state = Have }) workPiece pieceStatus)
+                                 if not $ verifyHash pBS (hash (pieceStatus ! workPiece))
+                                   then
+                                   putStrLn $ "Hash mismatch: " ++ show (hash (pieceStatus ! workPiece)) ++ " vs " ++ show (take 20 (SHA1.hash pBS))
+                                   else do
+                                   let fileOffset = if workPiece == 0 then 0 else workPiece * len (pieceStatus ! (workPiece - 1))
+                                   putStrLn $ "Write into file at offset: " ++ show fileOffset
+                                   writeFileAtOffset "/tmp/download.file" fileOffset pBS
+                                   msgLoop pState (adjust (\pieceData -> pieceData { state = Have }) workPiece pieceStatus)
                           | otherwise = do
                               msg <- getMsg (handle pState)
                               putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer pState)
@@ -237,9 +228,9 @@ msgLoop pState pieceStatus | meInterested pState == False &&
                                  -- map with pieceIndex as the key and modify the value to add the peer.
                                  -- download each of the piece in order
                                  msgLoop pState pieceStatus'
-                               UnChokeMsg -> do
+                               UnChokeMsg ->
                                  msgLoop (pState { heChoking = False }) pieceStatus
-                               _ -> do
+                               _ ->
                                  msgLoop pState pieceStatus
 
 -- simple algorithm to pick piece.
@@ -256,7 +247,7 @@ pickPiece m =
 updatePieceAvailability :: PieceMap -> Peer -> [Integer] -> PieceMap
 updatePieceAvailability pieceStatus p pieceList =
   mapWithKey (\k pd -> if k `elem` pieceList
-                       then (pd { peers = p : (peers pd) })
+                       then (pd { peers = p : peers pd })
                        else pd) pieceStatus
 
 handlePeerMsgs :: Peer -> Metainfo -> String -> IO ()
@@ -282,7 +273,7 @@ downloadPiece h index pieceLength = do
   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 index ++ ", part: " ++ show i ++ " of length: "
                                                ++ show pLen
                                              msg <- getMsg h
                                              case msg of