Test.daml

-- Copyright (c) 2019 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
-- SPDX-License-Identifier: Apache-2.0

-- file that contains the declarations used in the sandbox tests
daml 1.2
module Test where

template Dummy
  with
    operator : Party
  where
    signatory operator

    controller operator can
      DummyChoice1 : ()
        do return ()

    controller operator can
      FailingChoice : ()
        do assert False


    controller operator can
      nonconsuming Clone: ContractId Dummy
        do create Dummy with operator

    controller operator can
      nonconsuming FailingClone : ()
        do
          clone <- exercise self Clone
          exercise self FailingChoice


    controller operator can
      ConsumeIfTimeIsBetween : ()
        with
          begin : Time
          end : Time
        do
          currentTime <- getTime
          assert (begin <= currentTime)
          assert (currentTime <= end)

    controller operator can
      WrapWithAddress : ContractId AddressWrapper
        with address : Address
        do
          create AddressWrapper with operator; address

data Address = Address
  { street: Text
  , city: Text
  , state: Text
  , zip: Text
  } deriving (Eq, Show)

-- DEL-4615
template AddressWrapper
  with
    operator: Party
    address: Address
  where
    signatory operator

template DummyWithParam
  with
    operator : Party
  where
    signatory operator

    controller operator can
      DummyChoice2 : ()
        with paramString: Text
        do return ()

template DummyFactory
  with
    operator: Party
  where
    signatory operator

    controller operator can
      DummyFactoryCall : ()
        do
          split <- create Dummy with operator
          rest <- create DummyWithParam with operator
          return ()


data OptionalInteger = SomeInteger Int | None
  deriving (Eq, Show)

data NestedOptionalInteger = Nested {value: OptionalInteger}
  deriving (Eq, Show)

template ParameterShowcase
  with
    operator: Party
    integer: Integer
    decimal: Decimal
    text: Text
    bool: Bool
    time: Time
    nestedOptionalInteger: NestedOptionalInteger
    integerList: List Integer
    optionalText: Optional Text
  where
    signatory operator

    -- multiple argument choice
    controller operator can
      Choice1 : ContractId ParameterShowcase
        with
          newInteger: Integer
          newDecimal: Decimal
          newText: Text
          newBool: Bool
          newTime: Time
          newNestedOptionalInteger: NestedOptionalInteger
          newIntegerList: List Integer
          newOptionalText: Optional Text
        do
          let new = this with
                { integer = newInteger
                , decimal = newDecimal
                , text = newText
                , bool = newBool
                , time = newTime
                , nestedOptionalInteger = newNestedOptionalInteger
                , integerList = newIntegerList
                , optionalText = newOptionalText
                }
          create new

    -- single argument choice
    controller operator can
      Choice2 : ContractId ParameterShowcase
        with
          newInteger: Integer
        do
          let new = this with integer = newInteger
          create new

template Agreement
  with
    receiver: Party
    giver: Party
  where
    signatory receiver, giver

    agreement (
      toText giver <> " promise to pay the " <>
      toText receiver <> " on demand the sum of five pounds.")

    controller giver can
      AcceptTriProposal : ContractId TriAgreement
        with cid : ContractId TriProposal
        do
          prop <- fetch cid
          assert (prop.receiver == receiver && prop.giver == giver)
          exercise cid TriProposalAccept

      UnrestrictedAcceptTriProposal : ContractId TriAgreement
        with cid: ContractId TriProposal
        do exercise cid TriProposalAccept

template DummyContractFactory
 with
    operator: Party
  where
    signatory operator

    controller operator can
      DummyContractFactoryCall : ContractId Dummy
        do
          split <- create Dummy with operator
          rest <- create DummyWithParam with operator
          pure split

template AgreementFactory
  with
    receiver: Party
    giver: Party
  where
    signatory giver

    controller receiver can
      nonconsuming CreateAgreement : ContractId Agreement
        do create Agreement with receiver, giver

      AgreementFactoryAccept : ContractId Agreement
        do create Agreement with receiver, giver

template TriAgreement
  with
    operator: Party
    receiver: Party
    giver: Party
  where
    signatory operator, receiver, giver

template TriProposal
  with
    operator: Party
    receiver: Party
    giver: Party
  where
    signatory operator

    controller [receiver, giver] can
      TriProposalAccept : ContractId TriAgreement
        do create TriAgreement with operator, receiver, giver

