Add conformance test for deeply nested values

ledger/ledger-api-test-tool/src/main/scala/com/daml/ledger/api/testtool/suites/DeeplyNestedValueIT.scala

@@ -0,0 +1,172 @@
+// Copyright (c) 2021 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
+// SPDX-License-Identifier: Apache-2.0
+
+package com.daml.ledger.api.testtool.suites
+
+import com.daml.ledger.api.refinements.ApiTypes.Party
+import com.daml.ledger.api.testtool.infrastructure.Allocation._
+import com.daml.ledger.api.testtool.infrastructure.Assertions._
+import com.daml.ledger.api.testtool.infrastructure.LedgerTestSuite
+import com.daml.ledger.api.testtool.infrastructure.participant.ParticipantTestContext
+import com.daml.ledger.test.semantic.ValueNesting._
+import io.grpc.Status
+
+import scala.annotation.tailrec
+import scala.concurrent.{ExecutionContext, Future}
+import scala.util.Success
+
+final class DeeplyNestedValueIT extends LedgerTestSuite {
+
+  @tailrec
+  private[this] def toNat(i: Long, acc: Nat = Nat.Z(())): Nat =
+    if (i == 0) acc else toNat(i - 1, Nat.S(acc))
+
+  private[this] def toEither[X](future: Future[X])(implicit
+      ec: ExecutionContext
+  ): Future[Either[Throwable, X]] =
+    future.transform(x => Success(x.toEither))
+
+  private[this] def camlCase(s: String) =
+    s.split(" ").iterator.map(_.capitalize).mkString("")
+
+  List[Long](30, 100, 101, 200).foreach { nesting =>
+    val accepted = nesting <= 100
+    val result = if (accepted) "Accept" else "Reject"
+
+    // Once converted to Nat, `n` will have nesting `nesting`.
+    // Note that Nat.Z(()) has depth 2.
+    val n = nesting - 1
+
+    // Choice argument are always wrapped in a record
+    val nChoiceArgument = n - 1
+
+    // The nesting of the payload of a `Contract` is one more than the nat it contains
+    val nContract = n - 1
+
+    // The nesting of the key of a `ContractWithKey` is one more than the nat it contains
+    val nKey = n - 1
+
+    def test[T](description: String)(
+        update: ExecutionContext => (
+            ParticipantTestContext,
+            Party,
+        ) => Future[Either[Throwable, T]]
+    ) =
+      super.test(
+        result + camlCase(description) + nesting.toString,
+        s"${result.toLowerCase}s $description with nesting of $nesting",
+        allocate(SingleParty),
+      )(implicit ec => { case Participants(Participant(alpha, party)) =>
+        update(ec)(alpha, party).map {
+          case Right(_) if accepted => ()
+          case Left(err: Throwable) if !accepted =>
+            assertGrpcError(err, Status.Code.INVALID_ARGUMENT, None)
+          case otherwise =>
+            fail("Unexpected " + otherwise.fold(err => s"failure: $err", _ => "success"))
+        }
+      })
+
+    test("create command") { implicit ec => (alpha, party) =>
+      toEither(alpha.create(party, Contract(party, nContract, toNat(nContract))))
+    }
+
+    test("exercise command") { implicit ec => (alpha, party) =>
+      for {
+        handler <- alpha.create(party, Handler(party))
+        result <- toEither(
+          alpha.exercise(party, handler.exerciseDestruct(_, toNat(nChoiceArgument)))
+        )
+      } yield result
+    }
+
+    test("create argument in CreateAndExercise command") { implicit ec => (alpha, party) =>
+      toEither(
+        alpha
+          .submitAndWaitForTransactionTree(
+            alpha
+              .submitAndWaitRequest(
+                party,
+                Contract(party, nContract, toNat(nContract)).createAnd
+                  .exerciseArchive(party)
+                  .command,
+              )
+          )
+      )
+    }
+
+    test("choice argument in CreateAndExercise command") { implicit ec => (alpha, party) =>
+      toEither(
+        alpha
+          .submitAndWaitForTransactionTree(
+            alpha
+              .submitAndWaitRequest(
+                party,
+                Handler(party).createAnd.exerciseDestruct(party, toNat(nChoiceArgument)).command,
+              )
+          )
+      )
+    }
+
+    test("exercise argument") { implicit ec => (alpha, party) =>
+      for {
+        handler <- alpha.create(party, Handler(party))
+        result <- toEither(
+          alpha.exercise(party, handler.exerciseConstructThenDestruct(_, nChoiceArgument))
+        )
+      } yield result
+    }
+
+    test("exercise output") { implicit ec => (alpha, party) =>
+      for {
+        handler <- alpha.create(party, Handler(party))
+        result <- toEither(alpha.exercise(party, handler.exerciseConstruct(_, n)))
+      } yield result
+    }
+
+    test("create argument") { implicit ec => (alpha, party) =>
+      for {
+        handler <- alpha.create(party, Handler(party))
+        result <- toEither(alpha.exercise(party, handler.exerciseCreate(_, nContract)))
+      } yield result
+    }
+
+    test("contract key") { implicit ec => (alpha, party) =>
+      for {
+        handler <- alpha.create(party, Handler(party))
+        result <- toEither(alpha.exercise(party, handler.exerciseCreateKey(_, nKey)))
+      } yield result
+    }
+
+    if (accepted) {
+      // Because we cannot create contracts with nesting > 100,
+      // it does not make sense to test fetch of those kinds of contracts.
+      test("fetch by key") { implicit ec => (alpha, party) =>
+        for {
+          handler <- alpha.create(party, Handler(party))
+          _ <- alpha.exercise(party, handler.exerciseCreateKey(_, nKey))
+          result <- toEither(alpha.exercise(party, handler.exerciseFetchByKey(_, nKey)))
+        } yield result
+      }
+    }
+
+    test("failing lookup by key") { implicit ec => (alpha, party) =>
+      for {
+        handler <- alpha.create(party, Handler(party))
+        result <- toEither(alpha.exercise(party, handler.exerciseLookupByKey(_, nKey)))
+      } yield result
+    }
+
+    if (accepted) {
+      // Because we cannot create contracts with key nesting > 100,
+      // it does not make sens to test successful lookup for those keys.
+      test("successful lookup by key") { implicit ec => (alpha, party) =>
+        for {
+          handler <- alpha.create(party, Handler(party))
+          _ <- alpha.exercise(party, handler.exerciseCreateKey(_, nKey))
+          result <- toEither(alpha.exercise(party, handler.exerciseLookupByKey(_, nKey)))
+        } yield result
+      }
+    }
+
+  }
+}

