diff --git a/sdk/daml-script/test/BUILD.bazel b/sdk/daml-script/test/BUILD.bazel index a2b597f908f1..6b5fdcf36d34 100644 --- a/sdk/daml-script/test/BUILD.bazel +++ b/sdk/daml-script/test/BUILD.bazel @@ -539,3 +539,67 @@ da_scala_test_suite( "@maven//:io_dropwizard_metrics_metrics_core", ], ) + +daml_compile( + name = "upgrade-test-lib", + srcs = [":daml/UpgradeTestLib.daml"], + dependencies = [ + "//daml-script/daml3:daml3-script-1.dev.dar", + ], + project_name = "upgrade-test-lib", + # TODO(https://github.com/digital-asset/daml/issues/18457): split the lib into modules that use + # contract keys and those that don't. Revert to the default target for those that don't. + target = "1.dev", + version = "1.0.0", +) + +filegroup( + name = "upgrade-test-files", + srcs = glob(["daml/upgrades/*.daml"]), + visibility = ["__pkg__"], +) + +da_scala_test( + name = "ide-upgrade-test", + size = "large", + srcs = ["src/main/scala/com/daml/lf/engine/script/test/IdeLedgerUpgradesIT.scala"], + data = [ + ":upgrade-test-files", + ":upgrade-test-lib.dar", + "//compiler/damlc", + "//daml-script/daml3:daml3-script-1.dev.dar", + ], + resources = glob(["src/main/resources/**/*"]), + scala_deps = [ + "@maven//:io_circe_circe_core", + "@maven//:io_circe_circe_yaml_common", + "@maven//:io_circe_circe_yaml", + "@maven//:org_apache_pekko_pekko_actor", + "@maven//:org_apache_pekko_pekko_stream", + "@maven//:org_typelevel_cats_core", + "@maven//:org_typelevel_cats_kernel", + ], + tags = [ + "cpu:4", + ], + deps = [ + ":test-utils", + "//bazel_tools/runfiles:scala_runfiles", + # "//canton:community_ledger_ledger-common", + # "//canton:community_util-logging", + "//daml-lf/data", + "//daml-lf/interpreter", + "//daml-lf/language", + "//daml-lf/transaction", + "//daml-script/runner:script-runner-lib", + "//libs-scala/ledger-resources", + "//libs-scala/ports", + "//libs-scala/resources", + "//libs-scala/rs-grpc-bridge", + "//libs-scala/scala-utils", + "//libs-scala/testing-utils", + "//libs-scala/timer-utils", + "//test-common/canton/it-lib", + ], +) if not is_windows else None +# skipping windows for now, it doesn't seem to like the filegroup `:upgrade-test-files` diff --git a/sdk/daml-script/test/daml/UpgradeTestLib.daml b/sdk/daml-script/test/daml/UpgradeTestLib.daml new file mode 100644 index 000000000000..ec31a73b73de --- /dev/null +++ b/sdk/daml-script/test/daml/UpgradeTestLib.daml @@ -0,0 +1,64 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module UpgradeTestLib ( + participant0, + participant1, + tests, + broken, + withUnvettedDar, + withUnvettedDarOnParticipant, + module Daml.Script, + module Daml.Script.Internal, + module DA.Assert, +) where + +import Daml.Script +import Daml.Script.Internal +import DA.Assert +import DA.Foldable +import DA.Time + +participant0 : ParticipantName +participant0 = ParticipantName "participant0" + +participant1 : ParticipantName +participant1 = ParticipantName "participant1" + +tests : [(Text, Script ())] -> Script () +tests cases = forA_ cases $ \(testName, test) -> do + debugRaw $ "Testing: " <> testName + test + +-- | Used to tag a test as failing by erroring in any way, once all this behaviour works, this function can be removed +brokenScript : Script () -> Script () +brokenScript act = do + tryToEither (\() -> liftFailedCommandToException act) >>= \case + Right _ -> assertFail "Expected failed and got success! Did you fix this logic? Remove the wrapping `broken` to mark this as working." + Left _ -> pure () + +withUnvettedDarOnParticipant : Text -> ParticipantName -> Script a -> Script a +withUnvettedDarOnParticipant darName participant act = do + unvetDarOnParticipant darName participant + res <- tryToEither (\() -> liftFailedCommandToException act) + vetDarOnParticipant darName participant + case res of + Left e -> throwAnyException e + Right r -> pure r + +withUnvettedDar : Text -> Script a -> Script a +withUnvettedDar darName act = do + unsafeUnvetDarOnParticipant darName (Some participant0) + unsafeUnvetDarOnParticipant darName (Some participant1) + sleep $ seconds 1 + res <- tryToEither (\() -> liftFailedCommandToException act) + unsafeVetDarOnParticipant darName (Some participant0) + unsafeVetDarOnParticipant darName (Some participant1) + sleep $ seconds 1 + case res of + Left e -> throwAnyException e + Right r -> pure r + +broken : (Text, Script ()) -> (Text, Script ()) +broken (name, act) = ("(BROKEN) " <> name, brokenScript act) + diff --git a/sdk/daml-script/test/daml/upgrades/ChoiceBodyExercise.daml b/sdk/daml-script/test/daml/upgrades/ChoiceBodyExercise.daml new file mode 100644 index 000000000000..b445915a480d --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/ChoiceBodyExercise.daml @@ -0,0 +1,111 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module ChoiceBodyExercise (main) where + +import UpgradeTestLib +import qualified V1.ChoiceBodyExercise as V1 +import qualified V2.ChoiceBodyExercise as V2 + +{- PACKAGE +name: choice-body-exercise +versions: 2 +-} + +{- MODULE +package: choice-body-exercise +contents: | + module ChoiceBodyExercise where + + template ChoiceBodyExerciseTemplate + with + party: Party + newField : Optional Text -- @V 2 + where + signatory party + + choice NonUpgradedChoice : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 + + template ChoiceBodyExerciseHelper + with + party: Party + where + signatory party + choice DoNonUpgradedExercise : Text with + cid : ContractId ChoiceBodyExerciseTemplate + controller party + do exercise cid NonUpgradedChoice +-} + +-- Template payload upgrading/downgrading from exercises within choice bodies +-- The expected behaviour here is that the outer templates have fixed the choice version they wish to call +-- So the ledger must coerce the real data to match the expected data. Regardless of what the "most recent" version of that package is +main : Script () +main = tests + [ ("Call a V1 choice on a V1 contract from within a choice body, expect V1 implementation is used regardless of the possible upgrade.", exerciseV1ChoiceV1ContractSameType) + , ("Call a V1 choice on a V2 contract from within a choice body, expect V1 implementation is used, via a downgrade.", exerciseV1ChoiceV2ContractSameType) + , ("Call a V1 choice on a V2 contract with Some field from within a choice body, expect V1 implementation to attempt to be used, but fail downgrade", exerciseV1ChoiceV2ContractSameTypeSome) + , ("Call a V2 choice on a V1 contract from within a choice body, expect V2 implementation is used, via an upgrade", exerciseV2ChoiceV1ContractSameType) + , ("Call a V2 choice on a V2 contract from within a choice body, expect V2 implementation is used, for sanity", exerciseV2ChoiceV2ContractSameType) + ] + +exerciseV1Util : Choice V1.ChoiceBodyExerciseHelper c r => Party -> c -> Script r +exerciseV1Util p c = p `submit` createAndExerciseExactCmd (V1.ChoiceBodyExerciseHelper with party = p) c + +exerciseV2Util : Choice V2.ChoiceBodyExerciseHelper c r => Party -> c -> Script r +exerciseV2Util p c = p `submit` createAndExerciseExactCmd (V2.ChoiceBodyExerciseHelper with party = p) c + +tryExerciseV1Util : Choice V1.ChoiceBodyExerciseHelper c r => Party -> c -> Script (Either SubmitError r) +tryExerciseV1Util p c = p `trySubmit` createAndExerciseExactCmd (V1.ChoiceBodyExerciseHelper with party = p) c + +tryExerciseV2Util : Choice V2.ChoiceBodyExerciseHelper c r => Party -> c -> Script (Either SubmitError r) +tryExerciseV2Util p c = p `trySubmit` createAndExerciseExactCmd (V2.ChoiceBodyExerciseHelper with party = p) c + +exerciseV1ChoiceV1ContractSameType : Script () +exerciseV1ChoiceV1ContractSameType = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createExactCmd V1.ChoiceBodyExerciseTemplate with party = a + + sameTypeResult <- a `exerciseV1Util` V1.DoNonUpgradedExercise with cid = cid + sameTypeResult === "V1" + +exerciseV1ChoiceV2ContractSameType : Script () +exerciseV1ChoiceV2ContractSameType = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createCmd V2.ChoiceBodyExerciseTemplate with party = a, newField = None + let cidV1 = coerceContractId @V2.ChoiceBodyExerciseTemplate @V1.ChoiceBodyExerciseTemplate cid + + sameTypeResult <- a `exerciseV1Util` V1.DoNonUpgradedExercise with cid = cidV1 + sameTypeResult === "V1" + +exerciseV1ChoiceV2ContractSameTypeSome : Script () +exerciseV1ChoiceV2ContractSameTypeSome = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createCmd V2.ChoiceBodyExerciseTemplate with party = a, newField = Some "hi" + let cidV1 = coerceContractId @V2.ChoiceBodyExerciseTemplate @V1.ChoiceBodyExerciseTemplate cid + + sameTypeResult <- a `tryExerciseV1Util` V1.DoNonUpgradedExercise with cid = cidV1 + case sameTypeResult of + Left _ -> pure () + Right _ -> assertFail "Wrong" + +exerciseV2ChoiceV1ContractSameType : Script () +exerciseV2ChoiceV1ContractSameType = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createCmd V1.ChoiceBodyExerciseTemplate with party = a + let cidV2 = coerceContractId @V1.ChoiceBodyExerciseTemplate @V2.ChoiceBodyExerciseTemplate cid + + sameTypeResult <- a `exerciseV2Util` V2.DoNonUpgradedExercise with cid = cidV2 + sameTypeResult === "V2" + +exerciseV2ChoiceV2ContractSameType : Script () +exerciseV2ChoiceV2ContractSameType = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createCmd V2.ChoiceBodyExerciseTemplate with party = a, newField = Some "hi" + + sameTypeResult <- a `exerciseV2Util` V2.DoNonUpgradedExercise with cid = cid + sameTypeResult === "V2" + diff --git a/sdk/daml-script/test/daml/upgrades/ContractKeys.daml b/sdk/daml-script/test/daml/upgrades/ContractKeys.daml new file mode 100644 index 000000000000..a937b24b12e4 --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/ContractKeys.daml @@ -0,0 +1,94 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module ContractKeys (main) where + +import UpgradeTestLib +import qualified V1.ContractKeys as V1 +import qualified V2.ContractKeys as V2 + +{- PACKAGE +name: contract-key-upgrades +versions: 2 +-} + +{- MODULE +package: contract-key-upgrades +contents: | + module ContractKeys where + + data UnchangedKeyKey = UnchangedKeyKey with + p : Party + n : Int + deriving (Eq, Show) + + template UnchangedKey + with + party : Party + n : Int + newField : Optional Text -- @V 2 + where + signatory party + key (UnchangedKeyKey party n) : UnchangedKeyKey + maintainer key.p + + choice UnchangedKeyCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 + + template UnchangedKeyHelper + with + party : Party + where + signatory party + choice UnchangedKeyFetch : (ContractId UnchangedKey, UnchangedKey) with + k : UnchangedKeyKey + controller party + do fetchByKey k + + choice UnchangedKeyExercise : Text with + k : UnchangedKeyKey + controller party + do exerciseByKey @UnchangedKey k UnchangedKeyCall +-} + +main : Script () +main = tests + [ ("Query an unchanged old key for a new contract", queryKeyUnchanged) + , ("ExerciseByKey command an unchanged old key for a new contract", exerciseCmdKeyUnchanged) + , ("Fetching an unchanged old key for a new contract", fetchKeyUnchanged) + , ("ExerciseByKey in Update an unchanged old key for a new contract", exerciseUpdateKeyUnchanged) + ] + +queryKeyUnchanged : Script () +queryKeyUnchanged = do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.UnchangedKey a 1) + keyRes <- queryContractKey a $ V2.UnchangedKeyKey a 1 + case keyRes of + Some (foundCid, foundContract) | show foundCid == show cid && foundContract == V2.UnchangedKey a 1 None -> pure () + _ -> assertFail $ "Didn't find correct contract, expected " <> show (cid, V2.UnchangedKey a 1 None) <> ", got " <> show keyRes + +exerciseCmdKeyUnchanged : Script () +exerciseCmdKeyUnchanged = do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.UnchangedKey a 1) + res <- a `submit` exerciseByKeyExactCmd @V2.UnchangedKey (V2.UnchangedKeyKey a 1) V2.UnchangedKeyCall + res === "V2" + +fetchKeyUnchanged : Script () +fetchKeyUnchanged = do + a <- allocateParty "alice" + cid <- a `submit` createCmd (V1.UnchangedKey a 1) + (foundCid, foundContract) <- a `submit` createAndExerciseCmd (V2.UnchangedKeyHelper a) (V2.UnchangedKeyFetch $ V2.UnchangedKeyKey a 1) + foundContract === V2.UnchangedKey a 1 None + show foundCid === show cid + +exerciseUpdateKeyUnchanged : Script () +exerciseUpdateKeyUnchanged = do + a <- allocateParty "alice" + _ <- a `submit` createCmd (V1.UnchangedKey a 1) + res <- a `submit` createAndExerciseCmd (V2.UnchangedKeyHelper a) (V2.UnchangedKeyExercise $ V2.UnchangedKeyKey a 1) + res === "V2" + diff --git a/sdk/daml-script/test/daml/upgrades/DataChanges.daml b/sdk/daml-script/test/daml/upgrades/DataChanges.daml new file mode 100644 index 000000000000..4a59b0edaa64 --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/DataChanges.daml @@ -0,0 +1,288 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +{-# LANGUAGE AllowAmbiguousTypes #-} + +module DataChanges (main) where + +import UpgradeTestLib +import qualified V1.NameChanges as V1 +import qualified V1.FieldsRemoved as V1 +import qualified V1.FieldsRemovedNested as V1 +import qualified V1.NonOptionalFieldsAdded as V1 +import qualified V1.NonOptionalFieldsAddedNested as V1 +import qualified V1.EnumUnchanged as V1 +import qualified V1.EnumRemoved as V1 +import qualified V1.EnumAdditional as V1 + +import qualified V2.NameChanges as V2 +import qualified V2.FieldsRemoved as V2 +import qualified V2.FieldsRemovedNested as V2 +import qualified V2.NonOptionalFieldsAdded as V2 +import qualified V2.NonOptionalFieldsAddedNested as V2 +import qualified V2.EnumUnchanged as V2 +import qualified V2.EnumRemoved as V2 +import qualified V2.EnumAdditional as V2 +import DA.Text + +main : Script () +main = tests + [ ("Fails if the template name changes", templateNameChanges) + , ("Fails if fields are removed", templateFieldsRemoved) + , ("Fails if non-optional fields are added", templateNonOptionalFieldsAdded) + , ("Fails if nested fields are removed", templateFieldsRemovedNested) + , ("Fails if nested non-optional fields are added", templateNonOptionalFieldsAddedNested) + , ("Succeeds if a nested enum is unchanged", templateEnumUnchanged) + , ("Succeeds if a nested enum is upgraded and extended", templateEnumUpgradeFromOld) + , ("Succeeds if a nested enum is an old case when downgrading", templateEnumDowngradeFromOld) + , ("Fails if a nested enum is a removed case", templateEnumUpgradeToRemoved) + , ("Fails if a nested enum is an additional case when downgrading", templateEnumDowngradeFromNew) + ] + +templateInvalidChange : forall t2 t1 c2. (Template t1, HasEnsure t1, Choice t2 c2 Text) => Bool -> (Party -> t1) -> c2 -> Script () +templateInvalidChange shouldSucceed makeV1Contract v2Choice = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createExactCmd (makeV1Contract a) + let cidV2 = coerceContractId @t1 @t2 cid + res <- a `trySubmit` exerciseCmd cidV2 v2Choice + + case (res, shouldSucceed) of + (Right "V2", True) -> pure () + (Left (WronglyTypedContract {}), False) -> pure () + (Left (UnknownError msg), False) | "An error occurred." `isInfixOf` msg -> pure () + _ -> assertFail $ "Expected " <> (if shouldSucceed then "success" else "specific failure") <> " but got " <> show res + +{- PACKAGE +name: data-changes +versions: 2 +-} + +{- MODULE +package: data-changes +contents: | + module NameChanges where + + template NameChanges -- @V 1 + template NameChangesOops -- @V 2 + with + party : Party + where + signatory party + choice NameChangesCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +templateNameChanges : Script () +templateNameChanges = templateInvalidChange @V2.NameChangesOops False V1.NameChanges V2.NameChangesCall + +{- MODULE +package: data-changes +contents: | + module FieldsRemoved where + template FieldsRemoved + with + party : Party + someData : Int -- @V 1 + where + signatory party + choice FieldsRemovedCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +templateFieldsRemoved : Script () +templateFieldsRemoved = templateInvalidChange @V2.FieldsRemoved False (`V1.FieldsRemoved` 1) V2.FieldsRemovedCall + +{- MODULE +package: data-changes +contents: | + module FieldsRemovedNested where + data FieldsRemovedNestedData = FieldsRemovedNestedData + with + party : Party + someData : Int -- @V 1 + deriving (Eq, Show) + + template FieldsRemovedNested + with + nestedData : FieldsRemovedNestedData + where + signatory nestedData.party + choice FieldsRemovedNestedCall : Text + controller nestedData.party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +templateFieldsRemovedNested : Script () +templateFieldsRemovedNested = + templateInvalidChange + @V2.FieldsRemovedNested + False + (\p -> V1.FieldsRemovedNested $ V1.FieldsRemovedNestedData p 1) + V2.FieldsRemovedNestedCall + +{- MODULE +package: data-changes +contents: | + module NonOptionalFieldsAdded where + + template NonOptionalFieldsAdded + with + party : Party + newField : Int -- @V 2 + where + signatory party + choice NonOptionalFieldsAddedCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +templateNonOptionalFieldsAdded : Script () +templateNonOptionalFieldsAdded = templateInvalidChange @V2.NonOptionalFieldsAdded False V1.NonOptionalFieldsAdded V2.NonOptionalFieldsAddedCall + +{- MODULE +package: data-changes +contents: | + module NonOptionalFieldsAddedNested where + + data NonOptionalFieldsAddedNestedData = NonOptionalFieldsAddedNestedData + with + party : Party + newField : Int -- @V 2 + deriving (Eq, Show) + + template NonOptionalFieldsAddedNested + with + nestedData : NonOptionalFieldsAddedNestedData + where + signatory nestedData.party + choice NonOptionalFieldsAddedNestedCall : Text + controller nestedData.party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +templateNonOptionalFieldsAddedNested : Script () +templateNonOptionalFieldsAddedNested = + templateInvalidChange + @V2.NonOptionalFieldsAddedNested + False + (V1.NonOptionalFieldsAddedNested . V1.NonOptionalFieldsAddedNestedData) + V2.NonOptionalFieldsAddedNestedCall + +{- MODULE +package: data-changes +contents: | + module EnumUnchanged where + + data EnumUnchangedData + = EnumUnchangedData1 + | EnumUnchangedData2 + deriving (Eq, Show, Enum) + template EnumUnchanged + with + party : Party + nestedData : EnumUnchangedData + where + signatory party + choice EnumUnchangedCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +templateEnumUnchanged : Script () +templateEnumUnchanged = + templateInvalidChange + @V2.EnumUnchanged + True + (`V1.EnumUnchanged` V1.EnumUnchangedData1) + V2.EnumUnchangedCall + +{- MODULE +package: data-changes +contents: | + module EnumRemoved where + + data EnumRemovedData + = EnumRemovedData1 + | EnumRemovedData2 + | EnumRemovedData3 -- @V 1 + deriving (Eq, Show, Enum) + template EnumRemoved + with + party : Party + nestedData : EnumRemovedData + where + signatory party + choice EnumRemovedCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +templateEnumUpgradeToRemoved : Script () +templateEnumUpgradeToRemoved = + templateInvalidChange + @V2.EnumRemoved + False + (`V1.EnumRemoved` V1.EnumRemovedData3) + V2.EnumRemovedCall + +{- MODULE +package: data-changes +contents: | + module EnumAdditional where + + data EnumAdditionalData + = EnumAdditionalData1 + | EnumAdditionalData2 + | EnumAdditionalData3 -- @V 2 + deriving (Eq, Show, Enum) + template EnumAdditional + with + party : Party + nestedData : EnumAdditionalData + where + signatory party + choice EnumAdditionalCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +templateEnumDowngradeFromNew : Script () +templateEnumDowngradeFromNew = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createCmd V2.EnumAdditional with party = a, nestedData = V2.EnumAdditionalData3 + + let cidV1 = coerceContractId @V2.EnumAdditional @V1.EnumAdditional cid + + -- Ensure we can only call the V1 choice + res <- a `trySubmit` exerciseExactCmd cidV1 V1.EnumAdditionalCall + + case res of + Left (UnknownError msg) | "An error occurred." `isInfixOf` msg -> pure () + _ -> assertFail $ "Expected specific failure but got " <> show res + +templateEnumUpgradeFromOld : Script () +templateEnumUpgradeFromOld = + templateInvalidChange + @V2.EnumAdditional + True + (`V1.EnumAdditional` V1.EnumAdditionalData1) + V2.EnumAdditionalCall + +templateEnumDowngradeFromOld : Script () +templateEnumDowngradeFromOld = + templateInvalidChange + @V1.EnumAdditional + True + (`V2.EnumAdditional` V2.EnumAdditionalData1) + V1.EnumAdditionalCall + diff --git a/sdk/daml-script/test/daml/upgrades/Ensure.daml b/sdk/daml-script/test/daml/upgrades/Ensure.daml new file mode 100644 index 000000000000..02470feaa589 --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/Ensure.daml @@ -0,0 +1,75 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +{-# LANGUAGE AllowAmbiguousTypes #-} + +module Ensure (main) where + +import UpgradeTestLib +import qualified V1.EnsureChanges as V1 +import qualified V2.EnsureChanges as V2 +import DA.Exception + +{- PACKAGE +name: ensure-changes +versions: 2 +-} + +{- MODULE +package: ensure-changes +contents: | + module EnsureChanges where + + template EnsureChangesTemplate + with + v1Valid : Bool + v2Valid : Bool + party : Party + where + signatory party + ensure v1Valid -- @V 1 + ensure v2Valid -- @V 2 + + choice EnsureChangesCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +main : Script () +main = tests + [ ("Fails if the ensure clause changes such that V1 is not longer valid", ensureClauseBecomesInvalid) + , ("Succeeds when implicitly creating a V1 contract such that the ensure clause only passes in V2", onlyV2EnsureClauseRequiredForImplicitUpgrade) + , ("Fails when explicitly calling a V1 choice on a V2 contract that doesn't pass the ensure clause in V1", ensureClauseDowngradeToNoLongerValid) + ] + +testForPreconditionFailed + : forall t2 t1 c2 r + . (Template t1, HasEnsure t1, Choice t2 c2 r, Show r) + => (Party -> t1) + -> c2 + -> Bool + -> Script () +testForPreconditionFailed makeV1Contract v2Choice explicitPackageIds = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createExactCmd (makeV1Contract a) + let cidV2 = coerceContractId @t1 @t2 cid + res <- a `trySubmit` (if explicitPackageIds then exerciseExactCmd else exerciseCmd) cidV2 v2Choice + case res of + Left (UnhandledException (Some (fromAnyException -> Some (PreconditionFailed _)))) -> pure () + res -> assertFail $ "Expected PreconditionFailed, got " <> show res + +ensureClauseBecomesInvalid : Script () +ensureClauseBecomesInvalid = + testForPreconditionFailed @V2.EnsureChangesTemplate (V1.EnsureChangesTemplate True False) V2.EnsureChangesCall False + +onlyV2EnsureClauseRequiredForImplicitUpgrade : Script () +onlyV2EnsureClauseRequiredForImplicitUpgrade = do + a <- allocatePartyOn "alice" participant0 + -- The V1 should be implicitly upgraded to V2 before evaluating the ensure clause. + a `submit` createCmd (V1.EnsureChangesTemplate False True a) + pure () + +ensureClauseDowngradeToNoLongerValid : Script () +ensureClauseDowngradeToNoLongerValid = + testForPreconditionFailed @V1.EnsureChangesTemplate (V2.EnsureChangesTemplate False True) V1.EnsureChangesCall True diff --git a/sdk/daml-script/test/daml/upgrades/Fetch.daml b/sdk/daml-script/test/daml/upgrades/Fetch.daml new file mode 100644 index 000000000000..51edb7b08b7f --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/Fetch.daml @@ -0,0 +1,118 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module Fetch (main) where + +import UpgradeTestLib +import qualified V1.Fetch as V1 +import qualified V2.Fetch as V2 +import DA.Text + +{- PACKAGE +name: fetch +versions: 2 +-} + +{- MODULE +package: fetch +contents: | + module Fetch where + + template FetchTemplate + with + party: Party + newField : Optional Text -- @V 2 + where + signatory party + + template FetchHelper + with + party: Party + where + signatory party + choice DoFetch : FetchTemplate with + cid : ContractId FetchTemplate + controller party + do fetch cid +-} + +main : Script () +main = tests + [ ("Upgrade a contract when fetching", fetchUpgraded) + , ("Downgrade a contract with Nones when fetching", fetchDowngradedNone) + , ("Fail to downgrade a contract with Somes when fetching", fetchDowngradedSome) + + , -- Fetching tests with unvetted sources (BROKEN) + broken ("Upgrade a contract when fetching where the source package (V1) is unvetted", fetchUpgradedSourceUnvetted) + , broken ("Downgrade a contract with Nones when fetching where the source package (V2) is unvetted", fetchDowngradedNoneSourceUnvetted) + ] + +exerciseV1Util : Choice V1.FetchHelper c r => Party -> c -> Script r +exerciseV1Util p c = p `submit` createAndExerciseExactCmd (V1.FetchHelper with party = p) c + +exerciseV2Util : Choice V2.FetchHelper c r => Party -> c -> Script r +exerciseV2Util p c = p `submit` createAndExerciseExactCmd (V2.FetchHelper with party = p) c + +tryExerciseV1Util : Choice V1.FetchHelper c r => Party -> c -> Script (Either SubmitError r) +tryExerciseV1Util p c = p `trySubmit` createAndExerciseExactCmd (V1.FetchHelper with party = p) c + +tryExerciseV2Util : Choice V2.FetchHelper c r => Party -> c -> Script (Either SubmitError r) +tryExerciseV2Util p c = p `trySubmit` createAndExerciseExactCmd (V2.FetchHelper with party = p) c + +fetchUpgraded : Script () +fetchUpgraded = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createExactCmd V1.FetchTemplate with party = a + + let v2Cid = coerceContractId @V1.FetchTemplate @V2.FetchTemplate cid + v2Name <- a `exerciseV2Util` V2.DoFetch with cid = v2Cid + v2Name === V2.FetchTemplate with party = a, newField = None + +fetchDowngradedNone : Script () +fetchDowngradedNone = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createCmd V2.FetchTemplate with party = a, newField = None + let v1Cid = coerceContractId @V2.FetchTemplate @V1.FetchTemplate cid + v1Name <- a `exerciseV1Util` V1.DoFetch with cid = v1Cid + v1Name === V1.FetchTemplate with party = a + +fetchDowngradedSome : Script () +fetchDowngradedSome = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createCmd V2.FetchTemplate with party = a, newField = Some "hi" + let v1Cid = coerceContractId @V2.FetchTemplate @V1.FetchTemplate cid + eV1Name <- a `tryExerciseV1Util` V1.DoFetch with cid = v1Cid + + case eV1Name of + Left (DevError Upgrade msg) + | "An optional contract field with a value of Some may not be dropped during downgrading" `isInfixOf` msg + -> pure () + res -> assertFail $ "Expected DevError Upgrade, got " <> show res + +fetchUpgradedSourceUnvetted : Script () +fetchUpgradedSourceUnvetted = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createExactCmd V1.FetchTemplate with party = a + + -- Unvet v1, so the engine cannot have type information about the real packageid of the contract + withUnvettedDarOnParticipant "fetch-1.0.0" participant0 $ do + let v2Cid = coerceContractId @V1.FetchTemplate @V2.FetchTemplate cid + res <- a `tryExerciseV2Util` V2.DoFetch with cid = v2Cid + case res of + Right v2Name -> v2Name === V2.FetchTemplate with party = a, newField = None + Left err -> assertFail $ "Expected success but got " <> show err + +fetchDowngradedNoneSourceUnvetted : Script () +fetchDowngradedNoneSourceUnvetted = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createCmd V2.FetchTemplate with party = a, newField = None + + -- Unvet the upgraded type and ensure downgrade occurs + withUnvettedDarOnParticipant "fetch-2.0.0" participant0 $ do + let v1Cid = coerceContractId @V2.FetchTemplate @V1.FetchTemplate cid + res <- a `tryExerciseV1Util` V1.DoFetch with cid = v1Cid + + case res of + Right v1Name -> v1Name === V1.FetchTemplate with party = a + Left err -> assertFail $ "Expected success but got " <> show err + diff --git a/sdk/daml-script/test/daml/upgrades/LedgerApiAddedRemovedChoices.daml b/sdk/daml-script/test/daml/upgrades/LedgerApiAddedRemovedChoices.daml new file mode 100644 index 000000000000..1cdf99eee0ad --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/LedgerApiAddedRemovedChoices.daml @@ -0,0 +1,90 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +{-# LANGUAGE AllowAmbiguousTypes #-} + +module LedgerApiAddedRemovedChoices (main) where + +import UpgradeTestLib +import qualified V1.AddedRemovedChoice as V1 +import qualified V2.AddedRemovedChoice as V2 +import DA.Text + +{- PACKAGE +name: ledger-api-added-removed-choice-upgrades +versions: 2 +-} + +{- MODULE +package: ledger-api-added-removed-choice-upgrades +contents: | + module AddedRemovedChoice where + + template AddedRemovedChoiceTemplate + with + party : Party + newField : Optional Text -- @V 2 + where + signatory party + + choice OldRemovedChoice : Text -- @V 1 + controller party -- @V 1 + do pure "V1" -- @V 1 + + choice NewAddedChoice : Text -- @V 2 + controller party -- @V 2 + do pure "V2" -- @V 2 +-} + +main : Script () +main = tests + [ ("Succeeds explicitly calling a new V2 choice on a V1 contract", explicitNewV2ChoiceV1Contract) + , ("Succeeds implicitly calling a new V2 choice on a V1 contract", implicitNewV2ChoiceV1Contract) + , -- These cases should not be possible once upload time checks are implemented + ("Succeeds explicitly calling a removed V1 choice on a V2 contract", explicitRemovedV1ChoiceV2Contract) + , ("Fails implicitly calling a removed V1 choice on a V2 contract, as V2 is selected", implicitRemovedV1ChoiceV2Contract) + , ("Fails implicitly calling a removed V1 choice on a V1 contract, as V2 is selected", implicitRemovedV1ChoiceV1Contract) + ] + +genericUpgradeTest + : forall t2 t1 c2 r + . (Template t1, HasEnsure t1, Choice t2 c2 r) + => (Party -> t1) + -> c2 + -> Bool + -> (Either SubmitError r -> Script ()) + -> Script () +genericUpgradeTest makeV1Contract v2Choice explicitPackageIds handleRes = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createExactCmd (makeV1Contract a) + let cidV2 = coerceContractId @t1 @t2 cid + res <- a `trySubmit` (if explicitPackageIds then exerciseExactCmd else exerciseCmd) cidV2 v2Choice + handleRes res + +choiceTest : forall t2 t1 c2 r. (Template t1, HasEnsure t1, Choice t2 c2 r, Eq r, Show r) => (Party -> t1) -> c2 -> Bool -> r -> Script () +choiceTest makeV1Contract v2Choice explicitPackageIds expectedResult = genericUpgradeTest @t2 makeV1Contract v2Choice explicitPackageIds $ \res -> + case res of + Right returnValue -> returnValue === expectedResult + Left err -> assertFail $ "Expected " <> show expectedResult <> " but got " <> show err + +explicitNewV2ChoiceV1Contract : Script () +explicitNewV2ChoiceV1Contract = choiceTest @V2.AddedRemovedChoiceTemplate V1.AddedRemovedChoiceTemplate V2.NewAddedChoice True "V2" + +implicitNewV2ChoiceV1Contract : Script () +implicitNewV2ChoiceV1Contract = choiceTest @V2.AddedRemovedChoiceTemplate V1.AddedRemovedChoiceTemplate V2.NewAddedChoice False "V2" + +explicitRemovedV1ChoiceV2Contract : Script () +explicitRemovedV1ChoiceV2Contract = choiceTest @V1.AddedRemovedChoiceTemplate (`V2.AddedRemovedChoiceTemplate` None) V1.OldRemovedChoice True "V1" + +implicitRemovedV1ChoiceV2Contract : Script () +implicitRemovedV1ChoiceV2Contract = + genericUpgradeTest @V1.AddedRemovedChoiceTemplate (`V2.AddedRemovedChoiceTemplate` None) V1.OldRemovedChoice False $ \case + Left (UnknownError msg) | "unknown choice OldRemovedChoice" `isInfixOf` msg -> pure () + res -> assertFail $ "Expected unknown choice error, got " <> show res + +implicitRemovedV1ChoiceV1Contract : Script () +implicitRemovedV1ChoiceV1Contract = + genericUpgradeTest @V1.AddedRemovedChoiceTemplate V1.AddedRemovedChoiceTemplate V1.OldRemovedChoice False $ \case + Left (UnknownError msg) | "unknown choice OldRemovedChoice" `isInfixOf` msg -> pure () + res -> assertFail $ "Expected unknown choice error, got " <> show res + diff --git a/sdk/daml-script/test/daml/upgrades/LedgerApiChoiceNestedUpgrade.daml b/sdk/daml-script/test/daml/upgrades/LedgerApiChoiceNestedUpgrade.daml new file mode 100644 index 000000000000..10d1644afd38 --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/LedgerApiChoiceNestedUpgrade.daml @@ -0,0 +1,131 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +{-# LANGUAGE AllowAmbiguousTypes #-} + +module LedgerApiChoiceNestedUpgrade (main) where + +import UpgradeTestLib +import qualified V1.UpgradedChoiceNested as V1 +import qualified V2.UpgradedChoiceNested as V2 + +{- PACKAGE +name: ledger-api-choice-nested-upgrades +versions: 2 +-} + +{- MODULE +package: ledger-api-choice-nested-upgrades +contents: | + module UpgradedChoiceNested where + + data UpgradedChoiceReturn = UpgradedChoiceReturn with + someData : Text + someOtherData : Optional Text -- @V 2 + deriving (Eq, Show) + + data UpgradedChoiceReturnWrapper = UpgradedChoiceReturnWrapper with + unwrap : UpgradedChoiceReturn + deriving (Eq, Show) + + data UpgradedChoiceData = UpgradedChoiceData with + firstArg : Text + secondArg : Optional Text -- @V 2 + deriving (Eq, Show) + + template UpgradedChoiceNestedTemplate + with + party : Party + newField : Optional Text -- @V 2 + where + signatory party + + choice UpgradedChoiceNested : UpgradedChoiceReturnWrapper with + choiceData : UpgradedChoiceData + controller party + do + pure $ UpgradedChoiceReturnWrapper $ UpgradedChoiceReturn + (choiceData.firstArg <> ":V1") -- @V 1 + (choiceData.firstArg <> ":V2:" <> show choiceData.secondArg) -- @V 2 + choiceData.secondArg -- @V 2 +-} + +main : Script () +main = tests + [ ("Explicitly call a V1 choice on a V1 contract over the ledger-api, expect V1 implementation used. (Nested)", explicitV1ChoiceV1ContractNested) + , ("Explicitly call a V2 choice on a V1 contract over the ledger-api, expect V2 implementation used, and contract upgraded. (Nested)", explicitV2ChoiceV1ContractNested) + , ("Call a V1 choice without package ID on a V1 contract over the ledger-api, expect V2 implementation used, contract + argument upgraded, daml-script downgrades return type. (Nested)", inferredV1ChoiceV1ContractNested) + , ("Call a V2 choice without package ID on a V1 contract over the ledger-api, expect V2 implementation used, and contract upgraded. (Nested)", inferredV2ChoiceV1ContractNested) + , broken ("Call a V2 choice without package ID on a V1 contract over the ledger-api, with V2 unvetted, expect V1 implementation used, argument downgraded, daml-script upgrades return type. (Nested)", inferredV1ChoiceV1ContractWithoutV2Nested) + , ("Explicitly call a V1 choice on a V2 contract over the ledger-api, expect V1 implementation used, and contract downgraded. (Nested)", explicitV1ChoiceV2ContractNested) + , ("Explicitly call a V2 choice on a V2 contract over the ledger-api, expect V2 implementation used. (Nested)", explicitV2ChoiceV2ContractNested) + ] + +choiceTest + : forall t2 t1 c2 r + . (Template t1, HasEnsure t1, Choice t2 c2 r, Eq r, Show r) + => (Party -> t1) + -> c2 + -> Bool + -> r + -> Script () +choiceTest makeV1Contract v2Choice explicitPackageIds expectedResult = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createExactCmd (makeV1Contract a) + let cidV2 = coerceContractId @t1 @t2 cid + res <- a `trySubmit` (if explicitPackageIds then exerciseExactCmd else exerciseCmd) cidV2 v2Choice + case res of + Right returnValue -> returnValue === expectedResult + Left err -> assertFail $ "Expected " <> show expectedResult <> " but got " <> show err + + +-- Convenience wrappers for the nested varients of these tests +v1ChoiceNested : Text -> V1.UpgradedChoiceNested +v1ChoiceNested = V1.UpgradedChoiceNested . V1.UpgradedChoiceData + +v1ChoiceReturnNested : Text -> V1.UpgradedChoiceReturnWrapper +v1ChoiceReturnNested = V1.UpgradedChoiceReturnWrapper . V1.UpgradedChoiceReturn + +v2ChoiceNested : Text -> Optional Text -> V2.UpgradedChoiceNested +v2ChoiceNested t = V2.UpgradedChoiceNested . V2.UpgradedChoiceData t + +v2ChoiceReturnNested : Text -> Optional Text -> V2.UpgradedChoiceReturnWrapper +v2ChoiceReturnNested t = V2.UpgradedChoiceReturnWrapper . V2.UpgradedChoiceReturn t + +explicitV1ChoiceV1ContractNested : Script () +explicitV1ChoiceV1ContractNested = + choiceTest @V1.UpgradedChoiceNestedTemplate V1.UpgradedChoiceNestedTemplate (v1ChoiceNested "v1 to v1") True (v1ChoiceReturnNested "v1 to v1:V1") + +explicitV2ChoiceV1ContractNested : Script () +explicitV2ChoiceV1ContractNested = + choiceTest @V2.UpgradedChoiceNestedTemplate V1.UpgradedChoiceNestedTemplate (v2ChoiceNested "v2 to v1" $ Some "extra") True (v2ChoiceReturnNested "v2 to v1:V2:Some \"extra\"" $ Some "extra") + +-- When inferring, the V1 contract and choice argument is upgraded, and the return type is downgraded directly by daml script. +-- As such, we get the v2 implementation called, with the additional field set to None (as shown in the choice return) +-- and since the extra data in the return will also be none, the downgrade can succeed. +inferredV1ChoiceV1ContractNested : Script () +inferredV1ChoiceV1ContractNested = + choiceTest @V1.UpgradedChoiceNestedTemplate V1.UpgradedChoiceNestedTemplate (v1ChoiceNested "v1 to v1") False (v1ChoiceReturnNested "v1 to v1:V2:None") + +inferredV2ChoiceV1ContractNested : Script () +inferredV2ChoiceV1ContractNested = + choiceTest @V2.UpgradedChoiceNestedTemplate V1.UpgradedChoiceNestedTemplate (v2ChoiceNested "v2 to v1" $ Some "extra") False (v2ChoiceReturnNested "v2 to v1:V2:Some \"extra\"" $ Some "extra") + +-- If v2 isn't vetted, then omitting a package id and giving v1 arguments should use the v1 implementation +-- TODO: This test fails for several reason: +-- first it tries to use v2 even through its unvetted <- this is not correct behaviour +-- second it doesn't hit a NO_DOMAIN_FOR_SUBMISSION error before attempting to directly upgrade the data type <- this is also not correct behaviour +-- lastly, it hits the same error as inferredV1ChoiceV1Contract, which is that choice argument upgrading isn't supported +inferredV1ChoiceV1ContractWithoutV2Nested : Script () +inferredV1ChoiceV1ContractWithoutV2Nested = + withUnvettedDar "ledger-api-choice-nested-upgrades-2.0.0" $ + choiceTest @V1.UpgradedChoiceNestedTemplate V1.UpgradedChoiceNestedTemplate (v1ChoiceNested "v1 to v1") False (v1ChoiceReturnNested "v1 to v1:V1") + +explicitV1ChoiceV2ContractNested : Script () +explicitV1ChoiceV2ContractNested = + choiceTest @V1.UpgradedChoiceNestedTemplate (`V2.UpgradedChoiceNestedTemplate` None) (v1ChoiceNested "v1 to v2") True (v1ChoiceReturnNested "v1 to v2:V1") + +explicitV2ChoiceV2ContractNested : Script () +explicitV2ChoiceV2ContractNested = + choiceTest @V2.UpgradedChoiceNestedTemplate (`V2.UpgradedChoiceNestedTemplate` Some "text") (v2ChoiceNested "v2 to v2" $ Some "extra") True (v2ChoiceReturnNested "v2 to v2:V2:Some \"extra\"" $ Some "extra") + diff --git a/sdk/daml-script/test/daml/upgrades/LedgerApiChoiceUpgrade.daml b/sdk/daml-script/test/daml/upgrades/LedgerApiChoiceUpgrade.daml new file mode 100644 index 000000000000..ab5e4a828240 --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/LedgerApiChoiceUpgrade.daml @@ -0,0 +1,108 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +{-# LANGUAGE AllowAmbiguousTypes #-} + +module LedgerApiChoiceUpgrade (main) where + +import UpgradeTestLib +import qualified V1.UpgradedChoice as V1 +import qualified V2.UpgradedChoice as V2 + +{- PACKAGE +name: ledger-api-choice-upgrades +versions: 2 +-} + +{- MODULE +package: ledger-api-choice-upgrades +contents: | + module UpgradedChoice where + + data UpgradedChoiceReturn = UpgradedChoiceReturn with + someData : Text + someOtherData : Optional Text -- @V 2 + deriving (Eq, Show) + + template UpgradedChoiceTemplate + with + party : Party + newField : Optional Text -- @V 2 + where + signatory party + + choice UpgradedChoice : UpgradedChoiceReturn with + firstArg : Text + secondArg : Optional Text -- @V 2 + controller party + do + pure $ UpgradedChoiceReturn + (firstArg <> ":V1") -- @V 1 + (firstArg <> ":V2:" <> show secondArg) -- @V 2 + secondArg -- @V 2 +-} + +main : Script () +main = tests + [ ("Explicitly call a V1 choice on a V1 contract over the ledger-api, expect V1 implementation used.", explicitV1ChoiceV1Contract) + , ("Explicitly call a V2 choice on a V1 contract over the ledger-api, expect V2 implementation used, and contract upgraded.", explicitV2ChoiceV1Contract) + , ("Call a V1 choice without package ID on a V1 contract over the ledger-api, expect V2 implementation used, contract + argument upgraded, daml-script downgrades return type.", inferredV1ChoiceV1Contract) + , ("Call a V2 choice without package ID on a V1 contract over the ledger-api, expect V2 implementation used, and contract upgraded.", inferredV2ChoiceV1Contract) + , broken ("Call a V2 choice without package ID on a V1 contract over the ledger-api, with V2 unvetted, expect V1 implementation used, argument downgraded, daml-script upgrades return type.", inferredV1ChoiceV1ContractWithoutV2) + , ("Explicitly call a V1 choice on a V2 contract over the ledger-api, expect V1 implementation used, and contract downgraded.", explicitV1ChoiceV2Contract) + , ("Explicitly call a V2 choice on a V2 contract over the ledger-api, expect V2 implementation used.", explicitV2ChoiceV2Contract) + ] + +choiceTest + : forall t2 t1 c2 r + . (Template t1, HasEnsure t1, Choice t2 c2 r, Eq r, Show r) + => (Party -> t1) + -> c2 + -> Bool + -> r + -> Script () +choiceTest makeV1Contract v2Choice explicitPackageIds expectedResult = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createExactCmd (makeV1Contract a) + let cidV2 = coerceContractId @t1 @t2 cid + res <- a `trySubmit` (if explicitPackageIds then exerciseExactCmd else exerciseCmd) cidV2 v2Choice + case res of + Right returnValue -> returnValue === expectedResult + Left err -> assertFail $ "Expected " <> show expectedResult <> " but got " <> show err + +explicitV1ChoiceV1Contract : Script () +explicitV1ChoiceV1Contract = + choiceTest @V1.UpgradedChoiceTemplate V1.UpgradedChoiceTemplate (V1.UpgradedChoice "v1 to v1") True (V1.UpgradedChoiceReturn "v1 to v1:V1") + +explicitV2ChoiceV1Contract : Script () +explicitV2ChoiceV1Contract = + choiceTest @V2.UpgradedChoiceTemplate V1.UpgradedChoiceTemplate (V2.UpgradedChoice "v2 to v1" $ Some "extra") True (V2.UpgradedChoiceReturn "v2 to v1:V2:Some \"extra\"" $ Some "extra") + +-- When inferring, the V1 contract and choice argument is upgraded, and the return type is downgraded directly by daml script. +-- As such, we get the v2 implementation called, with the additional field set to None (as shown in the choice return) +-- and since the extra data in the return will also be none, the downgrade can succeed. +inferredV1ChoiceV1Contract : Script () +inferredV1ChoiceV1Contract = + choiceTest @V1.UpgradedChoiceTemplate V1.UpgradedChoiceTemplate (V1.UpgradedChoice "v1 to v1") False (V1.UpgradedChoiceReturn "v1 to v1:V2:None") + +inferredV2ChoiceV1Contract : Script () +inferredV2ChoiceV1Contract = + choiceTest @V2.UpgradedChoiceTemplate V1.UpgradedChoiceTemplate (V2.UpgradedChoice "v2 to v1" $ Some "extra") False (V2.UpgradedChoiceReturn "v2 to v1:V2:Some \"extra\"" $ Some "extra") + +-- If v2 isn't vetted, then omitting a package id and giving v1 arguments should use the v1 implementation +-- TODO: This test fails for several reasons: +-- first it tries to use v2 even through its unvetted <- this is not correct behaviour +-- second it doesn't hit a NO_DOMAIN_FOR_SUBMISSION error before attempting to directly upgrade the data type <- this is also not correct behaviour +inferredV1ChoiceV1ContractWithoutV2 : Script () +inferredV1ChoiceV1ContractWithoutV2 = + withUnvettedDar "ledger-api-choice-upgrades-2.0.0" $ + choiceTest @V1.UpgradedChoiceTemplate V1.UpgradedChoiceTemplate (V1.UpgradedChoice "v1 to v1") False (V1.UpgradedChoiceReturn "v1 to v1:V1") + +explicitV1ChoiceV2Contract : Script () +explicitV1ChoiceV2Contract = + choiceTest @V1.UpgradedChoiceTemplate (`V2.UpgradedChoiceTemplate` None) (V1.UpgradedChoice "v1 to v2") True (V1.UpgradedChoiceReturn "v1 to v2:V1") + +explicitV2ChoiceV2Contract : Script () +explicitV2ChoiceV2Contract = + choiceTest @V2.UpgradedChoiceTemplate (`V2.UpgradedChoiceTemplate` Some "text") (V2.UpgradedChoice "v2 to v2" $ Some "extra") True (V2.UpgradedChoiceReturn "v2 to v2:V2:Some \"extra\"" $ Some "extra") + diff --git a/sdk/daml-script/test/daml/upgrades/MultiParticipant.daml b/sdk/daml-script/test/daml/upgrades/MultiParticipant.daml new file mode 100644 index 000000000000..bf5f758ddf62 --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/MultiParticipant.daml @@ -0,0 +1,74 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module MultiParticipant (main) where + +import UpgradeTestLib +import qualified V1.MultiParticipant as V1 +-- import qualified V2.MultiParticipant as V2 +import DA.Text + +{- PACKAGE +name: multi-participant +versions: 2 +-} + +{- MODULE +package: multi-participant +contents: | + module MultiParticipant where + + template SharedTemplate + with + party : Party + ob : Party + additionalField : Optional Text -- @V 2 + where + signatory party + observer ob +-} + +main : Script () +main = tests + [ ("Both participants have v2, upgraded create succeeds.", bothParticipantsV2) + , ("Submitting participant has v2, other has v1, expect v1 used.", submitV2OtherV1) + , ("Submitting participant has v1, other has v2, expect v1 used.", submitV1OtherV2) + ] + +-- The error given back for unknown templates is either PACKAGE_NOT_FOUND (if the dar was never uploaded) +-- or NO_DOMAIN_FOR_SUBMISSION. We always upload all dars before the test, so we'll never hit the former error. +-- We've not yet implemented variants in the SubmitError type for NoDomainForSubmission, so we capture this error via UnknownError +assertUnknownPackageError : Either SubmitError a -> Script () +assertUnknownPackageError (Left (UnknownError msg)) | "NO_DOMAIN_FOR_SUBMISSION" `isInfixOf` msg = pure () +assertUnknownPackageError (Left err) = assertFail $ "Expected NO_DOMAIN_FOR_SUBMISSION error, but got: " <> show err +assertUnknownPackageError (Right _) = assertFail $ "Expected missing package error, but submission succeeded" + +-- Convenient wrapper we can inline with the submit call +liftAssertUnknownPackageError : Script (Either SubmitError a) -> Script () +liftAssertUnknownPackageError s = s >>= assertUnknownPackageError + +bothParticipantsV2 : Script () +bothParticipantsV2 = do + a <- allocatePartyOn "alice" participant0 + b <- allocatePartyOn "bob" participant1 + a `submit` createCmd V1.SharedTemplate with party = a, ob = b + pure () + +submitV1OtherV2 : Script () +submitV1OtherV2 = do + a <- allocatePartyOn "alice" participant0 + b <- allocatePartyOn "bob" participant1 + + withUnvettedDarOnParticipant "multi-participant-2.0.0" participant0 $ + a `trySubmit` createCmd V1.SharedTemplate with party = a, ob = b + + pure () + +submitV2OtherV1 : Script () +submitV2OtherV1 = do + a <- allocatePartyOn "alice" participant0 + b <- allocatePartyOn "bob" participant1 + + withUnvettedDarOnParticipant "multi-participant-2.0.0" participant1 $ + liftAssertUnknownPackageError $ a `trySubmit` createCmd V1.SharedTemplate with party = a, ob = b + diff --git a/sdk/daml-script/test/daml/upgrades/PackageSelection.daml b/sdk/daml-script/test/daml/upgrades/PackageSelection.daml new file mode 100644 index 000000000000..8ed93998181b --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/PackageSelection.daml @@ -0,0 +1,46 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module PackageSelection (main) where + +import UpgradeTestLib +import qualified V1.PackageSelection as V1 +-- import qualified V2.PackageSelection as V2 + +{- PACKAGE +name: package-selection +versions: 2 +-} + +{- MODULE +package: package-selection +contents: | + module PackageSelection where + + template PackageSelectionTemplate + with + party: Party + where + signatory party +-} + +main : Script () +main = tests + [ -- https://github.com/DACH-NY/canton/issues/14718 + broken ("Chooses the v1 contract if v2 is unvetted and package id is omitted.", packageSelectionChoosesUnvettedPackages) + ] + +packageSelectionChoosesUnvettedPackages : Script () +packageSelectionChoosesUnvettedPackages = + -- Unvet the v2 dar on all participants on the domain + withUnvettedDar "package-selection-2.0.0" $ do + a <- allocatePartyOn "alice" participant0 + -- Attempt to create a v1 contract, without specifying package id, expecting that the v1 package will be selected as v2 is unvetted + res <- a `trySubmit` createCmd V1.PackageSelectionTemplate with party = a + + -- What actually happens is the submitting participant chooses the v2 package, finds none of the participants on the domain have this package + -- and gives a NO_DOMAIN_FOR_SUBMISSION error + case res of + Right cid -> pure () + _ -> assertFail $ "Expected success but got " <> show res + diff --git a/sdk/daml-script/test/daml/upgrades/Query.daml b/sdk/daml-script/test/daml/upgrades/Query.daml new file mode 100644 index 000000000000..7541aae834ff --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/Query.daml @@ -0,0 +1,62 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module Query (main) where + +import UpgradeTestLib +import qualified V1.Query as V1 +import qualified V2.Query as V2 + +{- PACKAGE +name: query +versions: 2 +-} + +{- MODULE +package: query +contents: | + module Query where + + template QueryTemplate + with + party: Party + newField : Optional Text -- @V 2 + where + signatory party +-} + +main : Script () +main = tests + [ ("Upgrade a contract when querying", queryUpgraded) + , ("Downgrade a contract with Nones when querying", queryDowngradedNone) + , ("Fail to downgrade a contract with Somes when querying", queryDowngradedSome) + ] + +queryUpgraded : Script () +queryUpgraded = do + a <- allocatePartyOn "alice" participant0 + + cid <- a `submit` createExactCmd V1.QueryTemplate with party = a + let v2Cid = coerceContractId @V1.QueryTemplate @V2.QueryTemplate cid + v2Name <- queryContractId a v2Cid + v2Name === Some V2.QueryTemplate with party = a, newField = None + +queryDowngradedNone : Script () +queryDowngradedNone = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createCmd V2.QueryTemplate with party = a, newField = None + let v1Cid = coerceContractId @V2.QueryTemplate @V1.QueryTemplate cid + v1Name <- queryContractId a v1Cid + v1Name === Some V1.QueryTemplate with party = a + pure () + +queryDowngradedSome : Script () +queryDowngradedSome = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createCmd V2.QueryTemplate with party = a, newField = Some("Text") + let v1Cid = coerceContractId @V2.QueryTemplate @V1.QueryTemplate cid + res <- tryCommands $ queryContractId a v1Cid + case res of + Left (FailedCmd (CommandName "QueryContractId") _ _) -> pure () + _ -> assertFail $ "Expected QueryContractId to error, but got " <> show res + diff --git a/sdk/daml-script/test/daml/upgrades/QueryDisclosure.daml b/sdk/daml-script/test/daml/upgrades/QueryDisclosure.daml new file mode 100644 index 000000000000..ffcb59c3f86d --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/QueryDisclosure.daml @@ -0,0 +1,51 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module QueryDisclosure (main) where + +import UpgradeTestLib +import qualified V1.QueryDisclosure as V1 +import qualified V2.QueryDisclosure as V2 +import DA.Optional (fromSome) + +{- PACKAGE +name: query-disclosure +versions: 2 +-} + +{- MODULE +package: query-disclosure +contents: | + module QueryDisclosure where + + template QueryDisclosureTemplate + with + party: Party + newField : Optional Text -- @V 2 + where + signatory party + + choice QueryDisclosureChoice : () + with + ctl: Party + where + controller ctl + do pure () +-} + +main : Script () +main = tests + [ ( "Disclosure retrieved with an upgraded template ID are valid disclosures" + , queriedDisclosuresAreValid + ) + ] + +queriedDisclosuresAreValid : Script () +queriedDisclosuresAreValid = do + a <- allocatePartyOn "alice" participant0 + b <- allocatePartyOn "bob" participant0 + + cid <- a `submit` createExactCmd V1.QueryDisclosureTemplate with party = a + let v2Cid = coerceContractId @V1.QueryDisclosureTemplate @V2.QueryDisclosureTemplate cid + disclosure <- fromSome <$> queryDisclosure a v2Cid + submitWithDisclosures b [disclosure] $ exerciseCmd v2Cid (V2.QueryDisclosureChoice b) diff --git a/sdk/daml-script/test/daml/upgrades/README.md b/sdk/daml-script/test/daml/upgrades/README.md new file mode 100644 index 000000000000..477134dfb939 --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/README.md @@ -0,0 +1,88 @@ +# Writing upgrades tests here +This suite allows for small, self contained runtime upgrades tests written with daml-script. +It provides a mechanism for generating upgraded dars within the daml test file using comments. + +## Generated packages +Each test module can have one or more `PACKAGE` definitions in the following format: +``` +{- PACKAGE +name: +versions: +-} +``` + +as well as one or more `MODULE` definitions in the following format: +``` +{- MODULE +package: +contents: | + module where + +-} +``` + +NOTES: + * The `name` of a `PACKAGE` must be unique across all upgrades tests, so choose something similar to your test file name. + * If the `package` of a `MODULE` definition does not match any `PACKAGE` definition, it will be ignored. + * The module name is extracted from the `contents`, so it must contain the line `module where` somewhere. + * Version comments (see below) are processed before extracting the module name, allowing for module name changes across versions. + * If multiple `MODULE` definitions use the same module name, the test suite will crash. + +The contents of each module can use a version comment syntax to include subsets of code in a specific version. +The syntax for this is ` -- @V `. For example +``` +template Upgraded with + p: Party + anotherField: Optional Int -- @V 2 + fieldThatChangesType: Int -- @V 1 + fieldThatChangesType: Text -- @V 2 + where + signatory p +``` + +With these comments, the modules can be imported via modules prefixes. Each module path will be prefixed with `V1` .. `Vn` for importing. +i.e. +``` +import qualified V1.Name.Of.The.Module as V1 +import qualified V2.Name.Of.The.Module as V2 +``` + +## UpgradeTestLib +It is expected that all daml script test files import the `UpgradeTestLib` module, which will transitively import daml3-script and various assertion/utility modules. +This testing module exposes the `tests` function as such +``` +tests : [(Text, Script ())] -> Script () +``` +This is used to define your list of named tests. Each test file will run a top level `main : Script ()` function, so the usual formula is +``` +main : Script () +main = tests + [ ("some test", someTest) + , ("some other test", someOtherTest) + ] + +someTest : Script () +someTest = ... + +someOtherTest : Script () +someOtherTest = ... +``` + +Given upgrades is work in progress, we also expose `broken : (Text, Script ()) -> (Text, Script ())`, which can be used to wrap the test cases in the `main` definition. This will tag the test with `(BROKEN)` and ensure it fails. +``` +main : Script () +main = tests + [ ("some test", someTest) + , broken ("oops", someOtherTest) + ] +``` + +Finally, we provide some utilities for unvetting dars in tests. +``` +withUnvettedDar : Text -> Script a -> Script a +withUnvettedDarOnParticipant : Text -> ParticipantName -> Script a -> Script a +participant0 : ParticipantName +participant1 : ParticipantName +``` +These allow running a computation with a dar unvetted, and handle re-vetting the dar afterwards, even in the case of failure. The first `Text` field is the dar names discussed in the Generated packages section, i.e. `my-package-1.0.0`. +Avoid using the daml3-script internal vetting primitives, and use these functions instead. diff --git a/sdk/daml-script/test/daml/upgrades/SignatoryObserverChanges.daml b/sdk/daml-script/test/daml/upgrades/SignatoryObserverChanges.daml new file mode 100644 index 000000000000..eb23382e5c36 --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/SignatoryObserverChanges.daml @@ -0,0 +1,112 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module SignatoryObserverChanges (main) where + +import UpgradeTestLib +import qualified V1.SignatoryObserverChanges as V1 +import qualified V2.SignatoryObserverChanges as V2 +import DA.Text + +{- PACKAGE +name: signatory-observer-changes +versions: 2 +-} + +{- MODULE +package: signatory-observer-changes +contents: | + module SignatoryObserverChanges where + + template SignatoryObserverChangesTemplate + with + signatories : [Party] + observers : [Party] + replacementSignatories : [Party] + replacementObservers : [Party] + where + signatory signatories -- @V 1 + signatory replacementSignatories -- @V 2 + observer observers -- @V 1 + observer replacementObservers -- @V 2 + + choice InvalidUpgradeStakeholdersCall : () with -- @V 2 + controller signatory this -- @V 2 + do pure () -- @V 2 +-} + +main : Script () +main = tests + [ ("Succeeds if the signatories don't change", unchangedSignatoryUpgrade) + , ("Fails if the signatories set gets larger", largerSignatoryUpgrade) + , ("Fails if the signatories set gets smaller", smallerSignatoryUpgrade) + , ("Succeeds if the observers don't change", unchangeObserverUpgrade) + , ("Fails if the observers set gets larger", largerObserverUpgrade) + , ("Fails if the observers set gets smaller", smallerObserverUpgrade) + , ("Succeeds if the observer set loses parties that are already signatories", canRemoveObserversThatAreSignatories) + ] + +-- Given a function that maps a set of 3 parties to the pre-upgrade and post-upgrade signatory set +-- and the same for observers +-- along side an expected result flag (success or failure), test the upgrade behaviour +signatoryObserverUpgrade + : Bool + -> ((Party, Party, Party) -> ([Party], [Party])) + -> ((Party, Party, Party) -> ([Party], [Party])) + -> Script () +signatoryObserverUpgrade shouldSucceed sigF obsF = do + alice <- allocatePartyOn "alice" participant0 + bob <- allocatePartyOn "bob" participant0 + charlie <- allocatePartyOn "charlie" participant0 + let (preSignatories, postSignatories) = sigF (alice, bob, charlie) + (preObservers, postObservers) = obsF (alice, bob, charlie) + + cid <- submitMulti [alice, bob, charlie] [] $ createExactCmd V1.SignatoryObserverChangesTemplate with + signatories = preSignatories + observers = preObservers + replacementSignatories = postSignatories + replacementObservers = postObservers + + let cidV2 = coerceContractId @V1.SignatoryObserverChangesTemplate @V2.SignatoryObserverChangesTemplate cid + res <- trySubmitMulti [alice, bob, charlie] [] $ exerciseCmd cidV2 V2.InvalidUpgradeStakeholdersCall + case (res, shouldSucceed) of + (Right _, True) -> pure () + (Left (DevError Upgrade msg), False) + | "Verify that neither the signatories, nor the observers, nor the contract key, nor the key's maintainers have changed" `isInfixOf` msg + -> pure () + _ -> assertFail $ "Expected " <> (if shouldSucceed then "success" else "Upgrade error") <> " but got " <> show res + +unchanged : (Party, Party, Party) -> ([Party], [Party]) +unchanged (alice, bob, charlie) = ([alice], [alice]) + +signatoryUpgrade : Bool -> ((Party, Party, Party) -> ([Party], [Party])) -> Script () +signatoryUpgrade shouldSucceed f = signatoryObserverUpgrade shouldSucceed f unchanged + +observerUpgrade : Bool -> ((Party, Party, Party) -> ([Party], [Party])) -> Script () +observerUpgrade shouldSucceed = signatoryObserverUpgrade shouldSucceed unchanged + +unchangedSignatoryUpgrade : Script () +unchangedSignatoryUpgrade = signatoryUpgrade True unchanged + +largerSignatoryUpgrade : Script () +largerSignatoryUpgrade = signatoryUpgrade False $ \(alice, bob, charlie) -> ([alice, bob], [alice, bob, charlie]) + +smallerSignatoryUpgrade : Script () +smallerSignatoryUpgrade = signatoryUpgrade False $ \(alice, bob, charlie) -> ([alice, bob, charlie], [alice, bob]) + +unchangeObserverUpgrade : Script () +unchangeObserverUpgrade = observerUpgrade True unchanged + +largerObserverUpgrade : Script () +largerObserverUpgrade = observerUpgrade False $ \(alice, bob, charlie) -> ([alice, bob], [alice, bob, charlie]) + +smallerObserverUpgrade : Script () +smallerObserverUpgrade = observerUpgrade False $ \(alice, bob, charlie) -> ([alice, bob, charlie], [alice, bob]) + +canRemoveObserversThatAreSignatories : Script () +canRemoveObserversThatAreSignatories = + signatoryObserverUpgrade + True + (\(alice, bob, charlie) -> ([alice, bob, charlie], [alice, bob, charlie])) -- signatories + (\(alice, bob, charlie) -> ([alice, bob, charlie], [alice, bob])) -- observers + diff --git a/sdk/daml-script/test/daml/upgrades/VariantChanges.daml b/sdk/daml-script/test/daml/upgrades/VariantChanges.daml new file mode 100644 index 000000000000..e32b9a27fd45 --- /dev/null +++ b/sdk/daml-script/test/daml/upgrades/VariantChanges.daml @@ -0,0 +1,440 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +{-# LANGUAGE AllowAmbiguousTypes #-} + +module VariantChanges (main) where + +import UpgradeTestLib +import DA.Text + +import qualified V1.VariantUnchanged as V1 +import qualified V1.VariantRemCon as V1 +import qualified V1.VariantRemFld as V1 +import qualified V1.VariantAddCon as V1 +import qualified V1.VariantAddOptFld as V1 +import qualified V1.VariantAddOptNestedFld as V1 +import qualified V1.VariantAddNonOptFld as V1 +import qualified V1.VariantAddNonOptNestedFld as V1 +import qualified V1.VariantNonLastAdditional as V1 + +import qualified V2.VariantUnchanged as V2 +import qualified V2.VariantRemCon as V2 +import qualified V2.VariantRemFld as V2 +import qualified V2.VariantAddCon as V2 +import qualified V2.VariantAddOptFld as V2 +import qualified V2.VariantAddOptNestedFld as V2 +import qualified V2.VariantAddNonOptFld as V2 +import qualified V2.VariantAddNonOptNestedFld as V2 +import qualified V2.VariantNonLastAdditional as V2 + +main : Script () +main = tests + [ ("Upgrade succeeds if variant is unchanged", unchanged) + , ("Upgrade succeeds if variant is existing constructor", upgradeFromExistingCon) + , ("Upgrade succeeds if variant has optional fields added", upgradeToNewOptField) + , ("Upgrade succeeds if variant has optional nested fields added", upgradeToNewOptNestedField) + , ("Upgrade fails if variant is a removed constructor", upgradeToRemovedCon) + , ("Upgrade fails if variant has fields removed", upgradeToRemovedField) + , ("Upgrade fails if variant has non-optional fields added", upgradeToNewNonOptField) + , ("Upgrade fails if variant has non-optional nested fields added", upgradeToNewNonOptNestedField) + + , ("Downgrade succeeds if variant is an existing constructor", downgradeFromExistingCon) + , ("Downgrade succeeds if variant has optional fields added as None", downgradeFromNoneNewOptField) + , ("Downgrade succeeds if variant has optional nested fields added as None", downgradeFromNoneNewOptNestedField) + , ("Downgrade fails if variant is a new constructor", downgradeFromNewCon) + , ("Downgrade fails if variant has optional fields added as Some", downgradeFromSomeNewOptField) + , ("Downgrade fails if variant has optional nested fields added as Some", downgradeFromSomeNewOptNestedField) + , broken ("Fails if upgrading a variant with a new case in the middle, from a case with unchanged rank", templateVariantUpgradeNonLastSameRank) + , broken ("Fails if upgrading a variant with a new case in the middle, from a case with changed rank", templateVariantUpgradeNonLastDifferentRank) + , ("Fails if downgrading a variant from a new case in the middle", templateVariantDowngradeNonLastDifferentRank) + ] + +templateInvalidChange : forall t2 t1 c2. (Template t1, HasEnsure t1, Choice t2 c2 Text) => Bool -> (Party -> t1) -> c2 -> Script () +templateInvalidChange shouldSucceed makeV1Contract v2Choice = do + a <- allocatePartyOn "alice" participant0 + cid <- a `submit` createExactCmd (makeV1Contract a) + let cidV2 = coerceContractId @t1 @t2 cid + res <- a `trySubmit` exerciseExactCmd cidV2 v2Choice + + case (res, shouldSucceed) of + (Right "V1", True) -> pure () + (Right "V2", True) -> pure () + (Left (DevError Upgrade _), False) -> pure () + (Left (WronglyTypedContract {}), False) -> pure () + (Left (UnknownError msg), False) | "An error occurred." `isInfixOf` msg -> pure () + _ -> assertFail $ "Expected " <> (if shouldSucceed then "success" else "specific failure") <> " but got " <> show res + +{- PACKAGE +name: variant-changes +versions: 2 +-} + +{- MODULE +package: variant-changes +contents: | + module VariantUnchanged where + + data VariantUnchangedData + = VariantUnchangedData1 { vud_field_1_1 : Bool; vud_field_1_2 : Text } + | VariantUnchangedData2 { vud_field_2_1 : Bool; vud_field_2_2 : Text } + deriving (Eq, Show) + template VariantUnchanged + with + party : Party + varData : VariantUnchangedData + where + signatory party + choice VariantUnchangedCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +unchanged : Script () +unchanged = + templateInvalidChange + @V2.VariantUnchanged + True + (`V1.VariantUnchanged` V1.VariantUnchangedData1 { vud_field_1_1 = True, vud_field_1_2 = "hello" }) + V2.VariantUnchangedCall + +{- MODULE +package: variant-changes +contents: | + module VariantRemCon where + + data VariantRemConData + = VariantRemConData1 { vrd_field_1_1 : Bool; vrd_field_1_2 : Text } + | VariantRemConData2 { vrd_field_2_1 : Bool; vrd_field_2_2 : Text } + | VariantRemConData3 { vrd_field_3_1 : Bool; vrd_field_3_2 : Text } -- @V 1 + deriving (Eq, Show) + + template VariantRemCon + with + party : Party + varData : VariantRemConData + where + signatory party + choice VariantRemConCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +upgradeToRemovedCon : Script () +upgradeToRemovedCon = + templateInvalidChange + @V2.VariantRemCon + False + (`V1.VariantRemCon` V1.VariantRemConData3 { vrd_field_3_1 = True, vrd_field_3_2 = "hello" }) + V2.VariantRemConCall + +{- MODULE +package: variant-changes +contents: | + module VariantAddCon where + + data VariantAddConData + = VariantAddConData1 { vad_field_1_1 : Bool; vad_field_1_2 : Text } + | VariantAddConData2 { vad_field_2_1 : Bool; vad_field_2_2 : Text } + | VariantAddConData3 { vad_field_3_1 : Bool; vad_field_3_2 : Text } -- @V 2 + deriving (Eq, Show) + template VariantAddCon + with + party : Party + varData : VariantAddConData + where + signatory party + choice VariantAddConCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +downgradeFromNewCon : Script () +downgradeFromNewCon = + templateInvalidChange + @V1.VariantAddCon + False + (`V2.VariantAddCon` V2.VariantAddConData3 { vad_field_3_1 = True, vad_field_3_2 = "hello" }) + V1.VariantAddConCall + +upgradeFromExistingCon : Script () +upgradeFromExistingCon = + templateInvalidChange + @V2.VariantAddCon + True + (`V1.VariantAddCon` V1.VariantAddConData1 { vad_field_1_1 = True, vad_field_1_2 = "hello" }) + V2.VariantAddConCall + +downgradeFromExistingCon : Script () +downgradeFromExistingCon = + templateInvalidChange + @V1.VariantAddCon + True + (`V2.VariantAddCon` V2.VariantAddConData1 { vad_field_1_1 = True, vad_field_1_2 = "hello" }) + V1.VariantAddConCall + +{- MODULE +package: variant-changes +contents: | + module VariantRemFld where + data VariantRemFldData + = VariantRemFldData1 + { vrf_field_1_1 : Bool + ; vrf_field_1_2 : Text -- @V 1 + } + | VariantRemFldData2 { vrf_field_2_1 : Bool; vrf_field_2_2 : Text } + deriving (Eq, Show) + template VariantRemFld + with + party : Party + varData : VariantRemFldData + where + signatory party + choice VariantRemFldCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +upgradeToRemovedField : Script () +upgradeToRemovedField = + templateInvalidChange + @V2.VariantRemFld + False + (`V1.VariantRemFld` V1.VariantRemFldData1 { vrf_field_1_1 = True, vrf_field_1_2 = "hello" }) + V2.VariantRemFldCall + +{- MODULE +package: variant-changes +contents: | + module VariantAddNonOptFld where + + data VariantAddNonOptFldData + = VariantAddNonOptFldData1 + { vanof_field_1_1 : Bool + ; vanof_field_1_2 : Text + ; vanof_field_1_3 : Text -- @V 2 + } + | VariantAddNonOptFldData2 { vanof_field_2_1 : Bool; vanof_field_2_2 : Text } + deriving (Eq, Show) + template VariantAddNonOptFld + with + party : Party + varData : VariantAddNonOptFldData + where + signatory party + choice VariantAddNonOptFldCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +upgradeToNewNonOptField : Script () +upgradeToNewNonOptField = + templateInvalidChange + @V2.VariantAddNonOptFld + False + (`V1.VariantAddNonOptFld` V1.VariantAddNonOptFldData1 { vanof_field_1_1 = True, vanof_field_1_2 = "hello" }) + V2.VariantAddNonOptFldCall + +{- MODULE +package: variant-changes +contents: | + module VariantAddNonOptNestedFld where + data VariantAddNonOptNestedFldNest = VariantAddNonOptNestedFldNest with + vanonf_nested_field_1 : Bool + vanonf_nested_field_2 : Text + vanonf_nested_field_3 : Text -- @V 2 + deriving (Eq, Show) + data VariantAddNonOptNestedFldData + = VariantAddNonOptNestedFldData1 { vanonf_field_1_1 : Bool; vanonf_field_1_2 : VariantAddNonOptNestedFldNest } + | VariantAddNonOptNestedFldData2 { vanonf_field_2_1 : Bool; vanonf_field_2_2 : Text } + deriving (Eq, Show) + template VariantAddNonOptNestedFld + with + party : Party + varData : VariantAddNonOptNestedFldData + where + signatory party + choice VariantAddNonOptNestedFldCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +upgradeToNewNonOptNestedField : Script () +upgradeToNewNonOptNestedField = + templateInvalidChange + @V2.VariantAddNonOptNestedFld + False + (`V1.VariantAddNonOptNestedFld` V1.VariantAddNonOptNestedFldData1 with + vanonf_field_1_1 = True + vanonf_field_1_2 = V1.VariantAddNonOptNestedFldNest with + vanonf_nested_field_1 = False + vanonf_nested_field_2 = "nested hello" + ) + V2.VariantAddNonOptNestedFldCall + +{- MODULE +package: variant-changes +contents: | + module VariantAddOptFld where + + data VariantAddOptFldData + = VariantAddOptFldData1 + { vaof_field_1_1 : Bool + ; vaof_field_1_2 : Text + ; vaof_field_1_3 : Optional Text -- @V 2 + } + | VariantAddOptFldData2 { vaof_field_2_1 : Bool; vaof_field_2_2 : Text } + deriving (Eq, Show) + template VariantAddOptFld + with + party : Party + varData : VariantAddOptFldData + where + signatory party + choice VariantAddOptFldCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +upgradeToNewOptField : Script () +upgradeToNewOptField = + templateInvalidChange + @V2.VariantAddOptFld + True + (`V1.VariantAddOptFld` V1.VariantAddOptFldData1 { vaof_field_1_1 = True, vaof_field_1_2 = "hello" }) + V2.VariantAddOptFldCall + +downgradeFromNoneNewOptField : Script () +downgradeFromNoneNewOptField = + templateInvalidChange + @V1.VariantAddOptFld + True + (`V2.VariantAddOptFld` V2.VariantAddOptFldData1 { vaof_field_1_1 = True, vaof_field_1_2 = "hello", vaof_field_1_3 = None }) + V1.VariantAddOptFldCall + +downgradeFromSomeNewOptField : Script () +downgradeFromSomeNewOptField = + templateInvalidChange + @V1.VariantAddOptFld + False + (`V2.VariantAddOptFld` V2.VariantAddOptFldData1 { vaof_field_1_1 = True, vaof_field_1_2 = "hello", vaof_field_1_3 = Some "goodbye" }) + V1.VariantAddOptFldCall + +{- MODULE +package: variant-changes +contents: | + module VariantAddOptNestedFld where + + data VariantAddOptNestedFldNest = VariantAddOptNestedFldNest with + vaonf_nested_field_1 : Bool + vaonf_nested_field_2 : Text + vaonf_nested_field_3 : Optional Text -- @V 2 + deriving (Eq, Show) + data VariantAddOptNestedFldData + = VariantAddOptNestedFldData1 { vaonf_field_1_1 : Bool; vaonf_field_1_2 : VariantAddOptNestedFldNest } + | VariantAddOptNestedFldData2 { vaonf_field_2_1 : Bool; vaonf_field_2_2 : Text } + deriving (Eq, Show) + template VariantAddOptNestedFld + with + party : Party + varData : VariantAddOptNestedFldData + where + signatory party + choice VariantAddOptNestedFldCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +upgradeToNewOptNestedField : Script () +upgradeToNewOptNestedField = + templateInvalidChange + @V2.VariantAddOptNestedFld + True + (`V1.VariantAddOptNestedFld` V1.VariantAddOptNestedFldData1 with + vaonf_field_1_1 = True + vaonf_field_1_2 = V1.VariantAddOptNestedFldNest with + vaonf_nested_field_1 = False + vaonf_nested_field_2 = "nested hello" + ) + V2.VariantAddOptNestedFldCall + +downgradeFromNoneNewOptNestedField : Script () +downgradeFromNoneNewOptNestedField = + templateInvalidChange + @V1.VariantAddOptNestedFld + True + (`V2.VariantAddOptNestedFld` V2.VariantAddOptNestedFldData1 with + vaonf_field_1_1 = True + vaonf_field_1_2 = V2.VariantAddOptNestedFldNest with + vaonf_nested_field_1 = False + vaonf_nested_field_2 = "nested hello" + vaonf_nested_field_3 = None + ) + V1.VariantAddOptNestedFldCall + +downgradeFromSomeNewOptNestedField : Script () +downgradeFromSomeNewOptNestedField = + templateInvalidChange + @V1.VariantAddOptNestedFld + False + (`V2.VariantAddOptNestedFld` V2.VariantAddOptNestedFldData1 with + vaonf_field_1_1 = True + vaonf_field_1_2 = V2.VariantAddOptNestedFldNest with + vaonf_nested_field_1 = False + vaonf_nested_field_2 = "nested hello" + vaonf_nested_field_3 = Some "nested goodbye" + ) + V1.VariantAddOptNestedFldCall + +{- MODULE +package: variant-changes +contents: | + module VariantNonLastAdditional where + data VariantNonLastAdditionalData + = VariantNonLastAdditionalData1 Int + | VariantNonLastAdditionalData15 (Numeric 10) -- @V 2 + | VariantNonLastAdditionalData2 Bool + deriving (Eq, Show) + template VariantNonLastAdditional + with + party : Party + nestedData : VariantNonLastAdditionalData + where + signatory party + choice VariantNonLastAdditionalCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 +-} + +templateVariantUpgradeNonLastSameRank : Script () +templateVariantUpgradeNonLastSameRank = + templateInvalidChange + @V2.VariantNonLastAdditional + False + (`V1.VariantNonLastAdditional` V1.VariantNonLastAdditionalData1 1) + V2.VariantNonLastAdditionalCall + +templateVariantUpgradeNonLastDifferentRank : Script () +templateVariantUpgradeNonLastDifferentRank = + templateInvalidChange + @V2.VariantNonLastAdditional + False + (`V1.VariantNonLastAdditional` V1.VariantNonLastAdditionalData2 True) -- Data2 is second in V1, and third in V2 + V2.VariantNonLastAdditionalCall + +templateVariantDowngradeNonLastDifferentRank : Script () +templateVariantDowngradeNonLastDifferentRank = + templateInvalidChange + @V1.VariantNonLastAdditional + False + (`V2.VariantNonLastAdditional` V2.VariantNonLastAdditionalData15 1.0) -- Data15 is second in V2, Data2 is second in V1 + V1.VariantNonLastAdditionalCall diff --git a/sdk/daml-script/test/src/main/scala/com/daml/lf/engine/script/test/IdeLedgerUpgradesIT.scala b/sdk/daml-script/test/src/main/scala/com/daml/lf/engine/script/test/IdeLedgerUpgradesIT.scala new file mode 100644 index 000000000000..bc4e3ffe50c1 --- /dev/null +++ b/sdk/daml-script/test/src/main/scala/com/daml/lf/engine/script/test/IdeLedgerUpgradesIT.scala @@ -0,0 +1,384 @@ +// Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +// SPDX-License-Identifier: Apache-2.0 + +package com.daml.lf.engine.script +package test + +import io.circe._ +import io.circe.yaml +import java.io.File +import java.nio.file.{Files, Path, Paths} +import com.daml.bazeltools.BazelRunfiles.{requiredResource, rlocation} +import com.daml.lf.data.Ref._ +import com.daml.lf.engine.script.ScriptTimeMode +import com.daml.lf.engine.script.test.DarUtil.{buildDar, Dar, DataDep} +import com.daml.lf.language.{LanguageMajorVersion, LanguageVersion} +// import com.daml.lf.engine.script.v2.ledgerinteraction.grpcLedgerClient.test.TestingAdminLedgerClient +import com.daml.scalautil.Statement.discard +import com.daml.timer.RetryStrategy +// import com.digitalasset.canton.ledger.client.configuration.LedgerClientChannelConfiguration +import org.scalatest.{BeforeAndAfterAll, Inside} +import org.scalatest.matchers.should.Matchers +import org.scalatest.wordspec.AsyncWordSpec +import scala.concurrent.Future +import scala.sys.process._ +import scala.util.matching.Regex +import scala.collection.mutable +import scala.concurrent.duration.DurationInt +import scala.jdk.CollectionConverters._ + +class IdeLedgerUpgradesIT extends AsyncWordSpec with BeforeAndAfterAll with Inside with Matchers { + + final override protected lazy val nParticipants = 2 + final override protected lazy val timeMode = ScriptTimeMode.WallClock + + final override protected lazy val devMode = true + final override protected val disableUpgradeValidation = true + + // TODO(https://github.com/digital-asset/daml/issues/18457): split the test into one with contract + // keys and one without, and revert to the default version. Here and below, in the loaded dars. + val languageVersion: LanguageVersion = LanguageVersion.v2_dev + override val majorLanguageVersion: LanguageMajorVersion = languageVersion.major + + override protected lazy val darFiles = List() + + lazy val damlScriptDar = requiredResource("daml-script/daml3/daml3-script-2.dev.dar") + lazy val upgradeTestLibDar: Path = rlocation(Paths.get("daml-script/test/upgrade-test-lib.dar")) + + lazy val tempDir: Path = Files.createTempDirectory("upgrades-it") + + val testFileDir: Path = rlocation(Paths.get("daml-script/test/daml/upgrades/")) + val testCases: Seq[TestCase] = getTestCases(testFileDir) + + private def traverseSequential[A, B](elems: Seq[A])(f: A => Future[B]): Future[Seq[B]] = + elems.foldLeft(Future.successful(Seq.empty[B])) { case (comp, elem) => + comp.flatMap { elems => f(elem).map(elems :+ _) } + } + + // Maybe provide our own tracer that doesn't tag, it makes the logs very long + "Multi-participant Daml Script Upgrades" should { + testCases.foreach { testCase => + testCase.name in { + for { + // Build dars + (testDarPath, deps) <- buildTestCaseDar(testCase) + + // Connection + // clients <- scriptClients(provideAdminPorts = true) + // adminClients = ledgerPorts.map { portInfo => + // ( + // portInfo.ledgerPort.value, + // TestingAdminLedgerClient.singleHost( + // "localhost", + // portInfo.adminPort.value, + // None, + // LedgerClientChannelConfiguration.InsecureDefaults, + // ), + // ) + // } + + // _ <- traverseSequential(adminClients) { case (ledgerPort, adminClient) => + // Future.traverse(deps) { dep => + // Thread.sleep(500) + // println( + // s"Uploading ${dep.versionedName} to participant on port ${ledgerPort}" + // ) + // adminClient + // .uploadDar(dep.path.toFile) + // .map(_.left.map(msg => throw new Exception(msg))) + // } + // } + + // // Wait for upload + // _ <- RetryStrategy.constant(attempts = 20, waitTime = 1.seconds) { (_, _) => + // // assertDepsVetted(adminClients.head._2, deps) + // () + // } + // _ = println("All packages vetted on all participants") + + // Run tests + testDar = CompiledDar.read(testDarPath, Runner.compilerConfig(LanguageMajorVersion.V2)) + _ <- run( + clients, + QualifiedName.assertFromString(s"${testCase.name}:main"), + dar = testDar, + enableContractUpgrading = true, + ) + } yield succeed + } + } + } + + // private def assertDepsVetted( + // client: TestingAdminLedgerClient, + // deps: Seq[Dar], + // ): Future[Unit] = { + // client + // .listVettedPackages() + // .map(_.foreach { case (participantId, packageIds) => + // deps.foreach { dep => + // if (!packageIds.contains(dep.mainPackageId)) + // throw new Exception( + // s"Couldn't find package ${dep.versionedName} on participant $participantId" + // ) + // } + // }) + // } + + def buildTestCaseDar(testCase: TestCase): Future[(Path, Seq[Dar])] = Future { + val testCaseRoot = Files.createDirectory(tempDir.resolve(testCase.name)) + val testCasePkg = Files.createDirectory(testCaseRoot.resolve("test-case")) + val dars: Seq[Dar] = testCase.pkgDefs.map(_.build(testCaseRoot)) + + val darPath = assertBuildDar( + name = testCase.name, + modules = Map((testCase.name, Files.readString(testCase.damlPath))), + dataDeps = Seq(DataDep(upgradeTestLibDar)) :++ dars.map { dar => + DataDep( + path = dar.path, + prefix = Some((dar.versionedName, s"V${dar.version}")), + ) + }, + tmpDir = Some(testCasePkg), + ).path + (darPath, dars) + } + + def assertBuildDar( + name: String, + version: Int = 1, + modules: Map[String, String], + deps: Seq[Path] = Seq.empty, + dataDeps: Seq[DataDep] = Seq.empty, + opts: Seq[String] = Seq(), + tmpDir: Option[Path] = None, + ): Dar = { + val builder = new StringBuilder + def log(t: String)(s: String) = discard(builder.append(s"${t}: ${s}\n")) + buildDar( + name = name, + version = version, + lfVersion = languageVersion, + modules = modules, + deps = deps, + dataDeps = dataDeps, + opts = opts, + tmpDir = tmpDir, + logger = ProcessLogger(log("stdout"), log("stderr")), + ) match { + case Right(dar) => dar + case Left(exitCode) => + fail( + s"While building ${name}-${version}.0.0: 'daml build' exited with ${exitCode}\n${builder.toString}" + ) + } + } + + case class TestCase( + name: String, + damlPath: Path, + damlRelPath: Path, + pkgDefs: Seq[PackageDefinition], + ) + + // Ensures no package name is defined twice across all test files + def getTestCases(testFileDir: Path): Seq[TestCase] = { + import java.lang.management.ManagementFactory + println(ManagementFactory.getRuntimeMXBean().getInputArguments()) + val cases = getTestCasesUnsafe(testFileDir) + val packageNameDefiners = mutable.Map[String, Seq[String]]() + for { + c <- cases + pkg <- c.pkgDefs + } packageNameDefiners.updateWith(pkg.name) { + case None => Some(Seq(c.name)) + case Some(names) => Some(names :+ c.name) + } + packageNameDefiners.foreach { + case (packageName, caseNames) if (caseNames.distinct.length > 1) => + throw new IllegalArgumentException( + s"Package with name $packageName is defined multiple times within the following case(s): ${caseNames.distinct + .mkString(",")}" + ) + case _ => + } + cases + } + + def isTest(file: File): Boolean = + file.getName.endsWith(".daml") + + def getTestCasesUnsafe(testFileDir: Path): Seq[TestCase] = + testFileDir.toFile.listFiles(isTest _).toSeq.map { testFile => + val damlPath = testFile.toPath + val damlRelPath = testFileDir.relativize(damlPath) + TestCase( + name = damlRelPath.toString.stripSuffix(".daml"), + damlPath, + damlRelPath, + pkgDefs = PackageDefinition.readFromFile(damlPath), + ) + } + + case class PackageDefinition( + name: String, + version: Int, + modules: Map[String, String], + ) { + def build(tmpDir: Path): Dar = { + assertBuildDar( + name = this.name, + version = this.version, + modules = this.modules, + deps = Seq(damlScriptDar.toPath), + tmpDir = Some(tmpDir), + ) + } + } + + object PackageDefinition { + + case class PackageComment( + name: String, + versions: Int, + ) + + // TODO[SW] Consider another attempt at using io.circe.generic.auto._ + // [MA] we make this lazy because we're calling it from the top level before + // the entire class has finished loading + implicit lazy val decodePackageComment: Decoder[PackageComment] = + new Decoder[PackageComment] { + final def apply(c: HCursor): Decoder.Result[PackageComment] = + for { + name <- c.downField("name").as[String] + versions <- c.downField("versions").as[Int] + } yield { + new PackageComment(name, versions) + } + } + + case class ModuleComment( + packageName: String, + contents: String, + ) + + implicit lazy val decodeModuleComment: Decoder[ModuleComment] = + new Decoder[ModuleComment] { + final def apply(c: HCursor): Decoder.Result[ModuleComment] = + for { + packageName <- c.downField("package").as[String] + contents <- c.downField("contents").as[String] + } yield { + new ModuleComment(packageName, contents) + } + } + + private def findComments(commentTitle: String, lines: Seq[String]): Seq[String] = + lines.foldLeft((None: Option[String], Seq[String]())) { + case ((None, cs), line) if line.startsWith(s"{- $commentTitle") => + (Some(""), cs) + case ((None, cs), _) => + (None, cs) + case ((Some(str), cs), line) if line.startsWith("-}") => + (None, cs :+ str) + case ((Some(str), cs), line) => + (Some(str + "\n" + line), cs) + } match { + case (None, cs) => cs + case (Some(str), _) => + throw new IllegalArgumentException( + s"Missing \"-}\" to close $commentTitle containing\n$str" + ) + } + + def readFromFile(path: Path): Seq[PackageDefinition] = { + val fileLines = Files.readAllLines(path).asScala.toSeq + val packageComments = + findComments("PACKAGE", fileLines).map { comment => + yaml.parser + .parse(comment) + .left + .map(err => err: Error) + .flatMap(_.as[PackageComment]) + .fold(throw _, identity) + } + val moduleMap: Map[String, Seq[Seq[VersionedLine]]] = + findComments("MODULE", fileLines) + .map { comment => + yaml.parser + .parse(comment) + .left + .map(err => err: Error) + .flatMap(_.as[ModuleComment]) + .fold(throw _, identity) + } + .groupMap(_.packageName)(c => readVersionedLines(c.contents)) + + packageComments.flatMap { c => + (1 to c.versions).toSeq.map { version => + PackageDefinition( + name = c.name, + version = version, + modules = moduleMap + .getOrElse(c.name, Seq.empty) + .map(getVersionedModule(c.name, _, version)) + .groupMap(_._1)(_._2) + .map { case (modName, modDefs) => + assertUnique(c.name, modName, modDefs) + }, + ) + } + } + } + + case class VersionedLine( + line: String, + versions: Option[Seq[Int]], + ) + + def readVersionedLines(contents: String): Seq[VersionedLine] = { + val versionedLinePat: Regex = "-- @V(.*)$".r + val intPat: Regex = "\\d+".r + contents.split('\n').toSeq.map { line => + VersionedLine( + line = line, + versions = versionedLinePat.findFirstMatchIn(line).map { m => + intPat.findAllMatchIn(m.group(1)).toSeq.map(_.group(0).toInt) + }, + ) + } + } + + def getVersionedModule( + packageName: String, + lines: Seq[VersionedLine], + version: Int, + ): (String, String) = { + val modNamePat: Regex = "module +([^ ]+) +where".r + val contents = lines + .collect { case vl if vl.versions.fold(true)(_.contains(version)) => vl.line } + .mkString("\n") + modNamePat.findFirstMatchIn(contents) match { + case Some(m) => (m.group(1), contents) + case None => + fail( + s"Failed to extract module name for a MODULE with package = ${packageName}" + ) + } + } + + def assertUnique( + packageName: String, + modName: String, + modDefs: Seq[String], + ): (String, String) = { + modDefs match { + case Seq(modDef) => (modName, modDef) + case _ => + fail( + s"Multiple conflicting definitions of module ${modName} in package ${packageName}" + ) + } + } + } +}