From: Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
Date: Sun, 19 Jun 2016 15:20:27 +0000 (+0530)
Subject: refactoring: return type of tracker
X-Git-Url: https://git.rkrishnan.org/a?a=commitdiff_plain;h=272216c101f5f411726898f90355956ab9a105b7;p=functorrent.git

refactoring: return type of tracker

Needs DuplicateRecordFields from GHC 8.0.x to compile
---

diff --git a/src/FuncTorrent/Tracker/Http.hs b/src/FuncTorrent/Tracker/Http.hs
index 9edf3fc..13395cc 100644
--- a/src/FuncTorrent/Tracker/Http.hs
+++ b/src/FuncTorrent/Tracker/Http.hs
@@ -42,7 +42,7 @@ import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats)
 import FuncTorrent.Network (sendGetRequest)
 import FuncTorrent.PeerMsgs (makePeer)
 import FuncTorrent.Utils (splitN, IP, Port)
-import FuncTorrent.Tracker.Types(TState(..), TrackerResponse(..))
+import FuncTorrent.Tracker.Types(TState(..), HttpTrackerResponse(..))
 
 
 --- | URL encode hash as per RFC1738
@@ -93,7 +93,7 @@ trackerLoop url sport peerId infohash fschan tstate = forever $ do
             void $ swapMVar (connectedPeers tstate) (peers tresp)
           threadDelay $ fromIntegral (interval tresp)
 
-parseTrackerResponse :: BVal -> Either ByteString TrackerResponse
+parseTrackerResponse :: BVal -> Either ByteString HttpTrackerResponse
 parseTrackerResponse resp =
     case lookup "failure reason" body of
       Just (Bstr err) -> Left err
@@ -102,7 +102,7 @@ parseTrackerResponse resp =
           let (Just (Bint i)) = lookup "interval" body
               (Just (Bstr peersBS)) = lookup "peers" body
               pl = map makePeer (splitN 6 peersBS)
-          in Right TrackerResponse {
+          in Right HttpTrackerResponse {
                    interval = i
                  , peers = pl
                  , complete = Nothing
diff --git a/src/FuncTorrent/Tracker/Types.hs b/src/FuncTorrent/Tracker/Types.hs
index 3adcacc..1c47d31 100644
--- a/src/FuncTorrent/Tracker/Types.hs
+++ b/src/FuncTorrent/Tracker/Types.hs
@@ -18,15 +18,18 @@
  -}
 
 {-# LANGUAGE OverloadedStrings #-}
+{-# LANGUAGE DuplicateRecordFields #-}
 module FuncTorrent.Tracker.Types
        ( TrackerProtocol(..)
-       , TrackerResponse(..)
+       , HttpTrackerResponse(..)
+       , UdpTrackerResponse(..)
        , TrackerEventState(..)
        , TState(..)
        , TrackerMsg(..)
        ) where
 
 import Data.ByteString (ByteString)
+import Data.Word (Word32)
 import Control.Concurrent.MVar (MVar)
 
 import FuncTorrent.PeerMsgs (Peer)
@@ -51,9 +54,16 @@ data TState = TState { left :: Integer
                      }
 
 -- | Tracker response
-data TrackerResponse = TrackerResponse {
+data HttpTrackerResponse = HttpTrackerResponse {
   interval :: Integer
   , peers :: [Peer]
   , complete :: Maybe Integer
   , incomplete :: Maybe Integer
   } deriving (Show, Eq)
+
+data UdpTrackerResponse = UdpTrackerResponse {
+  leechers :: Word32
+  , seeders :: Word32
+  , interval :: Word32
+  , peers :: [Peer]
+  } deriving (Show)
diff --git a/src/FuncTorrent/Tracker/Udp.hs b/src/FuncTorrent/Tracker/Udp.hs
index 5e98879..aaa9947 100644
--- a/src/FuncTorrent/Tracker/Udp.hs
+++ b/src/FuncTorrent/Tracker/Udp.hs
@@ -40,7 +40,7 @@ import System.Random (randomIO)
 import System.Timeout (timeout)
 
 import FuncTorrent.PeerMsgs (Peer(..))
-import FuncTorrent.Tracker.Types (TrackerEventState(..), TState(..))
+import FuncTorrent.Tracker.Types (TrackerEventState(..), TState(..), UdpTrackerResponse(..))
 import FuncTorrent.Utils (IP, Port, toIP, toPort, getHostname, getPort)
 import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats)
 
@@ -171,13 +171,7 @@ announceRequest cid infohash peerId up down left port = do
   liftIO $ sendRequest h (toStrict pkt)
   return tidi
 
-data PeerStats = PeerStats { leechers :: Word32
-                           , seeders :: Word32
-                           , interval :: Word32
-                           , peers :: [Peer]
-                           } deriving (Show)
-
-announceResponse :: Word32 -> ReaderT UDPTrackerHandle IO PeerStats
+announceResponse :: Word32 -> ReaderT UDPTrackerHandle IO UdpTrackerResponse
 announceResponse tid = do
   h <- ask
   resp <- liftIO $ recvResponse h
@@ -186,10 +180,10 @@ announceResponse tid = do
       if tidr == tid
       then do
         liftIO $ putStrLn "announce succeeded"
-        return $ PeerStats ls ss interval xs
+        return $ UdpTrackerResponse ls ss interval xs
       else
-        return $ PeerStats 0 0 0 []
-    _ -> return $ PeerStats 0 0 0 []
+        return $ UdpTrackerResponse 0 0 0 []
+    _ -> return $ UdpTrackerResponse 0 0 0 []
 
 getIPPortPairs :: Get [Peer]
 getIPPortPairs = do
diff --git a/stack.yaml b/stack.yaml
index d652a8c..5b69a9a 100644
--- a/stack.yaml
+++ b/stack.yaml
@@ -13,7 +13,7 @@ packages:
 extra-deps: []
 
 # Specifies the GHC version and set of packages available (e.g., lts-3.5, nightly-2015-09-21, ghc-7.10.2)
-resolver: lts-5.2
+resolver: nightly-2016-06-19
 
 rebuild-ghc-options: true
 ghc-options: