summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r--src/Network/BitTorrent/Internal.lhs28
-rw-r--r--src/Network/BitTorrent/Peer.hs24
2 files changed, 14 insertions, 38 deletions
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