fix(simple-token): resolve CIP-0056 internal-review findings (56-1 – 56-6 + 56-Q1)

simple-token-test/daml/SimpleToken/Test/Allocation.daml

@@ -138,17 +138,49 @@ test_dvpTwoLegs = do
   enriched2 <- getAllocationFactory registry args2
   result2 <- submitWithDisc bob enriched2.disclosures $
     exerciseCmd enriched2.factoryCid enriched2.arg
-  -- Execute both legs
+  -- Execute both legs atomically (56-5): a single transaction, so either both settle or neither.
   case (result1.output, result2.output) of
     (AllocationInstructionResult_Completed alloc1, AllocationInstructionResult_Completed alloc2) -> do
-      -- Execute leg 1
-      _ <- submitMulti [exec, alice, bob] [] $ exerciseCmd alloc1 Allocation_ExecuteTransfer with
-        extraArgs = emptyExtraArgs
-      -- Execute leg 2
-      _ <- submitMulti [exec, alice, bob] [] $ exerciseCmd alloc2 Allocation_ExecuteTransfer with
-        extraArgs = emptyExtraArgs
+      let execLeg1 = exerciseCmd alloc1 Allocation_ExecuteTransfer with extraArgs = emptyExtraArgs
+          execLeg2 = exerciseCmd alloc2 Allocation_ExecuteTransfer with extraArgs = emptyExtraArgs
+      _ <- submitMulti [exec, alice, bob] [] (execLeg1 *> execLeg2)
       -- Alice: 100 - 80 + 30 = 50
       checkBalance alice registry.instrumentId 50.0
       -- Bob: 50 - 30 + 80 = 100
       checkBalance bob registry.instrumentId 100.0
     _ -> fail "Expected both allocations to complete"
+
+-- Test 13 (56-5): atomic rollback — if one leg of a DvP fails, neither leg settles.
+test_dvpAtomicRollback : Script ()
+test_dvpAtomicRollback = do
+  TestEnv{..} <- setupTestEnv
+  let alice = parties.alice
+      bob = parties.bob
+      exec = parties.executor
+  [hAlice] <- fundParty registry alice 100.0
+  [hBob] <- fundParty registry bob 50.0
+  -- Leg 1: Alice allocates 80 to Bob. Leg 2: Bob allocates 30 to Alice (shared settlement).
+  let args1 = mkAllocationArgs registry alice bob exec 80.0 [hAlice]
+  enriched1 <- getAllocationFactory registry args1
+  result1 <- submitWithDisc alice enriched1.disclosures $
+    exerciseCmd enriched1.factoryCid enriched1.arg
+  let args2 = (mkAllocationArgs registry bob alice exec 30.0 [hBob])
+        with allocation = (mkAllocationArgs registry bob alice exec 30.0 [hBob]).allocation
+              with settlement = args1.allocation.settlement
+  enriched2 <- getAllocationFactory registry args2
+  result2 <- submitWithDisc bob enriched2.disclosures $
+    exerciseCmd enriched2.factoryCid enriched2.arg
+  case (result1.output, result2.output) of
+    (AllocationInstructionResult_Completed alloc1, AllocationInstructionResult_Completed alloc2) -> do
+      -- Bob withdraws leg 2, archiving alloc2 (and returning his 30).
+      _ <- submit bob $ exerciseCmd alloc2 Allocation_Withdraw with extraArgs = emptyExtraArgs
+      -- Atomically execute both legs: leg 2 now refers to an archived allocation, so the whole
+      -- transaction must fail — and critically, leg 1 must NOT have settled.
+      let execLeg1 = exerciseCmd alloc1 Allocation_ExecuteTransfer with extraArgs = emptyExtraArgs
+          execLeg2 = exerciseCmd alloc2 Allocation_ExecuteTransfer with extraArgs = emptyExtraArgs
+      submitMultiMustFail [exec, alice, bob] [] (execLeg1 *> execLeg2)
+      -- Nothing moved: Alice still holds everything (80 still locked in alloc1 + 20 change = 100);
+      -- Bob never received Alice's 80 (his 20 change + 30 returned by withdraw = 50).
+      checkBalance alice registry.instrumentId 100.0
+      checkBalance bob registry.instrumentId 50.0
+    _ -> fail "Expected both allocations to complete"

simple-token-test/daml/SimpleToken/Test/Negative.daml

@@ -360,6 +360,7 @@ test_preapprovalZeroAmount = do
   submitMultiMustFail [registry.admin, alice] [] $
     exerciseCmd preapprovalCid TransferPreapproval_Send with
       sender = alice
+      expectedReceiver = bob  -- matches the preapproval; failure is on amount, not receiver (56-4)
       transferInstrumentId = registry.instrumentId
       amount = 0.0
       totalInput = 100.0

simple-token-test/daml/SimpleToken/Test/ReviewFindings.daml

@@ -0,0 +1,165 @@
+-- | Regression tests for security findings from the CIP-0056 internal review.
+--
+-- 56-4 (LOW/MEDIUM) — direct-transfer receiver redirect: the preapproval used by the
+--   direct-transfer path comes from untrusted choice context, and nothing bound it to the
+--   transfer's intended receiver. A context supplying a preapproval for a *different*
+--   receiver silently redirected the funds. Fix: TransferPreapproval_Send now takes
+--   `expectedReceiver` and asserts it equals the preapproval's `receiver`.
+--
+-- 56-6 (MEDIUM) — forged-holding supply inflation: `archiveAndSumInputs` trusted the shared
+--   `Holding` interface view of its inputs. A foreign look-alike template could advertise a
+--   spoofed view (huge amount, borrowed instrumentId), inflate `totalInput`, and mint a real
+--   backed holding for the fake amount. Fix: inputs must down-cast to one of the registry's
+--   own concrete holding templates (SimpleHolding / LockedSimpleHolding).
+module SimpleToken.Test.ReviewFindings where
+
+import DA.TextMap qualified as TextMap
+
+import Splice.Api.Token.MetadataV1
+import Splice.Api.Token.HoldingV1
+import Splice.Api.Token.TransferInstructionV1
+
+import SimpleToken.Holding
+import SimpleToken.Rules
+import SimpleToken.Preapproval
+import SimpleToken.ContextUtils
+import SimpleToken.Testing.SimpleRegistry
+import SimpleToken.Testing.WalletClient
+import SimpleToken.Test.Setup
+
+import Daml.Script
+
+-- | A foreign template that implements the standard `Holding` interface but is NOT issued by
+-- the registry. It advertises an attacker-controlled view — the "look-alike" of finding 56-6.
+template EvilHolding
+  with
+    attacker : Party
+    spoofedInstrumentId : InstrumentId
+    spoofedAmount : Decimal
+  where
+    signatory attacker
+    interface instance Holding for EvilHolding where
+      view = HoldingView with
+        owner = attacker
+        instrumentId = spoofedInstrumentId
+        amount = spoofedAmount
+        lock = None
+        meta = emptyMetadata
+
+-- Test (56-4): a direct transfer addressed to `charlie` must not be redirected to `bob` by a
+-- choice context that supplies bob's preapproval. With the receiver binding it fails closed.
+test_directTransferReceiverRedirectRejected : Script ()
+test_directTransferReceiverRedirectRejected = do
+  TestEnv{..} <- setupTestEnv
+  let alice = parties.alice      -- sender
+      bob = parties.bob          -- receiver of the (wrong) preapproval supplied via context
+      charlie = parties.charlie  -- the transfer's intended receiver
+  [h1] <- fundParty registry alice 100.0
+  -- A preapproval exists for bob only; charlie has none.
+  bobPreapprovalCid <- createPreapproval registry bob None
+  -- Honest transfer is addressed to charlie...
+  let transfer = Transfer with
+        sender = alice
+        receiver = charlie
+        amount = 50.0
+        instrumentId = registry.instrumentId
+        requestedAt = demoTime
+        executeBefore = futureDeadline
+        inputHoldingCids = [h1]
+        meta = emptyMetadata
+  -- ...but a malicious choice context injects bob's preapproval cid.
+  [(rulesCid, _)] <- query @SimpleTokenRules registry.admin
+  let tfCid = toInterfaceContractId @TransferFactory rulesCid
+  rulesDisc <- queryDisc @SimpleTokenRules registry.admin rulesCid
+  bobDisc <- queryDisc @TransferPreapproval registry.admin bobPreapprovalCid
+  let ctx = ChoiceContext with
+        values = TextMap.fromList
+          [(transferPreapprovalContextKey, AV_ContractId (coerceContractId bobPreapprovalCid))]
+  -- Must fail: preapproval.receiver (bob) /= transfer.receiver (charlie).
+  submitWithDiscMustFail alice (rulesDisc <> bobDisc) $
+    exerciseCmd tfCid TransferFactory_Transfer with
+      expectedAdmin = registry.admin
+      transfer
+      extraArgs = ExtraArgs with context = ctx; meta = emptyMetadata
+
+-- Test (56-6): a foreign look-alike holding must be rejected as a transfer input. Otherwise a
+-- self-transfer would archive it and mint a real backed holding for the spoofed amount.
+test_forgedHoldingInputRejected : Script ()
+test_forgedHoldingInputRejected = do
+  TestEnv{..} <- setupTestEnv
+  let alice = parties.alice
+  -- Attacker mints a look-alike advertising 1,000,000 of the real instrument.
+  evilCid <- submit alice $ createCmd EvilHolding with
+    attacker = alice
+    spoofedInstrumentId = registry.instrumentId
+    spoofedAmount = 1000000.0
+  let evilHoldingCid = toInterfaceContractId @Holding evilCid
+  let transfer = Transfer with
+        sender = alice
+        receiver = alice  -- self-transfer: would mint a backed 1,000,000 holding from thin air
+        amount = 1000000.0
+        instrumentId = registry.instrumentId
+        requestedAt = demoTime
+        executeBefore = futureDeadline
+        inputHoldingCids = [evilHoldingCid]
+        meta = emptyMetadata
+  enriched <- getTransferFactory registry transfer emptyExtraArgs
+  -- Must fail: EvilHolding is not one of the registry's own holding templates.
+  submitWithDiscMustFail alice enriched.disclosures $
+    exerciseCmd enriched.factoryCid enriched.arg
+
+-- Positive control: an equivalent transfer backed by a *real* registry holding still works,
+-- so the 56-6 gate rejects only foreign templates, not legitimate inputs.
+test_genuineHoldingInputStillWorks : Script ()
+test_genuineHoldingInputStillWorks = do
+  TestEnv{..} <- setupTestEnv
+  let alice = parties.alice
+  [h1] <- fundParty registry alice 1000000.0
+  let transfer = Transfer with
+        sender = alice
+        receiver = alice
+        amount = 1000000.0
+        instrumentId = registry.instrumentId
+        requestedAt = demoTime
+        executeBefore = futureDeadline
+        inputHoldingCids = [h1]
+        meta = emptyMetadata
+  enriched <- getTransferFactory registry transfer emptyExtraArgs
+  result <- submitWithDisc alice enriched.disclosures $
+    exerciseCmd enriched.factoryCid enriched.arg
+  case result.output of
+    TransferInstructionResult_Completed _ -> pure ()
+    _ -> fail "Expected Completed for a genuine registry holding"
+  checkBalance alice registry.instrumentId 1000000.0
+
+-- Test (56-1): a holding whose admin is not the instrument's issuing admin cannot be created.
+test_holdingAdminMustMatchInstrumentAdmin : Script ()
+test_holdingAdminMustMatchInstrumentAdmin = do
+  TestEnv{..} <- setupTestEnv
+  let alice = parties.alice
+      charlie = parties.charlie
+  -- instrumentId.admin (charlie) /= holding admin (registry.admin) -> the ensure must reject it.
+  submitMultiMustFail [registry.admin, alice] [] $ createCmd SimpleHolding with
+    admin = registry.admin
+    owner = alice
+    instrumentId = InstrumentId with admin = charlie; id = "SimpleToken"
+    amount = 100.0
+    meta = emptyMetadata
+
+-- Test (56-3a): TransferPreapproval_Send rejects a totalInput that does not cover the amount
+-- (defense-in-depth for direct callers that bypass the factory's invariant #18).
+test_preapprovalTotalInputMustCoverAmount : Script ()
+test_preapprovalTotalInputMustCoverAmount = do
+  TestEnv{..} <- setupTestEnv
+  let alice = parties.alice
+      bob = parties.bob
+  preapprovalCid <- createPreapproval registry bob None
+  -- Claim only 10 of input while sending 50 -> must fail before any holding is minted.
+  submitMultiMustFail [registry.admin, alice] [] $
+    exerciseCmd preapprovalCid TransferPreapproval_Send with
+      sender = alice
+      expectedReceiver = bob
+      transferInstrumentId = registry.instrumentId
+      amount = 50.0
+      totalInput = 10.0
+      holdingMeta = emptyMetadata

simple-token/daml/SimpleToken/Allocation.daml

@@ -1,5 +1,12 @@
 -- | Allocation for DvP settlement.
 -- SimpleAllocation: backed by a locked holding, supports execute/cancel/withdraw.
+--
+-- SCOPE (56-Q1): there is no on-ledger settlement coordinator by design. Atomic multi-leg DvP is
+-- achieved by a TRUSTED executor batching each leg's `Allocation_ExecuteTransfer` into a single
+-- transaction — Daml transaction atomicity then guarantees all-or-nothing settlement (see
+-- SimpleToken.Test.Allocation: test_dvpTwoLegs / test_dvpAtomicRollback). Trusting the executor to
+-- assemble and submit all legs is consistent with the centralized/permissioned model this reference
+-- targets; a trust-minimized matching/escrow coordinator is explicitly out of scope.
 module SimpleToken.Allocation where
 
 import Splice.Api.Token.MetadataV1

simple-token/daml/SimpleToken/AllocationRequest.daml

@@ -1,5 +1,18 @@
--- | Allocation request template for DvP test scenarios.
--- Allows an executor to request allocations from senders.
+-- | Standard-interface demonstration stub for @AllocationRequest@ (CIP-0056).
+--
+-- SCOPE (56-3): this template exists only to witness that the registry can implement the
+-- standard @AllocationRequest@ interface. It is NOT part of the reference allocation flow —
+-- nothing in this package creates or consumes it (the real path is SimpleTokenRules'
+-- @AllocationFactory@ -> @SimpleAllocation@), and the reject/withdraw choice bodies are
+-- intentionally no-ops. It is therefore left deliberately unvalidated.
+--
+-- A PRODUCTION request template (one that end users actually submit against) MUST add [FUTURE]:
+--   * settlement field ordering: requestedAt <= allocateBefore <= settleBefore;
+--   * non-empty @transferLegs@, each with amount > 0.0;
+--   * @senders@ equals exactly the transfer legs' senders — otherwise an omitted sender's leg
+--     silently stalls, and an extra observer gets needless disclosure and can grief via reject;
+--   * reject/withdraw gated to an actual sender/executor (the no-op bodies below authorize via
+--     the interface controller only).
 module SimpleToken.AllocationRequest where
 
 import DA.TextMap qualified as TextMap

simple-token/daml/SimpleToken/Holding.daml

@@ -16,7 +16,9 @@ template SimpleHolding
     meta : Metadata
   where
     signatory admin, owner
-    ensure amount > 0.0
+    -- 56-1: bind the holding's admin to the instrument's issuing admin, so a holding cannot
+    -- advertise an instrument it is not backed by (defense-in-depth for integrators/observers).
+    ensure amount > 0.0 && admin == instrumentId.admin
 
     interface instance Holding for SimpleHolding where
       view = HoldingView with
@@ -41,7 +43,8 @@ template LockedSimpleHolding
   where
     signatory admin, owner, lock.holders
     observer extraObservers
-    ensure amount > 0.0
+    -- 56-1: bind the holding's admin to the instrument's issuing admin.
+    ensure amount > 0.0 && admin == instrumentId.admin
 
     -- | Owner can unlock a holding whose lock has expired.
     choice LockedSimpleHolding_Unlock : ContractId SimpleHolding

simple-token/daml/SimpleToken/Preapproval.daml

@@ -11,6 +11,12 @@ import SimpleToken.Holding
 -- The TransferPreapproval_Send choice is nonconsuming, making it reusable.
 -- The choice creates the receiver holding (and sender change) using the receiver's
 -- signatory authorization from this contract.
+--
+-- SCOPE (56-2): this is intentionally OPEN-BY-DEFAULT — any sender may pay the receiver, so the
+-- receiver establishes one preapproval per instrument. On a permissioned network of vetted
+-- counterparties this is the ergonomic happy path. Restricting a preapproval to a specific sender
+-- is a deliberate opt-in extension (e.g. a `ScopedTransferPreapproval` carrying an allowed-sender
+-- set), tracked [FUTURE] — it is not the default, and this base template is not changed for it.
 template TransferPreapproval
   with
     admin : Party
@@ -26,18 +32,31 @@ template TransferPreapproval
     nonconsuming choice TransferPreapproval_Send : ([ContractId Holding], [ContractId Holding])
       with
         sender : Party
+        expectedReceiver : Party
         transferInstrumentId : InstrumentId
         amount : Decimal
         totalInput : Decimal
         holdingMeta : Metadata
       controller admin, sender
       do
+        -- 56-4: bind this preapproval to the transfer's intended receiver.
+        -- The preapproval cid is supplied via untrusted choice context; without this
+        -- check a preapproval for a different receiver would silently redirect the funds.
+        assertMsg "Preapproval receiver does not match transfer receiver"
+          (receiver == expectedReceiver)
         -- Invariant #16: preapproval.instrumentId == transfer.instrumentId
         assertMsg "Preapproval instrumentId does not match transfer instrumentId"
           (instrumentId == transferInstrumentId)
         -- Defense-in-depth: amount > 0.0 (also enforced by SimpleHolding ensure clause)
         assertMsg "Transfer amount must be positive"
           (amount > 0.0)
+        -- 56-3a: this choice mints from a caller-supplied `totalInput` rather than from archived
+        -- inputs, so it trusts its caller (SimpleTokenRules, exercised with admin authority) to have
+        -- archived inputs summing to `totalInput`. Assert as defense-in-depth — mirroring the
+        -- factory's invariant #18 — that the claimed input at least covers the amount, so an
+        -- integration calling this choice directly cannot create a receiver holding it hasn't backed.
+        assertMsg "totalInput must cover the transfer amount"
+          (totalInput >= amount)
         -- Check expiry if set
         now <- getTime
         case expiresAt of

simple-token/daml/SimpleToken/Rules.daml

@@ -176,6 +176,16 @@ archiveAndSumInputs : Party -> InstrumentId -> [ContractId Holding] -> Update De
 archiveAndSumInputs sender expectedInstrumentId holdingCids = do
   amounts <- forA holdingCids $ \holdingCid -> do
     holdingI <- fetch holdingCid
+    -- 56-6: reject foreign look-alike holdings. `holdingCid` is the shared Holding
+    -- interface, so a malicious template could advertise a spoofed HoldingView (inflated
+    -- amount / borrowed instrumentId) and inflate totalInput -> unbacked mint. Require the
+    -- input to be one of our own concrete holding templates before trusting its view.
+    let isOwnHolding = case fromInterface @SimpleHolding holdingI of
+          Some _ -> True
+          None -> case fromInterface @LockedSimpleHolding holdingI of
+            Some _ -> True
+            None -> False
+    assertMsg "Input holding is not a recognized SimpleToken holding template" isOwnHolding
     let hv = view holdingI
     -- Invariant #10: input owner == sender
     assertMsg "Input holding owner does not match sender"
@@ -230,9 +240,12 @@ selfTransfer admin transfer totalInput meta = do
 -- The preapproval choice creates the receiver holding (needs receiver auth from preapproval signatories).
 directTransfer : Party -> Transfer -> Decimal -> ContractId TransferPreapproval -> Metadata -> Update TransferInstructionResult
 directTransfer admin transfer totalInput preapprovalCid meta = do
-  -- Exercise nonconsuming send on preapproval (validates instrumentId match - invariant #16)
+  -- Exercise nonconsuming send on preapproval.
+  -- Validates instrumentId match (invariant #16) and, since the preapproval cid comes from
+  -- untrusted choice context, that its receiver == transfer.receiver (56-4).
   (receiverHoldingCids, senderChangeCids) <- exercise preapprovalCid TransferPreapproval_Send with
     sender = transfer.sender
+    expectedReceiver = transfer.receiver
     transferInstrumentId = transfer.instrumentId
     amount = transfer.amount
     totalInput