summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent.hs25
-rw-r--r--src/Network/BitTorrent/Internal.lhs30
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
78import Control.Concurrent 82import Control.Concurrent
83import Control.Concurrent.STM
79import Control.Exception 84import Control.Exception
80import Control.Monad 85import Control.Monad
81import Control.Monad.Reader 86import 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.
123addTorrent :: ClientSession -> TorrentLoc -> IO () 129addTorrent :: ClientSession -> TorrentLoc -> IO ()
124addTorrent ClientSession {..} TorrentLoc {..} = do 130addTorrent 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
134removeTorrent :: ClientSession -> TorrentLoc -> IO () 141-- | Unregister torrent and stop all running sessions.
135removeTorrent ClientSession {..} TorrentLoc {..} = undefined 142removeTorrent :: ClientSession -> InfoHash -> IO ()
143removeTorrent ses loc = atomically $ unregisterTorrent ses loc
136 144
145{-
146-- | The same as 'removeTorrrent' torrent, but delete all torrent
147-- content files.
137deleteTorrent :: ClientSession -> TorrentLoc -> IO () 148deleteTorrent :: ClientSession -> TorrentLoc -> IO ()
138deleteTorrent ClientSession {..} TorrentLoc {..} = undefined 149deleteTorrent 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
237TorrentMap is used to keep track all known torrents for the 237TorrentMap 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
258back. 258back.
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
264Client session 280Client 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
377Swarm session 385Swarm session
378------------------------------------------------------------------------ 386------------------------------------------------------------------------
379 387