template TextContainer
  with
    operator: Party
    text: Text
  where
    signatory operator

    controller operator can
      Consume : ()
        do return ()

template NothingArgument
  with
    operator: Party
    arg1: Optional Text
  where
    signatory operator

    controller operator can
      Choose : ()
        do return ()

template WithObservers
  with
    giver : Party
    observers : List Party
  where
  signatory giver
  observer observers

  controller giver can
    Ping : ()
      do return ()

template BranchingSignatories
  with
    whichSign : Bool
    signTrue : Party
    signFalse : Party
  where
  signatory (if whichSign then signTrue else signFalse)

template BranchingControllers
  with
    giver : Party
    whichCtrl : Bool
    ctrlTrue : Party
    ctrlFalse : Party
  where
  signatory giver
  controller (if whichCtrl then ctrlTrue else ctrlFalse) can
    Delete : ()
      do return ()


template PayOut
  with
    receiver: Party
    giver: Party
  where
    signatory receiver
    signatory giver
    agreement (
      toText giver <> " must pay to " <>
      toText receiver <> " the sum of five pounds.")


template CallablePayout
  with
    giver: Party
    receiver: Party
  where
    signatory giver
    controller receiver can
      Call : ContractId PayOut
        do create PayOut with receiver, giver
      Transfer : ContractId CallablePayout
        with newReceiver: Party
          do create this with receiver = newReceiver

template TextKey
  with
    tkParty : Party
    tkKey : Text
  where
    signatory tkParty

    controller tkParty can
      TextKeyChoice : ()
        do
          return ()

instance TemplateKey TextKey TextKey where
  key tk = tk

  maintainer tk = [tk.tkParty]

template TextKeyOperations
  with
    tkoParty: Party

  where
    signatory tkoParty

    controller tkoParty can
      nonconsuming TKOLookup: ()
        with
          keyToLookup: TextKey
          expected: Optional (ContractId TextKey)
        do
          actual <- lookupByKey @TextKey keyToLookup
          assertMsg "lookup matches" (expected == actual)

    controller tkoParty can
      nonconsuming TKOFetch: ()
        with
          keyToFetch: TextKey
          expectedCid: ContractId TextKey
        do
          (actualCid, actualContract) <- fetchByKey @TextKey keyToFetch
          assertMsg "fetch contract id matches" (expectedCid == actualCid)
          assertMsg "fetch contract matches" (keyToFetch == actualContract)

    controller tkoParty can
      nonconsuming TKOConsumeAndLookup: ()
        with
          cidToConsume: ContractId TextKey
          keyToLookup: TextKey
        do
          mbCid1 <- lookupByKey @TextKey keyToLookup
          assertMsg "gets contract the first time" (mbCid1 == Just cidToConsume)
          exercise cidToConsume TextKeyChoice
          mbCid2 <- lookupByKey @TextKey keyToLookup
          assertMsg "does not get contract after exercise" (mbCid2 == Nothing)


-- dummy contract to be divulged out-of-band
template Divulgence1
  with
    div1Party: Party
  where
    signatory div1Party

-- contract to be used to divulge out of band. the owner of the
-- `Divulgence1` contract should be the fetcher, and the party
-- to disclose to the signatory.
template Divulgence2
  with
    div2Signatory: Party
    div2Fetcher: Party
  where
    signatory div2Signatory

    controller div2Fetcher can
      nonconsuming Divulgence2Fetch: ()
        with
          div1ToFetch: ContractId Divulgence1
        do
          _ <- fetch div1ToFetch
          return ()

    controller div2Fetcher can
      nonconsuming Divulgence2Archive: ()
        with
          div1ToArchive: ContractId Divulgence1
        do
          archive div1ToArchive

template DecimalRounding
  with
    party: Party
    number: Decimal
  where
    signatory party

{-
testDivulgence : Scenario ()
testDivulgence = test do
  alice <- getParty "alice"
  bob <- getParty "bob"
  div1Cid <- submit alice (create Divulgence1 with div1Party = alice)
  div2Cid <- submit bob (create Divulgence2 with div2Signatory = bob, div2Fetcher = alice)
  submit alice (exercise div2Cid Divulgence2Fetch with div1ToFetch = div1Cid)
-}

testScenario : Scenario ()
testScenario = do
  party <- getParty "party"
  submit party (create Dummy with operator = party)
  submit party (create DummyWithParam with operator = party)
  submit party (create DummyFactory with operator = party)
  return ()