[commit: Cabal] master: Get the saved hackage username and password from the config file (b8e9e93)
Ian Lynagh
igloo at earth.li
Fri Jun 24 01:48:49 CEST 2011
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 <duncan at haskell.org>
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
More information about the Cvs-libraries
mailing list