[commit: Cabal] master: Use the configured proxy even for uploading build reports (4bd8471)

[Ian Lynagh]

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 <batterseapower at hotmail.com>
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"