From b780cc77ddf77ec8cdadb511f4e0adfb0962d9c7 Mon Sep 17 00:00:00 2001
From: "U-CIQDEV\\gbazerman" <gbazerman@GBAZERMAN-T35.ciqdev.com>
Date: Fri, 1 May 2015 17:36:07 -0400
Subject: [PATCH] Implement HTTPS support using external curl, wget and
 powershell

Supports both uploading and downloading.
Basic built-in HTTP is still supported.
---
 .../Client/BuildReports/Upload.hs             |  58 ++-
 cabal-install/Distribution/Client/Config.hs   |   3 +-
 cabal-install/Distribution/Client/Fetch.hs    |  16 +-
 .../Distribution/Client/FetchUtils.hs         |  23 +-
 cabal-install/Distribution/Client/Freeze.hs   |   8 +-
 cabal-install/Distribution/Client/Get.hs      |  16 +-
 .../Distribution/Client/HttpUtils.hs          | 426 ++++++++++++++----
 cabal-install/Distribution/Client/Install.hs  |  25 +-
 cabal-install/Distribution/Client/List.hs     |   7 +-
 cabal-install/Distribution/Client/Setup.hs    |  21 +-
 cabal-install/Distribution/Client/Targets.hs  |  15 +-
 cabal-install/Distribution/Client/Update.hs   |  16 +-
 cabal-install/Distribution/Client/Upload.hs   | 111 +----
 cabal-install/Main.hs                         |  10 +-
 cabal-install/cabal-install.cabal             |   4 +-
 15 files changed, 497 insertions(+), 262 deletions(-)

diff --git a/cabal-install/Distribution/Client/BuildReports/Upload.hs b/cabal-install/Distribution/Client/BuildReports/Upload.hs
index c367f17396..fad7a6edbc 100644
--- a/cabal-install/Distribution/Client/BuildReports/Upload.hs
+++ b/cabal-install/Distribution/Client/BuildReports/Upload.hs
@@ -5,17 +5,17 @@ module Distribution.Client.BuildReports.Upload
     ( BuildLog
     , BuildReportId
     , uploadReports
-    , postBuildReport
-    , putBuildLog
     ) where
 
+{-
 import Network.Browser
          ( BrowserAction, request, setAllowRedirects )
 import Network.HTTP
          ( Header(..), HeaderName(..)
          , Request(..), RequestMethod(..), Response(..) )
 import Network.TCP (HandleStream)
-import Network.URI (URI, uriPath, parseRelativeReference, relativeTo)
+-}
+import Network.URI (URI, uriPath) --parseRelativeReference, relativeTo)
 
 import Control.Monad
          ( forM_ )
@@ -24,22 +24,31 @@ import System.FilePath.Posix
 import qualified Distribution.Client.BuildReports.Anonymous as BuildReport
 import Distribution.Client.BuildReports.Anonymous (BuildReport)
 import Distribution.Text (display)
+import Distribution.Verbosity (Verbosity)
+import Distribution.Simple.Utils (die)
+import Distribution.Client.HttpUtils
 
 type BuildReportId = URI
 type BuildLog = String
 
-uploadReports :: URI -> [(BuildReport, Maybe BuildLog)]
-              ->  BrowserAction (HandleStream BuildLog) ()
-uploadReports uri reports = do
+uploadReports :: Verbosity -> (String, String) -> URI -> [(BuildReport, Maybe BuildLog)] -> IO ()
+uploadReports verbosity auth uri reports = do
   forM_ reports $ \(report, mbBuildLog) -> do
-     buildId <- postBuildReport uri report
+     buildId <- postBuildReport verbosity auth uri report
      case mbBuildLog of
-       Just buildLog -> putBuildLog buildId buildLog
+       Just buildLog -> putBuildLog verbosity auth buildId buildLog
        Nothing       -> return ()
 
-postBuildReport :: URI -> BuildReport
-                -> BrowserAction (HandleStream BuildLog) BuildReportId
-postBuildReport uri buildReport = do
+postBuildReport :: Verbosity -> (String, String) -> URI -> BuildReport -> IO BuildReportId
+postBuildReport verbosity auth uri buildReport = do
+  let fullURI = uri { uriPath = "/package" </> display (BuildReport.package buildReport) </> "reports" }
+  transport <- configureTransport verbosity Nothing
+  res <- postHttp transport fullURI (BuildReport.show buildReport) (Just auth)
+  case res of
+    (303, redir) -> return $ undefined redir --TODO parse redir
+    _ -> die "unrecognized response" -- give response
+
+{-
   setAllowRedirects False
   (_, response) <- request Request {
     rqURI     = uri { uriPath = "/package" </> display (BuildReport.package buildReport) </> "reports" },
@@ -64,17 +73,18 @@ postBuildReport uri buildReport = do
               -> return $ buildId
     _         -> error "Unrecognised response from server."
   where body  = BuildReport.show buildReport
+-}
+
+
+-- TODO force this to be a PUT?
 
-putBuildLog :: BuildReportId -> BuildLog
-            -> BrowserAction (HandleStream BuildLog) ()
-putBuildLog reportId buildLog = do
-  --FIXME: do something if the request fails
-  (_, _response) <- request Request {
-      rqURI     = reportId{uriPath = uriPath reportId </> "log"},
-      rqMethod  = PUT,
-      rqHeaders = [Header HdrContentType   ("text/plain"),
-                   Header HdrContentLength (show (length buildLog)),
-                   Header HdrAccept        ("text/plain")],
-      rqBody    = buildLog
-    }
-  return ()
+putBuildLog :: Verbosity -> (String, String)
+            -> BuildReportId -> BuildLog
+            -> IO ()
+putBuildLog verbosity auth reportId buildLog = do
+  let fullURI = reportId {uriPath = uriPath reportId </> "log"}
+  transport <- configureTransport verbosity Nothing
+  res <- postHttp transport fullURI buildLog (Just auth)
+  case res of
+    (200, _) -> return ()
+    _ -> die "unrecognized response" -- give response
diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs
index 6e8d336d27..5a25f41db6 100644
--- a/cabal-install/Distribution/Client/Config.hs
+++ b/cabal-install/Distribution/Client/Config.hs
@@ -219,7 +219,8 @@ instance Monoid SavedConfig where
         globalLogsDir           = combine globalLogsDir,
         globalWorldFile         = combine globalWorldFile,
         globalRequireSandbox    = combine globalRequireSandbox,
-        globalIgnoreSandbox     = combine globalIgnoreSandbox
+        globalIgnoreSandbox     = combine globalIgnoreSandbox,
+        globalHttpTransport     = combine globalHttpTransport
         }
         where
           combine        = combine'        savedGlobalFlags
diff --git a/cabal-install/Distribution/Client/Fetch.hs b/cabal-install/Distribution/Client/Fetch.hs
index a04a21f333..cb863525c5 100644
--- a/cabal-install/Distribution/Client/Fetch.hs
+++ b/cabal-install/Distribution/Client/Fetch.hs
@@ -21,6 +21,8 @@ import Distribution.Client.FetchUtils hiding (fetchPackage)
 import Distribution.Client.Dependency
 import Distribution.Client.IndexUtils as IndexUtils
          ( getSourcePackages, getInstalledPackages )
+import Distribution.Client.HttpUtils
+         ( configureTransport, HttpTransport(..) )
 import qualified Distribution.Client.InstallPlan as InstallPlan
 import Distribution.Client.Setup
          ( GlobalFlags(..), FetchFlags(..) )
@@ -33,7 +35,7 @@ import Distribution.Simple.PackageIndex (InstalledPackageIndex)
 import Distribution.Simple.Program
          ( ProgramConfiguration )
 import Distribution.Simple.Setup
-         ( fromFlag )
+         ( fromFlag, flagToMaybe )
 import Distribution.Simple.Utils
          ( die, notice, debug )
 import Distribution.System
@@ -83,7 +85,9 @@ fetch verbosity packageDBs repos comp platform conf
     installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
     sourcePkgDb       <- getSourcePackages    verbosity repos
 
-    pkgSpecifiers <- resolveUserTargets verbosity
+    transport <- configureTransport verbosity (flagToMaybe (globalHttpTransport globalFlags))
+
+    pkgSpecifiers <- resolveUserTargets transport verbosity
                        (fromFlag $ globalWorldFile globalFlags)
                        (packageIndex sourcePkgDb)
                        userTargets
@@ -105,7 +109,7 @@ fetch verbosity packageDBs repos comp platform conf
                      "The following packages would be fetched:"
                    : map (display . packageId) pkgs'
 
-             else mapM_ (fetchPackage verbosity . packageSource) pkgs'
+             else mapM_ (fetchPackage transport verbosity . packageSource) pkgs'
 
   where
     dryRun = fromFlag (fetchDryRun fetchFlags)
@@ -181,8 +185,8 @@ checkTarget target = case target of
             ++ "In the meantime you can use the 'unpack' commands."
     _ -> return ()
 
-fetchPackage :: Verbosity -> PackageLocation a -> IO ()
-fetchPackage verbosity pkgsrc = case pkgsrc of
+fetchPackage :: HttpTransport -> Verbosity -> PackageLocation a -> IO ()
+fetchPackage transport verbosity pkgsrc = case pkgsrc of
     LocalUnpackedPackage _dir  -> return ()
     LocalTarballPackage  _file -> return ()
 
@@ -191,5 +195,5 @@ fetchPackage verbosity pkgsrc = case pkgsrc of
          ++ "In the meantime you can use the 'unpack' commands."
 
     RepoTarballPackage repo pkgid _ -> do
-      _ <- fetchRepoTarball verbosity repo pkgid
+      _ <- fetchRepoTarball transport verbosity repo pkgid
       return ()
diff --git a/cabal-install/Distribution/Client/FetchUtils.hs b/cabal-install/Distribution/Client/FetchUtils.hs
index 97920bbc30..acf830a51b 100644
--- a/cabal-install/Distribution/Client/FetchUtils.hs
+++ b/cabal-install/Distribution/Client/FetchUtils.hs
@@ -27,7 +27,7 @@ module Distribution.Client.FetchUtils (
 
 import Distribution.Client.Types
 import Distribution.Client.HttpUtils
-         ( downloadURI, isOldHackageURI, DownloadResult(..) )
+         ( downloadURI, isOldHackageURI, DownloadResult(..), HttpTransport(..) )
 
 import Distribution.Package
          ( PackageId, packageName, packageVersion )
@@ -88,10 +88,11 @@ checkFetched loc = case loc of
 
 -- | Fetch a package if we don't have it already.
 --
-fetchPackage :: Verbosity
+fetchPackage :: HttpTransport
+             -> Verbosity
              -> PackageLocation (Maybe FilePath)
              -> IO (PackageLocation FilePath)
-fetchPackage verbosity loc = case loc of
+fetchPackage transport verbosity loc = case loc of
     LocalUnpackedPackage dir  ->
       return (LocalUnpackedPackage dir)
     LocalTarballPackage  file ->
@@ -105,7 +106,7 @@ fetchPackage verbosity loc = case loc of
       path <- downloadTarballPackage uri
       return (RemoteTarballPackage uri path)
     RepoTarballPackage repo pkgid Nothing -> do
-      local <- fetchRepoTarball verbosity repo pkgid
+      local <- fetchRepoTarball transport verbosity repo pkgid
       return (RepoTarballPackage repo pkgid local)
   where
     downloadTarballPackage uri = do
@@ -113,14 +114,14 @@ fetchPackage verbosity loc = case loc of
       tmpdir <- getTemporaryDirectory
       (path, hnd) <- openTempFile tmpdir "cabal-.tar.gz"
       hClose hnd
-      _ <- downloadURI verbosity uri path
+      _ <- downloadURI transport verbosity uri path
       return path
 
 
 -- | Fetch a repo package if we don't have it already.
 --
-fetchRepoTarball :: Verbosity -> Repo -> PackageId -> IO FilePath
-fetchRepoTarball verbosity repo pkgid = do
+fetchRepoTarball :: HttpTransport -> Verbosity -> Repo -> PackageId -> IO FilePath
+fetchRepoTarball transport verbosity repo pkgid = do
   fetched <- doesFileExist (packageFile repo pkgid)
   if fetched
     then do info verbosity $ display pkgid ++ " has already been downloaded."
@@ -136,20 +137,20 @@ fetchRepoTarball verbosity repo pkgid = do
             dir  = packageDir       repo pkgid
             path = packageFile      repo pkgid
         createDirectoryIfMissing True dir
-        _ <- downloadURI verbosity uri path
+        _ <- downloadURI transport verbosity uri path
         return path
 
 -- | Downloads an index file to [config-dir/packages/serv-id].
 --
-downloadIndex :: Verbosity -> RemoteRepo -> FilePath -> IO DownloadResult
-downloadIndex verbosity repo cacheDir = do
+downloadIndex :: HttpTransport -> Verbosity -> RemoteRepo -> FilePath -> IO DownloadResult
+downloadIndex transport verbosity repo cacheDir = do
   let uri = (remoteRepoURI repo) {
               uriPath = uriPath (remoteRepoURI repo)
                           `FilePath.Posix.combine` "00-index.tar.gz"
             }
       path = cacheDir </> "00-index" <.> "tar.gz"
   createDirectoryIfMissing True cacheDir
-  downloadURI verbosity uri path
+  downloadURI transport verbosity uri path
 
 
 -- ------------------------------------------------------------
diff --git a/cabal-install/Distribution/Client/Freeze.hs b/cabal-install/Distribution/Client/Freeze.hs
index 8c1b9a18af..98ec58cc73 100644
--- a/cabal-install/Distribution/Client/Freeze.hs
+++ b/cabal-install/Distribution/Client/Freeze.hs
@@ -27,6 +27,8 @@ import Distribution.Client.InstallPlan
 import qualified Distribution.Client.InstallPlan as InstallPlan
 import Distribution.Client.Setup
          ( GlobalFlags(..), FreezeFlags(..), ConfigExFlags(..) )
+import Distribution.Client.HttpUtils
+         ( configureTransport )
 import Distribution.Client.Sandbox.PackageEnvironment
          ( loadUserConfig, pkgEnvSavedConfig, showPackageEnvironment,
            userPackageEnvironmentFile )
@@ -42,7 +44,7 @@ import qualified Distribution.Simple.PackageIndex as PackageIndex
 import Distribution.Simple.Program
          ( ProgramConfiguration )
 import Distribution.Simple.Setup
-         ( fromFlag, fromFlagOrDefault )
+         ( fromFlag, fromFlagOrDefault, flagToMaybe )
 import Distribution.Simple.Utils
          ( die, notice, debug, writeFileAtomic )
 import Distribution.System
@@ -87,7 +89,9 @@ freeze verbosity packageDBs repos comp platform conf mSandboxPkgInfo
     installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
     sourcePkgDb       <- getSourcePackages    verbosity repos
 
-    pkgSpecifiers <- resolveUserTargets verbosity
+    transport <- configureTransport verbosity (flagToMaybe (globalHttpTransport globalFlags))
+
+    pkgSpecifiers <- resolveUserTargets transport verbosity
                        (fromFlag $ globalWorldFile globalFlags)
                        (packageIndex sourcePkgDb)
                        [UserTargetLocalDir "."]
diff --git a/cabal-install/Distribution/Client/Get.hs b/cabal-install/Distribution/Client/Get.hs
index 1c288ad960..8fc36ea3cb 100644
--- a/cabal-install/Distribution/Client/Get.hs
+++ b/cabal-install/Distribution/Client/Get.hs
@@ -21,7 +21,7 @@ module Distribution.Client.Get (
 import Distribution.Package
          ( PackageId, packageId, packageName )
 import Distribution.Simple.Setup
-         ( Flag(..), fromFlag, fromFlagOrDefault )
+         ( Flag(..), fromFlag, fromFlagOrDefault, flagToMaybe )
 import Distribution.Simple.Utils
          ( notice, die, info, writeFileAtomic )
 import Distribution.Verbosity
@@ -35,6 +35,8 @@ import Distribution.Client.Types
 import Distribution.Client.Targets
 import Distribution.Client.Dependency
 import Distribution.Client.FetchUtils
+import Distribution.Client.HttpUtils
+        ( configureTransport, HttpTransport(..) )
 import qualified Distribution.Client.Tar as Tar (extractTarGzFile)
 import Distribution.Client.IndexUtils as IndexUtils
         ( getSourcePackages )
@@ -90,7 +92,9 @@ get verbosity repos globalFlags getFlags userTargets = do
 
   sourcePkgDb <- getSourcePackages verbosity repos
 
-  pkgSpecifiers <- resolveUserTargets verbosity
+  transport <- configureTransport verbosity (flagToMaybe (globalHttpTransport globalFlags))
+
+  pkgSpecifiers <- resolveUserTargets transport verbosity
                    (fromFlag $ globalWorldFile globalFlags)
                    (packageIndex sourcePkgDb)
                    userTargets
@@ -104,7 +108,7 @@ get verbosity repos globalFlags getFlags userTargets = do
 
   if useFork
     then fork pkgs
-    else unpack pkgs
+    else unpack transport pkgs
 
   where
     resolverParams sourcePkgDb pkgSpecifiers =
@@ -119,10 +123,10 @@ get verbosity repos globalFlags getFlags userTargets = do
       branchers <- findUsableBranchers
       mapM_ (forkPackage verbosity branchers prefix kind) pkgs
 
-    unpack :: [SourcePackage] -> IO ()
-    unpack pkgs = do
+    unpack :: HttpTransport -> [SourcePackage] -> IO ()
+    unpack transport pkgs = do
       forM_ pkgs $ \pkg -> do
-        location <- fetchPackage verbosity (packageSource pkg)
+        location <- fetchPackage transport verbosity (packageSource pkg)
         let pkgid = packageId pkg
             descOverride | usePristine = Nothing
                          | otherwise   = packageDescrOverride pkg
diff --git a/cabal-install/Distribution/Client/HttpUtils.hs b/cabal-install/Distribution/Client/HttpUtils.hs
index 8e8e7dc4ab..486ee0331e 100644
--- a/cabal-install/Distribution/Client/HttpUtils.hs
+++ b/cabal-install/Distribution/Client/HttpUtils.hs
@@ -3,10 +3,9 @@
 -----------------------------------------------------------------------------
 module Distribution.Client.HttpUtils (
     DownloadResult(..),
+    configureTransport,
+    HttpTransport(..),
     downloadURI,
-    getHTTP,
-    cabalBrowse,
-    proxy,
     isOldHackageURI
   ) where
 
@@ -17,35 +16,56 @@ import Network.HTTP.Proxy ( Proxy(..), fetchProxy)
 import Network.URI
          ( URI (..), URIAuth (..) )
 import Network.Browser
-         ( BrowserAction, browse, setAllowBasicAuth, setAuthorityGen
-         , setOutHandler, setErrHandler, setProxy, request)
-import Network.Stream
-         ( Result, ConnError(..) )
-import Control.Exception
-         ( handleJust )
+         ( browse, setOutHandler, setErrHandler, setProxy
+         , setAuthorityGen, request, setAllowBasicAuth)
+import Control.Applicative
+import qualified Control.Exception as Exception
 import Control.Monad
-         ( liftM, guard )
+         ( when, guard, foldM )
 import qualified Data.ByteString.Lazy.Char8 as ByteString
-import Data.ByteString.Lazy (ByteString)
-
+import Data.List
+         ( isPrefixOf )
+import Data.Maybe
+         ( listToMaybe )
 import qualified Paths_cabal_install (version)
 import Distribution.Verbosity (Verbosity)
 import Distribution.Simple.Utils
-         ( die, info, warn, debug, notice
-         , copyFileVerbose, writeFileAtomic )
+         ( die, info, warn, debug, notice, writeFileAtomic
+         , copyFileVerbose,  withTempFile
+         , rawSystemStdInOut, toUTF8, fromUTF8, normaliseLineEndings )
 import Distribution.System
          ( buildOS, buildArch )
 import Distribution.Text
          ( display )
-import Data.Char ( isSpace )
+import Data.Char
+         ( isSpace )
 import qualified System.FilePath.Posix as FilePath.Posix
          ( splitDirectories )
 import System.FilePath
          ( (<.>) )
 import System.Directory
-         ( doesFileExist )
+         ( doesFileExist, renameFile, removeFile )
 import System.IO.Error
          ( isDoesNotExistError )
+import Distribution.Simple.Program
+         ( simpleProgram, getProgramInvocationOutput, programInvocation
+         , ConfiguredProgram, ProgramInvocation(..), defaultProgramConfiguration )
+import Distribution.Simple.Program.Db
+         ( ProgramDb, configureProgram, lookupProgram )
+import Distribution.Simple.Program.Run
+        ( IOEncoding(..), getEffectiveEnvironment )
+import Numeric (showHex)
+import System.Directory (canonicalizePath)
+import System.IO (hClose, openTempFile, hPutStr)
+import System.FilePath (takeFileName, takeDirectory)
+import System.Random (randomRIO)
+import System.Exit (ExitCode(..))
+
+readMay :: Read a => String -> Maybe a
+readMay s = case [x | (x,t) <- reads s, ("","") <- lex t] of
+                [x] -> Just x
+                _ -> Nothing
+
 
 data DownloadResult = FileAlreadyInCache | FileDownloaded FilePath deriving (Eq)
 
@@ -66,97 +86,267 @@ proxy _verbosity = do
       if uri' == "" then NoProxy else Proxy uri' auth
     _ -> p
 
-mkRequest :: URI
-          -> Maybe String -- ^ Optional etag to be set in the If-None-Match HTTP header.
-          -> Request ByteString
-mkRequest uri etag = Request{ rqURI     = uri
-                            , rqMethod  = GET
-                            , rqHeaders = Header HdrUserAgent userAgent : ifNoneMatchHdr
-                            , rqBody    = ByteString.empty }
-  where userAgent = concat [ "cabal-install/", display Paths_cabal_install.version
-                           , " (", display buildOS, "; ", display buildArch, ")"
-                           ]
-        ifNoneMatchHdr = maybe [] (\t -> [Header HdrIfNoneMatch t]) etag
-
--- |Carry out a GET request, using the local proxy settings
-getHTTP :: Verbosity
-        -> URI
-        -> 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 Nothing (request (mkRequest uri etag))
-
-cabalBrowse :: Verbosity
-            -> Maybe (String, String)
-            -> BrowserAction s a
-            -> IO a
-cabalBrowse verbosity auth act = do
-    p   <- proxy verbosity
-    handleJust
-        (guard . isDoesNotExistError)
-        (const . die $ "Couldn't establish HTTP connection. "
-                    ++ "Possible cause: HTTP proxy server is down.") $
-        browse $ do
-            setProxy p
-            setErrHandler (warn verbosity . ("http error: "++))
-            setOutHandler (debug verbosity)
-            setAllowBasicAuth False
-            setAuthorityGen (\_ _ -> return auth)
-            act
-
-downloadURI :: Verbosity
+userAgent :: String
+userAgent = concat [ "cabal-install/", display Paths_cabal_install.version
+                   , " (", display buildOS, "; ", display buildArch, ")"
+                   ]
+
+noPostYet :: URI -> String -> Maybe (String, String) -> IO (Int, String)
+noPostYet _ _ _ = die "Posting (for report upload) is not implemented yet"
+
+data HttpTransport = HttpTransport {
+      getHttp :: URI -> Maybe String -> FilePath -> IO (Int, Maybe String),
+      postHttp :: URI -> String -> Maybe (String, String) -> IO (Int, String),
+      putHttpFile :: URI -> FilePath -> Maybe (String,String) -> IO (Int, String)
+    }
+
+uriToSecure :: URI -> URI
+uriToSecure x | uriScheme x == "http:" = x {uriScheme = "https:"}
+              | otherwise = x
+
+setupTransportDb :: Verbosity -> IO ProgramDb
+setupTransportDb verbosity = foldM (flip (configureProgram verbosity)) defaultProgramConfiguration progs
+    where progs = map simpleProgram ["curl","wget","powershell"]
+
+configureTransport :: Verbosity -> Maybe String -> IO HttpTransport
+configureTransport verbosity prefTransport = do
+  db <- setupTransportDb verbosity
+  let
+      curlTrans = curlTransport verbosity <$> lookupProgram (simpleProgram "curl") db
+      wgetTrans = wgetTransport verbosity <$> lookupProgram (simpleProgram "wget") db
+      powershellTrans = powershellTransport verbosity <$> lookupProgram (simpleProgram "powershell") db
+      httpTrans = Just (plainHttpTransport verbosity)
+      trans = case prefTransport of
+                (Just "curl") -> curlTrans
+                (Just "wget") -> wgetTrans
+                (Just "powershell") -> powershellTrans
+                (Just "insecure-http") -> httpTrans
+                (Just t) -> error $ "Unknown transport specified: " ++ t
+                Nothing -> curlTrans <|> wgetTrans <|> powershellTrans
+  maybe (die $ "Could not find a secure https transport: Fallback to http by running with --http-transport=insecure-http") return trans
+
+
+statusParseFail :: URI -> String -> IO a
+statusParseFail uri r = die $ "Failed to download " ++ show uri ++ " : No Status Code could be parsed from Response: " ++ r
+
+curlTransport :: Verbosity -> ConfiguredProgram -> HttpTransport
+curlTransport verbosity prog = HttpTransport gethttp posthttp puthttpfile
+  where
+    gethttp uri' etag destPath = parseResponse =<< getProgramInvocationOutput verbosity (programInvocation prog args)
+      where args = [show uri,"-o",destPath,"-L","--write-out","%{http_code}","-A",userAgent,"-s","-S"]
+                   ++ maybe [] (\t -> ["--header","If-None-Match: " ++ t]) etag
+            parseResponse x = case readMay $ trim x of
+              Just i -> return (i, Nothing) -- TODO extract real etag
+              Nothing -> statusParseFail uri x
+            uri = uriToSecure uri'
+
+    posthttp = noPostYet
+
+    puthttpfile uri' path auth = parseResponse =<< getProgramInvocationOutput verbosity (programInvocation prog args)
+      where
+        args = [show uri,"-F","package=@"++path,"--write-out","%{http_code}","-A",userAgent]
+               ++ maybe [] (\(u,p) -> ["--digest","-u",u++":"++p]) auth
+        parseResponse x = case readMay . trim =<< listToMaybe . take 1 . reverse . lines =<< return x of
+          Just i -> return (i,x) -- TODO extract error?
+          Nothing -> statusParseFail uri x
+        uri = uriToSecure uri'
+
+wgetTransport :: Verbosity -> ConfiguredProgram -> HttpTransport
+wgetTransport verbosity prog = HttpTransport gethttp posthttp puthttpfile
+  where
+    gethttp uri' etag destPath = parseResponse . snd =<< getProgramInvocationOutputAndErrors verbosity (programInvocation prog args)
+      where
+        args = ["-S",show uri,"--output-document="++destPath,"--user-agent="++userAgent,"--tries=5","--timeout=15"]
+               ++ maybe [] (\t -> ["--header","If-None-Match: " ++ t]) etag
+        parseResponse x =
+          let resp = reverse . takeUntil ("HTTP/" `isPrefixOf`) . reverse . map (dropWhile isSpace) . lines $ x
+          in case readMay =<< listToMaybe . drop 1 . words =<< listToMaybe resp of
+            Just i -> return (i, Nothing) --TODO etags
+            Nothing -> statusParseFail uri x
+        uri = uriToSecure uri'
+
+    posthttp = noPostYet
+
+    puthttpfile _uri _path _auth = die $ "Https upload with wget is not yet supported. Either ensure curl is in your path or fallback to http by running with --http-transport=insecure-http."
+
+    -- TODO this doesn't do proper multipart with wget, which is not easy. It should be fixed.
+    _puthttpfileBroken uri' path auth = withTempFile (takeDirectory path) (takeFileName path) $ \tmpFile tmpHandle -> do
+      boundary <- genBoundary
+      body <- generateMultipartBody (ByteString.pack boundary) path
+      ByteString.hPut tmpHandle body
+      hClose tmpHandle
+      let args = ["-S",show uri,"--user-agent="++userAgent,"--post-file="++tmpFile]
+                 ++ ["--header=\"Content-type: multipart/form-data boundary="++boundary++"\""]
+                 ++ maybe [] (\(u,p) -> ["--http-user="++u,"--http-password="++p]) auth
+
+          parseResponse x =
+            let resp = reverse . takeUntil ("HTTP/" `isPrefixOf`) . reverse . map (dropWhile isSpace) . lines $ x
+            in case readMay =<< listToMaybe . drop 1 . words =<< listToMaybe resp of
+              Just i -> return (i, x)
+              Nothing -> statusParseFail uri x
+          uri = uriToSecure uri'
+      parseResponse =<< getProgramInvocationOutput verbosity (programInvocation prog args)
+
+    takeUntil _ [] = []
+    takeUntil p (x:xs) = if p x then [x] else x : takeUntil p xs
+
+powershellTransport :: Verbosity -> ConfiguredProgram -> HttpTransport
+powershellTransport verbosity prog = HttpTransport gethttp posthttp puthttpfile
+  where
+    gethttp uri' etag destPath = do
+      _proxyInfo <- proxy verbosity
+      let
+        uri = uriToSecure uri'
+        escape x = '"' : x ++ "\"" --TODO write/find real escape.
+        proxySettings = [] --TODO extract real settings from proxyInfo
+
+        parseResponse x = case readMay . unlines . take 1 . lines $ trim x of
+          Just i -> return (i, Nothing) -- TODO extract real etag
+          Nothing -> statusParseFail uri x
+
+        script = unlines . map (++";") $
+                 ["$wc = new-object system.net.webclient",
+                  "$wc.Headers.Add(\"user-agent\","++escape userAgent++")"]
+                 ++ maybe [] (\t -> ["$wc.Headers.Add(\"If-None-Match\"," ++ t ++ ")"]) etag
+                 ++ proxySettings
+                 ++ ["Try {",
+                     "$wc.DownloadFile("++ escape (show uri) ++ "," ++ escape destPath ++ ")",
+                     "} Catch {Write-Error $_; Exit(5);}",
+                     "Write-Host \"200\"",
+                     "Write-Host $wc.ResponseHeaders.Item(\"ETag\")",
+                     "Exit"]
+      withTempFile (takeDirectory destPath) "psScript.ps1" $ \tmpFile tmpHandle -> do
+         hPutStr tmpHandle script
+         hClose tmpHandle
+         foo <- getProgramInvocationOutputAndErrors verbosity (programInvocation prog ["-InputFormat","None","-File",tmpFile])
+         putStrLn $ show foo
+         parseResponse (fst foo)
+
+    posthttp = noPostYet
+
+
+    puthttpfile uri' path auth = withTempFile (takeDirectory path) (takeFileName path) $ \tmpFile tmpHandle -> do
+      boundary <- genBoundary
+      body <- generateMultipartBody (ByteString.pack boundary) path
+      ByteString.hPut tmpHandle body
+      hClose tmpHandle
+      fullPath <- canonicalizePath tmpFile
+      _proxyInfo <- proxy verbosity
+      let
+        uri = uriToSecure uri'
+        escape x = show x
+        proxySettings = [] --TODO extract real settings from proxyInfo
+
+        parseResponse x = case readMay . unlines . take 1 . lines $ trim x of
+          Just i -> return (i, x) -- TODO extract real etag
+          Nothing -> statusParseFail uri x
+
+        script = unlines . map (++";") $
+                 ["$wc = new-object system.net.webclient",
+                  "$wc.Headers.Add(\"user-agent\","++escape userAgent++")",
+                  "$wc.Headers.Add(\"Content-type\","++"\"multipart/form-data; boundary="++boundary++"\")"]
+                 ++ authSettings
+                 ++ proxySettings
+                 ++ ["Try {",
+                     "$bytes = [System.IO.File]::ReadAllBytes("++escape fullPath++")",
+                     "$wc.UploadData("++ escape (show uri) ++ ",$bytes)",
+                     "} Catch {Write-Error $_; Exit(1);}",
+                     "Write-Host \"200\"",
+                     "Exit"]
+        authSettings = case auth of Just (u,p) -> ["$wc.Credentials = new-object System.Net.NetworkCredential("++escape u ++ "," ++ escape p ++ ",\"\")"]; Nothing -> []
+
+      withTempFile (takeDirectory path) "psScript.ps1" $ \tmpScriptFile tmpScriptHandle -> do
+         hPutStr tmpScriptHandle script
+         hClose tmpScriptHandle
+         foo <- getProgramInvocationOutputAndErrors verbosity (programInvocation prog ["-InputFormat","None","-File",tmpScriptFile])
+         putStrLn $ show foo
+         parseResponse (fst foo)
+
+plainHttpTransport :: Verbosity -> HttpTransport
+plainHttpTransport verbosity = HttpTransport gethttp posthttp puthttpfile
+  where gethttp uri etag destPath =
+          processGetResult destPath . snd =<< cabalBrowse (request
+            Request{ rqURI     = uri
+                   , rqMethod  = GET
+                   , rqHeaders = Header HdrUserAgent userAgent
+                                 : maybe [] (\t -> [Header HdrIfNoneMatch t]) etag
+                   , rqBody    = ByteString.empty })
+
+        processGetResult destPath resp = do
+            when (code==200) $ writeFileAtomic destPath $ rspBody resp
+            return (code, etag)
+          where code = case rspCode (resp) of (a,b,c) -> a*100 + b*10 + c
+                etag = lookupHeader HdrETag (rspHeaders resp)
+
+        posthttp = noPostYet
+
+        puthttpfile uri path auth = do
+          boundary <- genBoundary
+          body <- generateMultipartBody (ByteString.pack boundary) path
+          let authorize = do
+                setAllowBasicAuth False
+                setAuthorityGen (\_ _ -> return auth)
+          processPutResult . snd <$> cabalBrowse (authorize >> request Request {
+                         rqURI = uri,
+                         rqMethod = POST,
+                         rqHeaders = [Header HdrContentType ("multipart/form-data; boundary="++boundary),
+                                      Header HdrContentLength (show (ByteString.length body)),
+                                      Header HdrAccept ("text/plain")],
+                         rqBody = body
+                        })
+
+        processPutResult resp = (code, rspReason resp)
+          where code = case rspCode (resp) of (a,b,c) -> a*100 + b*10 + c
+
+        cabalBrowse act = do
+          p <- proxy verbosity
+          Exception.handleJust
+                (guard . isDoesNotExistError)
+                (const . die $ "Couldn't establish HTTP connection. "
+                 ++ "Possible cause: HTTP proxy server is down.") $
+                browse $ do
+                  setProxy p
+                  setErrHandler (warn verbosity . ("http error: "++))
+                  setOutHandler (debug verbosity)
+                  act
+
+downloadURI :: HttpTransport
+            -> Verbosity
             -> URI      -- ^ What to download
             -> FilePath -- ^ Where to put it
             -> IO DownloadResult
-downloadURI verbosity uri path | uriScheme uri == "file:" = do
+downloadURI _transport verbosity uri path | uriScheme uri == "file:" = do
   copyFileVerbose verbosity (uriPath uri) path
   return (FileDownloaded path)
   -- Can we store the hash of the file so we can safely return path when the
   -- hash matches to avoid unnecessary computation?
-downloadURI verbosity uri path = do
+
+downloadURI transport verbosity uri path = withTempFileName (takeDirectory path) (takeFileName path) $ \tmpFile -> do
   let etagPath = path <.> "etag"
   targetExists   <- doesFileExist path
   etagPathExists <- doesFileExist etagPath
   -- In rare cases the target file doesn't exist, but the etag does.
   etag <- if targetExists && etagPathExists
-            then liftM Just $ readFile etagPath
+            then Just <$> readFile etagPath
             else return Nothing
 
-  result <- getHTTP verbosity uri etag
-  let result' = case result of
-        Left  err -> Left err
-        Right rsp -> case rspCode rsp of
-          (2,0,0) -> Right rsp
-          (3,0,4) -> Right rsp
-          (a,b,c) -> Left err
-            where
-              err = ErrorMisc $ "Error HTTP code: "
-                                ++ concatMap show [a,b,c]
+  result <- getHttp transport uri etag tmpFile
 
   -- Only write the etag if we get a 200 response code.
   -- A 304 still sends us an etag header.
-  case result' of
-    Left _ -> return ()
-    Right rsp -> case rspCode rsp of
-      (2,0,0) -> case lookupHeader HdrETag (rspHeaders rsp) of
-        Nothing -> return ()
-        Just newEtag -> writeFile etagPath newEtag
-      (_,_,_) -> return ()
-
-  case result' of
-    Left err   -> die $ "Failed to download " ++ show uri ++ " : " ++ show err
-    Right rsp -> case rspCode rsp of
-      (2,0,0) -> do
+  case result of
+    (200, Just newEtag) -> writeFile etagPath newEtag
+    _ -> return ()
+
+  case fst result of
+    200 -> do
         info verbosity ("Downloaded to " ++ path)
-        writeFileAtomic path $ rspBody rsp
+        renameFile tmpFile path
         return (FileDownloaded path)
-      (3,0,4) -> do
+    304 -> do
         notice verbosity "Skipping download: Local and remote files match."
         return FileAlreadyInCache
-      (_,_,_) -> return (FileDownloaded path)
-      --FIXME: check the content-length header matches the body length.
-      --TODO: stream the download into the file rather than buffering the whole
-      --      thing in memory.
+    errCode ->  die $ "Failed to download " ++ show uri ++ " : HTTP code " ++ show errCode
 
 -- Utility function for legacy support.
 isOldHackageURI :: URI -> Bool
@@ -165,3 +355,67 @@ isOldHackageURI uri
         Just (URIAuth {uriRegName = "hackage.haskell.org"}) ->
             FilePath.Posix.splitDirectories (uriPath uri) == ["/","packages","archive"]
         _ -> False
+
+-- Gets us the temp file name but gives us more control over the file itself.
+
+withTempFileName :: FilePath
+             -> String
+             -> (FilePath -> IO a) -> IO a
+withTempFileName tmpDir template action =
+  Exception.bracket
+    (openTempFile tmpDir template)
+    (\(name, _) -> (`when` removeFile name) =<< doesFileExist name)
+    (\(name, h) -> hClose h >> action name)
+
+-- Multipart stuff partially taken from cgi package.
+
+genBoundary :: IO String
+genBoundary = do i <- randomRIO (0x10000000000000,0xFFFFFFFFFFFFFF) :: IO Integer
+                 return $ showHex i ""
+
+generateMultipartBody :: ByteString.ByteString -> FilePath -> IO ByteString.ByteString
+generateMultipartBody boundary path = do
+  pkg <- ByteString.readFile path
+  let
+    crlf = ByteString.pack "\r\n"
+    dd = ByteString.pack "--"
+    printOneMultiPart (hs, c) = printBodyPart (hs,c) ++ [crlf, dd, boundary, dd, crlf]
+    printBodyPart (hs, c) = [crlf, dd, boundary, crlf] ++ map (ByteString.pack . show) hs ++ [crlf, c]
+    formData = ( [Header (HdrCustom "Content-disposition") $
+                   "form-data; name=package; filename=\""++takeFileName path++"\"",
+                   Header HdrContentType "application/x-gzip"],
+                   pkg)
+    body = ByteString.concat $ printOneMultiPart formData
+  return body
+
+-- This should go back in the main program machinery. We need the errors explicitly because wget writes its results to stderr for no good reason.
+
+getProgramInvocationOutputAndErrors :: Verbosity -> ProgramInvocation -> IO (String, String)
+getProgramInvocationOutputAndErrors verbosity
+  ProgramInvocation {
+    progInvokePath  = path,
+    progInvokeArgs  = args,
+    progInvokeEnv   = envOverrides,
+    progInvokeCwd   = mcwd,
+    progInvokeInput = minputStr,
+    progInvokeOutputEncoding = encoding
+  } = do
+    let utf8 = case encoding of IOEncodingUTF8 -> True; _ -> False
+        decode | utf8      = fromUTF8 . normaliseLineEndings
+               | otherwise = id
+    menv <- getEffectiveEnvironment envOverrides
+    (output, errors, exitCode) <- rawSystemStdInOut verbosity
+                                    path args
+                                    mcwd menv
+                                    input utf8
+    when (exitCode /= ExitSuccess) $
+      die $ "'" ++ path ++ "' exited with an error:\n" ++ errors ++ "\n" ++ decode output
+    return (decode output, errors)
+  where
+    input =
+      case minputStr of
+        Nothing       -> Nothing
+        Just inputStr -> Just $
+          case encoding of
+            IOEncodingText -> (inputStr, False)
+            IOEncodingUTF8 -> (toUTF8 inputStr, True) -- use binary mode for utf8
diff --git a/cabal-install/Distribution/Client/Install.hs b/cabal-install/Distribution/Client/Install.hs
index c1c53c26fe..c8cef42e59 100644
--- a/cabal-install/Distribution/Client/Install.hs
+++ b/cabal-install/Distribution/Client/Install.hs
@@ -72,6 +72,8 @@ import Distribution.Client.Dependency
 import Distribution.Client.Dependency.Types
          ( Solver(..) )
 import Distribution.Client.FetchUtils
+import Distribution.Client.HttpUtils
+         ( configureTransport, HttpTransport (..) )
 import qualified Distribution.Client.Haddock as Haddock (regenerateHaddockIndex)
 import Distribution.Client.IndexUtils as IndexUtils
          ( getSourcePackages, getInstalledPackages )
@@ -228,7 +230,7 @@ install verbosity packageDBs repos comp platform conf useSandbox mSandboxPkgInfo
 -- TODO: Make InstallContext a proper data type with documented fields.
 -- | Common context for makeInstallPlan and processInstallPlan.
 type InstallContext = ( InstalledPackageIndex, SourcePackageDb
-                      , [UserTarget], [PackageSpecifier SourcePackage] )
+                      , [UserTarget], [PackageSpecifier SourcePackage], HttpTransport )
 
 -- TODO: Make InstallArgs a proper data type with documented fields or just get
 -- rid of it completely.
@@ -255,6 +257,7 @@ makeInstallContext verbosity
 
     installedPkgIndex <- getInstalledPackages verbosity comp packageDBs conf
     sourcePkgDb       <- getSourcePackages    verbosity repos
+    transport <- configureTransport verbosity (flagToMaybe (globalHttpTransport globalFlags))
 
     (userTargets, pkgSpecifiers) <- case mUserTargets of
       Nothing           ->
@@ -268,13 +271,13 @@ makeInstallContext verbosity
         let userTargets | null userTargets0 = [UserTargetLocalDir "."]
                         | otherwise         = userTargets0
 
-        pkgSpecifiers <- resolveUserTargets verbosity
+        pkgSpecifiers <- resolveUserTargets transport verbosity
                          (fromFlag $ globalWorldFile globalFlags)
                          (packageIndex sourcePkgDb)
                          userTargets
         return (userTargets, pkgSpecifiers)
 
-    return (installedPkgIndex, sourcePkgDb, userTargets, pkgSpecifiers)
+    return (installedPkgIndex, sourcePkgDb, userTargets, pkgSpecifiers, transport)
 
 -- | Make an install plan given install context and install arguments.
 makeInstallPlan :: Verbosity -> InstallArgs -> InstallContext
@@ -284,7 +287,7 @@ makeInstallPlan verbosity
    _, configFlags, configExFlags, installFlags,
    _)
   (installedPkgIndex, sourcePkgDb,
-   _, pkgSpecifiers) = do
+   _, pkgSpecifiers, _) = do
 
     solver <- chooseSolver verbosity (fromFlag (configSolver configExFlags))
               (compilerInfo comp)
