mirror of
https://github.com/digital-asset/daml.git
synced 2024-11-10 00:35:25 +03:00
choice observers, prep (#7548)
* choice observers, WIP changelog_begin changelog_end fix generator driven test Node.isReplayedBy, consider observers add observers to NodeExercise in transaction.proto add observers to TemplateChoice in Ast.scala add observers to LF .proto, and Haskell Ast for TemplateChoice reinstate trailing // for better format fix validate tests fix haskell LF decoder when choice-observers field is missing in .proto fix build make choice-observers optional in scala AST make choice-observers optional in Haskell Ast address comments from Remy and Martin more review comments check TransactionVersions.minChoiceObservers in Transaction encode/decode featureChoiceObservers, and check in haskell type-checker improve speedy Compiler for empty choice-observers extend scala LF decoder for optional choice observers extend scala parser for choices to allow optional choice-observers clause, and test rename new field in scala Ast -> "choiceObservers" var rename extend TypingSpec tests for choice-observers. also add missing negative test for controllers switch from keyword "ob" to identifier "observers" in scala parser choice syntax add TODO for featureChoiceObservers to be part of DAML 1.9 (issue 7139) * replace "NICK" comment markers with "FIXME #7709" comment markers
This commit is contained in:
parent
5f8c3a2dcc
commit
fd5db0cfd7
@ -810,6 +810,8 @@ data TemplateChoice = TemplateChoice
|
||||
, chcControllers :: !Expr
|
||||
-- ^ The controllers of the choice. They have type @List Party@ and the
|
||||
-- template parameter in scope, and (since 1.2) also the choice parameter.
|
||||
, chcObservers :: !(Maybe Expr)
|
||||
-- ^ The observers of the choice. When they are present, they have type @List Party@.
|
||||
, chcSelfBinder :: !ExprVarName
|
||||
-- ^ Variable to bind the ContractId of the contract this choice is
|
||||
-- exercised on to.
|
||||
|
@ -57,9 +57,10 @@ _PRSelfModule modName = prism (Qualified PRSelf modName) $ \case
|
||||
q -> Left q
|
||||
|
||||
templateChoiceExpr :: Traversal' TemplateChoice Expr
|
||||
templateChoiceExpr f (TemplateChoice loc name consuming actor selfBinder argBinder typ update) =
|
||||
templateChoiceExpr f (TemplateChoice loc name consuming controllers observers selfBinder argBinder typ update) =
|
||||
TemplateChoice loc name consuming
|
||||
<$> f actor
|
||||
<$> f controllers
|
||||
<*> traverse f observers
|
||||
<*> pure selfBinder
|
||||
<*> pure argBinder
|
||||
<*> pure typ
|
||||
|
@ -534,7 +534,7 @@ instance Pretty DefValue where
|
||||
|
||||
pPrintTemplateChoice ::
|
||||
PrettyLevel -> ModuleName -> TypeConName -> TemplateChoice -> Doc ann
|
||||
pPrintTemplateChoice lvl modName tpl (TemplateChoice mbLoc name isConsuming controller selfBinder argBinder retType update) =
|
||||
pPrintTemplateChoice lvl modName tpl (TemplateChoice mbLoc name isConsuming controllers observers selfBinder argBinder retType update) =
|
||||
withSourceLoc lvl mbLoc $
|
||||
vcat
|
||||
[ hsep
|
||||
@ -545,7 +545,8 @@ pPrintTemplateChoice lvl modName tpl (TemplateChoice mbLoc name isConsuming cont
|
||||
, pPrintAndType lvl precParam argBinder
|
||||
, if levelHasTypes lvl then docHasType <-> pPrintPrec lvl 0 retType else empty
|
||||
]
|
||||
, nest 2 (keyword_ "controller" <-> pPrintPrec lvl 0 controller)
|
||||
, nest 2 (keyword_ "controller" <-> pPrintPrec lvl 0 controllers)
|
||||
, nest 2 (keyword_ "observer" <-> pPrintPrec lvl 0 observers)
|
||||
, nest 2 (keyword_ "do" <-> pPrintPrec lvl 0 update)
|
||||
]
|
||||
|
||||
|
@ -127,6 +127,14 @@ featureToTextContractId = Feature
|
||||
, featureCppFlag = "DAML_TO_TEXT_CONTRACT_ID"
|
||||
}
|
||||
|
||||
featureChoiceObservers :: Feature -- issue #7709
|
||||
featureChoiceObservers = Feature
|
||||
{ featureName = "Choice observers"
|
||||
-- TODO Change as part of #7139
|
||||
, featureMinVersion = versionDev
|
||||
, featureCppFlag = "DAML_CHOICE_OBSERVERS"
|
||||
}
|
||||
|
||||
allFeatures :: [Feature]
|
||||
allFeatures =
|
||||
[ featureNumeric
|
||||
@ -139,6 +147,7 @@ allFeatures =
|
||||
, featurePackageMetadata
|
||||
, featureUnstable
|
||||
, featureToTextContractId
|
||||
, featureChoiceObservers
|
||||
]
|
||||
|
||||
allFeaturesForVersion :: Version -> [Feature]
|
||||
|
@ -319,6 +319,7 @@ decodeChoice LF1.TemplateChoice{..} =
|
||||
<*> decodeName ChoiceName templateChoiceName
|
||||
<*> pure templateChoiceConsuming
|
||||
<*> mayDecode "templateChoiceControllers" templateChoiceControllers decodeExpr
|
||||
<*> traverse decodeExpr templateChoiceObservers
|
||||
<*> decodeName ExprVarName templateChoiceSelfBinder
|
||||
<*> mayDecode "templateChoiceArgBinder" templateChoiceArgBinder decodeVarWithType
|
||||
<*> mayDecode "templateChoiceRetType" templateChoiceRetType decodeType
|
||||
|
@ -812,6 +812,7 @@ encodeTemplateChoice TemplateChoice{..} = do
|
||||
templateChoiceName <- encodeName unChoiceName chcName
|
||||
let templateChoiceConsuming = chcConsuming
|
||||
templateChoiceControllers <- encodeExpr chcControllers
|
||||
templateChoiceObservers <- traverse encodeExpr' chcObservers
|
||||
templateChoiceSelfBinder <- encodeName unExprVarName chcSelfBinder
|
||||
templateChoiceArgBinder <- Just <$> encodeExprVarWithType chcArgBinder
|
||||
templateChoiceRetType <- encodeType chcReturnType
|
||||
|
@ -656,10 +656,14 @@ checkDefValue (DefValue _loc (_, typ) _noParties (IsTest isTest) expr) = do
|
||||
_ -> throwWithContext (EExpectedScenarioType typ)
|
||||
|
||||
checkTemplateChoice :: MonadGamma m => Qualified TypeConName -> TemplateChoice -> m ()
|
||||
checkTemplateChoice tpl (TemplateChoice _loc _ _ actors selfBinder (param, paramType) retType upd) = do
|
||||
checkTemplateChoice tpl (TemplateChoice _loc _ _ controllers mbObservers selfBinder (param, paramType) retType upd) = do
|
||||
checkType paramType KStar
|
||||
checkType retType KStar
|
||||
introExprVar param paramType $ checkExpr actors (TList TParty)
|
||||
introExprVar param paramType $ checkExpr controllers (TList TParty)
|
||||
introExprVar param paramType $ do
|
||||
whenJust mbObservers $ \observers -> do
|
||||
_checkFeature featureChoiceObservers
|
||||
checkExpr observers (TList TParty)
|
||||
introExprVar selfBinder (TContractId (TCon tpl)) $ introExprVar param paramType $
|
||||
checkExpr upd (TUpdate retType)
|
||||
|
||||
|
@ -219,7 +219,7 @@ genTemplate pac mod Template{..} = do
|
||||
where
|
||||
archive :: TemplateChoice
|
||||
archive = TemplateChoice Nothing (ChoiceName "Archive") True
|
||||
(ENil (TBuiltin BTParty)) (ExprVarName "self")
|
||||
(ENil (TBuiltin BTParty)) Nothing (ExprVarName "self")
|
||||
(ExprVarName "arg", TStruct []) (TBuiltin BTUnit)
|
||||
(EUpdate $ UPure (TBuiltin BTUnit) (EBuiltin BEUnit))
|
||||
|
||||
|
@ -692,6 +692,7 @@ convertChoice env tbinds (ChoiceData ty expr)
|
||||
, chcName = choiceName
|
||||
, chcConsuming = consuming == Consuming
|
||||
, chcControllers = controllers `ETmApp` EVar this `ETmApp` EVar arg
|
||||
, chcObservers = Nothing -- FIXME #7709, need syntax for non-empty choice-observers
|
||||
, chcSelfBinder = self
|
||||
, chcArgBinder = (arg, choiceTy)
|
||||
, chcReturnType = choiceRetTy
|
||||
|
@ -67,6 +67,7 @@ main = do
|
||||
, chcName = ChoiceName "NotChoice"
|
||||
, chcConsuming = True
|
||||
, chcControllers = tplParties
|
||||
, chcObservers = Nothing
|
||||
, chcSelfBinder = ExprVarName "this"
|
||||
, chcArgBinder = (ExprVarName "self", TCon (modRef (dataTypeCon chcArg)))
|
||||
, chcReturnType = TUnit
|
||||
@ -77,6 +78,7 @@ main = do
|
||||
, chcName = ChoiceName "Choice2"
|
||||
, chcConsuming = True
|
||||
, chcControllers = tplParties
|
||||
, chcObservers = Nothing
|
||||
, chcSelfBinder = ExprVarName "this"
|
||||
, chcArgBinder = (ExprVarName "self", TCon (modRef (dataTypeCon chcArg2)))
|
||||
, chcReturnType = TUnit
|
||||
@ -87,6 +89,7 @@ main = do
|
||||
, chcName = ChoiceName "Archive"
|
||||
, chcConsuming = True
|
||||
, chcControllers = tplParties
|
||||
, chcObservers = Nothing
|
||||
, chcSelfBinder = ExprVarName "this"
|
||||
, chcArgBinder = (ExprVarName "self", TCon (modRef (dataTypeCon emptyRec)))
|
||||
, chcReturnType = TUnit
|
||||
|
@ -45,6 +45,7 @@
|
||||
// 2019-12-03: Add (experimental) text primitives.
|
||||
// 2019-12-05: Add Generic Equality builtin
|
||||
// 2019-13-10: Add ExerciseByKey Update
|
||||
// 2020-10-??: Add choice-observers
|
||||
|
||||
syntax = "proto3";
|
||||
package daml_lf_1;
|
||||
@ -1210,6 +1211,9 @@ message TemplateChoice {
|
||||
// conjunctive choice controllers).
|
||||
Expr controllers = 3;
|
||||
|
||||
// The additional informees of the choice. They have type `List Party`.
|
||||
Expr observers = 11; // *Available in versions >= 1.dev*
|
||||
|
||||
// Name to which the choice argument is bound and its type.
|
||||
VarWithType arg_binder = 4;
|
||||
|
||||
|
@ -552,6 +552,10 @@ private[archive] class DecodeV1(minor: LV.Minor) extends Decode.OfPackage[PLF.Pa
|
||||
name = chName,
|
||||
consuming = lfChoice.getConsuming,
|
||||
controllers = decodeExpr(lfChoice.getControllers, s"$tpl:$chName:controller"),
|
||||
choiceObservers =
|
||||
if (lfChoice.hasObservers)
|
||||
Some(decodeExpr(lfChoice.getObservers, s"$tpl:$chName:observers"))
|
||||
else None,
|
||||
selfBinder = selfBinder,
|
||||
argBinder = v -> t,
|
||||
returnType = decodeType(lfChoice.getRetType),
|
||||
|
@ -155,6 +155,7 @@ private[engine] final class Preprocessor(compiledPackages: MutableCompiledPackag
|
||||
chosenVal @ _,
|
||||
stakeholders @ _,
|
||||
signatories @ _,
|
||||
choiceObservers @ _,
|
||||
controllersDifferFromActors @ _,
|
||||
children @ _,
|
||||
exerciseResult @ _,
|
||||
|
@ -55,6 +55,7 @@ private[preprocessing] final class TransactionPreprocessor(
|
||||
chosenVal,
|
||||
stakeholders @ _,
|
||||
signatories @ _,
|
||||
choiceObservers @ _,
|
||||
controllersDifferFromActors @ _,
|
||||
children @ _,
|
||||
exerciseResult @ _,
|
||||
|
@ -1063,6 +1063,7 @@ class EngineTest
|
||||
_,
|
||||
_,
|
||||
_,
|
||||
_,
|
||||
children,
|
||||
_,
|
||||
_,
|
||||
@ -1661,7 +1662,7 @@ class EngineTest
|
||||
"be partially reinterpretable" in {
|
||||
val Right((tx, txMeta)) = run(3)
|
||||
val ImmArray(_, exeNode1) = tx.transaction.roots
|
||||
val Node.NodeExercises(_, _, _, _, _, _, _, _, _, _, children, _, _, _) =
|
||||
val Node.NodeExercises(_, _, _, _, _, _, _, _, _, _, _, children, _, _, _) =
|
||||
tx.transaction.nodes(exeNode1)
|
||||
val nids = children.toSeq.take(2).toImmArray
|
||||
|
||||
@ -1965,6 +1966,7 @@ object EngineTest {
|
||||
_,
|
||||
_,
|
||||
_,
|
||||
_,
|
||||
_))) =>
|
||||
(contracts - targetCoid, keys)
|
||||
case (
|
||||
|
@ -898,6 +898,12 @@ private[lf] final class Compiler(
|
||||
{
|
||||
addExprVar(choice.argBinder._1, choiceArgPos)
|
||||
compile(choice.controllers)
|
||||
}, //
|
||||
{
|
||||
choice.choiceObservers match {
|
||||
case Some(observers) => compile(observers)
|
||||
case None => SEValue.EmptyList
|
||||
}
|
||||
},
|
||||
mbKey.fold(compileKeyWithMaintainers(tmpl.key))(pos => SBSome(svar(pos))),
|
||||
)
|
||||
|
@ -891,13 +891,14 @@ private[lf] object SBuiltin {
|
||||
}
|
||||
|
||||
/** $beginExercise
|
||||
* :: arg (choice argument)
|
||||
* -> ContractId arg (contract to exercise)
|
||||
* -> List Party (actors)
|
||||
* -> List Party (signatories)
|
||||
* -> List Party (observers)
|
||||
* -> List Party (choice controllers)
|
||||
* -> Optional {key: key, maintainers: List Party} (template key, if present)
|
||||
* :: arg 0 (choice argument)
|
||||
* -> ContractId arg 1 (contract to exercise)
|
||||
* -> List Party 2 (actors)
|
||||
* -> List Party 3 (signatories)
|
||||
* -> List Party 4 (template observers)
|
||||
* -> List Party 5 (choice controllers)
|
||||
* -> List Party 6 (choice observers)
|
||||
* -> Optional {key: key, maintainers: List Party} 7 (template key, if present)
|
||||
* -> ()
|
||||
*/
|
||||
final case class SBUBeginExercise(
|
||||
@ -905,7 +906,7 @@ private[lf] object SBuiltin {
|
||||
choiceId: ChoiceName,
|
||||
consuming: Boolean,
|
||||
byKey: Boolean,
|
||||
) extends OnLedgerBuiltin(7) {
|
||||
) extends OnLedgerBuiltin(8) {
|
||||
|
||||
override protected final def execute(
|
||||
args: util.ArrayList[SValue],
|
||||
@ -922,10 +923,11 @@ private[lf] object SBuiltin {
|
||||
case v => crash(s"expect optional parties, got: $v")
|
||||
}
|
||||
val sigs = extractParties(args.get(3))
|
||||
val obs = extractParties(args.get(4))
|
||||
val templateObservers = extractParties(args.get(4))
|
||||
val ctrls = extractParties(args.get(5))
|
||||
val choiceObservers = extractParties(args.get(6))
|
||||
|
||||
val mbKey = extractOptionalKeyWithMaintainers(args.get(6))
|
||||
val mbKey = extractOptionalKeyWithMaintainers(args.get(7))
|
||||
val auth = machine.auth
|
||||
|
||||
onLedger.ptx = onLedger.ptx
|
||||
@ -938,8 +940,9 @@ private[lf] object SBuiltin {
|
||||
consuming = consuming,
|
||||
actingParties = optActors.getOrElse(ctrls),
|
||||
signatories = sigs,
|
||||
stakeholders = sigs union obs,
|
||||
stakeholders = sigs union templateObservers,
|
||||
controllers = ctrls,
|
||||
choiceObservers = choiceObservers,
|
||||
mbKey = mbKey,
|
||||
byKey = byKey,
|
||||
chosenValue = arg,
|
||||
|
@ -111,6 +111,7 @@ private[lf] object PartialTransaction {
|
||||
signatories: Set[Party],
|
||||
stakeholders: Set[Party],
|
||||
controllers: Set[Party],
|
||||
choiceObservers: Set[Party],
|
||||
nodeId: NodeId,
|
||||
parent: Context,
|
||||
byKey: Boolean
|
||||
@ -352,6 +353,7 @@ private[lf] case class PartialTransaction(
|
||||
signatories: Set[Party],
|
||||
stakeholders: Set[Party],
|
||||
controllers: Set[Party],
|
||||
choiceObservers: Set[Party],
|
||||
mbKey: Option[Node.KeyWithMaintainers[Value[Nothing]]],
|
||||
byKey: Boolean,
|
||||
chosenValue: Value[Value.ContractId],
|
||||
@ -377,6 +379,7 @@ private[lf] case class PartialTransaction(
|
||||
signatories = signatories,
|
||||
stakeholders = stakeholders,
|
||||
controllers = controllers,
|
||||
choiceObservers = choiceObservers,
|
||||
nodeId = nid,
|
||||
parent = context,
|
||||
byKey = byKey
|
||||
@ -416,6 +419,7 @@ private[lf] case class PartialTransaction(
|
||||
chosenValue = ec.chosenValue,
|
||||
stakeholders = ec.stakeholders,
|
||||
signatories = ec.signatories,
|
||||
choiceObservers = ec.choiceObservers,
|
||||
controllersDifferFromActors = ec.controllers != ec.actingParties,
|
||||
children = context.children.toImmArray,
|
||||
exerciseResult = Some(value),
|
||||
|
@ -634,6 +634,7 @@ object Ast {
|
||||
name: ChoiceName, // Name of the choice.
|
||||
consuming: Boolean, // Flag indicating whether exercising the choice consumes the contract.
|
||||
controllers: E, // Parties that can exercise the choice.
|
||||
choiceObservers: Option[E], // Additional informees for the choice.
|
||||
selfBinder: ExprVarName, // Self ContractId binder.
|
||||
argBinder: (ExprVarName, Type), // Choice argument binder.
|
||||
returnType: Type, // Return type of the choice follow-up.
|
||||
@ -645,15 +646,24 @@ object Ast {
|
||||
name: ChoiceName,
|
||||
consuming: Boolean,
|
||||
controllers: E,
|
||||
choiceObservers: Option[E],
|
||||
selfBinder: ExprVarName,
|
||||
argBinder: (ExprVarName, Type),
|
||||
returnType: Type,
|
||||
update: E
|
||||
): GenTemplateChoice[E] =
|
||||
new GenTemplateChoice(name, consuming, controllers, selfBinder, argBinder, returnType, update)
|
||||
new GenTemplateChoice(
|
||||
name,
|
||||
consuming,
|
||||
controllers,
|
||||
choiceObservers,
|
||||
selfBinder,
|
||||
argBinder,
|
||||
returnType,
|
||||
update)
|
||||
|
||||
def unapply(arg: GenTemplateChoice[E])
|
||||
: Option[(ChoiceName, Boolean, E, ExprVarName, (ExprVarName, Type), Type, E)] =
|
||||
: Option[(ChoiceName, Boolean, E, Option[E], ExprVarName, (ExprVarName, Type), Type, E)] =
|
||||
GenTemplateChoice.unapply(arg)
|
||||
}
|
||||
|
||||
|
@ -122,8 +122,24 @@ object Util {
|
||||
|
||||
private[this] def toSignature(choice: TemplateChoice): TemplateChoiceSignature =
|
||||
choice match {
|
||||
case TemplateChoice(name, consuming, _, selfBinder, argBinder, returnType, _) =>
|
||||
TemplateChoiceSignature(name, consuming, (), selfBinder, argBinder, returnType, ())
|
||||
case TemplateChoice(
|
||||
name,
|
||||
consuming,
|
||||
_,
|
||||
choiceObservers,
|
||||
selfBinder,
|
||||
argBinder,
|
||||
returnType,
|
||||
_) =>
|
||||
TemplateChoiceSignature(
|
||||
name,
|
||||
consuming,
|
||||
(),
|
||||
choiceObservers.map(_ => ()),
|
||||
selfBinder,
|
||||
argBinder,
|
||||
returnType,
|
||||
())
|
||||
}
|
||||
|
||||
private[this] def toSignature(key: TemplateKey): TemplateKeySignature =
|
||||
|
@ -125,6 +125,7 @@ class AstSpec extends WordSpec with TableDrivenPropertyChecks with Matchers {
|
||||
name = name,
|
||||
consuming = true,
|
||||
controllers = eParties,
|
||||
choiceObservers = None, //FIXME #7709: need test for the Some case
|
||||
selfBinder = Name.assertFromString("self"),
|
||||
argBinder = Name.assertFromString("arg") -> TUnit,
|
||||
returnType = TUnit,
|
||||
|
@ -221,6 +221,7 @@ private[daml] class AstRewriter(
|
||||
name,
|
||||
consuming,
|
||||
controllers,
|
||||
observers,
|
||||
selfBinder,
|
||||
(argBinderVar, argBinderType),
|
||||
returnType,
|
||||
@ -229,6 +230,7 @@ private[daml] class AstRewriter(
|
||||
name,
|
||||
consuming,
|
||||
apply(controllers),
|
||||
observers.map(apply),
|
||||
selfBinder,
|
||||
(argBinderVar, apply(argBinderType)),
|
||||
apply(returnType),
|
||||
|
@ -138,12 +138,14 @@ private[parser] class ModParser[P](parameters: ParserParameters[P]) {
|
||||
Id("choice") ~> tags(templateChoiceTags) ~ id ~ selfBinder ~ choiceParam ~
|
||||
(`:` ~> typ) ~
|
||||
(`,` ~> Id("controllers") ~> expr) ~
|
||||
opt(`,` ~> Id("observers") ~> expr) ~
|
||||
(`to` ~> expr) ^^ {
|
||||
case choiceTags ~ name ~ self ~ param ~ retTyp ~ controllers ~ update =>
|
||||
case choiceTags ~ name ~ self ~ param ~ retTyp ~ controllers ~ choiceObservers ~ update =>
|
||||
name -> TemplateChoice(
|
||||
name,
|
||||
!choiceTags(nonConsumingTag),
|
||||
controllers,
|
||||
choiceObservers,
|
||||
self,
|
||||
param,
|
||||
retTyp,
|
||||
|
@ -456,8 +456,17 @@ class ParsersSpec extends WordSpec with TableDrivenPropertyChecks with Matchers
|
||||
observers Cons @Party ['Alice'] (Nil @Party),
|
||||
agreement "Agreement",
|
||||
choices {
|
||||
choice Sleep (self) (u:Unit) : ContractId Mod:Person , controllers Cons @Party [person] (Nil @Party) to upure @(ContractId Mod:Person) self,
|
||||
choice @nonConsuming Nap (self) (i : Int64): Int64 , controllers Cons @Party [person] (Nil @Party) to upure @Int64 i
|
||||
choice Sleep (self) (u:Unit) : ContractId Mod:Person
|
||||
, controllers Cons @Party [person] (Nil @Party)
|
||||
to upure @(ContractId Mod:Person) self,
|
||||
choice @nonConsuming Nap (self) (i : Int64): Int64
|
||||
, controllers Cons @Party [person] (Nil @Party)
|
||||
, observers Nil @Party
|
||||
to upure @Int64 i,
|
||||
choice @nonConsuming PowerNap (self) (i : Int64): Int64
|
||||
, controllers Cons @Party [person] (Nil @Party)
|
||||
, observers Cons @Party [person] (Nil @Party)
|
||||
to upure @Int64 i
|
||||
},
|
||||
key @Party (Mod:Person {name} this) (\ (p: Party) -> p)
|
||||
} ;
|
||||
@ -475,6 +484,7 @@ class ParsersSpec extends WordSpec with TableDrivenPropertyChecks with Matchers
|
||||
name = n"Sleep",
|
||||
consuming = true,
|
||||
controllers = e"Cons @Party [person] (Nil @Party)",
|
||||
choiceObservers = None,
|
||||
selfBinder = n"self",
|
||||
argBinder = n"u" -> TUnit,
|
||||
returnType = t"ContractId Mod:Person",
|
||||
@ -484,6 +494,17 @@ class ParsersSpec extends WordSpec with TableDrivenPropertyChecks with Matchers
|
||||
name = n"Nap",
|
||||
consuming = false,
|
||||
controllers = e"Cons @Party [person] (Nil @Party)",
|
||||
choiceObservers = Some(e"Nil @Party"),
|
||||
selfBinder = n"self",
|
||||
argBinder = n"i" -> TInt64,
|
||||
returnType = t"Int64",
|
||||
update = e"upure @Int64 i"
|
||||
),
|
||||
n"PowerNap" -> TemplateChoice(
|
||||
name = n"PowerNap",
|
||||
consuming = false,
|
||||
controllers = e"Cons @Party [person] (Nil @Party)",
|
||||
choiceObservers = Some(e"Cons @Party [person] (Nil @Party)"),
|
||||
selfBinder = n"self",
|
||||
argBinder = n"i" -> TInt64,
|
||||
returnType = t"Int64",
|
||||
|
@ -4163,6 +4163,12 @@ The type checker will reject any DAML-LF < 1.2 program that tries to access
|
||||
the choice argument in a controller expression.
|
||||
|
||||
|
||||
Choice observers
|
||||
................
|
||||
|
||||
FIXME: https://github.com/digital-asset/daml/issues/7709
|
||||
|
||||
|
||||
Validation
|
||||
~~~~~~~~~~
|
||||
|
||||
|
@ -453,6 +453,8 @@ As of version 1, these fields are included:
|
||||
* repeated ``string`` signatories
|
||||
* repeated ``string`` controllers
|
||||
|
||||
FIXME: choice observers: https://github.com/digital-asset/daml/issues/7709
|
||||
|
||||
``children`` may be empty; all other fields are required, and required
|
||||
to be non-empty.
|
||||
|
||||
|
@ -188,6 +188,7 @@ object TransactionBuilder {
|
||||
byKey: Boolean = true,
|
||||
): Exercise =
|
||||
Exercise(
|
||||
choiceObservers = Set.empty, //FIXME #7709: take observers as argument (pref no default value)
|
||||
targetCoid = contract.coid,
|
||||
templateId = contract.coinst.template,
|
||||
choiceId = Ref.ChoiceName.assertFromString(choice),
|
||||
|
@ -328,6 +328,7 @@ object ValueGenerators {
|
||||
chosenValue,
|
||||
stakeholders,
|
||||
signatories,
|
||||
choiceObservers = Set.empty, //FIXME #7709: extend Gen to test non-empty choice-observers
|
||||
false,
|
||||
children,
|
||||
Some(exerciseResultValue),
|
||||
|
@ -94,6 +94,7 @@ message NodeExercise {
|
||||
com.daml.lf.value.VersionedValue return_value = 12;
|
||||
com.daml.lf.value.VersionedValue contract_key = 13; // optional
|
||||
KeyWithMaintainers key_with_maintainers = 14; // optional
|
||||
repeated string observers = 15; // optional
|
||||
}
|
||||
|
||||
message NodeLookupByKey {
|
||||
|
@ -101,6 +101,7 @@ object Node {
|
||||
_,
|
||||
_,
|
||||
_,
|
||||
_,
|
||||
children,
|
||||
exerciseResult,
|
||||
key,
|
||||
@ -163,6 +164,7 @@ object Node {
|
||||
chosenValue,
|
||||
stakeholders @ _,
|
||||
signatories @ _,
|
||||
choiceObservers @ _,
|
||||
controllersDifferFromActors @ _,
|
||||
children @ _,
|
||||
exerciseResult,
|
||||
@ -243,6 +245,7 @@ object Node {
|
||||
chosenValue: Val,
|
||||
stakeholders: Set[Party],
|
||||
signatories: Set[Party],
|
||||
choiceObservers: Set[Party],
|
||||
controllersDifferFromActors: Boolean,
|
||||
children: ImmArray[Nid],
|
||||
exerciseResult: Option[Val],
|
||||
@ -270,6 +273,7 @@ object Node {
|
||||
chosenValue: Val,
|
||||
stakeholders: Set[Party],
|
||||
signatories: Set[Party],
|
||||
choiceObservers: Set[Party],
|
||||
children: ImmArray[Nid],
|
||||
exerciseResult: Option[Val],
|
||||
key: Option[KeyWithMaintainers[Val]],
|
||||
@ -285,6 +289,7 @@ object Node {
|
||||
chosenValue,
|
||||
stakeholders,
|
||||
signatories,
|
||||
choiceObservers,
|
||||
controllersDifferFromActors = false,
|
||||
children,
|
||||
exerciseResult,
|
||||
@ -381,6 +386,7 @@ object Node {
|
||||
chosenValue2,
|
||||
stakeholders2,
|
||||
signatories2,
|
||||
choiceObservers2,
|
||||
controllersDifferFromActors2,
|
||||
_,
|
||||
exerciseResult2,
|
||||
@ -390,7 +396,7 @@ object Node {
|
||||
import ne._
|
||||
targetCoid === targetCoid2 && templateId == templateId2 && choiceId == choiceId2 &&
|
||||
consuming == consuming2 && actingParties == actingParties2 && chosenValue === chosenValue2 &&
|
||||
stakeholders == stakeholders2 && signatories == signatories2 &&
|
||||
stakeholders == stakeholders2 && signatories == signatories2 && choiceObservers == choiceObservers2 &&
|
||||
controllersDifferFromActors == controllersDifferFromActors2 &&
|
||||
exerciseResult.fold(true)(_ => exerciseResult === exerciseResult2) &&
|
||||
key.fold(true)(_ => key === key2)
|
||||
|
@ -66,14 +66,15 @@ object NodeInfo {
|
||||
def signatories: Set[Party]
|
||||
def stakeholders: Set[Party]
|
||||
def actingParties: Set[Party]
|
||||
def choiceObservers: Set[Party]
|
||||
|
||||
final def requiredAuthorizers(): Set[Party] = actingParties
|
||||
|
||||
final def informeesOfNode: Set[Party] =
|
||||
if (consuming)
|
||||
stakeholders | actingParties
|
||||
stakeholders | actingParties | choiceObservers
|
||||
else
|
||||
signatories | actingParties
|
||||
signatories | actingParties | choiceObservers
|
||||
}
|
||||
|
||||
trait LookupByKey extends NodeInfo {
|
||||
|
@ -362,7 +362,7 @@ sealed abstract class HasTxNodes[Nid, +Cid, +Val] {
|
||||
*/
|
||||
final def inputContracts[Cid2 >: Cid]: Set[Cid2] =
|
||||
fold(Set.empty[Cid2]) {
|
||||
case (acc, (_, Node.NodeExercises(coid, _, _, _, _, _, _, _, _, _, _, _, _, _))) =>
|
||||
case (acc, (_, Node.NodeExercises(coid, _, _, _, _, _, _, _, _, _, _, _, _, _, _))) =>
|
||||
acc + coid
|
||||
case (acc, (_, Node.NodeFetch(coid, _, _, _, _, _, _, _))) =>
|
||||
acc + coid
|
||||
@ -501,9 +501,9 @@ object GenTransaction extends value.CidContainer3[GenTransaction] {
|
||||
node match {
|
||||
case Node.NodeCreate(_, c, _, _, _, Some(key)) =>
|
||||
state.created(globalKey(c.template, key.key.value))
|
||||
case Node.NodeExercises(_, tmplId, _, _, true, _, _, _, _, _, _, _, Some(key), _) =>
|
||||
case Node.NodeExercises(_, tmplId, _, _, true, _, _, _, _, _, _, _, _, Some(key), _) =>
|
||||
state.consumed(globalKey(tmplId, key.key.value))
|
||||
case Node.NodeExercises(_, tmplId, _, _, false, _, _, _, _, _, _, _, Some(key), _) =>
|
||||
case Node.NodeExercises(_, tmplId, _, _, false, _, _, _, _, _, _, _, _, Some(key), _) =>
|
||||
state.referenced(globalKey(tmplId, key.key.value))
|
||||
case Node.NodeFetch(_, tmplId, _, _, _, _, Some(key), _) =>
|
||||
state.referenced(globalKey(tmplId, key.key.value))
|
||||
|
@ -146,6 +146,7 @@ object TransactionCoder {
|
||||
minContractKeyInExercise,
|
||||
minMaintainersInExercise,
|
||||
minContractKeyInFetch,
|
||||
minChoiceObservers,
|
||||
}
|
||||
node match {
|
||||
case nc @ NodeCreate(_, _, _, _, _, _) =>
|
||||
@ -203,8 +204,14 @@ object TransactionCoder {
|
||||
nodeBuilder.setFetch(fetchBuilder).build()
|
||||
}
|
||||
|
||||
case ne @ NodeExercises(_, _, _, _, _, _, _, _, _, _, _, _, _, _) =>
|
||||
case ne @ NodeExercises(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _) =>
|
||||
for {
|
||||
_ <- Either.cond(
|
||||
test =
|
||||
!((transactionVersion precedes minChoiceObservers) && ne.choiceObservers.nonEmpty),
|
||||
right = (),
|
||||
left = EncodeError(transactionVersion, isTooOldFor = "non-empty choice-observers")
|
||||
)
|
||||
argValue <- encodeValue(encodeCid, ne.chosenValue)
|
||||
retValue <- ne.exerciseResult traverse (v => encodeValue(encodeCid, v))
|
||||
exBuilder = TransactionOuterClass.NodeExercise
|
||||
@ -217,6 +224,7 @@ object TransactionCoder {
|
||||
.addAllChildren(ne.children.map(encodeNid.asString).toList.asJava)
|
||||
.addAllSignatories(ne.signatories.toSet[String].asJava)
|
||||
.addAllStakeholders(ne.stakeholders.toSet[String].asJava)
|
||||
.addAllObservers(ne.choiceObservers.toSet[String].asJava)
|
||||
encodedCid <- encodeCid.encode(transactionVersion, ne.targetCoid)
|
||||
controllers <- if (transactionVersion precedes minNoControllers)
|
||||
Either.cond(
|
||||
@ -310,6 +318,7 @@ object TransactionCoder {
|
||||
minContractKeyInExercise,
|
||||
minMaintainersInExercise,
|
||||
minContractKeyInFetch,
|
||||
minChoiceObservers,
|
||||
}
|
||||
protoNode.getNodeTypeCase match {
|
||||
case NodeTypeCase.CREATE =>
|
||||
@ -420,6 +429,12 @@ object TransactionCoder {
|
||||
}
|
||||
signatories <- toPartySet(protoExe.getSignatoriesList)
|
||||
stakeholders <- toPartySet(protoExe.getStakeholdersList)
|
||||
choiceObservers <- toPartySet(protoExe.getObserversList)
|
||||
_ <- Either.cond(
|
||||
test = !((txVersion precedes minChoiceObservers) && choiceObservers.nonEmpty),
|
||||
right = (),
|
||||
left = DecodeError(txVersion, isTooOldFor = "non-empty choice-observers")
|
||||
)
|
||||
choiceName <- toIdentifier(protoExe.getChoice)
|
||||
} yield
|
||||
(
|
||||
@ -434,6 +449,7 @@ object TransactionCoder {
|
||||
chosenValue = cv,
|
||||
stakeholders = stakeholders,
|
||||
signatories = signatories,
|
||||
choiceObservers = choiceObservers,
|
||||
controllersDifferFromActors = controllersDifferFromActors,
|
||||
children = children,
|
||||
exerciseResult = rv,
|
||||
@ -656,11 +672,19 @@ object TransactionCoder {
|
||||
actingParties_ <- toPartySet(protoExe.getActorsList)
|
||||
signatories_ <- toPartySet(protoExe.getSignatoriesList)
|
||||
stakeholders_ <- toPartySet(protoExe.getStakeholdersList)
|
||||
choiceObservers_ <- toPartySet(protoExe.getObserversList)
|
||||
_ <- Either.cond(
|
||||
test =
|
||||
!((txVersion precedes TransactionVersions.minChoiceObservers) && choiceObservers_.nonEmpty),
|
||||
right = (),
|
||||
left = DecodeError(txVersion, isTooOldFor = "non-empty choice-observers")
|
||||
)
|
||||
} yield {
|
||||
new NodeInfo.Exercise {
|
||||
def signatories = signatories_
|
||||
def stakeholders = stakeholders_
|
||||
def actingParties = actingParties_
|
||||
def choiceObservers = choiceObservers_
|
||||
def consuming = protoExe.getConsuming
|
||||
}
|
||||
}
|
||||
|
@ -32,6 +32,7 @@ private[lf] object TransactionVersions
|
||||
private[transaction] val minContractKeyInExercise = TransactionVersion("8")
|
||||
private[transaction] val minMaintainersInExercise = TransactionVersion("9")
|
||||
private[transaction] val minContractKeyInFetch = TransactionVersion("10")
|
||||
private[transaction] val minChoiceObservers = TransactionVersion("11")
|
||||
|
||||
// Older versions are deprecated https://github.com/digital-asset/daml/issues/5220
|
||||
val StableOutputVersions: VersionRange[TransactionVersion] =
|
||||
|
@ -230,7 +230,7 @@ object TransactionSpec {
|
||||
chosenValue = V.ValueUnit,
|
||||
stakeholders = Set.empty,
|
||||
signatories = Set.empty,
|
||||
controllersDifferFromActors = false,
|
||||
choiceObservers = Set.empty,
|
||||
children = children,
|
||||
exerciseResult = if (hasExerciseResult) Some(V.ValueUnit) else None,
|
||||
key = None,
|
||||
|
@ -344,6 +344,7 @@ private[validation] object Typing {
|
||||
name @ _,
|
||||
consuming @ _,
|
||||
controllers,
|
||||
choiceObservers @ _,
|
||||
selfBinder,
|
||||
(param, paramType),
|
||||
returnType,
|
||||
@ -357,6 +358,9 @@ private[validation] object Typing {
|
||||
throw EIllegalShadowingExprVar(ctx, param)
|
||||
checkExpr(controllers, TParties)
|
||||
}
|
||||
choiceObservers.foreach {
|
||||
checkExpr(_, TParties) // FIXME #7709, be conditional on: supportsContractObservers
|
||||
}
|
||||
introExprVar(selfBinder, TContractId(TTyCon(tplName)))
|
||||
.introExprVar(param, paramType)
|
||||
.checkExpr(update, TUpdate(returnType))
|
||||
|
@ -145,11 +145,13 @@ private[validation] object ExprTraversable {
|
||||
name @ _,
|
||||
consuming @ _,
|
||||
controllers,
|
||||
observers,
|
||||
selfBinder @ _,
|
||||
binder @ _,
|
||||
returnType @ _,
|
||||
update) =>
|
||||
f(controllers)
|
||||
observers.map(f)
|
||||
f(update)
|
||||
()
|
||||
}
|
||||
|
@ -180,11 +180,13 @@ private[validation] object TypeTraversable {
|
||||
name @ _,
|
||||
consuming @ _,
|
||||
controllers,
|
||||
observers,
|
||||
selfBinder @ _,
|
||||
(boundedVarName @ _, boundedVarType),
|
||||
retType,
|
||||
update) =>
|
||||
foreach(controllers, f)
|
||||
observers.foreach(foreach(_, f))
|
||||
foreach(update, f)
|
||||
f(boundedVarType)
|
||||
f(retType)
|
||||
|
@ -475,7 +475,17 @@ class TypingSpec extends WordSpec with TableDrivenPropertyChecks with Matchers {
|
||||
observers Cons @Party ['Alice'] (Nil @Party),
|
||||
agreement "Agreement",
|
||||
choices {
|
||||
choice Ch (self) (i : Unit) : Unit, controllers Cons @Party ['Alice'] (Nil @Party) to upure @Unit ()
|
||||
choice Ch1 (self) (i : Unit) : Unit
|
||||
, controllers Cons @Party ['Alice'] (Nil @Party)
|
||||
to upure @Unit (),
|
||||
choice Ch2 (self) (i : Unit) : Unit
|
||||
, controllers Cons @Party ['Alice'] (Nil @Party)
|
||||
, observers Nil @Party
|
||||
to upure @Unit (),
|
||||
choice Ch3 (self) (i : Unit) : Unit
|
||||
, controllers Cons @Party ['Alice'] (Nil @Party)
|
||||
, observers Cons @Party ['Alice'] (Nil @Party)
|
||||
to upure @Unit ()
|
||||
},
|
||||
key @NegativeTestCase:TBis
|
||||
(NegativeTestCase:TBis { person = (NegativeTestCase:T {name} this), party = (NegativeTestCase:T {person} this) })
|
||||
@ -511,6 +521,39 @@ class TypingSpec extends WordSpec with TableDrivenPropertyChecks with Matchers {
|
||||
} ;
|
||||
}
|
||||
|
||||
module PositiveTestCase_ControllersMustBeListParty {
|
||||
record @serializable T = {};
|
||||
|
||||
template (this : T) = {
|
||||
precondition True,
|
||||
signatories Cons @Party ['Bob'] (Nil @Party),
|
||||
observers Cons @Party ['Bob'] (Nil @Party),
|
||||
agreement "Agreement",
|
||||
choices {
|
||||
choice Ch (self) (i : Unit) : Unit
|
||||
, controllers () // should be of type (List Party)
|
||||
to upure @Unit ()
|
||||
}
|
||||
} ;
|
||||
}
|
||||
|
||||
module PositiveTestCase_ChoiceObserversMustBeListParty {
|
||||
record @serializable T = {};
|
||||
|
||||
template (this : T) = {
|
||||
precondition True,
|
||||
signatories Cons @Party ['Bob'] (Nil @Party),
|
||||
observers Cons @Party ['Bob'] (Nil @Party),
|
||||
agreement "Agreement",
|
||||
choices {
|
||||
choice Ch (self) (i : Unit) : Unit
|
||||
, controllers Cons @Party ['Alice'] (Nil @Party)
|
||||
, observers () // should be of type (List Party)
|
||||
to upure @Unit ()
|
||||
}
|
||||
} ;
|
||||
}
|
||||
|
||||
module PositiveTestCase3 {
|
||||
record @serializable T = {};
|
||||
|
||||
@ -657,11 +700,12 @@ class TypingSpec extends WordSpec with TableDrivenPropertyChecks with Matchers {
|
||||
} ;
|
||||
}
|
||||
"""
|
||||
|
||||
val typeMismatchCases = Table(
|
||||
"moduleName",
|
||||
"PositiveTestCase1",
|
||||
"PositiveTestCase2",
|
||||
"PositiveTestCase_ControllersMustBeListParty",
|
||||
"PositiveTestCase_ChoiceObserversMustBeListParty",
|
||||
"PositiveTestCase3",
|
||||
"PositiveTestCase7",
|
||||
"PositiveTestCase8"
|
||||
|
@ -65,6 +65,7 @@ private[dao] trait JdbcLedgerDaoDivulgenceSpec extends LoneElement with Inside {
|
||||
chosenValue = someValueRecord,
|
||||
stakeholders = Set(alice, bob),
|
||||
signatories = Set(alice),
|
||||
choiceObservers = Set.empty, //FIXME #7709, also test the case of non-empty choice-observers
|
||||
children = ImmArray.empty,
|
||||
exerciseResult = None,
|
||||
key = None,
|
||||
@ -97,6 +98,7 @@ private[dao] trait JdbcLedgerDaoDivulgenceSpec extends LoneElement with Inside {
|
||||
chosenValue = someValueRecord,
|
||||
stakeholders = Set(bob),
|
||||
signatories = Set(bob),
|
||||
choiceObservers = Set.empty,
|
||||
children = ImmArray.empty,
|
||||
exerciseResult = None,
|
||||
key = Some(
|
||||
|
@ -125,6 +125,7 @@ private[dao] trait JdbcLedgerDaoSuite extends JdbcLedgerDaoBackend {
|
||||
chosenValue = ValueText("some choice value"),
|
||||
stakeholders = Set(alice, bob),
|
||||
signatories = Set(alice, bob),
|
||||
choiceObservers = Set.empty,
|
||||
children = ImmArray.empty,
|
||||
exerciseResult = Some(ValueText("some exercise result")),
|
||||
key = None,
|
||||
@ -184,6 +185,7 @@ private[dao] trait JdbcLedgerDaoSuite extends JdbcLedgerDaoBackend {
|
||||
chosenValue = ValueUnit,
|
||||
stakeholders = divulgees,
|
||||
signatories = divulgees,
|
||||
choiceObservers = Set.empty,
|
||||
children = ImmArray.empty,
|
||||
exerciseResult = Some(ValueUnit),
|
||||
key = None,
|
||||
@ -515,7 +517,7 @@ private[dao] trait JdbcLedgerDaoSuite extends JdbcLedgerDaoBackend {
|
||||
chosenValue = ValueUnit,
|
||||
stakeholders = Set(party),
|
||||
signatories = Set(party),
|
||||
controllersDifferFromActors = false,
|
||||
choiceObservers = Set.empty,
|
||||
children = ImmArray.empty,
|
||||
exerciseResult = Some(ValueUnit),
|
||||
key = maybeKey.map(k => KeyWithMaintainers(ValueText(k), Set(party))),
|
||||
|
@ -92,7 +92,7 @@ private[kvutils] object InputsAndEffects {
|
||||
GlobalKey(create.coinst.template, forceNoContractIds(keyWithMaintainers.key.value)))
|
||||
}
|
||||
|
||||
case exe @ Node.NodeExercises(_, _, _, _, _, _, _, _, _, _, _, _, _, _) =>
|
||||
case exe @ Node.NodeExercises(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _) =>
|
||||
addContractInput(exe.targetCoid)
|
||||
|
||||
case lookup @ Node.NodeLookupByKey(_, _, _, _) =>
|
||||
@ -141,7 +141,7 @@ private[kvutils] object InputsAndEffects {
|
||||
)
|
||||
)
|
||||
|
||||
case exe @ Node.NodeExercises(_, _, _, _, _, _, _, _, _, _, _, _, _, _) =>
|
||||
case exe @ Node.NodeExercises(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _) =>
|
||||
if (exe.consuming) {
|
||||
effects.copy(
|
||||
consumedContracts = contractIdToStateKey(exe.targetCoid) :: effects.consumedContracts,
|
||||
|
@ -281,7 +281,7 @@ private[kvutils] class TransactionCommitter(
|
||||
.fold((true, keys)) {
|
||||
case (
|
||||
(allUnique, existingKeys),
|
||||
(_, exe @ Node.NodeExercises(_, _, _, _, _, _, _, _, _, _, _, _, _, _)))
|
||||
(_, exe @ Node.NodeExercises(_, _, _, _, _, _, _, _, _, _, _, _, _, _, _)))
|
||||
if exe.key.isDefined && exe.consuming =>
|
||||
val stateKey = Conversions.globalKeyToStateKey(
|
||||
GlobalKey(exe.templateId, Conversions.forceNoContractIds(exe.key.get.key.value)))
|
||||
|
@ -48,6 +48,7 @@ class ProjectionsSpec extends WordSpec with Matchers {
|
||||
chosenValue = ValueText("foo"),
|
||||
stakeholders = stakeholders,
|
||||
signatories = signatories,
|
||||
choiceObservers = Set.empty,
|
||||
children = ImmArray.empty,
|
||||
exerciseResult = None,
|
||||
key = None,
|
||||
|
Loading…
Reference in New Issue
Block a user