Add exchange manager and session to client session

7 files changed, 177 insertions, 28 deletions

diff --git a/src/Network/BitTorrent/Client.hs b/src/Network/BitTorrent/Client.hs
index d8c3ee91..255c4dec 100644
--- a/src/Network/BitTorrent/Client.hs
+++ b/src/Network/BitTorrent/Client.hs
@@ -28,6 +28,10 @@ module Network.BitTorrent.Client
        , openTorrent
        , openMagnet
        , closeHandle
+
+       , start
+       , pause
+       , stop
        ) where
 
 import Control.Exception
@@ -40,12 +44,13 @@ import Data.Maybe
 import Data.Text
 import Network
 
-import Network.BitTorrent.Client.Types
-import Network.BitTorrent.Client.Handle
-import Network.BitTorrent.Core
-import Network.BitTorrent.DHT
-import Network.BitTorrent.Tracker as Tracker hiding (Options)
-import Network.BitTorrent.Exchange.Message
+import           Network.BitTorrent.Client.Types
+import           Network.BitTorrent.Client.Handle
+import           Network.BitTorrent.Core
+import           Network.BitTorrent.DHT
+import           Network.BitTorrent.Tracker  as Tracker  hiding (Options)
+import           Network.BitTorrent.Exchange as Exchange hiding (Options)
+import qualified Network.BitTorrent.Exchange as Exchange (Options(..))
 
 
 data Options = Options
@@ -67,30 +72,40 @@ instance Default Options where
     , optBootNode    = Nothing
     }
 
+exchangeOptions :: PeerId -> Options -> Exchange.Options
+exchangeOptions pid Options {..} = Exchange.Options
+  { optPeerAddr = PeerAddr (Just pid) (peerHost def) optPort
+  , optBacklog  = optBacklog def
+  }
+
+--connHandler :: HashMap InfoHash Handle -> Handler
+connHandler tmap = undefined
+
 newClient :: Options -> LogFun -> IO Client
-newClient Options {..} logger = do
+newClient opts @ Options {..} logger = do
   pid  <- genPeerId
-  ts   <- newMVar HM.empty
-  let peerInfo = PeerInfo pid Nothing optPort
-  mgr  <- Tracker.newManager def peerInfo
+  tmap <- newMVar HM.empty
+  tmgr <- Tracker.newManager def (PeerInfo pid Nothing optPort)
+  emgr <- Exchange.newManager (exchangeOptions pid opts) connHandler
   node <- runResourceT $ do
     node <- startNode handlers def optNodeAddr logger
     runDHT node $ bootstrap (maybeToList optBootNode)
     return node
-
   return Client
     { clientPeerId       = pid
     , clientListenerPort = optPort
     , allowedExtensions  = toCaps optExtensions
-    , trackerManager     = mgr
+    , trackerManager     = tmgr
+    , exchangeManager    = emgr
     , clientNode         = node
-    , clientTorrents     = ts
+    , clientTorrents     = tmap
     , clientLogger       = logger
     }
 
 closeClient :: Client -> IO ()
 closeClient Client {..} = do
-  Tracker.closeManager trackerManager
+  Exchange.closeManager exchangeManager
+  Tracker.closeManager  trackerManager
   return ()
 --  closeNode clientNode
 
diff --git a/src/Network/BitTorrent/Client/Handle.hs b/src/Network/BitTorrent/Client/Handle.hs
index 467d5745..39d8393a 100644
--- a/src/Network/BitTorrent/Client/Handle.hs
+++ b/src/Network/BitTorrent/Client/Handle.hs
@@ -28,8 +28,9 @@ import Data.Torrent
 import Data.Torrent.InfoHash
 import Data.Torrent.Magnet
 import Network.BitTorrent.Client.Types
