From 07ac8270807140fac201b7c973e12f924ca4b36b Mon Sep 17 00:00:00 2001
From: Sam T <pxqr.sta@gmail.com>
Date: Fri, 14 Jun 2013 11:06:31 +0400
Subject: ~ Minor changes.

---
 src/Network/BitTorrent.hs          |  9 ++-------
 src/Network/BitTorrent/Exchange.hs |  9 ++++++++-
 src/Network/BitTorrent/Peer.hs     | 33 ++++++++++++++++++++++++++++++---
 3 files changed, 40 insertions(+), 11 deletions(-)

(limited to 'src')

diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs
index 24d78e85..ce9f0149 100644
--- a/src/Network/BitTorrent.hs
+++ b/src/Network/BitTorrent.hs
@@ -45,6 +45,7 @@ import Network.BitTorrent.Exchange
 import Network.BitTorrent.Exchange.Protocol
 import Network.BitTorrent.Tracker
 import Network.BitTorrent.Extension
+import Network.BitTorrent.Peer
 
 
 defaultClient :: IO ClientSession
@@ -55,7 +56,7 @@ defaultClient = newClient defaultThreadCount defaultExtensions
 
 discover :: SwarmSession -> P2P () -> IO ()
 discover swarm action = do
-  port <- listener swarm action
+  port <- forkListener (error "discover")
 
   let conn = TConnection (tAnnounce (torrentMeta swarm))
                          (tInfoHash (torrentMeta swarm))
@@ -69,9 +70,3 @@ discover swarm action = do
       addr <- getPeerAddr tses
       spawnP2P swarm addr $ do
         action
-
-listener :: SwarmSession -> P2P () -> IO PortNumber
-listener _ _ = do
-  -- TODO:
---  forkIO loop
-  return 10000
diff --git a/src/Network/BitTorrent/Exchange.hs b/src/Network/BitTorrent/Exchange.hs
index 2d0393c0..862611f9 100644
--- a/src/Network/BitTorrent/Exchange.hs
+++ b/src/Network/BitTorrent/Exchange.hs
@@ -102,7 +102,7 @@ runSession  se addr p2p =
     isIOException _ = return ()
 
 -- | Run P2P session in the current thread. Normally you don't need this
--- function in client application.
+-- function in client application, except for debugging.
 runP2P :: SwarmSession -> PeerAddr -> P2P () -> IO ()
 runP2P se addr p2p = waitVacancy se $ runSession se addr p2p
 
@@ -115,6 +115,13 @@ spawnP2P se addr p2p = do
   forkIO $ do
     runSession se addr p2p `finally` leaveSwarm se
 
+-- TODO unify this all using PeerConnection
+{-
+listenP2P :: SwarmSession -> P2P () -> IO PortNumber
+listenP2P _ _ = undefined
+
+chainP2P :: SwarmSession -> PeerConnection -> P2P () -> IO ()
+-}
 {-----------------------------------------------------------------------
     Exceptions
 -----------------------------------------------------------------------}
diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs
index 9aa924d3..41630c6d 100644
--- a/src/Network/BitTorrent/Peer.hs
+++ b/src/Network/BitTorrent/Peer.hs
@@ -44,12 +44,14 @@ module Network.BitTorrent.Peer
 
          -- ** Generation
        , newPeerID, timestampByteString
+
          -- ** Extra
        , byteStringPadded
 
          -- * Peer address
        , PeerAddr(..)
-       , peerSockAddr, connectToPeer
+       , peerSockAddr
+       , connectToPeer, forkListener
        , ppPeer
 
          -- * Client version detection
@@ -66,6 +68,8 @@ module Network.BitTorrent.Peer
 
 
 import Control.Applicative
+import Control.Concurrent
+import Control.Exception
 import Data.BEncode
 import Data.Bits
 import Data.Word
@@ -84,7 +88,7 @@ import Data.Time.Format (formatTime)
 import Text.PrettyPrint (text, Doc, (<+>))
 import System.Locale    (defaultTimeLocale)
 
-import Network
+import Network hiding (accept)
 import Network.Socket
 
 
@@ -489,7 +493,8 @@ data PeerAddr = PeerAddr {
     , peerIP   :: HostAddress
     , peerPort :: PortNumber
     } deriving (Show, Eq, Ord)
-               -- TODO verify semantic of ord and eq instances
+
+-- TODO check semantic of ord and eq instances
 
 instance BEncodable PortNumber where
   toBEncode = toBEncode . fromEnum
@@ -535,6 +540,28 @@ connectToPeer p = do
   connect sock (peerSockAddr p)
   return sock
 
+
+forkListener :: ((PeerAddr, Socket) -> IO ()) -> IO PortNumber
+forkListener action = do
+    sock <- socket AF_INET Stream defaultProtocol
+    bindSocket sock (SockAddrInet 0 0)
+    listen sock 1
+    addr <- getSocketName sock
+    case addr of
+      SockAddrInet port _ -> do
+        forkIO (loop sock)
+        return port
+      _                   -> do
+        throwIO $ userError "listener: impossible happened"
+  where
+    loop sock = do
+      (conn, addr) <- accept sock
+      case addr of
+        SockAddrInet port host ->
+          action (PeerAddr Nothing host port, conn)
+        _                      -> return ()
+      loop sock
+
 -- | Pretty print peer address in human readable form.
 ppPeer :: PeerAddr -> Doc
 ppPeer p @ PeerAddr {..} = case peerID of
-- 
cgit v1.2.3