summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent/Client.hs43
-rw-r--r--src/Network/BitTorrent/Client/Handle.hs13
-rw-r--r--src/Network/BitTorrent/Client/Types.hs9
-rw-r--r--src/Network/BitTorrent/Core/PeerAddr.hs4
-rw-r--r--src/Network/BitTorrent/Exchange.hs24
-rw-r--r--src/Network/BitTorrent/Exchange/Manager.hs55
-rw-r--r--src/Network/BitTorrent/Exchange/Session.hs57
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
28 , openTorrent 28 , openTorrent
29 , openMagnet 29 , openMagnet
30 , closeHandle 30 , closeHandle
31
32 , start
33 , pause
34 , stop
31 ) where 35 ) where
32 36
33import Control.Exception 37import Control.Exception
@@ -40,12 +44,13 @@ import Data.Maybe
40import Data.Text 44import Data.Text
41import Network 45import Network
42 46
43import Network.BitTorrent.Client.Types 47import Network.BitTorrent.Client.Types
44import Network.BitTorrent.Client.Handle 48import Network.BitTorrent.Client.Handle
45import Network.BitTorrent.Core 49import Network.BitTorrent.Core
46import Network.BitTorrent.DHT 50import Network.BitTorrent.DHT
47import Network.BitTorrent.Tracker as Tracker hiding (Options) 51import Network.BitTorrent.Tracker as Tracker hiding (Options)
48import Network.BitTorrent.Exchange.Message 52import Network.BitTorrent.Exchange as Exchange hiding (Options)
53import qualified Network.BitTorrent.Exchange as Exchange (Options(..))
49 54
50 55
51data Options = Options 56data Options = Options
@@ -67,30 +72,40 @@ instance Default Options where
67 , optBootNode = Nothing 72 , optBootNode = Nothing
68 } 73 }
69 74
75exchangeOptions :: PeerId -> Options -> Exchange.Options
76exchangeOptions pid Options {..} = Exchange.Options
77 { optPeerAddr = PeerAddr (Just pid) (peerHost def) optPort
78 , optBacklog = optBacklog def
79 }
80
81--connHandler :: HashMap InfoHash Handle -> Handler
82connHandler tmap = undefined
83
70newClient :: Options -> LogFun -> IO Client 84newClient :: Options -> LogFun -> IO Client
71newClient Options {..} logger = do 85newClient opts @ Options {..} logger = do
72 pid <- genPeerId 86 pid <- genPeerId
73 ts <- newMVar HM.empty 87 tmap <- newMVar HM.empty
74 let peerInfo = PeerInfo pid Nothing optPort 88 tmgr <- Tracker.newManager def (PeerInfo pid Nothing optPort)
75 mgr <- Tracker.newManager def peerInfo 89 emgr <- Exchange.newManager (exchangeOptions pid opts) connHandler
76 node <- runResourceT $ do 90 node <- runResourceT $ do
77 node <- startNode handlers def optNodeAddr logger 91 node <- startNode handlers def optNodeAddr logger
78 runDHT node $ bootstrap (maybeToList optBootNode) 92 runDHT node $ bootstrap (maybeToList optBootNode)
79 return node 93 return node
80
81 return Client 94 return Client
82 { clientPeerId = pid 95 { clientPeerId = pid
83 , clientListenerPort = optPort 96 , clientListenerPort = optPort
84 , allowedExtensions = toCaps optExtensions 97 , allowedExtensions = toCaps optExtensions
85 , trackerManager = mgr 98 , trackerManager = tmgr
99 , exchangeManager = emgr
86 , clientNode = node 100 , clientNode = node
87 , clientTorrents = ts 101 , clientTorrents = tmap
88 , clientLogger = logger 102 , clientLogger = logger
89 } 103 }
90 104
91closeClient :: Client -> IO () 105closeClient :: Client -> IO ()
92closeClient Client {..} = do 106closeClient Client {..} = do
93 Tracker.closeManager trackerManager 107 Exchange.closeManager exchangeManager
108 Tracker.closeManager trackerManager
94 return () 109 return ()
95-- closeNode clientNode 110-- closeNode clientNode
96 111
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
28import Data.Torrent.InfoHash 28import Data.Torrent.InfoHash
29import Data.Torrent.Magnet 29import Data.Torrent.Magnet
30import Network.BitTorrent.Client.Types 30import Network.BitTorrent.Client.Types
31import Network.BitTorrent.DHT as DHT 31import Network.BitTorrent.DHT as DHT
32import Network.BitTorrent.Tracker as Tracker 32import Network.BitTorrent.Exchange as Exchange
33import Network.BitTorrent.Tracker as Tracker
33 34
34{----------------------------------------------------------------------- 35{-----------------------------------------------------------------------
35-- Safe handle set manupulation 36-- Safe handle set manupulation
@@ -74,8 +75,9 @@ openTorrent :: Torrent -> BitTorrent Handle
74openTorrent t @ Torrent {..} = do 75openTorrent t @ Torrent {..} = do
75 let ih = idInfoHash tInfoDict 76 let ih = idInfoHash tInfoDict
76 allocHandle ih $ do 77 allocHandle ih $ do
77 ses <- liftIO (Tracker.newSession ih (trackerList t)) 78 tses <- liftIO $ Tracker.newSession ih (trackerList t)
78 return $ Handle ih (idPrivate tInfoDict) ses 79 eses <- liftIO $ Exchange.newSession undefined undefined undefined
80 return $ Handle ih (idPrivate tInfoDict) tses eses
79 81
80-- | Use 'nullMagnet' to open handle from 'InfoHash'. 82-- | Use 'nullMagnet' to open handle from 'InfoHash'.
81openMagnet :: Magnet -> BitTorrent Handle 83openMagnet :: Magnet -> BitTorrent Handle
@@ -105,6 +107,9 @@ start Handle {..} = do
105 liftIO $ Tracker.notify trackerManager trackers Tracker.Started 107 liftIO $ Tracker.notify trackerManager trackers Tracker.Started
106 unless private $ do 108 unless private $ do
107 liftDHT $ DHT.insert topic undefined 109 liftDHT $ DHT.insert topic undefined
110 peers <- liftIO $ askPeers trackerManager trackers
111 forM_ peers $ \ peer -> do
112 liftIO $ Exchange.insert peer exchange
108 113
109-- | Stop downloading this torrent. 114-- | Stop downloading this torrent.
110pause :: Handle -> BitTorrent () 115pause :: 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
24 24
25import Data.Torrent.InfoHash 25import Data.Torrent.InfoHash
26import Network.BitTorrent.Core 26import Network.BitTorrent.Core
27import Network.BitTorrent.DHT as DHT 27import Network.BitTorrent.DHT as DHT
28import Network.BitTorrent.Tracker as Tracker 28import Network.BitTorrent.Exchange as Exchange
29import Network.BitTorrent.Exchange.Message 29import Network.BitTorrent.Tracker as Tracker
30
31 30
32data Handle = Handle 31data Handle = Handle
33 { topic :: !InfoHash 32 { topic :: !InfoHash
34 , private :: !Bool 33 , private :: !Bool
35 , trackers :: !Tracker.Session 34 , trackers :: !Tracker.Session
35 , exchange :: !Exchange.Session
36 } 36 }
37 37
38data Client = Client 38data Client = Client
@@ -40,6 +40,7 @@ data Client = Client
40 , clientListenerPort :: !PortNumber 40 , clientListenerPort :: !PortNumber
41 , allowedExtensions :: !Caps 41 , allowedExtensions :: !Caps
42 , trackerManager :: !Tracker.Manager 42 , trackerManager :: !Tracker.Manager
43 , exchangeManager :: !Exchange.Manager
43 , clientNode :: !(Node IPv4) 44 , clientNode :: !(Node IPv4)
44 , clientTorrents :: !(MVar (HashMap InfoHash Handle)) 45 , clientTorrents :: !(MVar (HashMap InfoHash Handle))
45 , clientLogger :: !LogFun 46 , 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
240instance Default (PeerAddr IPv4) where 240instance Default (PeerAddr IPv4) where
241 def = "127.0.0.1:6881" 241 def = "127.0.0.1:6881"
242 242
243-- | @127.0.0.1:6881@
244instance Default (PeerAddr IP) where
245 def = IPv4 <$> def
246
243-- | Example: 247-- | Example:
244-- 248--
245-- @peerPort \"127.0.0.1:6881\" == 6881@ 249-- @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 @@
6-- Portability : portable 6-- Portability : portable
7-- 7--
8module Network.BitTorrent.Exchange 8module Network.BitTorrent.Exchange
9 ( 9 ( -- * Options
10 Options (..)
11 , Caps
12 , Extension
13 , toCaps
14
15 -- * Manager
16 , Manager
17 , Handler
18 , newManager
19 , closeManager
20
21 -- * Session
22 , Session
23 , newSession
24 , closeSession
25
26 -- * Session control
27 , insert
10 ) where 28 ) where
29
30import Network.BitTorrent.Exchange.Manager
31import Network.BitTorrent.Exchange.Message
32import 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 @@
1module Network.BitTorrent.Exchange.Manager
2 ( Options (..)
3 , Manager
4 , Handler
5 , newManager
6 , closeManager
7 ) where
8
9import Control.Concurrent
10import Control.Exception hiding (Handler)
11import Control.Monad
12import Data.Default
13import Network.Socket
14
15import Network.BitTorrent.Core
16
17
18data Options = Options
19 { optBacklog :: Int
20 , optPeerAddr :: PeerAddr IP
21 } deriving (Show, Eq)
22
23instance Default Options where
24 def = Options
25 { optBacklog = maxListenQueue
26 , optPeerAddr = def
27 }
28
29data Manager = Manager
30 { listener :: !ThreadId
31 }
32
33type Handler = Socket -> PeerAddr IP -> IO ()
34
35listenIncoming :: Options -> Handler -> IO ()
36listenIncoming Options {..} handler = do
37 bracket (socket AF_INET Stream defaultProtocol) close $ \ sock -> do
38 bind sock (toSockAddr optPeerAddr)
39 listen sock optBacklog
40 forever $ do
41 (conn, addr) <- accept sock
42 case fromSockAddr addr of
43 Nothing -> return ()
44 Just paddr -> do
45 forkIO $ handler conn paddr
46 return ()
47
48newManager :: Options -> Handler -> IO Manager
49newManager opts handler = do
50 tid <- forkIO $ listenIncoming opts handler
51 return (Manager tid)
52
53closeManager :: Manager -> IO ()
54closeManager Manager {..} = do
55 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 @@
1{-# LANGUAGE TemplateHaskell #-} 1{-# LANGUAGE TemplateHaskell #-}
2{-# LANGUAGE DeriveDataTypeable #-} 2{-# LANGUAGE DeriveDataTypeable #-}
3module Network.BitTorrent.Exchange.Session 3module Network.BitTorrent.Exchange.Session
4 ( 4 ( Session
5 , newSession
6 , closeSession
7
8 , Network.BitTorrent.Exchange.Session.insert
5 ) where 9 ) where
6 10
7import Control.Concurrent.STM 11import Control.Concurrent.STM
8import Control.Exception 12import Control.Exception
9import Control.Lens 13import Control.Lens
14import Control.Monad.Reader
15import Control.Monad.State
10import Data.Function 16import Data.Function
11import Data.IORef 17import Data.IORef
18import Data.Map
12import Data.Ord 19import Data.Ord
13import Data.Typeable 20import Data.Typeable
14import Text.PrettyPrint 21import Text.PrettyPrint
@@ -16,8 +23,12 @@ import Text.PrettyPrint
16import Data.Torrent.Bitfield 23import Data.Torrent.Bitfield
17import Data.Torrent.InfoHash 24import Data.Torrent.InfoHash
18import Network.BitTorrent.Core 25import Network.BitTorrent.Core
26import Network.BitTorrent.Exchange.Assembler
27import Network.BitTorrent.Exchange.Block
19import Network.BitTorrent.Exchange.Message 28import Network.BitTorrent.Exchange.Message
20import Network.BitTorrent.Exchange.Status 29import Network.BitTorrent.Exchange.Status
30import Network.BitTorrent.Exchange.Wire
31import System.Torrent.Storage
21 32
22 33
23data ExchangeError 34data ExchangeError
@@ -26,12 +37,45 @@ data ExchangeError
26 | CorruptedPiece PieceIx 37 | CorruptedPiece PieceIx
27 38
28data Session = Session 39data Session = Session
29 { storage :: Storage 40 { peerId :: PeerId
30 , bitfield :: Bitfield 41 , bitfield :: Bitfield
31 , assembler :: Assembler 42 , assembler :: Assembler
32 , peerId :: PeerId 43 , storage :: Storage
44 , unchoked :: [PeerAddr IP]
45 , handler :: Exchange ()
46 , connections :: Map (PeerAddr IP) Connection
33 } 47 }
34 48
49newSession :: PeerAddr IP -> Storage -> Bitfield -> IO Session
50newSession addr st bf = do
51 return Session
52 { peerId = undefined
53 , bitfield = undefined
54 , assembler = undefined
55 , storage = undefined
56 , unchoked = undefined
57 , handler = undefined
58 , connections = undefined
59 }
60
61closeSession :: Session -> IO ()
62closeSession = undefined
63
64insert :: PeerAddr IP -> {- Maybe Socket -> -} Session -> IO ()
65insert addr ses @ Session {..} = do
66 undefined
67-- forkIO $ connectWire hs addr caps (runStateT ses handler)
68
69delete :: PeerAddr IP -> Session -> IO ()
70delete = undefined
71
72deleteAll :: Session -> IO ()
73deleteAll = undefined
74
75{-----------------------------------------------------------------------
76-- Event loop
77-----------------------------------------------------------------------}
78
35type Exchange = StateT Session (ReaderT Connection IO) 79type Exchange = StateT Session (ReaderT Connection IO)
36 80
37--runExchange :: Exchange () -> [PeerAddr] -> IO () 81--runExchange :: Exchange () -> [PeerAddr] -> IO ()
@@ -39,6 +83,9 @@ type Exchange = StateT Session (ReaderT Connection IO)
39-- forM_ peers $ \ peer -> do 83-- forM_ peers $ \ peer -> do
40-- forkIO $ runReaderT (runStateT exchange session ) 84-- forkIO $ runReaderT (runStateT exchange session )
41 85
86data Event = NewMessage (PeerAddr IP) Message
87 | Timeout -- for scheduling
88
42awaitEvent :: Exchange Event 89awaitEvent :: Exchange Event
43awaitEvent = undefined 90awaitEvent = undefined
44 91