pantry 0.3.0.0 → 0.4.0.0

raw patch · 6 files changed

+113/−103 lines, 6 filesdep ~aesondep ~persistentdep ~persistent-templatePVP ok

version bump matches the API change (PVP)

Dependency ranges changed: aeson, persistent, persistent-template

API changes (from Hackage documentation)

Files

• ChangeLog.md +6/−0
• pantry.cabal +3/−3
• src/Pantry.hs +84/−92
• src/Pantry/Archive.hs +6/−7
• src/Pantry/Types.hs +13/−0
• test/Pantry/CasaSpec.hs +1/−1

@@ -1,5 +1,11 @@ # Changelog for pantry +## v0.4.0.0++* Add a deprecation warning when using a repo/archive without a cabal file, see [Stack #5210](https://github.com/commercialhaskell/stack/issues/5210)+* Do not include repo/archive dependencies which do not include cabal files in lock files+* Remove some no longer used functions+ ## v0.3.0.0  * Upgrade to Cabal 3.0

@@ -1,13 +1,13 @@ cabal-version: 1.12 --- This file has been generated from package.yaml by hpack version 0.32.0.+-- This file has been generated from package.yaml by hpack version 0.33.0. -- -- see: https://github.com/sol/hpack ----- hash: 66b17dc690d946f2a8ece380f0bd2b576e16f19d1f63e5a163eb2d6c7c81f1fa+-- hash: 9e29bee888e549f8360e383c2731ae492d94e7f64fca959461665c70cbece9c8  name:           pantry-version:        0.3.0.0+version:        0.4.0.0 synopsis:       Content addressable Haskell package management description:    Please see the README on Github at <https://github.com/commercialhaskell/pantry#readme> category:       Development

