From: Jaseem Abid Date: Sun, 15 Mar 2015 18:34:10 +0000 (+0530) Subject: Make network request return ByteString X-Git-Url: https://git.rkrishnan.org/specifications/components/com_hotproperty/%22doc.html/%22file:/index.php?a=commitdiff_plain;h=b601c68ab17e5d8bd908f30f624fb385a1a67d2f;p=functorrent.git 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 b55644c..915fe71 100644 --- 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 b8afb0e..bc4b8d3 100644 --- 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 09d5529..6c558e5 100644 --- 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)