@@ -300,7 +303,7 @@ processInstallPlan :: Verbosity -> InstallArgs -> InstallContext
 processInstallPlan verbosity
   args@(_,_, comp, _, _, _, _, _, _, _, installFlags, _)
   (installedPkgIndex, sourcePkgDb,
-   userTargets, pkgSpecifiers) installPlan = do
+   userTargets, pkgSpecifiers, _) installPlan = do
     checkPrintPlan verbosity comp installedPkgIndex installPlan sourcePkgDb
       installFlags pkgSpecifiers
 
@@ -687,7 +690,7 @@ reportPlanningFailure :: Verbosity -> InstallArgs -> InstallContext -> String ->
 reportPlanningFailure verbosity
   (_, _, comp, platform, _, _, _
   ,_, configFlags, _, installFlags, _)
-  (_, sourcePkgDb, _, pkgSpecifiers)
+  (_, sourcePkgDb, _, pkgSpecifiers, _)
   message = do
 
   when reportFailure $ do
@@ -1015,13 +1018,14 @@ performInstallations verbosity
   installLock  <- newLock -- serialise installation
   cacheLock    <- newLock -- serialise access to setup exe cache
 
+  transport <- configureTransport verbosity (flagToMaybe (globalHttpTransport globalFlags))
 
   executeInstallPlan verbosity comp jobControl useLogFile installPlan $ \rpkg ->
     -- Calculate the package key (ToDo: Is this right for source install)
     let pkg_key = readyPackageKey comp rpkg in
     installReadyPackage platform cinfo configFlags
                         rpkg $ \configFlags' src pkg pkgoverride ->
