Opt-in on requiring the Hackage index be present

src/Stack/Build/ConstructPlan.hs

@@ -422,7 +422,7 @@ addDep name = do
                             -- names. This code does not feel right.
                             let version = installedVersion installed
                                 askPkgLoc = liftRIO $ do
-                                  mrev <- getLatestHackageRevision name version
+                                  mrev <- getLatestHackageRevision YesRequireHackageIndex name version
                                   case mrev of
                                     Nothing -> do
                                       -- this could happen for GHC boot libraries missing from Hackage
@@ -658,7 +658,7 @@ addPackageDeps package = do
         eres <- addDep depname
         let getLatestApplicableVersionAndRev :: M (Maybe (Version, BlobKey))
             getLatestApplicableVersionAndRev = do
-              vsAndRevs <- runRIO ctx $ getHackagePackageVersions UsePreferredVersions depname
+              vsAndRevs <- runRIO ctx $ getHackagePackageVersions YesRequireHackageIndex UsePreferredVersions depname
               pure $ do
                 lappVer <- latestApplicableVersion range $ Map.keysSet vsAndRevs
                 revs <- Map.lookup lappVer vsAndRevs

src/Stack/Build/Target.hs

@@ -343,7 +343,7 @@ resolveRawTarget sma allLocs (ri, rt) =
               ]
             -- Not present at all, add it from Hackage
             Nothing -> do
-              mrev <- getLatestHackageRevision name version
+              mrev <- getLatestHackageRevision YesRequireHackageIndex name version
               pure $ case mrev of
                 Nothing -> deferToConstructPlan name
                 Just (_rev, cfKey, treeKey) -> Right ResolveResult
@@ -355,7 +355,7 @@ resolveRawTarget sma allLocs (ri, rt) =
                   }
 
     hackageLatest name = do
-        mloc <- getLatestHackageLocation name UsePreferredVersions
+        mloc <- getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions
         pure $ case mloc of
           Nothing -> deferToConstructPlan name
           Just loc -> do
@@ -368,7 +368,7 @@ resolveRawTarget sma allLocs (ri, rt) =
                   }
 
     hackageLatestRevision name version = do
-        mrev <- getLatestHackageRevision name version
+        mrev <- getLatestHackageRevision YesRequireHackageIndex name version
         pure $ case mrev of
           Nothing -> deferToConstructPlan name
           Just (_rev, cfKey, treeKey) -> Right ResolveResult

src/Stack/Hoogle.hs

@@ -78,7 +78,7 @@ hoogleCmd (args,setup,rebuild,startServer) =
     installHoogle :: RIO EnvConfig ()
     installHoogle = do
         hooglePackageIdentifier <- do
-          mversion <- getLatestHackageVersion hooglePackageName UsePreferredVersions
+          mversion <- getLatestHackageVersion YesRequireHackageIndex hooglePackageName UsePreferredVersions
 
           -- FIXME For a while, we've been following the logic of
           -- taking the latest Hoogle version available. However, we

src/Stack/Runners.hs

@@ -187,7 +187,7 @@ shouldUpgradeCheck = do
     let yesterday = addUTCTime (-24 * 60 * 60) now
     checks <- upgradeChecksSince yesterday
     when (checks == 0) $ do
-      mversion <- getLatestHackageVersion "stack" UsePreferredVersions -- FIXME ensure it doesn't force an update ever
+      mversion <- getLatestHackageVersion NoRequireHackageIndex "stack" UsePreferredVersions
       case mversion of
         Just (PackageIdentifierRevision _ version _) | version > mkVersion' Paths_stack.version -> do
           logWarn "<<<<<<<<<<<<<<<<<<"

src/Stack/Unpack.hs

@@ -69,14 +69,14 @@ unpackPackages mSnapshot dest input = do
 
     toLocNoSnapshot :: PackageName -> RIO env (Either String (PackageLocationImmutable, PackageIdentifier))
     toLocNoSnapshot name = do
-      mloc1 <- getLatestHackageLocation name UsePreferredVersions
+      mloc1 <- getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions
       mloc <-
         case mloc1 of
           Just _ -> pure mloc1
           Nothing -> do
             updated <- updateHackageIndex $ Just $ "Could not find package " <> fromString (packageNameString name) <> ", updating"
             case updated of
