Use TemplateTypeRep in DAML Trigger API (#3245)

* Add TemplateTypeRep to AnyContractId

* Define Trigger.ContractId t

* Use Trigger.ContractId t

* Implement fromCreated and fromArchived

* instance MapKey TemplateTypeRep

* More efficient ACS access using Map TemplateTypeRep

* ./fmt.sh

* toString and fromString for Identifier

* Replace Identifier by TemplateTypeRep

* TheContractId --> AbsoluteContractId

https://github.com/digital-asset/daml/pull/3245#discussion_r338033546

compiler/damlc/daml-stdlib-src/DA/Internal/LF.daml

@@ -39,7 +39,10 @@ module DA.Internal.LF
 
   , AnyTemplate
   , AnyChoice
+
   , TemplateTypeRep
+  , templateTypeRepToText
+  , templateTypeRepFromText
   ) where
 
 import GHC.Types (Opaque, Symbol)
@@ -221,3 +224,9 @@ newtype AnyChoice = AnyChoice { getAnyChoice : Any }
 -- | Unique textual representation of a template Id.
 newtype TemplateTypeRep = TemplateTypeRep { getTemplateTypeRep : Text }
   deriving (Eq, Ord, Show)
+
+templateTypeRepToText : TemplateTypeRep -> Text
+templateTypeRepToText = getTemplateTypeRep
+
+templateTypeRepFromText : Text -> Optional TemplateTypeRep
+templateTypeRepFromText = Some . TemplateTypeRep

compiler/damlc/daml-stdlib-src/DA/Next/Map.daml

@@ -59,6 +59,10 @@ instance MapKey Party where
   keyToText = partyToText
   keyFromText = fromSome . partyFromText
 
+instance MapKey TemplateTypeRep where
+  keyToText = templateTypeRepToText
+  keyFromText = fromSome . templateTypeRepFromText
+
 instance MapKey Int where
   keyToText = show
   keyFromText = fromSome . parseInt

daml-lf/data/src/main/scala/com/digitalasset/daml/lf/data/Ref.scala

