Add metadata checks to upgraded dar

sdk/bazel-haskell-deps.bzl

@@ -18,8 +18,8 @@ load("@dadew//:dadew.bzl", "dadew_tool_home")
 load("@rules_haskell//haskell:cabal.bzl", "stack_snapshot")
 load("//bazel_tools/ghc-lib:repositories.bzl", "ghc_lib_and_dependencies")
 
-GHCIDE_REV = "eff0d9141f5825f4765fb0899f65f5174cb29261"
-GHCIDE_SHA256 = "a43aa87c1b8e4ff4b861c0ab728df8ac125ab4c4c01420eaa86d60c1e32f5c87"
+GHCIDE_REV = "c73370d4f0be0159095eb3718a84f0996e84e7cc"
+GHCIDE_SHA256 = "52981ca9ce2c8508de5c590f02a71f1885a9e31bc6de932b2e25a59ad90c1d28"
 GHCIDE_LOCAL_PATH = None
 JS_JQUERY_VERSION = "3.3.1"
 JS_DGTABLE_VERSION = "0.5.2"

sdk/compiler/damlc/daml-ide-core/BUILD.bazel

@@ -66,6 +66,7 @@ da_haskell_library(
         "//compiler/damlc/daml-package-config",
         "//compiler/damlc/daml-rule-types",
         "//compiler/scenario-service/client",
+        "//daml-assistant:daml-project-config",
         "//libs-haskell/bazel-runfiles",
         "//libs-haskell/da-hs-base",
         "//sdk-version/hs:sdk-version-class-lib",

sdk/compiler/damlc/daml-ide-core/src/Development/IDE/Core/Rules/Daml.hs

@@ -23,7 +23,7 @@ import qualified DA.Daml.LF.Proto3.EncodeV1 as EncodeV1
 import qualified DA.Daml.LF.Proto3.EncodeV2 as EncodeV2
 import HscTypes
 import MkIface
-import Maybes (MaybeErr(..))
+import Maybes (MaybeErr(..), rightToMaybe)
 import TcRnMonad (initIfaceLoad)
 
 import qualified "zip-archive" Codec.Archive.Zip as ZipArchive
@@ -38,6 +38,8 @@ import DA.Daml.LF.Ast (renderMajorVersion, Version (versionMajor))
 import DA.Daml.Options
 import DA.Daml.Options.Packaging.Metadata
 import DA.Daml.Options.Types
+import DA.Daml.Project.Consts (projectConfigName)
+import DA.Daml.Project.Types (ProjectPath (..))
 import Data.Aeson hiding (Options)
 import Data.Bifunctor (bimap)
 import Data.Binary (Binary())
@@ -536,25 +538,60 @@ generatePackageMap version mbProjRoot userPkgDbs = do
                      (LF.extPackagePkg $ LF.dalfPackagePkg pkg)
                      (LF.dalfPackageId pkg)
 
+getUpgradedPackageErrs :: Options -> LSP.NormalizedFilePath -> LF.Package -> [FileDiagnostic]
+getUpgradedPackageErrs opts file mainPkg = catMaybes $
+  [ justIf (not $ optDamlLfVersion opts `LF.supports` LF.featurePackageUpgrades) $
+      ideErrorPretty file $ mconcat
+        [ "Main package LF Version "
+        , LF.renderVersion $ optDamlLfVersion opts
+        , " does not support Smart Contract Upgrades"
+        ]
+  , justIf (not $ LF.packageLfVersion mainPkg `LF.supports` LF.featurePackageUpgrades) $
+      ideErrorPretty file $ mconcat
+        [ "Upgraded package LF Version "
+        , LF.renderVersion $ LF.packageLfVersion mainPkg
+        , " does not support Smart Contract Upgrades"
+        ]
+  ] ++ case LF.packageMetadata mainPkg of
+    Nothing -> [Just $ ideErrorPretty file ("Upgraded DAR does not contain metadata" :: T.Text)]
+    Just meta ->
+      [ justIf (optMbPackageName opts /= Just (LF.packageName meta)) $
+          ideErrorPretty file $ T.unlines
+            [ "Upgraded package must have the same package name as main package."
+            , "Expected " <> maybe "<unknown>" LF.unPackageName (optMbPackageName opts)
+            , "Got " <> LF.unPackageName (LF.packageName meta)
+            ]
+      , justIf (optMbPackageVersion opts == Just (LF.packageVersion meta)) $
+          ideErrorPretty file $ mconcat
+            [ "Upgradeed package cannot have the same package version as main package ("
+            , LF.unPackageVersion $ LF.packageVersion meta
+            , ")"
+            ]
+      ]
+  where
+    justIf :: Bool -> a -> Maybe a
+    justIf cond val = guard cond >> Just val
+
 extractUpgradedPackageRule :: Options -> Rules ()
 extractUpgradedPackageRule opts = do
   defineNoFile $ \ExtractUpgradedPackage ->
     case uiUpgradedPackagePath (optUpgradeInfo opts) of
       Nothing -> pure Nothing
-      Just path -> use ExtractUpgradedPackageFile (toNormalizedFilePath' path)
+      Just path -> Just <$> use_ ExtractUpgradedPackageFile (toNormalizedFilePath' path)
   define $ \ExtractUpgradedPackageFile file -> do
     ExtractedDar{edMain,edDalfs} <- liftIO $ extractDar (fromNormalizedFilePath file)
     let bsMain = BSL.toStrict $ ZipArchive.fromEntry edMain
-    let bsDeps = BSL.toStrict . ZipArchive.fromEntry <$> edDalfs
-    let mainAndDeps :: Either Archive.ArchiveError ((LF.PackageId, LF.Package), [(LF.PackageId, LF.Package)])
+        bsDeps = BSL.toStrict . ZipArchive.fromEntry <$> edDalfs
+        mainAndDeps :: Either Archive.ArchiveError ((LF.PackageId, LF.Package), [(LF.PackageId, LF.Package)])
         mainAndDeps = do
            main <- Archive.decodeArchive Archive.DecodeAsMain bsMain
            deps <- Archive.decodeArchive Archive.DecodeAsDependency `traverse` bsDeps
            pure (main, deps)
-    let myThing = case mainAndDeps of
-          Left _ -> ([ideErrorPretty file ("Could not decode file as a DAR." :: T.Text)], Nothing)
-          Right mainAndDeps -> ([], Just mainAndDeps)
-    pure myThing
+        packageConfigFilePath = maybe file (LSP.toNormalizedFilePath . (</> projectConfigName) . unwrapProjectPath) $ optMbPackageConfigPath opts
+        diags = case mainAndDeps of
+          Left _ -> [ideErrorPretty packageConfigFilePath ("Could not decode file as a DAR." :: T.Text)]
+          Right ((_, mainPkg), _) -> getUpgradedPackageErrs opts packageConfigFilePath mainPkg
+    pure (diags, guard (null diags) >> rightToMaybe mainAndDeps)
 
 readDalfPackage :: FilePath -> IO (Either FileDiagnostic LF.DalfPackage)
 readDalfPackage dalf = do

sdk/compiler/damlc/daml-opts/BUILD.bazel

@@ -27,6 +27,7 @@ da_haskell_library(
     deps = [
         "//compiler/daml-lf-ast",
         "//compiler/damlc/daml-package-config",
+        "//daml-assistant:daml-project-config",
         "//libs-haskell/bazel-runfiles",
         "//libs-haskell/da-hs-base",
     ],

sdk/compiler/damlc/daml-opts/daml-opts-types/DA/Daml/Options/Types.hs

@@ -43,6 +43,7 @@ module DA.Daml.Options.Types
 import Control.Monad.Reader
 import DA.Bazel.Runfiles
 import qualified DA.Daml.LF.Ast as LF
+import DA.Daml.Project.Types (ProjectPath)
 import DA.Pretty
 import qualified DA.Service.Logger as Logger
 import qualified DA.Service.Logger.Impl.IO as Logger.IO
@@ -72,6 +73,8 @@ data Options = Options
     -- ^ Name of the package (version not included, so this is not the unit id)
   , optMbPackageVersion :: Maybe LF.PackageVersion
     -- ^ Version of the package
+  , optMbPackageConfigPath :: Maybe ProjectPath
+    -- ^ Path to the daml.yaml
   , optIfaceDir :: Maybe FilePath
     -- ^ directory to write interface files to. If set to `Nothing` we default to <current working dir>.daml/interfaces.
   , optPackageImports :: [PackageFlag]
@@ -252,6 +255,7 @@ defaultOptions mbVersion =
         , optStablePackages = Nothing
         , optMbPackageName = Nothing
         , optMbPackageVersion = Nothing
+        , optMbPackageConfigPath = Nothing
         , optIfaceDir = Nothing
         , optPackageImports = []
         , optShakeProfiling = Nothing

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

@@ -141,6 +141,7 @@ import DA.Daml.Options.Types (EnableScenarioService(..),
                               optIncrementalBuild,
                               optMbPackageName,
                               optMbPackageVersion,
+                              optMbPackageConfigPath,
                               optPackageDbs,
                               optPackageImports,
                               optScenarioService,
@@ -813,9 +814,10 @@ execIde telemetry (Debug debug) enableScenarioService autorunAllScenarios option
                       whenJust gcpStateM $ \gcpState -> Logger.GCP.logIgnored gcpState
                       f loggerH
                   TelemetryDisabled -> f loggerH
-          mPkgConfig <- withMaybeConfig (withPackageConfig defaultProjectPath) pure
+          pkgPath <- getCanonDefaultProjectPath
+          mPkgConfig <- withMaybeConfig (withPackageConfig pkgPath) pure
           let pkgConfUpgradeDar = pUpgradeDar =<< mPkgConfig
-          options <- updateUpgradePath "ide" options pkgConfUpgradeDar
+          options <- updateUpgradePath "ide" pkgPath options pkgConfUpgradeDar
           options <- pure options
               { optScenarioService = enableScenarioService
               , optEnableOfInterestRule = True
@@ -824,6 +826,9 @@ execIde telemetry (Debug debug) enableScenarioService autorunAllScenarios option
               -- individual options. As a stopgap we ignore the argument to
               -- --jobs.
               , optThreads = 0
+              , optMbPackageName = pName <$> mPkgConfig
+              , optMbPackageVersion = mPkgConfig >>= pVersion
+              , optMbPackageConfigPath = Just pkgPath
               }
           installDepsAndInitPackageDb options (InitPkgDb True)
           scenarioServiceConfig <- readScenarioServiceConfig
@@ -934,6 +939,9 @@ execLint inputFiles opts =
 defaultProjectPath :: ProjectPath
 defaultProjectPath = ProjectPath "."
 
+getCanonDefaultProjectPath :: IO ProjectPath
+getCanonDefaultProjectPath = fmap ProjectPath $ canonicalizePath $ unwrapProjectPath defaultProjectPath
+
 -- | If we're in a daml project, read the daml.yaml field, install the dependencies and create the
 -- project local package database. Otherwise do nothing.
 execInit :: SdkVersion.Class.SdkVersioned => Options -> ProjectOpts -> Command
@@ -998,16 +1006,17 @@ execBuild projectOpts opts mbOutFile incrementalBuild initPkgDb enableMultiPacka
   Command Build (Just projectOpts) $ evalContT $ do
     relativize <- ContT $ withProjectRoot' (projectOpts {projectCheck = ProjectCheck "" False})
 
-    let buildSingle :: PackageConfigFields -> IO ()
-        buildSingle pkgConfig = void $ buildEffect relativize pkgConfig opts mbOutFile incrementalBuild initPkgDb
-        buildMulti :: Maybe PackageConfigFields -> ProjectPath -> IO ()
-        buildMulti mPkgConfig multiPackageConfigPath = do
+    let buildSingle :: ProjectPath -> PackageConfigFields -> IO ()
+        buildSingle pkgPath pkgConfig = void $ buildEffect relativize pkgPath pkgConfig opts mbOutFile incrementalBuild initPkgDb
+        buildMulti :: ProjectPath -> Maybe PackageConfigFields -> ProjectPath -> IO ()
+        buildMulti pkgPath mPkgConfig multiPackageConfigPath = do
           hPutStrLn stderr $ "Running multi-package build of "
             <> maybe ("all packages in " <> unwrapProjectPath multiPackageConfigPath) (T.unpack . LF.unPackageName . pName) mPkgConfig <> "."
           withMultiPackageConfig multiPackageConfigPath $ \multiPackageConfig ->
-            multiPackageBuildEffect relativize mPkgConfig multiPackageConfig projectOpts opts mbOutFile incrementalBuild initPkgDb noCache
+            multiPackageBuildEffect relativize pkgPath mPkgConfig multiPackageConfig opts mbOutFile incrementalBuild initPkgDb noCache
 
-    mPkgConfig <- ContT $ withMaybeConfig $ withPackageConfig defaultProjectPath
+    pkgPath <- liftIO getCanonDefaultProjectPath
+    mPkgConfig <- ContT $ withMaybeConfig $ withPackageConfig pkgPath
     liftIO $ if getEnableMultiPackage enableMultiPackage then do
       mMultiPackagePath <- getMultiPackagePath multiPackageLocation
       -- At this point, if mMultiPackagePath is Just, we know it points to a multi-package.yaml
@@ -1017,7 +1026,7 @@ execBuild projectOpts opts mbOutFile incrementalBuild initPkgDb enableMultiPacka
         (True, _, Just multiPackagePath) ->
           -- TODO[SW]: Ideally we would error here if any of the flags that change `opts` has been set, as it won't be propagated
           -- Its unclear how to implement this.
-          buildMulti Nothing multiPackagePath
+          buildMulti pkgPath Nothing multiPackagePath
 
         -- We're attempting to multi-package build --all but we don't have a multi-package.yaml
         (True, _, Nothing) -> do
@@ -1026,12 +1035,12 @@ execBuild projectOpts opts mbOutFile incrementalBuild initPkgDb enableMultiPacka
           exitFailure
 
         -- We know the package we want and we have a multi-package.yaml
-        (False, Just pkgConfig, Just multiPackagePath) -> buildMulti (Just pkgConfig) multiPackagePath
+        (False, Just pkgConfig, Just multiPackagePath) -> buildMulti pkgPath (Just pkgConfig) multiPackagePath
 
         -- We know the package we want but we do not have a multi-package. The user has provided no reason they would want a multi-package build.
         (False, Just pkgConfig, Nothing) -> do
           hPutStrLn stderr $ "Running single package build of " <> T.unpack (LF.unPackageName $ pName pkgConfig) <> " as no multi-package.yaml was found."
-          buildSingle pkgConfig
+          buildSingle pkgPath pkgConfig
 
         -- We have no package context, but we have found a multi package at the current directory
         (False, Nothing, Just _) -> do
@@ -1057,7 +1066,7 @@ execBuild projectOpts opts mbOutFile incrementalBuild initPkgDb enableMultiPacka
             then do
               hPutStrLn stderr "Multi-package build option used with multi-package disabled - re-enable it by setting the --enable-multi-package=yes flag."
               exitFailure
-            else buildSingle pkgConfig
+            else buildSingle pkgPath pkgConfig
 
 -- Takes the withPackageConfig style functions and changes the continuation
 -- to give a Maybe, where Nothing signifies a missing file. Parse errors are still thrown
@@ -1078,9 +1087,18 @@ withMaybeConfig withConfig handler = do
     ) (withConfig $ pure . Just)
   handler mConfig
 
-buildEffect :: SdkVersion.Class.SdkVersioned => (FilePath -> IO FilePath) -> PackageConfigFields -> Options -> Maybe FilePath -> IncrementalBuild -> InitPkgDb -> IO (Maybe LF.PackageId)
-buildEffect relativize pkgConfig opts mbOutFile incrementalBuild initPkgDb = do
-  (pkgConfig, opts) <- syncUpgradesField pkgConfig opts
+buildEffect
+  :: SdkVersion.Class.SdkVersioned
+  => (FilePath -> IO FilePath)
+  -> ProjectPath
+  -> PackageConfigFields
+  -> Options
+  -> Maybe FilePath
+  -> IncrementalBuild
+  -> InitPkgDb
+  -> IO (Maybe LF.PackageId)
+buildEffect relativize pkgPath pkgConfig opts mbOutFile incrementalBuild initPkgDb = do
+  (pkgConfig, opts) <- syncUpgradesField pkgPath pkgConfig opts
   let PackageConfigFields{..} = pkgConfig
   installDepsAndInitPackageDb opts initPkgDb
   loggerH <- getLogger opts "build"
@@ -1093,6 +1111,7 @@ buildEffect relativize pkgConfig opts mbOutFile incrementalBuild initPkgDb = do
       opts
         { optMbPackageName = Just pName
         , optMbPackageVersion = pVersion
+        , optMbPackageConfigPath = Just pkgPath
         , optIncrementalBuild = incrementalBuild
         }
       loggerH
@@ -1114,20 +1133,25 @@ buildEffect relativize pkgConfig opts mbOutFile incrementalBuild initPkgDb = do
             Nothing -> pure $ distDir </> name <.> "dar"
             Just out -> rel out
 
-        syncUpgradesField :: PackageConfigFields -> Options -> IO (PackageConfigFields, Options)
-        syncUpgradesField pkgConf opts = do
-          opts <- updateUpgradePath "build" opts (pUpgradeDar pkgConf)
+        syncUpgradesField :: ProjectPath -> PackageConfigFields -> Options -> IO (PackageConfigFields, Options)
+        syncUpgradesField pkgPath pkgConf opts = do
+          opts <- updateUpgradePath "build" pkgPath opts (pUpgradeDar pkgConf)
           pure (pkgConf { pUpgradeDar = uiUpgradedPackagePath (optUpgradeInfo opts) }, opts)
 
-updateUpgradePath :: T.Text -> Options -> Maybe FilePath -> IO Options
-updateUpgradePath context opts@Options{optUpgradeInfo} newPkgPath = do
-  uiUpgradedPackagePath <- case (newPkgPath, uiUpgradedPackagePath optUpgradeInfo) of
+updateUpgradePath :: T.Text -> ProjectPath -> Options -> Maybe FilePath -> IO Options
+updateUpgradePath context projectPath opts@Options{optUpgradeInfo} newPkgPath = do
+  let projectFilePath = unwrapProjectPath projectPath
+  optCanonPath <- traverse canonicalizePath $ uiUpgradedPackagePath optUpgradeInfo
+  pkgCanonPath <- withCurrentDirectory projectFilePath $ traverse canonicalizePath newPkgPath
+  -- optUpgradeInfo is normalised to current directory
+  -- newPkgPath is normalised to daml.yaml location (or currentDirectory)
+  uiUpgradedPackagePath <- case (pkgCanonPath, optCanonPath) of
     (Just damlYamlOption, Just buildFlagsOption) | damlYamlOption /= buildFlagsOption -> do
       loggerH <- getLogger opts context
       Logger.logError loggerH $ T.unlines
         [ "ERROR: Specified two different DARs to run upgrade checks against:"
-        , "  Path specified in daml.yaml `upgrades:` field is '" <> T.pack damlYamlOption <> "'"
-        , "  Path specified in `--upgrades` build option is '" <> T.pack buildFlagsOption <> "'"
+        , "  Path specified in daml.yaml `upgrades:` field is '" <> T.pack (makeRelative projectFilePath damlYamlOption) <> "'"
+        , "  Path specified in `--upgrades` build option is '" <> T.pack (makeRelative projectFilePath buildFlagsOption) <> "'"
         ]
       exitFailure
     (a, b) ->
@@ -1169,19 +1193,18 @@ updateUpgradePath context opts@Options{optUpgradeInfo} newPkgPath = do
 multiPackageBuildEffect
   :: SdkVersion.Class.SdkVersioned
   => (FilePath -> IO FilePath)
+  -> ProjectPath
   -> Maybe PackageConfigFields -- Nothing signifies build all
   -> MultiPackageConfigFields
-  -> ProjectOpts
   -> Options
   -> Maybe FilePath
   -> IncrementalBuild
   -> InitPkgDb
   -> MultiPackageNoCache
   -> IO ()
-multiPackageBuildEffect relativize mPkgConfig multiPackageConfig projectOpts opts mbOutFile incrementalBuild initPkgDb noCache = do
+multiPackageBuildEffect relativize pkgPath mPkgConfig multiPackageConfig opts mbOutFile incrementalBuild initPkgDb noCache = do
   vfs <- makeVFSHandle
   loggerH <- getLogger opts "multi-package build"
-  cDir <- getCurrentDirectory
   assistantPath <- getEnv "DAML_ASSISTANT"
   -- Must drop DAML_PROJECT from env var so it can be repopulated based on `cwd`
   assistantEnv <- filter (flip notElem ["DAML_PROJECT", "DAML_SDK_VERSION", "DAML_SDK"] . fst) <$> getEnvironment
@@ -1197,11 +1220,11 @@ multiPackageBuildEffect relativize mPkgConfig multiPackageConfig projectOpts opt
 
       buildableDataDeps = BuildableDataDeps $ flip Map.lookup buildableDataDepsMapping
       mRootPkgBuilder = flip fmap mPkgConfig $ \pkgConfig -> do
-        mPkgId <- buildEffect relativize pkgConfig opts mbOutFile incrementalBuild initPkgDb
+        mPkgId <- buildEffect relativize pkgPath pkgConfig opts mbOutFile incrementalBuild initPkgDb
         pure $ fromMaybe
           (error "Internal error: root package was built from dalf, giving no package-id. This is incompatible with multi-package")
           mPkgId
-      mRootPkgData = (toNormalizedFilePath' $ maybe cDir unwrapProjectPath $ projectRoot projectOpts,) <$> mRootPkgBuilder
+      mRootPkgData = (toNormalizedFilePath' $ unwrapProjectPath pkgPath,) <$> mRootPkgBuilder
       rule = buildMultiRule assistantRunner buildableDataDeps noCache mRootPkgData
 
   -- Set up a near empty shake environment, with just the buildMulti rule

sdk/compiler/damlc/lib/DA/Cli/Options.hs

@@ -410,6 +410,7 @@ optionsParser numProcessors enableScenarioService parsePkgName parseDlintUsage =
     ~(optMbPackageName, optMbPackageVersion) <-
         fmap parseUnitId parsePkgName
 
+    let optMbPackageConfigPath = Nothing
     optImportPath <- optImportPath
     optPackageDbs <- optPackageDir
     optAccessTokenPath <- optAccessTokenPath