interfaces: Preserve/provide by_interface data for create actions. (#…

…11639)

* interfaces: Preserve by_interface data for create.

Part of #10915

This was a lot more involved than fetch or exercise. The first issue is
that we need to preserve the interface id into speedy, so it needs a
separate primitive ("experimental" won't cut it). Second, because
speedy's create requires the template definition, and now the interface
id as well, we basically need to compile a separate version of "create"
for each interface that a template implements, hence the separate
`CreateByInterfaceDefRef(templateId, ifaceId)`.

changelog_begin
changelog_end

* scalafmt and refactoring

* fixx merge conflict

* fix silly mistakes

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Alpha.hs

@@ -299,6 +299,10 @@ alphaUpdate env = \case
         UCreate t2 e2 -> alphaTypeCon t1 t2
             && alphaExpr' env e1 e2
         _ -> False
+    UCreateInterface t1 e1 -> \case
+        UCreateInterface t2 e2 -> alphaTypeCon t1 t2
+            && alphaExpr' env e1 e2
+        _ -> False
     UExercise t1 c1 e1a e1b -> \case
         UExercise t2 c2 e2a e2b -> alphaTypeCon t1 t2
             && c1 == c2

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Base.hs

@@ -654,6 +654,14 @@ data Update
     , creArg      :: !Expr
       -- ^ Argument for the contract template.
     }
