Make network request return ByteString

Packing and unpacking curropted the binary data in several occations
when the network response was written to disk for caching/testing.

Add support for local caches. This aids in testing, and throttling
remote requests if the file is new enough.

Removes unwanted <$>

diff --git a/functorrent.cabal b/functorrent.cabal
index b55644c3b4102eee928f449c846314e23e5e4936..915fe71f146619f34884980ec1b7ad4d45cb7a9c 100644 (file)
--- a/functorrent.cabal
+++ b/functorrent.cabal
@@ -20,15 +20,17 @@ executable functorrent
   -- other-modules:       
   -- other-extensions:    
   build-depends:       base,
-                       parsec,
-                       containers,
-                       time,
-                       bytestring,
-                       base16-bytestring,
-                       doctest,
                        HTTP,
+                       base16-bytestring,
+                       binary,
+                       bytestring,                    
+                       containers,
                        cryptohash,
-                       binary
+                       doctest,
+                       network-uri, 
+                       parsec,
+                       time
+
   hs-source-dirs:      src
   ghc-options:         -Wall -fwarn-incomplete-patterns
-  default-language:    Haskell2010
\ No newline at end of file
+  default-language:    Haskell2010

diff --git a/src/Main.hs b/src/Main.hs
index b8afb0e830a25853d37632e250633055f814cd53..bc4b8d31013948dbfd35c053c5fb18b3d623b2f2 100644 (file)
--- a/src/Main.hs
+++ b/src/Main.hs
@@ -1,17 +1,17 @@
+{-# LANGUAGE OverloadedStrings #-}
 module Main where
 
-import Prelude hiding (length, readFile)
+import Prelude hiding (length, readFile, writeFile)
+import Data.ByteString.Char8 (ByteString, length, readFile, writeFile, length)
+import System.Environment (getArgs)
+import System.Exit (exitSuccess)
+import Text.ParserCombinators.Parsec (ParseError)
 
 import Bencode (decode, BVal(..))
-import Data.ByteString.Char8 as BC (ByteString, pack, length, readFile, length)
-import Data.Functor ((<$>))
-import Metainfo (announce, lengthInBytes, mkMetaInfo, info)
+import Logger (initLogger, logMessage, logStop)
+import Metainfo (announce, lengthInBytes, mkMetaInfo, info, name)
 import Peer (getPeers, getPeerResponse, handShakeMsg)
-import System.Environment (getArgs)
-import System.Exit (exitSuccess)
 import Tracker (connect, prepareRequest)
-import Text.ParserCombinators.Parsec (ParseError)
-import Logger
 
 logError :: ParseError -> (String -> IO ()) -> IO ()
 logError e logMsg = logMsg $ "parse error: \n" ++ show e
@@ -46,14 +46,16 @@ main = do
 
               let len = lengthInBytes $ info m
                   (Bdict d') = d
-              
+
               logMsg "Trying to fetch peers: "
+              body <- connect (announce m) (prepareRequest d' peerId len)
+
+              -- TODO: Write to ~/.functorrent/caches
+              writeFile (name (info m) ++ ".cache") body
 
-              body <- pack <$> connect (announce m) (prepareRequest d' peerId len)
-              
               let peerResponse = show $ getPeers $ getPeerResponse body
               logMsg $ "Peers List : " ++ peerResponse
-              
+
               let hsMsgLen = show $ length $ handShakeMsg d' peerId
               logMsg $ "Hand-shake message length : " ++ hsMsgLen
 

diff --git a/src/Tracker.hs b/src/Tracker.hs
index 09d55293718e67be1d4bf4f3d616a31c5b627d85..6c558e5798e6df86358a790398bc1f78d15f939a 100644 (file)
--- a/src/Tracker.hs
+++ b/src/Tracker.hs
@@ -7,9 +7,11 @@ import Crypto.Hash.SHA1 (hash)
 import Data.ByteString.Char8 (ByteString, pack, unpack)
 import Data.Char (chr)
 import Data.List (intercalate)
+import Data.Maybe (fromJust)
 import Data.Map as M (Map, (!))
-import Network.HTTP (simpleHTTP, getRequest, getResponseBody)
+import Network.HTTP (simpleHTTP, defaultGETRequest_, getResponseBody)
 import Network.HTTP.Base (urlEncode)
+import Network.URI (parseURI)
 import Utils (splitN)
 import qualified Data.ByteString.Base16 as B16 (encode)
 
@@ -45,7 +47,6 @@ prepareRequest d peer_id len =
            ("event", "started")]
   in intercalate "&" [f ++ "=" ++ s | (f,s) <- p]
 
-connect :: Url -> String -> IO String
-connect baseurl qstr = let url = baseurl ++ "?" ++ qstr
-                       in simpleHTTP (getRequest url) >>=
-                          getResponseBody
+connect :: Url -> String -> IO ByteString
+connect baseurl qstr = simpleHTTP (defaultGETRequest_ url) >>= getResponseBody
+    where url = fromJust . parseURI $ (baseurl ++ "?" ++ qstr)