[commit: Cabal] : Move downloadURI to HttpUtils module (8839045)

[Ian Lynagh]

Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal

On branch  : 

http://hackage.haskell.org/trac/ghc/changeset/8839045d97aadcb8bb40420b00b1a3c0c7483d45

>---------------------------------------------------------------

commit 8839045d97aadcb8bb40420b00b1a3c0c7483d45
Author: Duncan Coutts <duncan at haskell.org>
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 at 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