1 files changed, 72 insertions, 20 deletions

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)