Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/ce6c73685cd14dd83a21976cf6f3fdbaeefc62fa >--------------------------------------------------------------- commit ce6c73685cd14dd83a21976cf6f3fdbaeefc62fa Author: Duncan Coutts <[email protected]> Date: Fri Jan 16 13:56:46 2009 +0000 Update to using HTTP-4000.x This should fix a long-standing bug with http proxies (ticket #352) It should also make downloads faster, or at least use less memory. >--------------------------------------------------------------- .../Distribution/Client/BuildReports/Upload.hs | 10 +++++++--- cabal-install/Distribution/Client/Fetch.hs | 8 ++++++-- cabal-install/Distribution/Client/HttpUtils.hs | 8 +++++--- cabal-install/Distribution/Client/Upload.hs | 6 ++++-- cabal-install/cabal-install.cabal | 2 +- 5 files changed, 23 insertions(+), 11 deletions(-) diff --git a/cabal-install/Distribution/Client/BuildReports/Upload.hs b/cabal-install/Distribution/Client/BuildReports/Upload.hs index f803532..dc35552 100644 --- a/cabal-install/Distribution/Client/BuildReports/Upload.hs +++ b/cabal-install/Distribution/Client/BuildReports/Upload.hs @@ -14,6 +14,7 @@ import Network.Browser import Network.HTTP ( Header(..), HeaderName(..) , Request(..), RequestMethod(..), Response(..) ) +import Network.TCP (HandleStream) import Network.URI (URI, uriPath, parseRelativeReference, relativeTo) import Control.Monad @@ -26,7 +27,8 @@ import Distribution.Client.BuildReports.Anonymous (BuildReport) type BuildReportId = URI type BuildLog = String -uploadReports :: URI -> [(BuildReport, Maybe BuildLog)] -> BrowserAction () +uploadReports :: URI -> [(BuildReport, Maybe BuildLog)] + -> BrowserAction (HandleStream BuildLog) () uploadReports uri reports = forM_ reports $ \(report, mbBuildLog) -> do buildId <- postBuildReport uri report @@ -34,7 +36,8 @@ uploadReports uri reports Just buildLog -> putBuildLog buildId buildLog Nothing -> return () -postBuildReport :: URI -> BuildReport -> BrowserAction BuildReportId +postBuildReport :: URI -> BuildReport + -> BrowserAction (HandleStream BuildLog) BuildReportId postBuildReport uri buildReport = do setAllowRedirects False (_, response) <- request Request { @@ -53,7 +56,8 @@ postBuildReport uri buildReport = do _ -> error "Unrecognised response from server." where body = BuildReport.show buildReport -putBuildLog :: BuildReportId -> BuildLog -> BrowserAction () +putBuildLog :: BuildReportId -> BuildLog + -> BrowserAction (HandleStream BuildLog) () putBuildLog reportId buildLog = do --FIXME: do something if the request fails (_, response) <- request Request { diff --git a/cabal-install/Distribution/Client/Fetch.hs b/cabal-install/Distribution/Client/Fetch.hs index 20a6f1d..fb140f2 100644 --- a/cabal-install/Distribution/Client/Fetch.hs +++ b/cabal-install/Distribution/Client/Fetch.hs @@ -36,6 +36,8 @@ import Distribution.Client.IndexUtils as IndexUtils ( getAvailablePackages, disambiguateDependencies ) import qualified Distribution.Client.InstallPlan as InstallPlan import Distribution.Client.HttpUtils (getHTTP, isOldHackageURI) +import Distribution.Client.Utils + ( writeFileAtomic ) import Distribution.Package ( PackageIdentifier, packageName, packageVersion, Dependency(..) ) @@ -48,7 +50,7 @@ import Distribution.Simple.Configure ( getInstalledPackages ) import Distribution.Simple.Utils ( die, notice, info, debug, setupMessage - , copyFileVerbose, writeFileAtomic ) + , copyFileVerbose ) import Distribution.System ( buildPlatform ) import Distribution.Text @@ -68,7 +70,9 @@ import qualified System.FilePath.Posix as FilePath.Posix import Network.URI ( URI(uriPath, uriScheme) ) import Network.HTTP - ( ConnError(..), Response(..) ) + ( Response(..) ) +import Network.Stream + ( ConnError(..) ) downloadURI :: Verbosity diff --git a/cabal-install/Distribution/Client/HttpUtils.hs b/cabal-install/Distribution/Client/HttpUtils.hs index fb97b1a..235cca2 100644 --- a/cabal-install/Distribution/Client/HttpUtils.hs +++ b/cabal-install/Distribution/Client/HttpUtils.hs @@ -15,6 +15,8 @@ import Network.Browser , setOutHandler, setErrHandler, setProxy, request) import Control.Monad ( mplus, join ) +import qualified Data.ByteString.Lazy as ByteString +import Data.ByteString.Lazy (ByteString) #ifdef WIN32 import System.Win32.Types ( DWORD, HKEY ) @@ -125,15 +127,15 @@ uri2proxy uri@URI{ uriScheme = "http:" _ -> pwd' uri2proxy _ = Nothing -mkRequest :: URI -> Request +mkRequest :: URI -> Request ByteString mkRequest uri = Request{ rqURI = uri , rqMethod = GET , rqHeaders = [Header HdrUserAgent userAgent] - , rqBody = "" } + , rqBody = ByteString.empty } where userAgent = "cabal-install/" ++ display Paths_cabal_install.version -- |Carry out a GET request, using the local proxy settings -getHTTP :: Verbosity -> URI -> IO (Result Response) +getHTTP :: Verbosity -> URI -> IO (Result (Response ByteString)) getHTTP verbosity uri = do p <- proxy verbosity let req = mkRequest uri diff --git a/cabal-install/Distribution/Client/Upload.hs b/cabal-install/Distribution/Client/Upload.hs index bb17457..b748455 100644 --- a/cabal-install/Distribution/Client/Upload.hs +++ b/cabal-install/Distribution/Client/Upload.hs @@ -21,6 +21,7 @@ import Network.Browser import Network.HTTP ( Header(..), HeaderName(..), findHeader , Request(..), RequestMethod(..), Response(..) ) +import Network.TCP (HandleStream) import Network.URI (URI(uriPath), parseURI) import Data.Char (intToDigit) @@ -104,7 +105,8 @@ check verbosity paths = do notice verbosity $ "Checking " ++ path ++ "... " handlePackage verbosity checkURI (return ()) path -handlePackage :: Verbosity -> URI -> BrowserAction () -> FilePath -> IO () +handlePackage :: Verbosity -> URI -> BrowserAction (HandleStream String) () + -> FilePath -> IO () handlePackage verbosity uri auth path = do req <- mkRequest uri path p <- proxy verbosity @@ -126,7 +128,7 @@ handlePackage verbosity uri auth path = Just "text/plain" -> notice verbosity $ rspBody resp _ -> debug verbosity $ rspBody resp -mkRequest :: URI -> FilePath -> IO Request +mkRequest :: URI -> FilePath -> IO (Request String) mkRequest uri path = do pkg <- readBinaryFile path boundary <- genBoundary diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal index 592a627..8dfa478 100644 --- a/cabal-install/cabal-install.cabal +++ b/cabal-install/cabal-install.cabal @@ -71,7 +71,7 @@ Executable cabal Cabal >= 1.6 && < 1.7, filepath >= 1.0, network >= 1 && < 3, - HTTP >= 3000 && < 3002, + HTTP >= 4000.0.2 && < 4001, zlib >= 0.4 && < 0.6 if flag(old-base) _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