@@ -104,9 +104,10 @@   , AddPackagesConfig (..)      -- * Completion functions+  , CompletePackageLocation (..)   , completePackageLocation-  , completeSnapshotLayer   , completeSnapshotLocation+  , warnMissingCabalFile      -- * Parsers   , parseWantedCompiler@@ -820,7 +821,8 @@   :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)   => RawPackageLocationImmutable   -> RIO env Package-loadPackageRaw rpli =+loadPackageRaw rpli = do+  logInfo $ "In loadPackageRaw: " <> display rpli   case getRawTreeKey rpli of     Just treeKey' -> do       mpackage <- tryLoadPackageRawViaDbOrCasa rpli treeKey'@@ -893,15 +895,28 @@     Just treeId ->       fmap Just (withStorage (loadPackageById rlpi (entityKey treeId))) +-- | Complete package location, plus whether the package has a cabal file. This+-- is relevant to reproducibility, see+-- <https://tech.fpcomplete.com/blog/storing-generated-cabal-files>+--+-- @since 0.4.0.0+data CompletePackageLocation = CompletePackageLocation+  { cplComplete :: !PackageLocationImmutable+  , cplHasCabalFile :: !Bool+  }+ -- | Fill in optional fields in a 'PackageLocationImmutable' for more reproducible builds. -- -- @since 0.1.0.0 completePackageLocation   :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)   => RawPackageLocationImmutable-  -> RIO env PackageLocationImmutable+  -> RIO env CompletePackageLocation completePackageLocation (RPLIHackage (PackageIdentifierRevision n v (CFIHash sha (Just size))) (Just tk)) =-  pure $ PLIHackage (PackageIdentifier n v) (BlobKey sha size) tk+  pure CompletePackageLocation+    { cplComplete = PLIHackage (PackageIdentifier n v) (BlobKey sha size) tk+    , cplHasCabalFile = True+    } completePackageLocation (RPLIHackage pir0@(PackageIdentifierRevision name version cfi0) _) = do   logDebug $ "Completing package location information from " <> display pir0   (pir, cfKey) <-@@ -916,7 +931,10 @@         logDebug $ "Added in cabal file hash: " <> display pir         pure (pir, BlobKey sha size)   treeKey' <- getHackageTarballKey pir-  pure $ PLIHackage (PackageIdentifier name version) cfKey treeKey'+  pure CompletePackageLocation+    { cplComplete = PLIHackage (PackageIdentifier name version) cfKey treeKey'+    , cplHasCabalFile = True+    } completePackageLocation pl@(RPLIArchive archive rpm) = do   mpackage <-     case rpmTreeKey rpm of@@ -925,7 +943,13 @@   case (,,) <$> raHash archive <*> raSize archive <*> mpackage of     Just (sha256, fileSize, package) -> do       let RawArchive loc _ _ subdir = archive-      pure $ PLIArchive (Archive loc sha256 fileSize subdir) (packagePM package)+      pure CompletePackageLocation+        { cplComplete = PLIArchive (Archive loc sha256 fileSize subdir) (packagePM package)+        , cplHasCabalFile =+            case packageCabalEntry package of+              PCCabalFile{} -> True+              PCHpack{} -> False+        }     Nothing -> byThirdParty (isJust mpackage)   where     byThirdParty warnAboutMissingSizeSha = do@@ -933,7 +957,14 @@       when warnAboutMissingSizeSha (warnWith sha size)       -- (getArchive checks archive and package metadata)       let RawArchive loc _ _ subdir = archive-      pure $ PLIArchive (Archive loc sha size subdir) (packagePM package)+      logDebug $ fromString $ show (pl, sha, size, package)+      pure CompletePackageLocation+        { cplComplete = PLIArchive (Archive loc sha size subdir) (packagePM package)+        , cplHasCabalFile =+            case packageCabalEntry package of+              PCCabalFile{} -> True+              PCHpack{} -> False+        }     warnWith sha size =       logWarn         (mconcat@@ -947,20 +978,29 @@            ]) completePackageLocation pl@(RPLIRepo repo rpm) = do   unless (isSHA1 (repoCommit repo)) $ throwIO $ CannotCompleteRepoNonSHA1 repo-  PLIRepo repo <$> completePM pl rpm+  completePM repo pl rpm   where     isSHA1 t = T.length t == 40 && T.all isHexDigit t  completePM   :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)-  => RawPackageLocationImmutable+  => Repo+  -> RawPackageLocationImmutable   -> RawPackageMetadata-  -> RIO env PackageMetadata-completePM plOrig rpm@(RawPackageMetadata mn mv mtk)-  | Just n <- mn, Just v <- mv, Just tk <- mtk =-      pure $ PackageMetadata (PackageIdentifier n v) tk+  -> RIO env CompletePackageLocation+completePM repo plOrig rpm@(RawPackageMetadata mn mv mtk)+  | Just n <- mn, Just v <- mv, Just tk <- mtk = do+      let pm = PackageMetadata (PackageIdentifier n v) tk+      pure CompletePackageLocation+        { cplComplete = PLIRepo repo pm+        -- This next bit is a hack: we don't know for certain that this is the case.+        -- However, for the use case where complete package metadata has been supplied,+        -- we'll assume there's a cabal file for purposes of generating a deprecation warning.+        , cplHasCabalFile = True+        }   | otherwise = do-      pm <- packagePM <$> loadPackageRaw plOrig+      package <- loadPackageRaw plOrig+      let pm = packagePM package       let isSame x (Just y) = x == y           isSame _ _ = True @@ -969,7 +1009,13 @@             isSame (pkgVersion $ pmIdent pm) (rpmVersion rpm) &&             isSame (pmTreeKey pm) (rpmTreeKey rpm)       if allSame-        then pure pm+        then pure CompletePackageLocation+               { cplComplete = PLIRepo repo pm+               , cplHasCabalFile =+                   case packageCabalEntry package of+                     PCCabalFile{} -> True+                     PCHpack{} -> False+               }         else throwIO $ CompletePackageMetadataMismatch plOrig pm  packagePM :: Package -> PackageMetadata@@ -992,27 +1038,6 @@   bs <- loadFromURL url Nothing   pure $ SLUrl url (bsToBlobKey bs) --- | Fill in optional fields in a 'SnapshotLayer' for more reproducible builds.------ @since 0.1.0.0-completeSnapshotLayer-  :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)-  => RawSnapshotLayer-  -> RIO env SnapshotLayer-completeSnapshotLayer rsnapshot = do-  parent' <- completeSnapshotLocation $ rslParent rsnapshot-  pls <- traverseConcurrently completePackageLocation $ rslLocations rsnapshot-  pure SnapshotLayer-    { slParent = parent'-    , slLocations = pls-    , slCompiler= rslCompiler rsnapshot-    , slDropPackages = rslDropPackages rsnapshot-    , slFlags = rslFlags rsnapshot-    , slHidden = rslHidden rsnapshot-    , slGhcOptions = rslGhcOptions rsnapshot-    , slPublishTime = rslPublishTime rsnapshot-    }- traverseConcurrently_   :: (Foldable f, HasPantryConfig env)   => (a -> RIO env ()) -- ^ action to perform@@ -1042,47 +1067,6 @@             f x             loop -traverseConcurrently-  :: (HasPantryConfig env, Traversable t)-  => (a -> RIO env b) -- ^ action to perform-  -> t a -- ^ input values-  -> RIO env (t b)-traverseConcurrently f t0 = do-  cnt <- view $ pantryConfigL.to pcConnectionCount-  traverseConcurrentlyWith cnt f t0---- | Like 'traverse', but does things on--- up to N separate threads at once.-traverseConcurrentlyWith-  :: (MonadUnliftIO m, Traversable t)-  => Int -- ^ concurrent workers-  -> (a -> m b) -- ^ action to perform-  -> t a -- ^ input values-  -> m (t b)-traverseConcurrentlyWith count f t0 = do-  (queue, t1) <- atomically $ do-    queueDList <- newTVar id-    t1 <- for t0 $ \x -> do-      res <- newEmptyTMVar-      modifyTVar queueDList (. ((x, res):))-      pure $ atomically $ takeTMVar res-    dlist <- readTVar queueDList-    queue <- newTVar $ dlist []-    pure (queue, t1)--  replicateConcurrently_ count $-    fix $ \loop -> join $ atomically $ do-      toProcess <- readTVar queue-      case toProcess of-        [] -> pure (pure ())-        ((x, res):rest) -> do-          writeTVar queue rest-          pure $ do-            y <- f x-            atomically $ putTMVar res y-            loop-  sequence t1- -- | Parse a 'RawSnapshot' (all layers) from a 'RawSnapshotLocation'. -- -- @since 0.1.0.0@@ -1202,6 +1186,7 @@       in pure (snapshot, [CompletedSL (RSLCompiler wc) (SLCompiler wc)], [])     Right (rsl, sloc) -> do       (snap0, slocs, completed0) <- loadAndCompleteSnapshotRaw (rslParent rsl) cacheSL cachePL+      logDebug $ fromString $ show rsl       (packages, completed, unused) <-         addAndCompletePackagesToSnapshot           rawLoc@@ -1337,12 +1322,14 @@ cachedSnapshotCompletePackageLocation :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)   => Map RawPackageLocationImmutable PackageLocationImmutable   -> RawPackageLocationImmutable-  -> RIO env PackageLocationImmutable+  -> RIO env (Maybe PackageLocationImmutable) cachedSnapshotCompletePackageLocation cachePackages rpli = do   let xs = Map.lookup rpli cachePackages   case xs of-    Nothing -> completePackageLocation rpli-    Just x -> pure x+    Nothing -> do+      cpl <- completePackageLocation rpli+      pure $ if cplHasCabalFile cpl then Just (cplComplete cpl) else Nothing+    Just x -> pure $ Just x  -- | Add more packages to a snapshot completing their locations if needed --@@ -1372,18 +1359,23 @@                  -> RawPackageLocationImmutable                  -> RIO env ([(PackageName, SnapshotPackage)], [CompletedPLI])       addPackage (ps, completed) rawLoc = do-        complLoc <- cachedSnapshotCompletePackageLocation cachedPL rawLoc-        let PackageIdentifier name _ = packageLocationIdent complLoc-            p = (name, SnapshotPackage-              { spLocation = complLoc-              , spFlags = Map.findWithDefault mempty name flags-              , spHidden = Map.findWithDefault False name hiddens-              , spGhcOptions = Map.findWithDefault [] name options-              })-            completed' = if toRawPLI complLoc == rawLoc-                         then completed-                         else CompletedPLI rawLoc complLoc:completed-        pure (p:ps, completed')+        mcomplLoc <- cachedSnapshotCompletePackageLocation cachedPL rawLoc+        case mcomplLoc of+          Nothing -> do+            warnMissingCabalFile rawLoc+            pure (ps, completed)+          Just complLoc -> do+            let PackageIdentifier name _ = packageLocationIdent complLoc+                p = (name, SnapshotPackage+                  { spLocation = complLoc+                  , spFlags = Map.findWithDefault mempty name flags+                  , spHidden = Map.findWithDefault False name hiddens+                  , spGhcOptions = Map.findWithDefault [] name options+                  })+                completed' = if toRawPLI complLoc == rawLoc+                             then completed+                             else CompletedPLI rawLoc complLoc:completed+            pure (p:ps, completed')   (revNew, revCompleted) <- foldM addPackage ([], []) newPackages   let (newSingles, newMultiples)         = partitionEithers