-      fetchSourcePackage verbosity fetchLimit src $ \src' ->
+      fetchSourcePackage transport verbosity fetchLimit src $ \src' ->
         installLocalPackage verbosity buildLimit
                             (packageId pkg) src' distPref $ \mpath ->
           installUnpackedPackage verbosity buildLimit installLock numJobs pkg_key
@@ -1217,18 +1221,19 @@ installReadyPackage platform cinfo configFlags
       Right (desc, _) -> desc
 
 fetchSourcePackage
-  :: Verbosity
+  :: HttpTransport
+  -> Verbosity
   -> JobLimit
   -> PackageLocation (Maybe FilePath)
   -> (PackageLocation FilePath -> IO BuildResult)
   -> IO BuildResult
-fetchSourcePackage verbosity fetchLimit src installPkg = do
+fetchSourcePackage transport verbosity fetchLimit src installPkg = do
   fetched <- checkFetched src
   case fetched of
     Just src' -> installPkg src'
     Nothing   -> onFailure DownloadFailed $ do
                    loc <- withJobLimit fetchLimit $
-                            fetchPackage verbosity src
+                            fetchPackage transport verbosity src
                    installPkg loc
 
 
diff --git a/cabal-install/Distribution/Client/List.hs b/cabal-install/Distribution/Client/List.hs
index dbcd3f9fc0..3ce3dd2533 100644
--- a/cabal-install/Distribution/Client/List.hs
+++ b/cabal-install/Distribution/Client/List.hs
@@ -30,7 +30,7 @@ import Distribution.Simple.Compiler
 import Distribution.Simple.Program (ProgramConfiguration)
 import Distribution.Simple.Utils
         ( equating, comparing, die, notice )
-import Distribution.Simple.Setup (fromFlag)
+import Distribution.Simple.Setup (fromFlag, flagToMaybe)
 import Distribution.Simple.PackageIndex (InstalledPackageIndex)
 import qualified Distribution.Simple.PackageIndex as InstalledPackageIndex
 import qualified Distribution.Client.PackageIndex as PackageIndex
@@ -55,6 +55,8 @@ import Distribution.Client.IndexUtils as IndexUtils
          ( getSourcePackages, getInstalledPackages )
 import Distribution.Client.FetchUtils
          ( isFetched )
+import Distribution.Client.HttpUtils
+        ( configureTransport )
 
 import Data.List
          ( sortBy, groupBy, sort, nub, intersperse, maximumBy, partition )
@@ -187,7 +189,8 @@ info verbosity packageDBs repos comp conf
                       (InstalledPackageIndex.allPackages installedPkgIndex)
                    ++ map packageId
                       (PackageIndex.allPackages sourcePkgIndex)
-    pkgSpecifiers <- resolveUserTargets verbosity
+    transport <- configureTransport verbosity (flagToMaybe (globalHttpTransport globalFlags))
+    pkgSpecifiers <- resolveUserTargets transport verbosity
                        (fromFlag $ globalWorldFile globalFlags)
                        sourcePkgs' userTargets
 
diff --git a/cabal-install/Distribution/Client/Setup.hs b/cabal-install/Distribution/Client/Setup.hs
index 319fef6a3b..75626fa891 100644
--- a/cabal-install/Distribution/Client/Setup.hs
+++ b/cabal-install/Distribution/Client/Setup.hs
@@ -126,7 +126,8 @@ data GlobalFlags = GlobalFlags {
     globalLogsDir           :: Flag FilePath,
     globalWorldFile         :: Flag FilePath,
     globalRequireSandbox    :: Flag Bool,
-    globalIgnoreSandbox     :: Flag Bool
+    globalIgnoreSandbox     :: Flag Bool,
+    globalHttpTransport     :: Flag String
   }
 
 defaultGlobalFlags :: GlobalFlags
@@ -141,7 +142,8 @@ defaultGlobalFlags  = GlobalFlags {
     globalLogsDir           = mempty,
     globalWorldFile         = mempty,
     globalRequireSandbox    = Flag False,
-    globalIgnoreSandbox     = Flag False
+    globalIgnoreSandbox     = Flag False,
+    globalHttpTransport     = mempty
   }
 
 globalCommand :: [Command action] -> CommandUI GlobalFlags
@@ -260,7 +262,7 @@ globalCommand commands = CommandUI {
     commandNotes = Nothing,
     commandDefaultFlags = mempty,
     commandOptions      = \showOrParseArgs ->
-      (case showOrParseArgs of ShowArgs -> take 6; ParseArgs -> id)
+      (case showOrParseArgs of ShowArgs -> take 7; ParseArgs -> id)
       [option ['V'] ["version"]
          "Print version information"
          globalVersion (\v flags -> flags { globalVersion = v })
@@ -291,6 +293,11 @@ globalCommand commands = CommandUI {
          globalIgnoreSandbox (\v flags -> flags { globalIgnoreSandbox = v })
          trueArg
 
+      ,option [] ["http-transport"]
+         "Set a transport for http(s) requests. Accepts 'curl', 'wget', 'powershell', and 'insecure-http'. (default: 'curl')"
+         globalConfigFile (\v flags -> flags { globalHttpTransport = v })
+         (reqArgFlag "HttpTransport")
+
       ,option [] ["remote-repo"]
          "The name and url for a remote repository"
          globalRemoteRepos (\v flags -> flags { globalRemoteRepos = v })
@@ -330,7 +337,8 @@ instance Monoid GlobalFlags where
     globalLogsDir           = mempty,
     globalWorldFile         = mempty,
     globalRequireSandbox    = mempty,
-    globalIgnoreSandbox     = mempty
+    globalIgnoreSandbox     = mempty,
+    globalHttpTransport     = mempty
   }
   mappend a b = GlobalFlags {
     globalVersion           = combine globalVersion,
@@ -343,7 +351,8 @@ instance Monoid GlobalFlags where
     globalLogsDir           = combine globalLogsDir,
     globalWorldFile         = combine globalWorldFile,
     globalRequireSandbox    = combine globalRequireSandbox,
-    globalIgnoreSandbox     = combine globalIgnoreSandbox
+    globalIgnoreSandbox     = combine globalIgnoreSandbox,
+    globalHttpTransport     = combine globalHttpTransport
   }
     where combine field = field a `mappend` field b
 
@@ -1953,7 +1962,7 @@ sandboxCommand = CommandUI {
     , headLine "init:"
     , indentParagraph $ "Initialize a sandbox in the current directory."
       ++ " An existing package database will not be modified, but settings"
-      ++ " (such as the location of the database) can be modified this way." 
+      ++ " (such as the location of the database) can be modified this way."
     , headLine "delete:"
     , indentParagraph $ "Remove the sandbox; deleting all the packages"
       ++ " installed inside."
diff --git a/cabal-install/Distribution/Client/Targets.hs b/cabal-install/Distribution/Client/Targets.hs
index c5a5c676a5..c64e18abdd 100644
--- a/cabal-install/Distribution/Client/Targets.hs
+++ b/cabal-install/Distribution/Client/Targets.hs
@@ -59,6 +59,7 @@ import Distribution.Client.PackageIndex (PackageIndex)
 import qualified Distribution.Client.PackageIndex as PackageIndex
 import qualified Distribution.Client.Tar as Tar
 import Distribution.Client.FetchUtils
+import Distribution.Client.HttpUtils ( HttpTransport(..) )
 import Distribution.Client.Utils ( tryFindPackageDesc )
 
 import Distribution.PackageDescription
@@ -350,17 +351,18 @@ reportUserTargetProblems problems = do
 -- or they can be named packages (with or without version info).
 --
 resolveUserTargets :: Package pkg
-                   => Verbosity
+                   => HttpTransport
+                   -> Verbosity
                    -> FilePath
                    -> PackageIndex pkg
                    -> [UserTarget]
                    -> IO [PackageSpecifier SourcePackage]
-resolveUserTargets verbosity worldFile available userTargets = do
+resolveUserTargets transport verbosity worldFile available userTargets = do
 
     -- given the user targets, get a list of fully or partially resolved
     -- package references
     packageTargets <- mapM (readPackageTarget verbosity)
-                  =<< mapM (fetchPackageTarget verbosity) . concat
+                  =<< mapM (fetchPackageTarget transport verbosity) . concat
                   =<< mapM (expandUserTarget worldFile) userTargets
 
     -- users are allowed to give package names case-insensitively, so we must
@@ -446,14 +448,15 @@ localPackageError dir =
 
 -- | Fetch any remote targets so that they can be read.
 --
-fetchPackageTarget :: Verbosity
+fetchPackageTarget :: HttpTransport
+                   -> Verbosity
                    -> PackageTarget (PackageLocation ())
                    -> IO (PackageTarget (PackageLocation FilePath))
-fetchPackageTarget verbosity target = case target of
+fetchPackageTarget transport verbosity target = case target of
     PackageTargetNamed      n cs ut -> return (PackageTargetNamed      n cs ut)
     PackageTargetNamedFuzzy n cs ut -> return (PackageTargetNamedFuzzy n cs ut)
     PackageTargetLocation location  -> do
-      location' <- fetchPackage verbosity (fmap (const Nothing) location)
+      location' <- fetchPackage transport verbosity (fmap (const Nothing) location)
       return (PackageTargetLocation location')
 
 
diff --git a/cabal-install/Distribution/Client/Update.hs b/cabal-install/Distribution/Client/Update.hs
index 50e35e1ea4..069488320c 100644
--- a/cabal-install/Distribution/Client/Update.hs
+++ b/cabal-install/Distribution/Client/Update.hs
@@ -17,7 +17,7 @@ module Distribution.Client.Update
 import Distribution.Client.Types
          ( Repo(..), RemoteRepo(..), LocalRepo(..) )
 import Distribution.Client.HttpUtils
-         ( DownloadResult(..) )
+         ( DownloadResult(..), HttpTransport(..) )
 import Distribution.Client.FetchUtils
          ( downloadIndex )
 import Distribution.Client.IndexUtils
@@ -36,11 +36,11 @@ import System.FilePath (dropExtension)
 import Data.Either (lefts)
 
 -- | 'update' downloads the package list from all known servers
-update :: Verbosity -> [Repo] -> IO ()
-update verbosity [] =
+update :: HttpTransport -> Verbosity -> [Repo] -> IO ()
+update _ verbosity [] =
   warn verbosity $ "No remote package servers have been specified. Usually "
                 ++ "you would have one specified in the config file."
-update verbosity repos = do
+update transport verbosity repos = do
   jobCtrl <- newParallelJobControl
   let remoteRepos = lefts (map repoKind repos)
   case remoteRepos of
@@ -51,14 +51,14 @@ update verbosity repos = do
     _ -> notice verbosity . unlines
             $ "Downloading the latest package lists from: "
             : map (("- " ++) . remoteRepoName) remoteRepos
-  mapM_ (spawnJob jobCtrl . updateRepo verbosity) repos
+  mapM_ (spawnJob jobCtrl . updateRepo transport verbosity) repos
   mapM_ (\_ -> collectJob jobCtrl) repos
 
-updateRepo :: Verbosity -> Repo -> IO ()
-updateRepo verbosity repo = case repoKind repo of
+updateRepo :: HttpTransport -> Verbosity -> Repo -> IO ()
+updateRepo transport verbosity repo = case repoKind repo of
   Right LocalRepo -> return ()
   Left remoteRepo -> do
-    downloadResult <- downloadIndex verbosity remoteRepo (repoLocalDir repo)
+    downloadResult <- downloadIndex transport verbosity remoteRepo (repoLocalDir repo)
     case downloadResult of
       FileAlreadyInCache -> return ()
       FileDownloaded indexPath -> do
diff --git a/cabal-install/Distribution/Client/Upload.hs b/cabal-install/Distribution/Client/Upload.hs
index 3801f336ec..33c16d3486 100644
--- a/cabal-install/Distribution/Client/Upload.hs
+++ b/cabal-install/Distribution/Client/Upload.hs
@@ -3,13 +3,10 @@
 
 module Distribution.Client.Upload (check, upload, report) where
 
-import qualified Data.ByteString.Lazy.Char8 as B (concat, length, pack, readFile, unpack)
-import           Data.ByteString.Lazy.Char8 (ByteString)
-
 import Distribution.Client.Types (Username(..), Password(..),Repo(..),RemoteRepo(..))
-import Distribution.Client.HttpUtils (isOldHackageURI, cabalBrowse)
+import Distribution.Client.HttpUtils (isOldHackageURI, HttpTransport(..))
 
-import Distribution.Simple.Utils (debug, notice, warn, info)
+import Distribution.Simple.Utils (notice, warn, info)
 import Distribution.Verbosity (Verbosity)
 import Distribution.Text (display)
 import Distribution.Client.Config
@@ -17,23 +14,16 @@ import Distribution.Client.Config
 import qualified Distribution.Client.BuildReports.Anonymous as BuildReport
 import qualified Distribution.Client.BuildReports.Upload as BuildReport
 
-import Network.Browser
-         ( request )
-import Network.HTTP
-         ( Header(..), HeaderName(..), findHeader
-         , Request(..), RequestMethod(..), Response(..) )
 import Network.URI (URI(uriPath), parseURI)
 
-import Data.Char        (intToDigit)
-import Numeric          (showHex)
 import System.IO        (hFlush, stdin, stdout, hGetEcho, hSetEcho)
 import Control.Exception (bracket)
-import System.Random    (randomRIO)
-import System.FilePath  ((</>), takeExtension, takeFileName)
+import System.FilePath  ((</>), takeExtension)
 import qualified System.FilePath.Posix as FilePath.Posix (combine)
 import System.Directory
 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?
@@ -43,18 +33,17 @@ Just legacyUploadURI = parseURI "http://hackage.haskell.org/cgi-bin/hackage-scri
 checkURI :: URI
 Just checkURI = parseURI "http://hackage.haskell.org/cgi-bin/hackage-scripts/check-pkg"
 
-
-upload :: Verbosity -> [Repo] -> Maybe Username -> Maybe Password -> [FilePath] -> IO ()
-upload verbosity repos mUsername mPassword paths = do
+upload :: HttpTransport -> Verbosity -> [Repo] -> Maybe Username -> Maybe Password -> [FilePath] -> IO ()
+upload transport verbosity repos mUsername mPassword paths = do
           let uploadURI = if isOldHackageURI targetRepoURI
                           then legacyUploadURI
                           else targetRepoURI{uriPath = uriPath targetRepoURI `FilePath.Posix.combine` "upload"}
           Username username <- maybe promptUsername return mUsername
           Password password <- maybe promptPassword return mPassword
-          let auth = Just (username, password)
+          let auth = Just (username,password)
           flip mapM_ paths $ \path -> do
             notice verbosity $ "Uploading " ++ path ++ "... "
-            handlePackage verbosity uploadURI auth path
+            handlePackage transport verbosity uploadURI auth path
   where
     targetRepoURI = remoteRepoURI $ last [ remoteRepo | Left remoteRepo <- map repoKind repos ] --FIXME: better error message when no repos are given
 
@@ -79,7 +68,7 @@ report :: Verbosity -> [Repo] -> Maybe Username -> Maybe Password -> IO ()
 report verbosity repos mUsername mPassword = do
       Username username <- maybe promptUsername return mUsername
       Password password <- maybe promptPassword return mPassword
-      let auth = Just (username, password)
+      let auth = (username,password)
       forM_ repos $ \repo -> case repoKind repo of
         Left remoteRepo
             -> do dotCabal <- defaultCabalDir
@@ -95,79 +84,23 @@ report verbosity repos mUsername mPassword = do
                              Left errs -> do warn verbosity $ "Errors: " ++ errs -- FIXME
                              Right report' ->
                                  do info verbosity $ "Uploading report for " ++ display (BuildReport.package report')
-                                    cabalBrowse verbosity auth $ BuildReport.uploadReports (remoteRepoURI remoteRepo) [(report', Just buildLog)]
+                                    BuildReport.uploadReports verbosity auth (remoteRepoURI remoteRepo) [(report', Just buildLog)]
                                     return ()
         Right{} -> return ()
 
-check :: Verbosity -> [FilePath] -> IO ()
-check verbosity paths = do
+check :: HttpTransport -> Verbosity -> [FilePath] -> IO ()
+check transport verbosity paths = do
           flip mapM_ paths $ \path -> do
             notice verbosity $ "Checking " ++ path ++ "... "
-            handlePackage verbosity checkURI Nothing path
+            handlePackage transport verbosity checkURI Nothing path
 
-handlePackage :: Verbosity -> URI -> Maybe (String, String)
+handlePackage :: HttpTransport -> Verbosity -> URI -> Auth
               -> FilePath -> IO ()
-handlePackage verbosity uri auth path =
-  do req <- mkRequest uri path
-     debug verbosity $ "\n" ++ show req
-     (_,resp) <- cabalBrowse verbosity auth $ request req
-     debug verbosity $ show resp
-     case rspCode resp of
-       (2,0,0) -> do notice verbosity "Ok"
-       (x,y,z) -> do notice verbosity $ "Error: " ++ path ++ ": "
-                                     ++ map intToDigit [x,y,z] ++ " "
-                                     ++ rspReason resp
-                     case findHeader HdrContentType resp of
-                       Just contenttype
-                         | takeWhile (/= ';') contenttype == "text/plain"
-                         -> notice verbosity $ B.unpack $ rspBody resp
-                       _ -> debug verbosity $ B.unpack $ rspBody resp
-
-mkRequest :: URI -> FilePath -> IO (Request ByteString)
-mkRequest uri path = 
-    do pkg <- readBinaryFile path
-       boundary <- genBoundary
-       let body = printMultiPart (B.pack boundary) (mkFormData path pkg)
-       return $ Request {
-                         rqURI = uri,
-                         rqMethod = POST,
-                         rqHeaders = [Header HdrContentType ("multipart/form-data; boundary="++boundary),
-                                      Header HdrContentLength (show (B.length body)),
-                                      Header HdrAccept ("text/plain")],
-                         rqBody = body
-                        }
-
-readBinaryFile :: FilePath -> IO ByteString
-readBinaryFile = B.readFile
-
-genBoundary :: IO String
-genBoundary = do i <- randomRIO (0x10000000000000,0xFFFFFFFFFFFFFF) :: IO Integer
-                 return $ showHex i ""
-
-mkFormData :: FilePath -> ByteString -> [BodyPart]
-mkFormData path pkg =
-  -- yes, web browsers are that stupid (re quoting)
-  [BodyPart [Header hdrContentDisposition $
-             "form-data; name=package; filename=\""++takeFileName path++"\"",
-             Header HdrContentType "application/x-gzip"]
-   pkg]
-
-hdrContentDisposition :: HeaderName
-hdrContentDisposition = HdrCustom "Content-disposition"
-
--- * Multipart, partly stolen from the cgi package.
-
-data BodyPart = BodyPart [Header] ByteString
-
-printMultiPart :: ByteString -> [BodyPart] -> ByteString
-printMultiPart boundary xs =
-    B.concat $ map (printBodyPart boundary) xs ++ [crlf, dd, boundary, dd, crlf]
-
-printBodyPart :: ByteString -> BodyPart -> ByteString
-printBodyPart boundary (BodyPart hs c) = B.concat $ [crlf, dd, boundary, crlf] ++ map (B.pack . show) hs ++ [crlf, c]
-
-crlf :: ByteString
-crlf = B.pack "\r\n"
-
-dd :: ByteString
-dd = B.pack "--"
+handlePackage transport verbosity uri auth path =
+  do resp <- putHttpFile transport uri path auth
+     case resp of
+       (200,_)     -> do notice verbosity "Ok"
+       (code,err)  -> do notice verbosity $ "Error: " ++ path ++ ": "
+                                     ++ show code ++ " "
+                                     ++ err
+
diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs
index 8f9ca52b49..4da0e0e823 100644
--- a/cabal-install/Main.hs
+++ b/cabal-install/Main.hs
@@ -75,6 +75,7 @@ import Distribution.Client.Check as Check     (check)
 --import Distribution.Client.Clean            (clean)
 import Distribution.Client.Upload as Upload   (upload, check, report)
 import Distribution.Client.Run                (run, splitRunArgs)
+import Distribution.Client.HttpUtils          (configureTransport)
 import Distribution.Client.SrcDist            (sdist)
 import Distribution.Client.Get                (get)
 import Distribution.Client.Sandbox            (sandboxInit
@@ -920,7 +921,8 @@ updateAction verbosityFlag extraArgs globalFlags = do
   (_useSandbox, config) <- loadConfigOrSandboxConfig verbosity
                            (globalFlags { globalRequireSandbox = Flag False })
   let globalFlags' = savedGlobalFlags config `mappend` globalFlags
-  update verbosity (globalRepos globalFlags')
+  transport <- configureTransport verbosity (flagToMaybe (globalHttpTransport globalFlags'))
+  update transport verbosity (globalRepos globalFlags')
 
 upgradeAction :: (ConfigFlags, ConfigExFlags, InstallFlags, HaddockFlags)
               -> [String] -> GlobalFlags -> IO ()
@@ -983,9 +985,11 @@ uploadAction uploadFlags extraArgs globalFlags = do
                         getProgramInvocationOutput verbosity
                         (simpleProgramInvocation xs xss)
        _             -> pure $ flagToMaybe $ uploadPassword uploadFlags'
+  transport <- configureTransport verbosity (flagToMaybe (globalHttpTransport globalFlags'))
   if fromFlag (uploadCheck uploadFlags')
-    then Upload.check  verbosity tarfiles
-    else upload verbosity
+    then Upload.check transport verbosity tarfiles
+    else upload transport
+                verbosity
                 (globalRepos globalFlags')
                 (flagToMaybe $ uploadUsername uploadFlags')
                 maybe_password
diff --git a/cabal-install/cabal-install.cabal b/cabal-install/cabal-install.cabal
index babfc0a52c..c42e1c1a31 100644
--- a/cabal-install/cabal-install.cabal
+++ b/cabal-install/cabal-install.cabal
@@ -135,7 +135,7 @@ executable cabal
         Cabal      >= 1.23     && < 1.24,
         containers >= 0.1      && < 0.6,
         filepath   >= 1.0      && < 1.5,
-        HTTP       >= 4000.2.5 && < 4000.3,
+        HTTP       >= 4000.1.5 && < 4000.3,
         mtl        >= 2.0      && < 3,
         pretty     >= 1        && < 1.2,
         random     >= 1        && < 1.2,
@@ -201,7 +201,7 @@ Test-Suite unit-tests
         time,
         HTTP,
         zlib,
-
+        random,
         tasty,
         tasty-hunit,
         tasty-quickcheck,
-- 
GitLab