[commit: Cabal] master: Don't verbosely display the http conversation chatter by default (6d3b9ff)

[Paolo Capriotti]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/6d3b9ff1f6edec7a22231679a8f9324348d90058

>---------------------------------------------------------------

commit 6d3b9ff1f6edec7a22231679a8f9324348d90058
Author: Duncan Coutts <duncan at haskell.org>
Date:   Tue Jan 15 16:02:33 2008 +0000

    Don't verbosely display the http conversation chatter by default
    Though do display it at deafening verbosity level.

>---------------------------------------------------------------

 cabal-install/Hackage/HttpUtils.hs |   13 ++++++++++---
 cabal-install/Hackage/Upload.hs    |   16 +++++++---------
 2 files changed, 17 insertions(+), 12 deletions(-)

diff --git a/cabal-install/Hackage/HttpUtils.hs b/cabal-install/Hackage/HttpUtils.hs
index 166bd2e..00dedc6 100644
--- a/cabal-install/Hackage/HttpUtils.hs
+++ b/cabal-install/Hackage/HttpUtils.hs
@@ -7,7 +7,8 @@ module Hackage.HttpUtils (getHTTP, proxy) where
 import Network.HTTP (Request (..), Response (..), RequestMethod (..), Header(..), HeaderName(..))
 import Network.URI (URI (..), URIAuth (..), parseURI)
 import Network.Stream (Result)
-import Network.Browser (Proxy (..), Authority (..), browse, setProxy, request)
+import Network.Browser (Proxy (..), Authority (..), browse,
+                        setOutHandler, setErrHandler, setProxy, request)
 import Control.Monad (mplus)
 #ifdef WIN32
 import System.Win32.Registry (hKEY_CURRENT_USER, regOpenKey, regQueryValue, regCloseKey)
@@ -16,7 +17,7 @@ import Control.Exception (try, bracket)
 import System.Environment (getEnvironment)
 
 import Distribution.Verbosity (Verbosity)
-import Distribution.Simple.Utils (warn)
+import Distribution.Simple.Utils (warn, debug)
 
 -- try to read the system proxy settings on windows or unix
 proxyString :: IO (Maybe String)
@@ -48,10 +49,12 @@ proxy verbosity = do
     Nothing     -> return NoProxy
     Just str    -> case parseURI str of
       Nothing   -> do warn verbosity $ "invalid proxy uri: " ++ show str
+                      warn verbosity $ "ignoring http proxy, trying a direct connection"
                       return NoProxy
       Just uri  -> case uri2proxy uri of
         Nothing -> do warn verbosity $ "invalid http proxy uri: " ++ show str
                       warn verbosity $ "proxy uri must be http with a hostname"
+                      warn verbosity $ "ignoring http proxy, trying a direct connection"
                       return NoProxy
         Just p  -> return p
 
@@ -79,5 +82,9 @@ getHTTP :: Verbosity -> URI -> IO (Result Response)
 getHTTP verbosity uri = do
                  p   <- proxy verbosity
                  let req = mkRequest uri
-                 (_, resp) <- browse (setProxy p >> request req)
+                 (_, resp) <- browse $ do
+                                setErrHandler (warn verbosity . ("http error: "++))
+                                setOutHandler (debug verbosity)
+                                setProxy p
+                                request req
                  return (Right resp)
diff --git a/cabal-install/Hackage/Upload.hs b/cabal-install/Hackage/Upload.hs
index 713170c..34cbd6a 100644
--- a/cabal-install/Hackage/Upload.hs
+++ b/cabal-install/Hackage/Upload.hs
@@ -6,7 +6,7 @@ module Hackage.Upload (check, upload) where
 import Hackage.Types (Username, Password)
 import Hackage.HttpUtils (proxy)
 
-import Distribution.Simple.Utils (debug, notice)
+import Distribution.Simple.Utils (debug, notice, warn)
 import Distribution.Verbosity (Verbosity)
 
 import Network.Browser (BrowserAction, browse, request, 
@@ -64,11 +64,12 @@ handlePackage verbosity uri auth path =
   do req <- mkRequest uri path
      p   <- proxy verbosity
      debug verbosity $ "\n" ++ show req
-     (_,resp) <- browse (setProxy p
-                      >> setErrHandler ignoreMsg 
-                      >> setOutHandler ignoreMsg 
-                      >> auth 
-                      >> request req)
+     (_,resp) <- browse $ do
+                   setProxy p
+                   setErrHandler (warn verbosity . ("http error: "++))
+                   setOutHandler (debug verbosity)
+                   auth
+                   request req
      debug verbosity $ show resp
      case rspCode resp of
        (2,0,0) -> do notice verbosity "OK"
@@ -77,9 +78,6 @@ handlePackage verbosity uri auth path =
                                      ++ rspReason resp
                      debug verbosity $ rspBody resp
 
-  where ignoreMsg :: String -> IO ()
-        ignoreMsg _ = return ()
-
 mkRequest :: URI -> FilePath -> IO Request
 mkRequest uri path = 
     do pkg <- readFile path