-              UpdateOccurred -> getLatestHackageLocation name UsePreferredVersions
+              UpdateOccurred -> getLatestHackageLocation YesRequireHackageIndex name UsePreferredVersions
               NoUpdateOccurred -> pure Nothing
       case mloc of
         Nothing -> do

src/Stack/Upgrade.hs

@@ -210,7 +210,7 @@ sourceUpgrade builtHash (SourceOpts gitRepo) =
       Nothing -> withConfig NoReexec $ do
         void $ updateHackageIndex
              $ Just "Updating index to make sure we find the latest Stack version"
-        mversion <- getLatestHackageVersion "stack" UsePreferredVersions
+        mversion <- getLatestHackageVersion YesRequireHackageIndex "stack" UsePreferredVersions
         (PackageIdentifierRevision _ version _) <-
           case mversion of
             Nothing -> throwString "No stack found in package indices"
@@ -223,7 +223,7 @@ sourceUpgrade builtHash (SourceOpts gitRepo) =
             else do
                 suffix <- parseRelDir $ "stack-" ++ versionString version
                 let dir = tmp </> suffix
-                mrev <- getLatestHackageRevision "stack" version
+                mrev <- getLatestHackageRevision YesRequireHackageIndex "stack" version
                 case mrev of
                   Nothing -> throwString "Latest version with no revision"
                   Just (_rev, cfKey, treeKey) -> do

subs/curator/src/Curator/Snapshot.hs

@@ -75,7 +75,7 @@ toLoc
 toLoc name pc =
   case pcSource pc of
     PSHackage (HackageSource mrange mrequiredLatest revisions) -> do
-      versions <- getHackagePackageVersions IgnorePreferredVersions name -- don't follow the preferred versions on Hackage, give curators more control
+      versions <- getHackagePackageVersions YesRequireHackageIndex IgnorePreferredVersions name -- don't follow the preferred versions on Hackage, give curators more control
       when (Map.null versions) $ error $ "Package not found on Hackage: " ++ packageNameString name
       for_ mrequiredLatest $ \required ->
         case Map.maxViewWithKey versions of

subs/pantry/src/Pantry.hs

@@ -154,6 +154,7 @@ module Pantry
     -- * Hackage index
   , updateHackageIndex
   , DidUpdateOccur (..)
+  , RequireHackageIndex (..)
   , hackageIndexTarballL
   , getHackagePackageVersions
   , getLatestHackageVersion
@@ -267,11 +268,12 @@ defaultHackageSecurityConfig = HackageSecurityConfig
 -- @since 0.1.0.0
 getLatestHackageVersion
   :: (HasPantryConfig env, HasLogFunc env)
-  => PackageName -- ^ package name
+  => RequireHackageIndex
+  -> PackageName -- ^ package name
   -> UsePreferredVersions
   -> RIO env (Maybe PackageIdentifierRevision)
-getLatestHackageVersion name preferred =
-  ((fmap fst . Map.maxViewWithKey) >=> go) <$> getHackagePackageVersions preferred name
+getLatestHackageVersion req name preferred =
+  ((fmap fst . Map.maxViewWithKey) >=> go) <$> getHackagePackageVersions req preferred name
   where
     go (version, m) = do
       (_rev, BlobKey sha size) <- fst <$> Map.maxViewWithKey m
@@ -283,12 +285,13 @@ getLatestHackageVersion name preferred =
 -- @since 0.1.0.0
 getLatestHackageLocation
   :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
-  => PackageName -- ^ package name
+  => RequireHackageIndex
+  -> PackageName -- ^ package name
   -> UsePreferredVersions
   -> RIO env (Maybe PackageLocationImmutable)
-getLatestHackageLocation name preferred = do
+getLatestHackageLocation req name preferred = do
   mversion <-
-    fmap fst . Map.maxViewWithKey <$> getHackagePackageVersions preferred name
+    fmap fst . Map.maxViewWithKey <$> getHackagePackageVersions req preferred name
   let mVerCfKey = do
         (version, revisions) <- mversion
         (_rev, cfKey) <- fst <$> Map.maxViewWithKey revisions
