From 51abb1c88b53e2989a2a8c2939ac4abc04bef194 Mon Sep 17 00:00:00 2001
From: Austin Seipp <austin@well-typed.com>
Date: Sun, 20 May 2018 13:25:09 -0400
Subject: [PATCH] ghc-pkg: recompute `abi-depends` for updated packages

See `Note [Recompute abi-depends]` for more information.

Signed-off-by: Austin Seipp <aseipp@pobox.com>

Test Plan: `./validate`

Reviewers: bgamari, ezyang

Reviewed By: bgamari

Subscribers: tdammers, juhp, carter, alexbiehl, shlevy, cocreature,
rwbarton, thomie

GHC Trac Issues: #14381

Differential Revision: https://phabricator.haskell.org/D4159

(cherry picked from commit 1cdc14f9c014f1a520638f7c0a01799ac6d104e6)
---
 .../cabal/bkpcabal02/bkpcabal02.stdout        |  5 ++
 testsuite/tests/cabal/T12485a.stdout          |  1 +
 testsuite/tests/cabal/T5442d.stdout           |  1 +
 testsuite/tests/cabal/cabal01/cabal01.stdout  |  1 +
 testsuite/tests/cabal/cabal06/cabal06.stdout  |  4 ++
 testsuite/tests/cabal/cabal08/cabal08.stdout  |  2 +
 testsuite/tests/cabal/shadow.stdout           |  1 +
 .../tests/driver/recomp007/recomp007.stdout   |  2 +
 .../safeHaskell/check/pkg01/safePkg01.stdout  | 20 ++++---
 .../tests/typecheck/T13168/T13168.stdout      |  2 +
 utils/ghc-pkg/Main.hs                         | 52 ++++++++++++++++++-
 11 files changed, 82 insertions(+), 9 deletions(-)

diff --git a/testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stdout b/testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stdout
index 2f17fdffcd8..1e51c3c4ac3 100644
--- a/testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stdout
+++ b/testsuite/tests/backpack/cabal/bkpcabal02/bkpcabal02.stdout
@@ -1,6 +1,11 @@
+ignoring (possibly broken) abi-depends field for packages
+ignoring (possibly broken) abi-depends field for packages
 Preprocessing library 'p' for bkpcabal01-0.1.0.0..
 Building library 'p' instantiated with H = <H>
 for bkpcabal01-0.1.0.0..
+ignoring (possibly broken) abi-depends field for packages
 Preprocessing library 'q' for bkpcabal01-0.1.0.0..
 Building library 'q' instantiated with H = <H>
 for bkpcabal01-0.1.0.0..
+ignoring (possibly broken) abi-depends field for packages
+ignoring (possibly broken) abi-depends field for packages
diff --git a/testsuite/tests/cabal/T12485a.stdout b/testsuite/tests/cabal/T12485a.stdout
index ee83ab293c8..af722c524af 100644
--- a/testsuite/tests/cabal/T12485a.stdout
+++ b/testsuite/tests/cabal/T12485a.stdout
@@ -1,3 +1,4 @@
+ignoring (possibly broken) abi-depends field for packages
 should SUCCEED
 should SUCCEED
 should SUCCEED
diff --git a/testsuite/tests/cabal/T5442d.stdout b/testsuite/tests/cabal/T5442d.stdout
index f3214578d25..0cb7375fbf7 100644
--- a/testsuite/tests/cabal/T5442d.stdout
+++ b/testsuite/tests/cabal/T5442d.stdout
@@ -1,6 +1,7 @@
 Reading package info from "shadow1.pkg" ... done.
 Reading package info from "shadow4.pkg" ... done.
 Reading package info from "shadow2.pkg" ... done.
+ignoring (possibly broken) abi-depends field for packages
 global (should be empty):
 user:
 shadow-2
diff --git a/testsuite/tests/cabal/cabal01/cabal01.stdout b/testsuite/tests/cabal/cabal01/cabal01.stdout
index e828cbe68a0..1378031cb14 100644
--- a/testsuite/tests/cabal/cabal01/cabal01.stdout
+++ b/testsuite/tests/cabal/cabal01/cabal01.stdout
@@ -1,3 +1,4 @@
+ignoring (possibly broken) abi-depends field for packages
 install1:
 bin
 lib
diff --git a/testsuite/tests/cabal/cabal06/cabal06.stdout b/testsuite/tests/cabal/cabal06/cabal06.stdout
index e5ff042302a..381363977c2 100644
--- a/testsuite/tests/cabal/cabal06/cabal06.stdout
+++ b/testsuite/tests/cabal/cabal06/cabal06.stdout
@@ -1,3 +1,7 @@
+ignoring (possibly broken) abi-depends field for packages
+ignoring (possibly broken) abi-depends field for packages
+ignoring (possibly broken) abi-depends field for packages
+ignoring (possibly broken) abi-depends field for packages
 Does the first instance of q depend on p-1.0?
 1
 Does the second instance of q depend on p-1.0?