+  -- | Create contract instance based on interface payload.
+  | UCreateInterface
+    { creInterface :: !(Qualified TypeConName)
+      -- ^ Interface type.
+    , creArg :: !Expr
+      -- ^ Payload expression.
+    }
+
   -- | Exercise choice on a contract given a contract ID.
   | UExercise
     { exeTemplate   :: !(Qualified TypeConName)

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/FreeVars.hs

@@ -135,6 +135,7 @@ freeVarsStep = \case
         UPureF t e -> freeVarsInType t <> e
         UBindF b e -> goBinding b e
         UCreateF _ e -> e
+        UCreateInterfaceF _ e -> e
         UExerciseF _ _ e1 e2 -> e1 <> e2
         UExerciseInterfaceF _ _ e1 e2 -> e1 <> e2
         UExerciseByKeyF _ _ e1 e2 -> e1 <> e2

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Pretty.hs

@@ -412,6 +412,8 @@ instance Pretty Update where
           $$ keyword_ "in" <-> pPrintPrec lvl precELam body
     UCreate tpl arg ->
       pPrintAppKeyword lvl prec "create" [tplArg tpl, TmArg arg]
+    UCreateInterface interface arg ->
+      pPrintAppKeyword lvl prec "create_interface" [interfaceArg interface, TmArg arg]
     UExercise tpl choice cid arg ->
       -- NOTE(MH): Converting the choice name into a variable is a bit of a hack.
       pPrintAppKeyword lvl prec "exercise"

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Recursive.hs

@@ -63,6 +63,7 @@ data UpdateF expr
   = UPureF     !Type !expr
   | UBindF     !(BindingF expr) !expr
   | UCreateF   !(Qualified TypeConName) !expr
+  | UCreateInterfaceF !(Qualified TypeConName) !expr
   | UExerciseF !(Qualified TypeConName) !ChoiceName !expr !expr
   | UExerciseInterfaceF !(Qualified TypeConName) !ChoiceName !expr !expr
   | UExerciseByKeyF !(Qualified TypeConName) !ChoiceName !expr !expr
@@ -111,6 +112,7 @@ projectUpdate = \case
   UPure a b -> UPureF a b
   UBind a b -> UBindF (projectBinding a) b
   UCreate a b -> UCreateF a b
+  UCreateInterface a b -> UCreateInterfaceF a b
   UExercise a b c d -> UExerciseF a b c d
   UExerciseInterface a b c d -> UExerciseInterfaceF a b c d
   UExerciseByKey a b c d -> UExerciseByKeyF a b c d
@@ -130,6 +132,7 @@ embedUpdate = \case
   UPureF a b -> UPure a b
   UBindF a b -> UBind (embedBinding a) b
   UCreateF a b -> UCreate a b
+  UCreateInterfaceF a b -> UCreateInterface a b
   UExerciseF a b c d -> UExercise a b c d
   UExerciseInterfaceF a b c d -> UExerciseInterface a b c d
   UExerciseByKeyF a b c d -> UExerciseByKey a b c d

compiler/daml-lf-ast/src/DA/Daml/LF/Ast/Subst.hs

@@ -244,6 +244,9 @@ applySubstInUpdate subst = \case
     UCreate templateName e -> UCreate
         templateName
         (applySubstInExpr subst e)
+    UCreateInterface interface e -> UCreateInterface
+        interface
+        (applySubstInExpr subst e)
     UExercise templateName choiceName e1 e2 -> UExercise
         templateName
         choiceName

compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/DecodeV1.hs

@@ -681,6 +681,10 @@ decodeUpdate LF1.Update{..} = mayDecode "updateSum" updateSum $ \case
     fmap EUpdate $ UCreate
       <$> mayDecode "update_CreateTemplate" mbTycon decodeTypeConName
       <*> mayDecode "update_CreateExpr" mbExpr decodeExpr
+  LF1.UpdateSumCreateInterface (LF1.Update_CreateInterface mbTycon mbExpr) ->
+    fmap EUpdate $ UCreateInterface
+      <$> mayDecode "update_CreateInterfaceInterface" mbTycon decodeTypeConName
+      <*> mayDecode "update_CreateInterfaceExpr" mbExpr decodeExpr
   LF1.UpdateSumExercise LF1.Update_Exercise{..} ->
     fmap EUpdate $ UExercise
       <$> mayDecode "update_ExerciseTemplate" update_ExerciseTemplate decodeTypeConName

compiler/daml-lf-proto/src/DA/Daml/LF/Proto3/EncodeV1.hs

@@ -746,6 +746,10 @@ encodeUpdate = fmap (P.Update . Just) . \case
         update_CreateTemplate <- encodeQualTypeConName creTemplate
         update_CreateExpr <- encodeExpr creArg
         pure $ P.UpdateSumCreate P.Update_Create{..}
+    UCreateInterface{..} -> do
+        update_CreateInterfaceInterface <- encodeQualTypeConName creInterface
+        update_CreateInterfaceExpr <- encodeExpr creArg
+        pure $ P.UpdateSumCreateInterface P.Update_CreateInterface{..}
     UExercise{..} -> do
         update_ExerciseTemplate <- encodeQualTypeConName exeTemplate
         update_ExerciseChoice <- encodeName unChoiceName exeChoice

compiler/daml-lf-tools/src/DA/Daml/LF/TypeChecker/Check.hs

@@ -584,6 +584,11 @@ checkCreate tpl arg = do
   _ :: Template <- inWorld (lookupTemplate tpl)
   checkExpr arg (TCon tpl)
 
+checkCreateInterface :: MonadGamma m => Qualified TypeConName -> Expr -> m ()
+checkCreateInterface iface arg = do
+  _ :: DefInterface <- inWorld (lookupInterface iface)
+  checkExpr arg (TCon iface)
+
 typeOfExercise :: MonadGamma m =>
   Qualified TypeConName -> ChoiceName -> Expr -> Expr -> m Type
 typeOfExercise tpl chName cid arg = do
@@ -645,6 +650,7 @@ typeOfUpdate = \case
   UPure typ expr -> checkPure typ expr $> TUpdate typ
   UBind binding body -> typeOfBind binding body
   UCreate tpl arg -> checkCreate tpl arg $> TUpdate (TContractId (TCon tpl))
+  UCreateInterface iface arg -> checkCreateInterface iface arg $> TUpdate (TContractId (TCon iface))
   UExercise tpl choice cid arg -> typeOfExercise tpl choice cid arg
   UExerciseInterface tpl choice cid arg -> typeOfExerciseInterface tpl choice cid arg
   UExerciseByKey tpl choice key arg -> typeOfExerciseByKey tpl choice key arg

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

@@ -311,6 +311,11 @@ convertPrim _ "UCreate" (TCon template :-> TUpdate (TContractId (TCon template')
     ETmLam (mkVar "this", TCon template) $
     EUpdate $ UCreate template (EVar (mkVar "this"))
 
+convertPrim _ "UCreateInterface" (TCon interface :-> TUpdate (TContractId (TCon interface')))
+    | interface == interface' =
+    ETmLam (mkVar "this", TCon interface) $
+    EUpdate $ UCreateInterface interface (EVar (mkVar "this"))
+
 convertPrim _ "UFetch" (TContractId (TCon template) :-> TUpdate (TCon template'))
     | template == template' =
     ETmLam (mkVar "this", TContractId (TCon template)) $
@@ -415,13 +420,6 @@ convertPrim version "EToAnyContractKey"
         ETmLam (mkVar "key", key) $
         EToAny key (EVar $ mkVar "key")
 
-convertPrim _ "UCreateInterface" (TCon interface :-> TUpdate (TContractId (TCon interface')))
-    | interface == interface' =
-    ETmLam (mkVar "this", TCon interface) $
-    EExperimental "RESOLVE_VIRTUAL_CREATE"
-        (TCon interface :-> TCon interface :-> TUpdate (TContractId (TCon interface)))
-        `ETmApp` EVar (mkVar "this") `ETmApp` EVar (mkVar "this")
-
 convertPrim _ "ESignatoryInterface" (TCon interface :-> TList TParty) =
     ETmLam (mkVar "this", TCon interface) $
     EExperimental "RESOLVE_VIRTUAL_SIGNATORIES"

compiler/damlc/daml-visual/src/DA/Daml/Visual.hs

@@ -136,6 +136,8 @@ startFromUpdate seen world update = case update of
     LF.UGetTime -> Set.empty
     LF.UEmbedExpr _ upEx -> startFromExpr seen world upEx
     LF.UCreate tpl _ -> Set.singleton (ACreate tpl)
+    LF.UCreateInterface{} ->
+      error "Interfaces are not supported"
     LF.UExercise tpl choice _ _ -> Set.singleton (AExercise tpl choice)
     LF.UExerciseInterface{} ->
       -- TODO https://github.com/digital-asset/daml/issues/10810

daml-lf/archive/src/main/protobuf/com/daml/daml_lf_dev/daml_lf_1.proto

@@ -1187,6 +1187,14 @@ message Update {
     Expr expr = 2;
   }
 
+  // Interface Create Update
+  message CreateInterface {
+    // Interface type
+    TypeConName interface = 1;
+    // Interface argument
+    Expr expr = 2;
+  }
+
   // Exercise Update
   message Exercise {
     // Template type
@@ -1293,6 +1301,7 @@ message Update {
     TryCatch try_catch = 11; // *Available in versions >= 1.14*
     ExerciseInterface exercise_interface = 12; // *Available in versions >= 1.dev*
     FetchInterface fetch_interface = 13; // *Available in versions >= 1.dev*
+    CreateInterface create_interface = 14; // *Available in versions >= 1.dev*
   }
 }
 

daml-lf/archive/src/main/scala/com/digitalasset/daml/lf/archive/DecodeV1.scala

@@ -1281,6 +1281,13 @@ private[archive] class DecodeV1(minor: LV.Minor) {
             arg = decodeExpr(create.getExpr, definition),
           )
 
+        case PLF.Update.SumCase.CREATE_INTERFACE =>
+          val create = lfUpdate.getCreateInterface
+          UpdateCreateInterface(
+            interface = decodeTypeConName(create.getInterface),
+            arg = decodeExpr(create.getExpr, definition),
+          )
+
         case PLF.Update.SumCase.EXERCISE =>
           val exercise = lfUpdate.getExercise
           UpdateExercise(

daml-lf/encoder/src/main/scala/com/digitalasset/daml/lf/archive/testing/EncodeV1.scala

@@ -363,6 +363,10 @@ private[daml] class EncodeV1(minor: LV.Minor) {
           )
         case UpdateCreate(templateId, arg) =>
           builder.setCreate(PLF.Update.Create.newBuilder().setTemplate(templateId).setExpr(arg))
+        case UpdateCreateInterface(interface, arg) =>
+          builder.setCreateInterface(
+            PLF.Update.CreateInterface.newBuilder().setInterface(interface).setExpr(arg)
+          )
         case UpdateFetch(templateId, contractId) =>
           builder.setFetch(PLF.Update.Fetch.newBuilder().setTemplate(templateId).setCid(contractId))
         case UpdateFetchInterface(interface, contractId) =>

daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Compiler.scala

@@ -375,6 +375,7 @@ private[lf] final class Compiler(
       addDef(compileSignatories(identifier, tmpl))
       addDef(compileObservers(identifier, tmpl))
       tmpl.implements.values.foreach { impl =>
+        addDef(compileCreateByInterface(identifier, tmpl, impl.interface))
         addDef(compileImplements(identifier, impl.interface))
         impl.methods.values.foreach(method =>
           addDef(compileImplementsMethod(identifier, impl.interface, method))
@@ -392,6 +393,7 @@ private[lf] final class Compiler(
 
     module.interfaces.foreach { case (ifaceName, iface) =>
       val identifier = Identifier(pkgId, QualifiedName(module.name, ifaceName))
+      addDef(compileCreateInterface(identifier))
       addDef(compileFetchInterface(identifier))
       iface.fixedChoices.values.foreach(
         builder += compileFixedChoice(identifier, iface.param, _)
@@ -850,6 +852,8 @@ private[lf] final class Compiler(
         compileEmbedExpr(env, e)
       case UpdateCreate(tmplId, arg) =>
         t.CreateDefRef(tmplId)(compile(env, arg))
+      case UpdateCreateInterface(iface, arg) =>
+        t.CreateDefRef(iface)(compile(env, arg))
       case UpdateExercise(tmplId, chId, cidE, argE) =>
         t.ChoiceDefRef(tmplId, chId)(compile(env, cidE), compile(env, argE))
       case UpdateExerciseInterface(ifaceId, chId, cidE, argE) =>
@@ -1549,33 +1553,66 @@ private[lf] final class Compiler(
     ref -> SDefinition(withLabelT(ref, unsafeCompile(method.value)))
   }
 
-  private[this] def compileCreate(
+  private[this] def compileCreateBody(
       tmplId: Identifier,
       tmpl: Template,
-  ): (t.SDefinitionRef, SDefinition) = {
+      byInterface: Option[Identifier],
+      tmplArgPos: Position,
+      env: Env,
+  ) = {
     val precondsArray =
       (Iterator(tmpl.precond) ++ (tmpl.implements.iterator.map(impl => impl._2.precond)))
         .to(ImmArray)
     val preconds = ECons(TBuiltin(BTBool), precondsArray, ENil(TBuiltin(BTBool)))
+    val env2 = env.bindExprVar(tmpl.param, tmplArgPos)
+    // We check precondition in a separated builtin to prevent
+    // further evaluation of agreement, signatories, observers and key
+    // in case of failed precondition.
+    let(env2, SBCheckPrecond(tmplId)(env2.toSEVar(tmplArgPos), compile(env2, preconds))) {
+      (_, env) =>
+        SBUCreate(tmplId, byInterface)(
+          env.toSEVar(tmplArgPos),
+          compile(env, tmpl.agreementText),
+          compile(env, tmpl.signatories),
+          compile(env, tmpl.observers),
+          compileKeyWithMaintainers(env, tmpl.key),
+        )
+    }
+  }
+
+  private[this] def compileCreate(
+      tmplId: Identifier,
+      tmpl: Template,
+  ): (t.SDefinitionRef, SDefinition) = {
     // Translates 'create Foo with <params>' into:
     // CreateDefRef(tmplId) = \ <tmplArg> <token> ->
     //   let _ = $checkPrecond(tmplId)(<tmplArg> [tmpl.precond ++ [precond | precond <- tmpl.implements]]
     //   in $create <tmplArg> [tmpl.agreementText] [tmpl.signatories] [tmpl.observers] [tmpl.key]
-    topLevelFunction2(t.CreateDefRef(tmplId)) { (tmplArgPos, _, _env) =>
-      val env = _env.bindExprVar(tmpl.param, tmplArgPos)
-      // We check precondition in a separated builtin to prevent
-      // further evaluation of agreement, signatories, observers and key
-      // in case of failed precondition.
-      let(env, SBCheckPrecond(tmplId)(env.toSEVar(tmplArgPos), compile(env, preconds))) {
-        (_, env) =>
-          SBUCreate(tmplId)(
-            env.toSEVar(tmplArgPos),
-            compile(env, tmpl.agreementText),
-            compile(env, tmpl.signatories),
-            compile(env, tmpl.observers),
-            compileKeyWithMaintainers(env, tmpl.key),
-          )
-      }
+    topLevelFunction2(t.CreateDefRef(tmplId))((tmplArgPos, _, env) =>
+      compileCreateBody(tmplId, tmpl, None, tmplArgPos, env)
+    )
+  }
+
+  private[this] def compileCreateByInterface(
+      tmplId: Identifier,
+      tmpl: Template,
+      ifaceId: Identifier,
+  ): (t.SDefinitionRef, SDefinition) = {
+    // Similar to compileCreate, but sets the 'byInterface' field in the transaction.
+    topLevelFunction2(t.CreateByInterfaceDefRef(tmplId, ifaceId))((tmplArgPos, _, env) =>
+      compileCreateBody(tmplId, tmpl, Some(ifaceId), tmplArgPos, env)
+    )
+  }
+
+  private[this] def compileCreateInterface(
+      ifaceId: Identifier
+  ): (t.SDefinitionRef, SDefinition) = {
+    topLevelFunction2(t.CreateDefRef(ifaceId)) { (tmplArgPos, tokenPos, env) =>
+      SBResolveCreateByInterface(ifaceId)(
+        env.toSEVar(tmplArgPos),
+        env.toSEVar(tmplArgPos),
+        env.toSEVar(tokenPos),
+      )
     }
   }
 

daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Pretty.scala

@@ -452,8 +452,12 @@ private[lf] object Pretty {
               ) + char(
                 ']'
               )
-            case SBUCreate(ref) =>
+            case SBUCreate(ref, None) =>
               text("$create") + char('[') + text(ref.qualifiedName.toString) + char(']')
+            case SBUCreate(ref, Some(iface)) =>
+              text("$createByInterface") + char('[') + text(ref.qualifiedName.toString) + char(
+                ','
+              ) + text(iface.qualifiedName.toString) + char(']')
             case SBUFetch(ref) =>
               text("$fetch") + char('[') + text(ref.qualifiedName.toString) + char(']')
             case SBGetTime => text("$getTime")

daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/Profile.scala

@@ -238,6 +238,7 @@ object Profile {
       implicit val anonClosure: Allowed[AnonymousClosure.type] = allowAll
       implicit val lfDefRef: Allowed[LfDefRef] = allowAll
       implicit val createDefRef: Allowed[CreateDefRef] = allowAll
+      implicit val createByInterfaceDefRef: Allowed[CreateByInterfaceDefRef] = allowAll
       implicit val keyDefRef: Allowed[KeyDefRef] = allowAll
       implicit val signatoriesDefRef: Allowed[SignatoriesDefRef] = allowAll
       implicit val observersDefRef: Allowed[ObserversDefRef] = allowAll
@@ -262,6 +263,8 @@ object Profile {
           case AnonymousClosure => "<lambda>"
           case LfDefRef(ref) => ref.qualifiedName.toString()
           case CreateDefRef(tmplRef) => s"create @${tmplRef.qualifiedName}"
+          case CreateByInterfaceDefRef(tmplRef, iface) =>
+            s"creatByInterface @${tmplRef.qualifiedName} @${iface.qualifiedName}"
           case KeyDefRef(tmplRef) => s"keyAndMaintainers @${tmplRef.qualifiedName}"
           case SignatoriesDefRef(tmplRef) => s"signatories @${tmplRef.qualifiedName}"
           case ObserversDefRef(tmplRef) => s"observers @${tmplRef.qualifiedName}"

daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SBuiltin.scala

@@ -923,7 +923,8 @@ private[lf] object SBuiltin {
     *    -> Optional {key: key, maintainers: List Party} (template key, if present)
     *    -> ContractId arg
     */
-  final case class SBUCreate(templateId: TypeConName) extends OnLedgerBuiltin(5) {
+  final case class SBUCreate(templateId: TypeConName, byInterface: Option[TypeConName])
+      extends OnLedgerBuiltin(5) {
     override protected def execute(
         args: util.ArrayList[SValue],
         machine: Machine,
@@ -957,7 +958,7 @@ private[lf] object SBuiltin {
           signatories = sigs,
           stakeholders = sigs union obs,
           key = mbKey,
-          byInterface = None, // TODO https://github.com/digital-asset/daml/issues/10915
+          byInterface = byInterface,
         )
 
       machine.addLocalContract(coid, templateId, createArg, sigs, obs, mbKey)
@@ -1184,6 +1185,9 @@ private[lf] object SBuiltin {
       machine.ctrl = SEVal(toDef(getSRecord(args, 0).id))
   }
 
+  final case class SBResolveCreateByInterface(ifaceId: TypeConName)
+      extends SBResolveVirtual(ref => CreateByInterfaceDefRef(ref, ifaceId))
+
   // Convert an interface to a given template type if possible. Since interfaces have the
   // same representation as the underlying template, we only need to perform a check
   // that the record type matches the template type.

daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SExpr.scala

@@ -405,6 +405,8 @@ object SExpr {
   final case class ChoiceByKeyDefRef(ref: DefinitionRef, choiceName: ChoiceName)
       extends SDefinitionRef
   final case class CreateDefRef(ref: DefinitionRef) extends SDefinitionRef
+  final case class CreateByInterfaceDefRef(ref: DefinitionRef, iface: TypeConName)
+      extends SDefinitionRef
   final case class FetchDefRef(ref: DefinitionRef) extends SDefinitionRef
   final case class FetchByKeyDefRef(ref: DefinitionRef) extends SDefinitionRef
   final case class LookupByKeyDefRef(ref: DefinitionRef) extends SDefinitionRef

daml-lf/language/src/main/scala/com/digitalasset/daml/lf/language/Ast.scala

@@ -487,6 +487,7 @@ object Ast {
   final case class UpdatePure(t: Type, expr: Expr) extends Update
   final case class UpdateBlock(bindings: ImmArray[Binding], body: Expr) extends Update
   final case class UpdateCreate(templateId: TypeConName, arg: Expr) extends Update
+  final case class UpdateCreateInterface(interface: TypeConName, arg: Expr) extends Update
   final case class UpdateFetch(templateId: TypeConName, contractId: Expr) extends Update
   final case class UpdateFetchInterface(interface: TypeConName, contractId: Expr) extends Update
   final case class UpdateExercise(

daml-lf/parser/src/main/scala/com/digitalasset/daml/lf/testing/parser/AstRewriter.scala

@@ -158,6 +158,8 @@ private[daml] class AstRewriter(
         UpdateBlock(bindings.map(apply), apply(body))
       case UpdateCreate(templateId, arg) =>
         UpdateCreate(apply(templateId), apply(arg))
+      case UpdateCreateInterface(interface, arg) =>
+        UpdateCreateInterface(apply(interface), apply(arg))
       case UpdateFetch(templateId, contractId) =>
         UpdateFetch(apply(templateId), apply(contractId))
       case UpdateFetchInterface(interface, contractId) =>