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(..),
 module FuncTorrent
     (BVal(..),

-     Info,
-     InfoDict,
-     Metainfo,
+     Info(..),
+     Metainfo(..),

      Peer,
      TrackerResponse(..),
      Peer,
      TrackerResponse(..),

-     announceList,

      connect,
      decode,
      encode,
      handShakeMsg,
      connect,
      decode,
      encode,
      handShakeMsg,

-     info,
-     infoHash,

      initLogger,
      initLogger,

-     lengthInBytes,

      logMessage,
      logStop,
      mkInfo,
      mkMetaInfo,
      logMessage,
      logStop,
      mkInfo,
      mkMetaInfo,

-     mkTrackerResponse,
-     name,
-     prepareRequest,
-     urlEncodeHash
+     mkTrackerResponse

     ) where
 
 import FuncTorrent.Bencode
     ) 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 #-}
 {-# LANGUAGE OverloadedStrings #-}

-module FuncTorrent.Bencode (
-      BVal(..)
-    , InfoDict
-    , bstrToString
-    , bValToInteger
-    , bValToInfoDict
+module FuncTorrent.Bencode
+    (BVal(..)

     , bValToBList
     , bValToBstr
     , bValToBList
     , bValToBstr

-    , encode
+    , bValToInfoDict
+    , bValToInteger
+    , bstrToString

     , decode
     , decode

+    , encode

     ) where
 
 import Prelude hiding (length, concat)
     ) 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]
 data BVal = Bint Integer
           | Bstr ByteString
           | Blist [BVal]

-          | Bdict InfoDict
+          | Bdict (Map String BVal)

             deriving (Ord, Eq, Show)
 
 -- getters
             deriving (Ord, Eq, Show)
 
 -- getters


@@ -40,15 +39,13 @@ bValToBList :: BVal    -> Maybe [BVal]
 bValToBList (Blist lst) = Just lst
 bValToBList _           = Nothing
 
 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
 
 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
 
 -- $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")])
 -- 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
 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.
 --
 -- 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 ())
 
 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(..),
 module FuncTorrent.Metainfo
     (Info(..),
      Metainfo(..),

-     infoHash,

      mkInfo,
      mkMetaInfo
     ) where
      mkInfo,
      mkMetaInfo
     ) where


@@ -12,7 +11,7 @@ import Data.Map as M ((!), lookup)
 import Crypto.Hash.SHA1 (hash)
 import Data.Maybe (maybeToList)
 
 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
 
 -- 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)
                          , comment :: !(Maybe String)
                          , createdBy :: !(Maybe String)
                          , encoding :: !(Maybe String)

+                         , infoHash :: !ByteString

                          } deriving (Eq, Show)
 
 mkInfo :: BVal -> Maybe Info
                          } deriving (Eq, Show)
 
 mkInfo :: BVal -> Maybe Info


@@ -63,7 +63,9 @@ mkMetaInfo (Bdict m)  =
            , comment      = bstrToString  =<< comment'
            , createdBy    = bstrToString  =<< createdBy'
            , encoding     = bstrToString  =<< encoding'
            , comment      = bstrToString  =<< comment'
            , createdBy    = bstrToString  =<< createdBy'
            , encoding     = bstrToString  =<< encoding'

+           , infoHash     = hash . encode $ (m ! "info")

         }
         }

+

 mkMetaInfo _ = Nothing
 
 getAnnounceList :: Maybe BVal -> [String]
 mkMetaInfo _ = Nothing
 
 getAnnounceList :: Maybe BVal -> [String]


@@ -78,9 +80,3 @@ getAnnounceList (Just (Blist l)) = map (\s -> case s of
                                                _ -> "") l
 
 getAnnounceList (Just (Bdict _)) = []
                                                _ -> "") 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 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)
 
 
 -- | 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"
 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,
 module FuncTorrent.Tracker
     (TrackerResponse(..),
      connect,

+     mkArgs,
+     mkParams,

      mkTrackerResponse,
      mkTrackerResponse,

-     prepareRequest,

      urlEncodeHash
     ) where
 
 import Prelude hiding (lookup, concat, replicate, splitAt)
      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.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 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.Peer (Peer(..))
 import FuncTorrent.Utils (splitN)

+import FuncTorrent.Metainfo (Info(..), Metainfo(..))

 
 
 -- | Tracker response
 
 
 -- | Tracker response


@@ -32,8 +34,6 @@ data TrackerResponse = TrackerResponse {
     , incomplete :: Maybe Integer
     } deriving (Show, Eq)
 
     , incomplete :: Maybe Integer
     } deriving (Show, Eq)
 

-type Url = String
-

 -- | Deserialize tracker response
 mkTrackerResponse :: BVal -> Either ByteString TrackerResponse
 mkTrackerResponse resp =
 -- | 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
       toPort = read . ("0x" ++) . unpack . B16.encode
 
       toIP :: ByteString -> String

-      toIP = intercalate "." .
+      toIP = Data.List.intercalate "." .

              map (show . toInt . ("0x" ++) . unpack) .
                  splitN 2 . B16.encode
 
              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
 
       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))
 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'] ++ "-_.~"
 
 
         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
 
 {-# 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 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.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
 
 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
 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
     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
             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
 
               -- 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 ->
                 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
     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)
 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
 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.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
 
 -- Parsed .torrent file
 file :: BVal


@@ -38,6 +39,7 @@ hello = Metainfo {
             lengthInBytes = 12,
             md5sum = Nothing
           },
             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",
           announceList = ["http://9.rarbg.com:2710/announce"],
           creationDate = Just 1428717851,
           comment = Just "hello world",