From 920dd0a8eb40ec65f794fd6480835a14066d8a99 Mon Sep 17 00:00:00 2001 From: Sam Truzjan Date: Wed, 12 Feb 2014 19:00:33 +0400 Subject: Initialize exchange session fields --- src/Network/BitTorrent/Client/Handle.hs | 8 ++- src/Network/BitTorrent/Exchange/Session.hs | 92 +++++++++++++++++++++++------- 2 files changed, 77 insertions(+), 23 deletions(-) (limited to 'src/Network/BitTorrent') diff --git a/src/Network/BitTorrent/Client/Handle.hs b/src/Network/BitTorrent/Client/Handle.hs index 39d8393a..7aaaf5aa 100644 --- a/src/Network/BitTorrent/Client/Handle.hs +++ b/src/Network/BitTorrent/Client/Handle.hs @@ -71,12 +71,13 @@ lookupHandle ih = do -- | Open a torrent in 'stop'ed state. Use 'nullTorrent' to open -- handle from 'InfoDict'. This operation do not block. -openTorrent :: Torrent -> BitTorrent Handle -openTorrent t @ Torrent {..} = do +openTorrent :: FilePath -> Torrent -> BitTorrent Handle +openTorrent rootPath t @ Torrent {..} = do let ih = idInfoHash tInfoDict allocHandle ih $ do + c @ Client {..} <- getClient tses <- liftIO $ Tracker.newSession ih (trackerList t) - eses <- liftIO $ Exchange.newSession undefined undefined undefined + eses <- liftIO $ Exchange.newSession (externalAddr c) rootPath tInfoDict return $ Handle ih (idPrivate tInfoDict) tses eses -- | Use 'nullMagnet' to open handle from 'InfoHash'. @@ -91,6 +92,7 @@ closeHandle :: Handle -> BitTorrent () closeHandle h @ Handle {..} = do freeHandle topic $ do stop h + liftIO $ Exchange.closeSession exchange liftIO $ Tracker.closeSession trackers {----------------------------------------------------------------------- diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs index 885dcb13..d798a8c6 100644 --- a/src/Network/BitTorrent/Exchange/Session.hs +++ b/src/Network/BitTorrent/Exchange/Session.hs @@ -8,6 +8,7 @@ module Network.BitTorrent.Exchange.Session , Network.BitTorrent.Exchange.Session.insert ) where +import Control.Applicative import Control.Concurrent import Control.Exception import Control.Lens @@ -15,12 +16,14 @@ import Control.Monad.Reader import Control.Monad.State import Data.Function import Data.IORef -import Data.Map +import Data.Maybe +import Data.Map as M import Data.Ord import Data.Typeable import Text.PrettyPrint -import Data.Torrent.Bitfield +import Data.Torrent (InfoDict (..)) +import Data.Torrent.Bitfield as BF import Data.Torrent.InfoHash import Network.BitTorrent.Core import Network.BitTorrent.Exchange.Assembler @@ -31,13 +34,9 @@ import Network.BitTorrent.Exchange.Wire import System.Torrent.Storage -data ExchangeError - = InvalidPieceIx PieceIx - | InvalidBlock BlockIx - | CorruptedPiece PieceIx - data Session = Session - { tpeerId :: PeerId + { tpeerId :: PeerId + , infohash :: InfoHash , bitfield :: Bitfield , assembler :: Assembler , storage :: Storage @@ -45,25 +44,40 @@ data Session = Session , connections :: MVar (Map (PeerAddr IP) (Connection Session)) } - -newSession :: PeerAddr IP -> Storage -> Bitfield -> IO Session -newSession addr st bf = do +newSession :: PeerAddr (Maybe IP) -- ^ /external/ address of this peer; + -> FilePath -- ^ root directory for content files; + -> InfoDict -- ^ torrent info dictionary; + -> IO Session -- ^ +newSession addr rootPath dict = do + connVar <- newMVar M.empty + store <- openInfoDict ReadWriteEx rootPath dict return Session - { tpeerId = undefined - , bitfield = undefined - , assembler = undefined - , storage = undefined - , unchoked = undefined - , connections = undefined + { tpeerId = fromMaybe (error "newSession: impossible") (peerId addr) + , infohash = idInfoHash dict + , bitfield = BF.haveNone (totalPieces store) + , assembler = error "newSession" + , storage = store + , unchoked = [] + , connections = connVar } closeSession :: Session -> IO () closeSession = undefined -insert :: PeerAddr IP -> {- Maybe Socket -> -} Session -> IO () +insert :: PeerAddr IP + -> {- Maybe Socket + -> -} Session -> IO () insert addr ses @ Session {..} = do - undefined --- forkIO $ connectWire hs addr caps (runStateT ses handler) + forkIO $ do + let caps = def + let ecaps = def + let hs = Handshake def caps infohash tpeerId + connectWire ses hs addr ecaps $ do + conn <- getConnection +-- liftIO $ modifyMVar_ connections $ pure . M.insert addr conn + exchange +-- liftIO $ modifyMVar_ connections $ pure . M.delete addr + return () delete :: PeerAddr IP -> Session -> IO () delete = undefined @@ -74,6 +88,44 @@ deleteAll = undefined {----------------------------------------------------------------------- -- Event loop -----------------------------------------------------------------------} +{- +data ExchangeError + = InvalidRequest BlockIx StorageFailure + | CorruptedPiece PieceIx + +packException :: Exception e => (e -> ExchangeError) -> IO a -> IO a +packException f m = try >>= either (throwIO . f) m + +readBlock :: BlockIx -> Storage -> IO (Block ByteString) +readBlock bix @ BlockIx {..} s = do + p <- packException (InvalidRequest bix) $ do readPiece ixPiece storage + let chunk = BS.take ixLength $ BS.drop ixOffset p + if BS.length chunk == ixLength + then return chunk + else throwIO $ InvalidRequest bix (InvalidSize ixLength) +-} +handleMessage :: Message -> Wire Session () +handleMessage KeepAlive = return () +handleMessage (Status s) = undefined +handleMessage (Available a) = undefined +handleMessage (Transfer msg) = case msg of + Request bix -> do +-- Session {..} <- getSession +-- addr <- getRemoteAddr +-- when (addr `elem` unchoked && ixPiece bix `BF.member` bitfield) $ do +-- blk <- liftIO $ readBlock bix storage +-- sendMsg (Piece blk) + return () + Piece blk -> return () + Cancel bix -> return () +handleMessage (Port n) = undefined +handleMessage (Fast _) = return () +handleMessage (Extended _) = return () + +exchange :: Wire Session () +exchange = do + e <- recvMessage + liftIO $ print e type Exchange = StateT Session (ReaderT (Connection Session) IO) -- cgit v1.2.3