summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--src/Network/BitTorrent/Discovery.hs11
-rw-r--r--src/Network/BitTorrent/Exchange.hs28
2 files changed, 12 insertions, 27 deletions
diff --git a/src/Network/BitTorrent/Discovery.hs b/src/Network/BitTorrent/Discovery.hs
index 1b9e7b26..222dfe56 100644
--- a/src/Network/BitTorrent/Discovery.hs
+++ b/src/Network/BitTorrent/Discovery.hs
@@ -36,12 +36,17 @@ discover swarm @ SwarmSession {..} action = {-# SCC discover #-} do
36 withTracker progress conn $ \tses -> do 36 withTracker progress conn $ \tses -> do
37 forever $ do 37 forever $ do
38 addr <- getPeerAddr tses 38 addr <- getPeerAddr tses
39 spawnP2P swarm addr $ do 39 forkThrottle swarm $ do
40 action 40 initiatePeerSession swarm addr $ \conn ->
41 runP2P conn action
42
41 43
42startListener :: ClientSession -> PortNumber -> IO () 44startListener :: ClientSession -> PortNumber -> IO ()
43startListener cs @ ClientSession {..} port = 45startListener cs @ ClientSession {..} port =
44 startService peerListener port $ listener cs (error "listener") 46 startService peerListener port $ listener cs $ \conn @ (sock, PeerSession{..}) -> do
47 print "accepted"
48 let storage = error "storage"
49 runP2P conn (exchange storage)
45 50
46startDHT :: ClientSession -> PortNumber -> IO () 51startDHT :: ClientSession -> PortNumber -> IO ()
47startDHT ClientSession {..} nodePort = withRunning peerListener failure start 52startDHT ClientSession {..} nodePort = withRunning peerListener failure start
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs
index a0e7df8c..6ba56a22 100644
--- a/src/Network/BitTorrent/Exchange.hs
+++ b/src/Network/BitTorrent/Exchange.hs
@@ -47,7 +47,6 @@
47module Network.BitTorrent.Exchange 47module Network.BitTorrent.Exchange
48 ( P2P 48 ( P2P
49 , runP2P 49 , runP2P
50 , spawnP2P
51 50
52 -- * Query 51 -- * Query
53 , getHaveCount 52 , getHaveCount
@@ -153,33 +152,14 @@ instance MonadState SessionState P2P where
153 put !s = asks sessionState >>= \ref -> liftIO $ writeIORef ref s 152 put !s = asks sessionState >>= \ref -> liftIO $ writeIORef ref s
154 {-# INLINE put #-} 153 {-# INLINE put #-}
155 154
156runSession :: SwarmSession -> PeerAddr -> P2P () -> IO () 155runP2P :: (Socket, PeerSession) -> P2P () -> IO ()
157runSession se addr p2p = 156runP2P (sock, ses) p2p =
158 handle isIOException $ 157 handle isIOException $
159 initiatePeerSession se addr $ \(sock, pses) -> do 158 runPeerWire sock (runReaderT (unP2P p2p) ses)
160 runPeerWire sock (runReaderT (unP2P p2p) pses)
161 where 159 where
162 isIOException :: IOException -> IO () 160 isIOException :: IOException -> IO ()
163 isIOException _ = return () 161 isIOException _ = return ()
164 162
165-- | Run P2P session in the current thread. Normally you don't need this
166-- function in client application, except for debugging.
167runP2P :: SwarmSession -> PeerAddr -> P2P () -> IO ()
168runP2P se addr p2p = waitVacancy se $ runSession se addr p2p
169
170-- | Run P2P session in forked thread. Might be used in listener or
171-- some other loop. Note that this function may block while waiting
172-- for a vacant place: use forkIO and runP2P instead.
173spawnP2P :: SwarmSession -> PeerAddr -> P2P () -> IO ThreadId
174spawnP2P se addr p2p = forkThrottle se $ runSession se addr p2p
175
176-- TODO unify this all using PeerConnection
177{-
178listenP2P :: SwarmSession -> P2P () -> IO PortNumber
179listenP2P _ _ = undefined
180
181chainP2P :: SwarmSession -> PeerConnection -> P2P () -> IO ()
182-}
183{----------------------------------------------------------------------- 163{-----------------------------------------------------------------------
184 Exceptions 164 Exceptions
185-----------------------------------------------------------------------} 165-----------------------------------------------------------------------}