add test cases demonstrating key collisions (#22282)

Keys are currently broken in the presence of force-vetted invalid
upgrades (or missing incompatible creation package).

This PR adds test cases which should result in "key not found" errors
but instead either succeed or fail with an upgrade validation error.
These tests are therefore marked as broken and should "fail to be
broken" once I fix keys.

Author: paulbrauner-da

sdk/daml-script/test/daml/upgrades/dev/ContractKeys.daml

@@ -18,9 +18,14 @@ import qualified V1.ChangedMaintainersExpr as V1
 import qualified V2.ChangedMaintainersExpr as V2
 import qualified V1.UpgradedContractKeys as V1
 import qualified V2.UpgradedContractKeys as V2
+import qualified V1.InvalidKeyUpgrade as V1
+import qualified V2.InvalidKeyUpgrade as V2
+import qualified V1.InvalidKeyRenaming as V1
+import qualified V2.InvalidKeyRenaming as V2
 import qualified V1.ContractKeyPresence as V1
 import qualified V2.ContractKeyPresence as V2
 import qualified V1.IfaceMod as Iface
+import qualified V1.KeyUpgradeClient as Client
 
 {- PACKAGE
 name: contract-key-upgrades-iface
@@ -107,14 +112,26 @@ main = tests
         ]
       ]
     ]
-  , subtree "Changed key type"
+  , subtree "Changed key type, valid upgrade"
     [ 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)
       ]
     ]
