summaryrefslogtreecommitdiff
path: root/src/Network/BitTorrent
diff options
context:
space:
mode:
Diffstat (limited to 'src/Network/BitTorrent')
-rw-r--r--src/Network/BitTorrent/Core/PeerAddr.hs4
-rw-r--r--src/Network/BitTorrent/Internal/Cache.hs14
-rw-r--r--src/Network/BitTorrent/Tracker/Session.hs29
3 files changed, 41 insertions, 6 deletions
diff --git a/src/Network/BitTorrent/Core/PeerAddr.hs b/src/Network/BitTorrent/Core/PeerAddr.hs
index b62cb945..adf64c7f 100644
--- a/src/Network/BitTorrent/Core/PeerAddr.hs
+++ b/src/Network/BitTorrent/Core/PeerAddr.hs
@@ -34,6 +34,7 @@ module Network.BitTorrent.Core.PeerAddr
34import Control.Applicative 34import Control.Applicative
35import Control.Monad 35import Control.Monad
36import Data.Aeson (ToJSON, FromJSON) 36import Data.Aeson (ToJSON, FromJSON)
37import Data.Aeson.TH
37import Data.BEncode as BS 38import Data.BEncode as BS
38import Data.BEncode.BDict (BKey) 39import Data.BEncode.BDict (BKey)
39import Data.ByteString.Char8 as BS8 40import Data.ByteString.Char8 as BS8
@@ -57,6 +58,7 @@ import Text.Read (readMaybe)
57import qualified Text.ParserCombinators.ReadP as RP 58import qualified Text.ParserCombinators.ReadP as RP
58 59
59import Data.Torrent.InfoHash 60import Data.Torrent.InfoHash
61import Data.Torrent.JSON
60import Network.BitTorrent.Core.PeerId 62import Network.BitTorrent.Core.PeerId
61 63
62 64
@@ -206,6 +208,8 @@ data PeerAddr a = PeerAddr
206 , peerPort :: {-# UNPACK #-} !PortNumber 208 , peerPort :: {-# UNPACK #-} !PortNumber
207 } deriving (Show, Eq, Ord, Typeable, Functor) 209 } deriving (Show, Eq, Ord, Typeable, Functor)
208 210
211$(deriveJSON omitRecordPrefix ''PeerAddr)
212
209peer_ip_key, peer_id_key, peer_port_key :: BKey 213peer_ip_key, peer_id_key, peer_port_key :: BKey
210peer_ip_key = "ip" 214peer_ip_key = "ip"
211peer_id_key = "peer id" 215peer_id_key = "peer id"
diff --git a/src/Network/BitTorrent/Internal/Cache.hs b/src/Network/BitTorrent/Internal/Cache.hs
index 8c74467a..b77e5e82 100644
--- a/src/Network/BitTorrent/Internal/Cache.hs
+++ b/src/Network/BitTorrent/Internal/Cache.hs
@@ -32,6 +32,7 @@ module Network.BitTorrent.Internal.Cache
32 ) where 32 ) where
33 33
34import Control.Applicative 34import Control.Applicative
35import Data.Aeson
35import Data.Monoid 36import Data.Monoid
36import Data.Default 37import Data.Default
37import Data.Time 38import Data.Time
@@ -55,6 +56,19 @@ data Cached a = Cached
55 56
56-- INVARIANT: minUpdateInterval <= updateInterval 57-- INVARIANT: minUpdateInterval <= updateInterval
57 58
59-- | TODO exsample
60instance ToJSON a => ToJSON (Cached a) where
61 toJSON Cached {..}
62 | currentTime < expireTime = object
63 [ "observed" .= posixSecondsToUTCTime lastUpdated
64 , "expired" .= posixSecondsToUTCTime expireTime
65 , "data" .= cachedData
66 ]
67 | otherwise = String "cached data expired"
68 where
69 expireTime = currentTime + updateInterval
70 currentTime = unsafePerformIO getPOSIXTime
71
58instance Default (Cached a) where 72instance Default (Cached a) where
59 def = mempty 73 def = mempty
60 74
diff --git a/src/Network/BitTorrent/Tracker/Session.hs b/src/Network/BitTorrent/Tracker/Session.hs
index 59958ccd..4c61034e 100644
--- a/src/Network/BitTorrent/Tracker/Session.hs
+++ b/src/Network/BitTorrent/Tracker/Session.hs
@@ -7,6 +7,7 @@
7-- 7--
8-- Multitracker sessions. 8-- Multitracker sessions.
9-- 9--
10{-# LANGUAGE TemplateHaskell #-}
10module Network.BitTorrent.Tracker.Session 11module Network.BitTorrent.Tracker.Session
11 ( -- * Session 12 ( -- * Session
12 Session 13 Session
@@ -25,6 +26,7 @@ module Network.BitTorrent.Tracker.Session
25 , getStatus 26 , getStatus
26 27
27 -- ** Single tracker sessions 28 -- ** Single tracker sessions
29 , LastScrape (..)
28 , TrackerEntry 30 , TrackerEntry
29 , trackerURI 31 , trackerURI
30 , trackerPeers 32 , trackerPeers
@@ -42,6 +44,8 @@ import Control.Applicative
42import Control.Exception 44import Control.Exception
43import Control.Concurrent 45import Control.Concurrent
44import Control.Monad 46import Control.Monad
47import Data.Aeson
48import Data.Aeson.TH
45import Data.Default 49import Data.Default
46import Data.Fixed 50import Data.Fixed
47import Data.Foldable as F 51import Data.Foldable as F
@@ -53,6 +57,7 @@ import Data.Traversable
53import Network.URI 57import Network.URI
54 58
55import Data.Torrent.InfoHash 59import Data.Torrent.InfoHash
60import Data.Torrent.JSON
56import Network.BitTorrent.Core 61import Network.BitTorrent.Core
57import Network.BitTorrent.Internal.Cache 62import Network.BitTorrent.Internal.Cache
58import Network.BitTorrent.Tracker.List 63import Network.BitTorrent.Tracker.List
@@ -79,10 +84,15 @@ instance Default LastScrape where
79 def = LastScrape Nothing Nothing 84 def = LastScrape Nothing Nothing
80 85
81data LastScrape = LastScrape 86data LastScrape = LastScrape
82 { leechersCount :: Maybe Int 87 { -- | Count of leechers the tracker aware of.
83 , seedersCount :: Maybe Int 88 scrapeLeechers :: Maybe Int
89
90 -- | Count of seeders the tracker aware of.
91 , scrapeSeeders :: Maybe Int
84 } deriving (Show, Eq) 92 } deriving (Show, Eq)
85 93
94$(deriveJSON omitRecordPrefix ''LastScrape)
95
86-- | Single tracker session. 96-- | Single tracker session.
87data TrackerEntry = TrackerEntry 97data TrackerEntry = TrackerEntry
88 { -- | Tracker announce URI. 98 { -- | Tracker announce URI.
@@ -98,7 +108,14 @@ data TrackerEntry = TrackerEntry
98 , trackerScrape :: Cached LastScrape 108 , trackerScrape :: Cached LastScrape
99 } 109 }
100 110
101-- | Single tracker session with empty state. 111instance ToJSON TrackerEntry where
112 toJSON TrackerEntry {..} = object
113 [ "uri" .= trackerURI
114 , "peers" .= trackerPeers
115 , "scrape" .= trackerScrape
116 ]
117
118-- | Single tracker session with empty state.l
102nullEntry :: URI -> TrackerEntry 119nullEntry :: URI -> TrackerEntry
103nullEntry uri = TrackerEntry uri Nothing def def 120nullEntry uri = TrackerEntry uri Nothing def def
104 121
@@ -134,8 +151,8 @@ cacheScrape AnnounceInfo {..} =
134 newCached (seconds respInterval) 151 newCached (seconds respInterval)
135 (seconds (fromMaybe respInterval respMinInterval)) 152 (seconds (fromMaybe respInterval respMinInterval))
136 LastScrape 153 LastScrape
137 { seedersCount = respComplete 154 { scrapeSeeders = respComplete
138 , leechersCount = respIncomplete 155 , scrapeLeechers = respIncomplete
139 } 156 }
140 157
141-- | Make announce request to specific tracker returning new state. 158-- | Make announce request to specific tracker returning new state.
@@ -218,7 +235,7 @@ notifyAll mgr Session {..} event = do
218 where 235 where
219 traversal 236 traversal
220 | allNotify event = traverseAll 237 | allNotify event = traverseAll
221 | otherwise = traverseTiers 238 | otherwise = traverseTiers
222 239
223-- TODO send notifications to tracker periodically. 240-- TODO send notifications to tracker periodically.
224-- | 241-- |