diff --git a/testsuite/tests/cabal/cabal08/cabal08.stdout b/testsuite/tests/cabal/cabal08/cabal08.stdout
index 06a164b1500..d70d778151a 100644
--- a/testsuite/tests/cabal/cabal08/cabal08.stdout
+++ b/testsuite/tests/cabal/cabal08/cabal08.stdout
@@ -1,3 +1,5 @@
+ignoring (possibly broken) abi-depends field for packages
+ignoring (possibly broken) abi-depends field for packages
 [1 of 1] Compiling Main             ( Main.hs, Main.o )
 Linking Main ...
 p2
diff --git a/testsuite/tests/cabal/shadow.stdout b/testsuite/tests/cabal/shadow.stdout
index a47ce15795d..c70767da1d4 100644
--- a/testsuite/tests/cabal/shadow.stdout
+++ b/testsuite/tests/cabal/shadow.stdout
@@ -1,3 +1,4 @@
+ignoring (possibly broken) abi-depends field for packages
 databases 1 and 2:
 localshadow1.package.conf
     (shadow-1)
diff --git a/testsuite/tests/driver/recomp007/recomp007.stdout b/testsuite/tests/driver/recomp007/recomp007.stdout
index d8343152e0c..d5da3dae18b 100644
--- a/testsuite/tests/driver/recomp007/recomp007.stdout
+++ b/testsuite/tests/driver/recomp007/recomp007.stdout
@@ -1,3 +1,5 @@
+ignoring (possibly broken) abi-depends field for packages
+ignoring (possibly broken) abi-depends field for packages
 Preprocessing executable 'test' for b-1.0..
 Building executable 'test' for b-1.0..
 [1 of 2] Compiling B                ( B.hs, dist/build/test/test-tmp/B.o ) [A changed]
diff --git a/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout b/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
index 59886cd378f..8d6378430b4 100644
--- a/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
+++ b/testsuite/tests/safeHaskell/check/pkg01/safePkg01.stdout
@@ -1,49 +1,53 @@
+ignoring (possibly broken) abi-depends field for packages
 pdb.safePkg01/local.db
     safePkg01-1.0
 
 trusted: False
 
 M_SafePkg
-package dependencies: base-4.9.0.0* ghc-prim-0.5.0.0 integer-gmp-1.0.0.0
+package dependencies: base-4.11.0.0* ghc-prim-0.5.2.0 integer-gmp-1.0.1.0
 trusted: safe
 require own pkg trusted: False
 
 M_SafePkg2
-package dependencies: base-4.9.0.0 ghc-prim-0.5.0.0 integer-gmp-1.0.0.0
+package dependencies: base-4.11.0.0 ghc-prim-0.5.2.0 integer-gmp-1.0.1.0
 trusted: trustworthy
 require own pkg trusted: False
 
 M_SafePkg3
-package dependencies: base-4.9.0.0* ghc-prim-0.5.0.0 integer-gmp-1.0.0.0
+package dependencies: base-4.11.0.0* ghc-prim-0.5.2.0 integer-gmp-1.0.1.0
 trusted: safe
 require own pkg trusted: True
 
 M_SafePkg4
-package dependencies: base-4.9.0.0* ghc-prim-0.5.0.0 integer-gmp-1.0.0.0
+package dependencies: base-4.11.0.0* ghc-prim-0.5.2.0 integer-gmp-1.0.1.0
 trusted: safe
 require own pkg trusted: True
 
 M_SafePkg5
-package dependencies: base-4.9.0.0* ghc-prim-0.5.0.0 integer-gmp-1.0.0.0
+package dependencies: base-4.11.0.0* ghc-prim-0.5.2.0 integer-gmp-1.0.1.0
 trusted: safe
 require own pkg trusted: True
 
 M_SafePkg6
-package dependencies: array-0.5.1.0 base-4.9.0.0* bytestring-0.10.7.0* deepseq-1.4.2.0 ghc-prim-0.5.0.0 integer-gmp-1.0.0.0
+package dependencies: array-0.5.2.0 base-4.11.0.0* bytestring-0.10.8.2* deepseq-1.4.3.0 ghc-prim-0.5.2.0 integer-gmp-1.0.1.0
 trusted: trustworthy
 require own pkg trusted: False
 
 M_SafePkg7
-package dependencies: array-0.5.1.0 base-4.9.0.0* bytestring-0.10.7.0* deepseq-1.4.2.0 ghc-prim-0.5.0.0 integer-gmp-1.0.0.0
+package dependencies: array-0.5.2.0 base-4.11.0.0* bytestring-0.10.8.2* deepseq-1.4.3.0 ghc-prim-0.5.2.0 integer-gmp-1.0.1.0
 trusted: safe
 require own pkg trusted: False
 
 M_SafePkg8