+  , subtree "Changed key type, invalid upgrade"
+    [ broken ("queryContractKeyCmd, global", queryInvalidKeyUpgradeGlobal)
+    , broken ("exerciseByKeyCmd, global", exerciseInvalidKeyUpgradeGlobal)
+    , broken ("fetch, local", fetchInvalidKeyUpgradeLocal)
+    , broken ("exerciseByKey, local", exerciseInvalidKeyUpgradeLocal)
+    ]
+  , subtree "Renamed key label, invalid upgrade"
+    [ broken ("queryContractKeyCmd, global", queryInvalidKeyRenamingGlobal)
+    , broken ("exerciseByKeyCmd, global", exerciseInvalidKeyRenamingGlobal)
+    , broken ("fetch, local", fetchInvalidKeyRenamingLocal)
+    , broken ("exerciseByKey, local", exerciseInvalidKeyRenamingLocal)
+    ]
   , subtree "Changed key presence"
     [ subtree "Key in v1, no key in v2"
       [ ("fetch", fetchTemplateWithUnexpectedKey)
@@ -666,6 +683,182 @@ exerciseUpdateKeyUpgraded = test $ do
   res <- a `submit` createAndExerciseCmd (V2.UpgradedKeyHelper a) (V2.UpgradedKeyExercise $ V2.UpgradedKeyKey a 1 None)
   res === "V2"
 
+{- MODULE
+package: contract-key-upgrades
+contents: |
+  module InvalidKeyUpgrade where
+
+  data InvalidKeyUpgradeKey = InvalidKeyUpgradeKey with
+      p : Party
+      n : Int                -- @V 1
+      n : Bool               -- @V 2
+    deriving (Eq, Show)
+
+  template InvalidKeyUpgrade
+    with
+      party : Party
+    where
+      signatory party
+      key (InvalidKeyUpgradeKey party 0) : InvalidKeyUpgradeKey     -- @V 1
+      key (InvalidKeyUpgradeKey party False) : InvalidKeyUpgradeKey -- @V 2
+      maintainer key.p
+
+      choice InvalidKeyUpgradeCall : Text
+        controller party
+        do pure (show (key this).n)
+-}
+
+{- MODULE
+package: contract-key-upgrades
+contents: |
+  module InvalidKeyRenaming where
+
+  data InvalidKeyRenamingKey = InvalidKeyRenamingKey with
+      p : Party
+      n : Int                -- @V 1
+      m : Int                -- @V 2
+    deriving (Eq, Show)
+
+  template InvalidKeyRenaming
+    with
+      party : Party
+    where
+      signatory party
+      key (InvalidKeyRenamingKey party 42) : InvalidKeyRenamingKey
+      maintainer key.p
+
+      choice InvalidKeyRenamingCall : Int
+        controller party
+        do
+          pure (key this).n  -- @V 1
+          pure (key this).m  -- @V 2
+-}
+
+{- PACKAGE
+name: contract-key-upgrades-client
+versions: 1
+depends: |
+  contract-key-upgrades-1.0.0
+  contract-key-upgrades-2.0.0
+-}
+
+{- MODULE
+package: contract-key-upgrades-client
+contents: |
+  module KeyUpgradeClient where
+
+  import V1.InvalidKeyUpgrade as V1
+  import V2.InvalidKeyUpgrade as V2
+  import V1.InvalidKeyRenaming as V1
+  import V2.InvalidKeyRenaming as V2
+
+  template KeyUpgradeClient
+    with
+      party : Party
+    where
+      signatory party
+
+      -- InvalidKeyUpgrade
+
+      choice InvalidKeyUpgradeFetch : (ContractId V2.InvalidKeyUpgrade, V2.InvalidKeyUpgrade)
+        controller party
+        do
+          cid <- create (V1.InvalidKeyUpgrade party)
+          fetchByKey (V2.InvalidKeyUpgradeKey party False)
+
+      choice InvalidKeyUpgradeExercise : Text
+        controller party
+        do
+          cid <- create (V1.InvalidKeyUpgrade party)
+          exerciseByKey @V2.InvalidKeyUpgrade (V2.InvalidKeyUpgradeKey party False) V2.InvalidKeyUpgradeCall
+
+      -- InvalidKeyRenaming
+
+      choice InvalidKeyRenamingFetch : (ContractId V2.InvalidKeyRenaming, V2.InvalidKeyRenaming)
+        controller party
+        do
+          cid <- create (V1.InvalidKeyRenaming party)
+          fetchByKey (V2.InvalidKeyRenamingKey party 42)
+
+      choice InvalidKeyRenamingExercise : Int
+        controller party
+        do
+          cid <- create (V1.InvalidKeyRenaming party)
+          exerciseByKey @V2.InvalidKeyRenaming (V2.InvalidKeyRenamingKey party 42) V2.InvalidKeyRenamingCall
+-}
+
+-- InvalidKeyUpgrade
+
+queryInvalidKeyUpgradeGlobal : Test
+queryInvalidKeyUpgradeGlobal = test $ do
+  a <- allocateParty "alice"
+  cid <- a `submit` createExactCmd (V1.InvalidKeyUpgrade a)
+  keyRes <- queryContractKey @V2.InvalidKeyUpgrade a $ V2.InvalidKeyUpgradeKey a False
+  case keyRes of
+    None -> pure ()
+    _ -> assertFail ("Expected None (key not found), but got: " <> show keyRes)
+
+exerciseInvalidKeyUpgradeGlobal : Test
+exerciseInvalidKeyUpgradeGlobal = test $ do
+  a <- allocateParty "alice"
+  cid <- a `submit` createExactCmd (V1.InvalidKeyUpgrade a)
+  res <- a `trySubmit` exerciseByKeyExactCmd @V2.InvalidKeyUpgrade (V2.InvalidKeyUpgradeKey a False) V2.InvalidKeyUpgradeCall
+  case res of
+    Left (ContractKeyNotFound _) -> pure ()
+    _ -> assertFail ("Expected ContractKeyNotFound, but got: " <> show res)
+    
+fetchInvalidKeyUpgradeLocal : Test
+fetchInvalidKeyUpgradeLocal = test $ do
+  a <- allocateParty "alice"
+  res <- a `trySubmit` createAndExerciseCmd (Client.KeyUpgradeClient a) Client.InvalidKeyUpgradeFetch
+  case res of
+    Left (ContractKeyNotFound _) -> pure ()
+    _ -> assertFail ("Expected ContractKeyNotFound, but got: " <> show res)
+
+exerciseInvalidKeyUpgradeLocal : Test
+exerciseInvalidKeyUpgradeLocal = test $ do
+  a <- allocateParty "alice"
+  res <- a `trySubmit` createAndExerciseCmd (Client.KeyUpgradeClient a) Client.InvalidKeyUpgradeExercise
+  case res of
+    Left (ContractKeyNotFound _) -> pure ()
+    _ -> assertFail ("Expected ContractKeyNotFound, but got: " <> show res)
+
+-- InvalidKeyRenaming
+
+queryInvalidKeyRenamingGlobal : Test
+queryInvalidKeyRenamingGlobal = test $ do
+  a <- allocateParty "alice"
+  cid <- a `submit` createExactCmd (V1.InvalidKeyRenaming a)
+  keyRes <- queryContractKey @V2.InvalidKeyRenaming a $ V2.InvalidKeyRenamingKey a 42
+  case keyRes of
+    None -> pure ()
+    _ -> assertFail ("Expected None (key not found), but got: " <> show keyRes)
+
+exerciseInvalidKeyRenamingGlobal : Test
+exerciseInvalidKeyRenamingGlobal = test $ do
+  a <- allocateParty "alice"
+  cid <- a `submit` createExactCmd (V1.InvalidKeyRenaming a)
+  res <- a `trySubmit` exerciseByKeyExactCmd @V2.InvalidKeyRenaming (V2.InvalidKeyRenamingKey a 42) V2.InvalidKeyRenamingCall
+  case res of
+    Left (ContractKeyNotFound _) -> pure ()
+    _ -> assertFail ("Expected ContractKeyNotFound, but got: " <> show res)
+
+fetchInvalidKeyRenamingLocal : Test
+fetchInvalidKeyRenamingLocal = test $ do
+  a <- allocateParty "alice"
+  res <- a `trySubmit` createAndExerciseCmd (Client.KeyUpgradeClient a) Client.InvalidKeyRenamingFetch
+  case res of
+    Left (ContractKeyNotFound _) -> pure ()
+    _ -> assertFail ("Expected ContractKeyNotFound, but got: " <> show res)
+
+exerciseInvalidKeyRenamingLocal : Test
+exerciseInvalidKeyRenamingLocal = test $ do
+  a <- allocateParty "alice"
+  res <- a `trySubmit` createAndExerciseCmd (Client.KeyUpgradeClient a) Client.InvalidKeyRenamingExercise
+  case res of
+    Left (ContractKeyNotFound _) -> pure ()
+    _ -> assertFail ("Expected ContractKeyNotFound, but got: " <> show res)
+
 {- MODULE
 package: contract-key-upgrades
 contents: |