Merge pull request #2849 from bennofs/new-hackage-url

Always use new hackage URI

cabal-install/Distribution/Client/Config.hs

@@ -76,6 +76,8 @@ import Distribution.ParseUtils
          , parseFilePathQ, parseTokenQ )
 import Distribution.Client.ParseUtils
          ( parseFields, ppFields, ppSection )
+import Distribution.Client.HttpUtils
+         ( isOldHackageURI )
 import qualified Distribution.ParseUtils as ParseUtils
          ( Field(..) )
 import qualified Distribution.Text as Text
@@ -503,10 +505,9 @@ defaultRemoteRepo = RemoteRepo name uri () False
 --
 addInfoForKnownRepos :: RemoteRepo -> RemoteRepo
 addInfoForKnownRepos repo@RemoteRepo{ remoteRepoName = "hackage.haskell.org" } =
-    repo {
-      --remoteRepoRootKeys --TODO: when this list is empty, fill in known crypto credentials
-      remoteRepoShouldTryHttps = True
-    }
+    tryHttps $ if isOldHackageURI (remoteRepoURI repo) then defaultRemoteRepo else repo
+  where
+    tryHttps       r = r { remoteRepoShouldTryHttps = True }
 addInfoForKnownRepos other = other
 
 --

cabal-install/Distribution/Client/Upload.hs

@@ -5,7 +5,7 @@ module Distribution.Client.Upload (check, upload, report) where
 
 import Distribution.Client.Types (Username(..), Password(..),Repo(..),RemoteRepo(..))
 import Distribution.Client.HttpUtils
-         ( isOldHackageURI, HttpTransport(..), remoteRepoTryUpgradeToHttps )
+         ( HttpTransport(..), remoteRepoTryUpgradeToHttps )
 
 import Distribution.Simple.Utils (notice, warn, info, die)
 import Distribution.Verbosity (Verbosity)
@@ -26,11 +26,6 @@ import Control.Monad (forM_, when)
 
 type Auth = Maybe (String, String)
 
---FIXME: how do we find this path for an arbitrary hackage server?
--- is it always at some fixed location relative to the server root?
-legacyUploadURI :: URI
-Just legacyUploadURI = parseURI "http://hackage.haskell.org/cgi-bin/hackage-scripts/protected/upload-pkg"
-
 checkURI :: URI
 Just checkURI = parseURI "http://hackage.haskell.org/cgi-bin/hackage-scripts/check-pkg"
 
@@ -41,13 +36,10 @@ upload transport verbosity repos mUsername mPassword paths = do
         [] -> die $ "Cannot upload. No remote repositories are configured."
         rs -> remoteRepoTryUpgradeToHttps transport (last rs)
     let targetRepoURI = remoteRepoURI targetRepo
-        uploadURI
-          | isOldHackageURI targetRepoURI
-          = legacyUploadURI
-          | otherwise
-          = targetRepoURI {
-              uriPath = uriPath targetRepoURI FilePath.Posix.</> "upload"
-            }
+        rootIfEmpty x = if null x then "/" else x
+        uploadURI = targetRepoURI {
+            uriPath = rootIfEmpty (uriPath targetRepoURI) FilePath.Posix.</> "upload"
+        }
     Username username <- maybe promptUsername return mUsername
     Password password <- maybe promptPassword return mPassword
     let auth = Just (username,password)