summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent/Client/Handle.hs
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent/Client/Handle.hs')
-rw-r--r--src/Network/BitTorrent/Client/Handle.hs138
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 @@
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 , HandleState
18 , getState
19 ) where
20
21import Control.Applicative
22import Control.Concurrent
23import Control.Monad
24import Control.Monad.Trans
25import Data.HashMap.Strict as HM
26
27import Data.Torrent
28import Data.Torrent.InfoHash
29import Data.Torrent.Magnet
30import Network.BitTorrent.Client.Types
31import Network.BitTorrent.DHT as DHT
32import Network.BitTorrent.Tracker as Tracker
33
34{-----------------------------------------------------------------------
35-- Safe handle set manupulation
36-----------------------------------------------------------------------}
37
38-- | Guarantees that we newer allocate the same handle twice.
39allocHandle :: InfoHash -> BitTorrent Handle -> BitTorrent Handle
40allocHandle 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-- |
50freeHandle :: InfoHash -> BitTorrent () -> BitTorrent ()
51freeHandle 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-- |
61lookupHandle :: InfoHash -> BitTorrent (Maybe Handle)
62lookupHandle 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.
73openTorrent :: Torrent -> BitTorrent Handle
74openTorrent 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'.
81openMagnet :: Magnet -> BitTorrent Handle
82openMagnet = 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.
88closeHandle :: Handle -> BitTorrent ()
89closeHandle 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.
102start :: Handle -> BitTorrent ()
103start 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.
110pause :: Handle -> BitTorrent ()
111pause _ = return ()
112
113-- | Stop downloading, uploading and announcing this torrent.
114stop :: Handle -> BitTorrent ()
115stop 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
125data HandleState
126 = Running
127 | Paused
128 | Stopped
129
130getHandle :: InfoHash -> BitTorrent Handle
131getHandle ih = do
132 mhandle <- lookupHandle ih
133 case mhandle of
134 Nothing -> error "should we throw some exception?"
135 Just h -> return h
136
137getState :: Handle -> IO HandleState
138getState = undefined \ No newline at end of file