pantry 0.1.1.2 → 0.2.0.0

raw patch · 11 files changed

+72/−92 lines, 11 filesdep ~Cabaldep ~aesondep ~hackage-securityPVP ok

version bump matches the API change (PVP)

Dependency ranges changed: Cabal, aeson, hackage-security, persistent, persistent-template

API changes (from Hackage documentation)

Files

• ChangeLog.md +9/−0
• pantry.cabal +2/−2
• src/Pantry.hs +8/−25
• src/Pantry/Archive.hs +3/−11
• src/Pantry/Hackage.hs +0/−1
• src/Pantry/Types.hs +17/−21
• test/Pantry/ArchiveSpec.hs +0/−1
• test/Pantry/BuildPlanSpec.hs +0/−2
• test/Pantry/CabalSpec.hs +7/−19
• test/Pantry/TreeSpec.hs +23/−1
• test/Pantry/TypesSpec.hs +3/−9

@@ -1,5 +1,14 @@ # Changelog for pantry +## v0.2.0.0++Bug fixes:++* Don't compare the hashes of cabal files.+  Addresses bugs such as [Stack+  #5045](https://github.com/commercialhaskell/stack/issues/5045).+  Data type changes: removed the `pmCabal` and `rpmCabal` fields.+ ## v0.1.1.2  Bug fixes:

@@ -4,10 +4,10 @@ -- -- see: https://github.com/sol/hpack ----- hash: e338943a1a53aa6c588e00a1b9eb2d38801ab6382e7ea4c33b31bd9eea0fb994+-- hash: abfcc422864de256ba0ef8b533df725b381cffd7791dca94f17303a16e69a2a3  name:           pantry-version:        0.1.1.2+version:        0.2.0.0 synopsis:       Content addressable Haskell package management description:    Please see the README on Github at <https://github.com/commercialhaskell/pantry#readme> category:       Development

@@ -390,10 +390,6 @@ -- -- This function ignores all warnings. ----- Note that, for now, this will not allow support for hpack files in--- these package locations. Instead, all @PackageLocationImmutable@s--- will require a .cabal file. This may be relaxed in the future.--- -- @since 0.1.0.0 loadCabalFileImmutable   :: (HasPantryConfig env, HasLogFunc env, HasProcessContext env)@@ -402,24 +398,21 @@ loadCabalFileImmutable loc = withCache $ do   logDebug $ "Parsing cabal file for " <> display loc   bs <- loadCabalFileBytes loc-  let foundCabalKey = bsToBlobKey bs   (_warnings, gpd) <- rawParseGPD (Left $ toRawPLI loc) bs   let pm =         case loc of-          PLIHackage (PackageIdentifier name version) cfHash mtree -> PackageMetadata+          PLIHackage (PackageIdentifier name version) _cfHash mtree -> PackageMetadata             { pmIdent = PackageIdentifier name version             , pmTreeKey = mtree-            , pmCabal = cfHash             }           PLIArchive _ pm' -> pm'           PLIRepo _ pm' -> pm'   let exc = MismatchedPackageMetadata (toRawPLI loc) (toRawPM pm) Nothing-        foundCabalKey (gpdPackageIdentifier gpd)+        (gpdPackageIdentifier gpd)       PackageIdentifier name ver = pmIdent pm   maybe (throwIO exc) pure $ do     guard $ name == gpdPackageName gpd     guard $ ver == gpdVersion gpd-    guard $ pmCabal pm == foundCabalKey     pure gpd   where     withCache inner = do@@ -448,26 +441,20 @@ loadCabalFileRawImmutable loc = withCache $ do   logDebug $ "Parsing cabal file for " <> display loc   bs <- loadRawCabalFileBytes loc-  let foundCabalKey = bsToBlobKey bs   (_warnings, gpd) <- rawParseGPD (Left loc) bs   let rpm =         case loc of-          RPLIHackage (PackageIdentifierRevision name version cfi) mtree -> RawPackageMetadata+          RPLIHackage (PackageIdentifierRevision name version _cfi) mtree -> RawPackageMetadata             { rpmName = Just name             , rpmVersion = Just version             , rpmTreeKey = mtree-            , rpmCabal =-                case cfi of-                  CFIHash sha (Just size) -> Just $ BlobKey sha size-                  _ -> Nothing             }           RPLIArchive _ rpm' -> rpm'           RPLIRepo _ rpm' -> rpm'-  let exc = MismatchedPackageMetadata loc rpm Nothing foundCabalKey (gpdPackageIdentifier gpd)+  let exc = MismatchedPackageMetadata loc rpm Nothing (gpdPackageIdentifier gpd)   maybe (throwIO exc) pure $ do     guard $ maybe True (== gpdPackageName gpd) (rpmName rpm)     guard $ maybe True (== gpdVersion gpd) (rpmVersion rpm)-    guard $ maybe True (== foundCabalKey) (rpmCabal rpm)     pure gpd   where     withCache inner = do@@ -766,9 +753,9 @@   => RawPackageLocationImmutable   -> RawPackageMetadata   -> RIO env PackageMetadata-completePM plOrig rpm@(RawPackageMetadata mn mv mtk mc)-  | Just n <- mn, Just v <- mv, Just tk <- mtk, Just c <- mc =-      pure $ PackageMetadata (PackageIdentifier n v) tk c+completePM plOrig rpm@(RawPackageMetadata mn mv mtk)+  | Just n <- mn, Just v <- mv, Just tk <- mtk =+      pure $ PackageMetadata (PackageIdentifier n v) tk   | otherwise = do       pm <- packagePM <$> loadPackageRaw plOrig       let isSame x (Just y) = x == y@@ -777,8 +764,7 @@           allSame =             isSame (pkgName $ pmIdent pm) (rpmName rpm) &&             isSame (pkgVersion $ pmIdent pm) (rpmVersion rpm) &&-            isSame (pmTreeKey pm) (rpmTreeKey rpm) &&-            isSame (pmCabal pm) (rpmCabal rpm)+            isSame (pmTreeKey pm) (rpmTreeKey rpm)       if allSame         then pure pm         else throwIO $ CompletePackageMetadataMismatch plOrig pm@@ -787,9 +773,6 @@ packagePM package = PackageMetadata   { pmIdent = packageIdent package   , pmTreeKey = packageTreeKey package-  , pmCabal = teBlob $ case packageCabalEntry package of-                         PCCabalFile cfile -> cfile-                         PCHpack hfile -> phGenerated hfile   }  -- | Add in hashes to make a 'SnapshotLocation' reproducible.

