Repository : ssh://darcs.haskell.org//srv/darcs/packages/Cabal On branch : master
http://hackage.haskell.org/trac/ghc/changeset/b8e9e9396d147971e708d4282688ddb8e1b5f8a1 >--------------------------------------------------------------- commit b8e9e9396d147971e708d4282688ddb8e1b5f8a1 Author: Duncan Coutts <[email protected]> Date: Mon Dec 17 23:46:49 2007 +0000 Get the saved hackage username and password from the config file rather than from the old ~/.cabal-upload/auth file. Now uses ~/.cabal/config with: hackage-username: hackage-password: >--------------------------------------------------------------- cabal-install/Hackage/Config.hs | 13 +++++++++++++ cabal-install/Hackage/Setup.hs | 6 ++---- cabal-install/Hackage/Types.hs | 8 +++++++- cabal-install/Hackage/Upload.hs | 35 +++++++++++------------------------ cabal-install/Main.hs | 7 +++---- 5 files changed, 36 insertions(+), 33 deletions(-) diff --git a/cabal-install/Hackage/Config.hs b/cabal-install/Hackage/Config.hs index c5f6220..efeeeaf 100644 --- a/cabal-install/Hackage/Config.hs +++ b/cabal-install/Hackage/Config.hs @@ -44,6 +44,7 @@ import Distribution.Simple.Configure (getInstalledPackages) import qualified Distribution.Simple.Configure as Configure (configCompiler) import Distribution.Simple.InstallDirs (InstallDirs(..), PathTemplate, toPathTemplate) import Distribution.Simple.Program (ProgramConfiguration, defaultProgramConfiguration) +import Distribution.Simple.Setup (toFlag, fromFlagOrDefault) import Distribution.Version (showVersion) import Distribution.Verbosity (Verbosity, normal) @@ -143,6 +144,8 @@ defaultConfigFlags = , configRepos = [Repo "hackage.haskell.org" "http://hackage.haskell.org/packages/archive";] , configVerbose = normal , configUserInstall = True + , configUploadUsername = mempty + , configUploadPassword = mempty } -- @@ -197,7 +200,17 @@ configWriteFieldDescrs = (text . show) (readS_to_P reads) configCacheDir (\d cfg -> cfg { configCacheDir = d }) , boolField "user-install" configUserInstall (\u cfg -> cfg { configUserInstall = u }) + , simpleField "hackage-username" + (text . show . fromFlagOrDefault "") + (fmap emptyToNothing $ readS_to_P reads) + configUploadUsername (\d cfg -> cfg { configUploadUsername = d }) + , simpleField "hackage-password" + (text . show . fromFlagOrDefault "") + (fmap emptyToNothing $ readS_to_P reads) + configUploadPassword (\d cfg -> cfg { configUploadPassword = d }) ] + where emptyToNothing "" = mempty + emptyToNothing f = toFlag f installDirDescrs :: [FieldDescr (InstallDirs (Maybe PathTemplate))] installDirDescrs = diff --git a/cabal-install/Hackage/Setup.hs b/cabal-install/Hackage/Setup.hs index 8a4a47b..ba123c9 100644 --- a/cabal-install/Hackage/Setup.hs +++ b/cabal-install/Hackage/Setup.hs @@ -45,7 +45,8 @@ import Distribution.Simple.Setup (Flag, toFlag, fromFlagOrDefault, flagToMaybe, flagToList) import Distribution.Verbosity (Verbosity, normal, flagToVerbosity, showForCabal) -import Hackage.Types (ConfigFlags(..), UnresolvedDependency(..)) +import Hackage.Types (ConfigFlags(..), UnresolvedDependency(..), + Username, Password) import Hackage.Utils (readPToMaybe, parseDependencyOrPackageId) import Control.Monad (MonadPlus(mplus)) @@ -152,9 +153,6 @@ infoCommand = CommandUI { -- * Upload flags -- ------------------------------------------------------------ -type Username = String -type Password = String - data UploadFlags = UploadFlags { uploadCheck :: Flag Bool, uploadUsername :: Flag Username, diff --git a/cabal-install/Hackage/Types.hs b/cabal-install/Hackage/Types.hs index 6d42c7a..eb5e8ed 100644 --- a/cabal-install/Hackage/Types.hs +++ b/cabal-install/Hackage/Types.hs @@ -14,6 +14,7 @@ module Hackage.Types where import Distribution.Simple.Compiler (CompilerFlavor) import Distribution.Simple.InstallDirs (InstallDirs, PathTemplate) +import Distribution.Simple.Setup (Flag) import Distribution.Package (PackageIdentifier) import Distribution.PackageDescription (GenericPackageDescription) import Distribution.Version (Dependency) @@ -37,10 +38,15 @@ data ConfigFlags = ConfigFlags { configCacheDir :: FilePath, configRepos :: [Repo], -- ^Available Hackage servers. configVerbose :: Verbosity, - configUserInstall :: Bool -- ^--user-install flag + configUserInstall :: Bool, -- ^--user-install flag + configUploadUsername :: Flag Username, + configUploadPassword :: Flag Password } deriving (Show) +type Username = String +type Password = String + data Repo = Repo { repoName :: String, repoURL :: String diff --git a/cabal-install/Hackage/Upload.hs b/cabal-install/Hackage/Upload.hs index 0b672cf..69b8113 100644 --- a/cabal-install/Hackage/Upload.hs +++ b/cabal-install/Hackage/Upload.hs @@ -4,6 +4,7 @@ module Hackage.Upload (upload) where import Hackage.Setup (UploadFlags(..)) +import Hackage.Types (ConfigFlags(..)) import Distribution.Simple.Utils (debug, notice) import Distribution.Simple.Setup (toFlag, fromFlag, flagToMaybe) @@ -14,13 +15,11 @@ import Network.HTTP (Header(..), HeaderName(..), Request(..), RequestMethod(..), Response(..)) import Network.URI (URI, parseURI) -import Control.Monad (MonadPlus(mplus)) +import Data.Monoid (Monoid(mappend)) import Data.Char (intToDigit) import Numeric (showHex) -import System.Directory (doesFileExist, getAppUserDataDirectory) import System.IO (hFlush, stdout) import System.Random (randomRIO) -import System.FilePath ((</>)) type Username = String type Password = String @@ -34,9 +33,9 @@ Just checkURI = parseURI "http://hackage.haskell.org/cgi-bin/hackage-scripts/che -upload :: UploadFlags -> [FilePath] -> IO () -upload flags paths = do - flags' <- if needsAuth flags then getAuth flags else return flags +upload :: ConfigFlags -> UploadFlags -> [FilePath] -> IO () +upload cfg flags paths = do + flags' <- if needsAuth flags then getAuth cfg flags else return flags mapM_ (handlePackage flags') paths handlePackage :: UploadFlags -> FilePath -> IO () @@ -74,13 +73,14 @@ setAuth uri user pwd = auPassword = pwd, auSite = uri } -getAuth :: UploadFlags -> IO UploadFlags -getAuth flags = - do (mu, mp) <- readAuthFile - u <- case flagToMaybe (uploadUsername flags) `mplus` mu of +getAuth :: ConfigFlags -> UploadFlags -> IO UploadFlags +getAuth cfg flags = + do u <- case flagToMaybe $ configUploadUsername cfg + `mappend` uploadUsername flags of Just u -> return u Nothing -> promptUsername - p <- case flagToMaybe (uploadPassword flags) `mplus` mp of + p <- case flagToMaybe $ configUploadPassword cfg + `mappend` uploadPassword flags of Just p -> return p Nothing -> promptPassword return $ flags { uploadUsername = toFlag u, @@ -98,19 +98,6 @@ promptPassword = hFlush stdout getLine -authFile :: IO FilePath -authFile = do dir <- getAppUserDataDirectory "cabal-upload" - return $ dir </> "auth" - -readAuthFile :: IO (Maybe Username, Maybe Password) -readAuthFile = - do file <- authFile - e <- doesFileExist file - if e then do s <- readFile file - let (u,p) = read s - return (Just u, Just p) - else return (Nothing, Nothing) - ignoreMsg :: String -> IO () ignoreMsg _ = return () diff --git a/cabal-install/Main.hs b/cabal-install/Main.hs index 0e04970..8eff900 100644 --- a/cabal-install/Main.hs +++ b/cabal-install/Main.hs @@ -172,9 +172,8 @@ fetchAction flags extraArgs = do uploadAction :: UploadFlags -> [String] -> IO () uploadAction flags extraArgs = do --- configFile <- defaultConfigFile --FIXME --- config0 <- loadConfig configFile --- let config = config0 { configVerbose = fromFlag $ uploadVerbosity flags } + configFile <- defaultConfigFile --FIXME + config <- loadConfig configFile -- FIXME: check that the .tar.gz files exist and report friendly error message if not let tarfiles = extraArgs - upload flags tarfiles + upload config flags tarfiles _______________________________________________ Cvs-libraries mailing list [email protected] http://www.haskell.org/mailman/listinfo/cvs-libraries
