Merge pull request #6515 from commercialhaskell/fix5290

Fix #5290 Add `--[no-]save-hackage-creds` to `stack upload`

ChangeLog.md

@@ -34,6 +34,8 @@ Other enhancements:
   documentation for executables, test suites and benchmarks. Due to a bug in
   Cabal (the library), Stack will ignore the flags with a warning for GHC
   versions before 9.4.
+* Add flag `--[no-]save-hackage-creds` to Stack's `upload` command, which takes
+  precedence over the existing `save-hackage-creds` configuration option.
 
 Bug fixes:
 

doc/upload_command.md

@@ -5,19 +5,22 @@
 ~~~text
 stack upload [ITEM] [-d|--documentation] [--pvp-bounds PVP-BOUNDS]
              [--ignore-check] [--[no-]test-tarball] [--tar-dir ARG]
-             [--candidate] [--setup-info-yaml URL]
+             [--candidate] [--[no-]save-hackage-creds] [--setup-info-yaml URL]
              [--snapshot-location-base URL]
 ~~~
 
 By default:
 
 * the command uploads one or more packages. Pass the flag `--documentation`
-  (`-d` for short) to upload documentation for one or more packages; and
+  (`-d` for short) to upload documentation for one or more packages;
 
 * the upload is a package to be published or documentation for a published
   package. Pass the flag `--candidate` to upload a
   [package candidate](http://hackage.haskell.org/upload#candidates) or
-  documentation for a package candidate.
+  documentation for a package candidate; and
+
+* the command prompts to save the user's Hackage username and password in a
+  local file. Pass the flag `--no-save-hackage-creds` to avoid the prompt.
 
 At least one `ITEM` must be specified. For example, if the current working
 directory is a package directory:

doc/yaml_configuration.md

@@ -1544,6 +1544,9 @@ to be used for this project. Example: `require-stack-version: "== 0.1.*"`
 
 Default: `true`
 
+Command line equivalent (takes precedence):
+[`stack upload --[no]-save-hackage-creds`](upload_command.md) option
+
 Controls whether, when using `stack upload`, the user's Hackage username and
 password are stored in a local file.
 

package.yaml

@@ -339,6 +339,7 @@ library:
   - Stack.Types.Storage
   - Stack.Types.TemplateName
   - Stack.Types.UnusedFlags
+  - Stack.Types.UploadOpts
   - Stack.Types.Version
   - Stack.Types.VersionedDownloadInfo
   - Stack.Uninstall

src/Stack/Config.hs

@@ -446,8 +446,7 @@ configFromConfigMonoid
       resolve configMonoid.defaultInitSnapshot
     let defaultTemplate = getFirst configMonoid.defaultTemplate
         dumpLogs = fromFirst DumpWarningLogs configMonoid.dumpLogs
-        saveHackageCreds =
-          fromFirst True configMonoid.saveHackageCreds
+        saveHackageCreds = configMonoid.saveHackageCreds
         hackageBaseUrl =
           fromFirst Constants.hackageBaseUrl configMonoid.hackageBaseUrl
         hideSourcePaths = fromFirstTrue configMonoid.hideSourcePaths

src/Stack/Options/UploadParser.hs

@@ -11,7 +11,8 @@ import           Options.Applicative
                    , metavar, option, readerError, short, strArgument, strOption
                    , switch
                    )
-import           Options.Applicative.Builder.Extra ( boolFlags, dirCompleter )
+import           Options.Applicative.Builder.Extra
+                   ( boolFlags, dirCompleter, firstBoolFlagsTrue )
 import           Options.Applicative.Types ( readerAsk )
 import           Stack.Prelude
 import           Stack.Upload ( UploadOpts (..), UploadVariant (..) )
@@ -27,6 +28,7 @@ uploadOptsParser = UploadOpts
   <*> buildPackageOption
   <*> tarDirParser
   <*> uploadVariantParser
