Lock files attempt 2

ChangeLog.md

@@ -66,6 +66,7 @@ Major changes:
 
 * Remove support for building GHCJS itself. Future releases of Stack
   may remove GHCJS support entirely.
+* Support for lock files for pinning exact project dependency versions
 
 Behavior changes:
 * `stack.yaml` now supports `snapshot`: a synonym for `resolver`. See [#4256](https://github.com/commercialhaskell/stack/issues/4256)

doc/lock_files.md

@@ -18,11 +18,12 @@ set of input files. There are a few problems with making this work:
 
 To address this, we follow the (fairly standard) approach of having a
 _lock file_. The goal of the lock file is to cache completed
-information about all packages and snapshot files so that:
+locations of project, snapshot packages and snapshots themselves so that:
 
 * These files can be stored in source control
 * Users on other machines can reuse these lock files and get identical
-  build plans
+  build plans given that the used local packages and local snapshots are
+  the same on those machines
 * Rerunning `stack build` in the future is deterministic in the build
   plan, not depending on mutable state in the world like Hackage
   revisions
@@ -31,8 +32,6 @@ information about all packages and snapshot files so that:
       to perform the build. However, by deterministic, we mean it
       either performs the same build or fails, never accidentally
       doing something different.
-* Stack can quickly determine the build plan in the common case of no
-  changes to `stack.yaml` or snapshot files
 
 This document explains the contents of a lock file, how they are used,
 and how they are created and updated.
@@ -42,11 +41,7 @@ and how they are created and updated.
 Relevant to this discussion, the `stack.yaml` file specifies:
 
 * Resolver (the parent snapshot)
-* Compiler override
 * `extra-deps`
-* Flags
-* GHC options
-* Hidden packages
 
 The resolver can either specify a compiler version or another snapshot
 file. This snapshot file can contain the same information referenced
@@ -55,12 +50,7 @@ above for a `stack.yaml`, with the following differences:
 * The `extra-deps` are called `packages`
 * Drop packages can be included
 
-Some of this information is, by its nature, complete. For example, the
-"flags" field cannot be influenced by anything outside of the file
-itself.
-
-On the other hand, some information in these files can be
-incomplete. Consider:
+Some information in these files can be incomplete. Consider:
 
 ```yaml
 resolver: lts-13.9
@@ -128,24 +118,16 @@ parsing of the additional files in the common case of no changes.
 
 The lock file contains the following information:
 
-* The full snapshot definition information, including completed
-  package locations for both `extra-deps` and packages in
+* Completed package locations for both `extra-deps` and packages in
   snapshot files
     * **NOTE** This only applies to _immutable_ packages. Mutable
       packages are not included in the lock file.
 * Completed information for the snapshot locations
-* A hash of the `stack.yaml` file
-* The snapshot hash, to bypass the need to recalculate this on each
-  run of Stack
 
 It looks like the following:
 
 ```yaml
 # Lock file, some message about the file being auto-generated
-stack-yaml:
-  sha256: XXXX
-  size: XXXX # in bytes
-
 snapshots:
   # Starts with the snapshot specified in stack.yaml,
   # then continues with the snapshot specified in each
@@ -163,33 +145,22 @@ snapshots:
       url: https://raw.githubusercontent.com/commercialhaskell/stackage-snapshots/master/lts/13/9.yaml
       sha256: 83de9017d911cf7795f19353dba4d04bd24cd40622b7567ff61fc3f7223aa3ea
 
-compiler: ghc-X.Y.Z
-
 packages:
-  acme-missiles:
-    location:
-      # QUESTION: any reason we need to specify which snapshot file it came from? I don't think so...
-      original: https://hackage.haskell.org/package/acme-missiles-0.3.tar.gz
-      completed:
-        size: 1442
-        url: https://hackage.haskell.org/package/acme-missiles-0.3.tar.gz
-        cabal-file:
-          size: 613
-          sha256: 2ba66a092a32593880a87fb00f3213762d7bca65a687d45965778deb8694c5d1
-        name: acme-missiles
-        version: '0.3'
-        sha256: e563d8b524017a06b32768c4db8eff1f822f3fb22a90320b7e414402647b735b
-        pantry-tree:
-          size: 226
-          sha256: 614bc0cca76937507ea0a5ccc17a504c997ce458d7f2f9e43b15a10c8eaeb033
-    flags: ...
-    hidden: true/false
-    ghc-options: [...]
+- original: https://hackage.haskell.org/package/acme-missiles-0.3.tar.gz
+  completed:
+    size: 1442
+    url: https://hackage.haskell.org/package/acme-missiles-0.3.tar.gz
+    cabal-file:
+      size: 613
+      sha256: 2ba66a092a32593880a87fb00f3213762d7bca65a687d45965778deb8694c5d1
+    name: acme-missiles
+    version: '0.3'
+    sha256: e563d8b524017a06b32768c4db8eff1f822f3fb22a90320b7e414402647b735b
+    pantry-tree:
+      size: 226
+      sha256: 614bc0cca76937507ea0a5ccc17a504c997ce458d7f2f9e43b15a10c8eaeb033
 ```
 
-**NOTE** The `original` fields may seem superfluous at first. See the
-update procedure below for an explanation.
-
 ## Creation
 
 Whenever a `stack.yaml` file is loaded, Stack checks for a lock file
@@ -206,36 +177,9 @@ If the lock file does not exist, it will be created by:
 * Completing all missing information
 * Writing out the new `stack.yaml.lock` file
 
-## Dirtiness checking
-
-If the `stack.yaml.lock` file exists, its last modification time is
-compared against the last modification time of the `stack.yaml` file
-and any local snapshot files. If any of those files is more recent
-than the `stack.yaml` file, and the file hashes in the lock file
-do not match the files on the filesystem, then the update procedure is
-triggered. Otherwise, the `stack.yaml.lock` file can be used as the
-definition of the snapshot.
-
 ## Update procedure
 
-The simplest possible implementation is: ignore the lock file entirely
-and create a new one followign the creation steps above. There's a
-significant downside to this, however: it may cause a larger delta in
-the lock file than intended, by causing more packages to be
-updates. For example, many packages from Hackage may have their
-Hackage revision information updated unnecessarily.
-
-The more complicated update procedure is described below. **QUESTION**
-Do we want to go the easy way at first and later implement the more
-complicated update procedure?
-
-1. Create a map from original package location to completed package
-   location in the lock file
-2. Load up each snapshot file
-3. For each incomplete package location:
-    * Lookup the value in the map created in (1)
-    * If present: use that completed information
-    * Otherwise: complete the information using the same completion
-      procedure from Pantry as in "creation"
-
-This should minimize the number of changes to packages incurred.
+When loading a Stack project all completed package or snapshot locations
+(even when they were completed using information from a lock file) get
+collected to form a new lock file in memory and compare against the one
+on disk, writing if there are any differences.

package.yaml

@@ -183,6 +183,7 @@ library:
   - Stack.IDE
   - Stack.Init
   - Stack.Ls
+  - Stack.Lock
   - Stack.New
   - Stack.Nix
   - Stack.Options.BenchParser
@@ -302,6 +303,7 @@ tests:
     dependencies:
     - QuickCheck
     - hspec
+    - raw-strings-qq
     - stack
     - smallcheck
 flags:

src/Stack/Config.hs

@@ -62,6 +62,7 @@ import           Stack.Config.Docker
 import           Stack.Config.Nix
 import           Stack.Constants
 import           Stack.Build.Haddock (shouldHaddockDeps)
+import           Stack.Lock (lockCachedWanted)
 import           Stack.Storage (initStorage)
 import           Stack.SourceMap
 import           Stack.Types.Build
@@ -76,6 +77,7 @@ import           System.Console.ANSI (hSupportsANSIWithoutEmulation)
 import           System.Environment
 import           System.PosixCompat.Files (fileOwner, getFileStatus)
 import           System.PosixCompat.User (getEffectiveUserID)
+import           RIO.List (unzip)
 import           RIO.PrettyPrint (stylesUpdateL, useColorL)
 import           RIO.Process
 
@@ -503,12 +505,51 @@ loadBuildConfig = do
             { projectCompiler = mcompiler <|> projectCompiler project'
             , projectResolver = fromMaybe (projectResolver project') mresolver
             }
+    extraPackageDBs <- mapM resolveDir' (projectExtraPackageDBs project)
 
-    resolver <- completeSnapshotLocation $ projectResolver project
-    (snapshot, _completed) <- loadAndCompleteSnapshot resolver
+    wanted <- lockCachedWanted stackYamlFP (projectResolver project) $
+        fillProjectWanted stackYamlFP config project
 
-    extraPackageDBs <- mapM resolveDir' (projectExtraPackageDBs project)
+    return BuildConfig
+        { bcConfig = config
+        , bcSMWanted = wanted
+        , bcExtraPackageDBs = extraPackageDBs
+        , bcStackYaml = stackYamlFP
+        , bcCurator = projectCurator project
+        }
+  where
+    getEmptyProject :: Maybe RawSnapshotLocation -> [PackageIdentifierRevision] -> RIO Config Project
+    getEmptyProject mresolver extraDeps = do
+      r <- case mresolver of
+            Just resolver -> do
+                logInfo ("Using resolver: " <> display resolver <> " specified on command line")
+                return resolver
+            Nothing -> do
+                r'' <- getLatestResolver
+                logInfo ("Using latest snapshot resolver: " <> display r'')
+                return r''
+      return Project
+        { projectUserMsg = Nothing
+        , projectPackages = []
+        , projectDependencies = map (RPLImmutable . flip RPLIHackage Nothing) extraDeps
+        , projectFlags = mempty
+        , projectResolver = r
+        , projectCompiler = Nothing
+        , projectExtraPackageDBs = []
+        , projectCurator = Nothing
+        , projectDropPackages = mempty
+        }
 
+fillProjectWanted ::
+       (HasProcessContext env, HasLogFunc env, HasPantryConfig env)
+    => Path Abs t
+    -> Config
+    -> Project
+    -> Map RawPackageLocationImmutable PackageLocationImmutable
+    -> WantedCompiler
+    -> Map PackageName (Bool -> RIO env DepPackage)
+    -> RIO env (SMWanted, [CompletedPLI])
+fillProjectWanted stackYamlFP config project locCache snapCompiler snapPackages = do
     let bopts = configBuild config
 
     packages0 <- for (projectPackages project) $ \fp@(RelFilePath t) -> do
@@ -517,25 +558,27 @@ loadBuildConfig = do
       pp <- mkProjectPackage YesPrintWarnings resolved (boptsHaddock bopts)
       pure (cpName $ ppCommon pp, pp)
 
-    let completeLocation (RPLMutable m) = pure $ PLMutable m
-        completeLocation (RPLImmutable im) = PLImmutable <$> completePackageLocation im
-
-    deps0 <- forM (projectDependencies project) $ \rpl -> do
-      pl <- completeLocation rpl
+    (deps0, mcompleted) <- fmap unzip . forM (projectDependencies project) $ \rpl -> do
+      (pl, mCompleted) <- case rpl of
+         RPLImmutable rpli -> do
+           compl <- maybe (completePackageLocation rpli) pure (Map.lookup rpli locCache)
+           pure (PLImmutable compl, Just (rpli, compl))
+         RPLMutable p ->
+           pure (PLMutable p, Nothing)
       dp <- additionalDepPackage (shouldHaddockDeps bopts) pl
-      pure (cpName $ dpCommon dp, dp)
+      pure ((cpName $ dpCommon dp, dp), mCompleted)
 
     checkDuplicateNames $
       map (second (PLMutable . ppResolvedDir)) packages0 ++
       map (second dpLocation) deps0
 
     let packages1 = Map.fromList packages0
-        snPackages = snapshotPackages snapshot
+        snPackages = snapPackages
           `Map.difference` packages1
           `Map.difference` Map.fromList deps0
           `Map.withoutKeys` projectDropPackages project
 
-    snDeps <- Map.traverseWithKey (snapToDepPackage (shouldHaddockDeps bopts)) snPackages
+    snDeps <- for snPackages $ \getDep -> getDep (shouldHaddockDeps bopts)
 
     let deps1 = Map.fromList deps0 `Map.union` snDeps
 
@@ -561,41 +604,14 @@ loadBuildConfig = do
       throwM $ InvalidGhcOptionsSpecification (Map.keys unusedPkgGhcOptions)
 
     let wanted = SMWanted
-          { smwCompiler = fromMaybe (snapshotCompiler snapshot) (projectCompiler project)
+          { smwCompiler = fromMaybe snapCompiler (projectCompiler project)
           , smwProject = packages
           , smwDeps = deps
           , smwSnapshotLocation = projectResolver project
           }
 
-    return BuildConfig
-        { bcConfig = config
-        , bcSMWanted = wanted
-        , bcExtraPackageDBs = extraPackageDBs
-        , bcStackYaml = stackYamlFP
-        , bcCurator = projectCurator project
-        }
-  where
-    getEmptyProject :: Maybe RawSnapshotLocation -> [PackageIdentifierRevision] -> RIO Config Project
-    getEmptyProject mresolver extraDeps = do
-      r <- case mresolver of
-            Just resolver -> do
-                logInfo ("Using resolver: " <> display resolver <> " specified on command line")
-                return resolver
-            Nothing -> do
-                r'' <- getLatestResolver
-                logInfo ("Using latest snapshot resolver: " <> display r'')
-                return r''
-      return Project
-        { projectUserMsg = Nothing
-        , projectPackages = []
-        , projectDependencies = map (RPLImmutable . flip RPLIHackage Nothing) extraDeps
-        , projectFlags = mempty
-        , projectResolver = r
-        , projectCompiler = Nothing
-        , projectExtraPackageDBs = []
-        , projectCurator = Nothing
-        , projectDropPackages = mempty
-        }
+    pure (wanted, catMaybes mcompleted)
+
 
 -- | Check if there are any duplicate package names and, if so, throw an
 -- exception.

src/Stack/Freeze.hs

@@ -69,7 +69,7 @@ doFreeze p FreezeSnapshot = do
   case result of
     Left _wc ->
       logInfo "No freezing is required for compiler resolver"
-    Right (snap, _) -> do
+    Right snap -> do
       snap' <- completeSnapshotLayer snap
       let rawCompleted = toRawSnapshotLayer snap'
       if rawCompleted == snap