From 8ea2e1f83ba7c06646f200107a018daf4a434bf9 Mon Sep 17 00:00:00 2001
From: Sam T <pxqr.sta@gmail.com>
Date: Sun, 7 Jul 2013 22:21:05 +0400
Subject: ~ Refactor torrent registration a bit.

---
 src/Network/BitTorrent.hs           | 17 +++++++++++++++--
 src/Network/BitTorrent/Internal.lhs | 28 +++++++++++++---------------
 src/Network/BitTorrent/Peer.hs      | 24 +-----------------------
 3 files changed, 29 insertions(+), 40 deletions(-)

(limited to 'src/Network')

diff --git a/src/Network/BitTorrent.hs b/src/Network/BitTorrent.hs
index 5521a825..a9d06ab4 100644
--- a/src/Network/BitTorrent.hs
+++ b/src/Network/BitTorrent.hs
@@ -125,10 +125,23 @@ discover swarm @ SwarmSession {..} action = {-# SCC discover #-} do
     Torrent management
 -----------------------------------------------------------------------}
 
+-- | Used to check torrent location before register torrent.
+validateLocation :: TorrentLoc -> IO Torrent
+validateLocation TorrentLoc {..} = do
+  t <- fromFile metafilePath
+--  exists <- doesDirectoryExist dataDirPath
+--  unless exists $ do
+--    throw undefined
+  return t
+
+
 -- | Register torrent and start downloading.
 addTorrent :: ClientSession -> TorrentLoc -> IO ()
 addTorrent clientSession loc @ TorrentLoc {..} = do
-  torrent <- registerTorrent loc
+  torrent <- validateLocation loc
+--  registerTorrent loc tInfoHash
+--  when (bf is not full)
+
   swarm   <- newLeecher  clientSession torrent
   storage <- swarm `bindTo` dataDirPath
   forkIO $ discover swarm $ do
@@ -140,7 +153,7 @@ addTorrent clientSession loc @ TorrentLoc {..} = do
 
 -- | Unregister torrent and stop all running sessions.
 removeTorrent :: ClientSession -> InfoHash ->  IO ()
-removeTorrent ses loc = atomically $ unregisterTorrent ses loc
+removeTorrent ses loc = undefined -- atomically $ unregisterTorrent ses loc
 
 {-
 -- | The same as 'removeTorrrent' torrent, but delete all torrent
diff --git a/src/Network/BitTorrent/Internal.lhs b/src/Network/BitTorrent/Internal.lhs
index e3fe3dac..475c5e32 100644
--- a/src/Network/BitTorrent/Internal.lhs
+++ b/src/Network/BitTorrent/Internal.lhs
@@ -257,25 +257,17 @@ so we need to do this on demand: if a peer asks for a block, we
 validate corresponding piece and only after read and send the block
 back.
 
-> -- | Used to check torrent location before register torrent.
-> validateTorrent :: TorrentLoc -> IO Torrent
-> validateTorrent TorrentLoc {..} = do
->   t <- fromFile metafilePath
->   exists <- doesDirectoryExist dataDirPath
->   unless exists $ do
->     throw undefined
->   return t
-
-> registerTorrent :: TVar TorrentMap -> TorrentLoc -> IO (Maybe Torrent)
-> registerTorrent ClientSession {..} tl = do
+> registerTorrent :: TVar TorrentMap -> InfoHash -> TorrentLoc -> IO ()
+> registerTorrent = error "registerTorrent"
+>   {-
 >   Torrent {..} <- validateTorrent tl
 >   atomically $ modifyTVar' torrentMap $ HM.insert tInfoHash tl
 >   return (Just t)
->
+>   -}
 
 > unregisterTorrent :: TVar TorrentMap -> InfoHash -> IO ()
-> unregisterTorrent ClientSession {..} ih = do
->   modifyTVar' torrentMap $ HM.delete ih
+> unregisterTorrent = error "unregisterTorrent"
+>   -- modifyTVar' torrentMap $ HM.delete ih
 
 Client session
 ------------------------------------------------------------------------
@@ -374,7 +366,7 @@ and different enabled extensions at the same time.
 >   ClientSession
 >     <$> newPeerId
 >     <*> pure exts
->     <*> forkListener (error "listener")
+>     <*> pure 10 -- forkListener (error "listener")
 >     <*> MSem.new n
 >     <*> pure n
 >     <*> newTVarIO S.empty
@@ -382,6 +374,12 @@ and different enabled extensions at the same time.
 >     <*> newTVarIO (startProgress 0)
 >     <*> newTVarIO HM.empty
 
+data TorrentStatus = Active     SwarmSession
+                   | Registered TorrentLoc
+                   | Unknown
+lookupTorrent :: ClientSession -> InfoHash -> IO TorrentStatus
+lookupTorrent ses ih =
+
 Swarm session
 ------------------------------------------------------------------------
 
diff --git a/src/Network/BitTorrent/Peer.hs b/src/Network/BitTorrent/Peer.hs
index 68771052..4615ad3a 100644
--- a/src/Network/BitTorrent/Peer.hs
+++ b/src/Network/BitTorrent/Peer.hs
@@ -51,7 +51,7 @@ module Network.BitTorrent.Peer
          -- * Peer address
        , PeerAddr(..)
        , peerSockAddr
-       , connectToPeer, forkListener
+       , connectToPeer
        , ppPeer
 
          -- * Client version detection
@@ -540,28 +540,6 @@ 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