mirror of
https://github.com/digital-asset/daml.git
synced 2024-09-20 09:17:43 +03:00
b023bebfda
changelog_begin changelog_end temp mod to get build make sure to maintain localContractSet engine test for: ExerciseAfterRollbackCreate fix ContractStateMachineSpec testcases and add new case rebase and fix build failure fix test (and comment) fix evaluation order test fails: revert the failure back to be the expected ContractNotActive, instead of ContractNotFound improve new test (creates in try are rolled back) to check the DamlException thrown remove ptx.localContracts. instead use ptx.contractState.locallyCreated improve test name un-inline ActiveLedgerState.consume Set() --> Set.empty add comments for new components of ContractStateMachine combine checks: consumedBy / inactive improve comments, doc and test-evidence
223 lines
5.0 KiB
Haskell
223 lines
5.0 KiB
Haskell
-- Copyright (c) 2022 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
|
|
-- SPDX-License-Identifier: Apache-2.0
|
|
|
|
module Exceptions where
|
|
|
|
import DA.Assert
|
|
import DA.Exception (throw)
|
|
|
|
exception E
|
|
where
|
|
message "E"
|
|
|
|
exception Ecid with cid: ContractId K
|
|
where
|
|
message "Ecid"
|
|
|
|
template K
|
|
with
|
|
p : Party
|
|
v : Int
|
|
t : Text
|
|
where
|
|
signatory p
|
|
key (p, v) : (Party, Int)
|
|
maintainer key._1
|
|
|
|
data Rollback = NoException | Throw
|
|
|
|
template T
|
|
with
|
|
p : Party
|
|
where
|
|
signatory p
|
|
|
|
nonconsuming choice RollbackArchiveTransient : ()
|
|
with
|
|
i : Int
|
|
controller p
|
|
do cid <- create (K p i "")
|
|
try (archive cid >> throw E)
|
|
catch
|
|
E -> pure ()
|
|
archive cid
|
|
|
|
nonconsuming choice ArchiveTransient : ()
|
|
with
|
|
i : Int
|
|
controller p
|
|
do cid <- create (K p i "")
|
|
try archive cid >> pure ()
|
|
catch
|
|
E -> pure ()
|
|
archive cid
|
|
|
|
nonconsuming choice RollbackArchiveNonTransient : ()
|
|
with
|
|
cid : ContractId K
|
|
controller p
|
|
do try archive cid >> throw E
|
|
catch
|
|
E -> pure ()
|
|
archive cid
|
|
|
|
nonconsuming choice ArchiveNonTransient : ()
|
|
with
|
|
cid : ContractId K
|
|
controller p
|
|
do try archive cid >> pure ()
|
|
catch
|
|
E -> pure ()
|
|
archive cid
|
|
|
|
nonconsuming choice RollbackKey : ()
|
|
with
|
|
i : Int
|
|
controller p
|
|
do cid <- create (K p i "before")
|
|
try do
|
|
archive cid
|
|
create (K p i "rollback")
|
|
throw E
|
|
catch
|
|
E -> pure ()
|
|
(_, k) <- fetchByKey @K (p, i)
|
|
k === K p i "before"
|
|
|
|
nonconsuming choice Key : ()
|
|
with
|
|
i : Int
|
|
controller p
|
|
do cid <- create (K p i "before")
|
|
try archive cid >> create (K p i "rollback") >> pure ()
|
|
catch
|
|
E -> pure ()
|
|
(_, k) <- fetchByKey @K (p, i)
|
|
k === K p i "rollback"
|
|
|
|
nonconsuming choice ExerciseAfterRollbackCreate: ()
|
|
controller p
|
|
do
|
|
try do
|
|
cid <- create (K p 1 "")
|
|
throw (Ecid cid)
|
|
catch (Ecid cid) -> archive cid
|
|
|
|
-- This template is used to test that the
|
|
-- engine only ever looks up a global key once.
|
|
-- All choices should succeed under the assumption
|
|
-- that there is one global contract with key (p, 0)
|
|
template GlobalLookups
|
|
with
|
|
p : Party
|
|
where
|
|
signatory p
|
|
|
|
let k = (p, 0)
|
|
|
|
choice LookupTwice : ()
|
|
controller p
|
|
do Some _ <- lookupByKey @K k
|
|
Some _ <- lookupByKey @K k
|
|
pure ()
|
|
|
|
choice LookupAfterCreate : ()
|
|
controller p
|
|
do cid <- create (K p 0 "")
|
|
Some cid' <- lookupByKey @K k
|
|
cid === cid'
|
|
pure ()
|
|
|
|
choice LookupAfterCreateArchive : ()
|
|
controller p
|
|
do cid <- create (K p 0 "")
|
|
Some cid' <- lookupByKey @K k
|
|
cid === cid'
|
|
pure ()
|
|
|
|
choice LookupAfterFetch : ()
|
|
with
|
|
cid : ContractId K
|
|
controller p
|
|
do -- Fetch does not bring key in scope.
|
|
c <- fetch cid
|
|
key c === k
|
|
Some _ <- lookupByKey @K k
|
|
pure ()
|
|
|
|
choice LookupAfterArchive : ()
|
|
with
|
|
cid : ContractId K
|
|
controller p
|
|
do -- Archive does not bring key in scope.
|
|
c <- fetch cid
|
|
key c === k
|
|
archive cid
|
|
None <- lookupByKey @K k
|
|
pure ()
|
|
|
|
-- Note that this will be rejected by
|
|
-- the unique contract key check in the ledger
|
|
-- but not by the engine.
|
|
choice LookupAfterRollbackCreate : ()
|
|
controller p
|
|
do try do
|
|
cid <- create (K p 0 "")
|
|
throw E
|
|
catch
|
|
E -> pure ()
|
|
None <- lookupByKey @K k
|
|
pure ()
|
|
|
|
choice LookupAfterRollbackLookup : ()
|
|
controller p
|
|
do try do
|
|
cid <- lookupByKey @K k
|
|
throw E
|
|
catch
|
|
E -> pure ()
|
|
Some _ <- lookupByKey @K k
|
|
pure ()
|
|
|
|
choice LookupAfterArchiveAfterRollbackLookup : ()
|
|
with
|
|
cid : ContractId K
|
|
controller p
|
|
do try do
|
|
-- this updates globalKeyInputs
|
|
Some cid' <- lookupByKey @K k
|
|
cid === cid'
|
|
throw E
|
|
catch
|
|
E -> pure ()
|
|
c <- fetch cid
|
|
key c === k
|
|
-- keys is empty here so archive does not drop it.
|
|
archive cid
|
|
-- this one needs to check activeness for an entry in globalKeyInputs
|
|
None <- lookupByKey @K k
|
|
pure ()
|
|
|
|
template NodeSeeds
|
|
with
|
|
p : Party
|
|
where
|
|
signatory p
|
|
-- Produces a transaction with all node types so we can
|
|
-- check which produce node seed and which do not.
|
|
choice CreateAllTypes : ()
|
|
with
|
|
cid : ContractId K
|
|
controller p
|
|
do _ <- fetch cid
|
|
Some _ <- lookupByKey @K (p, 0)
|
|
create (K p 1 "")
|
|
try do
|
|
_ <- fetch cid
|
|
Some _ <- lookupByKey @K (p, 0)
|
|
create (K p 2 "")
|
|
throw E
|
|
catch
|
|
E -> pure ()
|
|
pure ()
|