summaryrefslogtreecommitdiff
path: root/bittorrent/src/Network/BitTorrent/Client.hs
diff options
context:
space:
mode:
authorJames Crayne <jim.crayne@gmail.com>2019-09-28 13:43:29 -0400
committerJoe Crayne <joe@jerkface.net>2020-01-01 19:27:53 -0500
commit11987749fc6e6d3e53ea737d46d5ab13a16faeb8 (patch)
tree5716463275c2d3e902889db619908ded2a73971c /bittorrent/src/Network/BitTorrent/Client.hs
parentadd2c76bced51fde5e9917e7449ef52be70faf87 (diff)
Factor out some new libraries
word64-map: Data.Word64Map network-addr: Network.Address tox-crypto: Crypto.Tox lifted-concurrent: Control.Concurrent.Lifted.Instrument Control.Concurrent.Async.Lifted.Instrument psq-wrap: Data.Wrapper.PSQInt Data.Wrapper.PSQ minmax-psq: Data.MinMaxPSQ tasks: Control.Concurrent.Tasks kad: Network.Kademlia Network.Kademlia.Bootstrap Network.Kademlia.Routing Network.Kademlia.CommonAPI Network.Kademlia.Persistence Network.Kademlia.Search
Diffstat (limited to 'bittorrent/src/Network/BitTorrent/Client.hs')
-rw-r--r--bittorrent/src/Network/BitTorrent/Client.hs195
1 files changed, 0 insertions, 195 deletions
diff --git a/bittorrent/src/Network/BitTorrent/Client.hs b/bittorrent/src/Network/BitTorrent/Client.hs
deleted file mode 100644
index c84290dd..00000000
--- a/bittorrent/src/Network/BitTorrent/Client.hs
+++ /dev/null
@@ -1,195 +0,0 @@
1{-# LANGUAGE FlexibleInstances #-}
2{-# LANGUAGE TypeSynonymInstances #-}
3{-# LANGUAGE GeneralizedNewtypeDeriving #-}
4{-# LANGUAGE TemplateHaskell #-}
5module Network.BitTorrent.Client
6 ( -- * Options
7 Options (..)
8
9 -- * Client session
10 , Client
11
12 -- ** Session data
13 , clientPeerId
14 , clientListenerPort
15 , allowedExtensions
16
17 -- ** Session initialization
18 , LogFun
19 , newClient
20 , closeClient
21 , withClient
22 , simpleClient
23
24 -- * BitTorrent monad
25 , MonadBitTorrent (..)
26 , BitTorrent
27 , runBitTorrent
28 , getClient
29
30 -- * Handle
31 , Handle
32 , handleTopic
33 , handleTrackers
34 , handleExchange
35
36 -- ** Construction
37 , TorrentSource (..)
38 , closeHandle
39
40 -- ** Query
41 , getHandle
42 , getIndex
43
44 -- ** Management
45 , start
46 , pause
47 , stop
48 ) where
49
50import Control.Applicative
51import Control.Exception
52import Control.Concurrent
53import Control.Concurrent.Chan.Split as CS
54import Control.Monad.Logger
55import Control.Monad.Trans
56import Control.Monad.Trans.Resource
57
58import Data.Default
59import Data.HashMap.Strict as HM
60import Data.Text
61import Network
62
63import Data.Torrent
64import Network.Address
65import Network.BitTorrent.Client.Types
66import Network.BitTorrent.Client.Handle
67import Network.BitTorrent.DHT as DHT hiding (Options)
68import Network.BitTorrent.Tracker as Tracker hiding (Options)
69import Network.BitTorrent.Exchange as Exchange hiding (Options)
70import qualified Network.BitTorrent.Exchange as Exchange (Options(..))
71
72
73data Options = Options
74 { optFingerprint :: Fingerprint
75 , optName :: Text
76 , optPort :: PortNumber
77 , optExtensions :: [Extension]
78 , optNodeAddr :: NodeAddr IPv4
79 , optBootNode :: Maybe (NodeAddr IPv4)
80 }
81
82instance Default Options where
83 def = Options
84 { optFingerprint = def
85 , optName = "hs-bittorrent"
86 , optPort = 6882
87 , optExtensions = []
88 , optNodeAddr = "0.0.0.0:6882"
89 , optBootNode = Nothing
90 }
91
92exchangeOptions :: PeerId -> Options -> Exchange.Options
93exchangeOptions pid Options {..} = Exchange.Options
94 { optPeerAddr = PeerAddr (Just pid) (peerHost def) optPort
95 , optBacklog = optBacklog def
96 }
97
98connHandler :: MVar (HashMap InfoHash Handle) -> Exchange.Handler
99connHandler tmap ih = do
100 m <- readMVar tmap
101 case HM.lookup ih m of
102 Nothing -> error "torrent not found"
103 Just (Handle {..}) -> return handleExchange
104
105initClient :: Options -> LogFun -> ResIO Client
106initClient opts @ Options {..} logFun = do
107 pid <- liftIO genPeerId
108 tmap <- liftIO $ newMVar HM.empty
109
110 let peerInfo = PeerInfo pid Nothing optPort
111 let mkTracker = Tracker.newManager def peerInfo
112 (_, tmgr) <- allocate mkTracker Tracker.closeManager
113
114 let mkEx = Exchange.newManager (exchangeOptions pid opts) (connHandler tmap)
115 (_, emgr) <- allocate mkEx Exchange.closeManager
116
117 let mkNode = DHT.newNode defaultHandlers def optNodeAddr logFun Nothing
118 (_, node) <- allocate mkNode DHT.closeNode
119
120 resourceMap <- getInternalState
121 eventStream <- liftIO newSendPort
122
123 return Client
124 { clientPeerId = pid
125 , clientListenerPort = optPort
126 , allowedExtensions = toCaps optExtensions
127 , clientResources = resourceMap
128 , trackerManager = tmgr
129 , exchangeManager = emgr
130 , clientNode = node
131 , clientTorrents = tmap
132 , clientLogger = logFun
133 , clientEvents = eventStream
134 }
135
136newClient :: Options -> LogFun -> IO Client
137newClient opts logFun = do
138 s <- createInternalState
139 runInternalState (initClient opts logFun) s
140 `onException` closeInternalState s
141
142closeClient :: Client -> IO ()
143closeClient Client {..} = closeInternalState clientResources
144
145withClient :: Options -> LogFun -> (Client -> IO a) -> IO a
146withClient opts lf action = bracket (newClient opts lf) closeClient action
147
148-- do not perform IO in 'initClient', do it in the 'boot'
149--boot :: BitTorrent ()
150--boot = do
151-- Options {..} <- asks options
152-- liftDHT $ bootstrap (maybeToList optBootNode)
153
154-- | Run bittorrent client with default options and log to @stderr@.
155--
156-- For testing purposes only.
157--
158simpleClient :: BitTorrent () -> IO ()
159simpleClient m = do
160 runStderrLoggingT $ LoggingT $ \ logger -> do
161 withClient def logger (`runBitTorrent` m)
162
163{-----------------------------------------------------------------------
164-- Torrent identifiers
165-----------------------------------------------------------------------}
166
167class TorrentSource s where
168 openHandle :: FilePath -> s -> BitTorrent Handle
169
170instance TorrentSource InfoHash where
171 openHandle path ih = openMagnet path (nullMagnet ih)
172 {-# INLINE openHandle #-}
173
174instance TorrentSource Magnet where
175 openHandle = openMagnet
176 {-# INLINE openHandle #-}
177
178instance TorrentSource InfoDict where
179 openHandle path dict = openTorrent path (nullTorrent dict)
180 {-# INLINE openHandle #-}
181
182instance TorrentSource Torrent where
183 openHandle = openTorrent
184 {-# INLINE openHandle #-}
185
186instance TorrentSource FilePath where
187 openHandle contentDir torrentPath = do
188 t <- liftIO $ fromFile torrentPath
189 openTorrent contentDir t
190 {-# INLINE openHandle #-}
191
192getIndex :: BitTorrent [Handle]
193getIndex = do
194 Client {..} <- getClient
195 elems <$> liftIO (readMVar clientTorrents)