ledger/ledger-api-test-tool/src/main/scala/com/daml/ledger/api/testtool/tests/Tests.scala

@@ -52,6 +52,7 @@ object Tests {
     Vector(
       new ParticipantPruningIT,
       new MultiPartySubmissionIT,
+      new DeeplyNestedValueIT,
     )
 
   val retired: Vector[LedgerTestSuite] =

ledger/sandbox-classic/BUILD.bazel

@@ -434,3 +434,21 @@ server_conformance_test(
         "--exclude=ClosedWorldIT",
     ],
 )
+
+server_conformance_test(
+    name = "conformance-test-nesting",
+    lf_versions = ["stable"],
+    server_args = [
+        "--contract-id-seeding=testing-weak",
+    ],
+    servers = SERVERS,
+    test_tool_args = [
+        "--include=" + ",".join([
+            "DeeplyNestedValueIT:Accept",
+            "DeeplyNestedValueIT:RejectCreateCommand",
+            "DeeplyNestedValueIT:RejectExerciseCommand",
+            "DeeplyNestedValueIT:RejectCreateArgumentInCreateAndExerciseCommand",
+            "DeeplyNestedValueIT:RejectChoiceArgumentInCreateAndExerciseCommand",
+        ]),
+    ],
+)

ledger/sandbox/BUILD.bazel

