Improve handling of exposed-modules with data-dependencies (#5330)

* Improve handling of exposed-modules with data-dependencies

Previously, we tried to rename all modules of a dependency via
--package. This fails if some of those modules are not exported. This
was trivial to hit as a user since the ``daml-trigger`` library made
use of this.

This PR adds a few things to improve the situation:

1. We only rename modules that are exposed. This fixes the issue if
   you don’t actually reference a non-exposed module from your
   data-dependency.
2. I’ve removed the exposed-modules from daml-trigger. I don’t think
   they are essential here given that the module name has `Internal`
   in the name and it’s too easy to have something that actually
   references the non-exposed module since the types are reexported.
3. I’ve added documentation that mentions this issue.
4. I’ve added a warning if your exposed-modules are excluding some
   modules. Maybe worth turning this into an error in the future.

changelog_begin
changelog_end

* Update compiler/damlc/lib/DA/Cli/Damlc/Packaging.hs

Co-Authored-By: associahedron <231829+associahedron@users.noreply.github.com>

Co-authored-by: associahedron <231829+associahedron@users.noreply.github.com>

compiler/damlc/daml-compiler/src/DA/Daml/Compiler/Dar.hs

@@ -56,6 +56,7 @@ import qualified Development.IDE.Types.Logger as IdeLogger
 import SdkVersion
 import System.Directory.Extra
 import System.FilePath
+import System.IO
 
 import MkIface
 import Module
@@ -152,6 +153,12 @@ buildDar service pkgConf@PackageConfigFields {..} ifDir dalfInput = do
                          [ (T.pack $ unitIdString unitId, LF.dalfPackageBytes pkg, LF.dalfPackageId pkg)
                          | (unitId, pkg) <- Map.toList dalfDependencies0
                          ]
+                 liftIO $ whenJust (fmap (pkgModuleNames \\) pExposedModules) $ \hidden ->
+                     when (notNull hidden) $
+                     hPutStr stderr $ unlines
+                         [ "WARNING: The following modules are not part of exposed-modules: " <> show hidden
+                         , "This can cause issues if those modules are referenced from a data-dependency."
+                         ]
                  confFile <- liftIO $ mkConfFile lfVersion pkgConf pkgModuleNames pkgId
                  let dataFiles = [confFile]
                  srcRoot <- getSrcRoot pSrc

compiler/damlc/lib/DA/Cli/Damlc/Packaging.hs

@@ -24,15 +24,20 @@ import qualified Data.Set as Set
 import qualified Data.Text.Extended as T
 import Development.IDE.Core.Rules (useE, useNoFileE)
 import Development.IDE.Core.Service (runActionSync)
+import Development.IDE.GHC.Util (hscEnv)
 import Development.IDE.Types.Location
+import "ghc-lib-parser" DynFlags (DynFlags)
+import "ghc-lib-parser" HscTypes as GHC
 import "ghc-lib-parser" Module (UnitId, unitIdString)
 import qualified Module as GHC
+import qualified "ghc-lib-parser" Packages as GHC
 import System.Directory.Extra
 import System.Exit
 import System.FilePath
 import System.Info.Extra
 import System.IO.Extra
 import System.Process (callProcess)
+import "ghc-lib-parser" UniqSet
 
 import DA.Bazel.Runfiles
 import DA.Cli.Damlc.Base
@@ -96,7 +101,7 @@ createProjectPackageDb projectRoot opts thisSdkVer deps dataDeps
     loggerH <- getLogger opts "generate package maps"
     mbRes <- withDamlIdeState opts loggerH diagnosticsLogger $ \ide -> runActionSync ide $ runMaybeT $
         (,) <$> useNoFileE GenerateStablePackages
-            <*> useE GeneratePackageMap  projectRoot
+            <*> useE GeneratePackageMap projectRoot
     (stablePkgs, dependencies) <- maybe (fail "Failed to generate package info") pure mbRes
     let stablePkgIds :: Set LF.PackageId
         stablePkgIds = Set.fromList $ map LF.dalfPackageId $ MS.elems stablePkgs
@@ -191,6 +196,24 @@ createProjectPackageDb projectRoot opts thisSdkVer deps dataDeps
                 [ show k <> " [" <> intercalate "," (map (T.unpack . LF.unPackageId) (Set.toList v)) <> "]"
                 | (k,v) <- MS.toList unitIdConflicts ]
 
+    -- We only do this at this point to ensure that all checks for duplicate unit ids have come
+    -- before and don’t end up blowing up GHC.
+    exposedModules <- do
+        -- We need to avoid inference of package flags. Otherwise, we will
+        -- try to load package flags for data-dependencies that we have not generated
+        -- yet. We only look for the packages in the package db so the --package flags
+        -- do not matter and can be actively harmful since we might have picked up
+        -- some from the daml.yaml if they are explicitly specified.
+        opts <- pure opts
+            { optInferDependantPackages = InferDependantPackages False
+            , optPackageImports = []
+            }
+        hscEnv <-
+            (maybe (exitWithError "Failed to list exposed modules") (pure . hscEnv) =<<) $
+            withDamlIdeState opts loggerH diagnosticsLogger $ \ide ->
+            runActionSync ide $ runMaybeT $ useE GhcSession projectRoot
+        pure $! getExposedModules $ hsc_dflags hscEnv
+
     let (depGraph, vertexToNode) = buildLfPackageGraph pkgs stablePkgs dependencies
     -- Iterate over the dependency graph in topological order.
     -- We do a topological sort on the transposed graph which ensures that
@@ -202,7 +225,6 @@ createProjectPackageDb projectRoot opts thisSdkVer deps dataDeps
       -- so we don’t need to generate interface files for them.
       unless (pkgId `Set.member` stablePkgIds || pkgId `Set.member` dependencyPkgIds) $ do
         let unitIdStr = unitIdString $ unitId pkgNode
-        let _instancesUnitIdStr = "instances-" <> unitIdStr
         let pkgIdStr = T.unpack $ LF.unPackageId pkgId
         let (pkgName, mbPkgVersion) = LF.splitUnitId (unitId pkgNode)
         let deps =
@@ -228,6 +250,7 @@ createProjectPackageDb projectRoot opts thisSdkVer deps dataDeps
             mbPkgVersion
             deps
             dependencies
+            exposedModules
   where
     dbPath = projectPackageDatabase </> lfVersionString (optDamlLfVersion opts)
     clearPackageDb = do
@@ -238,6 +261,14 @@ createProjectPackageDb projectRoot opts thisSdkVer deps dataDeps
         removePathForcibly dbPath
         createDirectoryIfMissing True $ dbPath </> "package.conf.d"
 
+-- Produce the list of exposed modules for each package.
+getExposedModules :: DynFlags -> MS.Map UnitId (UniqSet GHC.ModuleName)
+getExposedModules df =
+    MS.fromList $
+    map (\pkgConf -> (getUnitId pkgConf, mkUniqSet $ map fst $ GHC.exposedModules pkgConf)) $
+    GHC.listPackageConfigMap df
+    where getUnitId = GHC.DefiniteUnitId . GHC.DefUnitId . GHC.unitId
+
 toGhcModuleName :: LF.ModuleName -> GHC.ModuleName
 toGhcModuleName = GHC.mkModuleName . T.unpack . LF.moduleNameString
 
@@ -254,13 +285,16 @@ generateAndInstallIfaceFiles ::
     -> Maybe LF.PackageVersion
     -> [(UnitId, LF.DalfPackage)] -- ^ List of packages referenced by this package.
     -> MS.Map UnitId LF.DalfPackage -- ^ Map of all packages in `dependencies`.
+    -> MS.Map UnitId (UniqSet GHC.ModuleName)
     -> IO ()
-generateAndInstallIfaceFiles dalf src opts workDir dbPath projectPackageDatabase pkgIdStr pkgName mbPkgVersion deps dependencies = do
+generateAndInstallIfaceFiles dalf src opts workDir dbPath projectPackageDatabase pkgIdStr pkgName mbPkgVersion deps dependencies exposedModules = do
     loggerH <- getLogger opts "generate interface files"
     let src' = [ (toNormalizedFilePath' $ workDir </> fromNormalizedFilePath nfp, str) | (nfp, str) <- src]
     mapM_ writeSrc src'
     -- We expose dependencies under a Pkg_$pkgId prefix so we can unambiguously refer to them
