~ Give more reasonable name for tracker messages.

Announce request/response is not only request/response types!
Moreover we can unify and reuse UDP and HTTP tracker messages.

2 files changed, 31 insertions, 32 deletions

diff --git a/src/Network/BitTorrent/Tracker.hs b/src/Network/BitTorrent/Tracker.hs
index 25d2c358..7a43fb23 100644
--- a/src/Network/BitTorrent/Tracker.hs
+++ b/src/Network/BitTorrent/Tracker.hs
@@ -88,8 +88,8 @@ tconnection t = TConnection (tAnnounce t) (tInfoHash t)
 
 
 -- | used to avoid boilerplate; do NOT export me
-genericReq :: TConnection -> Progress -> TRequest
-genericReq ses pr =   TRequest {
+genericReq :: TConnection -> Progress -> AnnounceQuery
+genericReq ses pr =   AnnounceQuery {
     reqInfoHash   = tconnInfoHash ses
   , reqPeerId     = tconnPeerId   ses
   , reqPort       = tconnPort     ses
@@ -107,7 +107,7 @@ genericReq ses pr =   TRequest {
 -- | The first request to the tracker that should be created is
 --   'startedReq'. It includes necessary 'Started' event field.
 --
-startedReq :: TConnection -> Progress -> TRequest
+startedReq :: TConnection -> Progress -> AnnounceQuery
 startedReq ses pr = (genericReq ses pr) {
     reqIP         = Nothing
   , reqNumWant    = Just defaultNumWant
@@ -118,7 +118,7 @@ startedReq ses pr = (genericReq ses pr) {
 --   notify tracker about current state of the client
 --   so new peers could connect to the client.
 --
-regularReq :: Int -> TConnection -> Progress -> TRequest
+regularReq :: Int -> TConnection -> Progress -> AnnounceQuery
 regularReq numWant ses pr = (genericReq ses pr) {
     reqIP         = Nothing
   , reqNumWant    = Just numWant
@@ -128,7 +128,7 @@ regularReq numWant ses pr = (genericReq ses pr) {
 -- | Must be sent to the tracker if the client is shutting down
 -- gracefully.
 --
-stoppedReq :: TConnection -> Progress -> TRequest
+stoppedReq :: TConnection -> Progress -> AnnounceQuery
 stoppedReq ses pr = (genericReq ses pr) {
     reqIP         = Nothing
   , reqNumWant    = Nothing
@@ -139,7 +139,7 @@ stoppedReq ses pr = (genericReq ses pr) {
 -- However, must not be sent if the download was already 100%
 -- complete.
 --
-completedReq :: TConnection -> Progress -> TRequest
+completedReq :: TConnection -> Progress -> AnnounceQuery
 completedReq ses pr = (genericReq ses pr) {
     reqIP         = Nothing
   , reqNumWant    = Nothing
@@ -233,7 +233,7 @@ withTracker initProgress conn action = bracket start end (action . fst)
         resp <- tryJust isIOException $ do
                     askTracker (tconnAnnounce conn) (regularReq defaultNumWant conn pr)
         case resp of
-          Right (OK {..}) -> do
+          Right (AnnounceInfo {..}) -> do
             writeIORef seInterval respInterval
 
             -- we rely on the fact that union on lists is not
diff --git a/src/Network/BitTorrent/Tracker/Protocol.hs b/src/Network/BitTorrent/Tracker/Protocol.hs
index e844f8b8..95d82b36 100644
--- a/src/Network/BitTorrent/Tracker/Protocol.hs
+++ b/src/Network/BitTorrent/Tracker/Protocol.hs
@@ -22,9 +22,8 @@
 {-# LANGUAGE RecordWildCards            #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE FlexibleInstances #-}
--- TODO: add "compact" field to TRequest
 module Network.BitTorrent.Tracker.Protocol
-       ( Event(..), TRequest(..), TResponse(..)
+       ( Event(..), AnnounceQuery(..), AnnounceInfo(..)
        , askTracker, leaveTracker
 
          -- * Defaults
@@ -55,7 +54,7 @@ import Network.URI
 import Network.BitTorrent.Peer
 
 {-----------------------------------------------------------------------
-  Tracker messages
+  Tracker Announce
 -----------------------------------------------------------------------}
 
 -- | Events used to specify which kind of tracker request is performed.
@@ -73,7 +72,7 @@ data Event = Started
 --   the torrent. The most important, requests are used by the tracker
 --   to keep track lists of active peer for a particular torrent.
 --
-data TRequest = TRequest { -- TODO peer here
+data AnnounceQuery = AnnounceQuery {
      reqInfoHash   :: !InfoHash
      -- ^ Hash of info part of the torrent usually obtained from
      -- 'Torrent'.
@@ -112,9 +111,9 @@ data TRequest = TRequest { -- TODO peer here
 --   participate in the torrent. The most important is 'respPeer' list
 --   used to join the swarm.
 --
-data TResponse =
+data AnnounceInfo =
      Failure Text -- ^ Failure reason in human readable form.
-   | OK { -- TODO rename to anounce
+   | AnnounceInfo {
        respWarning     ::  Maybe Text
        -- ^ Human readable warning.
 
@@ -138,12 +137,12 @@ data TResponse =
      } deriving Show
 
 {-----------------------------------------------------------------------
-  HTTP Tracker encoding
+  HTTP Announce
 -----------------------------------------------------------------------}
 
-instance BEncodable TResponse where
-  toBEncode (Failure t)  = fromAssocs ["failure reason" --> t]
-  toBEncode (OK {..})    = fromAssocs
+instance BEncodable AnnounceInfo where
+  toBEncode (Failure t)        = fromAssocs ["failure reason" --> t]
+  toBEncode  AnnounceInfo {..} = fromAssocs
     [ "interval"     -->  respInterval
     , "min interval" -->? respMinInterval
     , "complete"     -->? respComplete
@@ -153,7 +152,8 @@ instance BEncodable TResponse where
 
   fromBEncode (BDict d)
     | Just t <- M.lookup "failure reason" d = Failure <$> fromBEncode t
-    | otherwise = OK <$> d >--? "warning message"
+    | otherwise = AnnounceInfo
+                     <$> d >--? "warning message"
                      <*> d >--  "interval"
                      <*> d >--? "min interval"
                      <*> d >--? "complete"
@@ -165,7 +165,7 @@ instance BEncodable TResponse where
         getPeers (Just (BString s))   = runGet getCompactPeerList s
         getPeers  _                   = decodingError "Peers"
 
-  fromBEncode _ = decodingError "TResponse"
+  fromBEncode _ = decodingError "AnnounceInfo"
 
 instance URLShow PortNumber where
   urlShow = urlShow . fromEnum
@@ -179,8 +179,8 @@ instance URLShow Event where
       -- INVARIANT: this is always nonempty list
       (x : xs) = show e
 
-instance URLEncode TRequest where
-  urlEncode TRequest {..} = mconcat
+instance URLEncode AnnounceQuery where
+  urlEncode AnnounceQuery {..} = mconcat
       [ s "peer_id"    %=  reqPeerId
       , s "port"       %=  reqPort
       , s "uploaded"   %=  reqUploaded
@@ -192,13 +192,13 @@ instance URLEncode TRequest where
       ]
     where s :: String -> String;  s = id; {-# INLINE s #-}
 
-encodeRequest :: URI -> TRequest -> URI
+encodeRequest :: URI -> AnnounceQuery -> URI
 encodeRequest announce req = URL.urlEncode req
                     `addToURI`      announce
                     `addHashToURI`  reqInfoHash req
 
 {-----------------------------------------------------------------------
-  UDP tracker encoding
+  UDP announce
 -----------------------------------------------------------------------}
 
 type EventId = Word32
@@ -223,8 +223,8 @@ getEvent = do
     3 -> return $ Just Stopped
     _ -> fail "unknown event id"
 
-instance Serialize TRequest where
-  put TRequest {..} = do
+instance Serialize AnnounceQuery where
+  put AnnounceQuery {..} = do
     put           reqInfoHash
     put           reqPeerId
 
@@ -254,7 +254,7 @@ instance Serialize TRequest where
 
     port <- get
 
-    return $ TRequest {
+    return $ AnnounceQuery {
         reqInfoHash   = ih
       , reqPeerId     = pid
       , reqPort       = port
@@ -266,9 +266,9 @@ instance Serialize TRequest where
       , reqEvent      = ev
       }
 
-instance Serialize TResponse where
+instance Serialize AnnounceInfo where
   put (Failure msg) = put $ encodeUtf8 msg
-  put OK {..} = do
+  put  AnnounceInfo {..} = do
     putWord32be $ fromIntegral respInterval
     putWord32be $ fromIntegral $ fromMaybe 0 respIncomplete
     putWord32be $ fromIntegral $ fromMaybe 0 respComplete
@@ -280,7 +280,7 @@ instance Serialize TResponse where
     seeders  <- getWord32be
     peers    <- many get
 
-    return $ OK {
+    return $ AnnounceInfo {
         respWarning     = Nothing
       , respInterval    = fromIntegral interval
       , respMinInterval = Nothing
@@ -289,7 +289,6 @@ instance Serialize TResponse where
       , respPeers       = peers
       }
 
-
 {-----------------------------------------------------------------------
   Tracker
 -----------------------------------------------------------------------}
@@ -316,7 +315,7 @@ mkHTTPRequest uri = Request uri GET [] ""
 -- announce list. This function throws 'IOException' if it couldn't
 -- send request or receive response or decode response.
 --
-askTracker :: URI -> TRequest -> IO TResponse
+askTracker :: URI -> AnnounceQuery -> IO AnnounceInfo
 askTracker announce req = do
     let r = mkHTTPRequest (encodeRequest announce req)
 
@@ -333,7 +332,7 @@ askTracker announce req = do
 
 -- | The same as the 'askTracker' but ignore response. Used in
 -- conjunction with 'Stopped'.
-leaveTracker :: URI -> TRequest -> IO ()
+leaveTracker :: URI -> AnnounceQuery -> IO ()
 leaveTracker announce req = do
   let r = mkHTTPRequest (encodeRequest announce req)
   void $ simpleHTTP r >>= getResponseBody