Merge PR #3893 (Implement `--index-state` aka index freezing)

This PR implements a new flag `--index-state` (and its `cabal.project`/config-file
equivalent `index-state: ...`) which allows to change the source package index
state the solver uses to compute install-plans. This is particularly useful in
combination with freeze-files in order to also freeze the state the package
index was in at the time the install-plan was frozen.

This provides the core functionality, on which future enhancements can build
upon. See also description of PR #3604 for some possible enhancements.

Cabal/doc/nix-local-build.rst

@@ -706,6 +706,29 @@ The following settings control the behavior of the dependency solver:
     The command line variant of this field is ``--allow-older=all``. A
     bare ``--allow-older`` is equivalent to ``--allow-older=all``.
 
+
+.. cfg-field:: index-state: HEAD, unix-timestamp, ISO8601 UTC timestamp.
+   :synopsis: Use source package index state as it existed at a previous time.
+   :since: 1.25
+
+   :default: ``HEAD``
+
+   This allows to change the source package index state the solver uses
+   to compute install-plans. This is particularly useful in
+   combination with freeze-files in order to also freeze the state the
+   package index was in at the time the install-plan was frozen.
+
+   ::
+
+      -- UNIX timestamp format example
+      index-state: @1474739268
+
+      -- ISO8601 UTC timestamp format example
+      -- This format is used by 'cabal new-configure'
+      -- for storing `--index-state` values.
+      index-state: 2016-09-24T17:47:48Z
+
+
 Package configuration options
 -----------------------------
 

cabal-install/Distribution/Client/Config.hs

@@ -249,6 +249,7 @@ instance Semigroup SavedConfig where
         installUpgradeDeps           = combine installUpgradeDeps,
         installOnly                  = combine installOnly,
         installOnlyDeps              = combine installOnlyDeps,
+        installIndexState            = combine installIndexState,
         installRootCmd               = combine installRootCmd,
         installSummaryFile           = lastNonEmptyNL installSummaryFile,
         installLogFile               = combine installLogFile,

cabal-install/Distribution/Client/IndexUtils.hs

@@ -24,12 +24,15 @@ module Distribution.Client.IndexUtils (
   getSourcePackages,
   getSourcePackagesMonitorFiles,
 
+  IndexState(..),
+  getSourcePackagesAtIndexState,
+
   Index(..),
   PackageEntry(..),
   parsePackageIndex,
   updateRepoIndexCache,
   updatePackageIndexCacheFile,
-  readCacheStrict,
+  readCacheStrict, -- only used by soon-to-be-obsolete sandbox code
 
   BuildTreeRefType(..), refTypeFromTypeCode, typeCodeFromRefType
   ) where
@@ -82,10 +85,11 @@ import Data.List   (isPrefixOf)
 import Data.Word
 #if !MIN_VERSION_base(4,8,0)
 import Data.Monoid (Monoid(..))
+import Control.Applicative
 #endif
 import qualified Data.Map as Map
 import Control.DeepSeq
-import Control.Monad (when, liftM)
+import Control.Monad
 import Control.Exception
 import qualified Data.ByteString.Lazy as BS
 import qualified Data.ByteString.Lazy.Char8 as BS.Char8
@@ -139,6 +143,48 @@ indexBaseName repo = repoLocalDir repo </> fn
 -- Reading the source package index
 --
 
+-- Note: 'data IndexState' is defined in
+-- "Distribution.Client.IndexUtils.Timestamp" to avoid import cycles
+
+-- | 'IndexStateInfo' contains meta-information about the resulting
+-- filtered 'Cache' 'after applying 'filterCache' according to a
+-- requested 'IndexState'.
+data IndexStateInfo = IndexStateInfo
+    { isiMaxTime  :: !Timestamp
+    -- ^ 'Timestamp' of maximum/latest 'Timestamp' in the current
+    -- filtered view of the cache.
+    --
+    -- The following property holds
+    --
+    -- > filterCache (IndexState (isiMaxTime isi)) cache == (cache, isi)
+    --
+
+    , isiHeadTime :: !Timestamp
+    -- ^ 'Timestamp' equivalent to 'IndexStateHead', i.e. the latest
+    -- known 'Timestamp'; 'isiHeadTime' is always greater or equal to
+    -- 'isiMaxTime'.
+    }
+
+emptyStateInfo :: IndexStateInfo
+emptyStateInfo = IndexStateInfo nullTimestamp nullTimestamp
+
+-- | Filters a 'Cache' according to an 'IndexState'
+-- specification. Also returns 'IndexStateInfo' describing the
+-- resulting index cache.
+--
+-- Note: 'filterCache' is idempotent in the 'Cache' value
+filterCache :: IndexState -> Cache -> (Cache, IndexStateInfo)
+filterCache IndexStateHead cache = (cache, IndexStateInfo{..})
+  where
+    isiMaxTime  = cacheHeadTs cache
+    isiHeadTime = cacheHeadTs cache
+filterCache (IndexStateTime ts0) cache0 = (cache, IndexStateInfo{..})
+  where
+    cache = Cache { cacheEntries = ents, cacheHeadTs = isiMaxTime }
+    isiHeadTime = cacheHeadTs cache0
+    isiMaxTime  = maximumTimestamp (map cacheEntryTimestamp ents)
+    ents = filter ((<= ts0) . cacheEntryTimestamp) (cacheEntries cache0)
+
 -- | Read a repository index from disk, from the local files specified by
 -- a list of 'Repo's.
 --
@@ -147,16 +193,67 @@ indexBaseName repo = repoLocalDir repo </> fn
 --
 -- This is a higher level wrapper used internally in cabal-install.
 getSourcePackages :: Verbosity -> RepoContext -> IO SourcePackageDb
-getSourcePackages verbosity repoCtxt | null (repoContextRepos repoCtxt) = do
-  warn verbosity $ "No remote package servers have been specified. Usually "
-                ++ "you would have one specified in the config file."
-  return SourcePackageDb {
-    packageIndex       = mempty,
-    packagePreferences = mempty
-  }
-getSourcePackages verbosity repoCtxt = do
-  info verbosity "Reading available packages..."
-  pkgss <- mapM (\r -> readRepoIndex verbosity repoCtxt r) (repoContextRepos repoCtxt)
+getSourcePackages verbosity repoCtxt =
+    getSourcePackagesAtIndexState verbosity repoCtxt IndexStateHead
+
+-- | Variant of 'getSourcePackages' which allows getting the source
+-- packages at a particular 'IndexState'.
+--
+-- Current choices are either the latest (aka HEAD), or the index as
+-- it was at a particular time.
+--
+-- TODO: Enhance to allow specifying per-repo 'IndexState's and also
+-- report back per-repo 'IndexStateInfo's (in order for @new-freeze@
+-- to access it)
+getSourcePackagesAtIndexState :: Verbosity -> RepoContext -> IndexState
+                           -> IO SourcePackageDb
+getSourcePackagesAtIndexState verbosity repoCtxt _
+  | null (repoContextRepos repoCtxt) = do
+      warn verbosity $ "No remote package servers have been specified. Usually "
+                       ++ "you would have one specified in the config file."
+      return SourcePackageDb {
+        packageIndex       = mempty,
+        packagePreferences = mempty
+      }
+getSourcePackagesAtIndexState verbosity repoCtxt idxState = do
+  case idxState of
+      IndexStateHead      -> info verbosity "Reading available packages..."
+      IndexStateTime time ->
+          info verbosity ("Reading available packages (for index-state as of "
+                          ++ display time ++ ")...")
+
+  pkgss <- forM (repoContextRepos repoCtxt) $ \r -> do
+      let rname = maybe "" remoteRepoName $ maybeRepoRemote r
+      unless (idxState == IndexStateHead) $
+          case r of
+            RepoLocal path -> warn verbosity ("index-state ignored for old-format repositories (local repository '" ++ path ++ "')")
+            RepoRemote {} -> warn verbosity ("index-state ignored for old-format (remote repository '" ++ rname ++ "')")
+            RepoSecure {} -> pure ()
+
+
+      let idxState' = case r of
+            RepoSecure {} -> idxState
+            _             -> IndexStateHead
+
+      (pis,deps,isi) <- readRepoIndex verbosity repoCtxt r idxState'
+
+      case idxState' of
+        IndexStateHead -> do
+            info verbosity ("index-state("++rname++") = " ++
+                              display (isiHeadTime isi))
+            return ()
+        IndexStateTime ts0 -> do
+            when (isiMaxTime isi /= ts0) $
+                warn verbosity ("Requested index-state " ++ display ts0
+                                ++ " does not exist in '"++rname++"'!"
+                                ++ " Falling back to older state ("
+                                ++ display (isiMaxTime isi) ++ ").")
+            info verbosity ("index-state("++rname++") = " ++
+                              display (isiMaxTime isi) ++ " (HEAD = " ++
+                              display (isiHeadTime isi) ++ ")")
+
+      pure (pis,deps)
+
   let (pkgs, prefs) = mconcat pkgss
       prefs' = Map.fromListWith intersectVersionRanges
                  [ (name, range) | Dependency name range <- prefs ]
