Commit 6d3b9ff1 authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Don't verbosely display the http conversation chatter by default

Though do display it at deafening verbosity level.
parent 48b440a6
......@@ -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)
......@@ -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
......
Supports Markdown
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment