From a7ea9d59bf19d7dd5cc5ad36b930f0be427fb7d0 Mon Sep 17 00:00:00 2001 From: Paul Brauner <141240651+paulbrauner-da@users.noreply.github.com> Date: Fri, 16 Aug 2024 09:39:57 +0200 Subject: [PATCH] allow upgrading key types in the participant (#19780) * allow upgrading key types in the participant * add runtime tests * fix queryByKey with upgrades * disable failing test --- sdk/daml-lf/validation/BUILD.bazel | 2 + .../daml/lf/validation/Upgrading.scala | 172 +----------------- .../validation/upgrade/UpgradesSpecBase.scala | 7 + .../daml/lf/engine/script/v2/ScriptF.scala | 2 +- .../test/daml/upgrades/ContractKeys.daml | 96 +++++++++- sdk/test-common/BUILD.bazel | 1 + .../v1/Main.daml | 5 +- .../v2/Main.daml | 7 +- .../v1/Main.daml | 15 ++ .../v2/Main.daml | 17 ++ 10 files changed, 138 insertions(+), 186 deletions(-) create mode 100644 sdk/test-common/src/main/daml/upgrades/SucceedsWhenTemplateUpgradesKeyType/v1/Main.daml create mode 100644 sdk/test-common/src/main/daml/upgrades/SucceedsWhenTemplateUpgradesKeyType/v2/Main.daml diff --git a/sdk/daml-lf/validation/BUILD.bazel b/sdk/daml-lf/validation/BUILD.bazel index c150ce3701ac..effe57993aed 100644 --- a/sdk/daml-lf/validation/BUILD.bazel +++ b/sdk/daml-lf/validation/BUILD.bazel @@ -196,6 +196,8 @@ da_scala_test_suite( "//test-common:upgrades-FailsWhenTemplateAddsKeyType-v2.dar", "//test-common:upgrades-FailsWhenTemplateChangesKeyType-v1.dar", "//test-common:upgrades-FailsWhenTemplateChangesKeyType-v2.dar", + "//test-common:upgrades-SucceedsWhenTemplateUpgradesKeyType-v1.dar", + "//test-common:upgrades-SucceedsWhenTemplateUpgradesKeyType-v2.dar", "//test-common:upgrades-FailsWhenTemplateChoiceChangesItsReturnType-v1.dar", "//test-common:upgrades-FailsWhenTemplateChoiceChangesItsReturnType-v2.dar", "//test-common:upgrades-FailsWhenTemplateRemovesKeyType-v1.dar", diff --git a/sdk/daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/Upgrading.scala b/sdk/daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/Upgrading.scala index 0f7f6eae21e1..6e967a8e3573 100644 --- a/sdk/daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/Upgrading.scala +++ b/sdk/daml-lf/validation/src/main/scala/com/digitalasset/daml/lf/validation/Upgrading.scala @@ -4,10 +4,9 @@ package com.daml.lf package validation -import com.daml.lf.data.Ref.TypeConName import com.daml.lf.data.{ImmArray, Ref} import com.daml.lf.language.Ast._ -import com.daml.lf.language.{Ast, LanguageVersion, PackageInterface} +import com.daml.lf.language.{Ast, LanguageVersion} import scala.annotation.tailrec import scala.util.{Failure, Success, Try} @@ -383,169 +382,8 @@ case class TypecheckUpgrades( ) { import TypecheckUpgrades._ - private lazy val packageId: Upgrading[Ref.PackageId] = packages.map(_._1) private lazy val _package: Upgrading[Ast.Package] = packages.map(_._2) - private val packageInterface: Upgrading[PackageInterface] = - packages.map { case (pkgId, pkgAst) => PackageInterface(Map(pkgId -> pkgAst)) } - - /** The set of type constructors whose definitions are structurally equal between the - * past and present packages. It is built by building the largest fixed point of - * [[genStructurallyEqualTyConsStep]], which removes type constructors whose definitions - * are not structurally equal from a set. The set is seeded with the qualified names of - * all type constructors present in both packages and whose definitions are serializable. - */ - private lazy val structurallyEqualTyCons: Set[Ref.QualifiedName] = { - def tyCons(pkg: Ast.Package): Set[Ref.QualifiedName] = { - pkg.modules.flatMap { case (moduleName, module) => - module.definitions.collect { - case (name, dt: DDataType) if dt.serializable => - Ref.QualifiedName(moduleName, name) - } - }.toSet - } - val commonTyCons = tyCons(_package.past).intersect(tyCons(_package.present)) - genStructurallyEqualTyCons(commonTyCons) - } - - /** Computes the fixed point of genStructurallyEqualTyConsStep. - */ - @tailrec - private def genStructurallyEqualTyCons(tyCons: Set[Ref.QualifiedName]): Set[Ref.QualifiedName] = { - val newTyCOns = genStructurallyEqualTyConsStep(tyCons) - if (newTyCOns == tyCons) tyCons - else genStructurallyEqualTyCons(newTyCOns) - } - - /** For each type constructor name in [[tyCons]], checks that the definition of [[tyCons]] in - * the past and present packages are structurally equal, assuming that the type constructors - * in [[tyCons]] are structurally equal. Removes those that aren't. - */ - def genStructurallyEqualTyConsStep(tyCons: Set[Ref.QualifiedName]): Set[Ref.QualifiedName] = { - tyCons.filter { name => - val pastTypeConName = TypeConName(packageId.past, name) - val presentTypeConName = TypeConName(packageId.present, name) - structurallyEqualDataTypes( - tyCons, - Util.handleLookup( - Context.DefDataType(pastTypeConName), - packageInterface.past - .lookupDataType(pastTypeConName), - ), - Util.handleLookup( - Context.DefDataType(presentTypeConName), - packageInterface.present - .lookupDataType(presentTypeConName), - ), - ) - } - } - - /** Checks that [[pastDataType]] and [[presentDataType]] are structurally equal, assuming that - * the type constructors in [[tyCons]] are structurally equal. - */ - def structurallyEqualDataTypes( - tyCons: Set[Ref.QualifiedName], - pastDataType: DDataType, - presentDataType: DDataType, - ): Boolean = - structurallyEqualDataCons( - tyCons, - Closure(Env().extend(pastDataType.params.map(_._1)), pastDataType.cons), - Closure(Env().extend(presentDataType.params.map(_._1)), presentDataType.cons), - ) - - /** Checks that [[pastCons]] and [[presentCons]] are structurally equal, assuming that - * the type constructors in [[tyCons]] are structurally equal. - */ - private def structurallyEqualDataCons( - tyCons: Set[Ref.QualifiedName], - pastCons: Closure[DataCons], - presentCons: Closure[DataCons], - ): Boolean = - (pastCons.value, presentCons.value) match { - case (DataRecord(pastFields), DataRecord(presentFields)) => - pastFields.length == presentFields.length && - pastFields.iterator.zip(presentFields.iterator).forall { - case ((pastFieldName, pastType), (presentFieldName, presentType)) => - pastFieldName == presentFieldName && - structurallyEqualTypes( - tyCons, - Closure(pastCons.env, pastType), - Closure(presentCons.env, presentType), - ) - } - case (DataVariant(pastVariants), DataVariant(presentVariants)) => - pastVariants.length == presentVariants.length && - pastVariants.iterator.zip(presentVariants.iterator).forall { - case ((pastVariantName, pastType), (presentVariantName, presentType)) => - pastVariantName == presentVariantName && - structurallyEqualTypes( - tyCons, - Closure(pastCons.env, pastType), - Closure(presentCons.env, presentType), - ) - } - case (DataEnum(pastConstructors), DataEnum(presentConstructors)) => - pastConstructors.length == presentConstructors.length && - pastConstructors.iterator.zip(presentConstructors.iterator).forall { - case (pastCtor, presentCtor) => pastCtor == presentCtor - } - case _ => - false - } - - /** Checks that [[pastType]] and [[presentType]] are structurally equal, assuming that - * the type constructors in [[tyCons]] are structurally equal. - */ - private def structurallyEqualTypes( - tyCons: Set[Ref.QualifiedName], - pastType: Closure[Ast.Type], - presentType: Closure[Ast.Type], - ): Boolean = - structurallyEqualTypes( - tyCons, - pastType.env, - presentType.env, - List((pastType.value, presentType.value)), - ) - - /** A stack-safe version of [[structurallyEqualTypes]] that uses a work list. - */ - @tailrec - private def structurallyEqualTypes( - tyCons: Set[Ref.QualifiedName], - envPast: Env, - envPresent: Env, - trips: List[(Type, Type)], - ): Boolean = { - trips match { - case Nil => true - case (t1, t2) :: trips => - (t1, t2) match { - case (TVar(x1), TVar(x2)) => - envPast.binderDepth(x1) == envPresent.binderDepth(x2) && - structurallyEqualTypes(tyCons, envPast, envPresent, trips) - case (TNat(n1), TNat(n2)) => - n1 == n2 && structurallyEqualTypes(tyCons, envPast, envPresent, trips) - case (TTyCon(c1), TTyCon(c2)) => - // Either c1 and c2 are the same type constructor from the exact same package (e.g. Tuple2), - // or they must have the same qualified name and be structurally equal by co-induction - // hypothesis. - (c1 == c2 || - (c1.qualifiedName == c2.qualifiedName && - tyCons.contains(c1.qualifiedName))) && - structurallyEqualTypes(tyCons, envPast, envPresent, trips) - case (TApp(f1, a1), TApp(f2, a2)) => - structurallyEqualTypes(tyCons, envPast, envPresent, (f1, f2) :: (a1, a2) :: trips) - case (TBuiltin(b1), TBuiltin(b2)) => - b1 == b2 && structurallyEqualTypes(tyCons, envPast, envPresent, trips) - case _ => - false - } - } - } - private def check(): Try[Unit] = { for { _ <- checkLfVersions(_package.map(_.languageVersion)) @@ -724,13 +562,7 @@ case class TypecheckUpgrades( case Upgrading(None, None) => Success(()); case Upgrading(Some(pastKey), Some(presentKey)) => { val keyPastPresent = Upgrading(pastKey.typ, presentKey.typ) - if ( - !structurallyEqualTypes( - structurallyEqualTyCons, - Closure(Env(), pastKey.typ), - Closure(Env(), presentKey.typ), - ) - ) + if (!checkType(Upgrading(Closure(Env(), pastKey.typ), Closure(Env(), presentKey.typ)))) fail(UpgradeError.TemplateChangedKeyType(templateName, keyPastPresent)) else Success(()) diff --git a/sdk/daml-lf/validation/src/test/scala/com/digitalasset/daml/lf/validation/upgrade/UpgradesSpecBase.scala b/sdk/daml-lf/validation/src/test/scala/com/digitalasset/daml/lf/validation/upgrade/UpgradesSpecBase.scala index a442736ec9f0..64a3af68c819 100644 --- a/sdk/daml-lf/validation/src/test/scala/com/digitalasset/daml/lf/validation/upgrade/UpgradesSpecBase.scala +++ b/sdk/daml-lf/validation/src/test/scala/com/digitalasset/daml/lf/validation/upgrade/UpgradesSpecBase.scala @@ -208,6 +208,13 @@ trait LongTests { this: UpgradesSpec => assertPackageUpgradeCheck(Some("The upgraded template A cannot change its key type.")), ) } + s"Succeeds when template upgrades its key type ($suffix)" in { + testPackagePair( + "test-common/upgrades-SucceedsWhenTemplateUpgradesKeyType-v1.dar", + "test-common/upgrades-SucceedsWhenTemplateUpgradesKeyType-v2.dar", + assertPackageUpgradeCheck(None), + ) + } s"Fails when template removes key type ($suffix)" in { testPackagePair( "test-common/upgrades-FailsWhenTemplateRemovesKeyType-v1.dar", diff --git a/sdk/daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/v2/ScriptF.scala b/sdk/daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/v2/ScriptF.scala index 162cb8701d00..898462b84ddf 100644 --- a/sdk/daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/v2/ScriptF.scala +++ b/sdk/daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/v2/ScriptF.scala @@ -400,7 +400,7 @@ class ScriptF(majorLanguageVersion: LanguageMajorVersion) { for { keyTy <- env.lookupKeyTy(id) translatorConfig = - if (enableContractUpgrading) preprocessing.ValueTranslator.Config.Coerceable + if (enableContractUpgrading) preprocessing.ValueTranslator.Config.Upgradeable else preprocessing.ValueTranslator.Config.Strict translated <- env.valueTranslator .translateValue(keyTy, v, translatorConfig) diff --git a/sdk/daml-script/test/daml/upgrades/ContractKeys.daml b/sdk/daml-script/test/daml/upgrades/ContractKeys.daml index 6b7a8832407d..26e2f2cc3ef5 100644 --- a/sdk/daml-script/test/daml/upgrades/ContractKeys.daml +++ b/sdk/daml-script/test/daml/upgrades/ContractKeys.daml @@ -6,12 +6,27 @@ module ContractKeys (main) where import UpgradeTestLib import qualified V1.ContractKeys as V1 import qualified V2.ContractKeys as V2 +import qualified V1.UpgradedContractKeys as V1 +import qualified V2.UpgradedContractKeys as V2 {- PACKAGE name: contract-key-upgrades versions: 2 -} +main : TestTree +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) + , ("Query an Upgraded old key for a new contract", queryKeyUpgraded) + -- TODO(https://github.com/digital-asset/daml/issues/19782): re-enable this test once the issue is fixed + -- , ("ExerciseByKey command an Upgraded old key for a new contract", exerciseCmdKeyUpgraded) + , ("Fetching an Upgraded old key for a new contract", fetchKeyUpgraded) + , ("ExerciseByKey in Update an Upgraded old key for a new contract", exerciseUpdateKeyUpgraded) + ] + {- MODULE package: contract-key-upgrades contents: | @@ -53,14 +68,6 @@ contents: | do exerciseByKey @UnchangedKey k UnchangedKeyCall -} -main : TestTree -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 : Test queryKeyUnchanged = test $ do a <- allocateParty "alice" @@ -92,3 +99,76 @@ exerciseUpdateKeyUnchanged = test $ do res <- a `submit` createAndExerciseCmd (V2.UnchangedKeyHelper a) (V2.UnchangedKeyExercise $ V2.UnchangedKeyKey a 1) res === "V2" +{- MODULE +package: contract-key-upgrades +contents: | + module UpgradedContractKeys where + + data UpgradedKeyKey = UpgradedKeyKey with + p : Party + n : Int + m : Optional Int -- @V 2 + deriving (Eq, Show) + + template UpgradedKey + with + party : Party + n : Int + m : Optional Int -- @V 2 + where + signatory party + key (UpgradedKeyKey party n) : UpgradedKeyKey -- @V 1 + key (UpgradedKeyKey party n m) : UpgradedKeyKey -- @V 2 + maintainer key.p + + choice UpgradedKeyCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 + + template UpgradedKeyHelper + with + party : Party + where + signatory party + choice UpgradedKeyFetch : (ContractId UpgradedKey, UpgradedKey) with + k : UpgradedKeyKey + controller party + do fetchByKey k + + choice UpgradedKeyExercise : Text with + k : UpgradedKeyKey + controller party + do exerciseByKey @UpgradedKey k UpgradedKeyCall +-} + +queryKeyUpgraded : Test +queryKeyUpgraded = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.UpgradedKey a 1) + keyRes <- queryContractKey a $ V2.UpgradedKeyKey a 1 None + case keyRes of + Some (foundCid, foundContract) | show foundCid == show cid && foundContract == V2.UpgradedKey a 1 None -> pure () + _ -> assertFail $ "Didn't find correct contract, expected " <> show (cid, V2.UpgradedKey a 1 None) <> ", got " <> show keyRes + +exerciseCmdKeyUpgraded : Test +exerciseCmdKeyUpgraded = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.UpgradedKey a 1) + res <- a `submit` exerciseByKeyExactCmd @V2.UpgradedKey (V2.UpgradedKeyKey a 1 None) V2.UpgradedKeyCall + res === "V2" + +fetchKeyUpgraded : Test +fetchKeyUpgraded = test $ do + a <- allocateParty "alice" + cid <- a `submit` createCmd (V1.UpgradedKey a 1) + (foundCid, foundContract) <- a `submit` createAndExerciseCmd (V2.UpgradedKeyHelper a) (V2.UpgradedKeyFetch $ V2.UpgradedKeyKey a 1 None) + foundContract === V2.UpgradedKey a 1 None + show foundCid === show cid + +exerciseUpdateKeyUpgraded : Test +exerciseUpdateKeyUpgraded = test $ do + a <- allocateParty "alice" + _ <- a `submit` createCmd (V1.UpgradedKey a 1) + res <- a `submit` createAndExerciseCmd (V2.UpgradedKeyHelper a) (V2.UpgradedKeyExercise $ V2.UpgradedKeyKey a 1 None) + res === "V2" \ No newline at end of file diff --git a/sdk/test-common/BUILD.bazel b/sdk/test-common/BUILD.bazel index 710296f835b6..0f663366952c 100644 --- a/sdk/test-common/BUILD.bazel +++ b/sdk/test-common/BUILD.bazel @@ -336,6 +336,7 @@ da_scala_dar_resources_library( ("FailsWhenOldFieldIsDeletedFromTemplateChoice", {}, {}), ("FailsWhenTemplateAddsKeyType", {}, {}), ("FailsWhenTemplateChangesKeyType", {}, {}), + ("SucceedsWhenTemplateUpgradesKeyType", {}, {}), ("FailsWhenTemplateChangesKeyTypeSuperficially", {}, {}), ("FailsWhenTemplateChoiceChangesItsReturnType", {}, {}), ("FailsWhenTemplateRemovesKeyType", {}, {}), diff --git a/sdk/test-common/src/main/daml/upgrades/FailsWhenTemplateChangesKeyType/v1/Main.daml b/sdk/test-common/src/main/daml/upgrades/FailsWhenTemplateChangesKeyType/v1/Main.daml index ab9be080a584..1ef17e1f2123 100644 --- a/sdk/test-common/src/main/daml/upgrades/FailsWhenTemplateChangesKeyType/v1/Main.daml +++ b/sdk/test-common/src/main/daml/upgrades/FailsWhenTemplateChangesKeyType/v1/Main.daml @@ -3,13 +3,12 @@ module Main where -data T = T with - i : Int +data T = T {} template A with p : Party q : Party where signatory p - key (p, T 0) : (Party, T) + key (p, T) : (Party, T) maintainer (fst key) diff --git a/sdk/test-common/src/main/daml/upgrades/FailsWhenTemplateChangesKeyType/v2/Main.daml b/sdk/test-common/src/main/daml/upgrades/FailsWhenTemplateChangesKeyType/v2/Main.daml index c9bdb424afd3..0f434aff5987 100644 --- a/sdk/test-common/src/main/daml/upgrades/FailsWhenTemplateChangesKeyType/v2/Main.daml +++ b/sdk/test-common/src/main/daml/upgrades/FailsWhenTemplateChangesKeyType/v2/Main.daml @@ -3,15 +3,14 @@ module Main where -data T = T with - i : Int - j : Optional Int +data T = T {} +data U = U {} template A with p : Party q : Party where signatory p - key (p, T 0 None) : (Party, T) + key (p, U) : (Party, U) maintainer (fst key) diff --git a/sdk/test-common/src/main/daml/upgrades/SucceedsWhenTemplateUpgradesKeyType/v1/Main.daml b/sdk/test-common/src/main/daml/upgrades/SucceedsWhenTemplateUpgradesKeyType/v1/Main.daml new file mode 100644 index 000000000000..ab9be080a584 --- /dev/null +++ b/sdk/test-common/src/main/daml/upgrades/SucceedsWhenTemplateUpgradesKeyType/v1/Main.daml @@ -0,0 +1,15 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module Main where + +data T = T with + i : Int + +template A with + p : Party + q : Party + where + signatory p + key (p, T 0) : (Party, T) + maintainer (fst key) diff --git a/sdk/test-common/src/main/daml/upgrades/SucceedsWhenTemplateUpgradesKeyType/v2/Main.daml b/sdk/test-common/src/main/daml/upgrades/SucceedsWhenTemplateUpgradesKeyType/v2/Main.daml new file mode 100644 index 000000000000..c9bdb424afd3 --- /dev/null +++ b/sdk/test-common/src/main/daml/upgrades/SucceedsWhenTemplateUpgradesKeyType/v2/Main.daml @@ -0,0 +1,17 @@ +-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved. +-- SPDX-License-Identifier: Apache-2.0 + +module Main where + +data T = T with + i : Int + j : Optional Int + +template A with + p : Party + q : Party + where + signatory p + key (p, T 0 None) : (Party, T) + maintainer (fst key) +