summaryrefslogtreecommitdiff
path: root/bittorrent/src/Network/BitTorrent/Client/Handle.hs
diff options
context:
space:
mode:
Diffstat (limited to 'bittorrent/src/Network/BitTorrent/Client/Handle.hs')
-rw-r--r--bittorrent/src/Network/BitTorrent/Client/Handle.hs188
1 files changed, 0 insertions, 188 deletions
diff --git a/bittorrent/src/Network/BitTorrent/Client/Handle.hs b/bittorrent/src/Network/BitTorrent/Client/Handle.hs
deleted file mode 100644
index 66baac48..00000000
--- a/bittorrent/src/Network/BitTorrent/Client/Handle.hs
+++ /dev/null
@@ -1,188 +0,0 @@
1module Network.BitTorrent.Client.Handle
2 ( -- * Handle
3 Handle
4
5 -- * Initialization
6 , openTorrent
7 , openMagnet
8 , closeHandle
9
10 -- * Control
11 , start
12 , pause
13 , stop
14
15 -- * Query
16 , getHandle
17 , getStatus
18 ) where
19
20import Control.Concurrent.Chan.Split
21import Control.Concurrent.Lifted as L
22import Control.Monad
23import Control.Monad.Trans
24import Data.Default
25import Data.List as L
26import Data.HashMap.Strict as HM
27
28import Data.Torrent
29import Network.BitTorrent.Client.Types as Types
30import Network.BitTorrent.DHT as DHT
31import Network.BitTorrent.Exchange as Exchange
32import Network.BitTorrent.Tracker as Tracker
33
34{-----------------------------------------------------------------------
35-- Safe handle set manupulation
36-----------------------------------------------------------------------}
37
38allocHandle :: InfoHash -> BitTorrent Handle -> BitTorrent Handle
39allocHandle ih m = do
40 Client {..} <- getClient
41
42 (h, added) <- modifyMVar clientTorrents $ \ handles -> do
43 case HM.lookup ih handles of
44 Just h -> return (handles, (h, False))
45 Nothing -> do
46 h <- m
47 return (HM.insert ih h handles, (h, True))
48
49 when added $ do
50 liftIO $ send clientEvents (TorrentAdded ih)
51
52 return h
53
54freeHandle :: InfoHash -> BitTorrent () -> BitTorrent ()
55freeHandle ih finalizer = do
56 Client {..} <- getClient
57
58 modifyMVar_ clientTorrents $ \ handles -> do
59 case HM.lookup ih handles of
60 Nothing -> return handles
61 Just _ -> do
62 finalizer
63 return (HM.delete ih handles)
64
65lookupHandle :: InfoHash -> BitTorrent (Maybe Handle)
66lookupHandle ih = do
67 Client {..} <- getClient
68 handles <- readMVar clientTorrents
69 return (HM.lookup ih handles)
70
71{-----------------------------------------------------------------------
72-- Initialization
73-----------------------------------------------------------------------}
74
75newExchangeSession :: FilePath -> Either InfoHash InfoDict -> BitTorrent Exchange.Session
76newExchangeSession rootPath source = do
77 c @ Client {..} <- getClient
78 liftIO $ Exchange.newSession clientLogger (externalAddr c) rootPath source
79
80-- | Open a torrent in 'stop'ed state. Use 'nullTorrent' to open
81-- handle from 'InfoDict'. This operation do not block.
82openTorrent :: FilePath -> Torrent -> BitTorrent Handle
83openTorrent rootPath t @ Torrent {..} = do
84 let ih = idInfoHash tInfoDict
85 allocHandle ih $ do
86 statusVar <- newMVar Types.Stopped
87 tses <- liftIO $ Tracker.newSession ih (trackerList t)
88 eses <- newExchangeSession rootPath (Right tInfoDict)
89 eventStream <- liftIO newSendPort
90 return $ Handle
91 { handleTopic = ih
92 , handlePrivate = idPrivate tInfoDict
93 , handleStatus = statusVar
94 , handleTrackers = tses
95 , handleExchange = eses
96 , handleEvents = eventStream
97 }
98
99-- | Use 'nullMagnet' to open handle from 'InfoHash'.
100openMagnet :: FilePath -> Magnet -> BitTorrent Handle
101openMagnet rootPath Magnet {..} = do
102 allocHandle exactTopic $ do
103 statusVar <- newMVar Types.Stopped
104 tses <- liftIO $ Tracker.newSession exactTopic def
105 eses <- newExchangeSession rootPath (Left exactTopic)
106 eventStream <- liftIO newSendPort
107 return $ Handle
108 { handleTopic = exactTopic
109 , handlePrivate = False
110 , handleStatus = statusVar
111 , handleTrackers = tses
112 , handleExchange = eses
113 , handleEvents = eventStream
114 }
115
116-- | Stop torrent and destroy all sessions. You don't need to close
117-- handles at application exit, all handles will be automatically
118-- closed at 'Network.BitTorrent.Client.closeClient'. This operation
119-- may block.
120closeHandle :: Handle -> BitTorrent ()
121closeHandle h @ Handle {..} = do
122 freeHandle handleTopic $ do
123 Client {..} <- getClient
124 stop h
125 liftIO $ Exchange.closeSession handleExchange
126 liftIO $ Tracker.closeSession trackerManager handleTrackers
127
128{-----------------------------------------------------------------------
129-- Control
130-----------------------------------------------------------------------}
131
132modifyStatus :: HandleStatus -> Handle -> (HandleStatus -> BitTorrent ()) -> BitTorrent ()
133modifyStatus targetStatus Handle {..} targetAction = do
134 modifyMVar_ handleStatus $ \ actualStatus -> do
135 unless (actualStatus == targetStatus) $ do
136 targetAction actualStatus
137 return targetStatus
138 liftIO $ send handleEvents (StatusChanged targetStatus)
139
140-- | Start downloading, uploading and announcing this torrent.
141--
142-- This operation is blocking, use
143-- 'Control.Concurrent.Async.Lifted.async' if needed.
144start :: Handle -> BitTorrent ()
145start h @ Handle {..} = do
146 modifyStatus Types.Running h $ \ status -> do
147 case status of
148 Types.Running -> return ()
149 Types.Stopped -> do
150 Client {..} <- getClient
151 liftIO $ Tracker.notify trackerManager handleTrackers Tracker.Started
152 unless handlePrivate $ do
153 liftDHT $ DHT.insert handleTopic (error "start")
154 liftIO $ do
155 peers <- askPeers trackerManager handleTrackers
156 print $ "got: " ++ show (L.length peers) ++ " peers"
157 forM_ peers $ \ peer -> do
158 Exchange.connect peer handleExchange
159
160-- | Stop downloading this torrent.
161pause :: Handle -> BitTorrent ()
162pause _ = return ()
163
164-- | Stop downloading, uploading and announcing this torrent.
165stop :: Handle -> BitTorrent ()
166stop h @ Handle {..} = do
167 modifyStatus Types.Stopped h $ \ status -> do
168 case status of
169 Types.Stopped -> return ()
170 Types.Running -> do
171 Client {..} <- getClient
172 unless handlePrivate $ do
173 liftDHT $ DHT.delete handleTopic (error "stop")
174 liftIO $ Tracker.notify trackerManager handleTrackers Tracker.Stopped
175
176{-----------------------------------------------------------------------
177-- Query
178-----------------------------------------------------------------------}
179
180getHandle :: InfoHash -> BitTorrent Handle
181getHandle ih = do
182 mhandle <- lookupHandle ih
183 case mhandle of
184 Nothing -> error "should we throw some exception?"
185 Just h -> return h
186
187getStatus :: Handle -> IO HandleStatus
188getStatus Handle {..} = readMVar handleStatus
generated by cgit v1.2.3 (git 2.39.1) at 2024-11-11 13:48:52 +0000