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

upload: fix repos with non-null uriPath

This commit fixes the handling of repo URIs that have a non-null uriPath.
Previously, the code would just override the uriPath if the repo had one.
For example, "" as repo would lead to the upload URI

Even using `parseRelativeReference "upload"` (instead of "/upload") doesn't work, since
that will replace the last path component of the URI path (i.e. "/foo/bar" would generate
the URI "/foo/upload", but we want "/foo/bar/upload").
parent 1bbea030
......@@ -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, parseRelativeReference, relativeTo)
import Network.URI (URI(uriPath), parseURI)
import System.IO (hFlush, stdin, stdout, hGetEcho, hSetEcho)
import Control.Exception (bracket)
......@@ -26,9 +26,6 @@ import Control.Monad (forM_, when)
type Auth = Maybe (String, String)
uploadReference :: URI
Just uploadReference = parseRelativeReference "/upload"
checkURI :: URI
Just checkURI = parseURI ""
......@@ -39,7 +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 = uploadReference `relativeTo` targetRepoURI
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)
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