Commit 204a2cfb authored by Duncan Coutts's avatar Duncan Coutts
Browse files

Move downloadURI to HttpUtils module

And use exceptions rather than return codes.
parent b6b0e973
......@@ -36,7 +36,8 @@ import Distribution.Client.IndexUtils as IndexUtils
( getAvailablePackages, disambiguateDependencies
, getInstalledPackages )
import qualified Distribution.Client.InstallPlan as InstallPlan
import Distribution.Client.HttpUtils (getHTTP, isOldHackageURI)
import Distribution.Client.HttpUtils
( downloadURI, isOldHackageURI )
import Distribution.Package
( PackageIdentifier, packageName, packageVersion, Dependency(..) )
......@@ -46,8 +47,7 @@ import Distribution.Simple.Compiler
import Distribution.Simple.Program
( ProgramConfiguration )
import Distribution.Simple.Utils
( die, notice, info, debug, setupMessage
, copyFileVerbose, writeFileAtomic )
( die, notice, info, debug, setupMessage )
import Distribution.System
( buildPlatform )
import Distribution.Text
......@@ -56,7 +56,6 @@ import Distribution.Verbosity
( Verbosity )
import qualified Data.Map as Map
import qualified Data.ByteString.Lazy.Char8 as BS
import Control.Monad
( when, filterM )
import System.Directory
......@@ -66,36 +65,8 @@ import System.FilePath
import qualified System.FilePath.Posix as FilePath.Posix
( combine, joinPath )
import Network.URI
( URI(uriPath, uriScheme) )
import Network.HTTP
( Response(..) )
import Network.Stream
( ConnError(..) )
downloadURI :: Verbosity
-> FilePath -- ^ Where to put it
-> URI -- ^ What to download
-> IO (Maybe ConnError)
downloadURI verbosity path uri | uriScheme uri == "file:" = do
copyFileVerbose verbosity (uriPath uri) path
return Nothing
downloadURI verbosity path uri = do
eitherResult <- getHTTP verbosity uri
case eitherResult of
Left err -> return (Just err)
Right rsp
| rspCode rsp == (2,0,0)
-> do info verbosity ("Downloaded to " ++ path)
writeFileAtomic path (BS.unpack $ rspBody rsp)
--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.
-- remember the ETag so we can not re-download if nothing changed.
>> return Nothing
| otherwise
-> return (Just (ErrorMisc ("Unsucessful HTTP code: " ++ show (rspCode rsp))))
( URI(uriPath) )
-- Downloads a package to [config-dir/packages/package-id] and returns the path to the package.
downloadPackage :: Verbosity -> Repo -> PackageIdentifier -> IO String
......@@ -108,11 +79,8 @@ downloadPackage verbosity repo@Repo{ repoKind = Left remoteRepo } pkgid = do
path = packageFile repo pkgid
debug verbosity $ "GET " ++ show uri
createDirectoryIfMissing True dir
status <- downloadURI verbosity path uri
case status of
Just err -> die $ "Failed to download '" ++ display pkgid
++ "': " ++ show err
Nothing -> return path
downloadURI verbosity uri path
return path
-- Downloads an index file to [config-dir/packages/serv-id].
downloadIndex :: Verbosity -> RemoteRepo -> FilePath -> IO FilePath
......@@ -123,10 +91,8 @@ downloadIndex verbosity repo cacheDir = do
}
path = cacheDir </> "00-index" <.> "tar.gz"
createDirectoryIfMissing True cacheDir
mbError <- downloadURI verbosity path uri
case mbError of
Just err -> die $ "Failed to download index '" ++ show err ++ "'"
Nothing -> return path
downloadURI verbosity uri path
return path
-- |Returns @True@ if the package has already been fetched.
isFetched :: AvailablePackage -> IO Bool
......
......@@ -2,20 +2,26 @@
-----------------------------------------------------------------------------
-- | Separate module for HTTP actions, using a proxy server if one exists
-----------------------------------------------------------------------------
module Distribution.Client.HttpUtils (getHTTP, proxy, isOldHackageURI) where
module Distribution.Client.HttpUtils (
downloadURI,
getHTTP,
proxy,
isOldHackageURI
) where
import Network.HTTP
( Request (..), Response (..), RequestMethod (..)
, Header(..), HeaderName(..) )
import Network.URI
( URI (..), URIAuth (..), parseAbsoluteURI )
import Network.Stream (Result)
import Network.Stream
( Result, ConnError(..) )
import Network.Browser
( Proxy (..), Authority (..), browse
, setOutHandler, setErrHandler, setProxy, request)
import Control.Monad
( mplus, join, liftM2 )
import qualified Data.ByteString.Lazy as ByteString
import qualified Data.ByteString.Lazy.Char8 as ByteString
import Data.ByteString.Lazy (ByteString)
#ifdef WIN32
import System.Win32.Types
......@@ -34,7 +40,9 @@ import System.Environment (getEnvironment)
import qualified Paths_cabal_install (version)
import Distribution.Verbosity (Verbosity)
import Distribution.Simple.Utils (warn, debug)
import Distribution.Simple.Utils
( die, info, warn, debug
, copyFileVerbose, writeFileAtomic )
import Distribution.Text
( display )
import qualified System.FilePath.Posix as FilePath.Posix
......@@ -92,6 +100,7 @@ proxy verbosity = do
warn verbosity $ "ignoring http proxy, trying a direct connection"
return NoProxy
Just p -> return p
--TODO: print info message when we're using a proxy
-- | We need to be able to parse non-URIs like @\"wwwcache.example.com:80\"@
-- which lack the @\"http://\"@ URI scheme. The problem is that
......@@ -152,6 +161,33 @@ getHTTP verbosity uri = do
request req
return (Right resp)
downloadURI :: Verbosity
-> URI -- ^ What to download
-> FilePath -- ^ Where to put it
-> IO ()
downloadURI verbosity uri path | uriScheme uri == "file:" =
copyFileVerbose verbosity (uriPath uri) path
downloadURI verbosity uri path = do
result <- getHTTP verbosity uri
let result' = case result of
Left err -> Left err
Right rsp -> case rspCode rsp of
(2,0,0) -> Right (rspBody rsp)
(a,b,c) -> Left err
where
err = ErrorMisc $ "Unsucessful HTTP code: "
++ concatMap show [a,b,c]
case result' of
Left err -> die $ "Failed to download " ++ show uri ++ " : " ++ show err
Right body -> do
info verbosity ("Downloaded to " ++ path)
writeFileAtomic path (ByteString.unpack body)
--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.
-- remember the ETag so we can not re-download if nothing changed.
-- Utility function for legacy support.
isOldHackageURI :: URI -> Bool
isOldHackageURI uri
......
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