-package dependencies: array-0.5.1.0 base-4.9.0.0 bytestring-0.10.7.0* deepseq-1.4.2.0 ghc-prim-0.5.0.0 integer-gmp-1.0.0.0
+package dependencies: array-0.5.2.0 base-4.11.0.0 bytestring-0.10.8.2* deepseq-1.4.3.0 ghc-prim-0.5.2.0 integer-gmp-1.0.1.0
 trusted: trustworthy
 require own pkg trusted: False
 
 Testing setting trust
+ignoring (possibly broken) abi-depends field for packages
 trusted: True
+ignoring (possibly broken) abi-depends field for packages
 trusted: False
+ignoring (possibly broken) abi-depends field for packages
 trusted: False
diff --git a/testsuite/tests/typecheck/T13168/T13168.stdout b/testsuite/tests/typecheck/T13168/T13168.stdout
index a935d2ffb3b..32eec3e0026 100644
--- a/testsuite/tests/typecheck/T13168/T13168.stdout
+++ b/testsuite/tests/typecheck/T13168/T13168.stdout
@@ -1 +1,3 @@
+ignoring (possibly broken) abi-depends field for packages
+ignoring (possibly broken) abi-depends field for packages
 Window
diff --git a/utils/ghc-pkg/Main.hs b/utils/ghc-pkg/Main.hs
index 0e793b49178..0bedbb2c4c2 100644
--- a/utils/ghc-pkg/Main.hs
+++ b/utils/ghc-pkg/Main.hs
@@ -1209,7 +1209,18 @@ updateDBCache verbosity db = do
       pkgsCabalFormat = packages db
 
       pkgsGhcCacheFormat :: [PackageCacheFormat]
-      pkgsGhcCacheFormat = map convertPackageInfoToCacheFormat pkgsCabalFormat
+      pkgsGhcCacheFormat
+        = map (recomputeValidAbiDeps pkgsCabalFormat) -- Note [Recompute abi-depends]
+        $ map convertPackageInfoToCacheFormat
+          pkgsCabalFormat
+
+      hasAnyAbiDepends :: InstalledPackageInfo -> Bool
+      hasAnyAbiDepends x = length (abiDepends x) > 0
+
+  -- warn when we find any (possibly-)bogus abi-depends fields;
+  -- Note [Recompute abi-depends]
+  when (any hasAnyAbiDepends pkgsCabalFormat) $
+      infoLn "ignoring (possibly broken) abi-depends field for packages"
 
   when (verbosity > Normal) $
       infoLn ("writing cache " ++ filename)
@@ -1232,6 +1243,45 @@ type PackageCacheFormat = GhcPkg.InstalledPackageInfo
                             ModuleName
                             OpenModule
 
+{- Note [Recompute abi-depends]
+~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~~
+
+Like most fields, `ghc-pkg` relies on who-ever is performing package
+registration to fill in fields; this includes the `abi-depends` field present
+for the package.
+
+However, this was likely a mistake, and is not very robust; in certain cases,
+versions of Cabal may use bogus abi-depends fields for a package when doing
+builds. Why? Because package database information is aggressively cached; it is
+possible to work Cabal into a situation where it uses a cached version of
+`abi-depends`, rather than the one in the actual database after it has been
+recomputed.
+
+However, there is an easy fix: ghc-pkg /already/ knows the `abi-depends` of a
+package, because they are the ABIs of the packages pointed at by the `depends`
+field. So it can simply look up the abi from the dependencies in the original
+database, and ignore whatever the system registering gave it.
+
+So, instead, we do two things here:
+
+  - We throw away the information for a registered package's `abi-depends` field.
+
+  - We recompute it: we simply look up the unit ID of the package in the original
+    database, and use *its* abi-depends.
+
+See Trac #14381, and Cabal issue #4728.
+
+-}
+
+recomputeValidAbiDeps :: [InstalledPackageInfo] -> PackageCacheFormat -> PackageCacheFormat
+recomputeValidAbiDeps db pkg = pkg { GhcPkg.abiDepends = catMaybes (newAbiDeps) }
+  where
+    newAbiDeps = flip map (GhcPkg.abiDepends pkg) $ \(k, _) ->
+      case filter (\d -> installedUnitId d == k) db of
+        []  -> Nothing
+        [x] -> Just (k, unAbiHash (abiHash x))
+        _   -> Nothing -- ???
+
 convertPackageInfoToCacheFormat :: InstalledPackageInfo -> PackageCacheFormat
 convertPackageInfoToCacheFormat pkg =
     GhcPkg.InstalledPackageInfo {
-- 
GitLab