Compiler: expose LF builtin ExerciseByKey (#12615)

With this change, Daml exerciseByKey use the LF primitive
ExerciseByKey instead of the combinason of FetchByKey + Exercise.

CHANGELOG_BEGIN
CHANGELOG_END

bazel-haskell-deps.bzl

@@ -17,11 +17,11 @@ load("@os_info//:os_info.bzl", "is_linux", "is_windows")
 load("@dadew//:dadew.bzl", "dadew_tool_home")
 load("@rules_haskell//haskell:cabal.bzl", "stack_snapshot")
 
-GHC_LIB_REV = "a0b9249a488a13d561a6731a74f72505"
-GHC_LIB_SHA256 = "cfc8f68aa8f457370ad0164468398eba362a2bd73ebbb84f05dee96f93df7e02"
+GHC_LIB_REV = "7efdbb093dad0ad7a5dfd47785bf1eba"
+GHC_LIB_SHA256 = "6a53c9808da2232bc9f331cb26686637f7bf6888072288d98176c9da299b9bb1"
 GHC_LIB_VERSION = "8.8.1"
-GHC_LIB_PARSER_REV = "a0b9249a488a13d561a6731a74f72505"
-GHC_LIB_PARSER_SHA256 = "69a3b783f53b3bff7cc92bb51a4e520f7bb1097d2182745a408a41f5711734b0"
+GHC_LIB_PARSER_REV = "7efdbb093dad0ad7a5dfd47785bf1eba"
+GHC_LIB_PARSER_SHA256 = "b08884e7d3b9fec2baa667aefdb75f93fb253c5d66572085ab3dc2c1595a1d35"
 GHC_LIB_PARSER_VERSION = "8.8.1"
 GHCIDE_REV = "4146f08b729e1f4e4a3ac789570e9c0b9010944e"
 GHCIDE_SHA256 = "bd16242397b67ac0d803c7e0452b03396133d9b7aaf2ba3bddd834260a78bd80"

ci/da-ghc-lib/compile.yml

@@ -12,7 +12,7 @@ jobs:
   variables:
     ghc-lib-sha: '362d4f38a7ac10521393de9b7ad942a77a2605be'
     base-sha: '9c787d4d24f2b515934c8503ee2bbd7cfac4da20'
-    patches: 'aa004d2294f756cd990092d2071ef368aa58d9af 833ca63be2ab14871874ccb6974921e8952802e9'
+    patches: 'e33ed14601b071ad15745f4455b1f50765ae26eb 833ca63be2ab14871874ccb6974921e8952802e9'
     flavor: 'da-ghc-8.8.1'
   steps:
   - checkout: self

compiler/damlc/daml-lf-conversion/src/DA/Daml/LFConversion/Primitives.hs

@@ -292,6 +292,15 @@ convertPrim _ "UExerciseInterface"
   where
     choiceName = ChoiceName (T.intercalate "." $ unTypeConName $ qualObject choice)
 
+convertPrim _ "UExerciseByKey"
+    (TApp proxy (TCon template) :-> key :-> TCon choice :-> TUpdate _returnTy) =
+    ETmLam (mkVar "_", TApp proxy (TCon template)) $
+    ETmLam (mkVar "key", key) $
+    ETmLam (mkVar "arg", TCon choice) $
+    EUpdate $ UExerciseByKey template choiceName (EVar (mkVar "key")) (EVar (mkVar "arg"))
+  where
+    choiceName = ChoiceName (T.intercalate "." $ unTypeConName $ qualObject choice)
+
 convertPrim _ "ULookupByKey" (key :-> TUpdate (TOptional (TContractId (TCon template)))) =
     ETmLam (mkVar "key", key) $ EUpdate $
         ULookupByKey $ RetrieveByKey template (EVar $ mkVar "key")

compiler/damlc/daml-stdlib-src/DA/Internal/Template/Functions.daml

@@ -196,16 +196,19 @@ class HasFromAnyContractKey t k | t -> k where
   -- | HIDE
   _fromAnyContractKey : proxy t -> Any -> Optional k
 
+-- | Exposes `exerciseByKey` function.
+class HasExerciseByKey t k c r | t -> k, t c -> r where
+   -- | HIDE
+   _exerciseByKey : proxy t -> k -> c -> Update r
+
 -- | Exercise a choice on the contract associated with the given key.
 --
 -- You must pass the `t` using an explicit type application. For
 -- instance, if you want to exercise a choice `Withdraw` on a contract of
 -- template `Account` given by its key `k`, you must call
 -- `exerciseByKey @Account k Withdraw`.
-exerciseByKey : forall t k c r. (HasFetchByKey t k, HasExercise t c r) => k -> c -> Update r
-exerciseByKey k c = do
-    (cid, _) <- fetchByKey @t k
-    exercise cid c
+exerciseByKey : forall t k c r. HasExerciseByKey t k c r => k -> c -> Update r
+exerciseByKey = _exerciseByKey ([] : [t])
 
 -- | Create a contract and exercise the choice on the newly created contract.
 createAndExercise : forall t c r. (HasCreate t, HasExercise t c r) => t -> c -> Update r

daml-lf/engine/src/test/scala/com/digitalasset/daml/lf/engine/EngineTest.scala

@@ -611,6 +611,50 @@ class EngineTest
     }
   }
 
+  "DAML exercise-by-key" should {
+    val seed = hash("exercise-by-key")
+    val now = Time.Timestamp.now()
+
+    "create a Exercise node with flag byKey without Fetch REMY" in {
+
+      val tmplId = Identifier(basicTestsPkgId, "BasicTests:ExerciseByKey")
+      val cmds = ImmArray(
+        speedy.Command.CreateAndExercise(
+          templateId = tmplId,
+          createArgument =
+            SRecord(null, ImmArray(Ref.Name.assertFromString("name")), ArrayList(SParty(alice))),
+          choiceId = ChoiceName.assertFromString("Exercise"),
+          choiceArgument = SUnit,
+        )
+      )
+      val submitters = Set(alice)
+
+      val result = suffixLenientEngine
+        .interpretCommands(
+          validating = false,
+          submitters = submitters,
+          readAs = Set.empty,
+          commands = cmds,
+          ledgerTime = now,
+          submissionTime = now,
+          seeding = InitialSeeding.TransactionSeed(seed),
+        )
+        .consume(lookupContract, lookupPackage, lookupKey)
+
+      inside(result) { case Right((tx, _)) =>
+        inside(tx.roots.map(tx.nodes)) { case ImmArray(create: Node.Create, exe: Node.Exercise) =>
+          create.templateId shouldBe tmplId
+          exe.templateId shouldBe tmplId
+          inside(exe.children.map(tx.nodes)) { case ImmArray(exeByKey: Node.Exercise) =>
+            exeByKey.templateId shouldBe Identifier(basicTestsPkgId, "BasicTests:WithKey")
+            exeByKey.children shouldBe ImmArray.empty
+            exeByKey.byKey shouldBe true
+          }
+        }
+      }
+    }
+  }
+
   "fecth-by-key" should {
     val seed = hash("fetch-by-key")
 

daml-lf/tests/BasicTests.daml

@@ -379,6 +379,15 @@ template FailedFetchByKey
          None <- lookupByKey @WithKey key
          fetchByKey @WithKey key
 
+template ExerciseByKey
+  with
+    p : Party
+  where
+    signatory p
+    choice Exercise : Int
+      controller p
+      do
+        exerciseByKey @WithKey (p, 42) SumToK with n = 0
 
 test_failedAuths = scenario do
   alice <- getParty "alice"