From: Ramakrishnan Muthukrishnan Date: Sat, 25 Jun 2016 01:31:59 +0000 (+0530) Subject: Tracker/Udp: cleanup of warnings X-Git-Url: https://git.rkrishnan.org/%5B/%5D%20/uri/%22doc.html/flags/frontends?a=commitdiff_plain;h=2b7c4456d2a16f9392108b617c4147c429f1ce59;p=functorrent.git Tracker/Udp: cleanup of warnings --- diff --git a/src/FuncTorrent/Tracker/Udp.hs b/src/FuncTorrent/Tracker/Udp.hs index dfc1233..ae7ad1e 100644 --- a/src/FuncTorrent/Tracker/Udp.hs +++ b/src/FuncTorrent/Tracker/Udp.hs @@ -23,7 +23,7 @@ module FuncTorrent.Tracker.Udp ) where import Control.Applicative (liftA2) -import Control.Monad (liftM, forever, void) +import Control.Monad (forever, void) import Control.Concurrent (threadDelay) import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar) import Control.Monad.Reader (ReaderT, runReaderT, ask, liftIO) @@ -42,7 +42,7 @@ import System.Timeout (timeout) import FuncTorrent.PeerMsgs (Peer(..)) import FuncTorrent.Tracker.Types (TrackerEventState(..), TState(..), UdpTrackerResponse(..)) -import FuncTorrent.Utils (IP, Port, toIP, toPort, getHostname, getPort) +import FuncTorrent.Utils (Port, toIP, toPort, getHostname, getPort) import qualified FuncTorrent.FileSystem as FS (MsgChannel, Stats(..), getStats) -- UDP tracker: http://bittorrent.org/beps/bep_0015.html @@ -64,7 +64,6 @@ data UDPResponse = ConnectResp Word32 Word64 -- transaction_id connection_id data UDPTrackerHandle = UDPTrackerHandle { sock :: Socket , addr :: SockAddr - , tid :: Word32 } actionToInteger :: Action -> Integer @@ -72,11 +71,6 @@ actionToInteger Connect = 0 actionToInteger Announce = 1 actionToInteger Scrape = 2 -intToAction :: Integer -> Action -intToAction 0 = Connect -intToAction 1 = Announce -intToAction 2 = Scrape - eventToInteger :: TrackerEventState -> Integer eventToInteger None = 0 eventToInteger Completed = 1 @@ -88,14 +82,14 @@ instance Binary UDPRequest where putWord64be 0x41727101980 putWord32be $ fromIntegral (actionToInteger Connect) putWord32be (fromIntegral transId) - put (AnnounceReq connId transId infohash peerId down left up event port) = do + put (AnnounceReq connId transId infohash peerId down left' up event port) = do putWord64be $ fromIntegral connId putWord32be $ fromIntegral (actionToInteger Announce) putWord32be $ fromIntegral transId putByteString infohash putByteString (BC.pack peerId) putWord64be (fromIntegral down) - putWord64be (fromIntegral left) + putWord64be (fromIntegral left') putWord64be (fromIntegral up) putWord32be $ fromIntegral (eventToInteger event) putWord32be 0 @@ -112,22 +106,22 @@ instance Binary UDPResponse where case a of 0 -> liftA2 ConnectResp (fromIntegral <$> getWord32be) (fromIntegral <$> getWord64be) 1 -> do - tid <- fromIntegral <$> getWord32be + tid' <- fromIntegral <$> getWord32be interval' <- fromIntegral <$> getWord32be l <- getWord32be -- leechers s <- getWord32be -- seeders ipportpairs <- getIPPortPairs -- [(ip, port)] - return $ AnnounceResp tid interval' l s ipportpairs + return $ AnnounceResp tid' interval' l s ipportpairs 2 -> do - tid <- fromIntegral <$> getWord32be + tid' <- fromIntegral <$> getWord32be _ <- getWord32be _ <- getWord32be _ <- getWord32be - return $ ScrapeResp tid 0 0 0 + return $ ScrapeResp tid' 0 0 0 3 -> do -- error response - tid <- fromIntegral <$> getWord32be + tid' <- fromIntegral <$> getWord32be bs <- getByteString 4 - return $ ErrorResp tid $ BC.unpack bs + return $ ErrorResp tid' $ BC.unpack bs _ -> error ("unknown response action type: " ++ show a) sendRequest :: UDPTrackerHandle -> ByteString -> IO () @@ -165,10 +159,10 @@ connectResponse tid = do _ -> return 0 announceRequest :: Word64 -> ByteString -> String -> Word64 -> Word64 -> Word64 -> Word16 -> ReaderT UDPTrackerHandle IO Word32 -announceRequest cid infohash peerId up down left port = do +announceRequest cid infohash peerId up down left' port = do h <- ask tidi <- liftIO randomIO - let pkt = encode $ AnnounceReq cid tidi infohash peerId down left up None port + let pkt = encode $ AnnounceReq cid tidi infohash peerId down left' up None port liftIO $ sendRequest h (toStrict pkt) return tidi @@ -177,11 +171,11 @@ announceResponse tid = do h <- ask resp <- liftIO $ recvResponse h case resp of - (AnnounceResp tidr interval ss ls xs) -> + (AnnounceResp tidr interval' ss ls xs) -> if tidr == tid then do liftIO $ putStrLn "announce succeeded" - return $ UdpTrackerResponse ls ss interval xs + return $ UdpTrackerResponse ls ss interval' xs else return $ UdpTrackerResponse 0 0 0 [] _ -> return $ UdpTrackerResponse 0 0 0 [] @@ -207,7 +201,7 @@ startSession host port = do , addr = (SockAddrInet (fromIntegral port) ip) } closeSession :: UDPTrackerHandle -> IO () -closeSession (UDPTrackerHandle s _ _) = close s +closeSession (UDPTrackerHandle s _) = close s trackerLoop :: String -> PortNumber -> String -> ByteString -> FS.MsgChannel -> TState -> IO () trackerLoop url sport peerId infohash fschan tstate = forever $ do @@ -215,7 +209,7 @@ trackerLoop url sport peerId infohash fschan tstate = forever $ do up <- fmap FS.bytesRead st down <- fmap FS.bytesWritten st handle <- startSession host port - stats <- timeout (15*(10^6)) $ worker handle up down + stats <- timeout (15*oneSec) $ worker handle up down case stats of Nothing -> closeSession handle Just stats' -> do @@ -225,9 +219,10 @@ trackerLoop url sport peerId infohash fschan tstate = forever $ do putMVar (connectedPeers tstate) (peers stats') else void $ swapMVar (connectedPeers tstate) (peers stats') - threadDelay $ fromIntegral (interval stats') * (10^6) + threadDelay $ fromIntegral (interval stats') * oneSec return () where + oneSec = 1000000 port = getPort url host = getHostname url worker handle up down = flip runReaderT handle $ do