Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/4bd8471bc648be52f7036d1ecb05e312f8acf3a5 >--------------------------------------------------------------- commit 4bd8471bc648be52f7036d1ecb05e312f8acf3a5 Author: Max Bolingbroke <[email protected]> Date: Wed Sep 28 21:08:59 2011 +0000 Use the configured proxy even for uploading build reports >--------------------------------------------------------------- .../Distribution/Client/BuildReports/Upload.hs | 4 +-- cabal-install/Distribution/Client/HttpUtils.hs | 32 ++++++++++++------- cabal-install/Distribution/Client/Upload.hs | 18 +++-------- 3 files changed, 26 insertions(+), 28 deletions(-) diff --git a/cabal-install/Distribution/Client/BuildReports/Upload.hs b/cabal-install/Distribution/Client/BuildReports/Upload.hs index a1ae1f1..44bce0d 100644 --- a/cabal-install/Distribution/Client/BuildReports/Upload.hs +++ b/cabal-install/Distribution/Client/BuildReports/Upload.hs @@ -29,10 +29,8 @@ type BuildReportId = URI type BuildLog = String uploadReports :: URI -> [(BuildReport, Maybe BuildLog)] - -> BrowserAction (HandleStream String) () -> BrowserAction (HandleStream BuildLog) () -uploadReports uri reports auth = do - auth +uploadReports uri reports = do forM_ reports $ \(report, mbBuildLog) -> do buildId <- postBuildReport uri report case mbBuildLog of diff --git a/cabal-install/Distribution/Client/HttpUtils.hs b/cabal-install/Distribution/Client/HttpUtils.hs index 81f6d12..0fd2a0a 100644 --- a/cabal-install/Distribution/Client/HttpUtils.hs +++ b/cabal-install/Distribution/Client/HttpUtils.hs @@ -5,6 +5,7 @@ module Distribution.Client.HttpUtils ( downloadURI, getHTTP, + cabalBrowse, proxy, isOldHackageURI ) where @@ -17,10 +18,10 @@ import Network.URI import Network.Stream ( Result, ConnError(..) ) import Network.Browser - ( Proxy (..), Authority (..), browse - , setOutHandler, setErrHandler, setProxy, request) + ( Proxy (..), Authority (..), BrowserAction, browse + , setOutHandler, setErrHandler, setProxy, setAuthorityGen, request) import Control.Monad - ( mplus, join, liftM2 ) + ( mplus, join, liftM, liftM2 ) import qualified Data.ByteString.Lazy.Char8 as ByteString import Data.ByteString.Lazy (ByteString) #ifdef WIN32 @@ -151,15 +152,22 @@ mkRequest uri = Request{ rqURI = uri -- |Carry out a GET request, using the local proxy settings getHTTP :: Verbosity -> URI -> IO (Result (Response ByteString)) -getHTTP verbosity uri = do - p <- proxy verbosity - let req = mkRequest uri - (_, resp) <- browse $ do - setErrHandler (warn verbosity . ("http error: "++)) - setOutHandler (debug verbosity) - setProxy p - request req - return (Right resp) +getHTTP verbosity uri = liftM (\(_, resp) -> Right resp) $ + cabalBrowse verbosity (return ()) (request (mkRequest uri)) + +cabalBrowse :: Verbosity + -> BrowserAction s () + -> BrowserAction s a + -> IO a +cabalBrowse verbosity auth act = do + p <- proxy verbosity + browse $ do + setProxy p + setErrHandler (warn verbosity . ("http error: "++)) + setOutHandler (debug verbosity) + auth + setAuthorityGen (\_ _ -> return Nothing) + act downloadURI :: Verbosity -> URI -- ^ What to download diff --git a/cabal-install/Distribution/Client/Upload.hs b/cabal-install/Distribution/Client/Upload.hs index eb9f892..2454f49 100644 --- a/cabal-install/Distribution/Client/Upload.hs +++ b/cabal-install/Distribution/Client/Upload.hs @@ -4,7 +4,7 @@ module Distribution.Client.Upload (check, upload, report) where import Distribution.Client.Types (Username(..), Password(..),Repo(..),RemoteRepo(..)) -import Distribution.Client.HttpUtils (proxy, isOldHackageURI) +import Distribution.Client.HttpUtils (isOldHackageURI, cabalBrowse) import Distribution.Simple.Utils (debug, notice, warn, info) import Distribution.Verbosity (Verbosity) @@ -15,9 +15,8 @@ import qualified Distribution.Client.BuildReports.Anonymous as BuildReport import qualified Distribution.Client.BuildReports.Upload as BuildReport import Network.Browser - ( BrowserAction, browse, request - , Authority(..), addAuthority, setAuthorityGen - , setOutHandler, setErrHandler, setProxy ) + ( BrowserAction, request + , Authority(..), addAuthority ) import Network.HTTP ( Header(..), HeaderName(..), findHeader , Request(..), RequestMethod(..), Response(..) ) @@ -106,7 +105,7 @@ report verbosity repos mUsername mPassword = do Left errs -> do warn verbosity $ "Errors: " ++ errs -- FIXME Right report' -> do info verbosity $ "Uploading report for " ++ display (BuildReport.package report') - browse $ BuildReport.uploadReports (remoteRepoURI remoteRepo) [(report', Just buildLog)] auth + cabalBrowse verbosity auth $ BuildReport.uploadReports (remoteRepoURI remoteRepo) [(report', Just buildLog)] return () Right{} -> return () where @@ -122,15 +121,8 @@ handlePackage :: Verbosity -> URI -> BrowserAction (HandleStream String) () -> FilePath -> IO () handlePackage verbosity uri auth path = do req <- mkRequest uri path - p <- proxy verbosity debug verbosity $ "\n" ++ show req - (_,resp) <- browse $ do - setProxy p - setErrHandler (warn verbosity . ("http error: "++)) - setOutHandler (debug verbosity) - auth - setAuthorityGen (\_ _ -> return Nothing) - request req + (_,resp) <- cabalBrowse verbosity auth $ request req debug verbosity $ show resp case rspCode resp of (2,0,0) -> do notice verbosity "Ok" _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