@@ -141,7 +141,23 @@ object Ref {
 
   /* A fully-qualified identifier pointing to a definition in the
    * specified package. */
-  case class Identifier(packageId: PackageId, qualifiedName: QualifiedName)
+  case class Identifier(packageId: PackageId, qualifiedName: QualifiedName) {
+    override def toString: String = packageId.toString + ":" + qualifiedName.toString
+  }
+  object Identifier {
+    type T = Identifier
+
+    def fromString(s: String): Either[String, Identifier] = {
+      val segments = split(s, ':')
+      if (segments.length != 3)
+        Left(s"Expecting three segments in $s, but got ${segments.length}")
+      else
+        for {
+          packageId <- PackageId.fromString(segments(0))
+          qualifiedName <- QualifiedName.fromString(segments(1) + ":" + segments(2))
+        } yield Identifier(packageId, qualifiedName)
+    }
+  }
 
   /* Choice name in a template. */
   val ChoiceName: Name.type = Name

docs/source/triggers/template-root/src/CopyTrigger.daml

@@ -64,9 +64,9 @@ copyRule : Party -> ACS -> Map CommandId [Command] -> () -> TriggerA ()
 copyRule party acs commandsInFlight () = do
 -- RULE_SIGNATURE_END
 -- ACS_QUERY_BEGIN
-  let subscribers : [(AnyContractId, Subscriber)] = getTemplates @Subscriber acs
-  let originals : [(AnyContractId, Original)] = getTemplates @Original acs
-  let copies : [(AnyContractId, Copy)] = getTemplates @Copy acs
+  let subscribers : [(AbsoluteContractId Subscriber, Subscriber)] = getTemplates @Subscriber acs
+  let originals : [(AbsoluteContractId Original, Original)] = getTemplates @Original acs
+  let copies : [(AbsoluteContractId Copy, Copy)] = getTemplates @Copy acs
 -- ACS_QUERY_END
 
 -- ACS_FILTER_BEGIN
@@ -80,7 +80,7 @@ copyRule party acs commandsInFlight () = do
 -- SUBSCRIBING_PARTIES_END
 
 -- GROUP_COPIES_BEGIN
-  let groupedCopies : [[(AnyContractId, Copy)]]
+  let groupedCopies : [[(AbsoluteContractId Copy, Copy)]]
       groupedCopies = groupOn snd $ sortOn snd $ ownedCopies
   let copiesToKeep = map head groupedCopies
   let archiveDuplicateCopies = concatMap tail groupedCopies

triggers/daml/Daml/Trigger.daml

@@ -12,6 +12,9 @@ module Daml.Trigger
  , CommandId
  , Command(..)
  , AnyContractId(..)
+ , AbsoluteContractId(..)
+ , toAnyContractId
+ , fromAnyContractId
  , exerciseCmd
  , createCmd
  , Message(..)
@@ -30,10 +33,12 @@ import qualified Daml.Trigger.LowLevel as LowLevel
 
 -- public API
 
-newtype ACS = ACS [(AnyContractId, AnyTemplate)]
+newtype ACS = ACS (Map TemplateTypeRep [(AnyContractId, AnyTemplate)])
 
-getTemplates : Template a => ACS -> [(AnyContractId, a)]
-getTemplates (ACS tpls) = mapOptional (\(cid, tpl) -> (cid,) <$> fromAnyTemplate tpl) tpls
+getTemplates : forall a. Template a => ACS -> [(AbsoluteContractId a, a)]
+getTemplates (ACS tpls) = map fromAny $ fromOptional [] $ Map.lookup (templateTypeRep @a) tpls
+  where
+    fromAny (cid, tpl) = (fromSome (fromAnyContractId cid), fromSome (fromAnyTemplate tpl))
 
 data Trigger s = Trigger
   { initialize : ACS -> s
@@ -60,7 +65,7 @@ runTrigger userTrigger = LowLevel.Trigger
   }
   where
     initialState party (ActiveContracts createdEvents) =
-      let acs = foldl (\acs created -> applyEvent (CreatedEvent created) acs) (ACS []) createdEvents
+      let acs = foldl (\acs created -> applyEvent (CreatedEvent created) acs) (ACS Map.empty) createdEvents
           userState = userTrigger.initialize acs
           (_, TriggerAState commands nextCommandId) = runTriggerA (userTrigger.rule party acs Map.empty userState) (TriggerAState [] 0)
           commandsInFlight = foldl addCommands Map.empty commands
@@ -102,14 +107,21 @@ addCommands : Map CommandId [Command] -> Commands -> Map CommandId [Command]
 addCommands m (Commands cid cmds) = Map.insert cid cmds m
 
 insertTpl : AnyContractId -> AnyTemplate -> ACS -> ACS
-insertTpl cid tpl (ACS acs) = ACS ((cid, tpl) :: acs)
+insertTpl cid tpl (ACS acs) =
+  case Map.lookup cid.templateId acs of
+    None -> ACS (Map.insert cid.templateId [(cid, tpl)] acs)
+    Some items -> ACS (Map.insert cid.templateId ((cid, tpl) :: items) acs)
 
 deleteTpl : AnyContractId -> ACS -> ACS
-deleteTpl cid (ACS acs) = ACS (filter (\(cid', _) -> cid /= cid') acs)
+deleteTpl cid (ACS acs) =
+  case Map.lookup cid.templateId acs of
+    None -> ACS acs
+    Some items -> ACS (Map.insert cid.templateId (filter (\(cid', _) -> cid /= cid') items) acs)
 
 lookupTpl : Template a => AnyContractId -> ACS -> Optional a
 lookupTpl cid (ACS acs) = do
-  (_, tpl) <- find ((cid ==) . fst) acs
+  items <- Map.lookup cid.templateId acs
+  (_, tpl) <- find ((cid ==) . fst) items
   fromAnyTemplate tpl
 
 applyEvent : Event -> ACS -> ACS

triggers/daml/Daml/Trigger/LowLevel.daml

@@ -7,14 +7,18 @@ module Daml.Trigger.LowLevel
   , Completion(..)
   , CompletionStatus(..)
   , Transaction(..)
-  , Identifier(..)
   , AnyContractId(..)
+  , AbsoluteContractId(..)
+  , toAnyContractId
+  , fromAnyContractId
   , TransactionId(..)
   , EventId(..)
   , CommandId(..)
   , Event(..)
   , Created(..)
+  , fromCreated
   , Archived(..)
+  , fromArchived
   , Trigger(..)
   , ActiveContracts(..)
   , Commands(..)
@@ -26,17 +30,25 @@ module Daml.Trigger.LowLevel
 
 import DA.Next.Map (MapKey(..))
 
-data Identifier = Identifier
-  { packageId : Text
-  , moduleName : Text
-  , entityName : Text
-  } deriving (Show, Eq, Ord)
-
 data AnyContractId = AnyContractId
-  { templateId : Identifier
+  { templateId : TemplateTypeRep
   , contractId : Text
   } deriving (Show, Eq, Ord)
 
+newtype AbsoluteContractId t = AbsoluteContractId { contractId : Text }
+  deriving (Show, Eq, Ord)
+
+toAnyContractId : forall t. Template t => AbsoluteContractId t -> AnyContractId
+toAnyContractId (AbsoluteContractId contractId) = AnyContractId
+  { templateId = templateTypeRep @t
+  , contractId = contractId
+  }
+
+fromAnyContractId : forall t. Template t => AnyContractId -> Optional (AbsoluteContractId t)
+fromAnyContractId cid
+  | cid.templateId == templateTypeRep @t = Some (AbsoluteContractId cid.contractId)
+  | otherwise = None
+
 newtype TransactionId = TransactionId Text
   deriving (Show, Eq)
 
@@ -62,11 +74,26 @@ data Created = Created
   , argument : AnyTemplate
   }
 
+fromCreated : Template t => Created -> Optional (EventId, AbsoluteContractId t, t)
+fromCreated Created {eventId, contractId, argument}
+  | Some contractId' <- fromAnyContractId contractId
+  , Some argument' <- fromAnyTemplate argument
+  = Some (eventId, contractId', argument')
+  | otherwise
+  = None
+
 data Archived = Archived
   { eventId : EventId
   , contractId : AnyContractId
   } deriving (Show, Eq)
 
+fromArchived : Template t => Archived -> Optional (EventId, AbsoluteContractId t)
+fromArchived Archived {eventId, contractId}
+  | Some contractId' <- fromAnyContractId contractId
+  = Some (eventId, contractId')
+  | otherwise
+  = None
+
 data Message
   = MTransaction Transaction
   | MCompletion Completion
@@ -111,9 +138,9 @@ createCmd : Template t => t -> Command
 createCmd templateArg =
   CreateCommand (toAnyTemplate templateArg)
 
-exerciseCmd : forall t c r. Choice t c r => AnyContractId -> c -> Command
+exerciseCmd : forall t c r. Choice t c r => AbsoluteContractId t -> c -> Command
 exerciseCmd contractId choiceArg =
-  ExerciseCommand contractId (toAnyChoice @t choiceArg)
+  ExerciseCommand (toAnyContractId contractId) (toAnyChoice @t choiceArg)
 
 data Commands = Commands
   { commandId : CommandId

triggers/runner/src/main/scala/com/daml/trigger/Converter.scala

@@ -111,13 +111,13 @@ object Converter {
     )
   }
 
-  private def fromIdentifier(triggerIds: TriggerIds, id: value.Identifier): SValue = {
-    val identifierTy = triggerIds.getId("Identifier")
-    record(
-      identifierTy,
-      ("packageId", SText(id.packageId)),
-      ("moduleName", SText(id.moduleName)),
-      ("name", SText(id.entityName)))
+  private def fromIdentifier(id: value.Identifier): SValue = {
+    SText(
+      Identifier(
+        PackageId.assertFromString(id.packageId),
+        QualifiedName(
+          DottedName.assertFromString(id.moduleName),
+          DottedName.assertFromString(id.entityName))).toString())
   }
 
   private def fromTransactionId(triggerIds: TriggerIds, transactionId: String): SValue = {
@@ -143,6 +143,15 @@ object Converter {
     }
   }
 
+  private def fromTemplateTypeRep(triggerIds: TriggerIds, templateId: value.Identifier): SValue = {
+    val templateTypeRepTy = Identifier(
+      triggerIds.stdlibPackageId,
+      QualifiedName(
+        DottedName.assertFromString("DA.Internal.LF"),
+        DottedName.assertFromString("TemplateTypeRep")))
+    record(templateTypeRepTy, ("getTemplateTypeRep", fromIdentifier(templateId)))
+  }
+
   private def fromAnyContractId(
       triggerIds: TriggerIds,
       templateId: value.Identifier,
@@ -150,7 +159,7 @@ object Converter {
     val contractIdTy = triggerIds.getId("AnyContractId")
     record(
       contractIdTy,
-      ("templateId", fromIdentifier(triggerIds, templateId)),
+      ("templateId", fromTemplateTypeRep(triggerIds, templateId)),
       ("contractId", SText(contractId))
     )
   }
@@ -276,14 +285,7 @@ object Converter {
 
   private def toIdentifier(v: SValue): Either[String, Identifier] = {
     v match {
-      case SRecord(_, _, vals) => {
-        assert(vals.size == 3)
-        for {
-          packageId <- toText(vals.get(0)).flatMap(PackageId.fromString)
-          moduleName <- toText(vals.get(1)).flatMap(DottedName.fromString)
-          entityName <- toText(vals.get(2)).flatMap(DottedName.fromString)
-        } yield Identifier(packageId, QualifiedName(moduleName, entityName))
-      }
+      case SText(s) => Identifier.fromString(s)
       case _ => Left(s"Expected Identifier but got $v")
     }
   }
@@ -295,12 +297,22 @@ object Converter {
     }
   }
 
+  private def toTemplateTypeRep(v: SValue): Either[String, Identifier] = {
+    v match {
+      case SRecord(_, _, vals) => {
+        assert(vals.size == 1)
+        toIdentifier(vals.get(0))
+      }
+      case _ => Left(s"Expected TemplateTypeRep but got $v")
+    }
+  }
+
   private def toAnyContractId(v: SValue): Either[String, AnyContractId] = {
     v match {
       case SRecord(_, _, vals) => {
         assert(vals.size == 2)
         for {
-          templateId <- toIdentifier(vals.get(0))
+          templateId <- toTemplateTypeRep(vals.get(0))
           contractId <- toText(vals.get(1))
         } yield AnyContractId(templateId, contractId)
       }

triggers/tests/daml/ACS.daml

@@ -10,7 +10,7 @@ import qualified DA.TextMap as TM
 import Daml.Trigger.LowLevel
 
 data TriggerState = TriggerState
-  { activeAssets : TextMap Identifier
+  { activeAssets : TextMap TemplateTypeRep
   , successfulCompletions : Int
   , failedCompletions : Int
   , nextCommandId : Int
@@ -26,7 +26,7 @@ initState party (ActiveContracts events) = TriggerState
   , failedCompletions = 0
   }
   where
-    updateAcs : TextMap Identifier -> Created -> TextMap Identifier
+    updateAcs : TextMap TemplateTypeRep -> Created -> TextMap TemplateTypeRep
     updateAcs acs (Created _ cId argument)
       | Some Asset{} <- fromAnyTemplate @(Asset ()) argument = TM.insert cId.contractId cId.templateId acs
       | otherwise = acs
@@ -53,17 +53,16 @@ test = Trigger
         , [Commands (CommandId $ "command_" <> show state.nextCommandId) cmds]
         )
       where
-        updateEvent : ([Command], TextMap Identifier) -> Event -> ([Command], TextMap Identifier)
+        updateEvent : ([Command], TextMap TemplateTypeRep) -> Event -> ([Command], TextMap TemplateTypeRep)
         updateEvent (cmds, acs) ev = case ev of
-          CreatedEvent (Created _ cId argument)
-            | Some (Asset {issuer}) <- fromAnyTemplate @(Asset ()) argument ->
+          CreatedEvent (fromCreated -> Some (_, assetId, Asset {issuer} : Asset ())) ->
             let proposeMirror : Command = createCmd (AssetMirrorProposal { issuer })
-            in (proposeMirror :: cmds, TM.insert cId.contractId cId.templateId acs)
-            | Some (AssetMirrorProposal {}) <- fromAnyTemplate argument ->
-            let accept : Command = exerciseCmd @AssetMirrorProposal cId Accept
+            in (proposeMirror :: cmds, TM.insert assetId.contractId (templateTypeRep @(Asset ())) acs)
+          CreatedEvent (fromCreated -> Some (_, proposalId, AssetMirrorProposal {})) ->
+            let accept : Command = exerciseCmd proposalId Accept
             in (accept :: cmds, acs)
-          ArchivedEvent (Archived _ cId)
-            | cId.templateId.entityName == "AssetUnit" -> (cmds, TM.delete cId.contractId acs)
+          ArchivedEvent (fromArchived @(Asset ()) -> Some (_, assetId)) ->
+            (cmds, TM.delete assetId.contractId acs)
           _ -> (cmds, acs)
 
 -- This is only a generic template to test that we do the conversion properly.

triggers/tests/daml/Retry.daml

@@ -45,9 +45,10 @@ toCreate : Template t => Command -> Optional t
 toCreate (CreateCommand t) = fromAnyTemplate t
 toCreate ExerciseCommand {} = None
 
-toExercise : Command -> Optional (AnyContractId, C)
+toExercise : Command -> Optional (AbsoluteContractId T, C)
 toExercise CreateCommand {} = None
-toExercise (ExerciseCommand cid choice) = fmap (cid,) $ fromAnyChoice @T choice
+toExercise (ExerciseCommand cid choice) =
+  liftA2 (,) (fromAnyContractId cid) (fromAnyChoice @T choice)
 
 template T
   with