The pieceLenth can often be quite big, so we need to split the piece
into smaller blocks of size 16384 bytes. Why 16384? Just an arbit
number. It seem to work okay.
import Data.Binary (Binary(..), decode, encode)
import Data.Binary.Put (putWord32be, putWord16be, putWord8)
import Data.Binary.Get (getWord32be, getWord16be, getWord8, runGet)
import Data.Binary (Binary(..), decode, encode)
import Data.Binary.Put (putWord32be, putWord16be, putWord8)
import Data.Binary.Get (getWord32be, getWord16be, getWord8, runGet)
-import Control.Monad (replicateM, liftM, forever)
+import Control.Monad (replicateM, liftM, forM, forever)
import Control.Applicative ((<$>), liftA3)
import Data.Bits
import Data.Word (Word8)
import Control.Applicative ((<$>), liftA3)
import Data.Bits
import Data.Word (Word8)
-import Data.Map (Map(..), fromList, toList, (!), mapWithKey)
+import Data.Map (Map(..), fromList, toList, (!), mapWithKey, adjust)
import FuncTorrent.Metainfo (Info(..), Metainfo(..))
import FuncTorrent.Metainfo (Info(..), Metainfo(..))
-import FuncTorrent.Utils (splitN)
+import FuncTorrent.Utils (splitN, splitNum)
type ID = String
type IP = String
type ID = String
type IP = String
-- Make the initial Piece map, with the assumption that no peer has the
-- piece and that every piece is pending download.
-- Make the initial Piece map, with the assumption that no peer has the
-- piece and that every piece is pending download.
-mkPieceMap :: Integer -> ByteString -> Integer -> PieceMap
-mkPieceMap numPieces pieceHash pLen = fromList kvs
+mkPieceMap :: Integer -> ByteString -> [Integer] -> PieceMap
+mkPieceMap numPieces pieceHash pLengths = fromList kvs
where kvs = [(i, PieceData { peers = []
, state = Pending
, hash = h
, len = pLen })
where kvs = [(i, PieceData { peers = []
, state = Pending
, hash = h
, len = pLen })
- | (i, h) <- zip [0..numPieces] hashes]
+ | (i, h, pLen) <- zip3 [0..numPieces] hashes pLengths]
hashes = splitN (fromIntegral numPieces) pieceHash
havePiece :: PieceMap -> Integer -> Bool
hashes = splitN (fromIntegral numPieces) pieceHash
havePiece :: PieceMap -> Integer -> Bool
in
setBits ++ go bs' (pos + 1)
in
setBits ++ go bs' (pos + 1)
--- downloadPiece :: Integer -> Handle -> IO ()
-
createDummyFile :: FilePath -> Int -> IO ()
createDummyFile path size =
writeFile path (BC.replicate size '\0')
createDummyFile :: FilePath -> Int -> IO ()
createDummyFile path size =
writeFile path (BC.replicate size '\0')
Nothing -> putStrLn "Nothing to download"
Just workPiece -> do
let pLen = len (pieceStatus ! workPiece)
Nothing -> putStrLn "Nothing to download"
Just workPiece -> do
let pLen = len (pieceStatus ! workPiece)
- sendMsg (handle state) (RequestMsg workPiece 0 pLen)
- putStrLn $ "--> RequestMsg for Piece " ++ (show workPiece) ++ "to peer: " ++ show (peer state)
- msg <- getMsg (handle state)
- putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer state)
- -- msgLoop state pieceStatus
+ pBS <- downloadPiece (handle state) workPiece pLen
+ -- sendMsg (handle state) (RequestMsg workPiece 0 pLen)
+ -- putStrLn $ "--> RequestMsg for Piece " ++ (show workPiece) ++ "to peer: " ++ show (peer state) ++ " of length: " ++ show pLen
+ -- msg <- getMsg (handle state)
+ -- putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer state)
+ msgLoop state (adjust (\pieceData -> pieceData { state = Have }) workPiece pieceStatus)
| otherwise = do
msg <- getMsg (handle state)
putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer state)
| otherwise = do
msg <- getMsg (handle state)
putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show (peer state)
, meChoking = True }
pieceHash = pieces (info m)
numPieces = (toInteger . (`quot` 20) . BC.length) pieceHash
, meChoking = True }
pieceHash = pieces (info m)
numPieces = (toInteger . (`quot` 20) . BC.length) pieceHash
- pLen = pieceLength (info m) :: Integer
- pieceStatus = mkPieceMap numPieces pieceHash pLen
+ pLen = pieceLength (info m)
+ fileLen = lengthInBytes (info m)
+ pieceStatus = mkPieceMap numPieces pieceHash (splitNum fileLen pLen)
msgLoop state pieceStatus
msgLoop state pieceStatus
+downloadPiece :: Handle -> Integer -> Integer -> IO [PeerMsg]
+downloadPiece h index pieceLength = do
+ let chunks = splitNum pieceLength 16384
+ 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
+ -- putStrLn $ "--> RequestMsg for Piece " ++ (show workPiece) ++ "to peer: " ++ show (peer state) ++ " of length: " ++ show pLen
+ getMsg h)
splitN :: Int -> BC.ByteString -> [BC.ByteString]
splitN n bs | BC.null bs = []
| otherwise = BC.take n bs : splitN n (BC.drop n bs)
splitN :: Int -> BC.ByteString -> [BC.ByteString]
splitN n bs | BC.null bs = []
| otherwise = BC.take n bs : splitN n (BC.drop n bs)
+
+splitNum :: Integer -> Integer -> [Integer]
+splitNum n d | n == 0 = []
+ | n < d = [n]
+ | otherwise = d : splitNum (n - d) d