summaryrefslogtreecommitdiff
path: root/src/Network
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network')
-rw-r--r--src/Network/BitTorrent.hs17
-rw-r--r--src/Network/BitTorrent/Internal.lhs28
-rw-r--r--src/Network/BitTorrent/Peer.hs24
3 files changed, 29 insertions, 40 deletions
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
125 Torrent management 125 Torrent management
126-----------------------------------------------------------------------} 126-----------------------------------------------------------------------}
127 127
128-- | Used to check torrent location before register torrent.
129validateLocation :: TorrentLoc -> IO Torrent
130validateLocation TorrentLoc {..} = do
131 t <- fromFile metafilePath
132-- exists <- doesDirectoryExist dataDirPath
133-- unless exists $ do
134-- throw undefined
135 return t
136
137
128-- | Register torrent and start downloading. 138-- | Register torrent and start downloading.
129addTorrent :: ClientSession -> TorrentLoc -> IO () 139addTorrent :: ClientSession -> TorrentLoc -> IO ()
130addTorrent clientSession loc @ TorrentLoc {..} = do 140addTorrent clientSession loc @ TorrentLoc {..} = do
131 torrent <- registerTorrent loc 141 torrent <- validateLocation loc
142-- registerTorrent loc tInfoHash
143-- when (bf is not full)
144
132 swarm <- newLeecher clientSession torrent 145 swarm <- newLeecher clientSession torrent
133 storage <- swarm `bindTo` dataDirPath 146 storage <- swarm `bindTo` dataDirPath
134 forkIO $ discover swarm $ do 147 forkIO $ discover swarm $ do
@@ -140,7 +153,7 @@ addTorrent clientSession loc @ TorrentLoc {..} = do
140 153
141-- | Unregister torrent and stop all running sessions. 154-- | Unregister torrent and stop all running sessions.
142removeTorrent :: ClientSession -> InfoHash -> IO () 155removeTorrent :: ClientSession -> InfoHash -> IO ()
143removeTorrent ses loc = atomically $ unregisterTorrent ses loc 156removeTorrent ses loc = undefined -- atomically $ unregisterTorrent ses loc
144 157
145{- 158{-
146-- | The same as 'removeTorrrent' torrent, but delete all torrent 159-- | 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
257validate corresponding piece and only after read and send the block 257validate corresponding piece and only after read and send the block
258back. 258back.
259 259
260> -- | Used to check torrent location before register torrent. 260> registerTorrent :: TVar TorrentMap -> InfoHash -> TorrentLoc -> IO ()
261> validateTorrent :: TorrentLoc -> IO Torrent 261> registerTorrent = error "registerTorrent"
262> validateTorrent TorrentLoc {..} = do 262> {-
263> t <- fromFile metafilePath
264> exists <- doesDirectoryExist dataDirPath
265> unless exists $ do
266> throw undefined
267> return t
268
269> registerTorrent :: TVar TorrentMap -> TorrentLoc -> IO (Maybe Torrent)
270> registerTorrent ClientSession {..} tl = do
271> Torrent {..} <- validateTorrent tl 263> Torrent {..} <- validateTorrent tl
272> atomically $ modifyTVar' torrentMap $ HM.insert tInfoHash tl 264> atomically $ modifyTVar' torrentMap $ HM.insert tInfoHash tl
273> return (Just t) 265> return (Just t)
274> 266> -}
275 267
276> unregisterTorrent :: TVar TorrentMap -> InfoHash -> IO () 268> unregisterTorrent :: TVar TorrentMap -> InfoHash -> IO ()
277> unregisterTorrent ClientSession {..} ih = do 269> unregisterTorrent = error "unregisterTorrent"
278> modifyTVar' torrentMap $ HM.delete ih 270> -- modifyTVar' torrentMap $ HM.delete ih
279 271
280Client session 272Client session
281------------------------------------------------------------------------ 273------------------------------------------------------------------------
@@ -374,7 +366,7 @@ and different enabled extensions at the same time.
374> ClientSession 366> ClientSession
375> <$> newPeerId 367> <$> newPeerId
376> <*> pure exts 368> <*> pure exts
377> <*> forkListener (error "listener") 369> <*> pure 10 -- forkListener (error "listener")
378> <*> MSem.new n 370> <*> MSem.new n
379> <*> pure n 371> <*> pure n
380> <*> newTVarIO S.empty 372> <*> newTVarIO S.empty
@@ -382,6 +374,12 @@ and different enabled extensions at the same time.
382> <*> newTVarIO (startProgress 0) 374> <*> newTVarIO (startProgress 0)
383> <*> newTVarIO HM.empty 375> <*> newTVarIO HM.empty
384 376
377data TorrentStatus = Active SwarmSession
378 | Registered TorrentLoc
379 | Unknown
380lookupTorrent :: ClientSession -> InfoHash -> IO TorrentStatus
381lookupTorrent ses ih =
382
385Swarm session 383Swarm session
386------------------------------------------------------------------------ 384------------------------------------------------------------------------
387 385
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
51 -- * Peer address 51 -- * Peer address
52 , PeerAddr(..) 52 , PeerAddr(..)
53 , peerSockAddr 53 , peerSockAddr
54 , connectToPeer, forkListener 54 , connectToPeer
55 , ppPeer 55 , ppPeer
56 56
57 -- * Client version detection 57 -- * Client version detection
@@ -540,28 +540,6 @@ connectToPeer p = do
540 connect sock (peerSockAddr p) 540 connect sock (peerSockAddr p)
541 return sock 541 return sock
542 542
543
544forkListener :: ((PeerAddr, Socket) -> IO ()) -> IO PortNumber
545forkListener action = do
546 sock <- socket AF_INET Stream defaultProtocol
547 bindSocket sock (SockAddrInet 0 0)
548 listen sock 1
549 addr <- getSocketName sock
550 case addr of
551 SockAddrInet port _ -> do
552 forkIO (loop sock)
553 return port
554 _ -> do
555 throwIO $ userError "listener: impossible happened"
556 where
557 loop sock = do
558 (conn, addr) <- accept sock
559 case addr of
560 SockAddrInet port host ->
561 action (PeerAddr Nothing host port, conn)
562 _ -> return ()
563 loop sock
564
565-- | Pretty print peer address in human readable form. 543-- | Pretty print peer address in human readable form.
566ppPeer :: PeerAddr -> Doc 544ppPeer :: PeerAddr -> Doc
567ppPeer p @ PeerAddr {..} = case peerID of 545ppPeer p @ PeerAddr {..} = case peerID of