@@ -136,9 +136,9 @@             _ -> do               case loc of                 ALUrl url -> do-                  logWarn $ "Using archive from " <> display url <> " without a specified cryptographic hash"-                  logWarn $ "Cached hash is " <> display sha <> ", file size " <> display size-                  logWarn "For security and reproducibility, please add a hash and file size to your configuration"+                  -- Only debug level, let lock files solve this+                  logDebug $ "Using archive from " <> display url <> " without a specified cryptographic hash"+                  logDebug $ "Cached hash is " <> display sha <> ", file size " <> display size                 ALFilePath _ -> pure ()               fmap (sha, size,) <$> loadFromCache tid         Just sha'@@ -146,15 +146,14 @@               case msize of                 Nothing -> do                   case loc of-                    ALUrl url -> do-                      logWarn $ "Archive from " <> display url <> " does not specify a size"-                      logWarn $ "To avoid an overflow attack, please add the file size to your configuration: " <> display size+                    -- Only debug level, let lock files solve this+                    ALUrl url -> logDebug $ "Archive from " <> display url <> " does not specify a size"                     ALFilePath _ -> pure ()                   fmap (sha, size,) <$> loadFromCache tid                 Just size'                   | size == size' -> fmap (sha, size,) <$> loadFromCache tid                   | otherwise -> do-+                      -- This is an actual warning, since we have a concrete mismatch                       logWarn $ "Archive from " <> display loc <> " has a matching hash but mismatched size"                       logWarn "Please verify that your configuration provides the correct size"                       loop rest

