diff --git a/sdk/bazel-haskell-deps.bzl b/sdk/bazel-haskell-deps.bzl index 2938b13c4e5d..a4839fd0a866 100644 --- a/sdk/bazel-haskell-deps.bzl +++ b/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 = "2bea7cd1ec043d7e44b762ae27d8498dd165e90b" +GHCIDE_SHA256 = "9d994cf7d3f08e7a4f0716ab1117f1c8275e864d0d34e3d793cecd1c2b47a32f" GHCIDE_LOCAL_PATH = None JS_JQUERY_VERSION = "3.3.1" JS_DGTABLE_VERSION = "0.5.2" diff --git a/sdk/compiler/damlc/daml-ide-core/BUILD.bazel b/sdk/compiler/damlc/daml-ide-core/BUILD.bazel index c5c33769ddd4..68867b49d76f 100644 --- a/sdk/compiler/damlc/daml-ide-core/BUILD.bazel +++ b/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", diff --git a/sdk/compiler/damlc/daml-ide-core/src/Development/IDE/Core/Rules/Daml.hs b/sdk/compiler/damlc/daml-ide-core/src/Development/IDE/Core/Rules/Daml.hs index b2abf8c03de5..a39c98034471 100644 --- a/sdk/compiler/damlc/daml-ide-core/src/Development/IDE/Core/Rules/Daml.hs +++ b/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 "" 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 diff --git a/sdk/compiler/damlc/daml-opts/BUILD.bazel b/sdk/compiler/damlc/daml-opts/BUILD.bazel index e5834a28309b..c271d01c09cf 100644 --- a/sdk/compiler/damlc/daml-opts/BUILD.bazel +++ b/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", ], diff --git a/sdk/compiler/damlc/daml-opts/daml-opts-types/DA/Daml/Options/Types.hs b/sdk/compiler/damlc/daml-opts/daml-opts-types/DA/Daml/Options/Types.hs index 8af740ebbdd9..ca25a365b034 100644 --- a/sdk/compiler/damlc/daml-opts/daml-opts-types/DA/Daml/Options/Types.hs +++ b/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 .daml/interfaces. , optPackageImports :: [PackageFlag] @@ -252,6 +255,7 @@ defaultOptions mbVersion = , optStablePackages = Nothing , optMbPackageName = Nothing , optMbPackageVersion = Nothing + , optMbPackageConfigPath = Nothing , optIfaceDir = Nothing , optPackageImports = [] , optShakeProfiling = Nothing diff --git a/sdk/compiler/damlc/lib/DA/Cli/Damlc.hs b/sdk/compiler/damlc/lib/DA/Cli/Damlc.hs index c47db41d9b28..693de31fa276 100644 --- a/sdk/compiler/damlc/lib/DA/Cli/Damlc.hs +++ b/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 diff --git a/sdk/compiler/damlc/lib/DA/Cli/Options.hs b/sdk/compiler/damlc/lib/DA/Cli/Options.hs index 9bf45d6d21a5..acb6a4fb4a64 100644 --- a/sdk/compiler/damlc/lib/DA/Cli/Options.hs +++ b/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