diff --git a/compiler/daml-lf-proto-decode/src/DA/Daml/LF/Proto3/Archive/Decode.hs b/compiler/daml-lf-proto-decode/src/DA/Daml/LF/Proto3/Archive/Decode.hs index b283b4c16c92..7c3f3b6d2404 100644 --- a/compiler/daml-lf-proto-decode/src/DA/Daml/LF/Proto3/Archive/Decode.hs +++ b/compiler/daml-lf-proto-decode/src/DA/Daml/LF/Proto3/Archive/Decode.hs @@ -4,6 +4,7 @@ module DA.Daml.LF.Proto3.Archive.Decode ( decodeArchive , decodeArchivePackageId + , decodeArchiveLfVersion , decodePackage , ArchiveError(..) , DecodingMode(..) @@ -47,6 +48,11 @@ decodeArchive mode bytes = do package <- decodePackage mode packageId payloadBytes return (packageId, package) +decodeArchiveLfVersion :: BS.ByteString -> Either ArchiveError LF.Version +decodeArchiveLfVersion bytes = do + (packageId, payloadBytes) <- decodeArchiveHeader bytes + decodePackageLfVersion packageId payloadBytes + -- | Decode an LF archive payload, returning the package -- Used to decode a BS returned from the PackageService ledger API decodePackage :: DecodingMode -> LF.PackageId -> BS.ByteString -> Either ArchiveError LF.Package @@ -55,7 +61,12 @@ decodePackage mode packageId payloadBytes = do DecodeAsMain -> LF.PRSelf DecodeAsDependency -> LF.PRImport packageId payload <- over _Left (ProtobufError . show) $ Proto.fromByteString payloadBytes - over _Left (ProtobufError. show) $ Decode.decodePayload packageId selfPackageRef payload + over _Left (ProtobufError . show) $ Decode.decodePayload packageId selfPackageRef payload + +decodePackageLfVersion :: LF.PackageId -> BS.ByteString -> Either ArchiveError LF.Version +decodePackageLfVersion packageId payloadBytes = do + payload <- over _Left (ProtobufError . show) $ Proto.fromByteString payloadBytes + over _Left (ProtobufError . show) $ Decode.extractLFVersion packageId payload -- | Decode an LF archive header, returning the package-id and the payload decodeArchiveHeader :: BS.ByteString -> Either ArchiveError (LF.PackageId, BS.ByteString) diff --git a/compiler/daml-lf-proto-decode/src/DA/Daml/LF/Proto3/Decode.hs b/compiler/daml-lf-proto-decode/src/DA/Daml/LF/Proto3/Decode.hs index 7e98080bab17..1937e799c7dd 100644 --- a/compiler/daml-lf-proto-decode/src/DA/Daml/LF/Proto3/Decode.hs +++ b/compiler/daml-lf-proto-decode/src/DA/Daml/LF/Proto3/Decode.hs @@ -6,6 +6,7 @@ module DA.Daml.LF.Proto3.Decode ( Error(..) , decodePayload + , extractLFVersion ) where import Com.Daml.DamlLfDev.DamlLf (ArchivePayload(..), ArchivePayloadSum(..)) @@ -47,3 +48,11 @@ decodePayload pkgId selfPackageRef payload = case archivePayloadSum payload of Nothing -> Left $ ParseError "Empty payload" where minorText = TL.toStrict (archivePayloadMinor payload) + +extractLFVersion :: PackageId -> ArchivePayload -> Either Error LF.Version +extractLFVersion pkgId payload = case archivePayloadSum payload of + Just (ArchivePayloadSumDamlLf1 _) -> decodeLfVersion LF.V1 pkgId minorText + Just (ArchivePayloadSumDamlLf2 _) -> decodeLfVersion LF.V2 pkgId minorText + Nothing -> Left $ ParseError "Empty payload" + where + minorText = TL.toStrict (archivePayloadMinor payload) diff --git a/compiler/daml-lf-reader/src/DA/Daml/LF/Reader.hs b/compiler/daml-lf-reader/src/DA/Daml/LF/Reader.hs index 8e38acb9cf50..49aec5b8b74d 100644 --- a/compiler/daml-lf-reader/src/DA/Daml/LF/Reader.hs +++ b/compiler/daml-lf-reader/src/DA/Daml/LF/Reader.hs @@ -9,9 +9,13 @@ module DA.Daml.LF.Reader , Dalfs(..) , readDalfManifest , readDalfs + , readDalfsWithMeta + , dalfsToList ) where import "zip-archive" Codec.Archive.Zip +import qualified DA.Daml.LF.Ast as LF +import Data.Bitraversable (bimapM) import Data.ByteString (ByteString) import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL @@ -19,7 +23,9 @@ import qualified Data.ByteString.UTF8 as BSUTF8 import Data.Char import Data.Either.Extra import Data.List.Extra +import qualified Data.Text as T import Data.Void +import System.FilePath (takeBaseName) import Text.Megaparsec import Text.Megaparsec.Byte @@ -90,11 +96,14 @@ data DalfManifest = DalfManifest } deriving (Show) -- | The dalfs stored in the DAR. -data Dalfs = Dalfs - { mainDalf :: BSL.ByteString - , dalfs :: [BSL.ByteString] +data Dalfs a = Dalfs + { mainDalf :: a + , dalfs :: [a] -- ^ Excludes the mainDalf. - } deriving (Show) + } deriving (Eq, Ord, Show, Functor) + +dalfsToList :: Dalfs a -> [a] +dalfsToList d = mainDalf d : dalfs d readDalfManifest :: Archive -> Either String DalfManifest readDalfManifest dar = do @@ -111,13 +120,27 @@ readDalfManifest dar = do lookup attrName attrs missingAttr attrName = Left $ "No " <> BSUTF8.toString attrName <> " attribute in manifest." -readDalfs :: Archive -> Either String Dalfs +readDalfs :: Archive -> Either String (Dalfs BSL.ByteString) readDalfs dar = do DalfManifest{..} <- readDalfManifest dar mainDalf <- getEntry dar mainDalfPath dalfs <- mapM (getEntry dar) (delete mainDalfPath dalfPaths) pure $ Dalfs mainDalf dalfs +extractNameAndPackageIdFromPath :: FilePath -> Maybe (T.Text, LF.PackageId) +extractNameAndPackageIdFromPath = bimapM (T.stripSuffix "-") (pure . LF.PackageId) . T.breakOnEnd "-" . T.pack . takeBaseName + +readDalfsWithMeta :: Archive -> Either String (Dalfs (T.Text, BSL.ByteString, LF.PackageId)) +readDalfsWithMeta dar = do + DalfManifest{..} <- readDalfManifest dar + let getEntryWithMeta dar path = do + dalf <- getEntry dar path + (name, pkgId) <- maybe (Left "Couldn't parse dalf filename, didn't contain dash.") Right $ extractNameAndPackageIdFromPath path + pure (name, dalf, pkgId) + mainDalf <- getEntryWithMeta dar mainDalfPath + dalfs <- mapM (getEntryWithMeta dar) (delete mainDalfPath dalfPaths) + pure $ Dalfs mainDalf dalfs + getEntry :: Archive -> FilePath -> Either String BSL.ByteString getEntry dar path = case findEntryByPath path dar of Nothing -> Left $ "Could not find " <> path <> " in DAR" diff --git a/compiler/damlc/daml-compiler/src/DA/Daml/Compiler/Dar.hs b/compiler/damlc/daml-compiler/src/DA/Daml/Compiler/Dar.hs index 93293df1fe05..9c5610103947 100644 --- a/compiler/damlc/daml-compiler/src/DA/Daml/Compiler/Dar.hs +++ b/compiler/damlc/daml-compiler/src/DA/Daml/Compiler/Dar.hs @@ -3,6 +3,7 @@ module DA.Daml.Compiler.Dar ( createDarFile , buildDar + , buildCompositeDar , createArchive , FromDalf(..) , breakAt72Bytes @@ -25,8 +26,9 @@ import Control.Monad.Trans.Class import Control.Monad.Trans.Maybe import Control.Monad.Trans.Resource (ResourceT) import qualified DA.Daml.LF.Ast as LF -import DA.Daml.LF.Proto3.Archive (encodeArchiveAndHash) +import DA.Daml.LF.Proto3.Archive (decodeArchiveLfVersion, encodeArchiveAndHash) import qualified DA.Daml.LF.Proto3.Archive as Archive +import DA.Daml.LF.Reader (Dalfs (..), dalfsToList, readDalfsWithMeta) import DA.Daml.Compiler.ExtractDar (extractDar,ExtractedDar(..)) import DA.Daml.LF.TypeChecker.Error (Error(EUnsupportedFeature)) import DA.Daml.LF.TypeChecker.Upgrade as TypeChecker.Upgrade @@ -48,6 +50,7 @@ import qualified Data.NameMap as NM import qualified Data.Set as S import qualified Data.Text as T import Data.Time +import Data.Tuple.Extra (second3, snd3, thd3) import Development.IDE.Core.API import Development.IDE.Core.Service (getIdeOptions) import Development.IDE.Core.RuleTypes.Daml @@ -71,7 +74,7 @@ import DA.Daml.Project.Types (UnresolvedReleaseVersion(..)) import qualified "zip-archive" Codec.Archive.Zip as ZipArchive -import SdkVersion.Class (SdkVersioned) +import SdkVersion.Class (SdkVersioned, unresolvedBuiltinSdkVersion) -- | Create a DAR file by running a ZipArchive action. createDarFile :: Logger.Handle IO -> FilePath -> Zip.ZipArchive () -> IO () @@ -206,6 +209,34 @@ buildDar service PackageConfigFields {..} ifDir dalfInput = do , Just pkgId ) +-- | Takes a list of paths to dars, composite package name and composite package version +-- Merges together all the dars without usage checks, generates a main package with 0 modules +-- Generated package uses latest LF version with matching Major version to the dars given, and the current builtin sdk version. +buildCompositeDar :: SdkVersioned => [FilePath] -> LF.PackageName -> LF.PackageVersion -> IO (Zip.ZipArchive ()) +buildCompositeDar darPaths name version = do + dars <- + forM darPaths $ \darPath -> do + bs <- BSL.readFile darPath + pure $ ZipArchive.toArchive bs + + let darDalfs = fmap (fmap (second3 BSL.toStrict) . either error id . readDalfsWithMeta) dars + darLfVersions <- forM darDalfs $ either (fail . DA.Pretty.renderPretty) pure . decodeArchiveLfVersion . snd3 . mainDalf + + let lfVersion = + case nubOrd $ LF.versionMajor <$> darLfVersions of + -- Note that this will not select dev. We may want to detect if any of the packages are `X.dev` and use this if so (and warn) + [mv] -> LF.defaultOrLatestStable mv + xs -> error $ "Dars contained multiple different Major LF versions: " <> show (sort xs) + pkgMeta = LF.PackageMetadata name version Nothing + pkg = LF.Package { LF.packageLfVersion = lfVersion, LF.packageModules = NM.empty, LF.packageMetadata = Just pkgMeta } + (dalf, pkgId) = encodeArchiveAndHash pkg + conf = mkConfFile name (Just version) [] Nothing [] pkgId + -- Dalfs included unique by packageId + dalfs = nubOrdOn thd3 $ concatMap dalfsToList darDalfs + dar = createArchive name (Just version) unresolvedBuiltinSdkVersion pkgId dalf dalfs "." [] [conf] [] + + pure dar + validateExposedModules :: Maybe [ModuleName] -> [ModuleName] -> MaybeT Action () validateExposedModules mbExposedModules pkgModuleNames = do let missingExposed = diff --git a/compiler/damlc/daml-package-config/src/DA/Daml/Package/Config.hs b/compiler/damlc/daml-package-config/src/DA/Daml/Package/Config.hs index 1b3c26057dd4..f70bac2d7df4 100644 --- a/compiler/damlc/daml-package-config/src/DA/Daml/Package/Config.hs +++ b/compiler/damlc/daml-package-config/src/DA/Daml/Package/Config.hs @@ -7,6 +7,7 @@ module DA.Daml.Package.Config ( MultiPackageConfigFields (..) , PackageConfigFields (..) + , CompositeDar (..) , parseProjectConfig , overrideSdkVersion , withPackageConfig @@ -21,7 +22,7 @@ import DA.Daml.Project.Consts import DA.Daml.Project.Types import Control.Exception.Safe (throwIO, displayException) -import Control.Monad (when) +import Control.Monad (forM_, when) import Control.Monad.Extra (loopM) import Control.Monad.Trans.Class (lift) import Control.Monad.Trans.State.Lazy @@ -100,9 +101,22 @@ checkPkgConfig PackageConfigFields {pName, pVersion} = versionRegex = "^(0|[1-9][0-9]*)(\\.(0|[1-9][0-9]*))*$" :: T.Text packageNameRegex = "^[A-Za-z][A-Za-z0-9]*(\\-[A-Za-z][A-Za-z0-9]*)*$" :: T.Text +data CompositeDar = CompositeDar + { cdName :: LF.PackageName + , cdVersion :: LF.PackageVersion + , cdPackages :: [FilePath] + , cdDars :: [FilePath] + , cdPath :: FilePath + } + deriving Show + data MultiPackageConfigFields = MultiPackageConfigFields { mpPackagePaths :: [FilePath] + , mpCompositeDars :: [CompositeDar] + , mpTransitiveCompositeDarNames :: [(FilePath, [LF.PackageName])] + , mpPath :: FilePath } + deriving Show -- | Intermediate of MultiPackageConfigFields that carries links to other config files, before being flattened into a single MultiPackageConfigFields data MultiPackageConfigFieldsIntermediate = MultiPackageConfigFieldsIntermediate @@ -110,11 +124,34 @@ data MultiPackageConfigFieldsIntermediate = MultiPackageConfigFieldsIntermediate , mpiOtherConfigFiles :: [FilePath] } +parseCompositeDar :: MultiPackageCompositeDar -> Either ConfigError CompositeDar +parseCompositeDar compositeDar = do + cdName <- queryMultiPackageCompositeDarRequired ["name"] compositeDar + cdVersion <- queryMultiPackageCompositeDarRequired ["version"] compositeDar + cdPackages <- fromMaybe [] <$> queryMultiPackageCompositeDar ["packages"] compositeDar + cdDars <- fromMaybe [] <$> queryMultiPackageCompositeDar ["dars"] compositeDar + cdPath <- queryMultiPackageCompositeDarRequired ["path"] compositeDar + if null $ cdPackages <> cdDars + then Left $ ConfigFileInvalid "multi-package" $ Y.InvalidYaml $ Just + $ Y.YamlException $ "Missing either `packages` or `dars` in composite dar \"" <> (T.unpack $ LF.unPackageName cdName) <> "\"" + else Right CompositeDar {..} + -- | Parse the multi-package.yaml file for auto rebuilds/IDE intelligence in multi-package projects -parseMultiPackageConfig :: MultiPackageConfig -> Either ConfigError MultiPackageConfigFieldsIntermediate -parseMultiPackageConfig multiPackage = do - mpiConfigFields <- MultiPackageConfigFields . fromMaybe [] <$> queryMultiPackageConfig ["packages"] multiPackage +parseMultiPackageConfig :: MultiPackageConfig -> FilePath -> Either ConfigError MultiPackageConfigFieldsIntermediate +parseMultiPackageConfig multiPackage mpPath = do + mpPackagePaths <- fromMaybe [] <$> queryMultiPackageConfig ["packages"] multiPackage mpiOtherConfigFiles <- fromMaybe [] <$> queryMultiPackageConfig ["projects"] multiPackage + compositeDarObjects <- fromMaybe [] <$> queryMultiPackageConfig ["composite-dars"] multiPackage + mpCompositeDars <- traverse parseCompositeDar compositeDarObjects + -- n^2 but this list is usually so small that its not worth complicating the logic + forM_ mpCompositeDars $ \cd -> + let matching = length $ filter (\otherCd -> (cdName cd, cdVersion cd) == (cdName otherCd, cdVersion otherCd)) mpCompositeDars + in when (matching > 1) $ Left $ ConfigFileInvalid "multi-package" $ Y.InvalidYaml $ Just + $ Y.YamlException $ "Multiple composite dars with the same name and version: " <> + T.unpack (LF.unPackageName (cdName cd) <> "-" <> LF.unPackageVersion (cdVersion cd)) + + let mpTransitiveCompositeDarNames = [] + mpiConfigFields = MultiPackageConfigFields {..} Right MultiPackageConfigFieldsIntermediate {..} overrideSdkVersion :: PackageConfigFields -> IO PackageConfigFields @@ -175,11 +212,25 @@ findMultiPackageConfig projectPath = do let newPath = takeDirectory path in pure $ if path == newPath then Right Nothing else Left newPath +canonicalizeCompositeDar :: CompositeDar -> IO CompositeDar +canonicalizeCompositeDar cd = do + canonPackages <- traverse canonicalizePath $ cdPackages cd + canonDars <- traverse canonicalizePath $ cdDars cd + canonPath <- canonicalizePath $ cdPath cd + + pure cd { cdPackages = canonPackages, cdDars = canonDars, cdPath = canonPath } + canonicalizeMultiPackageConfigIntermediate :: ProjectPath -> MultiPackageConfigFieldsIntermediate -> IO MultiPackageConfigFieldsIntermediate -canonicalizeMultiPackageConfigIntermediate projectPath (MultiPackageConfigFieldsIntermediate (MultiPackageConfigFields packagePaths) multiPackagePaths) = +canonicalizeMultiPackageConfigIntermediate projectPath (MultiPackageConfigFieldsIntermediate mpc multiPackagePaths) = withCurrentDirectory (unwrapProjectPath projectPath) $ do MultiPackageConfigFieldsIntermediate - <$> (MultiPackageConfigFields <$> traverse canonicalizePath packagePaths) + <$> + ( MultiPackageConfigFields + <$> traverse canonicalizePath (mpPackagePaths mpc) + <*> traverse canonicalizeCompositeDar (mpCompositeDars mpc) + <*> pure (mpTransitiveCompositeDarNames mpc) + <*> pure (mpPath mpc) + ) <*> traverse canonicalizePath multiPackagePaths -- Given some computation to give a result and dependencies, we explore the entire cyclic graph to give the combined @@ -202,11 +253,16 @@ fullParseMultiPackageConfig :: ProjectPath -> IO MultiPackageConfigFields fullParseMultiPackageConfig startPath = do mpcs <- exploreAndFlatten startPath $ \projectPath -> do multiPackage <- readMultiPackageConfig projectPath - multiPackageConfigI <- either throwIO pure (parseMultiPackageConfig multiPackage) + multiPackageConfigI <- either throwIO pure (parseMultiPackageConfig multiPackage $ unwrapProjectPath projectPath) canonMultiPackageConfigI <- canonicalizeMultiPackageConfigIntermediate projectPath multiPackageConfigI pure (ProjectPath <$> mpiOtherConfigFiles canonMultiPackageConfigI, mpiConfigFields canonMultiPackageConfigI) - pure $ MultiPackageConfigFields $ nubOrd $ concatMap mpPackagePaths mpcs + pure MultiPackageConfigFields + { mpPackagePaths = nubOrd $ concatMap mpPackagePaths mpcs + , mpCompositeDars = mpCompositeDars $ head mpcs + , mpTransitiveCompositeDarNames = (\mpc -> (mpPath mpc, cdName <$> mpCompositeDars mpc)) <$> tail mpcs + , mpPath = mpPath $ head mpcs + } -- Gives the filepath where the multipackage was found if its not the same as project path. withMultiPackageConfig :: ProjectPath -> (MultiPackageConfigFields -> IO a) -> IO a diff --git a/compiler/damlc/lib/DA/Cli/Damlc.hs b/compiler/damlc/lib/DA/Cli/Damlc.hs index 1c003f89732c..42b58ecd82c4 100644 --- a/compiler/damlc/lib/DA/Cli/Damlc.hs +++ b/compiler/damlc/lib/DA/Cli/Damlc.hs @@ -31,6 +31,8 @@ import DA.Cli.Options (Debug(..), MultiPackageCleanAll(..), MultiPackageLocation(..), MultiPackageNoCache(..), + MultiPackageBuildCompositeDar(..), + MultiPackageBuildAllCompositeDars(..), ProjectOpts(..), Style(..), Telemetry(..), @@ -48,6 +50,8 @@ import DA.Cli.Options (Debug(..), multiPackageBuildAllOpt, multiPackageCleanAllOpt, multiPackageLocationOpt, + multiPackageBuildCompositeDarOpt, + multiPackageBuildAllCompositeDarsOpt, multiPackageNoCacheOpt, optionalDlintUsageParser, optionalOutputFileOpt, @@ -79,6 +83,7 @@ import DA.Cli.Damlc.Test (CoveragePaths(..), import DA.Daml.Compiler.Dar (FromDalf(..), breakAt72Bytes, buildDar, + buildCompositeDar, createDarFile, damlFilesInDir, getDamlRootFiles, @@ -141,6 +146,7 @@ import DA.Daml.Options.Types (EnableScenarioService(..), projectPackageDatabase) import DA.Daml.Package.Config (MultiPackageConfigFields(..), PackageConfigFields(..), + CompositeDar(..), checkPkgConfig, findMultiPackageConfig, withPackageConfig, @@ -175,9 +181,10 @@ import qualified Data.ByteString.Lazy.Char8 as BSLC import qualified Data.ByteString.UTF8 as BSUTF8 import Data.Either (fromRight, partitionEithers) import Data.FileEmbed (embedFile) +import Data.Foldable (traverse_) import qualified Data.HashSet as HashSet -import Data.List (isPrefixOf, isInfixOf) -import Data.List.Extra (elemIndices, nubOrd, nubSort, nubSortOn) +import Data.List (intercalate, isPrefixOf, isInfixOf) +import Data.List.Extra (elemIndices, nubOrd, nubSort, nubSortOn, unsnoc) import qualified Data.List.Split as Split import qualified Data.Map.Strict as Map import Data.Maybe (catMaybes, fromMaybe, listToMaybe, mapMaybe) @@ -186,6 +193,7 @@ import Data.Text.Encoding (encodeUtf8) import qualified Data.Text.Lazy.IO as TL import qualified Data.Text.IO as T import Data.Traversable (for) +import Data.Tuple (swap) import Data.Typeable (Typeable) import qualified Data.Yaml as Y import Development.IDE.Core.API (getDalf, makeVFSHandle, runActionSync, setFilesOfInterest) @@ -528,6 +536,8 @@ cmdBuildParser numProcessors = <*> multiPackageBuildAllOpt <*> multiPackageNoCacheOpt <*> multiPackageLocationOpt + <*> multiPackageBuildCompositeDarOpt + <*> multiPackageBuildAllCompositeDarsOpt cmdRepl :: SdkVersion.Class.SdkVersioned => Int -> Mod CommandFields Command cmdRepl numProcessors = @@ -942,6 +952,69 @@ getMultiPackagePath multiPackageLocation = exitFailure pure $ Just $ ProjectPath path +-- Renders a list of strings as "x, y, and z" +commaSepAnd :: [String] -> String +commaSepAnd [x] = x +commaSepAnd (unsnoc -> Just (xs, x)) = intercalate ", " xs <> " and " <> x +commaSepAnd _ = [] + +-- Gets a list of the (transitive) sub-project directories that define given composite dar name +findCompositeDarTransitiveDefiners :: MultiPackageConfigFields -> LF.PackageName -> [FilePath] +findCompositeDarTransitiveDefiners mpc darName = + mapMaybe (\(path, darNames) -> if darName `elem` darNames then Just path else Nothing) $ mpTransitiveCompositeDarNames mpc + +-- Prints a message warning if a composite dar exists in one or more sub-projects +warnTransitiveCompositeDar :: Handle -> MultiPackageConfigFields -> LF.PackageName -> IO () +warnTransitiveCompositeDar handle mpc name = do + let otherDefiners = findCompositeDarTransitiveDefiners mpc name + in when (not $ null otherDefiners) $ do + hPutStrLn handle $ "Warning: Found definition for " <> T.unpack (LF.unPackageName name) + <> " in the following sub-projects:" + traverse_ (hPutStrLn handle . (" - " <>)) otherDefiners + hPutStrLn handle $ "Use `--multi-package-path` to specify the multi-package.yaml " + <> "defining the composite-dar if you intended to build one of these composite dars." + +data MultiPackageBuildModeComposite a = SelectCompositeDars [a] | AllCompositeDars + +-- a is either CompositeDar or LF.PackageName +data MultiPackageBuildMode a + = SinglePackage PackageConfigFields + | MultiPackage MultiPackageBuildAll (MultiPackageBuildModeComposite a) + +toMaybePackageConfig :: MultiPackageBuildMode a -> Maybe PackageConfigFields +toMaybePackageConfig (SinglePackage pkgConfig) = Just pkgConfig +toMaybePackageConfig _ = Nothing + +realiseMultiBuildMode :: MultiPackageConfigFields -> MultiPackageBuildMode LF.PackageName -> IO (MultiPackageBuildMode CompositeDar) +realiseMultiBuildMode multiPackageConfig buildMode = + case buildMode of + SinglePackage pkgConfig -> pure $ SinglePackage pkgConfig + MultiPackage buildAll (SelectCompositeDars names) -> MultiPackage buildAll . SelectCompositeDars <$> extractCompositeDars names + MultiPackage buildAll AllCompositeDars -> pure $ MultiPackage buildAll AllCompositeDars + where + extractCompositeDars :: [LF.PackageName] -> IO [CompositeDar] + extractCompositeDars darNames = do + compositeDars <- + forM darNames $ \darName -> do + let isMatchingCompositeDar cd = + cdName cd == darName || + (LF.unPackageName (cdName cd) <> "-" <> LF.unPackageVersion (cdVersion cd)) == LF.unPackageName darName + matchingCompositeDars = filter isMatchingCompositeDar $ mpCompositeDars multiPackageConfig + case matchingCompositeDars of + [dar] -> pure dar + [] -> do + hPutStrLn stderr $ "Couldn't find composite dar with the name " <> T.unpack (LF.unPackageName darName) <> " in " <> mpPath multiPackageConfig + warnTransitiveCompositeDar stderr multiPackageConfig darName + exitFailure + dars -> do + hPutStrLn stderr "Multiple composite dars with the same name were found, to specify which you need, use one of the following full names:" + let toDarFullName cd = T.unpack $ LF.unPackageName (cdName cd) <> "-" <> LF.unPackageVersion (cdVersion cd) + traverse_ (hPutStrLn stderr . (" - " <>) . toDarFullName) dars + exitFailure + + forM_ compositeDars $ warnTransitiveCompositeDar stdout multiPackageConfig . cdName + pure compositeDars + execBuild :: SdkVersion.Class.SdkVersioned => ProjectOpts @@ -953,41 +1026,66 @@ execBuild -> MultiPackageBuildAll -> MultiPackageNoCache -> MultiPackageLocation + -> [MultiPackageBuildCompositeDar] + -> MultiPackageBuildAllCompositeDars -> Command -execBuild projectOpts opts mbOutFile incrementalBuild initPkgDb enableMultiPackage buildAll noCache multiPackageLocation = +execBuild + projectOpts opts mbOutFile + incrementalBuild initPkgDb + enableMultiPackage buildAll noCache multiPackageLocation compositeDarNames allCompositeDars = Command Build (Just projectOpts) $ evalContT $ do relativize <- ContT $ withProjectRoot' (projectOpts {projectCheck = ProjectCheck "" False}) - - let buildSingle :: PackageConfigFields -> IO () + let buildSingle :: PackageConfigFields -> IO () buildSingle pkgConfig = void $ buildEffect relativize pkgConfig opts mbOutFile incrementalBuild initPkgDb - buildMulti :: Maybe PackageConfigFields -> ProjectPath -> IO () - buildMulti mPkgConfig multiPackageConfigPath = do - putStrLn $ "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 - - -- TODO: This throws if you have the sdk-version only daml.yaml, ideally it should return Nothing + buildMulti :: MultiPackageBuildMode LF.PackageName -> ProjectPath -> IO () + buildMulti buildMode multiPackageConfigPath = + withMultiPackageConfig multiPackageConfigPath $ \multiPackageConfig -> do + realisedBuildMode <- realiseMultiBuildMode multiPackageConfig buildMode + + putStrLn $ "Running multi-package build of " <> case realisedBuildMode of + SinglePackage pkgConfig -> T.unpack $ LF.unPackageName $ pName pkgConfig + MultiPackage buildAll compositeDars -> + (if getMultiPackageBuildAll buildAll + then "all packages in " <> unwrapProjectPath multiPackageConfigPath <> "and " + else "") <> + (case compositeDars of + SelectCompositeDars compositeDars -> + "the following composite dar(s): " <> commaSepAnd (fmap (T.unpack . LF.unPackageName . cdName) compositeDars) + AllCompositeDars -> "all composite dars in " <> unwrapProjectPath multiPackageConfigPath + ) + multiPackageBuildEffect relativize realisedBuildMode multiPackageConfig projectOpts opts mbOutFile incrementalBuild initPkgDb noCache + mPkgConfig <- ContT $ withMaybeConfig $ withPackageConfig defaultProjectPath 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 + + let buildAnyCompositeDars = not (null compositeDarNames) || getMultiPackageBuildAllCompositeDars allCompositeDars - case (getMultiPackageBuildAll buildAll, mPkgConfig, mMultiPackagePath) of + case (getMultiPackageBuildAll buildAll || buildAnyCompositeDars, mPkgConfig, mMultiPackagePath) of -- We're attempting to multi-package build --all, so we require that we have a multi-package.yaml, but do not care if we have a daml.yaml - (True, _, Just multiPackagePath) -> + (True, _, Just multiPackagePath) -> do -- 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 + + when (getMultiPackageBuildAllCompositeDars allCompositeDars && not (null compositeDarNames)) $ do + hPutStrLn stderr "Cannot specify `--composite-dar` when `all-composite-dars` is provided" + exitFailure + + let buildMode = MultiPackage buildAll $ + if getMultiPackageBuildAllCompositeDars allCompositeDars + then AllCompositeDars + else SelectCompositeDars $ LF.PackageName . getMultiPackageBuildCompositeDar <$> compositeDarNames + buildMulti buildMode multiPackagePath -- We're attempting to multi-package build --all but we don't have a multi-package.yaml (True, _, Nothing) -> do hPutStrLn stderr - "Attempted to build all packages, but could not find a multi-package.yaml at current or parent directory. Use --multi-package-path to specify its location." + "Attempted to build all packages or a composite dar, but could not find a multi-package.yaml at current or parent directory. Use --multi-package-path to specify its location." 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 (SinglePackage 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 @@ -1014,6 +1112,7 @@ execBuild projectOpts opts mbOutFile incrementalBuild initPkgDb enableMultiPacka getMultiPackageBuildAll buildAll || getMultiPackageNoCache noCache || multiPackageLocation /= MPLSearch + || not (null compositeDarNames) if usedMultiPackageOption then do hPutStrLn stderr "Multi-package build option used with multi-package disabled - re-enable it by setting the --enable-multi-package=yes flag." @@ -1107,7 +1206,7 @@ buildEffect relativize pkgConfig@PackageConfigFields{..} opts mbOutFile incremen multiPackageBuildEffect :: SdkVersion.Class.SdkVersioned => (FilePath -> IO FilePath) - -> Maybe PackageConfigFields -- Nothing signifies build all + -> MultiPackageBuildMode CompositeDar -> MultiPackageConfigFields -> ProjectOpts -> Options @@ -1116,7 +1215,7 @@ multiPackageBuildEffect -> InitPkgDb -> MultiPackageNoCache -> IO () -multiPackageBuildEffect relativize mPkgConfig multiPackageConfig projectOpts opts mbOutFile incrementalBuild initPkgDb noCache = do +multiPackageBuildEffect relativize buildMode multiPackageConfig projectOpts opts mbOutFile incrementalBuild initPkgDb noCache = do vfs <- makeVFSHandle loggerH <- getLogger opts "multi-package build" cDir <- getCurrentDirectory @@ -1124,7 +1223,7 @@ multiPackageBuildEffect relativize mPkgConfig multiPackageConfig projectOpts opt -- 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 - buildableDataDepsMapping <- fmap Map.fromList $ for (mpPackagePaths multiPackageConfig) $ \path -> do + buildableDataDepsPairs <- for (mpPackagePaths multiPackageConfig) $ \path -> do darPath <- darPathFromDamlYaml path pure (darPath, path) @@ -1132,9 +1231,12 @@ multiPackageBuildEffect relativize mPkgConfig multiPackageConfig projectOpts opt withCreateProcess ((proc assistantPath args) {cwd = Just location, env = Just assistantEnv}) $ \_ _ _ p -> do exitCode <- waitForProcess p when (exitCode /= ExitSuccess) $ error $ "Failed to build package at " <> location <> "." + buildableDataDepsForwardMapping = Map.fromList buildableDataDepsPairs + buildableDataDepsBackwardMapping = Map.fromList $ swap <$> buildableDataDepsPairs + buildableDataDeps = + BuildableDataDeps (flip Map.lookup buildableDataDepsForwardMapping) (flip Map.lookup buildableDataDepsBackwardMapping) - buildableDataDeps = BuildableDataDeps $ flip Map.lookup buildableDataDepsMapping - mRootPkgBuilder = flip fmap mPkgConfig $ \pkgConfig -> do + mRootPkgBuilder = flip fmap (toMaybePackageConfig buildMode) $ \pkgConfig -> do mPkgId <- buildEffect relativize 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") @@ -1147,14 +1249,37 @@ multiPackageBuildEffect relativize mPkgConfig multiPackageConfig projectOpts opt (IDE.initialise rule (DummyLspEnv diagnosticsLogger) (toIdeLogger loggerH) noopDebouncer (toCompileOpts opts) vfs) IDE.shutdown $ \ideState -> runActionSync ideState - $ case mRootPkgData of - Nothing -> void $ uses_ BuildMulti $ toNormalizedFilePath' <$> mpPackagePaths multiPackageConfig - Just (rootPkgPath, _) -> void $ use_ BuildMulti rootPkgPath - -data AssistantRunner = AssistantRunner { runAssistant :: FilePath -> [String] -> IO ()} - --- Stores a mapping from dar path to project path -data BuildableDataDeps = BuildableDataDeps { getDataDepSource :: FilePath -> Maybe FilePath } + $ case (mRootPkgData, buildMode) of + (Just (rootPkgPath, _), _) -> void $ use_ BuildMulti rootPkgPath + (_, MultiPackage buildAll buildComposite) -> do + let compositeDars = case buildComposite of + SelectCompositeDars dars -> dars + AllCompositeDars -> mpCompositeDars multiPackageConfig + packagePaths = if getMultiPackageBuildAll buildAll + then toNormalizedFilePath' <$> mpPackagePaths multiPackageConfig + else nubOrd $ concatMap (fmap toNormalizedFilePath' . cdPackages) compositeDars + void $ uses_ BuildMulti packagePaths + liftIO $ traverse_ (buildAndWriteCompositeDar loggerH buildableDataDeps) compositeDars + _ -> error "Impossible case" + +buildAndWriteCompositeDar :: SdkVersion.Class.SdkVersioned => Logger.Handle IO -> BuildableDataDeps -> CompositeDar -> IO () +buildAndWriteCompositeDar loggerH buildableDataDeps cd = do + Logger.logInfo loggerH $ "Building " <> LF.unPackageName (cdName cd) <> " Composite Dar" + + let packageToDarPath pkgPath = + fromMaybe + (error $ pkgPath <> " is not listed in top-level `packages:` in any `multi-package.yaml`") + (getPackageDarPath buildableDataDeps pkgPath) -- This should be a backwards lookup :/ + darPaths = fmap packageToDarPath (cdPackages cd) <> cdDars cd + + dar <- buildCompositeDar darPaths (cdName cd) (cdVersion cd) + createDarFile loggerH (cdPath cd) dar + +data AssistantRunner = AssistantRunner { runAssistant :: FilePath -> [String] -> IO () } + +-- Stores a mapping from dar path to project path, and reverse +-- TODO: Consider Data.BiMap +data BuildableDataDeps = BuildableDataDeps { getDataDepSource :: FilePath -> Maybe FilePath, getPackageDarPath :: FilePath -> Maybe FilePath } data BuildMulti = BuildMulti deriving (Eq, Show, Typeable, Generic) diff --git a/compiler/damlc/lib/DA/Cli/Options.hs b/compiler/damlc/lib/DA/Cli/Options.hs index 176b53b365da..db11376cfcd4 100644 --- a/compiler/damlc/lib/DA/Cli/Options.hs +++ b/compiler/damlc/lib/DA/Cli/Options.hs @@ -6,8 +6,7 @@ module DA.Cli.Options ) where import Data.List.Extra (lower, splitOn, trim) -import Options.Applicative hiding (option, strOption) -import qualified Options.Applicative (option, strOption) +import Options.Applicative import Options.Applicative.Extended import Data.List import Data.Maybe @@ -166,6 +165,18 @@ newtype MultiPackageNoCache = MultiPackageNoCache {getMultiPackageNoCache :: Boo multiPackageNoCacheOpt :: Parser MultiPackageNoCache multiPackageNoCacheOpt = MultiPackageNoCache <$> switch (long "no-cache" <> help "Disables cache checking, rebuilding all dependencies") +newtype MultiPackageBuildCompositeDar = MultiPackageBuildCompositeDar {getMultiPackageBuildCompositeDar :: T.Text} +multiPackageBuildCompositeDarOpt :: Parser [MultiPackageBuildCompositeDar] +multiPackageBuildCompositeDarOpt = many $ MultiPackageBuildCompositeDar <$> strOption + ( metavar "COMPOSITE-DAR-NAME" + <> help "Builds the given composite dar as defined in multi-package.yaml" + <> long "composite-dar" + ) + +newtype MultiPackageBuildAllCompositeDars = MultiPackageBuildAllCompositeDars {getMultiPackageBuildAllCompositeDars :: Bool} +multiPackageBuildAllCompositeDarsOpt :: Parser MultiPackageBuildAllCompositeDars +multiPackageBuildAllCompositeDarsOpt = MultiPackageBuildAllCompositeDars <$> switch (long "all-composite-dars" <> help "Build all composite-dars in multi-package.daml") + data MultiPackageLocation -- | Search for the multi-package.yaml above the current directory = MPLSearch @@ -302,7 +313,7 @@ dlintHintFilesParser = ) explicitDlintHintFiles = fmap ExplicitDlintHintFiles $ - some $ Options.Applicative.strOption + some $ strOption ( long "lint-hint-file" <> metavar "FILE" <> internal @@ -440,19 +451,19 @@ optionsParser numProcessors enableScenarioService parsePkgName parseDlintUsage = optImportPath :: Parser [FilePath] optImportPath = many $ - Options.Applicative.strOption $ + strOption $ metavar "INCLUDE-PATH" <> help "Path to an additional source directory to be included" <> long "include" optPackageDir :: Parser [FilePath] - optPackageDir = many $ Options.Applicative.strOption $ metavar "LOC-OF-PACKAGE-DB" + optPackageDir = many $ strOption $ metavar "LOC-OF-PACKAGE-DB" <> help "use package database in the given location" <> long "package-db" optPackageImport :: Parser PackageFlag optPackageImport = - Options.Applicative.option readPackageImport $ + option readPackageImport $ metavar "PACKAGE" <> help "explicit import of a package with optional renaming of modules" <> long "package" <> @@ -557,7 +568,7 @@ optionsParser numProcessors enableScenarioService parsePkgName parseDlintUsage = optGhcCustomOptions :: Parser [String] optGhcCustomOptions = fmap concat $ many $ - Options.Applicative.option (stringsSepBy ' ') $ + option (stringsSepBy ' ') $ long "ghc-option" <> metavar "OPTION" <> help "Options to pass to the underlying GHC" diff --git a/compiler/damlc/tests/BUILD.bazel b/compiler/damlc/tests/BUILD.bazel index cd9caaa67c88..4712eb7c9796 100644 --- a/compiler/damlc/tests/BUILD.bazel +++ b/compiler/damlc/tests/BUILD.bazel @@ -479,6 +479,7 @@ da_haskell_test( data = [ "//daml-assistant:daml", "//release:sdk-release-tarball", + "@local_jdk//:bin/java.exe" if is_windows else "@local_jdk//:bin/java", ], hackage_deps = [ "base", @@ -492,12 +493,16 @@ da_haskell_test( "tasty-hunit", "text", "time", + "unordered-containers", ], main_function = "DA.Test.DamlcMultiPackage.main", src_strip_prefix = "src", visibility = ["//visibility:public"], deps = [ + "//compiler/daml-dar-reader", + "//compiler/daml-lf-ast", "//libs-haskell/bazel-runfiles", + "//libs-haskell/da-hs-base", "//libs-haskell/test-utils", "//sdk-version/hs:sdk-version-lib", ], diff --git a/compiler/damlc/tests/src/DA/Test/DamlcMultiPackage.hs b/compiler/damlc/tests/src/DA/Test/DamlcMultiPackage.hs index d8c963dd2760..c3aaf0f6f9b5 100644 --- a/compiler/damlc/tests/src/DA/Test/DamlcMultiPackage.hs +++ b/compiler/damlc/tests/src/DA/Test/DamlcMultiPackage.hs @@ -6,23 +6,30 @@ module DA.Test.DamlcMultiPackage (main) where {- HLINT ignore "locateRunfiles/package_app" -} import Control.Exception (try) -import Control.Monad.Extra (forM_, unless, void) +import Control.Monad.Extra (forM, forM_, unless, void) import DA.Bazel.Runfiles (exe, locateRunfiles, mainWorkspace) -import Data.List (intercalate, intersect, isInfixOf, union, (\\)) +import qualified DA.Daml.Dar.Reader as Reader +import qualified DA.Daml.LF.Ast as LF +import DA.Daml.LF.Ast.Version (version1_15) +import DA.Test.Util (defaultJvmMemoryLimits, limitJvmMemory, withEnv) +import qualified Data.HashMap.Strict as HashMap +import Data.List (find, intercalate, intersect, isInfixOf, isPrefixOf, sort, union, (\\)) import qualified Data.Map as Map import Data.Maybe (fromMaybe, fromJust) +import qualified Data.NameMap as NM import qualified Data.Text as T import qualified Data.Text.IO as TIO import Data.Time.Clock (UTCTime) import SdkVersion (SdkVersioned, sdkVersion, withSdkVersions) -import System.Directory.Extra (canonicalizePath, createDirectoryIfMissing, doesFileExist, getModificationTime, removeFile, withCurrentDirectory) +import System.Directory.Extra (canonicalizePath, createDirectoryIfMissing, doesFileExist, getModificationTime, listDirectory, removeFile, withCurrentDirectory) import System.Environment.Blank (setEnv) import System.Exit (ExitCode (..)) -import System.FilePath (makeRelative, ()) -import System.IO.Extra (withTempDir) -import System.Process (CreateProcess (..), proc, readCreateProcessWithExitCode, readCreateProcess) -import Test.Tasty (TestTree, defaultMain, testGroup) -import Test.Tasty.HUnit (HUnitFailure (..), assertFailure, assertBool, testCase) +import System.FilePath (getSearchPath, isExtensionOf, makeRelative, replaceFileName, searchPathSeparator, takeFileName, ()) +import System.Info.Extra (isWindows) +import System.IO.Extra (newTempDir, withTempDir) +import System.Process (CreateProcess (..), proc, readCreateProcessWithExitCode, readCreateProcess, readProcess) +import Test.Tasty (TestTree, defaultMain, testGroup, withResource) +import Test.Tasty.HUnit (HUnitFailure (..), assertFailure, assertBool, assertEqual, testCase, (@?=)) import Text.Regex.TDFA (Regex, makeRegex, matchTest) -- Abstraction over the folder structure of a project, consisting of many packages. @@ -40,6 +47,7 @@ data ProjectStructure | MultiPackage { mpPackages :: [T.Text] , mpProjects :: [T.Text] + , mpCompositeDars :: [CompositeDarDefinition] } | Dir { dName :: T.Text @@ -62,6 +70,14 @@ data PackageIdentifier = PackageIdentifier instance Show PackageIdentifier where show pi = T.unpack (piName pi) <> "-" <> T.unpack (piVersion pi) +data CompositeDarDefinition = CompositeDarDefinition + { cddName :: T.Text + , cddVersion :: T.Text + , cddPackages :: [T.Text] + , cddDars :: [T.Text] + , cddPath :: T.Text + } + {- Remaining tests needed: - multi-sdk Use Dylan's `releases-endpoint` and `alternate-download` in daml-config to defer sdk download @@ -73,16 +89,24 @@ main :: IO () main = withSdkVersions $ do damlAssistant <- locateRunfiles (mainWorkspace "daml-assistant" exe "daml") release <- locateRunfiles (mainWorkspace "release" "sdk-release-tarball-ce.tar.gz") + oldPath <- getSearchPath + javaPath <- locateRunfiles "local_jdk/bin" + withTempDir $ \damlHome -> do setEnv "DAML_HOME" damlHome True -- Install sdk `env:DAML_SDK_RELEASE_VERSION` into temp DAML_HOME -- corresponds to: -- - `0.0.0` on PR builds -- - `x.y.z-snapshot.yyyymmdd.nnnnn.m.vpppppppp` on MAIN/Release builds - void $ readCreateProcess (proc damlAssistant ["install", release, "--install-with-custom-version", sdkVersion]) "" + void $ readProcess damlAssistant ["install", release, "--install-with-custom-version", sdkVersion] "" -- Install a copy under the release version 10.0.0 - void $ readCreateProcess (proc damlAssistant ["install", release, "--install-with-custom-version", "10.0.0"]) "" - defaultMain $ tests damlAssistant + void $ readProcess damlAssistant ["install", release, "--install-with-custom-version", "10.0.0"] "" + + limitJvmMemory defaultJvmMemoryLimits + withEnv + [("PATH", Just $ intercalate [searchPathSeparator] $ javaPath : oldPath)] + (defaultMain $ tests damlAssistant) + tests :: SdkVersioned => FilePath -> TestTree tests damlAssistant = @@ -390,6 +414,109 @@ tests damlAssistant = [PackageIdentifier "package-b" "0.0.1"] warningProject ] + , testGroup + "Composite Dar Building" + [ test "Building a single composite dar works and builds only the packages needed" ["--composite-dar=main"] "" compositeDarProject $ Right + [ PackageIdentifier "package-a" "0.0.1" + , PackageIdentifier "package-b" "0.0.1" + , PackageIdentifier "main" "0.0.1" + ] + , test "Building two composite dars builds only the packages needed" ["--composite-dar=main", "--composite-dar=test"] "" compositeDarProject $ Right + [ PackageIdentifier "package-a" "0.0.1" + , PackageIdentifier "package-b" "0.0.1" + , PackageIdentifier "package-c" "0.0.1" + , PackageIdentifier "package-d" "0.0.1" + , PackageIdentifier "main" "0.0.1" + , PackageIdentifier "test" "0.0.1" + ] + , test "Building --all and a composite dar builds every package except the other composite dar" ["--all", "--composite-dar=main"] "" compositeDarProject $ Right + [ PackageIdentifier "package-a" "0.0.1" + , PackageIdentifier "package-b" "0.0.1" + , PackageIdentifier "package-c" "0.0.1" + , PackageIdentifier "package-d" "0.0.1" + , PackageIdentifier "package-e" "0.0.1" + , PackageIdentifier "main" "0.0.1" + ] + , test "Building --all-composite-dars builds all composite dars and only packages needed for them" ["--all-composite-dars"] "" compositeDarProject $ Right + [ PackageIdentifier "package-a" "0.0.1" + , PackageIdentifier "package-b" "0.0.1" + , PackageIdentifier "package-c" "0.0.1" + , PackageIdentifier "package-d" "0.0.1" + , PackageIdentifier "main" "0.0.1" + , PackageIdentifier "test" "0.0.1" + ] + , test "Building a single composite dar from a subdirectory works" ["--composite-dar=main"] "./package-a" compositeDarProject $ Right + [ PackageIdentifier "package-a" "0.0.1" + , PackageIdentifier "package-b" "0.0.1" + , PackageIdentifier "main" "0.0.1" + ] + , test "Building a transitive composite dar gives an error including where the dar is" ["--composite-dar=unshadowed-transitive"] "./first" compositeDarShadowingProject + $ Left "Found definition for unshadowed-transitive in the following sub-projects" + , test "Building a repeated transitive dar (same name and version) gives error" ["--composite-dar=main"] "" compositeDarDuplicateProject + $ Left "Multiple composite dars with the same name and version: main-0.0.1" + , test "Building a composite dar by name only when another with the same name exists fails" ["--composite-dar=same-name"] "./first" compositeDarShadowingProject + $ Left "Multiple composite dars with the same name were found, to specify which you need, use one of the following full names:\n - same-name-0.0.1\n - same-name-0.0.2\n" + , test "Building a duplicate name dar by name and version succeeds" ["--composite-dar=same-name-0.0.1"] "./first" compositeDarShadowingProject + $ Right [ PackageIdentifier "same-name" "0.0.1", PackageIdentifier "same-name-package" "0.0.1" ] + , test "Building a non-existent composite dar fails as expected" ["--composite-dar=some-composite-dar"] "./first" compositeDarShadowingProject + $ Left "Couldn't find composite dar with the name some-composite-dar in" + , testWithStdout "Building a shadowed transitive dar succeeds with warning" ["--composite-dar=shadowed-transitive"] "./first" compositeDarShadowingProject + (Right [ PackageIdentifier "shadowed-transitive" "0.0.1", PackageIdentifier "shadowed-transitive-package" "0.0.1" ]) + (Just "Warning: Found definition for shadowed-transitive in the following sub-projects:") + ] + , testGroup + "Composite Dar Artifact" + [ withCompositeDar compositeDarProject "main-0.0.1" $ \getDarData -> testGroup "main-0.0.1" $ + [ testCase "Only has expected packages" $ do + darInfo <- snd <$> getDarData + let dalfInfos = fmap snd $ HashMap.toList $ Reader.packages darInfo + notPrimOrStdlib dalfName = not $ "daml-prim" `isPrefixOf` dalfName || "daml-stdlib" `isPrefixOf` dalfName + nonDamlDalfInfos = filter (notPrimOrStdlib . takeFileName . Reader.dalfFilePath) dalfInfos + nonDamlPkgNames = maybe "unknown" LF.unPackageName . Reader.dalfPackageName <$> nonDamlDalfInfos + + sort nonDamlPkgNames @?= ["main", "package-a", "package-b"] + , testCase "Main package has correct name and version" $ do + darInfo <- snd <$> getDarData + let ownDalfInfo = fromMaybe (error "Missing own package") $ HashMap.lookup (Reader.mainPackageId darInfo) $ Reader.packages darInfo + + Reader.dalfPackageName ownDalfInfo @?= Just (LF.PackageName "main") + Reader.dalfPackageVersion ownDalfInfo @?= Just (LF.PackageVersion "0.0.1") + , testCase "All packages have correct LF version" $ do + darInfo <- snd <$> getDarData + let dalfInfos = fmap snd $ HashMap.toList $ Reader.packages darInfo + isPrimOrStdlib dalfInfo = + let dalfName = takeFileName $ Reader.dalfFilePath dalfInfo + in "daml-prim" `isPrefixOf` dalfName || "daml-stdlib" `isPrefixOf` dalfName + -- We do not check daml-prim/daml-stdlib, as they are in very old LF versions + forM_ (filter (not . isPrimOrStdlib) dalfInfos) $ \dalfInfo -> do + let dalfLfVersion = LF.packageLfVersion $ Reader.dalfPackage dalfInfo + dalfName = maybe "unknown" (T.unpack . LF.unPackageName) $ Reader.dalfPackageName dalfInfo + + assertEqual ("LF version for " <> dalfName <> " was incorrect") version1_15 dalfLfVersion + , testCase "Dar has no source code" $ do + darInfo <- snd <$> getDarData + let damlFiles = filter (isExtensionOf "daml") $ Reader.files darInfo + unless (null damlFiles) $ assertFailure $ "Expected no daml files but found " <> show damlFiles + , testCase "Main package is empty" $ do + darInfo <- snd <$> getDarData + let ownDalfInfo = fromMaybe (error "Missing own package") $ HashMap.lookup (Reader.mainPackageId darInfo) $ Reader.packages darInfo + assertBool "Main package has modules" $ NM.null $ LF.packageModules $ Reader.dalfPackage ownDalfInfo + , testCase "Works with java codegen" $ do + darPath <- fst <$> getDarData + let codegenPath = replaceFileName darPath "java-codegen" + void $ readProcess damlAssistant ["codegen", "java", darPath, "--output-directory", codegenPath] "" + listDirectory codegenPath >>= assertBool "Codegen directory is empty" . not . null + ] <> + [ testCase "Works with js codegen" $ do + darPath <- fst <$> getDarData + let codegenPath = replaceFileName darPath "js-codegen" + void $ readProcess damlAssistant ["codegen", "js", darPath, "-o", codegenPath] "" + listDirectory codegenPath >>= assertBool "Codegen directory is empty" . not . null + -- The '@daml/types' NPM package is not available on Windows which + -- is required by 'daml2js'. + | not isWindows + ] + ] ] where @@ -403,10 +530,23 @@ tests damlAssistant = -> Either T.Text [PackageIdentifier] -> TestTree test name flags runPath projectStructure expectedResult = + testWithStdout name flags runPath projectStructure expectedResult Nothing + + testWithStdout + :: String + -> [String] + -> FilePath + -> [ProjectStructure] + -- Left is error regex, right is success + expected packages to have build. + -- Any created dar files that aren't listed here throw an error. + -> Either T.Text [PackageIdentifier] + -> Maybe String + -> TestTree + testWithStdout name flags runPath projectStructure expectedResult expectedStdout = testCase name $ withTempDir $ \dir -> do allPossibleDars <- buildProject dir projectStructure - runBuildAndAssert dir flags runPath allPossibleDars expectedResult + runBuildAndAssert dir flags runPath allPossibleDars expectedResult expectedStdout testCache :: String -- name @@ -450,7 +590,7 @@ tests damlAssistant = withTempDir $ \dir -> do allPossibleDars <- buildProject dir projectStructure let runBuild :: ([String], FilePath) -> [PackageIdentifier] -> IO () - runBuild (flags, runPath) pkgs = runBuildAndAssert dir flags runPath allPossibleDars (Right pkgs) + runBuild (flags, runPath) pkgs = runBuildAndAssert dir flags runPath allPossibleDars (Right pkgs) Nothing getPkgsLastModified :: [PackageIdentifier] -> IO (Map.Map PackageIdentifier UTCTime) getPkgsLastModified pkgs = -- fromJust is safe as long as called after a runBuild, since that asserts all pkgs exists in allPossibleDars @@ -488,8 +628,9 @@ tests damlAssistant = -> FilePath -> Map.Map PackageIdentifier FilePath -> Either T.Text [PackageIdentifier] + -> Maybe String -> IO () - runBuildAndAssert dir flags runPath allPossibleDars expectedResult = do + runBuildAndAssert dir flags runPath allPossibleDars expectedResult expectedStdout = do -- Quick check to ensure all the package identifiers are possible case expectedResult of Left _ -> pure () @@ -502,7 +643,9 @@ tests damlAssistant = runPath <- canonicalizePath $ dir runPath let args = ["build", "--enable-multi-package=yes"] <> flags process = (proc damlAssistant args) {cwd = Just runPath} - (exitCode, _, err) <- readCreateProcessWithExitCode process "" + (exitCode, out, err) <- readCreateProcessWithExitCode process "" + forM_ expectedStdout $ \expectedOut -> assertBool "Stdout did not contained expected string" $ expectedOut `isInfixOf` out + case expectedResult of Right expectedPackageIdentifiers -> do unless (exitCode == ExitSuccess) $ assertFailure $ "Expected success and got " <> show exitCode <> ".\n StdErr: \n " <> err @@ -557,7 +700,18 @@ tests damlAssistant = TIO.writeFile (path "multi-package.yaml") $ T.unlines $ ["packages:"] ++ fmap (" - " <>) (mpPackages multiPackage) ++ ["projects:"] ++ fmap (" - " <>) (mpProjects multiPackage) - pure Map.empty + ++ ["composite-dars:"] + ++ concatMap (\cd -> + [ " - name: " <> cddName cd + , " version: " <> cddVersion cd + ] + <> [" packages: "] <> fmap (" - " <>) (cddPackages cd) + <> [" dars: "] <> fmap (" - " <>) (cddDars cd) + <> [" path: " <> cddPath cd] + ) (mpCompositeDars multiPackage) + fmap Map.fromList $ forM (mpCompositeDars multiPackage) $ \cd -> do + outPath <- canonicalizePath $ path T.unpack (cddPath cd) + pure (PackageIdentifier (cddName cd) (cddVersion cd), outPath) dir@Dir {} -> do let newDir = path (T.unpack $ dName dir) createDirectoryIfMissing True newDir @@ -572,6 +726,25 @@ tests damlAssistant = TIO.writeFile (path T.unpack (gfName genericFile)) $ gfContent genericFile pure Map.empty + withCompositeDar :: [ProjectStructure] -> String -> (IO (FilePath, Reader.InspectInfo) -> TestTree) -> TestTree + withCompositeDar projectStructure compositeDarFullName f = + let acquireResource = do + (dir, removeDir) <- newTempDir + darMapping <- buildProject dir projectStructure + + let isCorrectPackage :: PackageIdentifier -> Bool + isCorrectPackage pkgId = compositeDarFullName == show pkgId + compositeDarPath <- + maybe (assertFailure "Failed to find given composite dar name. Use the full path (name-version)") (pure . snd) + $ find (isCorrectPackage . fst) $ Map.toList darMapping + + let args = ["build", "--enable-multi-package=yes", "--composite-dar=" <> compositeDarFullName] + process = (proc damlAssistant args) {cwd = Just dir} + _ <- readCreateProcess process "" + darInfo <- Reader.getDarInfo compositeDarPath + pure (removeDir, (compositeDarPath, darInfo)) + in withResource acquireResource fst $ f . fmap snd + ----- Testing project fixtures -- daml.yaml with current sdk version, default ouput path and source set to `daml` @@ -581,7 +754,7 @@ damlYaml name version deps = DamlYaml name version Nothing "daml" Nothing [] [] -- B depends on A simpleTwoPackageProject :: [ProjectStructure] simpleTwoPackageProject = - [ MultiPackage ["./package-a", "./package-b"] [] + [ MultiPackage ["./package-a", "./package-b"] [] [] , Dir "package-a" [ damlYaml "package-a" "0.0.1" [] , Dir "daml" [DamlSource "PackageAMain" []] @@ -595,7 +768,7 @@ simpleTwoPackageProject = -- B and C depend on A, D depends on B and C diamondProject :: [ProjectStructure] diamondProject = - [ MultiPackage ["./package-a", "./package-b", "./package-c", "./package-d"] [] + [ MultiPackage ["./package-a", "./package-b", "./package-c", "./package-d"] [] [] , Dir "package-a" [ damlYaml "package-a" "0.0.1" [] , Dir "daml" [DamlSource "PackageAMain" []] @@ -619,7 +792,7 @@ diamondProject = multiProject :: [ProjectStructure] multiProject = [ Dir "libs" - [ MultiPackage ["./lib-a", "./lib-b"] [] + [ MultiPackage ["./lib-a", "./lib-b"] [] [] , Dir "lib-a" [ damlYaml "lib-a" "0.0.1" [] , Dir "daml" [DamlSource "LibAMain" []] @@ -630,7 +803,7 @@ multiProject = ] ] , Dir "packages" - [ MultiPackage ["./package-a", "./package-b"] ["../libs"] + [ MultiPackage ["./package-a", "./package-b"] ["../libs"] [] , Dir "package-a" [ damlYaml "package-a" "0.0.1" ["../../libs/lib-b/.daml/dist/lib-b-0.0.1.dar"] , Dir "daml" [DamlSource "PackageAMain" ["LibBMain"]] @@ -646,14 +819,14 @@ multiProject = cyclicMultiPackage :: [ProjectStructure] cyclicMultiPackage = [ Dir "libs" - [ MultiPackage ["./lib-a"] ["../packages"] + [ MultiPackage ["./lib-a"] ["../packages"] [] , Dir "lib-a" [ damlYaml "lib-a" "0.0.1" [] , Dir "daml" [DamlSource "LibAMain" []] ] ] , Dir "packages" - [ MultiPackage ["./package-a"] ["../libs"] + [ MultiPackage ["./package-a"] ["../libs"] [] , Dir "package-a" [ damlYaml "package-a" "0.0.1" ["../../libs/lib-a/.daml/dist/lib-a-0.0.1.dar"] , Dir "daml" [DamlSource "PackageAMain" ["LibAMain"]] @@ -664,7 +837,7 @@ cyclicMultiPackage = -- Cyclic dar dependencies in daml.yamls cyclicPackagesProject :: [ProjectStructure] cyclicPackagesProject = - [ MultiPackage ["./package-a", "./package-b"] [] + [ MultiPackage ["./package-a", "./package-b"] [] [] , Dir "package-a" [ damlYaml "package-a" "0.0.1" ["../package-b/.daml/dist/package-b-0.0.1.dar"] , Dir "daml" [DamlSource "PackageAMain" ["PackageBMain"]] @@ -678,7 +851,7 @@ cyclicPackagesProject = -- Package that defines --output, putting `dar` outside of `.daml/dist` customOutPathProject :: [ProjectStructure] customOutPathProject = - [ MultiPackage ["./package-a", "./package-b"] [] + [ MultiPackage ["./package-a", "./package-b"] [] [] , Dir "package-a" [ (damlYaml "package-a" "0.0.1" []) {dyOutPath = Just "../package-a.dar" } , Dir "daml" [DamlSource "PackageAMain" []] @@ -692,7 +865,7 @@ customOutPathProject = -- Project where both packages throw warnings, used to detect flag forwarding via -Werror warningProject :: [ProjectStructure] warningProject = - [ MultiPackage ["./package-a", "./package-b"] [] + [ MultiPackage ["./package-a", "./package-b"] [] [] , Dir "package-a" [ damlYaml "package-a" "0.0.1" [] , Dir "daml" [GenericFile "PackageAMain.daml" $ "module PackageAMain where\n" <> warnText] @@ -710,7 +883,7 @@ warningProject = -- v2 depends on v1 sameNameDifferentVersionProject :: [ProjectStructure] sameNameDifferentVersionProject = - [ MultiPackage ["./package-v1", "./package-v2"] [] + [ MultiPackage ["./package-v1", "./package-v2"] [] [] , Dir "package-v1" [ damlYaml "package" "0.0.1" [] , Dir "daml" [DamlSource "PackageV1Main" []] @@ -725,7 +898,7 @@ sameNameDifferentVersionProject = -- v1-again depends on v1 sameNameSameVersionProject :: [ProjectStructure] sameNameSameVersionProject = - [ MultiPackage ["./package-v1", "./package-v1-again"] [] + [ MultiPackage ["./package-v1", "./package-v1-again"] [] [] , Dir "package-v1" [ damlYaml "package" "0.0.1" [] , Dir "daml" [DamlSource "PackageV1Main" []] @@ -739,7 +912,7 @@ sameNameSameVersionProject = -- B depends on A with specified source folder for package-a simpleTwoPackageProjectSource :: T.Text -> [ProjectStructure] simpleTwoPackageProjectSource path = - [ MultiPackage ["./package-a", "./package-b"] [] + [ MultiPackage ["./package-a", "./package-b"] [] [] , Dir "package-a" [ (damlYaml "package-a" "0.0.1" []) {dySource = path} , Dir path [DamlSource "PackageAMain" []] @@ -753,7 +926,7 @@ simpleTwoPackageProjectSource path = -- B depends on A where package-a uses a .daml file source in daml.yaml simpleTwoPackageProjectSourceDaml :: [ProjectStructure] simpleTwoPackageProjectSourceDaml = - [ MultiPackage ["./package-a", "./package-b"] [] + [ MultiPackage ["./package-a", "./package-b"] [] [] , Dir "package-a" [ (damlYaml "package-a" "0.0.1" []) {dySource = "daml/PackageAMain.daml"} , Dir "daml" [DamlSource "PackageAMain" ["PackageAAux"], DamlSource "PackageAAux" []] @@ -768,7 +941,7 @@ simpleTwoPackageProjectSourceDaml = -- This daml file depends on another daml file higher up the file system hierarchy simpleTwoPackageProjectSourceDamlUpwards :: [ProjectStructure] simpleTwoPackageProjectSourceDamlUpwards = - [ MultiPackage ["./package-a", "./package-b"] [] + [ MultiPackage ["./package-a", "./package-b"] [] [] , Dir "package-a" [ (damlYaml "package-a" "0.0.1" []) {dySource = "daml/PackageA/PackageAMain.daml"} , Dir "daml" [DamlSource "PackageAAux" [], Dir "PackageA" [DamlSource "PackageA.PackageAMain" ["PackageAAux"]]] @@ -781,7 +954,7 @@ simpleTwoPackageProjectSourceDamlUpwards = simpleTwoPackageProjectModulePrefixes :: [ProjectStructure] simpleTwoPackageProjectModulePrefixes = - [ MultiPackage ["./package-a", "./package-b"] [] + [ MultiPackage ["./package-a", "./package-b"] [] [] , Dir "package-a" [ damlYaml "package-a" "0.0.1" [] , Dir "daml" [DamlSource "PackageAMain" []] @@ -791,3 +964,67 @@ simpleTwoPackageProjectModulePrefixes = , Dir "daml" [DamlSource "PackageBMain" ["A.PackageAMain"]] ] ] + +-- 5 Packages, A-E. 2 Composite dars, first depends on A,B, second on C,D +-- Each package has a unique module name and defines a template, for codegen testing +-- (java codegen won't generate any files if all modules are empty) +compositeDarProject :: [ProjectStructure] +compositeDarProject = + [ MultiPackage ["./package-a", "./package-b", "./package-c", "./package-d", "./package-e"] [] + [ CompositeDarDefinition "main" "0.0.1" ["./package-a", "./package-b"] [] "./main.dar" + , CompositeDarDefinition "test" "0.0.1" ["./package-c", "./package-d"] [] "./test.dar" + ] + , simplePackage "package-a" "Main1" + , simplePackage "package-b" "Main2" + , simplePackage "package-c" "Main3" + , simplePackage "package-d" "Main4" + , simplePackage "package-e" "Main5" + ] + where + -- Simple package with one module that defines a template + -- Names need to be unique for java codegen + simplePackage :: T.Text -> T.Text -> ProjectStructure + simplePackage name moduleName = Dir name + [ damlYaml name "0.0.1" [] + , Dir "daml" [GenericFile (moduleName <> ".daml") ("module " <> moduleName <> " where template T with p : Party where signatory p")] + ] + +-- first multi-package +-- shadowed-transitive +-- same-name-0.0.1 +-- same-name-0.0.2 +-- +-- second multi-package +-- unshadowed-transitive +-- shadowed-transitive +-- each composite dar has one package unique to it +compositeDarShadowingProject :: [ProjectStructure] +compositeDarShadowingProject = + [ Dir "first" $ compositeDarsStructure [("shadowed-transitive", "0.0.1"), ("same-name", "0.0.1"), ("same-name", "0.0.2")] ["../second"] + , Dir "second" $ compositeDarsStructure [("shadowed-transitive", "0.0.1"), ("unshadowed-transitive", "0.0.1")] [] + ] + where + -- For each name and version, make a composite dar entry in the multi-package and a single package that it is composed of + compositeDarsStructure :: [(T.Text, T.Text)] -> [T.Text] -> [ProjectStructure] + compositeDarsStructure compositeDars projects = + [ MultiPackage ((\(name, version) -> "./" <> name <> "-" <> version) <$> compositeDars) projects $ + (\(name, version) -> CompositeDarDefinition name version ["./" <> name <> "-" <> version] [] ("./" <> name <> "-" <> version <> ".dar")) <$> compositeDars + ] <> + ((\(name, version) -> + Dir (name <> "-" <> version) + [ damlYaml (name <> "-package") version [] + , Dir "daml" [DamlSource "Main" []] + ] + ) <$> compositeDars) + +compositeDarDuplicateProject :: [ProjectStructure] +compositeDarDuplicateProject = + [ MultiPackage ["./package-a"] [] + [ CompositeDarDefinition "main" "0.0.1" ["./package-a"] [] "./main.dar" + , CompositeDarDefinition "main" "0.0.1" ["./package-a"] [] "./main2.dar" + ] + , Dir "package-a" + [ damlYaml "package-a" "0.0.1" [] + , Dir "daml" [DamlSource "Main" []] + ] + ] diff --git a/daml-assistant/daml-project-config/DA/Daml/Project/Config.hs b/daml-assistant/daml-project-config/DA/Daml/Project/Config.hs index 9241e59c1012..b7182c9842d4 100644 --- a/daml-assistant/daml-project-config/DA/Daml/Project/Config.hs +++ b/daml-assistant/daml-project-config/DA/Daml/Project/Config.hs @@ -21,6 +21,8 @@ module DA.Daml.Project.Config , queryProjectConfigRequired , querySdkConfigRequired , queryMultiPackageConfigRequired + , queryMultiPackageCompositeDar + , queryMultiPackageCompositeDarRequired ) where import DA.Daml.Project.Consts @@ -95,6 +97,9 @@ querySdkConfig path = queryConfig "SDK" "SdkConfig" path . unwrapSdkConfig queryMultiPackageConfig :: Y.FromJSON t => [Text] -> MultiPackageConfig -> Either ConfigError (Maybe t) queryMultiPackageConfig path = queryConfig "multi-package" "MultiPackageConfig" path . unwrapMultiPackageConfig +queryMultiPackageCompositeDar :: Y.FromJSON t => [Text] -> MultiPackageCompositeDar -> Either ConfigError (Maybe t) +queryMultiPackageCompositeDar path = queryConfig "multi-package" "MultiPackageCompositeDar" path . unwrapMultiPackageCompositeDar + -- | Like 'queryDamlConfig' but returns an error if the property is missing. queryDamlConfigRequired :: Y.FromJSON t => [Text] -> DamlConfig -> Either ConfigError t queryDamlConfigRequired path = queryConfigRequired "daml" "DamlConfig" path . unwrapDamlConfig @@ -111,6 +116,10 @@ querySdkConfigRequired path = queryConfigRequired "SDK" "SdkConfig" path . unwra queryMultiPackageConfigRequired :: Y.FromJSON t => [Text] -> MultiPackageConfig -> Either ConfigError t queryMultiPackageConfigRequired path = queryConfigRequired "multi-package" "MultiPackageConfig" path . unwrapMultiPackageConfig +-- | Like 'queryMultiPackageCompositeDar' but returns an error if the property is missing. +queryMultiPackageCompositeDarRequired :: Y.FromJSON t => [Text] -> MultiPackageCompositeDar -> Either ConfigError t +queryMultiPackageCompositeDarRequired path = queryConfigRequired "multi-package" "MultiPackageCompositeDar" path . unwrapMultiPackageCompositeDar + -- | (internal) Helper function for querying config data. The 'path' argument -- represents the location of the desired property within the config file. -- For example, if you had a YAML file like so: diff --git a/daml-assistant/daml-project-config/DA/Daml/Project/Types.hs b/daml-assistant/daml-project-config/DA/Daml/Project/Types.hs index 5298e6d06082..17a70b8fb002 100644 --- a/daml-assistant/daml-project-config/DA/Daml/Project/Types.hs +++ b/daml-assistant/daml-project-config/DA/Daml/Project/Types.hs @@ -51,6 +51,10 @@ newtype MultiPackageConfig = MultiPackageConfig { unwrapMultiPackageConfig :: Y.Value } deriving (Eq, Show, Y.FromJSON) +newtype MultiPackageCompositeDar = MultiPackageCompositeDar + { unwrapMultiPackageCompositeDar :: Y.Value + } deriving (Eq, Show, Y.FromJSON) + -- | File path of daml installation root (by default ~/.daml on unix, %APPDATA%/daml on windows). newtype DamlPath = DamlPath { unwrapDamlPath :: FilePath