Merge pull request #5848 from fgaz/prevent-dep-on-private-lib

Prevent dependency on private library
haskell · Jun 25, 2019 · 9756b4c · 9756b4c
2 parents 7a02cda + 3e31042
commit 9756b4c
Show file tree

Hide file tree

Showing 20 changed files with 128 additions and 27 deletions.
diff --git a/Cabal/Distribution/Simple/Configure.hs b/Cabal/Distribution/Simple/Configure.hs
@@ -83,6 +83,7 @@ import Distribution.Types.PkgconfigDependency
 import Distribution.Types.PkgconfigVersionRange
 import Distribution.Types.LocalBuildInfo
 import Distribution.Types.LibraryName
+import Distribution.Types.LibraryVisibility
 import Distribution.Types.ComponentRequestedSpec
 import Distribution.Types.ForeignLib
 import Distribution.Types.ForeignLibType
@@ -476,6 +477,7 @@ configure (pkg_descr0, pbi) cfg = do
                 (dependencySatisfiable
                     use_external_internal_deps
                     (fromFlagOrDefault False (configExactConfiguration cfg))
+                    (fromFlagOrDefault False (configAllowDependingOnPrivateLibs cfg))
                     (packageName pkg_descr0)
                     installedPackageSet
                     internalPackageSet
@@ -881,6 +883,7 @@ getInternalPackages pkg_descr0 =
 dependencySatisfiable
     :: Bool -- ^ use external internal deps?
     -> Bool -- ^ exact configuration?
+    -> Bool -- ^ allow depending on private libs?
     -> PackageName
     -> InstalledPackageIndex -- ^ installed set
     -> Map PackageName (Maybe UnqualComponentName) -- ^ internal set
@@ -889,7 +892,9 @@ dependencySatisfiable
     -> (Dependency -> Bool)
 dependencySatisfiable
   use_external_internal_deps
-  exact_config pn installedPackageSet internalPackageSet requiredDepsMap
+  exact_config
+  allow_private_deps
+  pn installedPackageSet internalPackageSet requiredDepsMap
   (Dependency depName vr sublibs)
 
     | exact_config
@@ -913,12 +918,7 @@ dependencySatisfiable
                       packageNameToUnqualComponentName depName)
                  requiredDepsMap)
 
-          || all
-               (\lib ->
-                 (depName, CLibName lib)
-                 `Map.member`
-                 requiredDepsMap)
-               sublibs
+          || all visible sublibs
 
     | isInternalDep
     = if use_external_internal_deps
@@ -949,6 +949,23 @@ dependencySatisfiable
            -- Reinterpret the "package name" as an unqualified component
            -- name
            = LSubLibName $ packageNameToUnqualComponentName depName