@@ -307,3 +307,28 @@ server_conformance_test(
         "--include=ClosedWorldIT",
     ],
 )
+
+server_conformance_test(
+    name = "conformance-test-nesting",
+    lf_versions = ["stable"],
+    servers = NEXT_SERVERS,
+    test_tool_args = [
+        "--include=" + ",".join([
+            "DeeplyNestedValueIT:AcceptCreateCommand30",
+            "DeeplyNestedValueIT:AcceptExerciseCommand30",
+            "DeeplyNestedValueIT:AcceptCreateArgumentInCreateAndExerciseCommand30",
+            "DeeplyNestedValueIT:AcceptChoiceArgumentInCreateAndExerciseCommand30",
+            "DeeplyNestedValueIT:AcceptExerciseArgument30",
+            "DeeplyNestedValueIT:AcceptExerciseOutput30",
+            "DeeplyNestedValueIT:AcceptCreateArgument30",
+            "DeeplyNestedValueIT:AcceptContractKey30",
+            "DeeplyNestedValueIT:AcceptFetchByKey30",
+            "DeeplyNestedValueIT:AcceptFailingLookupByKey30",
+            "DeeplyNestedValueIT:AcceptSuccessfulLookupByKey30",
+            "DeeplyNestedValueIT:RejectCreateCommand",
+            "DeeplyNestedValueIT:RejectExerciseCommand",
+            "DeeplyNestedValueIT:RejectCreateArgumentInCreateAndExerciseCommand",
+            "DeeplyNestedValueIT:RejectChoiceArgumentInCreateAndExerciseCommand",
+        ]),
+    ],
+)

ledger/test-common/src/main/daml/semantic/ValueNesting.daml

@@ -0,0 +1,88 @@
+-- Copyright (c) 2021 Digital Asset (Switzerland) GmbH and/or its affiliates. All rights reserved.
+-- SPDX-License-Identifier: Apache-2.0
+
+module ValueNesting where
+
+data Nat = Z | S Nat
+  deriving (Eq, Show)
+
+construct: Int -> Nat -> Nat
+construct x acc | x <= 0 = acc
+construct x acc  = construct (x-1) (S acc)
+
+toNat : Int -> Nat
+toNat x = construct x Z
+
+destruct: Nat -> Int -> Int
+destruct Z acc = acc
+destruct (S n) acc = destruct n (acc + 1)
+
+toInt: Nat -> Int
+toInt x = destruct x 0
+
+template Contract
+  with
+    party: Party
+    i: Int
+    n: Nat
+  where
+    signatory party
+
+template ContractWithKey
+  with
+    party: Party
+    i: Int
+  where
+    signatory party
+    key (party, toNat i): (Party, Nat)
+    maintainer key._1
+
+template Handler
+  with
+    party : Party
+  where
+    signatory party
+    controller party can
+      nonconsuming Construct : Nat
+        with i : Int
+        do
+          pure $ toNat i
+      nonconsuming Destruct : Int
+        with n: Nat
+        do pure $ toInt n
+      nonconsuming ConstructThenDestruct : Int
+        with
+          i: Int
+        do
+          exercise self Destruct with n = toNat i
+      nonconsuming Create: ContractId Contract
+        with
+          i : Int
+        do
+          create Contract with
+            party = party
+            i = i
+            n = toNat i
+      nonconsuming CreateKey: ContractId ContractWithKey
+        with
+          i : Int
+        do
+          create ContractWithKey with
+            party = party
+            i = i
+      nonconsuming Fetch: Contract
+        with cid: ContractId Contract
+        do
+          fetch cid
+      nonconsuming FetchByKey: ContractId ContractWithKey
+        with
+          i: Int
+        do
+          (cid, _) <- fetchByKey @ContractWithKey (party, toNat i)
+          pure cid
+      nonconsuming LookupByKey: Optional (ContractId ContractWithKey)
+        with
+          i: Int
+        do
+          lookupByKey @ContractWithKey (party, toNat i)
+