diff options
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/BitTorrent.hs | 25 | ||||
-rw-r--r-- | src/Network/BitTorrent/Internal.lhs | 30 |
2 files changed, 37 insertions, 18 deletions
diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs index ea6b88bd..5521a825 100644 --- a/src/Network/BitTorrent.hs +++ b/src/Network/BitTorrent.hs | |||
@@ -24,6 +24,10 @@ module Network.BitTorrent | |||
24 | , getPeerCount | 24 | , getPeerCount |
25 | , getSwarmCount | 25 | , getSwarmCount |
26 | 26 | ||
27 | , TorrentLoc(..) | ||
28 | , addTorrent | ||
29 | , removeTorrent | ||
30 | |||
27 | -- ** Swarm | 31 | -- ** Swarm |
28 | , SwarmSession(torrentMeta) | 32 | , SwarmSession(torrentMeta) |
29 | 33 | ||
@@ -76,6 +80,7 @@ module Network.BitTorrent | |||
76 | ) where | 80 | ) where |
77 | 81 | ||
78 | import Control.Concurrent | 82 | import Control.Concurrent |
83 | import Control.Concurrent.STM | ||
79 | import Control.Exception | 84 | import Control.Exception |
80 | import Control.Monad | 85 | import Control.Monad |
81 | import Control.Monad.Reader | 86 | import Control.Monad.Reader |
@@ -119,21 +124,27 @@ discover swarm @ SwarmSession {..} action = {-# SCC discover #-} do | |||
119 | {----------------------------------------------------------------------- | 124 | {----------------------------------------------------------------------- |
120 | Torrent management | 125 | Torrent management |
121 | -----------------------------------------------------------------------} | 126 | -----------------------------------------------------------------------} |
122 | {- | 127 | |
128 | -- | Register torrent and start downloading. | ||
123 | addTorrent :: ClientSession -> TorrentLoc -> IO () | 129 | addTorrent :: ClientSession -> TorrentLoc -> IO () |
124 | addTorrent ClientSession {..} TorrentLoc {..} = do | 130 | addTorrent clientSession loc @ TorrentLoc {..} = do |
125 | torrent <- fromFile metafilePath | 131 | torrent <- registerTorrent loc |
126 | swarm <- newLeecher clientSession torrent | 132 | swarm <- newLeecher clientSession torrent |
127 | storage <- swarm `bindTo` dataDir | 133 | storage <- swarm `bindTo` dataDirPath |
128 | discover swarm $ do | 134 | forkIO $ discover swarm $ do |
129 | liftIO $ putStrLn "connected to peer" | 135 | liftIO $ putStrLn "connected to peer" |
130 | forever $ do | 136 | forever $ do |
131 | liftIO $ putStrLn "from mesage loop" | 137 | liftIO $ putStrLn "from mesage loop" |
132 | exchange storage | 138 | exchange storage |
139 | return () | ||
133 | 140 | ||
134 | removeTorrent :: ClientSession -> TorrentLoc -> IO () | 141 | -- | Unregister torrent and stop all running sessions. |
135 | removeTorrent ClientSession {..} TorrentLoc {..} = undefined | 142 | removeTorrent :: ClientSession -> InfoHash -> IO () |
143 | removeTorrent ses loc = atomically $ unregisterTorrent ses loc | ||
136 | 144 | ||
145 | {- | ||
146 | -- | The same as 'removeTorrrent' torrent, but delete all torrent | ||
147 | -- content files. | ||
137 | deleteTorrent :: ClientSession -> TorrentLoc -> IO () | 148 | deleteTorrent :: ClientSession -> TorrentLoc -> IO () |
138 | deleteTorrent ClientSession {..} TorrentLoc {..} = undefined | 149 | deleteTorrent ClientSession {..} TorrentLoc {..} = undefined |
139 | -} \ No newline at end of file | 150 | -} \ No newline at end of file |
diff --git a/src/Network/BitTorrent/Internal.lhs b/src/Network/BitTorrent/Internal.lhs index f46ca244..e3fe3dac 100644 --- a/src/Network/BitTorrent/Internal.lhs +++ b/src/Network/BitTorrent/Internal.lhs | |||
@@ -231,7 +231,7 @@ To avoid this we keep just *metainfo* about *metainfo*: | |||
231 | > metafilePath :: FilePath | 231 | > metafilePath :: FilePath |
232 | > -- | Full path to directory contating content files associated | 232 | > -- | Full path to directory contating content files associated |
233 | > -- with the metafile. | 233 | > -- with the metafile. |
234 | > , dataPath :: FilePath | 234 | > , dataDirPath :: FilePath |
235 | > } | 235 | > } |
236 | 236 | ||
237 | TorrentMap is used to keep track all known torrents for the | 237 | TorrentMap is used to keep track all known torrents for the |
@@ -258,8 +258,24 @@ validate corresponding piece and only after read and send the block | |||
258 | back. | 258 | back. |
259 | 259 | ||
260 | > -- | Used to check torrent location before register torrent. | 260 | > -- | Used to check torrent location before register torrent. |
261 | > validateTorrent :: TorrentLoc -> IO () | 261 | > validateTorrent :: TorrentLoc -> IO Torrent |
262 | > validateTorrent = error "validateTorrent: not implemented" | 262 | > validateTorrent TorrentLoc {..} = do |
263 | > t <- fromFile metafilePath | ||
264 | > exists <- doesDirectoryExist dataDirPath | ||
265 | > unless exists $ do | ||
266 | > throw undefined | ||
267 | > return t | ||
268 | |||
269 | > registerTorrent :: TVar TorrentMap -> TorrentLoc -> IO (Maybe Torrent) | ||
270 | > registerTorrent ClientSession {..} tl = do | ||
271 | > Torrent {..} <- validateTorrent tl | ||
272 | > atomically $ modifyTVar' torrentMap $ HM.insert tInfoHash tl | ||
273 | > return (Just t) | ||
274 | > | ||
275 | |||
276 | > unregisterTorrent :: TVar TorrentMap -> InfoHash -> IO () | ||
277 | > unregisterTorrent ClientSession {..} ih = do | ||
278 | > modifyTVar' torrentMap $ HM.delete ih | ||
263 | 279 | ||
264 | Client session | 280 | Client session |
265 | ------------------------------------------------------------------------ | 281 | ------------------------------------------------------------------------ |
@@ -366,14 +382,6 @@ and different enabled extensions at the same time. | |||
366 | > <*> newTVarIO (startProgress 0) | 382 | > <*> newTVarIO (startProgress 0) |
367 | > <*> newTVarIO HM.empty | 383 | > <*> newTVarIO HM.empty |
368 | 384 | ||
369 | > registerTorrent :: ClientSession -> InfoHash -> TorrentLoc -> STM () | ||
370 | > registerTorrent ClientSession {..} ih tl = do | ||
371 | > modifyTVar' torrentMap $ HM.insert ih tl | ||
372 | |||
373 | > unregisterTorrent :: ClientSession -> InfoHash -> STM () | ||
374 | > unregisterTorrent ClientSession {..} ih = do | ||
375 | > modifyTVar' torrentMap $ HM.delete ih | ||
376 | |||
377 | Swarm session | 385 | Swarm session |
378 | ------------------------------------------------------------------------ | 386 | ------------------------------------------------------------------------ |
379 | 387 | ||