summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent.hs
blob: acb3700ce486cd283184f0dd5cd969315055cac6 (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
133
134
135
136
137
138
139
140
141
142
143
144
145
-- |
--   Copyright   :  (c) Sam T. 2013
--   License     :  MIT
--   Maintainer  :  pxqr.sta@gmail.com
--   Stability   :  experimental
--   Portability :  portable
--
{-# LANGUAGE RecordWildCards #-}
module Network.BitTorrent
       (
         module Data.Torrent

         -- * Session
       , ThreadCount
       , defaultThreadCount

         -- ** Client
       , ClientSession( clientPeerId, allowedExtensions )

       , withDefaultClient

       , Progress(..)
       , getCurrentProgress
       , getPeerCount
       , getSwarmCount

       , TorrentLoc(..)
       , addTorrent
       , removeTorrent

         -- ** Swarm
       , SwarmSession(torrentMeta)

       , newLeecher
       , newSeeder

       , SessionCount
       , getSessionCount

         -- * Discovery
       , discover
       , exchange


         -- * Peer to Peer
       , P2P

         -- ** Session
       , PeerSession( PeerSession, connectedPeerAddr
                    , swarmSession, enabledExtensions
                    )

       , getHaveCount
       , getWantCount
       , getPieceCount


         -- ** Transfer
       , Block(..), ppBlock
       , BlockIx(..), ppBlockIx

         -- ** Control
       , SessionException
       , disconnect
       , protocolError

         -- ** Events
       , Event(..)
       , awaitEvent, yieldEvent

         -- * Extensions
       , Extension, defaultExtensions, ppExtension
       ) where

import Control.Concurrent
import Control.Concurrent.STM
import Control.Exception
import Control.Monad
import Control.Monad.Reader

import Network

import Data.Bitfield as BF
import Data.Torrent
import Network.BitTorrent.Internal
import Network.BitTorrent.Peer
import Network.BitTorrent.Extension
import Network.BitTorrent.Exchange
import Network.BitTorrent.Exchange.Protocol
import Network.BitTorrent.Tracker
import Network.BitTorrent.Discovery

import System.Torrent.Storage

-- 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 dhtPort listPort action = do
  withClientSession defaultThreadCount defaultExtensions $ \client -> do
    startListener client listPort
    startDHT      client dhtPort
    action client

{-----------------------------------------------------------------------
    Torrent management
-----------------------------------------------------------------------}

-- | Used to check torrent location before register torrent.
validateLocation :: TorrentLoc -> IO Torrent
validateLocation TorrentLoc {..} = do
  t <- fromFile metafilePath
--  exists <- doesDirectoryExist dataDirPath
--  unless exists $ do
--    throw undefined
  return t


-- | Register torrent and start downloading.
addTorrent :: ClientSession -> TorrentLoc -> IO ()
addTorrent clientSession loc @ TorrentLoc {..} = do
  torrent <- validateLocation loc
--  registerTorrent loc tInfoHash
--  when (bf is not full)

  swarm   <- newLeecher  clientSession torrent
  storage <- openStorage (torrentMeta swarm) dataDirPath
  forkIO $ discover swarm $ do
    liftIO $ putStrLn "connected to peer"
    forever $ do
      liftIO $ putStrLn "from mesage loop"
      exchange storage
  return ()

-- | Unregister torrent and stop all running sessions.
removeTorrent :: ClientSession -> InfoHash ->  IO ()
removeTorrent ses loc = undefined -- atomically $ unregisterTorrent ses loc

{-
-- | The same as 'removeTorrrent' torrent, but delete all torrent
--   content files.
deleteTorrent :: ClientSession -> TorrentLoc -> IO ()
deleteTorrent ClientSession {..} TorrentLoc {..} = undefined
-}