Clean up tracker network code

- Made info_hash an attribute of meta info
- Refactored a `get` function
- Removed few more useless types
- Cleaned up log messages
- Remove unnecessary Url type
- Fix double urlEncode

TIL You should ideally always write total functions in Haskell.

diff --git a/src/FuncTorrent.hs b/src/FuncTorrent.hs
index b942f5e4008a2bebd7b26e5574f0d3899fad5aad..67fc309a8922355d8c02f3aeba8eedef470e9d65 100644 (file)
--- a/src/FuncTorrent.hs
+++ b/src/FuncTorrent.hs
@@ -1,27 +1,19 @@
 module FuncTorrent
     (BVal(..),
-     Info,
-     InfoDict,
-     Metainfo,
+     Info(..),
+     Metainfo(..),
      Peer,
      TrackerResponse(..),
-     announceList,
      connect,
      decode,
      encode,
      handShakeMsg,
-     info,
-     infoHash,
      initLogger,
-     lengthInBytes,
      logMessage,
      logStop,
      mkInfo,
      mkMetaInfo,
-     mkTrackerResponse,
-     name,
-     prepareRequest,
-     urlEncodeHash
+     mkTrackerResponse
     ) where
 
 import FuncTorrent.Bencode

diff --git a/src/FuncTorrent/Bencode.hs b/src/FuncTorrent/Bencode.hs
index bbeca650a6eca2c8a9b78050f5671ec36de418a9..2b641a7f4b51f57b8ef4f831c6156a20f79c054c 100644 (file)
--- a/src/FuncTorrent/Bencode.hs
+++ b/src/FuncTorrent/Bencode.hs
@@ -1,14 +1,13 @@
 {-# LANGUAGE OverloadedStrings #-}
-module FuncTorrent.Bencode (
-      BVal(..)
-    , InfoDict
-    , bstrToString
-    , bValToInteger
-    , bValToInfoDict
+module FuncTorrent.Bencode
+    (BVal(..)
     , bValToBList
     , bValToBstr
-    , encode
+    , bValToInfoDict
+    , bValToInteger
+    , bstrToString
     , decode
+    , encode
     ) where
 
 import Prelude hiding (length, concat)
@@ -24,7 +23,7 @@ import qualified Text.Parsec.ByteString as ParsecBS
 data BVal = Bint Integer
           | Bstr ByteString
           | Blist [BVal]
-          | Bdict InfoDict
+          | Bdict (Map String BVal)
             deriving (Ord, Eq, Show)
 
 -- getters
@@ -40,15 +39,13 @@ bValToBList :: BVal    -> Maybe [BVal]
 bValToBList (Blist lst) = Just lst
 bValToBList _           = Nothing
 
-bValToInfoDict :: BVal     -> Maybe InfoDict
+bValToInfoDict :: BVal     -> Maybe (Map String BVal)
 bValToInfoDict (Bdict dict) = Just dict
 bValToInfoDict _            = Nothing
 
 bstrToString :: BVal -> Maybe String
 bstrToString bval     = unpack <$> bValToBstr bval
 
-type InfoDict = Map String BVal
-
 -- $setup
 -- >>> import Data.Either
 
@@ -122,7 +119,7 @@ bencList = do _ <- spaces
 -- Right (fromList [("spam",Blist [Bstr "a",Bstr "b"])])
 -- >>> parse bencDict "Bdict" (pack "d9:publisher3:bob17:publisher-webpage15:www.example.com18:publisher.location4:homee")
 -- Right (fromList [("publisher",Bstr "bob"),("publisher-webpage",Bstr "www.example.com"),("publisher.location",Bstr "home")])
-bencDict :: ParsecBS.Parser InfoDict
+bencDict :: ParsecBS.Parser (Map String BVal)
 bencDict = between (char 'd') (char 'e') $ fromList <$> many kvpair
   where kvpair = do k <- bencStr
                     v <- bencVal

diff --git a/src/FuncTorrent/Logger.hs b/src/FuncTorrent/Logger.hs
index 255809bde72cbda14bb9fcfeb707f4c113183104..81bc9f40ae124675d0f70dc27484a3c3ee6762d5 100644 (file)
--- a/src/FuncTorrent/Logger.hs
+++ b/src/FuncTorrent/Logger.hs
@@ -16,7 +16,6 @@ import Control.Concurrent
 --
 -- The MVar in stop is just to ensure the logger thread executes completely
 -- Before exiting the main application.
---
 data Logger = Logger (MVar LogCommand)
 data LogCommand = Message String | Stop (MVar ())
 

diff --git a/src/FuncTorrent/Metainfo.hs b/src/FuncTorrent/Metainfo.hs
index 1695b596f902e20acd15c0233134d55825028b72..a3313d18cbb5c6338de4a38466719af25ad47258 100644 (file)
--- a/src/FuncTorrent/Metainfo.hs
+++ b/src/FuncTorrent/Metainfo.hs
@@ -1,7 +1,6 @@
 module FuncTorrent.Metainfo
     (Info(..),
      Metainfo(..),
-     infoHash,
      mkInfo,
      mkMetaInfo
     ) where
@@ -12,7 +11,7 @@ import Data.Map as M ((!), lookup)
 import Crypto.Hash.SHA1 (hash)
 import Data.Maybe (maybeToList)
 
-import FuncTorrent.Bencode (BVal(..), InfoDict, encode, bstrToString, bValToInteger)
+import FuncTorrent.Bencode (BVal(..), encode, bstrToString, bValToInteger)
 
 -- only single file mode supported for the time being.
 data Info = Info { pieceLength :: !Integer
@@ -29,6 +28,7 @@ data Metainfo = Metainfo { info :: !Info
                          , comment :: !(Maybe String)
                          , createdBy :: !(Maybe String)
                          , encoding :: !(Maybe String)
+                         , infoHash :: !ByteString
                          } deriving (Eq, Show)
 
 mkInfo :: BVal -> Maybe Info
@@ -63,7 +63,9 @@ mkMetaInfo (Bdict m)  =
            , comment      = bstrToString  =<< comment'
            , createdBy    = bstrToString  =<< createdBy'
            , encoding     = bstrToString  =<< encoding'
+           , infoHash     = hash . encode $ (m ! "info")
         }
+
 mkMetaInfo _ = Nothing
 
 getAnnounceList :: Maybe BVal -> [String]
@@ -78,9 +80,3 @@ getAnnounceList (Just (Blist l)) = map (\s -> case s of
                                                _ -> "") l
 
 getAnnounceList (Just (Bdict _)) = []
-
--- | Info hash is urlencoded 20 byte SHA1 hash of the value of the info key from
--- the Metainfo file. Note that the value will be a bencoded dictionary, given
--- the definition of the info key above. TODO: `Metainfo -> ByteString`
-infoHash :: InfoDict -> ByteString
-infoHash m = hash . encode $ (m ! "info")

diff --git a/src/FuncTorrent/Peer.hs b/src/FuncTorrent/Peer.hs
index 96c66b0c020f57a44d1153686f6134f3bda92aba..b0c546b9b5abae16d8260290ec0054f06b1db55a 100644 (file)
--- a/src/FuncTorrent/Peer.hs
+++ b/src/FuncTorrent/Peer.hs
@@ -11,14 +11,13 @@ import Data.ByteString.Lazy (toChunks)
 import Data.Int (Int8)
 import qualified Data.Binary as Bin (encode)
 
-import FuncTorrent.Bencode (InfoDict)
-import FuncTorrent.Metainfo (infoHash)
+import FuncTorrent.Metainfo (Metainfo(..))
 
 -- | Peer is a IP address, port tuple
 data Peer = Peer String Integer
             deriving (Show, Eq)
 
-handShakeMsg :: InfoDict -> String -> ByteString
+handShakeMsg :: Metainfo -> String -> ByteString
 handShakeMsg m peer_id = concat [pstrlen, pstr, reserved, infoH, peerID]
     where pstrlen = concat $ toChunks $ Bin.encode (19 :: Int8)
           pstr = pack "BitTorrent protocol"

diff --git a/src/FuncTorrent/Tracker.hs b/src/FuncTorrent/Tracker.hs
index 8d2b3ec7ce38196578155180beb8b2881b80066b..749f75d2780a9ee9214df4c7614964ead14303e7 100644 (file)
--- a/src/FuncTorrent/Tracker.hs
+++ b/src/FuncTorrent/Tracker.hs
@@ -2,26 +2,28 @@
 module FuncTorrent.Tracker
     (TrackerResponse(..),
      connect,
+     mkArgs,
+     mkParams,
      mkTrackerResponse,
-     prepareRequest,
      urlEncodeHash
     ) where
 
 import Prelude hiding (lookup, concat, replicate, splitAt)
-import Data.ByteString.Char8 (ByteString, unpack, splitAt)
+
+import Data.ByteString (ByteString)
+import Data.ByteString.Char8 as BC (pack, unpack, splitAt, concat, intercalate)
 import Data.Char (chr)
 import Data.List (intercalate)
 import Data.Map as M (lookup)
-import Data.Maybe (fromJust)
 import Network.HTTP (simpleHTTP, defaultGETRequest_, getResponseBody)
 import Network.HTTP.Base (urlEncode)
 import Network.URI (parseURI)
 import qualified Data.ByteString.Base16 as B16 (encode)
 
-import FuncTorrent.Bencode (BVal(..), InfoDict)
-import FuncTorrent.Metainfo (infoHash)
+import FuncTorrent.Bencode (BVal(..))
 import FuncTorrent.Peer (Peer(..))
 import FuncTorrent.Utils (splitN)
+import FuncTorrent.Metainfo (Info(..), Metainfo(..))
 
 
 -- | Tracker response
@@ -32,8 +34,6 @@ data TrackerResponse = TrackerResponse {
     , incomplete :: Maybe Integer
     } deriving (Show, Eq)
 
-type Url = String
-
 -- | Deserialize tracker response
 mkTrackerResponse :: BVal -> Either ByteString TrackerResponse
 mkTrackerResponse resp =
@@ -60,7 +60,7 @@ mkTrackerResponse resp =
       toPort = read . ("0x" ++) . unpack . B16.encode
 
       toIP :: ByteString -> String
-      toIP = intercalate "." .
+      toIP = Data.List.intercalate "." .
              map (show . toInt . ("0x" ++) . unpack) .
                  splitN 2 . B16.encode
 
@@ -68,11 +68,14 @@ mkTrackerResponse resp =
       makePeer peer = Peer (toIP ip') (toPort port')
           where (ip', port') = splitAt 4 peer
 
+-- | Connect to a tracker and get peer info
+connect :: Metainfo -> String -> IO ByteString
+connect m peer_id = get (head . announceList $ m) $ mkArgs m peer_id
 
--- | urlEncodeHash
---
--- >>> urlEncodeHash $ pack "123456789abcdef123456789abcdef123456789a"
--- "%124Vx%9a%bc%de%f1%23Eg%89%ab%cd%ef%124Vx%9a"
+--- | 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))
@@ -83,18 +86,26 @@ urlEncodeHash bs = concatMap (encode' . unpack) (splitN 2 bs)
 
         nonSpecialChars = ['A'..'Z'] ++ ['a'..'z'] ++ ['0'..'9'] ++ "-_.~"
 
-prepareRequest :: InfoDict -> String -> Integer -> String
-prepareRequest d peer_id len =
-  let p = [("info_hash", urlEncodeHash ((B16.encode . infoHash) d)),
-           ("peer_id", urlEncode peer_id),
-           ("port", "6881"),
-           ("uploaded", "0"),
-           ("downloaded", "0"),
-           ("left", show len),
-           ("compact", "1"),
-           ("event", "started")]
-  in intercalate "&" [f ++ "=" ++ s | (f,s) <- p]
-
-connect :: Url -> String -> IO ByteString
-connect baseurl qstr = simpleHTTP (defaultGETRequest_ url) >>= getResponseBody
-    where url = fromJust . parseURI $ (baseurl ++ "?" ++ qstr)
+-- | Make arguments that should be posted to tracker.
+-- This is a separate pure function for testability.
+mkArgs :: Metainfo -> String -> [(String, ByteString)]
+mkArgs m peer_id = [("info_hash", pack . urlEncodeHash . B16.encode . infoHash $ m),
+                    ("peer_id", pack . urlEncode $ peer_id),
+                    ("port", "6881"),
+                    ("uploaded", "0"),
+                    ("downloaded", "0"),
+                    ("left", pack . show . lengthInBytes $ info m),
+                    ("compact", "1"),
+                    ("event", "started")]
+
+-- | Make a query string from a alist of k, v
+-- TODO: Url encode each argument
+mkParams :: [(String, ByteString)] -> ByteString
+mkParams params = BC.intercalate "&" [concat [pack f, "=", s] | (f,s) <- params]
+
+get :: String -> [(String, ByteString)] -> IO ByteString
+get url args = simpleHTTP (defaultGETRequest_ url') >>= getResponseBody
+    where url' = case parseURI $ unpack $ concat [pack url, "?", qstr] of
+                   Just x -> x
+                   _ -> error "Bad tracker URL"
+          qstr = mkParams args

diff --git a/src/Main.hs b/src/Main.hs
index 3537e48865c4d08d3a91f9f7908e01bd8554b7be..791b4b58089b2ae7257aace05d0ba163f5f15879 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,18 +1,18 @@
 {-# LANGUAGE OverloadedStrings #-}
 module Main where
 
-import Prelude hiding (length, readFile, writeFile)
+import Prelude hiding (log, length, readFile, writeFile)
 import Data.ByteString.Char8 (ByteString, readFile, writeFile, length, unpack)
 import System.Environment (getArgs)
 import System.Exit (exitSuccess)
 import System.Directory (doesFileExist)
 import Text.ParserCombinators.Parsec (ParseError)
 
-import FuncTorrent.Bencode (decode, BVal(..))
+import FuncTorrent.Bencode (decode)
 import FuncTorrent.Logger (initLogger, logMessage, logStop)
 import FuncTorrent.Metainfo (Info(..), Metainfo(..), mkMetaInfo)
 import FuncTorrent.Peer (handShakeMsg)
-import FuncTorrent.Tracker (connect, prepareRequest, peers, mkTrackerResponse)
+import FuncTorrent.Tracker (connect, peers, mkTrackerResponse)
 
 logError :: ParseError -> (String -> IO ()) -> IO ()
 logError e logMsg = logMsg $ "parse error: \n" ++ show e
@@ -39,25 +39,24 @@ main :: IO ()
 main = do
     args <- getArgs
     logR <- initLogger
-    let logMsg = logMessage logR
-    logMsg $ "Parsing input file: " ++ concat args
+    let log = logMessage logR
+    log "Starting up functorrent"
+    log $ "Parsing input file " ++ concat args
     torrentStr <- parse args
     case decode torrentStr of
       Right d ->
           case mkMetaInfo d of
-            Nothing -> logMsg "parse error"
+            Nothing -> log "Unable to make meta info file"
             Just m -> do
-              logMsg "Input File OK"
+              log "Input File OK"
+              log $ "Downloading file : " ++ name (info m)
+              log "Trying to fetch peers"
 
-              let len = lengthInBytes $ info m
-                  (Bdict d') = d
-                  trackers = announceList m
+              log $ "Trackers: " ++ head (announceList m)
+              response <- connect m peerId
 
-              logMsg "Trying to fetch peers: "
-              response <- connect (head trackers) (prepareRequest d' peerId len)
-
-              let hsMsgLen = show $ length $ handShakeMsg d' peerId
-              logMsg $ "Hand-shake message length : " ++ hsMsgLen
+              let hsMsgLen = show $ length $ handShakeMsg m peerId
+              log $ "Hand-shake message length : " ++ hsMsgLen
 
               -- TODO: Write to ~/.functorrent/caches
               writeFile (name (info m) ++ ".cache") response
@@ -66,9 +65,9 @@ main = do
                 Right trackerInfo ->
                     case mkTrackerResponse trackerInfo of
                       Right peerResp ->
-                          logMsg $ "Peers List : " ++ (show . peers $ peerResp)
-                      Left e -> logMsg $ "Error" ++ unpack e
-                Left e -> logError e logMsg
+                          log $ "Peers List : " ++ (show . peers $ peerResp)
+                      Left e -> log $ "Error" ++ unpack e
+                Left e -> logError e log
 
-      Left e -> logError e logMsg
+      Left e -> logError e log
     logStop logR

diff --git a/test/Test.hs b/test/Test.hs
index 3ead970aa024b32d8e2ba3473b2ca474041c1ebf..fb6c768e3fe45c58884106f3c02ef5c9927c84d8 100644 (file)
--- a/test/Test.hs
+++ b/test/Test.hs
@@ -2,7 +2,8 @@
 module Main where
 
 import Prelude hiding (readFile)
-import Data.ByteString.Char8 (ByteString, readFile)
+
+import Data.ByteString (ByteString, readFile)
 import Data.Map.Strict (fromList)
 
 import Test.Tasty
@@ -11,7 +12,7 @@ import Test.Tasty.HUnit
 import FuncTorrent.Bencode (decode, BVal(..))
 import FuncTorrent.Metainfo (Info(..), Metainfo(..), mkMetaInfo)
 import FuncTorrent.Peer (Peer(..))
-import FuncTorrent.Tracker (TrackerResponse(..), peers, mkTrackerResponse)
+import FuncTorrent.Tracker
 
 -- Parsed .torrent file
 file :: BVal
@@ -38,6 +39,7 @@ hello = Metainfo {
             lengthInBytes = 12,
             md5sum = Nothing
           },
+          infoHash = "\249\SYN\145=\129\182\205\\\181v0\144\154\EM\150f\152\221]}",
           announceList = ["http://9.rarbg.com:2710/announce"],
           creationDate = Just 1428717851,
           comment = Just "hello world",