diff options
author | Sam T <pxqr.sta@gmail.com> | 2013-07-14 19:54:29 +0400 |
---|---|---|
committer | Sam T <pxqr.sta@gmail.com> | 2013-07-14 19:54:29 +0400 |
commit | 33da2f459c0819b694f2ef21dba6d09167a5af6a (patch) | |
tree | e8c869c21c3a5a7d33e351d32127bd009f2274c6 /src | |
parent | 4427cb321a6927b2dd8119e95e09f4998ff8a226 (diff) |
~ Move initial messages exchange to Exchange.
All exchange details should be in Exchange module, Sessions should
handle handshakes only!
Diffstat (limited to 'src')
-rw-r--r-- | src/Network/BitTorrent/Exchange.hs | 11 | ||||
-rw-r--r-- | src/Network/BitTorrent/Sessions.hs | 11 |
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 | |||
488 | yieldInit :: P2P () | ||
489 | yieldInit = yieldMessage . Bitfield =<< getClientBF | ||
490 | |||
491 | p2p :: P2P () | ||
492 | p2p = 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 | ||
209 | registerSwarmSession :: SwarmSession -> STM () | 209 | registerSwarmSession :: SwarmSession -> STM () |
210 | registerSwarmSession ss @ SwarmSession {..} = | 210 | registerSwarmSession ss @ SwarmSession {..} = |
@@ -348,11 +348,6 @@ closeSession = unregisterPeerSession | |||
348 | type PeerConn = (Socket, PeerSession) | 348 | type PeerConn = (Socket, PeerSession) |
349 | type Exchange = PeerConn -> IO () | 349 | type Exchange = PeerConn -> IO () |
350 | 350 | ||
351 | sendClientStatus :: PeerConn -> IO () | ||
352 | sendClientStatus (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 | ||
402 | listener :: ClientSession -> Exchange -> PortNumber -> IO () | 395 | listener :: ClientSession -> Exchange -> PortNumber -> IO () |