Commit 1bbea030 authored by Benno Fünfstück's avatar Benno Fünfstück
Browse files

upload: fix URI bug and always use new hackage URI

Previously, when uriPath was "", then the generated URI would be wrong. For example,
if we have a remote repo with the URI (without a trailing slash),
then the previous code will generate http://hackage.haskell.orgupload for the upload URL.
We now use the relativeTo function from Network.URI, which does the right thing.

Additionaly, we now always rely on the new hackage URL layout. cabal now automatically
upgrades the old URI to the new URI when parsing the config file, so manually checking
for that is no longer needed.
parent 29bd5aaf
......@@ -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)
......@@ -15,7 +15,7 @@ import Distribution.Client.Config
import qualified Distribution.Client.BuildReports.Anonymous as BuildReport
import qualified Distribution.Client.BuildReports.Upload as BuildReport
import Network.URI (URI(uriPath), parseURI)
import Network.URI (URI(uriPath), parseURI, parseRelativeReference, relativeTo)
import System.IO (hFlush, stdin, stdout, hGetEcho, hSetEcho)
import Control.Exception (bracket)
......@@ -26,10 +26,8 @@ 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 ""
uploadReference :: URI
Just uploadReference = parseRelativeReference "/upload"
checkURI :: URI
Just checkURI = parseURI ""
......@@ -41,13 +39,7 @@ 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
| isOldHackageURI targetRepoURI
= legacyUploadURI
| otherwise
= targetRepoURI {
uriPath = uriPath targetRepoURI FilePath.Posix.</> "upload"
uploadURI = uploadReference `relativeTo` targetRepoURI
Username username <- maybe promptUsername return mUsername
Password password <- maybe promptPassword return mPassword
let auth = Just (username,password)
Markdown is supported
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