1
2
3
4
5
6
7
8
9
10
11
12
13
14
15
16
17
18
19
20
21
22
23
24
25
26
27
28
29
30
31
32
33
34
35
36
37
38
39
40
41
42
43
44
45
46
47
48
49
50
51
52
53
54
55
56
57
58
59
60
61
62
63
64
65
66
67
68
69
70
71
72
73
74
75
76
77
78
79
80
81
82
83
84
85
86
87
88
89
90
91
92
93
94
95
96
97
98
99
100
101
102
103
104
105
106
107
108
109
110
111
112
113
114
115
116
117
118
119
120
121
122
123
124
125
126
127
128
129
130
131
132
|
-- |
-- Copyright : (c) Sam Truzjan 2013
-- License : BSD3
-- Maintainer : pxqr.sta@gmail.com
-- Stability : experimental
-- Portability : portable
--
{-# LANGUAGE RecordWildCards #-}
module Network.BitTorrent
( module Data.Torrent
, TorrentLoc(..), TorrentMap, Progress(..)
, ThreadCount, SessionCount
, ClientSession( clientPeerId, allowedExtensions )
, withDefaultClient, defaultThreadCount, defaultPorts
, addTorrent
, removeTorrent
, getCurrentProgress
, getPeerCount
, getSwarmCount
, getSessionCount
, getSwarm
, getStorage
, getTorrentInfo
, getTorrentInfoStr
-- * Torrent Groups
, ClientLoc (..), ppClientLoc
, concreteLoc, concretePath
, addTorrents
, removeTorrents
-- * Extensions
, Extension
, defaultExtensions
, ppExtension
) where
import Control.Applicative
import Control.Exception
import Control.Monad
import Data.List as L
import Data.HashMap.Strict as HM
import Network
import Text.Read
import Text.PrettyPrint
import System.Directory
import System.FilePath
import Data.Torrent
import Network.BitTorrent.Sessions.Types
import Network.BitTorrent.Sessions
import Network.BitTorrent.Extension
import Network.BitTorrent.Tracker
-- TODO remove fork from Network.BitTorrent.Exchange
-- TODO make all forks in Internal.
-- | Client session with default parameters. Use it for testing only.
withDefaultClient :: PortNumber -> PortNumber -> (ClientSession -> IO ()) -> IO ()
withDefaultClient listPort dhtPort action = do
withClientSession defaultThreadCount [] listPort dhtPort action
getTorrentInfoStr :: ClientSession -> String -> IO (Maybe Torrent)
getTorrentInfoStr cs str
| Just infohash <- readMaybe str = getTorrentInfo cs infohash
| otherwise = return Nothing
{-----------------------------------------------------------------------
Torrent management
-----------------------------------------------------------------------}
-- | Register torrent and start downloading.
addTorrent :: ClientSession -> TorrentLoc -> IO ()
addTorrent cs loc @ TorrentLoc {..} = do
registerTorrent cs loc
openSwarmSession cs loc
return ()
-- | Unregister torrent and stop all running sessions.
removeTorrent :: ClientSession -> InfoHash -> IO ()
removeTorrent = unregisterTorrent
{-
-- | The same as 'removeTorrrent' torrent, but delete all torrent
-- content files.
deleteTorrent :: ClientSession -> TorrentLoc -> IO ()
deleteTorrent ClientSession {..} TorrentLoc {..} = undefined
-}
{-----------------------------------------------------------------------
Torrent group management
-----------------------------------------------------------------------}
-- TODO better name
data ClientLoc = ClientLoc
{ tdir :: FilePath -- ^ Path to directory with .torrent files.
, ddir :: FilePath -- ^ Path to directory to place content.
} deriving (Show, Eq)
ppClientLoc :: ClientLoc -> Doc
ppClientLoc ClientLoc {..} =
text "torrent directory" <+> text tdir $$
text "data directory" <+> text ddir
concretePath :: ClientLoc -> FilePath -> FilePath
concretePath ClientLoc {..} relPath = tdir </> relPath
concreteLoc :: ClientLoc -> FilePath -> TorrentLoc
concreteLoc loc @ ClientLoc {..} relPath
= TorrentLoc (concretePath loc relPath) ddir
addTorrents :: ClientSession -> ClientLoc -> IO ()
addTorrents ses loc @ ClientLoc {..} = do
paths <- L.filter isTorrentPath <$> getDirectoryContents tdir
forM_ paths $ handle handler . addTorrent ses . concreteLoc loc
where
handler :: SomeException -> IO ()
handler = print
removeTorrents :: ClientSession -> IO ()
removeTorrents cs = do
tm <- getRegistered cs
forM_ (keys tm) (removeTorrent cs)
{-
deleteTorrents :: ClientSession -> IO ()
deleteTorrents = undefined
-}
|
