summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent.hs
blob: 7ff85b39280b848ed4c2a4dc274fa59f86b900b6 (plain)
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 T. 2013
--   License     :  MIT
--   Maintainer  :  pxqr.sta@gmail.com
--   Stability   :  experimental
--   Portability :  portable
--
{-# LANGUAGE RecordWildCards #-}
module Network.BitTorrent
       ( module Data.Torrent.Metainfo

       , 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.Metainfo
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
-}