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 <[email protected]> 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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