@@ -181,14 +278,15 @@ readCacheStrict verbosity index mkPkg = do
 --
 -- This is a higher level wrapper used internally in cabal-install.
 --
-readRepoIndex :: Verbosity -> RepoContext -> Repo
-              -> IO (PackageIndex UnresolvedSourcePackage, [Dependency])
-readRepoIndex verbosity repoCtxt repo =
+readRepoIndex :: Verbosity -> RepoContext -> Repo -> IndexState
+              -> IO (PackageIndex UnresolvedSourcePackage, [Dependency], IndexStateInfo)
+readRepoIndex verbosity repoCtxt repo idxState =
   handleNotFound $ do
     warnIfIndexIsOld =<< getIndexFileAge repo
     updateRepoIndexCache verbosity (RepoIndex repoCtxt repo)
     readPackageIndexCacheFile verbosity mkAvailablePackage
                               (RepoIndex repoCtxt repo)
+                              idxState
 
   where
     mkAvailablePackage pkgEntry =
@@ -213,7 +311,7 @@ readRepoIndex verbosity repoCtxt repo =
           RepoLocal{..}  -> warn verbosity $
                "The package list for the local repo '" ++ repoLocalDir
             ++ "' is missing. The repo is invalid."
-        return mempty
+        return (mempty,mempty,emptyStateInfo)
       else ioError e
 
     isOldThreshold = 15 --days
@@ -445,10 +543,15 @@ is01Index (SandboxIndex _)   = False
 
 updatePackageIndexCacheFile :: Verbosity -> Index -> IO ()
 updatePackageIndexCacheFile verbosity index = do
-    info verbosity ("Updating index cache file " ++ cacheFile index)
+    info verbosity ("Updating index cache file " ++ cacheFile index ++ " ...")
     withIndexEntries index $ \entries -> do
-      let cache = Cache { cacheEntries = entries }
+      let !maxTs = maximumTimestamp (map cacheEntryTimestamp entries)
+          cache = Cache { cacheHeadTs  = maxTs
+                        , cacheEntries = entries
+                        }
       writeIndexCache index cache
+      info verbosity ("Index cache updated to index-state "
+                      ++ display (cacheHeadTs cache))
 
 -- | Read the index (for the purpose of building a cache)
 --
@@ -516,11 +619,15 @@ readPackageIndexCacheFile :: Package pkg
                           => Verbosity
                           -> (PackageEntry -> pkg)
                           -> Index
-                          -> IO (PackageIndex pkg, [Dependency])
-readPackageIndexCacheFile verbosity mkPkg index = do
-  cache    <- readIndexCache verbosity index
-  indexHnd <- openFile (indexFile index) ReadMode
-  packageIndexFromCache mkPkg indexHnd cache ReadPackageIndexLazyIO
+                          -> IndexState
+                          -> IO (PackageIndex pkg, [Dependency], IndexStateInfo)
+readPackageIndexCacheFile verbosity mkPkg index idxState = do
+    cache0    <- readIndexCache verbosity index
+    indexHnd <- openFile (indexFile index) ReadMode
+    let (cache,isi) = filterCache idxState cache0
+    (pkgs,deps) <- packageIndexFromCache mkPkg indexHnd cache ReadPackageIndexLazyIO
+    pure (pkgs,deps,isi)
+
 
 packageIndexFromCache :: Package pkg
                       => (PackageEntry -> pkg)
@@ -642,9 +749,14 @@ writeIndexCache index cache
   | otherwise       = writeFile (cacheFile index) (show00IndexCache cache)
 
 -- | Cabal caches various information about the Hackage index
