Force cabal upload to always use digest auth and never basic auth

cabal-install/Distribution/Client/HttpUtils.hs

@@ -17,8 +17,8 @@ import Network.HTTP.Proxy ( Proxy(..), fetchProxy)
 import Network.URI
          ( URI (..), URIAuth (..) )
 import Network.Browser
-         ( BrowserAction, browse
-         , setOutHandler, setErrHandler, setProxy, setAuthorityGen, request)
+         ( BrowserAction, browse, setAllowBasicAuth, setAuthorityGen
+         , setOutHandler, setErrHandler, setProxy, request)
 import Network.Stream
          ( Result, ConnError(..) )
 import Control.Exception
@@ -84,10 +84,10 @@ getHTTP :: Verbosity
         -> Maybe String -- ^ Optional etag to check if we already have the latest file.
         -> IO (Result (Response ByteString))
 getHTTP verbosity uri etag = liftM (\(_, resp) -> Right resp) $
-                                   cabalBrowse verbosity (return ()) (request (mkRequest uri etag))
+                                   cabalBrowse verbosity Nothing (request (mkRequest uri etag))
 
 cabalBrowse :: Verbosity
-            -> BrowserAction s ()
+            -> Maybe (String, String)
             -> BrowserAction s a
             -> IO a
 cabalBrowse verbosity auth act = do
@@ -100,8 +100,8 @@ cabalBrowse verbosity auth act = do
             setProxy p
             setErrHandler (warn verbosity . ("http error: "++))
             setOutHandler (debug verbosity)
-            auth
-            setAuthorityGen (\_ _ -> return Nothing)
+            setAllowBasicAuth False
+            setAuthorityGen (\_ _ -> return auth)
             act
 
 downloadURI :: Verbosity

cabal-install/Distribution/Client/Upload.hs

@@ -18,12 +18,10 @@ import qualified Distribution.Client.BuildReports.Anonymous as BuildReport
 import qualified Distribution.Client.BuildReports.Upload as BuildReport
 
 import Network.Browser
-         ( BrowserAction, request
-         , Authority(..), addAuthority )
+         ( request )
 import Network.HTTP
          ( Header(..), HeaderName(..), findHeader
          , Request(..), RequestMethod(..), Response(..) )
-import Network.TCP (HandleStream)
 import Network.URI (URI(uriPath), parseURI)
 
 import Data.Char        (intToDigit)
@@ -53,12 +51,7 @@ upload verbosity repos mUsername mPassword paths = do
                           else targetRepoURI{uriPath = uriPath targetRepoURI `FilePath.Posix.combine` "upload"}
           Username username <- maybe promptUsername return mUsername
           Password password <- maybe promptPassword return mPassword
-          let auth = addAuthority AuthBasic {
-                       auRealm    = "Hackage",
-                       auUsername = username,
-                       auPassword = password,
-                       auSite     = uploadURI
-                     }
+          let auth = Just (username, password)
           flip mapM_ paths $ \path -> do
             notice verbosity $ "Uploading " ++ path ++ "... "
             handlePackage verbosity uploadURI auth path
@@ -89,12 +82,7 @@ report verbosity repos mUsername mPassword = do
                       else targetRepoURI{uriPath = ""}
       Username username <- maybe promptUsername return mUsername
       Password password <- maybe promptPassword return mPassword
-      let auth = addAuthority AuthBasic {
-                   auRealm    = "Hackage",
-                   auUsername = username,
-                   auPassword = password,
-                   auSite     = uploadURI
-                 }
+      let auth = Just (username, password)
       forM_ repos $ \repo -> case repoKind repo of
         Left remoteRepo
             -> do dotCabal <- defaultCabalDir
@@ -120,9 +108,9 @@ check :: Verbosity -> [FilePath] -> IO ()
 check verbosity paths = do
           flip mapM_ paths $ \path -> do
             notice verbosity $ "Checking " ++ path ++ "... "
-            handlePackage verbosity checkURI (return ()) path
+            handlePackage verbosity checkURI Nothing path
 
-handlePackage :: Verbosity -> URI -> BrowserAction (HandleStream ByteString) ()
+handlePackage :: Verbosity -> URI -> Maybe (String, String)
               -> FilePath -> IO ()
 handlePackage verbosity uri auth path =
   do req <- mkRequest uri path