@@ -51,12 +51,7 @@   -> RIO env () fetchArchives pairs =   -- TODO be more efficient, group together shared archives-  fetchArchivesRaw [-    let PackageIdentifier nm ver = pmIdent pm-        rpm = RawPackageMetadata (Just nm) (Just ver) (Just $ pmTreeKey pm) (Just $ pmCabal pm)-        ra = RawArchive (archiveLocation a) (Just $ archiveHash a) (Just $ archiveSize a) (archiveSubdir a)-    in (ra, rpm)-   | (a, pm) <- pairs]+  fetchArchivesRaw [(toRawArchive a, toRawPM pm) | (a, pm) <- pairs]  getArchiveKey   :: forall env. (HasPantryConfig env, HasLogFunc env, HasProcessContext env)@@ -172,15 +167,13 @@   -> Either PantryException Package checkPackageMetadata pl pm pa = do   let-      pkgCabal = case packageCabalEntry pa of-                       PCCabalFile tentry -> tentry-                       PCHpack phpack -> phGenerated phpack       err = MismatchedPackageMetadata               pl               pm               (Just (packageTreeKey pa))-              (teBlob pkgCabal)               (packageIdent pa)++      test :: Eq a => Maybe a -> a -> Bool       test (Just x) y = x == y       test Nothing _ = True @@ -188,7 +181,6 @@         [ test (rpmTreeKey pm) (packageTreeKey pa)         , test (rpmName pm) (pkgName $ packageIdent pa)         , test (rpmVersion pm) (pkgVersion $ packageIdent pa)-        , test (rpmCabal pm) (teBlob pkgCabal)         ]     in if and tests then Right pa else Left err

@@ -586,7 +586,6 @@           { rpmName = Just name           , rpmVersion = Just ver           , rpmTreeKey = Nothing -- with a revision cabal file will differ giving a different tree-          , rpmCabal = Nothing -- cabal file in the tarball may be different!           }     case packageTree package of       TreeMap m -> do

