summaryrefslogtreecommitdiff
path: root/examples
diff options
context:
space:
mode:
Diffstat (limited to 'examples')
-rw-r--r--examples/MkTorrent.hs54
1 files changed, 13 insertions, 41 deletions
diff --git a/examples/MkTorrent.hs b/examples/MkTorrent.hs
index 960f5acb..58e14af1 100644
--- a/examples/MkTorrent.hs
+++ b/examples/MkTorrent.hs
@@ -6,13 +6,14 @@ module Main (main) where
6 6
7import Prelude as P 7import Prelude as P
8import Control.Concurrent 8import Control.Concurrent
9import Control.Concurrent.Async 9import Control.Concurrent.Async.Lifted
10import Control.Concurrent.ParallelIO 10import Control.Concurrent.ParallelIO
11import Control.Exception 11import Control.Exception
12import Control.Lens hiding (argument, (<.>)) 12import Control.Lens hiding (argument, (<.>))
13import Control.Monad 13import Control.Monad as M
14import Control.Monad.Trans 14import Control.Monad.Trans
15import Data.Conduit as C 15import Data.Conduit as C
16import Data.Conduit.List as C
16import Data.List as L 17import Data.List as L
17import Data.Maybe as L 18import Data.Maybe as L
18import Data.Monoid 19import Data.Monoid
@@ -31,17 +32,14 @@ import Text.Read
31import Text.PrettyPrint.Class 32import Text.PrettyPrint.Class
32 33
33import Paths_bittorrent (version) 34import Paths_bittorrent (version)
34import Data.Torrent 35import Data.Torrent hiding (Magnet (Magnet))
35import Data.Torrent.Bitfield as BF 36import Network.BitTorrent.Address
36import Data.Torrent.InfoHash
37import Data.Torrent.Piece
38import Data.Torrent.Layout
39import Data.Torrent.Magnet hiding (Magnet)
40import Network.BitTorrent.Core
41import Network.BitTorrent.DHT.Session hiding (Options, options) 37import Network.BitTorrent.DHT.Session hiding (Options, options)
42import Network.BitTorrent.DHT as DHT hiding (Options) 38import Network.BitTorrent.DHT as DHT hiding (Options)
43import Network.BitTorrent.Exchange.Message 39import Network.BitTorrent.Exchange.Bitfield as BF
44import Network.BitTorrent.Exchange.Connection hiding (Options) 40import Network.BitTorrent.Exchange.Connection hiding (Options)
41import Network.BitTorrent.Exchange.Message
42import Network.BitTorrent.Exchange.Session
45import System.Torrent.Storage 43import System.Torrent.Storage
46 44
47 45
@@ -356,43 +354,17 @@ getInfo = info (helper <*> paramsParser)
356 <> header "get torrent file by infohash" 354 <> header "get torrent file by infohash"
357 ) 355 )
358 356
359exchangeTorrent :: InfoHash -> PeerAddr IP -> IO InfoDict
360exchangeTorrent ih addr = do
361 pid <- genPeerId
362 var <- newEmptyMVar
363 let hs = Handshake def (toCaps [ExtExtended]) ih pid
364 chan <- newChan
365 connectWire () hs addr (toCaps [ExtMetadata]) chan $ do
366 infodict <- undefined -- getMetadata
367 liftIO $ putMVar var infodict
368 takeMVar var
369
370exchangeConc :: InfoHash -> [PeerAddr IP] -> IO (Maybe InfoDict)
371exchangeConc ih peers = do
372 workers <- forM peers $ async . exchangeTorrent ih
373 (_, result) <- waitAnyCatchCancel workers
374 return $ either (const Nothing) Just result
375
376sinkInfoDict :: InfoHash -> Sink [PeerAddr IPv4] (DHT ip) InfoDict
377sinkInfoDict ih = do
378 m <- await
379 case m of
380 Nothing -> liftIO $ throwIO $ userError "impossible: end of peer stream"
381 Just peers -> do
382 minfodict <- liftIO $ exchangeConc ih (fmap IPv4 <$> peers)
383 maybe (sinkInfoDict ih) return minfodict
384
385 -- TODO add tNodes, tCreated, etc? 357 -- TODO add tNodes, tCreated, etc?
386getTorrent :: GetOpts -> IO () 358getTorrent :: GetOpts -> IO ()
387getTorrent GetOpts {..} = do 359getTorrent GetOpts {..} = do
388 infoM "get" "starting..." 360 infoM "get" "searching for peers..."
361 s <- newSession (\ _ _ _ _ -> return ()) (PeerAddr Nothing Nothing 7000) "/tmp" (Left topic)
389 dht (def { optBucketCount = buckets }) (NodeAddr "0.0.0.0" servPort) $ do 362 dht (def { optBucketCount = buckets }) (NodeAddr "0.0.0.0" servPort) $ do
390 bootstrap [bootNode] 363 bootstrap [bootNode]
391 liftIO $ infoM "get" "searching for peers..." 364 infodict <- withAsync (DHT.lookup topic $$ connectSink s)
392 infodict <- DHT.lookup topic $$ sinkInfoDict topic 365 (const (liftIO $ waitMetadata s))
393 liftIO $ infoM "get" "saving torrent file..."
394 liftIO $ toFile (show topic <.> torrentExt) $ nullTorrent infodict 366 liftIO $ toFile (show topic <.> torrentExt) $ nullTorrent infodict
395 infoM "get" "done" 367 infoM "get" "saved torrent file"
396 368
397{----------------------------------------------------------------------- 369{-----------------------------------------------------------------------
398-- Command 370-- Command