[WIP] port 'main' daml-script grpc ledger client upgrades test suite …

…to test ide ledger

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`

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)
+

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"
+

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"
+