[commit: Cabal] master: Don't echo when prompting for the hackage upload password. (b304416)

[Paolo Capriotti]

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

On branch  : master

http://hackage.haskell.org/trac/ghc/changeset/b304416fe777c511ea72ab6577a58c445f34d143

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

commit b304416fe777c511ea72ab6577a58c445f34d143
Author: Duncan Coutts <duncan at haskell.org>
Date:   Thu May 1 21:44:56 2008 +0000

    Don't echo when prompting for the hackage upload password.
    Fixes ticket #268. And use newtypes for the username and password,
    just to be more sure we're not mixing them up with other strings.

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

 cabal-install/Hackage/Config.hs |   12 ++++++------
 cabal-install/Hackage/Setup.hs  |   11 +++++++----
 cabal-install/Hackage/Types.hs  |    4 ++--
 cabal-install/Hackage/Upload.hs |   29 +++++++++++++++++++++--------
 4 files changed, 36 insertions(+), 20 deletions(-)

diff --git a/cabal-install/Hackage/Config.hs b/cabal-install/Hackage/Config.hs
index 43f72c6..9c10397 100644
--- a/cabal-install/Hackage/Config.hs
+++ b/cabal-install/Hackage/Config.hs
@@ -46,7 +46,8 @@ import qualified Distribution.Simple.Setup as ConfigFlags
 import qualified Distribution.Simple.Setup as Cabal
 import Distribution.Verbosity (Verbosity, normal)
 
-import Hackage.Types (RemoteRepo(..), Repo(..), Username, Password)
+import Hackage.Types
+         ( RemoteRepo(..), Repo(..), Username(..), Password(..) )
 import Hackage.ParseUtils
 import Hackage.Utils (readFileIfExists)
 import Distribution.Simple.Utils (notice, warn)
@@ -73,7 +74,6 @@ data SavedConfig = SavedConfig {
     configGlobalInstallDirs :: InstallDirs (Flag PathTemplate),
     configFlags             :: ConfigFlags
   }
-  deriving (Show)
 
 configUserInstall     :: SavedConfig -> Flag Bool
 configUserInstall     =  ConfigFlags.configUserInstall . configFlags
@@ -200,12 +200,12 @@ configCabalInstallFieldDescrs =
                 (fmap emptyToNothing parseFilePathQ)
                 configCacheDir    (\d cfg -> cfg { configCacheDir = d })
     , simpleField "hackage-username"
-                (text . show . fromFlagOrDefault "")
-                (fmap emptyToNothing parseTokenQ)
+                (text . show . fromFlagOrDefault "" . fmap unUsername)
+                (fmap (fmap Username . emptyToNothing) parseTokenQ)
                 configUploadUsername    (\d cfg -> cfg { configUploadUsername = d })
     , simpleField "hackage-password"
-                (text . show . fromFlagOrDefault "")
-                (fmap emptyToNothing parseTokenQ)
+                (text . show . fromFlagOrDefault "" . fmap unPassword)
+                (fmap (fmap Password . emptyToNothing) parseTokenQ)
                 configUploadPassword    (\d cfg -> cfg { configUploadPassword = d })
     ]
     where emptyToNothing "" = mempty
diff --git a/cabal-install/Hackage/Setup.hs b/cabal-install/Hackage/Setup.hs
index 94e3bf1..4deb5d9 100644
--- a/cabal-install/Hackage/Setup.hs
+++ b/cabal-install/Hackage/Setup.hs
@@ -51,7 +51,8 @@ import Distribution.ReadE
          ( readP_to_E )
 import Distribution.Verbosity (Verbosity, normal)
 
-import Hackage.Types (UnresolvedDependency(..), Username, Password)
+import Hackage.Types
+         ( UnresolvedDependency(..), Username(..), Password(..) )
 import Hackage.ParseUtils (readPToMaybe, parseDependencyOrPackageId)
 
 import Data.Monoid (Monoid(..))
