diff options
Diffstat (limited to 'examples')
-rw-r--r-- | examples/MkTorrent.hs | 54 |
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 | ||
7 | import Prelude as P | 7 | import Prelude as P |
8 | import Control.Concurrent | 8 | import Control.Concurrent |
9 | import Control.Concurrent.Async | 9 | import Control.Concurrent.Async.Lifted |
10 | import Control.Concurrent.ParallelIO | 10 | import Control.Concurrent.ParallelIO |
11 | import Control.Exception | 11 | import Control.Exception |
12 | import Control.Lens hiding (argument, (<.>)) | 12 | import Control.Lens hiding (argument, (<.>)) |
13 | import Control.Monad | 13 | import Control.Monad as M |
14 | import Control.Monad.Trans | 14 | import Control.Monad.Trans |
15 | import Data.Conduit as C | 15 | import Data.Conduit as C |
16 | import Data.Conduit.List as C | ||
16 | import Data.List as L | 17 | import Data.List as L |
17 | import Data.Maybe as L | 18 | import Data.Maybe as L |
18 | import Data.Monoid | 19 | import Data.Monoid |
@@ -31,17 +32,14 @@ import Text.Read | |||
31 | import Text.PrettyPrint.Class | 32 | import Text.PrettyPrint.Class |
32 | 33 | ||
33 | import Paths_bittorrent (version) | 34 | import Paths_bittorrent (version) |
34 | import Data.Torrent | 35 | import Data.Torrent hiding (Magnet (Magnet)) |
35 | import Data.Torrent.Bitfield as BF | 36 | import Network.BitTorrent.Address |
36 | import Data.Torrent.InfoHash | ||
37 | import Data.Torrent.Piece | ||
38 | import Data.Torrent.Layout | ||
39 | import Data.Torrent.Magnet hiding (Magnet) | ||
40 | import Network.BitTorrent.Core | ||
41 | import Network.BitTorrent.DHT.Session hiding (Options, options) | 37 | import Network.BitTorrent.DHT.Session hiding (Options, options) |
42 | import Network.BitTorrent.DHT as DHT hiding (Options) | 38 | import Network.BitTorrent.DHT as DHT hiding (Options) |
43 | import Network.BitTorrent.Exchange.Message | 39 | import Network.BitTorrent.Exchange.Bitfield as BF |
44 | import Network.BitTorrent.Exchange.Connection hiding (Options) | 40 | import Network.BitTorrent.Exchange.Connection hiding (Options) |
41 | import Network.BitTorrent.Exchange.Message | ||
42 | import Network.BitTorrent.Exchange.Session | ||
45 | import System.Torrent.Storage | 43 | import 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 | ||
359 | exchangeTorrent :: InfoHash -> PeerAddr IP -> IO InfoDict | ||
360 | exchangeTorrent 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 | |||
370 | exchangeConc :: InfoHash -> [PeerAddr IP] -> IO (Maybe InfoDict) | ||
371 | exchangeConc ih peers = do | ||
372 | workers <- forM peers $ async . exchangeTorrent ih | ||
373 | (_, result) <- waitAnyCatchCancel workers | ||
374 | return $ either (const Nothing) Just result | ||
375 | |||
376 | sinkInfoDict :: InfoHash -> Sink [PeerAddr IPv4] (DHT ip) InfoDict | ||
377 | sinkInfoDict 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? |
386 | getTorrent :: GetOpts -> IO () | 358 | getTorrent :: GetOpts -> IO () |
387 | getTorrent GetOpts {..} = do | 359 | getTorrent 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 |