Add instance ToJSON TrackerEntry

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
 import Control.Applicative
 import Control.Monad
 import Data.Aeson (ToJSON, FromJSON)
+import Data.Aeson.TH
 import Data.BEncode   as BS
 import Data.BEncode.BDict (BKey)
 import Data.ByteString.Char8 as BS8
@@ -57,6 +58,7 @@ import Text.Read (readMaybe)
 import qualified Text.ParserCombinators.ReadP as RP
 
 import Data.Torrent.InfoHash
+import Data.Torrent.JSON
 import Network.BitTorrent.Core.PeerId
 
 
@@ -206,6 +208,8 @@ data PeerAddr a = PeerAddr
   , peerPort :: {-# UNPACK #-} !PortNumber
   } deriving (Show, Eq, Ord, Typeable, Functor)
 
+$(deriveJSON omitRecordPrefix ''PeerAddr)
+
 peer_ip_key, peer_id_key, peer_port_key :: BKey
 peer_ip_key   = "ip"
 peer_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
        ) where
 
 import Control.Applicative
+import Data.Aeson
 import Data.Monoid
 import Data.Default
 import Data.Time
@@ -55,6 +56,19 @@ data Cached a = Cached
 
 -- INVARIANT: minUpdateInterval <= updateInterval
 
+-- | TODO exsample
+instance ToJSON a => ToJSON (Cached a) where
+  toJSON Cached {..}
+    | currentTime < expireTime = object
+      [ "observed" .= posixSecondsToUTCTime lastUpdated
+      , "expired"  .= posixSecondsToUTCTime expireTime
+      , "data"     .= cachedData
+      ]
+    | otherwise = String "cached data expired"
+    where
+      expireTime  = currentTime + updateInterval
+      currentTime = unsafePerformIO getPOSIXTime
+
 instance Default (Cached a) where
   def = mempty
 
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 @@
 --
 --   Multitracker sessions.
 --
+{-# LANGUAGE TemplateHaskell #-}
 module Network.BitTorrent.Tracker.Session
        ( -- * Session
          Session
@@ -25,6 +26,7 @@ module Network.BitTorrent.Tracker.Session
        , getStatus
 
          -- ** Single tracker sessions
+       , LastScrape (..)
        , TrackerEntry
        , trackerURI
        , trackerPeers
@@ -42,6 +44,8 @@ import Control.Applicative
 import Control.Exception
 import Control.Concurrent
 import Control.Monad
+import Data.Aeson
+import Data.Aeson.TH
 import Data.Default
 import Data.Fixed
 import Data.Foldable as F
@@ -53,6 +57,7 @@ import Data.Traversable
 import Network.URI
 
 import Data.Torrent.InfoHash
+import Data.Torrent.JSON
 import Network.BitTorrent.Core
 import Network.BitTorrent.Internal.Cache
 import Network.BitTorrent.Tracker.List
@@ -79,10 +84,15 @@ instance Default LastScrape where
   def = LastScrape Nothing Nothing
 
 data LastScrape = LastScrape
-  { leechersCount :: Maybe Int
-  , seedersCount  :: Maybe Int
+  { -- | Count of leechers the tracker aware of.
+    scrapeLeechers :: Maybe Int
+
+    -- | Count of seeders the tracker aware of.
+  , scrapeSeeders  :: Maybe Int
   } deriving (Show, Eq)
 
+$(deriveJSON omitRecordPrefix ''LastScrape)
+
 -- | Single tracker session.
 data TrackerEntry = TrackerEntry
   { -- | Tracker announce URI.
@@ -98,7 +108,14 @@ data TrackerEntry = TrackerEntry
   , trackerScrape :: Cached LastScrape
   }
 
--- | Single tracker session with empty state.
+instance ToJSON TrackerEntry where
+  toJSON TrackerEntry {..} = object
+    [ "uri"    .= trackerURI
+    , "peers"  .= trackerPeers
+    , "scrape" .= trackerScrape
+    ]
+
+-- | Single tracker session with empty state.l
 nullEntry :: URI -> TrackerEntry
 nullEntry uri = TrackerEntry uri Nothing def def
 
@@ -134,8 +151,8 @@ cacheScrape AnnounceInfo {..} =
   newCached (seconds respInterval)
             (seconds (fromMaybe respInterval respMinInterval))
     LastScrape
-      { seedersCount  = respComplete
-      , leechersCount = respIncomplete
+      { scrapeSeeders  = respComplete
+      , scrapeLeechers = respIncomplete
       }
 
 -- | Make announce request to specific tracker returning new state.
@@ -218,7 +235,7 @@ notifyAll mgr Session {..} event = do
   where
     traversal
       | allNotify event = traverseAll
-      |    otherwise     = traverseTiers
+      |    otherwise    = traverseTiers
 
 -- TODO send notifications to tracker periodically.
 -- |