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
139
140
141
142
|
-- |
-- Copyright : (c) Sam Truzjan 2013
-- License : BSD
-- Maintainer : pxqr.sta@gmail.com
-- Stability : experimental
-- Portability : portable
--
-- Protocol independent bittorrent tracker API.
--
module Network.BitTorrent.Tracker.RPC
( PeerInfo (..)
-- * Manager
, Options (..)
, Manager
, newManager
, closeManager
, withManager
-- * RPC
, SAnnounceQuery (..)
, announce
, scrape
) where
import Control.Exception
import Control.Monad.Trans.Resource
import Data.Default
import Network
import Network.URI
import Network.Socket (HostAddress)
import Data.Torrent.InfoHash
import Data.Torrent.Progress
import Network.BitTorrent.Core
import Network.BitTorrent.Tracker.Message
import qualified Network.BitTorrent.Tracker.RPC.HTTP as HTTP
import qualified Network.BitTorrent.Tracker.RPC.UDP as UDP
{-----------------------------------------------------------------------
-- Simplified announce
-----------------------------------------------------------------------}
-- | Info to advertise to trackers.
data PeerInfo = PeerInfo
{ peerId :: !PeerId
, peerPort :: !PortNumber
, peerIP :: !(Maybe HostAddress)
} deriving (Show, Eq)
-- | Simplified announce query.
data SAnnounceQuery = SAnnounceQuery
{ sInfoHash :: InfoHash
, sProgress :: Progress
, sNumWant :: Maybe Int
, sEvent :: Maybe Event
}
fillAnnounceQuery :: PeerInfo -> SAnnounceQuery -> AnnounceQuery
fillAnnounceQuery PeerInfo{..} SAnnounceQuery {..} = AnnounceQuery
{ reqInfoHash = sInfoHash
, reqPeerId = peerId
, reqPort = peerPort
, reqProgress = sProgress
, reqIP = peerIP
, reqNumWant = sNumWant
, reqEvent = sEvent
}
{-----------------------------------------------------------------------
-- RPC manager
-----------------------------------------------------------------------}
-- | Tracker manager settings.
data Options = Options
{ -- | HTTP tracker protocol specific options.
optHttpRPC :: !HTTP.Options
-- | UDP tracker protocol specific options.
, optUdpRPC :: !UDP.Options
-- | Whether to use multitracker extension.
, optMultitracker :: !Bool
}
instance Default Options where
def = Options
{ optHttpRPC = def
, optUdpRPC = def
, optMultitracker = True
}
-- | Tracker RPC Manager.
data Manager = Manager
{ options :: !Options
, peerInfo :: !PeerInfo
, httpMgr :: !HTTP.Manager
, udpMgr :: !UDP.Manager
}
-- | Normally a bittorrent client session need a single RPC manager
-- only.
newManager :: Options -> PeerInfo -> IO Manager
newManager opts info = do
h <- HTTP.newManager (optHttpRPC opts)
u <- UDP.newManager (optUdpRPC opts) `onException` HTTP.closeManager h
return $ Manager opts info h u
closeManager :: Manager -> IO ()
closeManager Manager {..} = do
UDP.closeManager udpMgr `finally` HTTP.closeManager httpMgr
withManager :: Options -> PeerInfo -> (Manager -> IO a) -> IO a
withManager opts info = bracket (newManager opts info) closeManager
{-----------------------------------------------------------------------
-- RPC calls
-----------------------------------------------------------------------}
-- TODO Catch IO exceptions on rpc calls.
dispatch :: URI -> IO a -> IO a -> IO a
dispatch URI {..} http udp
| uriScheme == "http:" = http
| uriScheme == "udp:" = udp
| otherwise = throwIO $ userError msg
where
msg = "unknown tracker protocol scheme: " ++ show uriScheme
announce :: Manager -> URI -> SAnnounceQuery -> IO AnnounceInfo
announce Manager {..} uri simpleQuery
= dispatch uri
(runResourceT (HTTP.announce httpMgr uri annQ))
(UDP.announce udpMgr uri annQ)
where
annQ = fillAnnounceQuery peerInfo simpleQuery
scrape :: Manager -> URI -> ScrapeQuery -> IO ScrapeInfo
scrape Manager {..} uri q
= dispatch uri
(runResourceT (HTTP.scrape httpMgr uri q))
(UDP.scrape udpMgr uri q)
|