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