diff options
Diffstat (limited to 'src/Network/BitTorrent/Client/Handle.hs')
-rw-r--r-- | src/Network/BitTorrent/Client/Handle.hs | 138 |
1 files changed, 138 insertions, 0 deletions
diff --git a/src/Network/BitTorrent/Client/Handle.hs b/src/Network/BitTorrent/Client/Handle.hs new file mode 100644 index 00000000..467d5745 --- /dev/null +++ b/src/Network/BitTorrent/Client/Handle.hs | |||
@@ -0,0 +1,138 @@ | |||
1 | module 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 | , HandleState | ||
18 | , getState | ||
19 | ) where | ||
20 | |||
21 | import Control.Applicative | ||
22 | import Control.Concurrent | ||
23 | import Control.Monad | ||
24 | import Control.Monad.Trans | ||
25 | import Data.HashMap.Strict as HM | ||
26 | |||
27 | import Data.Torrent | ||
28 | import Data.Torrent.InfoHash | ||
29 | import Data.Torrent.Magnet | ||
30 | import Network.BitTorrent.Client.Types | ||
31 | import Network.BitTorrent.DHT as DHT | ||
32 | import Network.BitTorrent.Tracker as Tracker | ||
33 | |||
34 | {----------------------------------------------------------------------- | ||
35 | -- Safe handle set manupulation | ||
36 | -----------------------------------------------------------------------} | ||
37 | |||
38 | -- | Guarantees that we newer allocate the same handle twice. | ||
39 | allocHandle :: InfoHash -> BitTorrent Handle -> BitTorrent Handle | ||
40 | allocHandle ih m = do | ||
41 | c @ Client {..} <- getClient | ||
42 | liftIO $ modifyMVar clientTorrents $ \ handles -> do | ||
43 | case HM.lookup ih handles of | ||
44 | Just h -> return (handles, h) | ||
45 | Nothing -> do | ||
46 | h <- runBitTorrent c m | ||
47 | return (HM.insert ih h handles, h) | ||
48 | |||
49 | -- | | ||
50 | freeHandle :: InfoHash -> BitTorrent () -> BitTorrent () | ||
51 | freeHandle ih finalizer = do | ||
52 | c @ Client {..} <- getClient | ||
53 | liftIO $ modifyMVar_ clientTorrents $ \ handles -> do | ||
54 | case HM.lookup ih handles of | ||
55 | Nothing -> return handles | ||
56 | Just _ -> do | ||
57 | runBitTorrent c finalizer | ||
58 | return (HM.delete ih handles) | ||
59 | |||
60 | -- | | ||
61 | lookupHandle :: InfoHash -> BitTorrent (Maybe Handle) | ||
62 | lookupHandle ih = do | ||
63 | Client {..} <- getClient | ||
64 | handles <- liftIO $ readMVar clientTorrents | ||
65 | return (HM.lookup ih handles) | ||
66 | |||
67 | {----------------------------------------------------------------------- | ||
68 | -- Initialization | ||
69 | -----------------------------------------------------------------------} | ||
70 | |||
71 | -- | Open a torrent in 'stop'ed state. Use 'nullTorrent' to open | ||
72 | -- handle from 'InfoDict'. This operation do not block. | ||
73 | openTorrent :: Torrent -> BitTorrent Handle | ||
74 | openTorrent t @ Torrent {..} = do | ||
75 | let ih = idInfoHash tInfoDict | ||
76 | allocHandle ih $ do | ||
77 | ses <- liftIO (Tracker.newSession ih (trackerList t)) | ||
78 | return $ Handle ih (idPrivate tInfoDict) ses | ||
79 | |||
80 | -- | Use 'nullMagnet' to open handle from 'InfoHash'. | ||
81 | openMagnet :: Magnet -> BitTorrent Handle | ||
82 | openMagnet = undefined | ||
83 | |||
84 | -- | Stop torrent and destroy all sessions. You don't need to close | ||
85 | -- handles at application exit, all handles will be automatically | ||
86 | -- closed at 'Network.BitTorrent.Client.closeClient'. This operation | ||
87 | -- may block. | ||
88 | closeHandle :: Handle -> BitTorrent () | ||
89 | closeHandle h @ Handle {..} = do | ||
90 | freeHandle topic $ do | ||
91 | stop h | ||
92 | liftIO $ Tracker.closeSession trackers | ||
93 | |||
94 | {----------------------------------------------------------------------- | ||
95 | -- Control | ||
96 | -----------------------------------------------------------------------} | ||
97 | |||
98 | -- | Start downloading, uploading and announcing this torrent. | ||
99 | -- | ||
100 | -- This operation is blocking, use | ||
101 | -- 'Control.Concurrent.Async.Lifted.async' if needed. | ||
102 | start :: Handle -> BitTorrent () | ||
103 | start Handle {..} = do | ||
104 | Client {..} <- getClient | ||
105 | liftIO $ Tracker.notify trackerManager trackers Tracker.Started | ||
106 | unless private $ do | ||
107 | liftDHT $ DHT.insert topic undefined | ||
108 | |||
109 | -- | Stop downloading this torrent. | ||
110 | pause :: Handle -> BitTorrent () | ||
111 | pause _ = return () | ||
112 | |||
113 | -- | Stop downloading, uploading and announcing this torrent. | ||
114 | stop :: Handle -> BitTorrent () | ||
115 | stop Handle {..} = do | ||
116 | Client {..} <- getClient | ||
117 | unless private $ do | ||
118 | liftDHT $ DHT.delete topic undefined | ||
119 | liftIO $ Tracker.notify trackerManager trackers Tracker.Stopped | ||
120 | |||
121 | {----------------------------------------------------------------------- | ||
122 | -- Query | ||
123 | -----------------------------------------------------------------------} | ||
124 | |||
125 | data HandleState | ||
126 | = Running | ||
127 | | Paused | ||
128 | | Stopped | ||
129 | |||
130 | getHandle :: InfoHash -> BitTorrent Handle | ||
131 | getHandle ih = do | ||
132 | mhandle <- lookupHandle ih | ||
133 | case mhandle of | ||
134 | Nothing -> error "should we throw some exception?" | ||
135 | Just h -> return h | ||
136 | |||
137 | getState :: Handle -> IO HandleState | ||
138 | getState = undefined \ No newline at end of file | ||