From d0327db1a217cab0b553ebb7bd5d40f67643d6cd Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mois=C3=A9s=20Ackerman?= Date: Tue, 17 Sep 2024 14:19:56 +0200 Subject: [PATCH 1/3] [Upgrades testing] Add cases for unchanged key type with changed key expression (#19897) * Add test cases for unchanged key type with changed key expression * Add test cases for unchanged key type with changed key expression, with fetchByKey * Add test cases for unchanged key type with changed key expression, with fetch * Mark broken tests, organize test tree * Add test cases for exercise{,ByKey}{,Cmd} * Use 'subtree' --- .../test/daml/upgrades/ContractKeys.daml | 312 +++++++++++++++++- 1 file changed, 304 insertions(+), 8 deletions(-) diff --git a/sdk/daml-script/test/daml/upgrades/ContractKeys.daml b/sdk/daml-script/test/daml/upgrades/ContractKeys.daml index 6b7a8832407d..17fd9039aaf3 100644 --- a/sdk/daml-script/test/daml/upgrades/ContractKeys.daml +++ b/sdk/daml-script/test/daml/upgrades/ContractKeys.daml @@ -3,15 +3,64 @@ module ContractKeys (main) where +import DA.Text (isInfixOf) + import UpgradeTestLib + import qualified V1.ContractKeys as V1 import qualified V2.ContractKeys as V2 +import qualified V1.ChangedKeyExpr as V1 +import qualified V2.ChangedKeyExpr 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 + [ subtree "Unchanged key type" + [ subtree "Unchanged key expression" + [ ("queryContractKey, src=v1 tgt=v2", queryKeyUnchanged) + , ("exerciseByKeyCmd, src=v1 tgt=v2", exerciseCmdKeyUnchanged) + , ("fetchByKey, src=v1 tgt=v2 ", fetchKeyUnchanged) + , ("exerciseByKey, src=v1 tgt=v2", exerciseUpdateKeyUnchanged) + ] + , subtree "Changed key expression" + [ subtree "Unchanged key value" + [ ("queryContractId, src=v1 tgt=v2", queryKeyChangedExprSameValue) + , ("queryContractKey, src=v1 tgt=v2", qckKeyChangedExprSameValue) + , ("fetch, src=v1 tgt=v2", fetchKeyChangedExprSameValue) + , ("fetchByKey, src=v1 tgt=v2", fbkKeyChangedExprSameValue) + , ("exercise, src=v1 tgt=v2", exerciseKeyChangedExprSameValue) + , ("exerciseByKey, src=v1 tgt=v2", ebkKeyChangedExprSameValue) + , ("exerciseCmd, src=v1 tgt=v2", exerciseCmdKeyChangedExprSameValue) + , ("exerciseByKeyCmd, src=v1 tgt=v2", ebkCmdKeyChangedExprSameValue) + ] + , subtree "Changed key value" + [ broken ("queryContractId, src=v1 tgt=v2", queryKeyChangedExprChangedValue) + , broken ("queryContractKey, src=v1 tgt=v2", qckKeyChangedExprChangedValue) + , ("fetch, src=v1 tgt=v2", fetchKeyChangedExprChangedValue) + , broken ("fetchByKey, src=v1 tgt=v2", fbkKeyChangedExprChangedValue) + , ("exercise, src=v1 tgt=v2", exerciseKeyChangedExprChangedValue) + , broken ("exerciseByKey, src=v1 tgt=v2", ebkKeyChangedExprChangedValue) + , ("exerciseCmd, src=v1 tgt=v2", exerciseCmdKeyChangedExprChangedValue) + , broken ("exerciseByKeyCmd, src=v1 tgt=v2", ebkCmdKeyChangedExprChangedValue) + ] + ] + ] + , subtree "Changed key type" + [ subtree "Unchanged key value (modulo trailing `None`s)" + [ ("queryContractKey, src=v1 tgt=v2", queryKeyUpgraded) + , ("exerciseByKeyCmd, src=v1 tgt=v2", exerciseCmdKeyUpgraded) + , ("fetch, src=v1 tgt=v2", fetchKeyUpgraded) + , ("exerciseByKey, src=v1 tgt=v2", exerciseUpdateKeyUpgraded) + ] + ] + ] + {- MODULE package: contract-key-upgrades contents: | @@ -53,14 +102,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 +133,258 @@ 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 ChangedKeyExpr where + + data ChangedKeyExprKey = ChangedKeyExprKey with + p : Party + b : Bool + deriving (Eq, Show) + + template ChangedKeyExpr + with + party : Party + b : Bool + where + signatory party + key (ChangedKeyExprKey party False) : ChangedKeyExprKey -- @V 1 + key (ChangedKeyExprKey party b) : ChangedKeyExprKey -- @V 2 + maintainer key.p + + choice ChangedKeyExprCall : Text + controller party + do pure "V1" -- @V 1 + do pure "V2" -- @V 2 + + template ChangedKeyExprHelper + with + party : Party + where + signatory party + + choice ChangedKeyExprFetch : ChangedKeyExpr with + cid : ContractId ChangedKeyExpr + controller party + do fetch cid + + choice ChangedKeyExprFetchByKey : (ContractId ChangedKeyExpr, ChangedKeyExpr) with + k : ChangedKeyExprKey + controller party + do fetchByKey k + + choice ChangedKeyExprExercise : Text with + cid : ContractId ChangedKeyExpr + controller party + do exercise @ChangedKeyExpr cid ChangedKeyExprCall + + choice ChangedKeyExprExerciseByKey : Text with + k : ChangedKeyExprKey + controller party + do exerciseByKey @ChangedKeyExpr k ChangedKeyExprCall +-} + +qckKeyChangedExprSameValue : Test +qckKeyChangedExprSameValue = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a False) + keyRes <- queryContractKey a $ V2.ChangedKeyExprKey a False + case keyRes of + Some (foundCid, foundContract) | show foundCid == show cid && foundContract == V2.ChangedKeyExpr a False -> pure () + _ -> assertFail $ "Didn't find correct contract, expected " <> show (cid, V2.ChangedKeyExpr a False) <> ", got " <> show keyRes + +queryKeyChangedExprSameValue : Test +queryKeyChangedExprSameValue = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a False) + res <- queryContractId a (coerceContractId @_ @V2.ChangedKeyExpr cid) + case res of + Some foundContract | foundContract == V2.ChangedKeyExpr a False -> pure () + _ -> assertFail $ "Didn't find correct contract, expected " <> show (V2.ChangedKeyExpr a False) <> ", got " <> show res + +qckKeyChangedExprChangedValue : Test +qckKeyChangedExprChangedValue = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a True) + -- the following query works, even though the key value changed! + r <- queryContractKey @V2.ChangedKeyExpr a $ V2.ChangedKeyExprKey a False + r === None + +queryKeyChangedExprChangedValue : Test +queryKeyChangedExprChangedValue = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a True) + -- the following query works, even though the key value changed! + r <- queryContractId a (coerceContractId @_ @V2.ChangedKeyExpr cid) + r === None + +fetchKeyChangedExprSameValue : Test +fetchKeyChangedExprSameValue = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a False) + foundContract <- a `submit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprFetch $ coerceContractId cid) + foundContract === V2.ChangedKeyExpr a False + +fetchKeyChangedExprChangedValue : Test +fetchKeyChangedExprChangedValue = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a True) + expectKeyChangedError =<< + a `trySubmit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprFetch $ coerceContractId cid) + +fbkKeyChangedExprSameValue : Test +fbkKeyChangedExprSameValue = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a False) + (foundCid, foundContract) <- a `submit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprFetchByKey $ V2.ChangedKeyExprKey a False) + foundContract === V2.ChangedKeyExpr a False + show foundCid === show cid + +fbkKeyChangedExprChangedValue : Test +fbkKeyChangedExprChangedValue = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a True) + -- the fetch inside the following command works, even though the key value changed! + expectKeyChangedError =<< + a `trySubmit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprFetchByKey $ V2.ChangedKeyExprKey a False) + +exerciseKeyChangedExprSameValue : Test +exerciseKeyChangedExprSameValue = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a False) + res <- a `submit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprExercise $ coerceContractId cid) + res === "V2" + +ebkKeyChangedExprSameValue : Test +ebkKeyChangedExprSameValue = test $ do + a <- allocateParty "alice" + _ <- a `submit` createExactCmd (V1.ChangedKeyExpr a False) + res <- a `submit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprExerciseByKey $ V2.ChangedKeyExprKey a False) + res === "V2" + +exerciseCmdKeyChangedExprSameValue : Test +exerciseCmdKeyChangedExprSameValue = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a False) + res <- a `submit` exerciseExactCmd @V2.ChangedKeyExpr (coerceContractId cid) V2.ChangedKeyExprCall + res === "V2" + +ebkCmdKeyChangedExprSameValue : Test +ebkCmdKeyChangedExprSameValue = test $ do + a <- allocateParty "alice" + _ <- a `submit` createExactCmd (V1.ChangedKeyExpr a False) + res <- a `submit` exerciseByKeyExactCmd @V2.ChangedKeyExpr (V2.ChangedKeyExprKey a False) V2.ChangedKeyExprCall + res === "V2" + +exerciseKeyChangedExprChangedValue : Test +exerciseKeyChangedExprChangedValue = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a True) + expectKeyChangedError =<< + a `trySubmit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprExercise $ coerceContractId cid) + +ebkKeyChangedExprChangedValue : Test +ebkKeyChangedExprChangedValue = test $ do + a <- allocateParty "alice" + _ <- a `submit` createExactCmd (V1.ChangedKeyExpr a True) + expectKeyChangedError =<< + a `trySubmit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprExerciseByKey $ V2.ChangedKeyExprKey a False) + +exerciseCmdKeyChangedExprChangedValue : Test +exerciseCmdKeyChangedExprChangedValue = test $ do + a <- allocateParty "alice" + cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a True) + expectKeyChangedError =<< + a `trySubmit` exerciseExactCmd @V2.ChangedKeyExpr (coerceContractId cid) V2.ChangedKeyExprCall + +ebkCmdKeyChangedExprChangedValue : Test +ebkCmdKeyChangedExprChangedValue = test $ do + a <- allocateParty "alice" + _ <- a `submit` createExactCmd (V1.ChangedKeyExpr a True) + expectKeyChangedError =<< + a `trySubmit` exerciseByKeyExactCmd @V2.ChangedKeyExpr (V2.ChangedKeyExprKey a False) V2.ChangedKeyExprCall + +{- 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" + +------------------------------------------------------------------------------------------------------------------------ + +expectKeyChangedError : Either SubmitError a -> Script () +expectKeyChangedError r = case r of + Right _ -> assertFail "Expected failure but got success" + Left (DevError Upgrade msg) + | "Verify that neither the signatories, nor the observers, nor the contract key, nor the key's maintainers have changed" `isInfixOf` msg + -> pure () + Left e -> assertFail $ "Expected Upgrade error but got " <> show e From 50de717b6903ca4e70cd84720a9e2e62d31a989c Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mois=C3=A9s=20Ackerman?= Date: Tue, 17 Sep 2024 14:57:09 +0200 Subject: [PATCH 2/3] Mark broken test cases --- sdk/daml-script/test/daml/upgrades/ContractKeys.daml | 4 ++-- 1 file changed, 2 insertions(+), 2 deletions(-) diff --git a/sdk/daml-script/test/daml/upgrades/ContractKeys.daml b/sdk/daml-script/test/daml/upgrades/ContractKeys.daml index 17fd9039aaf3..b7d029a4e0f5 100644 --- a/sdk/daml-script/test/daml/upgrades/ContractKeys.daml +++ b/sdk/daml-script/test/daml/upgrades/ContractKeys.daml @@ -53,8 +53,8 @@ main = tests ] , subtree "Changed key type" [ subtree "Unchanged key value (modulo trailing `None`s)" - [ ("queryContractKey, src=v1 tgt=v2", queryKeyUpgraded) - , ("exerciseByKeyCmd, src=v1 tgt=v2", exerciseCmdKeyUpgraded) + [ broken ("queryContractKey, src=v1 tgt=v2", queryKeyUpgraded) + , broken ("exerciseByKeyCmd, src=v1 tgt=v2", exerciseCmdKeyUpgraded) , ("fetch, src=v1 tgt=v2", fetchKeyUpgraded) , ("exerciseByKey, src=v1 tgt=v2", exerciseUpdateKeyUpgraded) ] From 4c7c9ef9a711f841984ca144c687cbfb22987e7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Mois=C3=A9s=20Ackerman?= Date: Thu, 19 Sep 2024 14:23:39 +0200 Subject: [PATCH 3/3] Document state of contract key upgrades in 3.x --- sdk/daml-script/test/daml/upgrades/ContractKeys.daml | 8 ++++++++ 1 file changed, 8 insertions(+) diff --git a/sdk/daml-script/test/daml/upgrades/ContractKeys.daml b/sdk/daml-script/test/daml/upgrades/ContractKeys.daml index b7d029a4e0f5..beeb44130b6f 100644 --- a/sdk/daml-script/test/daml/upgrades/ContractKeys.daml +++ b/sdk/daml-script/test/daml/upgrades/ContractKeys.daml @@ -53,6 +53,14 @@ main = tests ] , subtree "Changed key type" [ subtree "Unchanged key value (modulo trailing `None`s)" + -- The tests below should all fail or all pass. Currently, `fetch` and + -- `exerciseByKey` (within an `Update`) work thanks to + -- https://github.com/digital-asset/daml/pull/19668, but + -- for `queryContractKey` and `exerciseByKeyCmd` to work we would need to port + -- https://github.com/digital-asset/daml/pull/19780 & + -- https://github.com/digital-asset/daml/pull/19792, + -- however, the latter is considered a hack, see + -- https://github.com/digital-asset/daml/issues/19782 [ broken ("queryContractKey, src=v1 tgt=v2", queryKeyUpgraded) , broken ("exerciseByKeyCmd, src=v1 tgt=v2", exerciseCmdKeyUpgraded) , ("fetch, src=v1 tgt=v2", fetchKeyUpgraded)