-    -- while avoiding name collisions in package imports.
+    -- while avoiding name collisions in package imports. Note that we can only do this
+    -- for exposed modules. GHC gets very unhappy if you try to remap modules that are not
+    -- exposed.
     -- TODO (MK)
     -- Use this scheme to refer to data-dependencies as well and replace the CurrentSdk prefix by this.
     let depImps =
@@ -268,8 +302,12 @@ generateAndInstallIfaceFiles dalf src opts workDir dbPath projectPackageDatabase
                   [ (toGhcModuleName modName, toGhcModuleName (prefixDependencyModule dalfPackageId modName))
                   | mod <- NM.toList $ LF.packageModules $ LF.extPackagePkg dalfPackagePkg
                   , let modName = LF.moduleName mod
+                  -- NOTE (MK) I am not sure if this lookup
+                  -- can ever fail but for now, we keep exposing the module in that case.
+                  , maybe True (toGhcModuleName modName `elementOfUniqSet`) mbExposed
                   ]
             | (unitId, LF.DalfPackage{..}) <- MS.toList dependencies <> deps
+            , let mbExposed = MS.lookup unitId exposedModules
             ]
     opts <-
         pure $ opts
@@ -512,7 +550,7 @@ showPackageFlag unitId exposeImplicit mods = concat
 -- as expected but we got no output.
 -- So now we are extra careful to make sure that the error message is actually
 -- written somewhere.
