Skip to content

Commit

Permalink
Fix up-84: softFetchInterface does not perform upgrade verification (#…
Browse files Browse the repository at this point in the history 
…20110)

* add failing tests for signatories and observers

* add ensure clause dynamic exercise test

* add dynamic exercise/fetch tests for changed keys

* fix bug
  • Loading branch information
@paulbrauner-da
paulbrauner-da authored Oct 17, 2024
1 parent 2fd0d18 commit fdb0060
Show file tree
Hide file tree
Showing 4 changed files with 215 additions and 76 deletions.
80 changes: 36 additions & 44 deletions sdk/daml-lf/interpreter/src/main/scala/com/digitalasset/daml/lf/speedy/SBuiltin.scala
View file
Original file line number Diff line number Diff line change
Expand Up @@ -1217,26 +1217,7 @@ private[lf] object SBuiltin {
machine: UpdateMachine,
coid: V.ContractId,
interfaceId: TypeConName,
)(k: SAny => Control[Question.Update]): Control[Question.Update] = {
// Continuation called by two different branches of the expression below. Factorized out to avoid duplication.
def cacheContractAndReturnAny(
machine: UpdateMachine,
coid: V.ContractId,
dstTplId: Ref.ValueRef,
dstArg: SValue,
)(k: SAny => Control[Question.Update]): Control[Question.Update] = {
// ensure the contract and its metadata are cached
getContractInfo(
machine,
coid,
dstTplId,
dstArg,
allowCatchingContractInfoErrors = false,
) { _ =>
k(SAny(Ast.TTyCon(dstTplId), dstArg))
}
}

)(k: SAny => Control[Question.Update]): Control[Question.Update] =
fetchAny(machine, None, coid) { (maybePkgName, srcContract) =>
maybePkgName match {
case None =>
Expand All @@ -1258,31 +1239,43 @@ private[lf] object SBuiltin {
case Some(dstArg) =>
viewInterface(machine, interfaceId, dstTplId, dstArg) { dstView =>
executeExpression(machine, SEPreventCatch(srcView)) { srcViewValue =>
// If the destination and src templates are the same, we skip the computation
// of the destination template's view.
if (dstTplId == srcTplId)
cacheContractAndReturnAny(machine, coid, dstTplId, dstArg)(k)
else
executeExpression(machine, SEPreventCatch(dstView)) { dstViewValue =>
if (srcViewValue != dstViewValue) {
Control.Error(
IE.Dev(
NameOf.qualifiedNameOfCurrentFunc,
IE.Dev.Upgrade(
IE.Dev.Upgrade.ViewMismatch(
coid,
interfaceId,
srcTplId,
dstTplId,
srcView = srcViewValue.toUnnormalizedValue,
dstView = dstViewValue.toUnnormalizedValue,
getContractInfo(
machine,
coid,
dstTplId,
dstArg,
allowCatchingContractInfoErrors = false,
) { contract =>
// If the destination and src templates are the same, we skip the computation
// of the destination template's view and the validation of the contract info.
if (dstTplId == srcTplId)
k(SAny(Ast.TTyCon(dstTplId), dstArg))
else {
validateContractInfo(machine, coid, dstTplId, contract) { () =>
executeExpression(machine, SEPreventCatch(dstView)) {
dstViewValue =>
if (srcViewValue != dstViewValue) {
Control.Error(
IE.Dev(
NameOf.qualifiedNameOfCurrentFunc,
IE.Dev.Upgrade(
IE.Dev.Upgrade.ViewMismatch(
coid,
interfaceId,
srcTplId,
dstTplId,
srcView = srcViewValue.toUnnormalizedValue,
dstView = dstViewValue.toUnnormalizedValue,
)
),
)
)
),
)
)
} else
cacheContractAndReturnAny(machine, coid, dstTplId, dstArg)(k)
} else
k(SAny(Ast.TTyCon(dstTplId), dstArg))
}
}
}
}
}
}
}
Expand All @@ -1293,7 +1286,6 @@ private[lf] object SBuiltin {
}
}
}
}

private[this] def resolvePackageName[Q](machine: UpdateMachine, pkgName: Ref.PackageName)(
k: PackageId => Control[Q]
Expand Down
73 changes: 72 additions & 1 deletion sdk/daml-script/test/daml/upgrades/ContractKeys.daml
View file
Original file line number Diff line number Diff line change
Expand Up @@ -13,10 +13,33 @@ import qualified V1.ChangedKeyExpr as V1
import qualified V2.ChangedKeyExpr as V2
import qualified V1.UpgradedContractKeys as V1
import qualified V2.UpgradedContractKeys as V2
import qualified V1.IfaceMod as Iface

{- PACKAGE
name: contract-key-upgrades-iface
versions: 1
-}

{- MODULE
package: contract-key-upgrades-iface
contents: |
module IfaceMod where
data MyUnit = MyUnit {}
deriving (Eq, Show)
interface I where
viewtype MyUnit
nonconsuming choice NoOp : ()
controller signatory this
do pure ()
-}

{- PACKAGE
name: contract-key-upgrades
versions: 2
depends: contract-key-upgrades-iface-1.0.0
-}

main : TestTree
Expand All @@ -33,8 +56,10 @@ main = tests
[ ("queryContractId, src=v1 tgt=v2", queryKeyChangedExprSameValue)
, ("queryContractKey, src=v1 tgt=v2", qckKeyChangedExprSameValue)
, ("fetch, src=v1 tgt=v2", fetchKeyChangedExprSameValue)
, ("fetchByInterface, src=v1 tgt=i", fbiKeyChangedExprSameValue)
, ("fetchByKey, src=v1 tgt=v2", fbkKeyChangedExprSameValue)
, ("exercise, src=v1 tgt=v2", exerciseKeyChangedExprSameValue)
, ("exerciseByInterface, src=v1 tgt=i", ebiKeyChangedExprSameValue)
, ("exerciseByKey, src=v1 tgt=v2", ebkKeyChangedExprSameValue)
, ("exerciseCmd, src=v1 tgt=v2", exerciseCmdKeyChangedExprSameValue)
, ("exerciseByKeyCmd, src=v1 tgt=v2", ebkCmdKeyChangedExprSameValue)
Expand All @@ -43,8 +68,10 @@ main = tests
[ broken ("queryContractId, src=v1 tgt=v2", queryKeyChangedExprChangedValue)
, broken ("queryContractKey, src=v1 tgt=v2", qckKeyChangedExprChangedValue)
, ("fetch, src=v1 tgt=v2", fetchKeyChangedExprChangedValue)
, ("fetchByInterface, src=v1 tgt=i", fbiKeyChangedExprChangedValue)
, ("fetchByKey, src=v1 tgt=v2", fbkKeyChangedExprChangedValue)
, ("exercise, src=v1 tgt=v2", exerciseKeyChangedExprChangedValue)
, ("exerciseByInterface, src=v1 tgt=i", ebiKeyChangedExprChangedValue)
, ("exerciseByKey, src=v1 tgt=v2", ebkKeyChangedExprChangedValue)
, ("exerciseCmd, src=v1 tgt=v2", exerciseCmdKeyChangedExprChangedValue)
, ("exerciseByKeyCmd, src=v1 tgt=v2", ebkCmdKeyChangedExprChangedValue)
Expand Down Expand Up @@ -138,6 +165,8 @@ package: contract-key-upgrades
contents: |
module ChangedKeyExpr where
import IfaceMod
data ChangedKeyExprKey = ChangedKeyExprKey with
p : Party
b : Bool
Expand All @@ -153,6 +182,9 @@ contents: |
key (ChangedKeyExprKey party b) : ChangedKeyExprKey -- @V 2
maintainer key.p
interface instance I for ChangedKeyExpr where
view = MyUnit {}
choice ChangedKeyExprCall : Text
controller party
do pure "V1" -- @V 1
Expand All @@ -169,6 +201,13 @@ contents: |
controller party
do fetch cid
choice ChangedKeyExprFetchByInterface : MyUnit with
cid : ContractId I
controller party
do
i <- fetch cid
pure (view i)
choice ChangedKeyExprFetchByKey : (ContractId ChangedKeyExpr, ChangedKeyExpr) with
k : ChangedKeyExprKey
controller party
Expand All @@ -179,6 +218,11 @@ contents: |
controller party
do exercise @ChangedKeyExpr cid ChangedKeyExprCall
choice ChangedKeyExprExerciseByInterface : () with
cid : ContractId I
controller party
do exercise @I cid NoOp
choice ChangedKeyExprExerciseByKey : Text with
k : ChangedKeyExprKey
controller party
Expand Down Expand Up @@ -233,6 +277,20 @@ fetchKeyChangedExprChangedValue = test $ do
expectKeyChangedError =<<
a `trySubmit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprFetch $ coerceContractId cid)

fbiKeyChangedExprSameValue : Test
fbiKeyChangedExprSameValue = test $ do
a <- allocateParty "alice"
cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a False)
foundContract <- a `submit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprFetchByInterface $ coerceContractId cid)
foundContract === Iface.MyUnit {}

fbiKeyChangedExprChangedValue : Test
fbiKeyChangedExprChangedValue = test $ do
a <- allocateParty "alice"
cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a True)
expectKeyChangedError =<<
a `trySubmit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprFetchByInterface $ coerceContractId cid)

fbkKeyChangedExprSameValue : Test
fbkKeyChangedExprSameValue = test $ do
a <- allocateParty "alice"
Expand All @@ -245,7 +303,6 @@ fbkKeyChangedExprChangedValue : Test
fbkKeyChangedExprChangedValue = test $ do
a <- allocateParty "alice"
cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a True)
-- the fetch inside the following command works, even though the key value changed!
expectKeyChangedError =<<
a `trySubmit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprFetchByKey $ V2.ChangedKeyExprKey a False)

Expand All @@ -256,6 +313,13 @@ exerciseKeyChangedExprSameValue = test $ do
res <- a `submit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprExercise $ coerceContractId cid)
res === "V2"

ebiKeyChangedExprSameValue : Test
ebiKeyChangedExprSameValue = test $ do
a <- allocateParty "alice"
cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a False)
res <- a `submit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprExerciseByInterface $ coerceContractId cid)
res === ()

