starting with a clean slate

[functorrent.git] / src / FuncTorrent / Tracker / Http.hs

diff --git a/src/FuncTorrent/Tracker/Http.hs b/src/FuncTorrent/Tracker/Http.hs
deleted file mode 100644 (file)
index 13395cc..0000000
--- a/src/FuncTorrent/Tracker/Http.hs
+++ /dev/null
@@ -1,113 +0,0 @@
-{-
- - Copyright (C) 2015-2016 Ramakrishnan Muthukrishnan <ram@rkrishnan.org>
- -
- - This file is part of FuncTorrent.
- -
- - FuncTorrent is free software; you can redistribute it and/or modify
- - it under the terms of the GNU General Public License as published by
- - the Free Software Foundation; either version 3 of the License, or
- - (at your option) any later version.
- -
- - FuncTorrent is distributed in the hope that it will be useful,
- - but WITHOUT ANY WARRANTY; without even the implied warranty of
- - MERCHANTABILITY or FITNESS FOR A PARTICULAR PURPOSE.  See the
- - GNU General Public License for more details.
- -
- - You should have received a copy of the GNU General Public License
- - along with FuncTorrent; if not,  see <http://www.gnu.org/licenses/>
- -}
-
-{-# LANGUAGE OverloadedStrings #-}
-
-module FuncTorrent.Tracker.Http
-       (trackerLoop
-       ) where
-
-import Prelude hiding (lookup)
-
-import Control.Concurrent (threadDelay)
-import Control.Concurrent.MVar (readMVar, putMVar, isEmptyMVar, swapMVar)
-import Control.Monad (forever, void)
-import qualified Data.ByteString.Base16 as B16 (encode)
-import Data.ByteString (ByteString)
-import Data.ByteString.Char8 as BC (pack, unpack)
-import Data.Char (chr)
-import Data.Map as M (lookup)
-import Network (PortNumber)
-import Network.HTTP.Base (urlEncode)
-
-import qualified FuncTorrent.Bencode as Benc
-import FuncTorrent.Bencode (BVal(..))
-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(..), HttpTrackerResponse(..))
-
-
---- | URL encode hash as per RFC1738
---- TODO: Add tests
---- REVIEW: Why is this not written in terms of `Network.HTTP.Base.urlEncode` or
---- equivalent library function?
-urlEncodeHash :: ByteString -> String
-urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs)
-  where encode' b@[c1, c2] = let c =  chr (read ("0x" ++ b))
-                            in escape c c1 c2
-        encode' _ = ""
-        escape i c1 c2 | i `elem` nonSpecialChars = [i]
-                       | otherwise = "%" ++ [c1] ++ [c2]
-
-        nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~"
-
--- | Make arguments that should be posted to tracker.
--- This is a separate pure function for testability.
-mkArgs :: PortNumber -> String -> Integer -> Integer -> Integer -> ByteString -> [(String, ByteString)]
-mkArgs port peer_id up down left' infoHash =
-  [("info_hash", pack . urlEncodeHash . B16.encode $ infoHash),
-   ("peer_id", pack . urlEncode $ peer_id),
-   ("port", pack $ show port),
-   ("uploaded", pack $ show up),
-   ("downloaded", pack $ show down),
-   ("left", pack $ show left'),
-   ("compact", "1"),
-   ("event", "started")]
-
-trackerLoop :: String -> PortNumber -> String -> ByteString -> FS.MsgChannel -> TState -> IO ()
-trackerLoop url sport peerId infohash fschan tstate = forever $ do
-  st <- readMVar <$> FS.getStats fschan
-  up <- fmap FS.bytesRead st
-  down <- fmap FS.bytesWritten st
-  resp <- sendGetRequest url $ mkArgs sport peerId up down (left tstate) infohash
-  case Benc.decode resp of
-    Left e ->
-      return () -- $ pack (show e)
-    Right trackerInfo ->
-      case parseTrackerResponse trackerInfo of
-        Left e -> return ()
-        Right tresp -> do
-          ps <- isEmptyMVar $ connectedPeers tstate
-          if ps
-            then
-            putMVar (connectedPeers tstate) (peers tresp)
-            else
-            void $ swapMVar (connectedPeers tstate) (peers tresp)
-          threadDelay $ fromIntegral (interval tresp)
-
-parseTrackerResponse :: BVal -> Either ByteString HttpTrackerResponse
-parseTrackerResponse resp =
-    case lookup "failure reason" body of
-      Just (Bstr err) -> Left err
-      Just _ -> Left "Unknown failure"
-      Nothing ->
-          let (Just (Bint i)) = lookup "interval" body
-              (Just (Bstr peersBS)) = lookup "peers" body
-              pl = map makePeer (splitN 6 peersBS)
-          in Right HttpTrackerResponse {
-                   interval = i
-                 , peers = pl
-                 , complete = Nothing
-                 , incomplete = Nothing
-                 }
-    where
-      (Bdict body) = resp
-