-data Cache = Cache {
-    cacheEntries :: [IndexCacheEntry]
-  }
+data Cache = Cache
+    { cacheHeadTs  :: Timestamp
+      -- ^ maximum/latest 'Timestamp' among 'cacheEntries'; unless the
+      -- invariant of 'cacheEntries' being in chronological order is
+      -- violated, this corresponds to the last (seen) 'Timestamp' in
+      -- 'cacheEntries'
+    , cacheEntries :: [IndexCacheEntry]
+    }
 
 instance NFData Cache where
     rnf = rnf . cacheEntries
@@ -667,24 +779,30 @@ instance NFData IndexCacheEntry where
     rnf (CachePreference dep _ _) = rnf dep
     rnf (CacheBuildTreeRef _ _) = ()
 
+cacheEntryTimestamp :: IndexCacheEntry -> Timestamp
+cacheEntryTimestamp (CacheBuildTreeRef _ _)  = nullTimestamp
+cacheEntryTimestamp (CachePreference _ _ ts) = ts
+cacheEntryTimestamp (CachePackageId _ _ ts)  = ts
+
 ----------------------------------------------------------------------------
 -- new binary 01-index.cache format
 
 instance Binary Cache where
-    put (Cache ents) = do
+    put (Cache headTs ents) = do
         -- magic / format version
         --
         -- NB: this currently encodes word-size implicitly; when we
         -- switch to CBOR encoding, we will have a platform
         -- independent binary encoding
-        put (0xcaba1001::Word)
+        put (0xcaba1002::Word)
+        put headTs
         put ents
 
     get = do
         magic <- get
-        when (magic /= (0xcaba1001::Word)) $
+        when (magic /= (0xcaba1002::Word)) $
             fail ("01-index.cache: unexpected magic marker encountered: " ++ show magic)
-        liftM Cache get
+        Cache <$> get <*> get
 
 instance Binary IndexCacheEntry
 
@@ -699,8 +817,9 @@ preferredVersionKey = "pref-ver:"
 
 -- legacy 00-index.cache format
 read00IndexCache :: BSS.ByteString -> Cache
