+{-
+ - 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/>
+ -}
+
{-# LANGUAGE OverloadedStrings #-}
+
module FuncTorrent.Peer
- (Peer(..),
- PieceMap,
+ (PieceMap,
handlePeerMsgs
) where
import Prelude hiding (lookup, concat, replicate, splitAt, take, drop)
-import Control.Concurrent.Chan (writeChan)
import Control.Monad.State
import Data.ByteString (ByteString, unpack, concat, hGet, hPut, take, drop, empty)
import Data.Bits
import FuncTorrent.PeerMsgs (Peer(..), PeerMsg(..), sendMsg, getMsg, genHandshakeMsg)
import FuncTorrent.Utils (splitNum, verifyHash)
import FuncTorrent.PieceManager (PieceDlState(..), PieceData(..), PieceMap, pickPiece, updatePieceAvailability)
-import qualified FuncTorrent.FileSystem as FS (MsgChannel, Msg(..), Piece(..))
+import qualified FuncTorrent.FileSystem as FS (MsgChannel, writePieceToDisk)
data PState = PState { handle :: Handle
, peer :: Peer
dlstate (pm ! index) == Have
connectToPeer :: Peer -> IO Handle
-connectToPeer (Peer _ ip port) = do
+connectToPeer (Peer ip port) = do
h <- connectTo ip (PortNumber (fromIntegral port))
hSetBuffering h LineBuffering
return h
liftIO $ putStrLn "Hash mismatch"
else do
liftIO $ putStrLn $ "Write piece: " ++ show workPiece
- liftIO $ writeChan msgchannel $ FS.WritePiece (FS.Piece workPiece pBS)
+ liftIO $ FS.writePieceToDisk msgchannel workPiece pBS
msgLoop (adjust (\pieceData -> pieceData { dlstate = Have }) workPiece pieceStatus) msgchannel
_ -> do
msg <- liftIO $ getMsg h
- gets peer >>= (\p -> liftIO $ putStrLn $ "<-- " ++ show msg ++ "from peer: " ++ show p)
+ gets peer >>= (\p -> liftIO $ putStrLn $ "<-- " ++ show msg ++ " from peer: " ++ show p)
case msg of
KeepAliveMsg -> do
liftIO $ sendMsg h KeepAliveMsg
msgLoop pieceStatus msgchannel
PortMsg _ ->
msgLoop pieceStatus msgchannel
- -- handle RequestMsg, HaveMsg. No need to handle PieceMsg here.
- -- also BitFieldMsg
+ HaveMsg idx -> do
+ p <- gets peer
+ let pieceStatus' = updatePieceAvailability pieceStatus p [idx]
+ msgLoop pieceStatus' msgchannel
+ _ -> do
+ liftIO $ putStrLn $ ".. not doing anything with the msg"
+ msgLoop pieceStatus msgchannel
+ -- No need to handle PieceMsg and RequestMsg here.
downloadPiece :: Handle -> Integer -> Integer -> IO ByteString