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
|
module Network.BitTorrent.Client
( Options (..)
, Client
, newClient
, addTorrent
) where
import Control.Concurrent.STM
import Data.Default
import Data.Function
import Data.HashMap.Strict as HM
import Data.Ord
import Data.Text
import Network
import Data.Torrent
import Data.Torrent.InfoHash
import Network.BitTorrent.Client.Swarm
import Network.BitTorrent.Core
import Network.BitTorrent.Exchange.Message
data Options = Options
{ fingerprint :: Fingerprint
, name :: Text
, port :: PortNumber
, extensions :: [Extension]
}
instance Default Options where
def = Options
{ fingerprint = def
, name = "hs-bittorrent"
, port = 6882
, extensions = []
}
data Client = Client
{ clientPeerId :: !PeerId
, clientListenerPort :: !PortNumber
, allowedExtensions :: !Caps
, torrents :: TVar (HashMap InfoHash Swarm)
}
instance Eq Client where
(==) = (==) `on` clientPeerId
instance Ord Client where
compare = comparing clientPeerId
newClient :: Options -> IO Client
newClient Options {..} = do
pid <- genPeerId
ts <- newTVarIO HM.empty
return Client
{ clientPeerId = pid
, clientListenerPort = port
, allowedExtensions = toCaps extensions
, torrents = ts
}
addTorrent :: Torrent -> Client -> IO ()
addTorrent t Client {..} = do
leecher <- newLeecher clientPeerId clientListenerPort t
let ih = idInfoHash (tInfoDict t)
atomically $ modifyTVar' torrents (HM.insert ih leecher)
askPeers leecher >>= print
|