ebkKeyChangedExprSameValue : Test
ebkKeyChangedExprSameValue = test $ do
a <- allocateParty "alice"
Expand Down Expand Up @@ -284,6 +348,13 @@ exerciseKeyChangedExprChangedValue = test $ do
expectKeyChangedError =<<
a `trySubmit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprExercise $ coerceContractId cid)

ebiKeyChangedExprChangedValue : Test
ebiKeyChangedExprChangedValue = test $ do
a <- allocateParty "alice"
cid <- a `submit` createExactCmd (V1.ChangedKeyExpr a True)
expectKeyChangedError =<<
a `trySubmit` createAndExerciseCmd (V2.ChangedKeyExprHelper a) (V2.ChangedKeyExprExerciseByInterface $ coerceContractId cid)

ebkKeyChangedExprChangedValue : Test
ebkKeyChangedExprChangedValue = test $ do
a <- allocateParty "alice"
Expand Down
53 changes: 42 additions & 11 deletions sdk/daml-script/test/daml/upgrades/Ensure.daml
View file
Original file line number Diff line number Diff line change
@@ -1,25 +1,47 @@
-- Copyright (c) 2024 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

{-# LANGUAGE AllowAmbiguousTypes #-}

module Ensure (main) where

import UpgradeTestLib
import qualified V1.EnsureChanges as V1
import qualified V2.EnsureChanges as V2
import qualified V1.IfaceMod as Iface
import DA.Exception

{- PACKAGE
name: ensure-changes-iface
versions: 1
-}

{- MODULE
package: ensure-changes-iface
contents: |
module IfaceMod where
data MyUnit = MyUnit {}
interface I where
viewtype MyUnit
nonconsuming choice NoOp : ()
controller signatory this
do pure ()
-}

{- PACKAGE
name: ensure-changes
versions: 2
depends: ensure-changes-iface-1.0.0
-}

{- MODULE
package: ensure-changes
contents: |
module EnsureChanges where
import IfaceMod
template EnsureChangesTemplate
with
v1Valid : Bool
Expand All @@ -30,6 +52,9 @@ contents: |
ensure v1Valid -- @V 1
ensure v2Valid -- @V 2
interface instance I for EnsureChangesTemplate where
view = MyUnit {}
choice EnsureChangesCall : Text
controller party
do pure "V1" -- @V 1
Expand All @@ -39,29 +64,34 @@ contents: |
main : TestTree
main = tests
[ ("Fails if the ensure clause changes such that V1 is not longer valid", ensureClauseBecomesInvalid)
, ("Fails if the ensure clause changes such that V1 is not longer valid, exercise by interface", ensureClauseBecomesInvalidDynamic)
, ("Succeeds when implicitly creating a V1 contract such that the ensure clause only passes in V2", onlyV2EnsureClauseRequiredForImplicitUpgrade)
, ("Fails when explicitly calling a V1 choice on a V2 contract that doesn't pass the ensure clause in V1", ensureClauseDowngradeToNoLongerValid)
]

testForPreconditionFailed
: forall t2 t1 c2 r
. (Template t1, HasAgreement t1, Choice t2 c2 r, Show r)
: (Template t1, HasAgreement t1, Show r)
=> (Party -> t1)
-> c2
-> Bool
-> (ContractId t1 -> Commands r)
-> Test
testForPreconditionFailed makeV1Contract v2Choice explicitPackageIds = test $ do
testForPreconditionFailed makeV1Contract exerciseChoice = test $ do
a <- allocatePartyOn "alice" participant0
cid <- a `submit` createExactCmd (makeV1Contract a)
let cidV2 = coerceContractId @t1 @t2 cid
res <- a `trySubmit` (if explicitPackageIds then exerciseExactCmd else exerciseCmd) cidV2 v2Choice
res <- a `trySubmit` exerciseChoice cid
case res of
Left (UnhandledException (Some (fromAnyException -> Some (PreconditionFailed _)))) -> pure ()
res -> assertFail $ "Expected PreconditionFailed, got " <> show res

ensureClauseBecomesInvalid : Test
ensureClauseBecomesInvalid =
testForPreconditionFailed @V2.EnsureChangesTemplate (V1.EnsureChangesTemplate True False) V2.EnsureChangesCall False
testForPreconditionFailed (V1.EnsureChangesTemplate True False) $ \cidV1 ->
-- because the exercise is not exact, the contract should be upgraded to V2 before evaluating the ensure clause
exerciseCmd cidV1 V1.EnsureChangesCall

ensureClauseBecomesInvalidDynamic : Test
ensureClauseBecomesInvalidDynamic =
testForPreconditionFailed (V1.EnsureChangesTemplate True False) $ \cidV1 ->
exerciseExactCmd (coerceContractId @V1.EnsureChangesTemplate @Iface.I cidV1) Iface.NoOp

onlyV2EnsureClauseRequiredForImplicitUpgrade : Test
onlyV2EnsureClauseRequiredForImplicitUpgrade = test $ do
Expand All @@ -72,4 +102,5 @@ onlyV2EnsureClauseRequiredForImplicitUpgrade = test $ do

ensureClauseDowngradeToNoLongerValid : Test
ensureClauseDowngradeToNoLongerValid =
testForPreconditionFailed @V1.EnsureChangesTemplate (V2.EnsureChangesTemplate False True) V1.EnsureChangesCall True
testForPreconditionFailed (V2.EnsureChangesTemplate False True) $ \cidV2 ->
exerciseExactCmd (coerceContractId @V2.EnsureChangesTemplate @V1.EnsureChangesTemplate cidV2) V1.EnsureChangesCall
Loading

0 comments on commit fdb0060

Please sign in to comment.