-exitWithError :: String -> IO ()
+exitWithError :: String -> IO a
 exitWithError msg = do
     hPutStrLn stderr msg
     hFlush stderr

compiler/damlc/tests/src/DA/Test/Packaging.hs

@@ -703,6 +703,64 @@ tests tools@Tools{damlc} = testGroup "Packaging" $
           (exitCode, _, stderr) <- readProcessWithExitCode damlc ["build", "--project-root", projDir] ""
           exitCode @?= ExitFailure 1
           assertBool ("Expected \"non-exhaustive\" error in stderr but got: " <> show stderr) ("non-exhaustive" `isInfixOf` stderr)
+
+    , testCaseSteps "data-dependencies + exposed-modules" $ \step -> withTempDir $ \projDir -> do
+          step "Building dependency"
+          createDirectoryIfMissing True (projDir </> "dependency")
+          writeFileUTF8 (projDir </> "dependency" </> "daml.yaml") $ unlines
+            [ "sdk-version: " <> sdkVersion
+            , "name: dependency"
+            , "version: 0.0.1"
+            , "source: ."
+            , "dependencies: [daml-prim, daml-stdlib]"
+            , "exposed-modules: [B]"
+            ]
+          writeFileUTF8 (projDir </> "dependency" </> "A.daml") $ unlines
+            [ "module A where"
+            ]
+          writeFileUTF8 (projDir </> "dependency" </> "B.daml") $ unlines
+            [ "module B where"
+            , "class C a where f : a"
+            ]
+          withCurrentDirectory (projDir </> "dependency") $ callProcessSilent damlc ["build", "-o", "dependency.dar"]
+          step "Building data-dependency"
+          createDirectoryIfMissing True (projDir </> "data-dependency")
+          writeFileUTF8 (projDir </> "data-dependency" </> "daml.yaml") $ unlines
+            [ "sdk-version: " <> sdkVersion
+            , "name: data-dependency"
+            , "version: 0.0.1"
+            , "source: ."
+            , "dependencies: [daml-prim, daml-stdlib]"
+            ]
+          writeFileUTF8 (projDir </> "data-dependency" </> "B.daml") $ unlines
+            [ "module B where"
+            , "class C a where f : a"
+            ]
+          writeFileUTF8 (projDir </> "data-dependency" </> "C.daml") $ unlines
+            [ "module C where"
+            , "import B"
+            , "data Foo = Foo"
+            , "instance C Foo where f = Foo"
+            ]
+          withCurrentDirectory (projDir </> "data-dependency") $ callProcessSilent damlc ["build", "-o", "data-dependency.dar"]
+          step "Building main"
+          createDirectoryIfMissing True (projDir </> "main")
+          writeFileUTF8 (projDir </> "main" </> "daml.yaml") $ unlines
+            [ "sdk-version: " <> sdkVersion
+            , "name: main"
+            , "version: 0.0.1"
+            , "source: ."
+            , "dependencies: [daml-prim, daml-stdlib, " <> show (projDir </> "dependency" </> "dependency.dar") <> "]"
+            , "data-dependencies: [" <> show (projDir </> "data-dependency" </> "data-dependency.dar") <>  "]"
+            ]
+          writeFileUTF8 (projDir </> "main" </> "Main.daml") $ unlines
+            [ "module Main where"
+            , "import \"dependency\" B"
+            , "import C"
+            , "foo : Foo"
+            , "foo = f"
+            ]
+          withCurrentDirectory (projDir </> "main") $ callProcessSilent damlc ["build", "-o", "main.dar"]
     ] <>
     [ lfVersionTests damlc
     , dataDependencyTests tools

daml-assistant/integration-tests/src/DA/Daml/Assistant/IntegrationTests.hs

@@ -179,6 +179,24 @@ packagingTests = testGroup "packaging"
         withCurrentDirectory projDir $ callCommandQuiet "daml build --target 1.dev"
         let dar = projDir </> ".daml/dist/script-example-0.0.1.dar"
         assertBool "script-example-0.0.1.dar was not created." =<< doesFileExist dar
+     , testCase "Package depending on daml-script and daml-trigger can use data-dependencies" $ withTempDir $ \tmpDir -> do
+        callCommandQuiet $ unwords ["daml", "new", tmpDir </> "data-dependency"]
+        withCurrentDirectory (tmpDir </> "data-dependency") $ callCommandQuiet "daml build -o data-dependency.dar"
+        createDirectoryIfMissing True (tmpDir </> "proj")
+        writeFileUTF8 (tmpDir </> "proj" </> "daml.yaml") $ unlines
+          [ "sdk-version: " <> sdkVersion
+          , "name: proj"
+          , "version: 0.0.1"
+          , "source: ."
+          , "dependencies: [daml-prim, daml-stdlib, daml-script, daml-trigger]"
+          , "data-dependencies: [" <> show (tmpDir </> "data-dependency" </> "data-dependency.dar") <> "]"
+          ]
+        writeFileUTF8 (tmpDir </> "proj" </> "A.daml") $ unlines
+          [ "module A where"
+          , "import Main (setup)"
+          , "setup' = setup"
+          ]
+        withCurrentDirectory (tmpDir </> "proj") $ callCommandQuiet "daml build"
      , testCase "Run init-script" $ withTempDir $ \tmpDir -> do
         let projDir = tmpDir </> "init-script-example"
         createDirectoryIfMissing True (projDir </> "daml")

docs/source/daml/reference/packages.rst

@@ -93,6 +93,8 @@ When importing packages this way, the DAML compiler will try to reconstruct the
 
 #. Export lists cannot be recovered, so imports via ``data-dependencies`` can access definitions that were originally hidden. This means it is up to the importing module to respect the data abstraction of the original module. Note that this is the same for all code that runs on the ledger, since the ledger does not provide special support for data abstraction.
 
+#. If you have a ``dependency`` that limits the modules that can be accessed via ``exposed-modules``, you can get an error if you also have a ``data-dependency`` that references something from the hidden modules (even if it is only reexported). Since ``exposed-modules`` are not available on the ledger in general, we recommend to not make use of them and instead rely on naming conventions (e.g., suffix module names with ``.Internal``) to make it clear which modules are part of the public API.
+
 #. Prior to DAML-LF version 1.8, typeclasses could not be reconstructed. This means if you have a package that is compiled with an older version of DAML-LF, typeclasses and typeclass instances will not be carried over via data-dependencies, and you won't be able to call functions that rely on typeclass instances. This includes the template functions, such as ``create``, ``signatory``, and ``exercise``, as these rely on typeclass instances.
 
 #. Starting from DAML-LF version 1.8, when possible, typeclass instances will be reconstructed by re-using the typeclass definitions from dependencies, such as the typeclasses exported in ``daml-stdlib``. However, if the typeclass signature has changed, you will get an instance for a reconstructed typeclass instead, which will not interoperate with code from dependencies. Furthermore, if the typeclass definition uses the ``FunctionalDependencies`` language extension, this may cause additional problems, since the functional dependencies cannot be recovered. So this is something to keep in mind when redefining typeclasses and when using ``FunctionalDependencies``.

triggers/daml/BUILD.bazel

@@ -32,10 +32,6 @@ sdk-version: {sdk}
 name: daml-trigger
 source: daml
 version: 0.0.1
-exposed-modules:
-  - Daml.Trigger
-  - Daml.Trigger.Assert
-  - Daml.Trigger.LowLevel
 dependencies:
   - daml-stdlib
   - daml-prim