Expose trigger actAs party via getActAs (#12296)

fixes #12125

changelog_begin
changelog_end

triggers/daml/Daml/Trigger.daml

@@ -45,6 +45,7 @@ module Daml.Trigger
  , registeredTemplate
  , RelTime(..)
  , getReadAs
+ , getActAs
  ) where
 
 import Prelude hiding (any)
@@ -107,6 +108,8 @@ class ActionTriggerAny m where
 
   getReadAs : m [Party]
 
+  getActAs : m Party
+
 instance ActionTriggerAny (TriggerA s) where
   implQuery = TriggerA $ pure . getContracts
   queryContractId id = TriggerA $ pure . getContractById id
@@ -115,17 +118,23 @@ instance ActionTriggerAny (TriggerA s) where
     s <- get
     pure s.readAs
 
+  getActAs = TriggerA $ \_ -> do
+    s <- get
+    pure s.actAs
+
 instance ActionTriggerAny (TriggerUpdateA s) where
-  implQuery = TriggerUpdateA $ \(_, acs, _) -> pure (getContracts acs)
-  queryContractId id = TriggerUpdateA $ \(_, acs, _) -> pure (getContractById id acs)
-  queryPendingContracts = TriggerUpdateA $ \(_, acs, _) -> pure (getPendingContracts acs)
-  getReadAs = TriggerUpdateA $ \(_, _, readAs) -> pure readAs
+  implQuery = TriggerUpdateA $ \s -> pure (getContracts s.acs)
+  queryContractId id = TriggerUpdateA $ \s -> pure (getContractById id s.acs)
+  queryPendingContracts = TriggerUpdateA $ \s -> pure (getPendingContracts s.acs)
+  getReadAs = TriggerUpdateA $ \s -> pure s.readAs
+  getActAs = TriggerUpdateA $ \s -> pure s.actAs
 
 instance ActionTriggerAny TriggerInitializeA where
-  implQuery = TriggerInitializeA (\(acs, _) -> getContracts acs)
-  queryContractId id = TriggerInitializeA (\(acs, _) -> getContractById id acs)
-  queryPendingContracts = TriggerInitializeA (\(acs, _) -> getPendingContracts acs)
-  getReadAs = TriggerInitializeA (\(_, readAs) -> readAs)
+  implQuery = TriggerInitializeA (\s -> getContracts s.acs)
+  queryContractId id = TriggerInitializeA (\s -> getContractById id s.acs)
+  queryPendingContracts = TriggerInitializeA (\s -> getPendingContracts s.acs)
+  getReadAs = TriggerInitializeA (\s -> s.readAs)
+  getActAs = TriggerInitializeA (\s -> s.actAs)
 
 -- | Features possible in `updateState` and `rule`.
 class ActionTriggerAny m => ActionTriggerUpdate m where
@@ -136,7 +145,7 @@ class ActionTriggerAny m => ActionTriggerUpdate m where
   getCommandsInFlight : m (Map CommandId [Command])
 
 instance ActionTriggerUpdate (TriggerUpdateA s) where
-  getCommandsInFlight = TriggerUpdateA $ \(cif, _, _) -> pure cif
+  getCommandsInFlight = TriggerUpdateA $ \s -> pure s.commandsInFlight
 
 instance ActionTriggerUpdate (TriggerA s) where
   getCommandsInFlight = liftTriggerRule $ get <&> \s -> s.commandsInFlight
@@ -264,10 +273,12 @@ runTrigger userTrigger = LowLevel.Trigger
   where
     initialState party readAs (ActiveContracts createdEvents) =
       let acs = foldl (\acs created -> applyEvent (CreatedEvent created) acs) (ACS mempty Map.empty) createdEvents
-          userState = runTriggerInitializeA userTrigger.initialize (acs, readAs)
+          userState = runTriggerInitializeA userTrigger.initialize (TriggerInitState acs party readAs)
           state = TriggerState acs party readAs userState Map.empty
       in TriggerSetup $ execStateT (runTriggerRule $ runRule userTrigger.rule) state
-    utUpdateState commandsInFlight acs readAs msg = execState $ flip runTriggerUpdateA (commandsInFlight, acs, readAs) $ userTrigger.updateState msg
+    utUpdateState commandsInFlight acs actAs readAs msg =
+      let state = TriggerUpdateState commandsInFlight acs actAs readAs
+      in execState $ flip runTriggerUpdateA state $ userTrigger.updateState msg
     update msg = do
       time <- getTime
       state <- get
