daml/daml-lf/tests/AuthorizedDivulgence.daml

-- Copyright (c) 2020 The DAML Authors. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

daml 1.2

module AuthorizedDivulgence where

----------------------------------------------------------------------------------------------------
-- Authorized fetch
----------------------------------------------------------------------------------------------------

template Secret with
    p : Party
    mySecret : Text
  where
    signatory p

template RevealYourSecret with
    p : Party
    secretCid : ContractId Secret
  where
    signatory p

-- This scenario succeeds only if the flag +DontDivulgeContractIdsInCreateArguments is turned on
test_authorizedFetch = scenario do
  me <- getParty "Me"
  spy <- getParty "Spy"
  secretCid <- submit me (create Secret {p = me, mySecret = "Password for my Swiss bank account is 874321"})
  submit spy (create RevealYourSecret {p = spy, secretCid = secretCid})
  submitMustFail spy do
    fetch secretCid
    -- secret <- fetch secretCid
    -- assert(secret.mySecret == "Password for my Swiss bank account is 874321")

----------------------------------------------------------------------------------------------------
-- Testing no divulgence of create arguments. We test with the classic swap scenario.
----------------------------------------------------------------------------------------------------

template Iou with
    owner : Party
    obligor : Party
  where
    signatory obligor
    observer owner

    controller owner can
      Sell : ContractId Iou
        with newOwner : Party
        do create this with owner = newOwner

template Swap1 with
    p1 : Party
    p2 : Party
  where
    signatory p1
    observer p2

    controller p1 can
      GoSwap1 : ContractId Swap2
        with cid1 : ContractId Iou
        do create Swap2 with p1; p2; cid1

      GoSwap1WithFetch : ContractId Swap2
        with cid1 : ContractId Iou
        do
          fetch cid1
          create Swap2 with p1; p2; cid1

template Swap2 with
    p1 : Party
    p2 : Party
    cid1 : ContractId Iou
  where
    signatory p1
    observer p2

    controller p2 can
      GoSwap2 : ()
        with cid2 : ContractId Iou
        do
          exercise cid1 Sell with newOwner = p2
          exercise cid2 Sell with newOwner = p1
          pure ()

-- We're testing the classic swap example.
-- This scenario should fail now if the DontDivulgeContractIdsInCreateArguments flag is set because
-- the cidIouAlice is not divulged to Bob.
test_noDivulgenceOfCreateArguments = scenario do
  alice <- getParty "Alice"
  bob <- getParty "Bob"
  cidIouAlice <- submit alice $ create $ Iou {owner = alice, obligor = alice}
  cidIouBob <- submit bob $ create $ Iou {owner = bob, obligor = bob}
  cidSwap1 <- submit alice $ create $ (Swap1 alice bob)
  cidSwap2 <- submit alice $ exercise cidSwap1 (GoSwap1 cidIouAlice)
  submitMustFail bob $ exercise cidSwap2 (GoSwap2 cidIouBob)

-- If we fetch the contract in the GoSwap1 choice, then the contract will be divulged to Bob and the
-- swap scenario passes.
test_noDivulgenceForFetch = scenario do
  alice <- getParty "Alice"
  bob <- getParty "Bob"
  cidIouAlice <- submit alice $ create $ Iou {owner = alice, obligor = alice}
  cidIouBob <- submit bob $ create $ Iou {owner = bob, obligor = bob}
  cidSwap1 <- submit alice $ create $ (Swap1 alice bob)
  cidSwap2 <- submit alice $ exercise cidSwap1 (GoSwap1WithFetch cidIouAlice)
  submit bob $ exercise cidSwap2 (GoSwap2 cidIouBob)

----------------------------------------------------------------------------------------------------
-- Testing divulgence of target contract ids of choices.
----------------------------------------------------------------------------------------------------

template C
  with
    p1: Party
    p2: Party
  where
    signatory p1

    controller p2 can
      Delegate : ContractId D do
        create $ D p1 p2


template D
  with
    p1: Party
    p2: Party
  where
    signatory p1, p2
    controller p1 can
      GoD : ContractId E do
        -- We create a contract right before exercising. p2 can't know about it and will only learn of
        -- it when he exercises the choice in the validation.
        cid <- create $ E p1 p2
        exercise cid DoSomething
        pure cid

template E
  with
    p1: Party
    p2: Party
  where
    signatory p1

    controller p2 can
      nonconsuming DoSomething : () do
        pure ()

-- We test that target contract id's of choices are divulged to parties. This will only pass if the
-- DontDivulgeContractIdsInCreateArguments flag is turned on.
test_divulgeChoiceTargetContractId = scenario do
  alice <- getParty "alice"
  bob <- getParty "bob"
  cidC <- submit alice $ create $ C alice bob
  cidD <- submit bob $ exercise cidC Delegate
  cidE <- submit alice $ exercise cidD GoD
  submit bob $ fetch cidE