+    -- Check whether a libray exists and is visible.
+    -- We don't disambiguate between dependency on non-existent or private
+    -- library yet, so we just return a bool and later report a generic error.
+    visible lib = maybe
+                    False -- Does not even exist (wasn't in the depsMap)
+                    (\ipi -> Installed.libVisibility ipi == LibraryVisibilityPublic
+                          -- If the override is enabled, the visibility does
+                          -- not matter (it's handled externally)
+                          || allow_private_deps
+                          -- If it's a library of the same package then it's
+                          -- always visible.
+                          -- This is only triggered when passing a component
+                          -- of the same package as --dependency, such as in:
+                          -- cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs
+                          || pkgName (Installed.sourcePackageId ipi) == pn)
+                    maybeIPI
+      where maybeIPI = Map.lookup (depName, CLibName lib) requiredDepsMap
 
 -- | Finalize a generic package description.  The workhorse is
 -- 'finalizePD' but there's a bit of other nattering
@@ -981,7 +998,7 @@ configureFinalizedPackage verbosity cfg enabled
                    pkg_descr0
             of Right r -> return r
                Left missing ->
-                   die' verbosity $ "Encountered missing dependencies:\n"
+                   die' verbosity $ "Encountered missing or private dependencies:\n"
                      ++ (render . nest 4 . sep . punctuate comma
                                 . map (pretty . simplifyDependency)
                                 $ missing)

diff --git a/Cabal/Distribution/Simple/Setup.hs b/Cabal/Distribution/Simple/Setup.hs
@@ -274,9 +274,13 @@ data ConfigFlags = ConfigFlags {
       -- ^Halt and show an error message indicating an error in flag assignment
     configRelocatable :: Flag Bool, -- ^ Enable relocatable package built
     configDebugInfo :: Flag DebugInfoLevel,  -- ^ Emit debug info.
-    configUseResponseFiles :: Flag Bool
+    configUseResponseFiles :: Flag Bool,
       -- ^ Whether to use response files at all. They're used for such tools
       -- as haddock, or or ld.
+    configAllowDependingOnPrivateLibs :: Flag Bool
+      -- ^ Allow depending on private sublibraries. This is used by external
+      -- tools (like cabal-install) so they can add multiple-public-libraries
+      -- compatibility to older ghcs by checking visibility externally.
   }
   deriving (Generic, Read, Show)
 
@@ -704,6 +708,13 @@ configureOptions showOrParseArgs =
          configUseResponseFiles
          (\v flags -> flags { configUseResponseFiles = v })
          (boolOpt' ([], ["disable-response-files"]) ([], []))
+
+      ,option "" ["allow-depending-on-private-libs"]
+         (  "Allow depending on private libraries. "
+         ++ "If set, the library visibility check MUST be done externally." )
+         configAllowDependingOnPrivateLibs
+         (\v flags -> flags { configAllowDependingOnPrivateLibs = v })
+         trueArg
       ]
   where
     liftInstallDirs =

diff --git a/Cabal/Distribution/Types/InstalledPackageInfo.hs b/Cabal/Distribution/Types/InstalledPackageInfo.hs
@@ -41,6 +41,7 @@ data InstalledPackageInfo
         sourcePackageId   :: PackageId,
         sourceLibName     :: LibraryName,
         installedComponentId_ :: ComponentId,
+        libVisibility     :: LibraryVisibility,
         installedUnitId   :: UnitId,
         -- INVARIANT: if this package is definite, OpenModule's
         -- OpenUnitId directly records UnitId.  If it is
@@ -87,8 +88,7 @@ data InstalledPackageInfo
         frameworks        :: [String],
         haddockInterfaces :: [FilePath],
         haddockHTMLs      :: [FilePath],
-        pkgRoot           :: Maybe FilePath,
-        libVisibility     :: LibraryVisibility
+        pkgRoot           :: Maybe FilePath
     }
     deriving (Eq, Generic, Typeable, Read, Show)
 

diff --git a/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs b/Cabal/Distribution/Types/InstalledPackageInfo/FieldGrammar.hs
@@ -60,7 +60,7 @@ ipiFieldGrammar = mkInstalledPackageInfo
     <$> monoidalFieldAla    "hugs-options"         (alaList' FSep Token)         unitedList
         --- https://github.com/haskell/cabal/commit/40f3601e17024f07e0da8e64d3dd390177ce908b
         ^^^ deprecatedSince CabalSpecV1_22 "hugs isn't supported anymore"
-    -- Very basic fields: name, version, package-name and lib-name
+    -- Very basic fields: name, version, package-name, lib-name and visibility
     <+> blurFieldGrammar basic basicFieldGrammar
     -- Basic fields
     <+> optionalFieldDef    "id"                                                 L.installedUnitId (mkUnitId "")
@@ -102,14 +102,14 @@ ipiFieldGrammar = mkInstalledPackageInfo
     <+> monoidalFieldAla    "haddock-interfaces"   (alaList' FSep FilePathNT)    L.haddockInterfaces
     <+> monoidalFieldAla    "haddock-html"         (alaList' FSep FilePathNT)    L.haddockHTMLs
     <+> optionalFieldAla    "pkgroot"              FilePathNT                    L.pkgRoot
-    <+> optionalFieldDef    "visibility"                                         L.libVisibility LibraryVisibilityPrivate
   where
     mkInstalledPackageInfo _ Basic {..} = InstalledPackageInfo
         -- _basicPkgName is not used
         -- setMaybePackageId says it can be no-op.
         (PackageIdentifier pn _basicVersion)
         (combineLibraryName ln _basicLibName)
         (mkComponentId "") -- installedComponentId_, not in use
+        _basicLibVisibility
       where
         MungedPackageName pn ln = _basicName
 {-# SPECIALIZE ipiFieldGrammar :: FieldDescrs InstalledPackageInfo InstalledPackageInfo #-}
@@ -223,10 +223,11 @@ instance Pretty SpecLicenseLenient where
 -- in serialised textual representation
 -- to the actual 'InstalledPackageInfo' fields.
 data Basic = Basic
-    { _basicName    :: MungedPackageName
-    , _basicVersion :: Version
-    , _basicPkgName :: Maybe PackageName
-    , _basicLibName :: LibraryName
+    { _basicName          :: MungedPackageName
+    , _basicVersion       :: Version
+    , _basicPkgName       :: Maybe PackageName
+    , _basicLibName       :: LibraryName
+    , _basicLibVisibility :: LibraryVisibility
     }
 
 basic :: Lens' InstalledPackageInfo Basic
@@ -237,12 +238,14 @@ basic f ipi = g <$> f b
         (packageVersion ipi)
         (maybePackageName ipi)
         (sourceLibName ipi)
+        (libVisibility ipi)
 
-    g (Basic n v pn ln) = ipi
+    g (Basic n v pn ln lv) = ipi
         & setMungedPackageName n
         & L.sourcePackageId . L.pkgVersion .~ v
         & setMaybePackageName pn
         & L.sourceLibName .~ ln
+        & L.libVisibility .~ lv
 
 basicName :: Lens' Basic MungedPackageName
 basicName f b = (\x -> b { _basicName = x }) <$> f (_basicName b)
@@ -261,6 +264,11 @@ basicLibName f b = (\x -> b { _basicLibName = maybeToLibraryName x }) <$>
     f (libraryNameString (_basicLibName b))
 {-# INLINE basicLibName #-}
 
+basicLibVisibility :: Lens' Basic LibraryVisibility
+basicLibVisibility f b = (\x -> b { _basicLibVisibility = x }) <$>
+    f (_basicLibVisibility b)
+{-# INLINE basicLibVisibility #-}
+
 basicFieldGrammar
     :: (FieldGrammar g, Applicative (g Basic))
     => g Basic Basic
@@ -269,5 +277,21 @@ basicFieldGrammar = mkBasic
     <*> optionalFieldDefAla "version"       MQuoted  basicVersion nullVersion
     <*> optionalField       "package-name"           basicPkgName
     <*> optionalField       "lib-name"               basicLibName
+    <+> optionalFieldDef    "visibility"             basicLibVisibility LibraryVisibilityPrivate
   where
-    mkBasic n v pn ln = Basic n v pn (maybe LMainLibName LSubLibName ln)
+    mkBasic n v pn ln lv = Basic n v pn ln' lv'
+      where
+        ln' = maybe LMainLibName LSubLibName ln
+        -- Older GHCs (<8.8) always report installed libraries as private
+        -- because their ghc-pkg builds with an older Cabal.
+        -- So we always set LibraryVisibilityPublic for main (unnamed) libs.
+        -- This can be removed once we stop supporting GHC<8.8, at the
+        -- condition that we keep marking main libraries as public when
+        -- registering them.
+        lv' = if
+                let MungedPackageName _ mln = n in
+                -- We need to check both because on ghc<8.2 ln' will always
+                -- be LMainLibName
+                ln' == LMainLibName && mln == LMainLibName
+              then LibraryVisibilityPublic
+              else lv
diff --git a/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.expr
@@ -29,7 +29,7 @@ InstalledPackageInfo
    installedUnitId = `UnitId "internal-preprocessor-test-0.1.0.0"`,
    instantiatedWith = [],
    ldOptions = [],
-   libVisibility = LibraryVisibilityPrivate,
+   libVisibility = LibraryVisibilityPublic,
    libraryDirs = ["/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/build",
                   "/home/ogre/Documents/other-haskell/cabal/cabal-testsuite/PackageTests/CustomPreProcess/setup.dist/work/dist/build"],
    libraryDynDirs = [],

diff --git a/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.format b/Cabal/tests/ParserTests/ipi/internal-preprocessor-test.format
@@ -1,5 +1,6 @@
 name:               internal-preprocessor-test
 version:            0.1.0.0
+visibility:         public
 id:                 internal-preprocessor-test-0.1.0.0
 key:                internal-preprocessor-test-0.1.0.0
 license:            GPL-3

diff --git a/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.expr
@@ -2071,7 +2071,7 @@ InstalledPackageInfo
                 "-lm",
                 "-lm",
                 "-lm"],
-   libVisibility = LibraryVisibilityPrivate,
+   libVisibility = LibraryVisibilityPublic,
    libraryDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"],
    libraryDynDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"],
    license = Right BSD3,

diff --git a/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.format b/Cabal/tests/ParserTests/ipi/issue-2276-ghc-9885.format
@@ -1,5 +1,6 @@
 name:                 transformers
 version:              0.5.2.0
+visibility:           public
 id:                   transformers-0.5.2.0
 key:                  transformers-0.5.2.0
 license:              BSD3

diff --git a/Cabal/tests/ParserTests/ipi/transformers.expr b/Cabal/tests/ParserTests/ipi/transformers.expr
@@ -71,7 +71,7 @@ InstalledPackageInfo
    installedUnitId = `UnitId "transformers-0.5.2.0"`,
    instantiatedWith = [],
    ldOptions = [],
-   libVisibility = LibraryVisibilityPrivate,
+   libVisibility = LibraryVisibilityPublic,
    libraryDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"],
    libraryDynDirs = ["/opt/ghc/8.2.2/lib/ghc-8.2.2/transformers-0.5.2.0"],
    license = Right BSD3,

diff --git a/Cabal/tests/ParserTests/ipi/transformers.format b/Cabal/tests/ParserTests/ipi/transformers.format
@@ -1,5 +1,6 @@
 name:                 transformers
 version:              0.5.2.0
+visibility:           public
 id:                   transformers-0.5.2.0
 key:                  transformers-0.5.2.0
 license:              BSD3

diff --git a/cabal-install/Distribution/Client/Config.hs b/cabal-install/Distribution/Client/Config.hs
@@ -413,7 +413,8 @@ instance Semigroup SavedConfig where
         configExactConfiguration  = combine configExactConfiguration,
         configFlagError           = combine configFlagError,
         configRelocatable         = combine configRelocatable,
-        configUseResponseFiles    = combine configUseResponseFiles
+        configUseResponseFiles    = combine configUseResponseFiles,
+        configAllowDependingOnPrivateLibs = combine configAllowDependingOnPrivateLibs
         }
         where
           combine        = combine'        savedConfigureFlags

diff --git a/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs b/cabal-install/Distribution/Client/ProjectConfig/Legacy.hs
@@ -687,7 +687,8 @@ convertToLegacyAllPackageConfig
       configFlagError           = mempty,                --TODO: ???
       configRelocatable         = mempty,
       configDebugInfo           = mempty,
-      configUseResponseFiles    = mempty
+      configUseResponseFiles    = mempty,
+      configAllowDependingOnPrivateLibs = mempty
     }
 
     haddockFlags = mempty {
@@ -757,7 +758,8 @@ convertToLegacyPerPackageConfig PackageConfig {..} =
       configFlagError           = mempty,                --TODO: ???
       configRelocatable         = packageConfigRelocatable,
       configDebugInfo           = packageConfigDebugInfo,
-      configUseResponseFiles    = mempty
+      configUseResponseFiles    = mempty,
+      configAllowDependingOnPrivateLibs = mempty
     }
 
     installFlags = mempty {

diff --git a/cabal-install/Distribution/Client/ProjectPlanning.hs b/cabal-install/Distribution/Client/ProjectPlanning.hs
@@ -3390,6 +3390,9 @@ setupHsConfigureFlags (ReadyPackage elab@ElaboratedConfiguredPackage{..})
     configUserInstall         = mempty -- don't rely on defaults
     configPrograms_           = mempty -- never use, shouldn't exist
     configUseResponseFiles    = mempty
+    -- TODO set to true when the solver can prevent private-library-deps by itself
+    -- (issue #6039)
+    configAllowDependingOnPrivateLibs = mempty
 
 setupHsConfigureArgs :: ElaboratedConfiguredPackage
                      -> [String]

diff --git a/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out b/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit-fail.out
@@ -9,5 +9,5 @@ Installing internal library sublib in <PATH>
 Registering library 'sublib' for Lib-0.1.0.0..
 # Setup configure
 Configuring executable 'exe' for Lib-0.1.0.0..
-setup: Encountered missing dependencies:
+setup: Encountered missing or private dependencies:
     sublib -any
diff --git a/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs b/cabal-testsuite/PackageTests/ConfigureComponent/SubLib/setup-explicit.test.hs
@@ -5,6 +5,6 @@ main = setupTest $ do
         base_id <- getIPID "base"
         setup_install ["sublib", "--cid", "sublib-0.1-abc"]
         setup_install [ "exe", "--exact-configuration"
-                      , "--dependency", "sublib=sublib-0.1-abc"
+                      , "--dependency", "sublib:sublib=sublib-0.1-abc"
                       , "--dependency", "base=" ++ base_id ]
         runExe' "exe" [] >>= assertOutputContains "OK"
diff --git a/cabal-testsuite/PackageTests/MultipleLibraries/cabal.out b/cabal-testsuite/PackageTests/MultipleLibraries/cabal.out
@@ -0,0 +1,12 @@
+# cabal v2-build
+Resolving dependencies...
+Build profile: -w ghc-<GHCVER> -O1
+In order, the following will be built:
+ - d-0.1.0.0 (lib:privatelib) (first run)
+ - p-0.1.0.0 (lib) (first run)
+Configuring library 'privatelib' for d-0.1.0.0..
+Preprocessing library 'privatelib' for d-0.1.0.0..
+Building library 'privatelib' for d-0.1.0.0..
+Configuring library for p-0.1.0.0..
+cabal: Encountered missing or private dependencies:
+    d : {privatelib} ==0.1.0.0
diff --git a/cabal-testsuite/PackageTests/MultipleLibraries/cabal.project b/cabal-testsuite/PackageTests/MultipleLibraries/cabal.project
@@ -0,0 +1,4 @@
+packages:
+  d
+  p
+
diff --git a/cabal-testsuite/PackageTests/MultipleLibraries/cabal.test.hs b/cabal-testsuite/PackageTests/MultipleLibraries/cabal.test.hs
@@ -0,0 +1,4 @@
+import Test.Cabal.Prelude
+main = cabalTest $
+    void $ fails (cabal' "v2-build" ["p"])
+
diff --git a/cabal-testsuite/PackageTests/MultipleLibraries/d/d.cabal b/cabal-testsuite/PackageTests/MultipleLibraries/d/d.cabal
@@ -0,0 +1,12 @@
+cabal-version: 3.0
+name: d
+version: 0.1.0.0
+
+-- See issue #6038
+library
+  default-language: Haskell2010
+
+library privatelib
+  visibility: private
+  default-language: Haskell2010
+
diff --git a/cabal-testsuite/PackageTests/MultipleLibraries/p/p.cabal b/cabal-testsuite/PackageTests/MultipleLibraries/p/p.cabal
@@ -0,0 +1,8 @@
+cabal-version: 3.0
+name: p
+version: 0.1.0.0
+
+library
+  build-depends: d:privatelib
+  default-language: Haskell2010
+