summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--bittorrent.cabal4
-rw-r--r--examples/GetTorrent.hs53
2 files changed, 52 insertions, 5 deletions
diff --git a/bittorrent.cabal b/bittorrent.cabal
index 347cc38d..f1b2823f 100644
--- a/bittorrent.cabal
+++ b/bittorrent.cabal
@@ -244,6 +244,10 @@ executable gettorrent
244 build-depends: base == 4.* 244 build-depends: base == 4.*
245 , optparse-applicative 245 , optparse-applicative
246 , data-default 246 , data-default
247 , conduit
248 , mtl
249 , network
250 , filepath
247 , bittorrent 251 , bittorrent
248 252
249executable client-example 253executable client-example
diff --git a/examples/GetTorrent.hs b/examples/GetTorrent.hs
index a9d2a44f..5e624fa1 100644
--- a/examples/GetTorrent.hs
+++ b/examples/GetTorrent.hs
@@ -1,27 +1,49 @@
1{-# LANGUAGE RecordWildCards #-}
1module Main (main) where 2module Main (main) where
3import Control.Applicative
4import Control.Concurrent
5import Control.Monad
6import Control.Monad.Trans
7import Data.Conduit as C
8import Data.Conduit.List as C
2import Data.Default 9import Data.Default
3 10import Data.Maybe
11import Network.URI
4import Options.Applicative 12import Options.Applicative
13import System.Exit
14import System.FilePath
15
16import Data.Torrent
5import Data.Torrent.InfoHash 17import Data.Torrent.InfoHash
6import Network.BitTorrent.Core 18import Network.BitTorrent.Core
19import Network.BitTorrent.DHT.Session
20import Network.BitTorrent.DHT as DHT
21import Network.BitTorrent.Exchange.Message
22import Network.BitTorrent.Exchange.Wire
7 23
8 24
9data Params = Params 25data Params = Params
10 { infohash :: InfoHash 26 { topic :: InfoHash
11 , thisNode :: NodeAddr IPv4 27 , thisNode :: NodeAddr IPv4
12 , bootNode :: NodeAddr IPv4 28 , bootNode :: NodeAddr IPv4
29 , buckets :: Int
13 } deriving Show 30 } deriving Show
14 31
15paramsParser :: Parser Params 32paramsParser :: Parser Params
16paramsParser = Params 33paramsParser = Params
17 <$> option (long "infohash" <> short 'i' 34 <$> option (long "infohash" <> short 'i'
18 <> metavar "SHA1" <> help "infohash of torrent file") 35 <> metavar "SHA1" <> help "infohash of torrent file")
19 <*> option (long "node" <> short 'n' <> value def 36 <*> option (long "port" <> short 'p'
20 <> metavar "NODE" <> help "this node address" 37 <> value def <> showDefault
38 <> metavar "NUM" <> help "port number to bind"
21 ) 39 )
22 <*> option (long "boot" <> short 'b' 40 <*> option (long "boot" <> short 'b'
23 <> metavar "NODE" <> help "bootstrap node address" 41 <> metavar "NODE" <> help "bootstrap node address"
24 ) 42 )
43 <*> option (long "bucket" <> short 'n'
44 <> value 2 <> showDefault
45 <> metavar "NUM" <> help "number of buckets to maintain"
46 )
25 47
26programInfo :: ParserInfo Params 48programInfo :: ParserInfo Params
27programInfo = info (helper <*> paramsParser) 49programInfo = info (helper <*> paramsParser)
@@ -30,8 +52,29 @@ programInfo = info (helper <*> paramsParser)
30 <> header "gettorrent - get torrent file by infohash" 52 <> header "gettorrent - get torrent file by infohash"
31 ) 53 )
32 54
55fakeTracker :: URI
56fakeTracker = fromJust $ parseURI "http://foo.org"
57
58exchangeTorrent :: PeerAddr IP -> InfoHash -> IO InfoDict
59exchangeTorrent addr ih = do
60 pid <- genPeerId
61 var <- newEmptyMVar
62 let hs = Handshake def (toCaps [ExtExtended]) ih pid
63 connectWire hs addr (toCaps [ExtMetadata]) $ do
64 infodict <- getMetadata
65 liftIO $ putMVar var infodict
66 takeMVar var
67
33getTorrent :: Params -> IO () 68getTorrent :: Params -> IO ()
34getTorrent = print 69getTorrent Params {..} = do
70 dht (def { optBucketCount = buckets }) thisNode $ do
71 bootstrap [bootNode]
72 DHT.lookup topic $$ C.mapM_ $ \ peers -> do
73 liftIO $ forM_ peers $ \ peer -> do
74 infodict <- exchangeTorrent (IPv4 <$> peer) topic
75 let torrent = nullTorrent fakeTracker infodict
76 toFile (show topic <.> torrentExt) torrent
77 exitSuccess
35 78
36main :: IO () 79main :: IO ()
37main = execParser programInfo >>= getTorrent 80main = execParser programInfo >>= getTorrent