summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent/Exchange.hs11
-rw-r--r--src/Network/BitTorrent/Sessions.hs11
2 files changed, 13 insertions, 9 deletions
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs
index 52b5f690..b2d639f6 100644
--- a/src/Network/BitTorrent/Exchange.hs
+++ b/src/Network/BitTorrent/Exchange.hs
@@ -60,6 +60,7 @@ module Network.BitTorrent.Exchange
60 , yieldEvent 60 , yieldEvent
61 , handleEvent 61 , handleEvent
62 , exchange 62 , exchange
63 , p2p
63 64
64 -- * Exceptions 65 -- * Exceptions
65 , disconnect 66 , disconnect
@@ -483,3 +484,13 @@ exchange storage = {-# SCC exchange #-} awaitEvent >>= handler
483 if BF.null offer 484 if BF.null offer
484 then return () 485 then return ()
485 else handler (Available offer) 486 else handler (Available offer)
487
488yieldInit :: P2P ()
489yieldInit = yieldMessage . Bitfield =<< getClientBF
490
491p2p :: P2P ()
492p2p = do
493 yieldInit
494 storage <- asks (storage . swarmSession)
495 forever $ do
496 exchange storage \ No newline at end of file
diff --git a/src/Network/BitTorrent/Sessions.hs b/src/Network/BitTorrent/Sessions.hs
index 4d4cf629..6d99213a 100644
--- a/src/Network/BitTorrent/Sessions.hs
+++ b/src/Network/BitTorrent/Sessions.hs
@@ -121,7 +121,7 @@ startListener cs @ ClientSession {..} port =
121 startService peerListener port $ listener cs $ \conn @ (sock, PeerSession{..}) -> do 121 startService peerListener port $ listener cs $ \conn @ (sock, PeerSession{..}) -> do
122 print "accepted" 122 print "accepted"
123 let storage = error "storage" 123 let storage = error "storage"
124 runP2P conn (exchange storage) 124 runP2P conn p2p
125 125
126-- | Create a new client session. The data passed to this function are 126-- | Create a new client session. The data passed to this function are
127-- usually loaded from configuration file. 127-- usually loaded from configuration file.
@@ -204,7 +204,7 @@ discover swarm @ SwarmSession {..} = {-# SCC discover #-} do
204 print addr 204 print addr
205 initiatePeerSession swarm addr $ \conn -> do 205 initiatePeerSession swarm addr $ \conn -> do
206 print addr 206 print addr
207 runP2P conn (exchange storage) 207 runP2P conn p2p
208 208
209registerSwarmSession :: SwarmSession -> STM () 209registerSwarmSession :: SwarmSession -> STM ()
210registerSwarmSession ss @ SwarmSession {..} = 210registerSwarmSession ss @ SwarmSession {..} =
@@ -348,11 +348,6 @@ closeSession = unregisterPeerSession
348type PeerConn = (Socket, PeerSession) 348type PeerConn = (Socket, PeerSession)
349type Exchange = PeerConn -> IO () 349type Exchange = PeerConn -> IO ()
350 350
351sendClientStatus :: PeerConn -> IO ()
352sendClientStatus (sock, PeerSession {..}) = do
353 cbf <- readTVarIO $ clientBitfield $ swarmSession
354 sendAll sock $ encode $ Bitfield cbf
355
356-- | Exchange action depends on session and socket, whereas session depends 351-- | Exchange action depends on session and socket, whereas session depends
357-- on socket: 352-- on socket:
358-- 353--
@@ -379,7 +374,6 @@ initiatePeerSession ss @ SwarmSession {..} addr
379 phs <- handshake sock (swarmHandshake ss) 374 phs <- handshake sock (swarmHandshake ss)
380 putStrLn "handshaked" 375 putStrLn "handshaked"
381 ps <- openSession ss addr phs 376 ps <- openSession ss addr phs
382 sendClientStatus (sock, ps)
383 return ps 377 return ps
384 378
385-- | Used the a peer want to connect to the client. 379-- | Used the a peer want to connect to the client.
@@ -396,7 +390,6 @@ acceptPeerSession cs@ClientSession {..} addr s = runSession (pure s) accepted
396 , hsInfoHash = hsInfoHash phs 390 , hsInfoHash = hsInfoHash phs
397 , hsPeerId = clientPeerId 391 , hsPeerId = clientPeerId
398 } 392 }
399 sendClientStatus (sock, ps)
400 return ps 393 return ps
401 394
402listener :: ClientSession -> Exchange -> PortNumber -> IO () 395listener :: ClientSession -> Exchange -> PortNumber -> IO ()