@@ -275,7 +276,7 @@ data UploadFlags = UploadFlags {
     uploadUsername  :: Flag Username,
     uploadPassword  :: Flag Password,
     uploadVerbosity :: Flag Verbosity
-  } deriving (Show)
+  }
 
 defaultUploadFlags :: UploadFlags
 defaultUploadFlags = UploadFlags {
@@ -307,12 +308,14 @@ uploadCommand = CommandUI {
       ,option ['u'] ["username"]
         "Hackage username."
         uploadUsername (\v flags -> flags { uploadUsername = v })
-        (reqArg' "USERNAME" toFlag flagToList)
+        (reqArg' "USERNAME" (toFlag . Username)
+                            (flagToList . fmap unUsername))
 
       ,option ['p'] ["password"]
         "Hackage password."
         uploadPassword (\v flags -> flags { uploadPassword = v })
-        (reqArg' "PASSWORD" toFlag flagToList)
+        (reqArg' "PASSWORD" (toFlag . Password)
+                            (flagToList . fmap unPassword))
       ]
   }
 
diff --git a/cabal-install/Hackage/Types.hs b/cabal-install/Hackage/Types.hs
index cb9966b..672b40c 100644
--- a/cabal-install/Hackage/Types.hs
+++ b/cabal-install/Hackage/Types.hs
@@ -17,8 +17,8 @@ import Distribution.Package
 import Distribution.PackageDescription
          ( GenericPackageDescription, FlagAssignment )
 
-type Username = String
-type Password = String
+newtype Username = Username { unUsername :: String }
+newtype Password = Password { unPassword :: String }
 
 -- | We re-use @GenericPackageDescription@ and use the @package-url@
 -- field to store the tarball URL.
diff --git a/cabal-install/Hackage/Upload.hs b/cabal-install/Hackage/Upload.hs
index 0b74850..2649b8e 100644
--- a/cabal-install/Hackage/Upload.hs
+++ b/cabal-install/Hackage/Upload.hs
@@ -3,7 +3,7 @@
 
 module Hackage.Upload (check, upload) where
 
-import Hackage.Types (Username, Password)
+import Hackage.Types (Username(..), Password(..))
 import Hackage.HttpUtils (proxy)
 
 import Distribution.Simple.Utils (debug, notice, warn)
@@ -18,7 +18,9 @@ import Network.URI (URI, parseURI)
 
 import Data.Char        (intToDigit)
 import Numeric          (showHex)
-import System.IO        (hFlush, stdout, openBinaryFile, IOMode(ReadMode), hGetContents)
+import System.IO        (hFlush, stdin, stdout, hGetEcho, hSetEcho
+                        ,openBinaryFile, IOMode(ReadMode), hGetContents)
+import Control.Exception (bracket)
 import System.Random    (randomRIO)
 
 
@@ -35,8 +37,8 @@ Just checkURI = parseURI "http://hackage.haskell.org/cgi-bin/hackage-scripts/che
 upload :: Verbosity -> Maybe Username -> Maybe Password -> [FilePath] -> IO ()
 upload verbosity mUsername mPassword paths = do
 
-          username <- maybe (prompt "username") return mUsername
-          password <- maybe (prompt "password") return mPassword
+          Username username <- maybe promptUsername return mUsername
+          Password password <- maybe promptPassword return mPassword
           let auth = addAuthority AuthBasic {
                        auRealm    = "Hackage",
                        auUsername = username,
@@ -48,10 +50,21 @@ upload verbosity mUsername mPassword paths = do
             notice verbosity $ "Uploading " ++ path ++ "... "
             handlePackage verbosity uploadURI auth path
 
-  where prompt thing = do
-          putStr ("Hackage " ++ thing ++ ": ")
-          hFlush stdout
-          getLine
+  where
+    promptUsername :: IO Username
+    promptUsername = do
+      putStr "Hackage username: "
+      hFlush stdout
+      fmap Username getLine
+
+    promptPassword :: IO Password
+    promptPassword = do
+      putStr "Hackage password: "
+      hFlush stdout
+      -- save/restore the terminal echoing status
+      bracket (hGetEcho stdin) (hSetEcho stdin) $ \_ -> do
+        hSetEcho stdin False  -- no echoing for entering the password
+        fmap Password getLine
 
 check :: Verbosity -> [FilePath] -> IO ()
 check verbosity paths = do