Commit b304416f authored by Duncan Coutts's avatar Duncan Coutts

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.
parent bbd4fca1
......@@ -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
......
......@@ -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))
]
}
......
......@@ -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.
......
......@@ -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
......
Markdown is supported
0% or .
You are about to add 0 people to the discussion. Proceed with caution.
Finish editing this message first!
Please register or to comment