stack 2.7.3 → 2.7.5
raw patch · 18 files changed
+274/−103 lines, 18 filesdep −regex-applicative-textdep ~aesondep ~pantrydep ~rio
Dependencies removed: regex-applicative-text
Dependency ranges changed: aeson, pantry, rio
Files
- ChangeLog.md +30/−2
- LICENSE +1/−1
- doc/ChangeLog.md +30/−2
- doc/GUIDE.md +7/−1
- doc/nix_integration.md +1/−1
- doc/yaml_configuration.md +1/−1
- src/Stack/Build/Cache.hs +25/−0
- src/Stack/Build/Execute.hs +8/−4
- src/Stack/Config.hs +9/−0
- src/Stack/Constants/Config.hs +10/−0
- src/Stack/Ghci.hs +2/−1
- src/Stack/Setup.hs +3/−8
- src/Stack/Upload.hs +101/−53
- src/main/Main.hs +6/−8
- src/test/Stack/UploadSpec.hs +12/−0
- stack.cabal +14/−17
- stack.yaml +5/−0
- test/integration/lib/StackTest.hs +9/−4
ChangeLog.md view
@@ -1,6 +1,34 @@ # Changelog +## v2.7.5++**Changes since v2.7.3:**++Behavior changes:++* Cloning git repositories isn't per sub-directory anymore, see+ [#5411](https://github.com/commercialhaskell/stack/issues/5411)++Other enhancements:++* `stack setup` supports installing GHC for macOS aarch64 (M1)++* `stack upload` supports authentication with a Hackage API key (via+ `HACKAGE_KEY` environment variable).++Bug fixes:++* Ensure that `extra-path` works for case-insensitive `PATH`s on Windows.+ See [rio#237](https://github.com/commercialhaskell/rio/pull/237)+* Fix handling of overwritten `ghc` and `ghc-pkg` locations.+ [#5597](https://github.com/commercialhaskell/stack/pull/5597)+* Fix failure to find package when a dependency is shared between projects.+ [#5680](https://github.com/commercialhaskell/stack/issues/5680)+* `stack ghci` now uses package flags in `stack.yaml`+ [#5434](https://github.com/commercialhaskell/stack/issues/5434)++ ## v2.7.3 **Changes since v2.7.1:**@@ -30,8 +58,8 @@ * `stack setup` will look in sandboxed directories for executables, not relying on `findExecutables. See [GHC issue 20074](https://gitlab.haskell.org/ghc/ghc/-/issues/20074)-* Track changes to `setup-config` properly to avoid reconfiguring on every- change. See [#5578](https://github.com/commercialhaskell/stack/issues/5578)+* Track changes to `setup-config` properly to avoid reconfiguring on every change.+ See [#5578](https://github.com/commercialhaskell/stack/issues/5578) ## v2.7.1
LICENSE view
@@ -1,4 +1,4 @@-Copyright (c) 2015-2021, Stack contributors+Copyright (c) 2015-2022, Stack contributors All rights reserved. Redistribution and use in source and binary forms, with or without
doc/ChangeLog.md view
@@ -1,6 +1,34 @@ # Changelog +## v2.7.5++**Changes since v2.7.3:**++Behavior changes:++* Cloning git repositories isn't per sub-directory anymore, see+ [#5411](https://github.com/commercialhaskell/stack/issues/5411)++Other enhancements:++* `stack setup` supports installing GHC for macOS aarch64 (M1)++* `stack upload` supports authentication with a Hackage API key (via+ `HACKAGE_KEY` environment variable).++Bug fixes:++* Ensure that `extra-path` works for case-insensitive `PATH`s on Windows.+ See [rio#237](https://github.com/commercialhaskell/rio/pull/237)+* Fix handling of overwritten `ghc` and `ghc-pkg` locations.+ [#5597](https://github.com/commercialhaskell/stack/pull/5597)+* Fix failure to find package when a dependency is shared between projects.+ [#5680](https://github.com/commercialhaskell/stack/issues/5680)+* `stack ghci` now uses package flags in `stack.yaml`+ [#5434](https://github.com/commercialhaskell/stack/issues/5434)++ ## v2.7.3 **Changes since v2.7.1:**@@ -30,8 +58,8 @@ * `stack setup` will look in sandboxed directories for executables, not relying on `findExecutables. See [GHC issue 20074](https://gitlab.haskell.org/ghc/ghc/-/issues/20074)-* Track changes to `setup-config` properly to avoid reconfiguring on every- change. See [#5578](https://github.com/commercialhaskell/stack/issues/5578)+* Track changes to `setup-config` properly to avoid reconfiguring on every change.+ See [#5578](https://github.com/commercialhaskell/stack/issues/5578) ## v2.7.1
doc/GUIDE.md view
@@ -1668,6 +1668,12 @@ [our blog post](https://www.fpcomplete.com/blog/2016/05/stack-security-gnupg-keys). * `--no-signature` disables signing of packages * `--candidate` upload a [package candidate](http://hackage.haskell.org/upload#candidates)+ * Hackage API key can be used instead of username and password. Usage example:++ ```bash+ HACKAGE_KEY=<api_key> stack upload .+ ```+ * `username` and `password` can be read by environment ```bash@@ -1745,7 +1751,7 @@ Building with debugging symbols in the [DWARF information](https://ghc.haskell.org/trac/ghc/wiki/DWARF) is supported by `stack`. This can be done by passing the flag `--ghc-options="-g"` and also to override the default behaviour of stripping executables of debugging symbols by passing either one of the following flags: `--no-strip`, `--no-library-stripping` or `--no-executable-stripping`. -In Windows GDB can be isntalled to debug an executable with `stack exec -- pacman -S gdb`. Windows visual studio compiler's debugging format PDB is not supported at the moment. This might be possible by [separating](https://stackoverflow.com/questions/866721/how-to-generate-gcc-debug-symbol-outside-the-build-target) debugging symbols and [converting](https://github.com/rainers/cv2pdb) their format. Or as an option when [using the LLVM backend](http://blog.llvm.org/2017/08/llvm-on-windows-now-supports-pdb-debug.html).+In Windows GDB can be installed to debug an executable with `stack exec -- pacman -S gdb`. Windows visual studio compiler's debugging format PDB is not supported at the moment. This might be possible by [separating](https://stackoverflow.com/questions/866721/how-to-generate-gcc-debug-symbol-outside-the-build-target) debugging symbols and [converting](https://github.com/rainers/cv2pdb) their format. Or as an option when [using the LLVM backend](http://blog.llvm.org/2017/08/llvm-on-windows-now-supports-pdb-debug.html). ## More resources
doc/nix_integration.md view
@@ -119,7 +119,7 @@ `stack setup` will start a nix-shell, so it will gather all the required packages, but given nix handles GHC installation, instead of stack, this will happen when running `stack build` if no setup has been performed-before. Therefore it is not longer necessary to run `stack setup` unless you+before. Therefore it is no longer necessary to run `stack setup` unless you want to cache a GHC installation before running the build. If `enable:` is omitted or set to `false`, you can still build in a nix-shell by
doc/yaml_configuration.md view
@@ -937,7 +937,7 @@ author-name: Your Name author-email: youremail@example.com category: Your Projects Category- copyright: 'Copyright (c) 2021 Your Name'+ copyright: 'Copyright (c) 2022 Your Name' github-username: yourusername ```
src/Stack/Build/Cache.hs view
@@ -12,6 +12,7 @@ , tryGetConfigCache , tryGetCabalMod , tryGetSetupConfigMod+ , tryGetPackageProjectRoot , getInstalledExes , tryGetFlagCache , deleteCaches@@ -22,6 +23,7 @@ , writeConfigCache , writeCabalMod , writeSetupConfigMod+ , writePackageProjectRoot , TestStatus (..) , setTestStatus , getTestStatus@@ -34,6 +36,7 @@ import Stack.Prelude import Crypto.Hash (hashWith, SHA256(..)) import qualified Data.ByteArray as Mem (convert)+import Data.ByteString.Builder (byteString) import qualified Data.Map as M import qualified Data.Set as Set import qualified Data.Text as T@@ -154,6 +157,18 @@ liftIO $ either (const Nothing) (Just . modificationTime) <$> tryIO (getFileStatus fp) +-- | Try to read the project root from the last build of a package+tryGetPackageProjectRoot :: HasEnvConfig env+ => Path Abs Dir -> RIO env (Maybe ByteString)+tryGetPackageProjectRoot dir = do+ fp <- toFilePath <$> configPackageProjectRoot dir+ tryReadFileBinary fp++tryReadFileBinary :: MonadIO m => FilePath -> m (Maybe ByteString)+tryReadFileBinary fp =+ liftIO $ either (const Nothing) Just <$>+ tryIO (readFileBinary fp)+ -- | Write the dirtiness cache for this package's files. writeBuildCache :: HasEnvConfig env => Path Abs Dir@@ -196,6 +211,16 @@ fp <- configSetupConfigMod dir writeBinaryFileAtomic fp "Just used for its modification time" liftIO $ setFileTimes (toFilePath fp) x x++-- | See 'tryGetPackageProjectRoot'+writePackageProjectRoot+ :: HasEnvConfig env+ => Path Abs Dir+ -> ByteString+ -> RIO env ()+writePackageProjectRoot dir projectRoot = do+ fp <- configPackageProjectRoot dir+ writeBinaryFileAtomic fp (byteString projectRoot) -- | Delete the caches for the project. deleteCaches :: HasEnvConfig env => Path Abs Dir -> RIO env ()
src/Stack/Build/Execute.hs view
@@ -849,6 +849,7 @@ liftIO $ either (const Nothing) (Just . modificationTime) <$> tryJust (guard . isDoesNotExistError) (getFileStatus (toFilePath setupConfigfp)) newSetupConfigMod <- getNewSetupConfigMod+ newProjectRoot <- S8.pack . toFilePath <$> view projectRootL -- See https://github.com/commercialhaskell/stack/issues/3554 taskAnyMissingHack <- view $ actualCompilerVersionL.to getGhcVersion.to (< mkVersion [8, 4]) needConfig <-@@ -870,10 +871,12 @@ -- Cabal's setup-config is created per OS/Cabal version, multiple -- projects using the same package could get a conflict because of this mOldSetupConfigMod <- tryGetSetupConfigMod pkgDir+ mOldProjectRoot <- tryGetPackageProjectRoot pkgDir return $ fmap ignoreComponents mOldConfigCache /= Just (ignoreComponents newConfigCache) || mOldCabalMod /= Just newCabalMod || mOldSetupConfigMod /= newSetupConfigMod+ || mOldProjectRoot /= Just newProjectRoot let ConfigureOpts dirs nodirs = configCacheOpts newConfigCache when (taskBuildTypeConfig task) ensureConfigureScript@@ -886,11 +889,11 @@ let programNames = case cpWhich cp of Ghc ->- [ "--with-ghc=" ++ toFilePath (cpCompiler cp)- , "--with-ghc-pkg=" ++ toFilePath pkgPath+ [ ("ghc", toFilePath (cpCompiler cp))+ , ("ghc-pkg", toFilePath pkgPath) ]- exes <- forM programNames $ \name -> do- mpath <- findExecutable name+ exes <- forM programNames $ \(name, file) -> do+ mpath <- findExecutable file return $ case mpath of Left _ -> [] Right x -> return $ concat ["--with-", name, "=", x]@@ -912,6 +915,7 @@ -- check if our config mod file is newer than the file above, but this -- seems reasonable too. getNewSetupConfigMod >>= writeSetupConfigMod pkgDir+ writePackageProjectRoot pkgDir newProjectRoot return needConfig where
src/Stack/Config.hs view
@@ -6,6 +6,7 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE TypeFamilies #-}+{-# LANGUAGE LambdaCase #-} -- | The general Stack configuration that starts everything off. This should -- be smart to falback if there is no stack.yaml, instead relying on@@ -651,6 +652,14 @@ let resolved = ResolvedPath fp abs' pp <- mkProjectPackage YesPrintWarnings resolved (boptsHaddock bopts) pure (cpName $ ppCommon pp, pp)++ -- prefetch git repos to avoid cloning per subdirectory+ -- see https://github.com/commercialhaskell/stack/issues/5411+ let gitRepos = mapMaybe (\case+ (RPLImmutable (RPLIRepo repo rpm)) -> Just (repo, rpm)+ _ -> Nothing) (projectDependencies project)+ logDebug ("Prefetching git repos: " <> display (T.pack (show gitRepos)))+ fetchReposRaw gitRepos (deps0, mcompleted) <- fmap unzip . forM (projectDependencies project) $ \rpl -> do (pl, mCompleted) <- case rpl of
src/Stack/Constants/Config.hs view
@@ -11,6 +11,7 @@ , projectDockerSandboxDir , configCabalMod , configSetupConfigMod+ , configPackageProjectRoot , buildCachesDir , testSuccessFile , testBuiltFile@@ -83,6 +84,15 @@ configSetupConfigMod dir = liftM (</> $(mkRelFile "stack-setup-config-mod"))+ (distDirFromDir dir)++-- | The filename used for the project root from the last build of a package+configPackageProjectRoot :: (MonadThrow m, MonadReader env m, HasEnvConfig env)+ => Path Abs Dir -- ^ Package directory.+ -> m (Path Abs File)+configPackageProjectRoot dir =+ liftM+ (</> $(mkRelFile "stack-project-root")) (distDirFromDir dir) -- | Directory for HPC work.
src/Stack/Ghci.hs view
@@ -644,11 +644,12 @@ (cpCabalConfigOpts . ppCommon <$> M.lookup name smProject) <|> (cpCabalConfigOpts . dpCommon <$> M.lookup name smDeps)+ sourceMapFlags = maybe mempty (cpFlags . ppCommon) $ M.lookup name smProject config = PackageConfig { packageConfigEnableTests = True , packageConfigEnableBenchmarks = True- , packageConfigFlags = getLocalFlags buildOptsCLI name+ , packageConfigFlags = getLocalFlags buildOptsCLI name `M.union` sourceMapFlags , packageConfigGhcOptions = sourceMapGhcOptions , packageConfigCabalConfigOpts = sourceMapCabalConfigOpts , packageConfigCompilerVersion = compilerVersion
src/Stack/Setup.hs view
@@ -836,15 +836,8 @@ if compilerTool `elem` installed then return (compilerTool,CompilerBuildStandard) else do- let repo = Repo- { repoCommit = commitId- , repoUrl = url- , repoType = RepoGit- , repoSubdir = mempty- }- -- clone the repository and execute the given commands- Pantry.withRepo repo $ do+ Pantry.withRepo (Pantry.SimpleRepo url commitId RepoGit) $ do -- withRepo is guaranteed to set workingDirL, so let's get it mcwd <- traverse parseAbsDir =<< view workingDirL let cwd = fromMaybe (error "Invalid working directory") mcwd@@ -1266,6 +1259,8 @@ Platform Arm Cabal.Linux -> return "linux-armv7" Platform AArch64 Cabal.Linux -> return "linux-aarch64" Platform Sparc Cabal.Linux -> return "linux-sparc"+ Platform AArch64 Cabal.OSX -> return "macosx-aarch64"+ Platform AArch64 Cabal.FreeBSD -> return "freebsd-aarch64" Platform arch os -> throwM $ UnsupportedSetupCombo os arch downloadOrUseLocal
src/Stack/Upload.hs view
@@ -12,8 +12,12 @@ , uploadRevision -- * Credentials , HackageCreds- , loadCreds+ , HackageAuth(..)+ , HackageKey(..)+ , loadAuth , writeFilePrivate+ -- * Internal+ , maybeGetHackageKey ) where import Stack.Prelude@@ -27,7 +31,13 @@ import qualified Data.ByteString.Lazy as L import qualified Data.Conduit.Binary as CB import qualified Data.Text as T-import Network.HTTP.StackClient (Request, RequestBody(RequestBodyLBS), Response, withResponse, httpNoBody, getGlobalManager, getResponseStatusCode,+import Network.HTTP.StackClient (Request,+ RequestBody(RequestBodyLBS),+ Response,+ withResponse,+ httpNoBody,+ getGlobalManager,+ getResponseStatusCode, getResponseBody, setRequestHeader, parseRequest,@@ -41,9 +51,12 @@ removeFile, renameFile) import System.Environment (lookupEnv) import System.FilePath ((</>), takeFileName, takeDirectory)-import System.IO (putStrLn, putStr, print) -- TODO remove putStrLn, use logInfo import System.PosixCompat.Files (setFileMode) ++newtype HackageKey = HackageKey Text+ deriving (Eq, Show)+ -- | Username and password to log into Hackage. -- -- Since 0.1.0.0@@ -52,8 +65,12 @@ , hcPassword :: !Text , hcCredsFile :: !FilePath }- deriving Show+ deriving (Eq, Show) +data HackageAuth = HAKey HackageKey+ | HACreds HackageCreds+ deriving (Eq, Show)+ instance ToJSON HackageCreds where toJSON (HackageCreds u p _) = object [ "username" .= u@@ -67,14 +84,26 @@ withEnvVariable :: Text -> IO Text -> IO Text withEnvVariable varName fromPrompt = lookupEnv (T.unpack varName) >>= maybe fromPrompt (pure . T.pack) +maybeGetHackageKey :: RIO m (Maybe HackageKey)+maybeGetHackageKey = liftIO $ fmap (HackageKey . T.pack) <$> lookupEnv "HACKAGE_KEY"++loadAuth :: HasLogFunc m => Config -> RIO m HackageAuth+loadAuth config = do+ maybeHackageKey <- maybeGetHackageKey+ case maybeHackageKey of+ Just key -> do+ logInfo "HACKAGE_KEY found in env, using that for credentials."+ return $ HAKey key+ Nothing -> HACreds <$> loadUserAndPassword config+ -- | Load Hackage credentials, either from a save file or the command -- line. -- -- Since 0.1.0.0-loadCreds :: Config -> IO HackageCreds-loadCreds config = do- fp <- credsFile config- elbs <- tryIO $ L.readFile fp+loadUserAndPassword :: HasLogFunc m => Config -> RIO m HackageCreds+loadUserAndPassword config = do+ fp <- liftIO $ credsFile config+ elbs <- liftIO $ tryIO $ L.readFile fp case either (const Nothing) Just elbs >>= \lbs -> (lbs, ) <$> decode' lbs of Nothing -> fromPrompt fp Just (lbs, mkCreds) -> do@@ -83,14 +112,15 @@ writeFilePrivate fp $ lazyByteString lbs unless (configSaveHackageCreds config) $ do- putStrLn "WARNING: You've set save-hackage-creds to false"- putStrLn "However, credentials were found at:"- putStrLn $ " " ++ fp+ logWarn "WARNING: You've set save-hackage-creds to false"+ logWarn "However, credentials were found at:"+ logWarn $ " " <> fromString fp return $ mkCreds fp where+ fromPrompt :: HasLogFunc m => FilePath -> RIO m HackageCreds fromPrompt fp = do- username <- withEnvVariable "HACKAGE_USERNAME" (prompt "Hackage username: ")- password <- withEnvVariable "HACKAGE_PASSWORD" (promptPassword "Hackage password: ")+ username <- liftIO $ withEnvVariable "HACKAGE_USERNAME" (prompt "Hackage username: ")+ password <- liftIO $ withEnvVariable "HACKAGE_PASSWORD" (promptPassword "Hackage password: ") let hc = HackageCreds { hcUsername = username , hcPassword = password@@ -100,10 +130,10 @@ when (configSaveHackageCreds config) $ do shouldSave <- promptBool $ T.pack $ "Save hackage credentials to file at " ++ fp ++ " [y/n]? "- putStrLn "NOTE: Avoid this prompt in the future by using: save-hackage-creds: false"+ logInfo "NOTE: Avoid this prompt in the future by using: save-hackage-creds: false" when shouldSave $ do writeFilePrivate fp $ fromEncoding $ toEncoding hc- putStrLn "Saved!"+ logInfo "Saved!" hFlush stdout return hc@@ -136,20 +166,30 @@ createDirectoryIfMissing True dir return $ dir </> "credentials.json" -applyCreds :: HackageCreds -> Request -> IO Request+addAPIKey :: HackageKey -> Request -> Request+addAPIKey (HackageKey key) req =+ setRequestHeader "Authorization" [fromString $ "X-ApiKey" ++ " " ++ T.unpack key] req++applyAuth :: HasLogFunc m => HackageAuth -> Request -> RIO m Request+applyAuth haAuth req0 = do+ case haAuth of+ HAKey key -> return (addAPIKey key req0)+ HACreds creds -> applyCreds creds req0++applyCreds :: HasLogFunc m => HackageCreds -> Request -> RIO m Request applyCreds creds req0 = do- manager <- getGlobalManager- ereq <- applyDigestAuth+ manager <- liftIO getGlobalManager+ ereq <- liftIO $ applyDigestAuth (encodeUtf8 $ hcUsername creds) (encodeUtf8 $ hcPassword creds) req0 manager case ereq of Left e -> do- putStrLn "WARNING: No HTTP digest prompt found, this will probably fail"+ logWarn "WARNING: No HTTP digest prompt found, this will probably fail" case fromException e of- Just e' -> putStrLn $ displayDigestAuthException e'- Nothing -> print e+ Just e' -> logWarn $ fromString $ displayDigestAuthException e'+ Nothing -> logWarn $ fromString $ displayException e return req0 Right req -> return req @@ -157,13 +197,14 @@ -- sending a file like 'upload', this sends a lazy bytestring. -- -- Since 0.1.2.1-uploadBytes :: String -- ^ Hackage base URL- -> HackageCreds+uploadBytes :: HasLogFunc m+ => String -- ^ Hackage base URL+ -> HackageAuth -> String -- ^ tar file name -> UploadVariant -> L.ByteString -- ^ tar file contents- -> IO ()-uploadBytes baseUrl creds tarName uploadVariant bytes = do+ -> RIO m ()+uploadBytes baseUrl auth tarName uploadVariant bytes = do let req1 = setRequestHeader "Accept" ["text/plain"] (fromString $ baseUrl <> "packages/"@@ -172,31 +213,36 @@ Candidate -> "candidates/" ) formData = [partFileRequestBody "package" tarName (RequestBodyLBS bytes)]- req2 <- formDataBody formData req1- req3 <- applyCreds creds req2- putStr $ "Uploading " ++ tarName ++ "... "+ req2 <- liftIO $ formDataBody formData req1+ req3 <- applyAuth auth req2+ logInfo $ "Uploading " <> fromString tarName <> "... " hFlush stdout- withResponse req3 $ \res ->+ withRunInIO $ \runInIO -> withResponse req3 (runInIO . inner)+ where+ inner :: HasLogFunc m => Response (ConduitM () S.ByteString IO ()) -> RIO m ()+ inner res = case getResponseStatusCode res of- 200 -> putStrLn "done!"+ 200 -> logInfo "done!" 401 -> do- putStrLn "authentication failure"- handleIO (const $ return ()) (removeFile (hcCredsFile creds))+ logError "authentication failure"+ case auth of+ HACreds creds -> handleIO (const $ return ()) (liftIO $ removeFile (hcCredsFile creds))+ _ -> pure () throwString "Authentication failure uploading to server" 403 -> do- putStrLn "forbidden upload"- putStrLn "Usually means: you've already uploaded this package/version combination"- putStrLn "Ignoring error and continuing, full message from Hackage below:\n"- printBody res+ logError "forbidden upload"+ logError "Usually means: you've already uploaded this package/version combination"+ logError "Ignoring error and continuing, full message from Hackage below:\n"+ liftIO $ printBody res 503 -> do- putStrLn "service unavailable"- putStrLn "This error some times gets sent even though the upload succeeded"- putStrLn "Check on Hackage to see if your pacakge is present"- printBody res+ logError "service unavailable"+ logError "This error some times gets sent even though the upload succeeded"+ logError "Check on Hackage to see if your pacakge is present"+ liftIO $ printBody res code -> do- putStrLn $ "unhandled status code: " ++ show code- printBody res- throwString $ "Upload failed on " ++ tarName+ logError $ "unhandled status code: " <> fromString (show code)+ liftIO $ printBody res+ throwString $ "Upload failed on " <> fromString tarName printBody :: Response (ConduitM () S.ByteString IO ()) -> IO () printBody res = runConduit $ getResponseBody res .| CB.sinkHandle stdout@@ -204,20 +250,22 @@ -- | Upload a single tarball with the given @Uploader@. -- -- Since 0.1.0.0-upload :: String -- ^ Hackage base URL- -> HackageCreds+upload :: HasLogFunc m+ => String -- ^ Hackage base URL+ -> HackageAuth -> FilePath -> UploadVariant- -> IO ()-upload baseUrl creds fp uploadVariant =- uploadBytes baseUrl creds (takeFileName fp) uploadVariant =<< L.readFile fp+ -> RIO m ()+upload baseUrl auth fp uploadVariant =+ uploadBytes baseUrl auth (takeFileName fp) uploadVariant =<< liftIO (L.readFile fp) -uploadRevision :: String -- ^ Hackage base URL- -> HackageCreds+uploadRevision :: HasLogFunc m+ => String -- ^ Hackage base URL+ -> HackageAuth -> PackageIdentifier -> L.ByteString- -> IO ()-uploadRevision baseUrl creds ident@(PackageIdentifier name _) cabalFile = do+ -> RIO m ()+uploadRevision baseUrl auth ident@(PackageIdentifier name _) cabalFile = do req0 <- parseRequest $ concat [ baseUrl , "package/"@@ -231,5 +279,5 @@ , partBS "publish" "on" ] req0- req2 <- applyCreds creds req1+ req2 <- applyAuth auth req1 void $ httpNoBody req2
src/main/Main.hs view
@@ -655,21 +655,19 @@ config <- view configL let hackageUrl = T.unpack $ configHackageBaseUrl config uploadVariant = uoptsUploadVariant uploadOpts- getCreds <- liftIO $ memoizeRef $ Upload.loadCreds config+ getCreds <- memoizeRef $ Upload.loadAuth config mapM_ (resolveFile' >=> checkSDistTarball sdistOpts) files forM_ files $ \file -> do tarFile <- resolveFile' file- liftIO $ do- creds <- runMemoized getCreds- Upload.upload hackageUrl creds (toFilePath tarFile) uploadVariant+ creds <- runMemoized getCreds+ Upload.upload hackageUrl creds (toFilePath tarFile) uploadVariant forM_ dirs $ \dir -> do pkgDir <- resolveDir' dir (tarName, tarBytes, mcabalRevision) <- getSDistTarball (sdoptsPvpBounds sdistOpts) pkgDir checkSDistTarball' sdistOpts tarName tarBytes- liftIO $ do- creds <- runMemoized getCreds- Upload.uploadBytes hackageUrl creds tarName uploadVariant tarBytes- forM_ mcabalRevision $ uncurry $ Upload.uploadRevision hackageUrl creds+ creds <- runMemoized getCreds+ Upload.uploadBytes hackageUrl creds tarName uploadVariant tarBytes+ forM_ mcabalRevision $ uncurry $ Upload.uploadRevision hackageUrl creds sdistCmd :: SDistOpts -> RIO Runner () sdistCmd sdistOpts =
src/test/Stack/UploadSpec.hs view
@@ -9,6 +9,7 @@ import Test.Hspec import System.Permissions (osIsWindows) import System.PosixCompat.Files (getFileStatus, fileMode)+import System.Environment (setEnv, unsetEnv) import Data.Bits ((.&.)) spec :: Spec@@ -26,3 +27,14 @@ unless osIsWindows $ do status <- getFileStatus fp (fileMode status .&. 0o777) `shouldBe` 0o600++ it "finds a HACKAGE_KEY env variable" $ do+ runRIO () maybeGetHackageKey `shouldReturn` Nothing++ withEnv "HACKAGE_KEY" "api_key"+ $ runRIO () maybeGetHackageKey `shouldReturn` Just (HackageKey "api_key")++withEnv :: String -> String -> IO a -> IO a+withEnv k v f = do+ setEnv k v+ f `finally` unsetEnv k
stack.cabal view
@@ -1,6 +1,6 @@ cabal-version: 2.0 name: stack-version: 2.7.3+version: 2.7.5 license: BSD3 license-file: LICENSE maintainer: manny@fpcomplete.com@@ -278,7 +278,7 @@ network-uri >=2.6.4.1, open-browser >=0.2.1.0, optparse-applicative >=0.14.3.0,- pantry >=0.5.2,+ pantry >=0.5.3, path >=0.7.0, path-io >=1.6.3, persistent >=2.11.0.4,@@ -288,9 +288,8 @@ primitive >=0.7.1.0, process >=1.6.9.0, project-template >=0.2.1.0,- regex-applicative-text >=0.1.0.1, retry >=0.8.1.2,- rio >=0.1.18.0,+ rio >=0.1.21.0, rio-prettyprint >=0.1.1.0, semigroups >=0.19.1, split >=0.2.3.4,@@ -405,7 +404,7 @@ network-uri >=2.6.4.1, open-browser >=0.2.1.0, optparse-applicative >=0.14.3.0,- pantry >=0.5.2,+ pantry >=0.5.3, path >=0.7.0, path-io >=1.6.3, persistent >=2.11.0.4,@@ -415,9 +414,8 @@ primitive >=0.7.1.0, process >=1.6.9.0, project-template >=0.2.1.0,- regex-applicative-text >=0.1.0.1, retry >=0.8.1.2,- rio >=0.1.18.0,+ rio >=0.1.21.0, rio-prettyprint >=0.1.1.0, semigroups >=0.19.1, split >=0.2.3.4,@@ -536,7 +534,7 @@ open-browser >=0.2.1.0, optparse-applicative >=0.14.3.0, optparse-generic >=1.3.1,- pantry >=0.5.2,+ pantry >=0.5.3, path >=0.7.0, path-io >=1.6.3, persistent >=2.11.0.4,@@ -546,9 +544,8 @@ primitive >=0.7.1.0, process >=1.6.9.0, project-template >=0.2.1.0,- regex-applicative-text >=0.1.0.1, retry >=0.8.1.2,- rio >=0.1.18.0,+ rio >=0.1.21.0, rio-prettyprint >=0.1.1.0, semigroups >=0.19.1, split >=0.2.3.4,@@ -594,9 +591,10 @@ ld-options: -static -pthread test-suite stack-test- type: exitcode-stdio-1.0- main-is: Spec.hs- hs-source-dirs: src/test+ type: exitcode-stdio-1.0+ main-is: Spec.hs+ build-tool-depends: hspec-discover:hspec-discover -any+ hs-source-dirs: src/test other-modules: Stack.ArgsSpec Stack.Build.ExecuteSpec@@ -614,7 +612,7 @@ Stack.UploadSpec Paths_stack - default-language: Haskell2010+ default-language: Haskell2010 ghc-options: -Wall -fwarn-tabs -fwarn-incomplete-uni-patterns -fwarn-incomplete-record-updates -optP-Wno-nonportable-include-path@@ -671,7 +669,7 @@ network-uri >=2.6.4.1, open-browser >=0.2.1.0, optparse-applicative >=0.14.3.0,- pantry >=0.5.2,+ pantry >=0.5.3, path >=0.7.0, path-io >=1.6.3, persistent >=2.11.0.4,@@ -682,9 +680,8 @@ process >=1.6.9.0, project-template >=0.2.1.0, raw-strings-qq >=1.1,- regex-applicative-text >=0.1.0.1, retry >=0.8.1.2,- rio >=0.1.18.0,+ rio >=0.1.21.0, rio-prettyprint >=0.1.1.0, semigroups >=0.19.1, smallcheck >=1.2.1,
stack.yaml view
@@ -3,6 +3,11 @@ packages: - . +extra-deps:+- rio-0.1.21.0@rev:0+- pantry-0.5.3@rev:0++ docker: enable: false #repo: fpco/alpine-haskell-stack:8.10.4
test/integration/lib/StackTest.hs view
@@ -289,14 +289,19 @@ then return () else throwIO e --- | Changes working directory to Stack source directory-withSourceDirectory :: HasCallStack => IO () -> IO ()-withSourceDirectory action = do- dir <- stackSrc+-- | Changes to the specified working directory.+withCwd :: HasCallStack => FilePath -> IO () -> IO ()+withCwd dir action = do currentDirectory <- getCurrentDirectory let enterDir = setCurrentDirectory dir exitDir = setCurrentDirectory currentDirectory bracket_ enterDir exitDir action++-- | Changes working directory to Stack source directory.+withSourceDirectory :: HasCallStack => IO () -> IO ()+withSourceDirectory action = do+ dir <- stackSrc+ withCwd dir action -- | Mark a test as superslow, only to be run when explicitly requested. superslow :: HasCallStack => IO () -> IO ()