-import Network.BitTorrent.DHT     as DHT
-import Network.BitTorrent.Tracker as Tracker
+import Network.BitTorrent.DHT      as DHT
+import Network.BitTorrent.Exchange as Exchange
+import Network.BitTorrent.Tracker  as Tracker
 
 {-----------------------------------------------------------------------
 --  Safe handle set manupulation
@@ -74,8 +75,9 @@ openTorrent :: Torrent -> BitTorrent Handle
 openTorrent t @ Torrent {..} = do
   let ih = idInfoHash tInfoDict
   allocHandle ih $ do
-    ses <- liftIO (Tracker.newSession ih (trackerList t))
-    return $ Handle ih (idPrivate tInfoDict) ses
+    tses <- liftIO $ Tracker.newSession ih (trackerList t)
+    eses <- liftIO $ Exchange.newSession undefined undefined undefined
+    return $ Handle ih (idPrivate tInfoDict) tses eses
 
 -- | Use 'nullMagnet' to open handle from 'InfoHash'.
 openMagnet :: Magnet -> BitTorrent Handle
@@ -105,6 +107,9 @@ start Handle {..} = do
   liftIO $ Tracker.notify trackerManager trackers Tracker.Started
   unless private $ do
     liftDHT $ DHT.insert topic undefined
+  peers <- liftIO $ askPeers trackerManager trackers
+  forM_ peers $ \ peer -> do
+    liftIO $ Exchange.insert peer exchange
 
 -- | Stop downloading this torrent.
 pause :: Handle -> BitTorrent ()
diff --git a/src/Network/BitTorrent/Client/Types.hs b/src/Network/BitTorrent/Client/Types.hs
index 0da24dc2..603142d5 100644
--- a/src/Network/BitTorrent/Client/Types.hs
+++ b/src/Network/BitTorrent/Client/Types.hs
@@ -24,15 +24,15 @@ import System.Log.FastLogger
 
 import Data.Torrent.InfoHash
 import Network.BitTorrent.Core
-import Network.BitTorrent.DHT     as DHT
-import Network.BitTorrent.Tracker as Tracker
-import Network.BitTorrent.Exchange.Message
-
+import Network.BitTorrent.DHT      as DHT
+import Network.BitTorrent.Exchange as Exchange
+import Network.BitTorrent.Tracker  as Tracker
 
 data Handle = Handle
   { topic    :: !InfoHash
   , private  :: !Bool
   , trackers :: !Tracker.Session
+  , exchange :: !Exchange.Session
   }
 
 data Client = Client
@@ -40,6 +40,7 @@ data Client = Client
   , clientListenerPort :: !PortNumber
   , allowedExtensions  :: !Caps
   , trackerManager     :: !Tracker.Manager
+  , exchangeManager    :: !Exchange.Manager
   , clientNode         :: !(Node IPv4)
   , clientTorrents     :: !(MVar (HashMap InfoHash Handle))
   , clientLogger       :: !LogFun
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
index 63885144..b62cb945 100644
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ b/src/Network/BitTorrent/Core/PeerAddr.hs
@@ -240,6 +240,10 @@ instance (Serialize a) => Serialize (PeerAddr a) where
 instance Default (PeerAddr IPv4) where
   def = "127.0.0.1:6881"
 
+-- | @127.0.0.1:6881@
+instance Default (PeerAddr IP) where
+  def = IPv4 <$> def
+
 -- | Example:
 --
 --   @peerPort \"127.0.0.1:6881\" == 6881@
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs
index 934c646d..86e13d58 100644
--- a/src/Network/BitTorrent/Exchange.hs
+++ b/src/Network/BitTorrent/Exchange.hs
@@ -6,5 +6,27 @@
 --   Portability :  portable
 --
 module Network.BitTorrent.Exchange
-       (
+       ( -- * Options
+         Options (..)
+       , Caps
+       , Extension
+       , toCaps
+
+         -- * Manager
+       , Manager
+       , Handler
+       , newManager
+       , closeManager
+
+         -- * Session
+       , Session
+       , newSession
+       , closeSession
+
+         -- * Session control
+       , insert
        ) where
+
+import Network.BitTorrent.Exchange.Manager
+import Network.BitTorrent.Exchange.Message
+import Network.BitTorrent.Exchange.Session
\ No newline at end of file
diff --git a/src/Network/BitTorrent/Exchange/Manager.hs b/src/Network/BitTorrent/Exchange/Manager.hs
new file mode 100644
index 00000000..1ea9989f
--- /dev/null
+++ b/src/Network/BitTorrent/Exchange/Manager.hs
@@ -0,0 +1,55 @@
+module Network.BitTorrent.Exchange.Manager
+       ( Options (..)
+       , Manager
+       , Handler
+       , newManager
+       , closeManager
+       ) where
+
+import Control.Concurrent
+import Control.Exception hiding (Handler)
+import Control.Monad
+import Data.Default
+import Network.Socket
+
+import Network.BitTorrent.Core
+
+
+data Options = Options
+  { optBacklog  :: Int
+  , optPeerAddr :: PeerAddr IP
+  } deriving (Show, Eq)
+
+instance Default Options where
+  def = Options
+    { optBacklog  = maxListenQueue
+    , optPeerAddr = def
+    }
+
+data Manager = Manager
+  { listener :: !ThreadId
+  }
+
+type Handler = Socket -> PeerAddr IP -> IO ()
+
+listenIncoming :: Options -> Handler -> IO ()
+listenIncoming Options {..} handler = do
+  bracket (socket AF_INET Stream defaultProtocol) close $ \ sock -> do
+    bind sock (toSockAddr optPeerAddr)
+    listen sock optBacklog
+    forever $ do
+      (conn, addr) <- accept sock
+      case fromSockAddr addr of
+        Nothing    -> return ()
+        Just paddr -> do
+          forkIO $ handler conn paddr
+          return ()
+
+newManager :: Options -> Handler -> IO Manager
+newManager opts handler = do
+  tid <- forkIO $ listenIncoming opts handler
+  return (Manager tid)
+
+closeManager :: Manager -> IO ()
+closeManager Manager {..} = do
+  killThread listener
\ No newline at end of file
diff --git a/src/Network/BitTorrent/Exchange/Session.hs b/src/Network/BitTorrent/Exchange/Session.hs
index d455ec65..5bfc2a71 100644
--- a/src/Network/BitTorrent/Exchange/Session.hs
+++ b/src/Network/BitTorrent/Exchange/Session.hs
@@ -1,14 +1,21 @@
 {-# LANGUAGE TemplateHaskell    #-}
 {-# LANGUAGE DeriveDataTypeable #-}
 module Network.BitTorrent.Exchange.Session
-       (
+       ( Session
+       , newSession
+       , closeSession
+
+       , Network.BitTorrent.Exchange.Session.insert
        ) where
 
 import Control.Concurrent.STM
 import Control.Exception
 import Control.Lens
+import Control.Monad.Reader
+import Control.Monad.State
 import Data.Function
 import Data.IORef
+import Data.Map
 import Data.Ord
 import Data.Typeable
 import Text.PrettyPrint
@@ -16,8 +23,12 @@ import Text.PrettyPrint
 import Data.Torrent.Bitfield
 import Data.Torrent.InfoHash
 import Network.BitTorrent.Core
+import Network.BitTorrent.Exchange.Assembler
+import Network.BitTorrent.Exchange.Block
 import Network.BitTorrent.Exchange.Message
 import Network.BitTorrent.Exchange.Status
+import Network.BitTorrent.Exchange.Wire
+import System.Torrent.Storage
 
 
 data ExchangeError
@@ -26,12 +37,45 @@ data ExchangeError
   | CorruptedPiece PieceIx
 
 data Session = Session
-  { storage   :: Storage
-  , bitfield  :: Bitfield
-  , assembler :: Assembler
-  , peerId    :: PeerId
+  { peerId      :: PeerId
+  , bitfield    :: Bitfield
+  , assembler   :: Assembler
+  , storage     :: Storage
+  , unchoked    :: [PeerAddr IP]
+  , handler     :: Exchange ()
+  , connections :: Map (PeerAddr IP) Connection
   }
 
+newSession :: PeerAddr IP -> Storage -> Bitfield -> IO Session
+newSession addr st bf = do
+  return Session
+    { peerId      = undefined
+    , bitfield    = undefined
+    , assembler   = undefined
+    , storage     = undefined
+    , unchoked    = undefined
+    , handler     = undefined
+    , connections = undefined
+    }
+
+closeSession :: Session -> IO ()
+closeSession = undefined
+
+insert :: PeerAddr IP -> {- Maybe Socket -> -} Session -> IO ()
+insert addr ses @ Session {..} = do
+  undefined
+--  forkIO $ connectWire hs addr caps (runStateT ses handler)
+
+delete :: PeerAddr IP -> Session -> IO ()
+delete = undefined
+
+deleteAll :: Session -> IO ()
+deleteAll = undefined
+
+{-----------------------------------------------------------------------
+--  Event loop
+-----------------------------------------------------------------------}
+
 type Exchange = StateT Session (ReaderT Connection IO)
 
 --runExchange :: Exchange () -> [PeerAddr] -> IO ()
@@ -39,6 +83,9 @@ type Exchange = StateT Session (ReaderT Connection IO)
 --  forM_ peers $ \ peer -> do
 --    forkIO $ runReaderT (runStateT exchange session )
 
+data Event = NewMessage (PeerAddr IP) Message
+           | Timeout -- for scheduling
+
 awaitEvent :: Exchange Event
 awaitEvent = undefined