@@ -275,7 +286,7 @@ runTrigger userTrigger = LowLevel.Trigger
         MCompletion completion ->
           -- NB: the commands-in-flight and ACS updateState sees are those
           -- prior to updates incurred by the msg
-          let userState = utUpdateState state.commandsInFlight state.acs state.readAs (MCompletion completion) state.userState
+          let userState = utUpdateState state.commandsInFlight state.acs state.actAs state.readAs (MCompletion completion) state.userState
           in case completion.status of
             Succeeded {} ->
               -- We delete successful completions when we receive the corresponding transaction
@@ -289,7 +300,7 @@ runTrigger userTrigger = LowLevel.Trigger
         MTransaction transaction -> do
           let acs = applyTransaction transaction state.acs
               -- again, we use the commands-in-flight and ACS before the update below
-              userState = utUpdateState state.commandsInFlight acs state.readAs (MTransaction transaction) state.userState
+              userState = utUpdateState state.commandsInFlight acs state.actAs state.readAs (MTransaction transaction) state.userState
               -- See the comment above for why we delete this here instead of when we receive the completion.
               (acs', commandsInFlight) = case transaction.commandId of
                 None -> (acs, state.commandsInFlight)
@@ -297,6 +308,6 @@ runTrigger userTrigger = LowLevel.Trigger
           put $ state { acs = acs', userState, commandsInFlight }
           runRule userTrigger.rule
         MHeartbeat -> do
-          let userState = utUpdateState state.commandsInFlight state.acs state.readAs MHeartbeat state.userState
+          let userState = utUpdateState state.commandsInFlight state.acs state.actAs state.readAs MHeartbeat state.userState
           put $ state { userState }
           runRule userTrigger.rule

triggers/daml/Daml/Trigger/Assert.daml

@@ -67,7 +67,7 @@ testRule trigger party readAs acsBuilder commandsInFlight s = do
   acs <- buildACS party acsBuilder
   let state = TriggerState
         { acs = acs
-        , party = party
+        , actAs = party
         , readAs = readAs
         , userState = s
         , commandsInFlight = commandsInFlight

triggers/daml/Daml/Trigger/Internal.daml

@@ -20,6 +20,8 @@ module Daml.Trigger.Internal
   , liftTriggerRule
   , TriggerAState (..)
   , TriggerState (..)
+  , TriggerInitState(..)
+  , TriggerUpdateState(..)
   ) where
 
 import DA.Action.State
@@ -65,12 +67,20 @@ instance ActionState s (TriggerA s) where
 instance HasTime (TriggerA s) where
   getTime = TriggerA $ const getTime
 
+-- | HIDE
+data TriggerUpdateState = TriggerUpdateState
+  with
+    commandsInFlight : Map CommandId [Command]
+    acs : ACS
+    actAs : Party
+    readAs : [Party]
+
 -- | TriggerUpdateA is the type used in the `updateState` of a Daml
 -- trigger.  It has similar actions in common with `TriggerA`, but
 -- cannot use `emitCommands` or `getTime`.
 newtype TriggerUpdateA s a =
   -- | HIDE
-  TriggerUpdateA { runTriggerUpdateA : (Map CommandId [Command], ACS, [Party]) -> State s a }
+  TriggerUpdateA { runTriggerUpdateA : TriggerUpdateState -> State s a }
 
 instance Functor (TriggerUpdateA s) where
   fmap f (TriggerUpdateA r) = TriggerUpdateA $ rliftFmap fmap f r
@@ -87,11 +97,18 @@ instance ActionState s (TriggerUpdateA s) where
   put = TriggerUpdateA . const . put
   modify = TriggerUpdateA . const . modify
 
+-- | HIDE
+data TriggerInitState = TriggerInitState
+  with
+    acs : ACS
+    actAs : Party
+    readAs : [Party]
+
 -- | TriggerInitializeA is the type used in the `initialize` of a Daml
 -- trigger.  It can query, but not emit commands or update the state.
 newtype TriggerInitializeA a =
   -- | HIDE
-  TriggerInitializeA { runTriggerInitializeA : (ACS, [Party]) -> a }
+  TriggerInitializeA { runTriggerInitializeA : TriggerInitState -> a }
   deriving (Functor, Applicative, Action)
 
 -- Internal API
@@ -142,14 +159,15 @@ runRule
 runRule rule = do
   state <- get
   TriggerRule . zoom zoomIn zoomOut . runTriggerRule . flip runTriggerA state.acs
-      $ rule state.party
-  where zoomIn state = TriggerAState state.commandsInFlight state.acs.pendingContracts state.userState state.readAs
+      $ rule state.actAs
+  where zoomIn state = TriggerAState state.commandsInFlight state.acs.pendingContracts state.userState state.readAs state.actAs
         zoomOut state aState =
           let commandsInFlight = aState.commandsInFlight
               acs = state.acs { pendingContracts = aState.pendingContracts }
               userState = aState.userState
               readAs = aState.readAs
-          in state { commandsInFlight, acs, userState, readAs }
+              actAs = aState.actAs
+          in state { commandsInFlight, acs, userState, readAs, actAs }
 
 -- | HIDE
 liftTriggerRule : TriggerRule (TriggerAState s) a -> TriggerA s a
@@ -167,12 +185,14 @@ data TriggerAState s = TriggerAState
   -- ^ zoomed from TriggerState
   , readAs : [Party]
   -- ^ zoomed from TriggerState
+  , actAs : Party
+  -- ^ zoomed from TriggerState
   }
 
 -- | HIDE
 data TriggerState s = TriggerState
   { acs : ACS
-  , party : Party
+  , actAs : Party
   , readAs : [Party]
   , userState : s
   , commandsInFlight : Map CommandId [Command]

triggers/tests/BUILD.bazel

@@ -42,6 +42,7 @@ DAML_LF_VERSIONS = [
       cp -L $(location :daml/Time.daml) $$TMP_DIR/daml
       cp -L $(location :daml/Heartbeat.daml) $$TMP_DIR/daml
       cp -L $(location :daml/ReadAs.daml) $$TMP_DIR/daml
+      cp -L $(location :daml/ActAs.daml) $$TMP_DIR/daml
       cp -L $(location //templates:copy-trigger/src/CopyTrigger.daml) $$TMP_DIR/daml
       cp -L $(location //triggers/daml:daml-trigger{suffix}.dar) $$TMP_DIR/daml-trigger.dar
       cp -L $(location //daml-script/daml:daml-script{suffix}.dar) $$TMP_DIR/daml-script.dar

triggers/tests/daml/ActAs.daml

@@ -0,0 +1,39 @@
+-- Copyright (c) 2022 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
+-- SPDX-License-Identifier: Apache-2.0
+
+
+module ActAs where
+
+import DA.Action
+import Daml.Trigger
+
+-- We run until init, updateState and rule have finished and
+-- check that the parties are identical across the 3.
+
+test : Trigger (Party, Bool, Bool)
+test = Trigger
+  { initialize = do
+      p <- getActAs
+      pure (p, False, False)
+  , updateState = \_ -> do
+      p <- getActAs
+      (p', _, _) <- get
+      unless (p == p') $ error "Inconsistent actAs parties"
+      modify (\(a, _, b) -> (a, True, b))
+  , rule = \p -> do
+      p' <- getActAs
+      (p'', _, _) <- get
+      unless (p == p') $ error "Inconsistent actAs parties"
+      unless (p == p'') $ error "Inconsistent actAs parties"
+      modify (\(a, b, _) -> (a, b, True))
+      _ <- emitCommands [createCmd (T p)] []
+      pure ()
+  , registeredTemplates = AllInDar
+  , heartbeat = None
+  }
+
+template T
+  with
+    p : Party
+  where
+    signatory p

triggers/tests/src/test/scala/com/digitalasset/daml/lf/engine/trigger/test/AbstractFuncTests.scala

@@ -17,6 +17,7 @@ import org.scalatest._
 import org.scalatest.matchers.should.Matchers
 import org.scalatest.wordspec.AsyncWordSpec
 import scalaz.syntax.traverse._
+import scala.jdk.CollectionConverters._
 
 import com.daml.lf.engine.trigger.TriggerMsg
 
@@ -558,5 +559,30 @@ abstract class AbstractFuncTests
         }
       }
     }
+    "getActAs" should {
+      "produce a consistent party" in {
+        for {
+          client <- ledgerClient()
+          party <- allocateParty(client)
+          runner = getRunner(
+            client,
+            QualifiedName.assertFromString("ActAs:test"),
+            party,
+          )
+          (acs, offset) <- runner.queryACS()
+          // 1 for the completion & 1 for the transaction.
+          result <- runner.runWithACS(acs, offset, msgFlow = Flow[TriggerMsg].take(2))._2
+        } yield {
+          inside(toHighLevelResult(result).state) { case SRecord(_, _, values) =>
+            // Check that both updateState and rule were executed.
+            values.asScala shouldBe Seq[SValue](
+              SParty(Party.assertFromString(party)),
+              SBool(true),
+              SBool(true),
+            )
+          }
+        }
+      }
+    }
   }
 }