+  <*> saveHackageCredsOption
  where
   itemsToWorkWithParser = many (strArgument
     (  metavar "ITEM"
@@ -70,3 +72,7 @@ uploadOptsParser = UploadOpts
     (  long "candidate"
     <> help "Upload as, or for, a package candidate."
     )
+  saveHackageCredsOption = firstBoolFlagsTrue
+      "save-hackage-creds"
+      "saving user's Hackage username and password in a local file."
+      idm

src/Stack/Types/Config.hs

@@ -172,7 +172,7 @@ data Config = Config
   , allowLocals            :: !Bool
     -- ^ Are we allowed to build local packages? The script
     -- command disallows this.
-  , saveHackageCreds       :: !Bool
+  , saveHackageCreds       :: !FirstTrue
     -- ^ Should we save Hackage credentials to a file?
   , hackageBaseUrl         :: !Text
     -- ^ Hackage base URL used when uploading packages

src/Stack/Types/ConfigMonoid.hs

@@ -166,7 +166,7 @@ data ConfigMonoid = ConfigMonoid
    -- installation.
   , dumpLogs           :: !(First DumpLogs)
     -- ^ See 'configDumpLogs'
-  , saveHackageCreds   :: !(First Bool)
+  , saveHackageCreds   :: !FirstTrue
     -- ^ See 'configSaveHackageCreds'
   , hackageBaseUrl     :: !(First Text)
     -- ^ See 'configHackageBaseUrl'
@@ -316,7 +316,7 @@ parseConfigMonoidObject rootDir obj = do
   defaultTemplate <- First <$> obj ..:? configMonoidDefaultTemplateName
   allowDifferentUser <- First <$> obj ..:? configMonoidAllowDifferentUserName
   dumpLogs <- First <$> obj ..:? configMonoidDumpLogsName
-  saveHackageCreds <- First <$> obj ..:? configMonoidSaveHackageCredsName
+  saveHackageCreds <- FirstTrue <$> obj ..:? configMonoidSaveHackageCredsName
   hackageBaseUrl <- First <$> obj ..:? configMonoidHackageBaseUrlName
   configMonoidColorWhenUS <- obj ..:? configMonoidColorWhenUSName
   configMonoidColorWhenGB <- obj ..:? configMonoidColorWhenGBName

src/Stack/Types/UploadOpts.hs

@@ -0,0 +1,33 @@
+{-# LANGUAGE NoImplicitPrelude #-}
+{-# LANGUAGE NoFieldSelectors  #-}
+
+-- | Types for command line options for the @stack upload@ command.
+module Stack.Types.UploadOpts
+  ( UploadOpts (..)
+  , UploadVariant (..)
+  ) where
+
+import           Stack.Prelude
+import           Stack.Types.PvpBounds (PvpBounds)
+
+-- | Type representing command line options for the @stack upload@ command.
+data UploadOpts = UploadOpts
+  { itemsToWorkWith :: ![String]
+    -- ^ The items to work with.
+  , documentation :: !Bool
+    -- ^ Uploading documentation for packages?
+  , pvpBounds :: !(Maybe PvpBounds)
+  , check :: !Bool
+  , buildPackage :: !Bool
+  , tarPath :: !(Maybe FilePath)
+  , uploadVariant :: !UploadVariant
+  , saveHackageCreds :: !FirstTrue
+    -- ^ Save user's Hackage username and password in a local file?
+  }
+
+-- | Type representing variants for uploading to Hackage.
+data UploadVariant
+  = Publishing
+    -- ^ Publish the package/a published package.
+  | Candidate
+    -- ^ Create a package candidate/a package candidate.

src/Stack/Upload.hs

@@ -56,10 +56,11 @@ import           Stack.SDist
                    , getSDistTarball, readLocalPackage
                    )
 import           Stack.Types.Config ( Config (..), configL, stackRootL )
+import qualified Stack.Types.Config as Config
 import           Stack.Types.EnvConfig ( HasEnvConfig )
 import           Stack.Types.Package ( LocalPackage (..), packageIdentifier )
-import           Stack.Types.PvpBounds (PvpBounds)
 import           Stack.Types.Runner ( Runner )
+import           Stack.Types.UploadOpts ( UploadOpts (..), UploadVariant (..) )
 import           System.Directory
                    ( createDirectoryIfMissing, doesDirectoryExist, doesFileExist
                    , removeFile, renameFile
@@ -159,94 +160,78 @@ data UploadContent
   | DocArchive
     -- ^ Content in the form of an archive file of package documentation.
 
--- | Type representing variants for uploading to Hackage.
-data UploadVariant
-  = Publishing
-    -- ^ Publish the package/a published package.
-  | Candidate
-    -- ^ Create a package candidate/a package candidate.
-
--- | Type representing command line options for the @stack upload@ command.
-data UploadOpts = UploadOpts
-  { itemsToWorkWith :: ![String]
-    -- ^ The items to work with.
-  , documentation :: !Bool
-    -- ^ Uploading documentation for packages?
-  , pvpBounds :: !(Maybe PvpBounds)
-  , check :: !Bool
-  , buildPackage :: !Bool
-  , tarPath :: !(Maybe FilePath)
-  , uploadVariant :: !UploadVariant
-  }
-
 -- | Function underlying the @stack upload@ command. Upload to Hackage.
 uploadCmd :: UploadOpts -> RIO Runner ()
-uploadCmd (UploadOpts [] uoDocumentation _ _ _ _ _) = do
+uploadCmd (UploadOpts [] uoDocumentation _ _ _ _ _ _) = do
   let subject = if uoDocumentation
         then "documentation for the current package,"
         else "the current package,"
   prettyThrowIO $ NoItemSpecified subject
-uploadCmd uo = withConfig YesReexec $ withDefaultEnvConfig $ do
-  config <- view configL
-  let hackageUrl = T.unpack config.hackageBaseUrl
-  if uo.documentation
-    then do
-      (dirs, invalid) <-
-        liftIO $ partitionM doesDirectoryExist uo.itemsToWorkWith
-      unless (null invalid) $
-        prettyThrowIO $ PackageDirectoryInvalid invalid
-      (failed, items) <- partitionEithers <$> forM dirs checkDocsTarball
-      unless (null failed) $ do
-        prettyThrowIO $ DocsTarballInvalid failed
-      getCreds <- memoizeRef $ loadAuth config
-      forM_ items $ \(pkgIdName, tarGzFile) -> do
-        creds <- runMemoized getCreds
-        upload
-          hackageUrl
-          creds
-          DocArchive
-          (Just pkgIdName)
-          (toFilePath tarGzFile)
-          uo.uploadVariant
-    else do
-      (files, nonFiles) <-
-        liftIO $ partitionM doesFileExist uo.itemsToWorkWith
-      (dirs, invalid) <- liftIO $ partitionM doesDirectoryExist nonFiles
-      unless (null invalid) $ do
-        prettyThrowIO $ ItemsInvalid invalid
-      let sdistOpts = SDistOpts
-            uo.itemsToWorkWith
-            uo.pvpBounds
-            uo.check
-            uo.buildPackage
-            uo.tarPath
-      getCreds <- memoizeRef $ loadAuth config
-      mapM_ (resolveFile' >=> checkSDistTarball sdistOpts) files
-      forM_ files $ \file -> do
-        tarFile <- resolveFile' file
-        creds <- runMemoized getCreds
-        upload
-          hackageUrl
-          creds
-          SDist
-          Nothing
-          (toFilePath tarFile)
-          uo.uploadVariant
-      forM_ dirs $ \dir -> do
-        pkgDir <- resolveDir' dir
-        (tarName, tarBytes, mcabalRevision) <-
-          getSDistTarball uo.pvpBounds pkgDir
-        checkSDistTarball' sdistOpts tarName tarBytes
-        creds <- runMemoized getCreds
-        uploadBytes
-          hackageUrl
-          creds
-          SDist
-          Nothing
-          tarName
-          uo.uploadVariant
-          tarBytes
-        forM_ mcabalRevision $ uncurry $ uploadRevision hackageUrl creds
+uploadCmd uo = do
+  let setSaveHackageCreds config =
+        let saveHackageCreds = config.saveHackageCreds <> uo.saveHackageCreds
+        in config { Config.saveHackageCreds = saveHackageCreds }
+  withConfig YesReexec $ local setSaveHackageCreds $ withDefaultEnvConfig $ do
+    config <- view configL
+    let hackageUrl = T.unpack config.hackageBaseUrl
+    if uo.documentation
+      then do
+        (dirs, invalid) <-
+          liftIO $ partitionM doesDirectoryExist uo.itemsToWorkWith
+        unless (null invalid) $
+          prettyThrowIO $ PackageDirectoryInvalid invalid
+        (failed, items) <- partitionEithers <$> forM dirs checkDocsTarball
+        unless (null failed) $ do
+          prettyThrowIO $ DocsTarballInvalid failed
+        getCreds <- memoizeRef $ loadAuth config
+        forM_ items $ \(pkgIdName, tarGzFile) -> do
+          creds <- runMemoized getCreds
+          upload
+            hackageUrl
+            creds
+            DocArchive
+            (Just pkgIdName)
+            (toFilePath tarGzFile)
+            uo.uploadVariant
+      else do
+        (files, nonFiles) <-
+          liftIO $ partitionM doesFileExist uo.itemsToWorkWith
+        (dirs, invalid) <- liftIO $ partitionM doesDirectoryExist nonFiles
+        unless (null invalid) $ do
+          prettyThrowIO $ ItemsInvalid invalid
+        let sdistOpts = SDistOpts
+              uo.itemsToWorkWith
+              uo.pvpBounds
+              uo.check
+              uo.buildPackage
+              uo.tarPath
+        getCreds <- memoizeRef $ loadAuth config
+        mapM_ (resolveFile' >=> checkSDistTarball sdistOpts) files
+        forM_ files $ \file -> do
+          tarFile <- resolveFile' file
+          creds <- runMemoized getCreds
+          upload
+            hackageUrl
+            creds
+            SDist
+            Nothing
+            (toFilePath tarFile)
+            uo.uploadVariant
+        forM_ dirs $ \dir -> do
+          pkgDir <- resolveDir' dir
+          (tarName, tarBytes, mcabalRevision) <-
+            getSDistTarball uo.pvpBounds pkgDir
+          checkSDistTarball' sdistOpts tarName tarBytes
+          creds <- runMemoized getCreds
+          uploadBytes
+            hackageUrl
+            creds
+            SDist
+            Nothing
+            tarName
+            uo.uploadVariant
+            tarBytes
+          forM_ mcabalRevision $ uncurry $ uploadRevision hackageUrl creds
    where
     checkDocsTarball ::
          HasEnvConfig env
@@ -336,7 +321,7 @@ loadUserAndPassword config = do
       -- didn't do this
       writeFilePrivate fp $ lazyByteString lbs
 
-      unless config.saveHackageCreds $ do
+      unless (fromFirstTrue config.saveHackageCreds) $ do
         prettyWarnL
           [ flow "You've set"
           , style Shell "save-hackage-creds"
@@ -357,7 +342,7 @@ loadUserAndPassword config = do
           , credsFile = fp
           }
 
-    when config.saveHackageCreds $ do
+    when (fromFirstTrue config.saveHackageCreds) $ do
       shouldSave <- promptBool $ T.pack $
         "Save Hackage credentials to file at " ++ fp ++ " [y/n]? "
       prettyNoteL

stack.cabal

@@ -333,6 +333,7 @@ library
       Stack.Types.Storage
       Stack.Types.TemplateName
       Stack.Types.UnusedFlags
+      Stack.Types.UploadOpts
       Stack.Types.Version
       Stack.Types.VersionedDownloadInfo
       Stack.Uninstall