@@ -108,6 +108,7 @@   , SnapshotCacheHash (..)   , getGlobalHintsFile   , bsToBlobKey+  , warnMissingCabalFile   ) where  import RIO@@ -2298,3 +2299,15 @@ bsToBlobKey :: ByteString -> BlobKey bsToBlobKey bs =     BlobKey (SHA256.hashBytes bs) (FileSize (fromIntegral (B.length bs)))++-- | Warn if the package uses 'PCHpack'.+--+-- @since 0.4.0.0+warnMissingCabalFile :: HasLogFunc env => RawPackageLocationImmutable -> RIO env ()+warnMissingCabalFile loc =+  logWarn $+  "DEPRECATED: The package at " <> display loc <>+  " does not include a cabal file.\n" <>+  "Instead, it includes an hpack package.yaml file for generating a cabal file.\n" <>+  "This usage is deprecated; please see https://github.com/commercialhaskell/stack/issues/5210.\n" <>+  "Support for this workflow will be removed in the future.\n"

@@ -17,7 +17,7 @@     "completePackageLocation: unliftio_0_2_12"     (shouldReturn        (runPantryAppClean-          (completePackageLocation (argsRlpi unliftio_0_2_12)))+          (cplComplete <$> completePackageLocation (argsRlpi unliftio_0_2_12)))        ( PLIHackage            (PackageIdentifier               { pkgName = "unliftio"