From 79ce2ac6e90746292caa12c0e81d15dea4a3d5cd Mon Sep 17 00:00:00 2001 From: Kirill Zaborsky Date: Thu, 16 Aug 2018 14:51:36 +0300 Subject: [PATCH 1/5] `stack freeze` command --- ChangeLog.md | 2 + package.yaml | 2 + src/Stack/Freeze.hs | 49 +++++++++++++++++++ src/Stack/Options/FreezeParser.hs | 16 ++++++ src/main/Main.hs | 10 ++++ subs/pantry/src/Pantry/Types.hs | 21 ++------ .../tests/4220-freeze-command/Main.hs | 26 ++++++++++ .../files/freeze-command.cabal | 12 +++++ .../4220-freeze-command/files/src/Src.hs | 5 ++ .../4220-freeze-command/files/stack.yaml | 5 ++ 10 files changed, 131 insertions(+), 17 deletions(-) create mode 100644 src/Stack/Freeze.hs create mode 100644 src/Stack/Options/FreezeParser.hs create mode 100644 test/integration/tests/4220-freeze-command/Main.hs create mode 100644 test/integration/tests/4220-freeze-command/files/freeze-command.cabal create mode 100644 test/integration/tests/4220-freeze-command/files/src/Src.hs create mode 100644 test/integration/tests/4220-freeze-command/files/stack.yaml diff --git a/ChangeLog.md b/ChangeLog.md index 43240af863..ad55f73e33 100644 --- a/ChangeLog.md +++ b/ChangeLog.md @@ -15,6 +15,8 @@ Major changes: must be specified in `extra-deps`. * The `extra-dep` key in `packages` is no longer supported; please move any such specifications to `extra-deps`. +* A new command, `stack freeze` has been added which outputs project + and snapshot definitions with dependencies pinned to their exact versions. Behavior changes: diff --git a/package.yaml b/package.yaml index 92852570b8..d556d36cfb 100644 --- a/package.yaml +++ b/package.yaml @@ -183,6 +183,7 @@ library: - Stack.Docker.GlobalDB - Stack.Dot - Stack.FileWatch + - Stack.Freeze - Stack.GhcPkg - Stack.Ghci - Stack.Ghci.Script @@ -202,6 +203,7 @@ library: - Stack.Options.DockerParser - Stack.Options.DotParser - Stack.Options.ExecParser + - Stack.Options.FreezeParser - Stack.Options.GhcBuildParser - Stack.Options.GhciParser - Stack.Options.GhcVariantParser diff --git a/src/Stack/Freeze.hs b/src/Stack/Freeze.hs new file mode 100644 index 0000000000..638c7dcdff --- /dev/null +++ b/src/Stack/Freeze.hs @@ -0,0 +1,49 @@ +{-# LANGUAGE NoImplicitPrelude #-} +{-# LANGUAGE OverloadedStrings #-} + +module Stack.Freeze + ( freeze + , FreezeOpts (..) + , FreezeMode (..) + ) where + +import qualified Data.Yaml as Yaml +import qualified RIO.ByteString as B +import Stack.Prelude +import Stack.Types.BuildPlan +import Stack.Types.Config + +data FreezeMode = FreezeProject | FreezeSnapshot + +data FreezeOpts = FreezeOpts + { freezeMode :: FreezeMode + } + +freeze :: HasEnvConfig env => FreezeOpts -> RIO env () +freeze (FreezeOpts FreezeProject) = do + mproject <- view $ configL.to configMaybeProject + case mproject of + Just (p, _) -> do + let deps = projectDependencies p + resolver = projectResolver p + completePackageLocation' pl = + case pl of + PLImmutable pli -> PLImmutable <$> completePackageLocation pli + plm@(PLMutable _) -> pure plm + resolver' <- completeSnapshotLocation resolver + deps' <- mapM completePackageLocation' deps + when (deps' /= deps || resolver' /= resolver) $ + liftIO $ B.putStr $ Yaml.encode p{ projectDependencies = deps' + , projectResolver = resolver' + } + Nothing -> pure () + +freeze (FreezeOpts FreezeSnapshot) = do + msnapshot <- view $ buildConfigL.to bcSnapshotDef.to sdSnapshot + case msnapshot of + Just (snap, _) -> do + snap' <- completeSnapshot snap + when (snap' /= snap) $ + liftIO $ B.putStr $ Yaml.encode snap' + Nothing -> + return () diff --git a/src/Stack/Options/FreezeParser.hs b/src/Stack/Options/FreezeParser.hs new file mode 100644 index 0000000000..65c2068aa9 --- /dev/null +++ b/src/Stack/Options/FreezeParser.hs @@ -0,0 +1,16 @@ +{-# LANGUAGE NoImplicitPrelude #-} + +module Stack.Options.FreezeParser where + +import Data.Semigroup ((<>)) +import Options.Applicative +import Stack.Freeze + + +-- | Parser for arguments to `stack freeze` +freezeOptsParser :: Parser FreezeOpts +freezeOptsParser = + FreezeOpts <$> flag FreezeProject FreezeSnapshot + ( long "snapshot" + <> short 's' + <> help "Freeze snapshot definition instead of project's stack.yaml" ) diff --git a/src/main/Main.hs b/src/main/Main.hs index 78744c4f51..7ad0fdd375 100644 --- a/src/main/Main.hs +++ b/src/main/Main.hs @@ -64,6 +64,7 @@ import Stack.Dot import Stack.GhcPkg (findGhcPkgField) import qualified Stack.Nix as Nix import Stack.FileWatch +import Stack.Freeze import Stack.Ghci import Stack.Hoogle import Stack.Ls @@ -78,6 +79,7 @@ import Stack.Options.DotParser import Stack.Options.ExecParser import Stack.Options.GhciParser import Stack.Options.GlobalParser +import Stack.Options.FreezeParser import Stack.Options.HpcReportParser import Stack.Options.NewParser @@ -389,6 +391,10 @@ commandLineHandler currentDir progName isInterpreter = complicatedOptions "Run a Stack Script" scriptCmd scriptOptsParser + addCommand' "freeze" + "Show project or snapshot with pinned dependencies if there are any such" + freezeCmd + freezeOptsParser unless isInterpreter (do addCommand' "eval" @@ -1005,6 +1011,10 @@ queryCmd selectors go = withBuildConfig go $ queryBuildInfo $ map T.pack selecto hpcReportCmd :: HpcReportOpts -> GlobalOpts -> IO () hpcReportCmd hropts go = withBuildConfig go $ generateHpcReportForTargets hropts +freezeCmd :: FreezeOpts -> GlobalOpts -> IO () +freezeCmd freezeOpts go = + withBuildConfig go $ freeze freezeOpts + data MainException = InvalidReExecVersion String String | UpgradeCabalUnusable | InvalidPathForExec FilePath diff --git a/subs/pantry/src/Pantry/Types.hs b/subs/pantry/src/Pantry/Types.hs index 9787732878..f6413701b9 100644 --- a/subs/pantry/src/Pantry/Types.hs +++ b/subs/pantry/src/Pantry/Types.hs @@ -1214,23 +1214,8 @@ instance Store Snapshot instance NFData Snapshot instance ToJSON Snapshot where toJSON snap = object $ concat - [ case snapshotParent snap of - SLCompiler compiler -> ["compiler" .= compiler] - SLUrl url mblob mcompiler -> concat - [ pure $ "resolver" .= concat - [ ["url" .= url] - , maybe [] blobKeyPairs mblob - ] - , case mcompiler of - Nothing -> [] - Just compiler -> ["compiler" .= compiler] - ] - SLFilePath resolved mcompiler -> concat - [ pure $ "resolver" .= object ["filepath" .= resolvedRelative resolved] - , case mcompiler of - Nothing -> [] - Just compiler -> ["compiler" .= compiler] - ] + [ maybe [] (\cv -> ["compiler" .= cv]) compiler + , ["resolver" .= usl] , ["name" .= snapshotName snap] , ["packages" .= map mkUnresolvedPackageLocationImmutable (snapshotLocations snap)] , if Set.null (snapshotDropPackages snap) then [] else ["drop-packages" .= Set.map CabalString (snapshotDropPackages snap)] @@ -1238,6 +1223,8 @@ instance ToJSON Snapshot where , if Map.null (snapshotHidden snap) then [] else ["hidden" .= toCabalStringMap (snapshotHidden snap)] , if Map.null (snapshotGhcOptions snap) then [] else ["ghc-options" .= toCabalStringMap (snapshotGhcOptions snap)] ] + where + (usl, compiler) = unresolveSnapshotLocation $ snapshotParent snap parseSnapshot :: Maybe (Path Abs Dir) -> Value -> Parser (WithJSONWarnings (IO Snapshot)) parseSnapshot mdir = withObjectWarnings "Snapshot" $ \o -> do diff --git a/test/integration/tests/4220-freeze-command/Main.hs b/test/integration/tests/4220-freeze-command/Main.hs new file mode 100644 index 0000000000..9b763bcfb7 --- /dev/null +++ b/test/integration/tests/4220-freeze-command/Main.hs @@ -0,0 +1,26 @@ +import Control.Monad (unless) +import StackTest + +main :: IO () +main = do + stackCheckStdout ["freeze"] $ \stdOut -> do + let expected = unlines + [ "packages:" + , "- ." + , "extra-deps:" + , "- hackage: a50-0.5@sha256:b8dfcc13dcbb12e444128bb0e17527a2a7a9bd74ca9450d6f6862c4b394ac054,1491" + , " pantry-tree:" + , " size: 409" + , " sha256: a7c6151a18b04afe1f13637627cad4deff91af51d336c4f33e95fc98c64c40d3" + , "resolver:" + , " blob:" + , " size: 527165" + , " sha256: 0116ad1779b20ad2c9d6620f172531f13b12bb69867e78f4277157e28865dfd4" + , " url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/11/19.yaml" + ] + unless (stdOut == expected) $ + error $ concat [ "Expected: " + , show expected + , "\nActual: " + , show stdOut + ] diff --git a/test/integration/tests/4220-freeze-command/files/freeze-command.cabal b/test/integration/tests/4220-freeze-command/files/freeze-command.cabal new file mode 100644 index 0000000000..0875aa6927 --- /dev/null +++ b/test/integration/tests/4220-freeze-command/files/freeze-command.cabal @@ -0,0 +1,12 @@ +name: freeze-command +version: 0.1.0.0 +build-type: Simple +cabal-version: >= 2.0 + +library + exposed-modules: Src + hs-source-dirs: src + build-depends: base + , rio + , vector + default-language: Haskell2010 diff --git a/test/integration/tests/4220-freeze-command/files/src/Src.hs b/test/integration/tests/4220-freeze-command/files/src/Src.hs new file mode 100644 index 0000000000..0f8db7fb77 --- /dev/null +++ b/test/integration/tests/4220-freeze-command/files/src/Src.hs @@ -0,0 +1,5 @@ +module Src where + +-- | A function of the main library +funMainLib :: Int -> Int +funMainLib = succ diff --git a/test/integration/tests/4220-freeze-command/files/stack.yaml b/test/integration/tests/4220-freeze-command/files/stack.yaml new file mode 100644 index 0000000000..509e7a9180 --- /dev/null +++ b/test/integration/tests/4220-freeze-command/files/stack.yaml @@ -0,0 +1,5 @@ +resolver: lts-11.19 +packages: +- . +extra-deps: +- a50-0.5 From 288131d2e330bd866a7098e91013c846886db014 Mon Sep 17 00:00:00 2001 From: Kirill Zaborsky Date: Tue, 21 Aug 2018 11:33:40 +0300 Subject: [PATCH 2/5] Pin revision to prevent test breakage --- test/integration/tests/4220-freeze-command/files/stack.yaml | 2 +- 1 file changed, 1 insertion(+), 1 deletion(-) diff --git a/test/integration/tests/4220-freeze-command/files/stack.yaml b/test/integration/tests/4220-freeze-command/files/stack.yaml index 509e7a9180..d67d97edb4 100644 --- a/test/integration/tests/4220-freeze-command/files/stack.yaml +++ b/test/integration/tests/4220-freeze-command/files/stack.yaml @@ -2,4 +2,4 @@ resolver: lts-11.19 packages: - . extra-deps: -- a50-0.5 +- a50-0.5@rev:0 From b108f02ec224298d5271eac531e22af656cf6d3f Mon Sep 17 00:00:00 2001 From: Kirill Zaborsky Date: Tue, 21 Aug 2018 11:34:18 +0300 Subject: [PATCH 3/5] More verbose and easy to understand output --- src/Stack/Freeze.hs | 14 ++++++++++---- 1 file changed, 10 insertions(+), 4 deletions(-) diff --git a/src/Stack/Freeze.hs b/src/Stack/Freeze.hs index 638c7dcdff..ac8316df4c 100644 --- a/src/Stack/Freeze.hs +++ b/src/Stack/Freeze.hs @@ -32,18 +32,24 @@ freeze (FreezeOpts FreezeProject) = do plm@(PLMutable _) -> pure plm resolver' <- completeSnapshotLocation resolver deps' <- mapM completePackageLocation' deps - when (deps' /= deps || resolver' /= resolver) $ + if deps' == deps && resolver' == resolver + then + logInfo "No freezing is required for this project" + else liftIO $ B.putStr $ Yaml.encode p{ projectDependencies = deps' , projectResolver = resolver' } - Nothing -> pure () + Nothing -> logWarn "No project was found: nothing to freeze" freeze (FreezeOpts FreezeSnapshot) = do msnapshot <- view $ buildConfigL.to bcSnapshotDef.to sdSnapshot case msnapshot of Just (snap, _) -> do snap' <- completeSnapshot snap - when (snap' /= snap) $ + if snap' == snap + then + logInfo "No freezing is required for the snapshot of this project" + else liftIO $ B.putStr $ Yaml.encode snap' Nothing -> - return () + logWarn "No snapshot was found: nothing to freeze" From 230237e1cece437a2f12eb0345774bc5c761c1dd Mon Sep 17 00:00:00 2001 From: Kirill Zaborsky Date: Tue, 21 Aug 2018 12:13:38 +0300 Subject: [PATCH 4/5] Docs for stack freeze --- doc/setting_up_dependencies.md | 38 ++++++++++++++++++++++++++++++++++ 1 file changed, 38 insertions(+) create mode 100644 doc/setting_up_dependencies.md diff --git a/doc/setting_up_dependencies.md b/doc/setting_up_dependencies.md new file mode 100644 index 0000000000..8b5ab349ac --- /dev/null +++ b/doc/setting_up_dependencies.md @@ -0,0 +1,38 @@ +# Dependency freezing + +To make builds reproducible it makes sense to pin project dependencies to some +exact versions and this is what is stack's `freeze` command is about. + +## Project freezing + +The default mode of its invocation: + +``` +$ stack freeze +``` +freezes the following fields from the project's `stack.yaml` + +* packages in `extra-deps` which do not include sha256 of their cabal files and + which do not specify pantry tree pointer of the package archive +* `resolver` if it references a remote snapshot and if it does not specify + pantry tree pointer of its contents + +The command outputs to standard output new project's `stack.yaml` with these +changes included. + +If a project is specified precisely enough stack tells about it and exits. + +## Snapshot freezing + +When a project uses some custom snapshot freezing dependencies defined in +the project is not enough as a snapshot could also contain not precisely +specified package references. To prevent this from happening `--snapshot` flag +(or `-s` in its short form) of the `freeze` command could be used: + +``` +$ stack freeze --snapshot +``` + +In this mode `freeze` command works almost like in the default mode, the main +differenc is that it works with the projects snapshot definition and thus it +pins packages from its `packages` field and not from the project's `extra-deps`. From 2f2b751687a8306aff57a91de665fc2d6fc81e7c Mon Sep 17 00:00:00 2001 From: Kirill Zaborsky Date: Tue, 21 Aug 2018 13:01:27 +0300 Subject: [PATCH 5/5] New output format in tests --- test/integration/tests/4220-freeze-command/Main.hs | 5 ++--- 1 file changed, 2 insertions(+), 3 deletions(-) diff --git a/test/integration/tests/4220-freeze-command/Main.hs b/test/integration/tests/4220-freeze-command/Main.hs index 9b763bcfb7..b3d8ec18a7 100644 --- a/test/integration/tests/4220-freeze-command/Main.hs +++ b/test/integration/tests/4220-freeze-command/Main.hs @@ -13,10 +13,9 @@ main = do , " size: 409" , " sha256: a7c6151a18b04afe1f13637627cad4deff91af51d336c4f33e95fc98c64c40d3" , "resolver:" - , " blob:" - , " size: 527165" - , " sha256: 0116ad1779b20ad2c9d6620f172531f13b12bb69867e78f4277157e28865dfd4" + , " size: 527165" , " url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/11/19.yaml" + , " sha256: 0116ad1779b20ad2c9d6620f172531f13b12bb69867e78f4277157e28865dfd4" ] unless (stdOut == expected) $ error $ concat [ "Expected: "