@@ -807,7 +807,6 @@       !RawPackageLocationImmutable       !RawPackageMetadata       !(Maybe TreeKey)-      !BlobKey -- cabal file found       !PackageIdentifier   | Non200ResponseStatus !Status   | InvalidBlobKey !(Mismatch BlobKey)@@ -920,13 +919,12 @@     display loc <>     ":\n" <>     displayShow e-  display (MismatchedPackageMetadata loc pm mtreeKey foundCabal foundIdent) =+  display (MismatchedPackageMetadata loc pm mtreeKey foundIdent) =     "Mismatched package metadata for " <> display loc <>-    "\nFound: " <> fromString (packageIdentifierString foundIdent) <> " with cabal file " <>-    display foundCabal <>+    "\nFound: " <> fromString (packageIdentifierString foundIdent) <>     (case mtreeKey of        Nothing -> mempty-       Just treeKey -> " and tree " <> display treeKey) <>+       Just treeKey -> " with tree " <> display treeKey) <>     "\nExpected: " <> display pm   display (Non200ResponseStatus status) =     "Unexpected non-200 HTTP status code: " <>@@ -1360,10 +1358,6 @@     -- ^ Tree key of the loaded up package     --     -- @since 0.1.0.0-  , rpmCabal :: !(Maybe BlobKey)-    -- ^ Blob key containing the cabal file-    ---    -- @since 0.1.0.0   }   deriving (Show, Eq, Ord, Generic, Typeable) instance NFData RawPackageMetadata@@ -1373,7 +1367,6 @@     [ (\name -> "name == " <> fromString (packageNameString name)) <$> rpmName rpm     , (\version -> "version == " <> fromString (versionString version)) <$> rpmVersion rpm     , (\tree -> "tree == " <> display tree) <$> rpmTreeKey rpm-    , (\cabal -> "cabal file == " <> display cabal) <$> rpmCabal rpm     ]  -- | Exact metadata specifying concrete package@@ -1388,10 +1381,6 @@     -- ^ Tree key of the loaded up package     --     -- @since 0.1.0.0-  , pmCabal :: !BlobKey-    -- ^ Blob key containing the cabal file-    ---    -- @since 0.1.0.0   }   deriving (Show, Eq, Ord, Generic, Typeable) -- i PackageMetadata@@ -1401,12 +1390,11 @@   display pm = fold $ intersperse ", " $     [ "ident == " <> fromString (packageIdentifierString $ pmIdent pm)     , "tree == " <> display (pmTreeKey pm)-    , "cabal file == " <> display (pmCabal pm)     ]  parsePackageMetadata :: Object -> WarningParser PackageMetadata parsePackageMetadata o = do-  pmCabal :: BlobKey <- o ..: "cabal-file"+  _oldCabalFile :: Maybe BlobKey <- o ..:? "cabal-file"   pantryTree :: BlobKey <- o ..: "pantry-tree"   CabalString pkgName <- o ..: "name"   CabalString pkgVersion <- o ..: "version"@@ -1419,7 +1407,7 @@ -- -- @since 0.1.0.0 toRawPM :: PackageMetadata -> RawPackageMetadata-toRawPM pm = RawPackageMetadata (Just name) (Just version) (Just $ pmTreeKey pm) (Just $ pmCabal pm)+toRawPM pm = RawPackageMetadata (Just name) (Just version) (Just $ pmTreeKey pm)   where     PackageIdentifier name version = pmIdent pm @@ -1520,11 +1508,10 @@           RepoHg  -> "hg"  rpmToPairs :: RawPackageMetadata -> [(Text, Value)]-rpmToPairs (RawPackageMetadata mname mversion mtree mcabal) = concat+rpmToPairs (RawPackageMetadata mname mversion mtree) = concat   [ maybe [] (\name -> ["name" .= CabalString name]) mname   , maybe [] (\version -> ["version" .= CabalString version]) mversion   , maybe [] (\tree -> ["pantry-tree" .= tree]) mtree-  , maybe [] (\cabal -> ["cabal-file" .= cabal]) mcabal   ]  instance FromJSON (WithJSONWarnings (Unresolved PackageLocationImmutable)) where@@ -1621,12 +1608,21 @@               Just x -> pure $ OSSubdirs x           Nothing -> OSPackageMetadata             <$> o ..:? "subdir" ..!= T.empty-            <*> (RawPackageMetadata+            <*> (rawPackageMetadataHelper                   <$> (fmap unCabalString <$> (o ..:? "name"))                   <*> (fmap unCabalString <$> (o ..:? "version"))                   <*> o ..:? "pantry-tree"                   <*> o ..:? "cabal-file") +      rawPackageMetadataHelper+        :: Maybe PackageName+        -> Maybe Version+        -> Maybe TreeKey+        -> Maybe BlobKey+        -> RawPackageMetadata+      rawPackageMetadataHelper name version pantryTree _ignoredCabalFile =+        RawPackageMetadata name version pantryTree+       repo = withObjectWarnings "UnresolvedPackageLocationImmutable.UPLIRepo" $ \o -> do         (repoType, repoUrl) <-           ((RepoGit, ) <$> o ..: "git") <|>@@ -1665,7 +1661,7 @@ osToRpms (OSPackageMetadata subdir rpm) = pure (subdir, rpm)  rpmEmpty :: RawPackageMetadata-rpmEmpty = RawPackageMetadata Nothing Nothing Nothing Nothing+rpmEmpty = RawPackageMetadata Nothing Nothing Nothing  -- | Newtype wrapper for easier JSON integration with Cabal types. --

@@ -41,7 +41,6 @@       { rpmName = Nothing       , rpmVersion = Nothing       , rpmTreeKey = Nothing-      , rpmCabal = Nothing       }  parsePackageIdentifier' :: String -> PackageIdentifier

@@ -47,7 +47,6 @@                     { rpmName = Nothing                     , rpmVersion = Nothing                     , rpmTreeKey = Nothing-                    , rpmCabal = Nothing                     }           actual <- decode'' contents           actual `shouldBe` pure expected@@ -75,7 +74,6 @@                     { rpmName = Nothing                     , rpmVersion = Nothing                     , rpmTreeKey = Nothing-                    , rpmCabal = Nothing                     }           actual <- decode'' contents           actual `shouldBe` pure expected

@@ -11,7 +11,8 @@  spec :: Spec spec = describe "wrong cabal file" $ do-  let test name action = it name (runPantryApp action :: IO ())+  let test :: HasCallStack => String -> RIO PantryApp () -> Spec+      test name action = it name (runPantryApp action :: IO ())       shouldThrow' x y = withRunInIO $ \run -> run x `shouldThrow` y   test "Hackage" $ do     sha <- either throwIO pure@@ -30,23 +31,19 @@         size = FileSize 597     go `shouldThrow'` \e ->       case e of-        MismatchedPackageMetadata rpli' rpm _tree cabal ident ->+        MismatchedPackageMetadata rpli' rpm _tree ident ->           rpli == rpli' &&           rpm == RawPackageMetadata             { rpmName = Just name             , rpmVersion = Just version3             , rpmTreeKey = Nothing-            , rpmCabal = Just $ BlobKey sha size             } &&-          cabal == BlobKey sha size &&           ident == PackageIdentifier name version2         _ -> False    test "tarball with wrong ident" $ do     archiveHash' <- either throwIO pure                   $ SHA256.fromHexBytes "b5a582209c50e4a61e4b6c0fb91a6a7d65177a881225438b0144719bc3682c3a"-    sha <- either throwIO pure-         $ SHA256.fromHexBytes "71c2c685a932cd3a70ec52d7bd0ec96ecbfa5e31e22130099cd50fa073ad1a69"     let rpli = RPLIArchive archive rpm         archive =             RawArchive@@ -59,7 +56,6 @@             RawPackageMetadata               { rpmName = Just acmeMissiles               , rpmVersion = Just version2-              , rpmCabal = Just $ BlobKey sha (FileSize 597)               , rpmTreeKey = Nothing               }         go = loadCabalFileRawImmutable rpli@@ -67,20 +63,15 @@         version2 = mkVersion [0, 2]     go `shouldThrow'` \e ->       case e of-        MismatchedPackageMetadata rpli' rpm' _treeKey cabal ident ->+        MismatchedPackageMetadata rpli' rpm' _treeKey ident ->           rpli == rpli' &&           rpm == rpm' &&-          cabal == BlobKey-            (either impureThrow id $ SHA256.fromHexBytes "940d82426ad1db0fcc978c0f386ac5d06df019546071993cb7c6633f1ad17d50")-            (FileSize 3038) &&           ident == PackageIdentifier             (mkPackageName "yesod-auth")             (mkVersion [1, 6, 4, 1])         _ -> False    test "tarball with wrong cabal file" $ do-    sha <- either throwIO pure-         $ SHA256.fromHexBytes "71c2c685a932cd3a70ec52d7bd0ec96ecbfa5e31e22130099cd50fa073ad1a69"     let rpli = RPLIArchive archive rpm         archive =             RawArchive@@ -93,20 +84,17 @@         rpm =             RawPackageMetadata               { rpmName = Just yesodAuth-              , rpmVersion = Just version-              , rpmCabal = Just $ BlobKey sha (FileSize 597)+              , rpmVersion = Just badVersion               , rpmTreeKey = Nothing               }         go = loadCabalFileRawImmutable rpli         yesodAuth = mkPackageName "yesod-auth"         version = mkVersion [1, 6, 4, 1]+        badVersion = mkVersion [1, 6, 4, 0]     go `shouldThrow'` \e ->       case e of-        MismatchedPackageMetadata rpli' rpm' _treeKey cabal ident ->+        MismatchedPackageMetadata rpli' rpm' _treeKey ident ->           rpli == rpli' &&           rpm == rpm' &&-          cabal == BlobKey-            (either impureThrow id $ SHA256.fromHexBytes "940d82426ad1db0fcc978c0f386ac5d06df019546071993cb7c6633f1ad17d50")-            (FileSize 3038) &&           ident == PackageIdentifier yesodAuth version         _ -> False

@@ -5,6 +5,9 @@ import Test.Hspec import RIO import Pantry+import qualified Pantry.SHA256 as SHA256+import Distribution.Types.PackageName (mkPackageName)+import Distribution.Types.Version (mkVersion)  spec :: Spec spec = do@@ -14,7 +17,6 @@         { rpmName = Nothing         , rpmVersion = Nothing         , rpmTreeKey = Nothing-        , rpmCabal = Nothing         }       mkArchive url =         RPLIArchive@@ -58,3 +60,23 @@     pair1 <- loadPackageRaw tarPL     pair2 <- loadPackageRaw hgPL     liftIO $ pair2 `shouldBe` pair1++  it "5045 no cabal file" $ asIO $ runPantryAppClean $ do+    let rpli = RPLIArchive archive rpm+        packageName = mkPackageName "yaml"+        version = mkVersion [0, 11, 1, 2]+        archive =+            RawArchive+              { raLocation = ALUrl "https://github.com/snoyberg/yaml/archive/yaml-0.11.1.2.tar.gz"+              , raHash = either impureThrow Just+                         $ SHA256.fromHexBytes "b8564e99c555e670ee487bbf92d03800d955f0e6e16333610ef46534548e0a3d"+              , raSize = Just $ FileSize 94198+              , raSubdir = "yaml"+              }+        rpm =+            RawPackageMetadata+              { rpmName = Just packageName+              , rpmVersion = Just version+              , rpmTreeKey = Nothing+              }+    void $ loadCabalFileRawImmutable rpli

@@ -49,6 +49,7 @@     [r| subdir: wai cabal-file:+  # This is ignored, only included to make sure we get no warnings   size: 1765   sha256: eea52c4967d8609c2f79213d6dffe6d6601034f1471776208404781de7051410 name: wai@@ -63,9 +64,6 @@ samplePLIRepo2 :: ByteString samplePLIRepo2 =     [r|-cabal-file:-  size: 1863-  sha256: 5ebffc39e75ea1016adcc8426dc31d2040d2cc8a5f4bbce228592ef35e233da2 name: merkle-log version: 0.1.0.0 git: https://github.com/kadena-io/merkle-log.git@@ -167,14 +165,11 @@                         "d11d63f1a6a92db8c637a8d33e7953ce6194a3e0"                   , repoUrl = "https://github.com/yesodweb/wai.git"                   }-          cabalSha =-              SHA256.fromHexBytes-                  "eea52c4967d8609c2f79213d6dffe6d6601034f1471776208404781de7051410"           pantrySha =               SHA256.fromHexBytes                   "ecfd0b4b75f435a3f362394807b35e5ef0647b1a25005d44a3632c49db4833d2"-      (csha, psha) <- case (cabalSha, pantrySha) of-        (Right csha, Right psha) -> pure (csha, psha)+      psha <- case pantrySha of+        Right psha -> pure psha         _ -> fail "Failed decoding sha256"       let pkgValue =               PackageMetadata@@ -183,7 +178,6 @@                             (mkPackageName "wai")                             (mkVersion [3, 2, 1, 2])                   , pmTreeKey = TreeKey (BlobKey psha (FileSize 714))-                  , pmCabal = BlobKey csha (FileSize 1765)                   }       pli `shouldBe` PLIRepo repoValue pkgValue