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 9edf3fca6691149ed218f012df2a5784b826ef02..13395cc72dfc789940646eb3fb5c8f2aae3e6c7f 100644 (file)
--- 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.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
 
 
 --- | 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)
 
             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
 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)
           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
                    interval = i
                  , peers = pl
                  , complete = Nothing

diff --git a/src/FuncTorrent/Tracker/Types.hs b/src/FuncTorrent/Tracker/Types.hs
index 3adcacc8bc6ac35c24b017dc83675f37635a11a6..1c47d3191f593471457972497d490555caf549e9 100644 (file)
--- a/src/FuncTorrent/Tracker/Types.hs
+++ b/src/FuncTorrent/Tracker/Types.hs
@@ -18,15 +18,18 @@
  -}
 
 {-# LANGUAGE OverloadedStrings #-}
  -}
 
 {-# LANGUAGE OverloadedStrings #-}

+{-# LANGUAGE DuplicateRecordFields #-}

 module FuncTorrent.Tracker.Types
        ( TrackerProtocol(..)
 module FuncTorrent.Tracker.Types
        ( TrackerProtocol(..)

-       , TrackerResponse(..)
+       , HttpTrackerResponse(..)
+       , UdpTrackerResponse(..)

        , TrackerEventState(..)
        , TState(..)
        , TrackerMsg(..)
        ) where
 
 import Data.ByteString (ByteString)
        , TrackerEventState(..)
        , TState(..)
        , TrackerMsg(..)
        ) where
 
 import Data.ByteString (ByteString)

+import Data.Word (Word32)

 import Control.Concurrent.MVar (MVar)
 
 import FuncTorrent.PeerMsgs (Peer)
 import Control.Concurrent.MVar (MVar)
 
 import FuncTorrent.PeerMsgs (Peer)


@@ -51,9 +54,16 @@ data TState = TState { left :: Integer
                      }
 
 -- | Tracker response
                      }
 
 -- | Tracker response

-data TrackerResponse = TrackerResponse {
+data HttpTrackerResponse = HttpTrackerResponse {

   interval :: Integer
   , peers :: [Peer]
   , complete :: Maybe Integer
   , incomplete :: Maybe Integer
   } deriving (Show, Eq)
   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 5e98879f976a082d4611def19bef7224e20077a2..aaa99472b44c3a9d72f955afd0f35a5e8c05d534 100644 (file)
--- 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 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)
 
 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
 
   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
 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"
       if tidr == tid
       then do
         liftIO $ putStrLn "announce succeeded"

-        return $ PeerStats ls ss interval xs
+        return $ UdpTrackerResponse ls ss interval xs

       else
       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
 
 getIPPortPairs :: Get [Peer]
 getIPPortPairs = do

diff --git a/stack.yaml b/stack.yaml
index d652a8c5a8cd9c778b15cef57fff55f17d3485ac..5b69a9a0ef7257ef2f92a9a0c2e24e8efcad72ef 100644 (file)
--- 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)
 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:
 
 rebuild-ghc-options: true
 ghc-options: