Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch :
http://hackage.haskell.org/trac/ghc/changeset/8839045d97aadcb8bb40420b00b1a3c0c7483d45 >--------------------------------------------------------------- commit 8839045d97aadcb8bb40420b00b1a3c0c7483d45 Author: Duncan Coutts <[email protected]> Date: Tue Dec 22 09:51:52 2009 +0000 Move downloadURI to HttpUtils module And use exceptions rather than return codes. >--------------------------------------------------------------- cabal-install/Distribution/Client/Fetch.hs | 50 ++++-------------------- cabal-install/Distribution/Client/HttpUtils.hs | 44 +++++++++++++++++++-- 2 files changed, 48 insertions(+), 46 deletions(-) diff --git a/cabal-install/Distribution/Client/Fetch.hs b/cabal-install/Distribution/Client/Fetch.hs index 084250d..9239aee 100644 --- a/cabal-install/Distribution/Client/Fetch.hs +++ b/cabal-install/Distribution/Client/Fetch.hs @@ -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 diff --git a/cabal-install/Distribution/Client/HttpUtils.hs b/cabal-install/Distribution/Client/HttpUtils.hs index 7d1d2ff..81f6d12 100644 --- a/cabal-install/Distribution/Client/HttpUtils.hs +++ b/cabal-install/Distribution/Client/HttpUtils.hs @@ -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 _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