@@ -305,11 +308,12 @@ getLatestHackageLocation name preferred = do
 -- @since 0.1.0.0
 getLatestHackageRevision
   :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)
-  => PackageName -- ^ package name
+  => RequireHackageIndex
+  -> PackageName -- ^ package name
   -> Version
   -> RIO env (Maybe (Revision, BlobKey, TreeKey))
-getLatestHackageRevision name version = do
-  revisions <- getHackagePackageVersionRevisions name version
+getLatestHackageRevision req name version = do
+  revisions <- getHackagePackageVersionRevisions req name version
   case fmap fst $ Map.maxViewWithKey revisions of
     Nothing -> pure Nothing
     Just (revision, cfKey@(BlobKey sha size)) -> do

subs/pantry/src/Pantry/Hackage.hs

@@ -5,6 +5,7 @@
 module Pantry.Hackage
   ( updateHackageIndex
   , DidUpdateOccur (..)
+  , RequireHackageIndex (..)
   , hackageIndexTarballL
   , getHackageTarball
   , getHackageTarballKey
@@ -335,7 +336,7 @@ fuzzyLookupCandidates
   -> Version
   -> RIO env FuzzyResults
 fuzzyLookupCandidates name ver0 = do
-  m <- getHackagePackageVersions UsePreferredVersions name
+  m <- getHackagePackageVersions YesRequireHackageIndex UsePreferredVersions name
   if Map.null m
     then FRNameNotFound <$> getHackageTypoCorrections name
     else
@@ -390,18 +391,37 @@ getHackageTypoCorrections name1 =
 data UsePreferredVersions = UsePreferredVersions | IgnorePreferredVersions
   deriving Show
 
+-- | Require that the Hackage index is populated.
+--
+-- @since 0.1.0.0
+data RequireHackageIndex
+  = YesRequireHackageIndex
+    -- ^ If there is nothing in the Hackage index, then perform an update
+  | NoRequireHackageIndex
+    -- ^ Do not perform an update
+  deriving Show
+
+initializeIndex
+  :: (HasPantryConfig env, HasLogFunc env)
+  => RequireHackageIndex
+  -> RIO env ()
+initializeIndex NoRequireHackageIndex = pure ()
+initializeIndex YesRequireHackageIndex = do
+  cabalCount <- withStorage countHackageCabals
+  when (cabalCount == 0) $ void $
+    updateHackageIndex $ Just $ "No information from Hackage index, updating"
+
 -- | Returns the versions of the package available on Hackage.
 --
 -- @since 0.1.0.0
 getHackagePackageVersions
   :: (HasPantryConfig env, HasLogFunc env)
-  => UsePreferredVersions
+  => RequireHackageIndex
+  -> UsePreferredVersions
   -> PackageName -- ^ package name
   -> RIO env (Map Version (Map Revision BlobKey))
-getHackagePackageVersions usePreferred name = do
-  cabalCount <- withStorage countHackageCabals
-  when (cabalCount == 0) $ void $
-    updateHackageIndex $ Just $ "No information from Hackage index, updating"
+getHackagePackageVersions req usePreferred name = do
+  initializeIndex req
   withStorage $ do
     mpreferred <-
       case usePreferred of
@@ -420,13 +440,12 @@ getHackagePackageVersions usePreferred name = do
 -- @since 0.1.0.0
 getHackagePackageVersionRevisions
   :: (HasPantryConfig env, HasLogFunc env)
-  => PackageName -- ^ package name
+  => RequireHackageIndex
+  -> PackageName -- ^ package name
   -> Version -- ^ package version
   -> RIO env (Map Revision BlobKey)
-getHackagePackageVersionRevisions name version = do
-  cabalCount <- withStorage countHackageCabals
-  when (cabalCount == 0) $ void $
-    updateHackageIndex $ Just $ "No information from Hackage index, updating"
+getHackagePackageVersionRevisions req name version = do
+  initializeIndex req
   withStorage $
     Map.map snd <$> loadHackagePackageVersion name version