-read00IndexCache bs = Cache {
-    cacheEntries = mapMaybe read00IndexCacheEntry $ BSS.lines bs
+read00IndexCache bs = Cache
+  { cacheHeadTs  = nullTimestamp
+  , cacheEntries = mapMaybe read00IndexCacheEntry $ BSS.lines bs
   }
 
 read00IndexCacheEntry :: BSS.ByteString -> Maybe IndexCacheEntry

cabal-install/Distribution/Client/IndexUtils/Timestamp.hs

+{-# LANGUAGE DeriveGeneric #-}
 {-# LANGUAGE GeneralizedNewtypeDeriving #-}
 {-# LANGUAGE RecordWildCards #-}
 
@@ -15,6 +16,9 @@ module Distribution.Client.IndexUtils.Timestamp
     , epochTimeToTimestamp
     , timestampToUTCTime
     , utcTimeToTimestamp
+    , maximumTimestamp
+
+    , IndexState(..)
     ) where
 
 import qualified Codec.Archive.Tar.Entry    as Tar
@@ -31,6 +35,7 @@ import           Distribution.Compat.Binary
 import qualified Distribution.Compat.ReadP  as ReadP
 import           Distribution.Text
 import qualified Text.PrettyPrint           as Disp
+import           GHC.Generics (Generic)
 
 -- | UNIX timestamp (expressed in seconds since unix epoch, i.e. 1970).
 newtype Timestamp = TS Int64 -- Tar.EpochTime
@@ -58,7 +63,16 @@ utcTimeToTimestamp utct
     t :: Integer
     t = round . utcTimeToPOSIXSeconds $ utct
 
-
+-- | Compute the maximum 'Timestamp' value
+--
+-- Returns 'nullTimestamp' for the empty list.  Also note that
+-- 'nullTimestamp' compares as smaller to all non-'nullTimestamp'
+-- values.
+maximumTimestamp :: [Timestamp] -> Timestamp
+maximumTimestamp [] = nullTimestamp
+maximumTimestamp xs@(_:_) = maximum xs
+
+-- returns 'Nothing' if not representable as 'Timestamp'
 posixSecondsToTimestamp :: Integer -> Maybe Timestamp
 posixSecondsToTimestamp pt
   | minTs <= pt, pt <= maxTs  = Just (TS (fromInteger pt))
@@ -152,3 +166,27 @@ instance Text Timestamp where
 -- missing/unknown/invalid
 nullTimestamp :: Timestamp
 nullTimestamp = TS minBound
+
+----------------------------------------------------------------------------
+-- defined here for now to avoid import cycles
+
+-- | Specification of the state of a specific repo package index
+data IndexState = IndexStateHead -- ^ Use all available entries
+                | IndexStateTime !Timestamp -- ^ Use all entries that existed at
+                                            -- the specified time
+                deriving (Eq,Generic,Show)
+
+instance Binary IndexState
+instance NFData IndexState
+
+instance Text IndexState where
+    disp IndexStateHead = Disp.text "HEAD"
+    disp (IndexStateTime ts) = disp ts
+
+    parse = parseHead ReadP.+++ parseTime
+      where
+        parseHead = do
+            _ <- ReadP.string "HEAD"
+            return IndexStateHead
+
+        parseTime = IndexStateTime `fmap` parse

cabal-install/Distribution/Client/Install.hs

@@ -80,7 +80,7 @@ import Distribution.Client.HttpUtils
 import Distribution.Solver.Types.PackageFixedDeps
 import qualified Distribution.Client.Haddock as Haddock (regenerateHaddockIndex)
 import Distribution.Client.IndexUtils as IndexUtils
-         ( getSourcePackages, getInstalledPackages )
+         ( getSourcePackagesAtIndexState, IndexState(..), getInstalledPackages )
 import qualified Distribution.Client.InstallPlan as InstallPlan
 import qualified Distribution.Client.SolverInstallPlan as SolverInstallPlan
 import Distribution.Client.InstallPlan (InstallPlan)
@@ -277,10 +277,13 @@ makeInstallContext :: Verbosity -> InstallArgs -> Maybe [UserTarget]
                       -> IO InstallContext
 makeInstallContext verbosity
   (packageDBs, repoCtxt, comp, _, progdb,_,_,
-   globalFlags, _, configExFlags, _, _) mUserTargets = do
+   globalFlags, _, configExFlags, installFlags, _) mUserTargets = do
+
+    let idxState = fromFlagOrDefault IndexStateHead $
+                       installIndexState installFlags
 
     installedPkgIndex <- getInstalledPackages verbosity comp packageDBs progdb
-    sourcePkgDb       <- getSourcePackages    verbosity repoCtxt
+    sourcePkgDb       <- getSourcePackagesAtIndexState verbosity repoCtxt idxState
     pkgConfigDb       <- readPkgConfigDb      verbosity progdb
 
     checkConfigExFlags verbosity installedPkgIndex

cabal-install/Distribution/Client/ProjectConfig.hs

@@ -58,6 +58,8 @@ import Distribution.Client.BuildReports.Types
          ( ReportLevel(..) )
 import Distribution.Client.Config
          ( loadConfig, defaultConfigFile )
+import Distribution.Client.IndexUtils.Timestamp
+         ( IndexState(..) )
 
 import Distribution.Solver.Types.SourcePackage
 import Distribution.Solver.Types.Settings
@@ -202,6 +204,7 @@ resolveSolverSettings ProjectConfig{
     solverSettingReorderGoals      = fromFlag projectConfigReorderGoals
     solverSettingCountConflicts    = fromFlag projectConfigCountConflicts
     solverSettingStrongFlags       = fromFlag projectConfigStrongFlags
+    solverSettingIndexState        = fromFlagOrDefault IndexStateHead projectConfigIndexState
   --solverSettingIndependentGoals  = fromFlag projectConfigIndependentGoals
   --solverSettingShadowPkgs        = fromFlag projectConfigShadowPkgs
   --solverSettingReinstall         = fromFlag projectConfigReinstall

cabal-install/Distribution/Client/ProjectConfig/Legacy.hs

@@ -302,6 +302,7 @@ convertLegacyAllPackageFlags globalFlags configFlags
     --installReinstall          = projectConfigReinstall,
     --installAvoidReinstalls    = projectConfigAvoidReinstalls,
     --installOverrideReinstall  = projectConfigOverrideReinstall,
+      installIndexState         = projectConfigIndexState,
       installMaxBackjumps       = projectConfigMaxBackjumps,
     --installUpgradeDeps        = projectConfigUpgradeDeps,
       installReorderGoals       = projectConfigReorderGoals,
@@ -505,6 +506,7 @@ convertToLegacySharedConfig
       installStrongFlags       = projectConfigStrongFlags,
       installOnly              = mempty,
       installOnlyDeps          = projectConfigOnlyDeps,
+      installIndexState        = projectConfigIndexState,
       installRootCmd           = mempty, --no longer supported
       installSummaryFile       = projectConfigSummaryFile,
       installLogFile           = projectConfigLogFile,
@@ -848,6 +850,7 @@ legacySharedConfigFieldDescrs =
       , "one-shot", "jobs", "keep-going", "offline"
         -- solver flags:
       , "max-backjumps", "reorder-goals", "count-conflicts", "strong-flags"
+      , "index-state"
       ]
   . commandOptionsToFields
   ) (installOptions ParseArgs)

cabal-install/Distribution/Client/ProjectConfig/Types.hs

@@ -29,6 +29,9 @@ import Distribution.Client.Targets
 import Distribution.Client.BuildReports.Types
          ( ReportLevel(..) )
 
+import Distribution.Client.IndexUtils.Timestamp
+         ( IndexState )
+
 import Distribution.Solver.Types.Settings
 import Distribution.Solver.Types.ConstraintSource
 
@@ -164,6 +167,7 @@ data ProjectConfigShared
        -- configuration used both by the solver and other phases
        projectConfigRemoteRepos       :: NubList RemoteRepo,     -- ^ Available Hackage servers.
        projectConfigLocalRepos        :: NubList FilePath,
+       projectConfigIndexState        :: Flag IndexState,
 
        -- solver configuration
        projectConfigConstraints       :: [(UserConstraint, ConstraintSource)],
@@ -347,7 +351,8 @@ data SolverSettings
        solverSettingMaxBackjumps      :: Maybe Int,
        solverSettingReorderGoals      :: ReorderGoals,
        solverSettingCountConflicts    :: CountConflicts,
-       solverSettingStrongFlags       :: StrongFlags
+       solverSettingStrongFlags       :: StrongFlags,
+       solverSettingIndexState        :: IndexState
        -- Things that only make sense for manual mode, not --local mode
        -- too much control!
      --solverSettingIndependentGoals  :: Bool,

cabal-install/Distribution/Client/ProjectPlanning.hs

@@ -480,8 +480,9 @@ rebuildInstallPlan verbosity
           installedPkgIndex <- getInstalledPackages verbosity
                                                     compiler progdb platform
                                                     corePackageDbs
-          sourcePkgDb       <- getSourcePackages    verbosity withRepoCtx
-          pkgConfigDB       <- getPkgConfigDb      verbosity progdb
+          sourcePkgDb       <- getSourcePackages verbosity withRepoCtx
+                                 (solverSettingIndexState solverSettings)
+          pkgConfigDB       <- getPkgConfigDb verbosity progdb
 
           --TODO: [code cleanup] it'd be better if the Compiler contained the
           -- ConfiguredPrograms that it needs, rather than relying on the progdb
@@ -688,12 +689,13 @@ getExecutableDBContents storeDirectory = do
     valid _ = True
 
 getSourcePackages :: Verbosity -> (forall a. (RepoContext -> IO a) -> IO a)
-                  -> Rebuild SourcePackageDb
-getSourcePackages verbosity withRepoCtx = do
+                  -> IndexUtils.IndexState -> Rebuild SourcePackageDb
+getSourcePackages verbosity withRepoCtx idxState = do
     (sourcePkgDb, repos) <-
       liftIO $
         withRepoCtx $ \repoctx -> do
-          sourcePkgDb <- IndexUtils.getSourcePackages verbosity repoctx
+          sourcePkgDb <- IndexUtils.getSourcePackagesAtIndexState verbosity
+                                                                  repoctx idxState
           return (sourcePkgDb, repoContextRepos repoctx)
 
     monitorFiles . map monitorFile

cabal-install/Distribution/Client/Setup.hs

@@ -61,6 +61,10 @@ import Distribution.Client.BuildReports.Types
          ( ReportLevel(..) )
 import Distribution.Client.Dependency.Types
          ( PreSolver(..) )
+
+import Distribution.Client.IndexUtils.Timestamp
+         ( IndexState )
+
 import qualified Distribution.Client.Init.Types as IT
          ( InitFlags(..), PackageType(..) )
 import Distribution.Client.Targets
@@ -1219,6 +1223,7 @@ data InstallFlags = InstallFlags {
     installUpgradeDeps      :: Flag Bool,
     installOnly             :: Flag Bool,
     installOnlyDeps         :: Flag Bool,
+    installIndexState       :: Flag IndexState,
     installRootCmd          :: Flag String,
     installSummaryFile      :: NubList PathTemplate,
     installLogFile          :: Flag PathTemplate,
@@ -1252,6 +1257,7 @@ defaultInstallFlags = InstallFlags {
     installUpgradeDeps     = Flag False,
     installOnly            = Flag False,
     installOnlyDeps        = Flag False,
+    installIndexState      = mempty,
     installRootCmd         = mempty,
     installSummaryFile     = mempty,
     installLogFile         = mempty,
@@ -1424,6 +1430,18 @@ installOptions showOrParseArgs =
           installOnlyDeps (\v flags -> flags { installOnlyDeps = v })
           (yesNoOpt showOrParseArgs)
 
+      , option [] ["index-state"]
+          ("Use source package index state as it existed at a previous time. " ++
+           "Accepts unix-timestamps (e.g. '@1474732068'), ISO8601 UTC timestamps " ++
+           "(e.g. '2016-09-24T17:47:48Z'), or 'HEAD' (default: 'HEAD').")
+          installIndexState (\v flags -> flags { installIndexState = v })
+          (reqArg "STATE" (readP_to_E (const $ "index-state must be a  " ++
+                                       "unix-timestamps (e.g. '@1474732068'), " ++
+                                       "a ISO8601 UTC timestamp " ++
+                                       "(e.g. '2016-09-24T17:47:48Z'), or 'HEAD'")
+                                      (toFlag `fmap` parse))
+                          (flagToList . fmap display))
+
       , option [] ["root-cmd"]
           "(No longer supported, do not use.)"
           installRootCmd (\v flags -> flags { installRootCmd = v })

cabal-install/tests/UnitTests/Distribution/Client/ArbitraryInstances.hs

@@ -30,6 +30,8 @@ import Distribution.Simple.InstallDirs
 
 import Distribution.Utils.NubList
 
+import Distribution.Client.IndexUtils.Timestamp
+
 import Test.QuickCheck
 
 
@@ -172,3 +174,10 @@ instance Arbitrary a => Arbitrary (NoShrink a) where
     arbitrary = NoShrink <$> arbitrary
     shrink _  = []
 
+instance Arbitrary Timestamp where
+    arbitrary = (maybe (toEnum 0) id . epochTimeToTimestamp) <$> arbitrary
+
+instance Arbitrary IndexState where
+    arbitrary = frequency [ (1, pure IndexStateHead)
+                          , (50, IndexStateTime <$> arbitrary)
+                          ]

cabal-install/tests/UnitTests/Distribution/Client/ProjectConfig.hs

@@ -344,6 +344,7 @@ instance Arbitrary ProjectConfigShared where
         <*> arbitrary
         <*> arbitrary
         <*> (toNubList <$> listOf arbitraryShortToken)
+        <*> arbitrary
         <*> arbitraryConstraints
         <*> shortListOf 2 arbitrary
         <*> arbitrary <*> arbitrary
@@ -358,19 +359,21 @@ instance Arbitrary ProjectConfigShared where
     shrink (ProjectConfigShared
               x00 x01 x02 x03 x04
               x05 x06 x07 x08 x09
-              x10 x11 x12 x13 x14 x15) =
+              x10 x11 x12 x13 x14
+              x15 x16) =
       [ ProjectConfigShared
           x00' (fmap getNonEmpty x01') (fmap getNonEmpty x02') x03' x04'
-          x05' (postShrink_Constraints x06') x07' x08' x09'
-          x10' x11' x12' x13' x14' x15'
+          x05'