Add queryContractId to DAML Script (#7289)

* Add queryContractId to DAML Script

I’ve switched between a few different naming options and in the end
settled on this one:

- `lookupContract`, not too bad but misses the connection to `query`
- `queryCid`, we don’t abbreviate this in other places in our API so I
  don’t think we should here.
- `queryContractId`, makes the connection clear and no
  abbreviation. We could also add `queryContractKey` later

changelog_begin

- [DAML Script] Add a `queryContractId` function for querying for a
  contract with the given identifier.

changelog_end

* Fix test

changelog_begin
changelog_end

Author: cocreature

Diff for: compiler/damlc/tests/src/DA/Test/ScriptService.hs

@@ -481,6 +481,53 @@ main =
                   matchRegex r "Tried to allocate a party that already exists:  alice"
                 expectScriptFailure rs (vr "duplicatePartyFromText") $ \r ->
                   matchRegex r "Tried to allocate a party that already exists:  bob"
+            , testCase "lookup and fetch" $ do
+                rs <-
+                  runScripts
+                    scriptService
+                    [ "module Test where"
+                    , "import DA.Assert"
+                    , "import Daml.Script"
+                    , "template T"
+                    , "  with"
+                    , "    owner : Party"
+                    , "    observer : Party"
+                    , "  where"
+                    , "    signatory owner"
+                    , "    observer observer"
+                    , "template Divulger"
+                    , "  with"
+                    , "    divulgee : Party"
+                    , "    sig : Party"
+                    , "  where"
+                    , "    signatory divulgee"
+                    , "    observer sig"
+                    , "    nonconsuming choice Divulge : T"
+                    , "      with cid : ContractId T"
+                    , "      controller sig"
+                    , "      do fetch cid"
+                    , "testQueryContractId = do"
+                    , "  p1 <- allocateParty \"p1\""
+                    , "  p2 <- allocateParty \"p2\""
+                    , "  onlyP1 <- submit p1 $ createCmd (T p1 p1)"
+                    , "  both <- submit p1 $ createCmd (T p1 p2)"
+                    , "  divulger <- submit p2 $ createCmd (Divulger p2 p1)"
+                    , "  optOnlyP1 <- queryContractId p1 onlyP1"
+                    , "  optOnlyP1 === Some (T p1 p1)"
+                    , "  optOnlyP1 <- queryContractId p2 onlyP1"
+                    , "  optOnlyP1 === None"
+                    , "  optBoth <- queryContractId p1 both"
+                    , "  optBoth === Some (T p1 p2)"
+                    , "  optBoth <- queryContractId p2 both"
+                    , "  optBoth === Some (T p1 p2)"
+                    -- Divulged contracts should not be returned in lookups
+                    , "  submit p1 $ exerciseCmd divulger (Divulge onlyP1)"
+                    , "  optOnlyP1 <- queryContractId p2 onlyP1"
+                    , "  optOnlyP1 === None"
+                    , "  pure ()"
+                    ]
+                expectScriptSuccess rs (vr "testQueryContractId") $ \r ->
+                  matchRegex r "Active contracts:  #2:0, #0:0, #1:0"
             ]
   where
     scenarioConfig = SS.defaultScenarioServiceConfig {SS.cnfJvmOptions = ["-Xmx200M"]}

Diff for: daml-script/daml/Daml/Script.daml

@@ -7,6 +7,7 @@ module Daml.Script
   , submit
   , submitMustFail
   , query
+  , queryContractId
   , PartyIdHint (..)
   , ParticipantName (..)
   , PartyDetails(..)
@@ -87,6 +88,7 @@ data ScriptF a
   = Submit (SubmitCmd a)
   | SubmitMustFail (SubmitMustFailCmd a)
   | Query (QueryACS a)
+  | QueryContractId (QueryContractIdPayload a)
   | AllocParty (AllocateParty a)
   | ListKnownParties (ListKnownPartiesPayload a)
   | GetTime (Time -> a)
@@ -105,6 +107,25 @@ data QueryACS a = QueryACS
 query : forall t. Template t => Party -> Script [(ContractId t, t)]
 query p = lift $ Free $ Query (QueryACS p (templateTypeRep @t) (pure . map (\(cid, tpl) -> (coerceContractId cid, fromSome $ fromAnyTemplate tpl))))
 
+data QueryContractIdPayload a = QueryContractIdPayload
+  { party : Party
+  , tplId : TemplateTypeRep
+  , cid : ContractId ()
+  , continue : Optional AnyTemplate -> a
+  } deriving Functor
+
+-- | Query for the contract with the given contract id.
+--
+-- Returns `None` if there is no active contract the party is a stakeholder on.
+-- This is semantically equivalent to calling `query`
+-- and filtering on the client side.
+queryContractId : forall t. Template t => Party -> ContractId t -> Script (Optional t)
+queryContractId p c = lift $ Free $ QueryContractId QueryContractIdPayload with
+  party = p
+  tplId = templateTypeRep @t
+  cid = coerceContractId c
+  continue = pure . fmap (fromSome . fromAnyTemplate)
+
 data SetTimePayload a = SetTimePayload
   with
     time : Time

Diff for: daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/Converter.scala

@@ -456,12 +456,11 @@ object Converter {
       entityName <- DottedName.fromString(id.entityName)
     } yield Identifier(packageId, QualifiedName(moduleName, entityName))
 
-  // Convert a Created event to a pair of (ContractId (), AnyTemplate)
-  def fromCreated(
+  // Convert an active contract to AnyTemplate
+  def fromContract(
       translator: preprocessing.ValueTranslator,
       contract: ScriptLedgerClient.ActiveContract): Either[String, SValue] = {
     val anyTemplateTyCon = daInternalAny("AnyTemplate")
-    val pairTyCon = daTypes("Tuple2")
     val tyCon = contract.templateId
     for {
       argSValue <- translator
@@ -470,7 +469,16 @@ object Converter {
         .map(
           err => s"Failure to translate value in create: $err"
         )
-      anyTpl = record(anyTemplateTyCon, ("getAnyTemplate", SAny(TTyCon(tyCon), argSValue)))
+    } yield record(anyTemplateTyCon, ("getAnyTemplate", SAny(TTyCon(tyCon), argSValue)))
+  }
+
+  // Convert a Created event to a pair of (ContractId (), AnyTemplate)
+  def fromCreated(
+      translator: preprocessing.ValueTranslator,
+      contract: ScriptLedgerClient.ActiveContract): Either[String, SValue] = {
+    val pairTyCon = daTypes("Tuple2")
+    for {
+      anyTpl <- fromContract(translator, contract)
     } yield record(pairTyCon, ("_1", SContractId(contract.contractId)), ("_2", anyTpl))
   }
 

Diff for: daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/LedgerInteraction.scala

@@ -119,6 +119,10 @@ trait ScriptLedgerClient {
       implicit ec: ExecutionContext,
       mat: Materializer): Future[Seq[ScriptLedgerClient.ActiveContract]]
 
+  def queryContractId(party: SParty, templateId: Identifier, cid: ContractId)(
+      implicit ec: ExecutionContext,
+      mat: Materializer): Future[Option[ScriptLedgerClient.ActiveContract]]
+
   def submit(
       party: SParty,
       commands: List[ScriptLedgerClient.Command],
@@ -180,6 +184,17 @@ class GrpcLedgerClient(val grpcClient: LedgerClient, val applicationId: Applicat
         })))
   }
 
+  override def queryContractId(party: SParty, templateId: Identifier, cid: ContractId)(
+      implicit ec: ExecutionContext,
+      mat: Materializer): Future[Option[ScriptLedgerClient.ActiveContract]] = {
+    // We cannot do better than a linear search over query here.
+    for {
+      activeContracts <- query(party, templateId)
+    } yield {
+      activeContracts.find(c => c.contractId == cid)
+    }
+  }
+
   override def submit(
       party: SParty,
       commands: List[ScriptLedgerClient.Command],
@@ -358,6 +373,26 @@ class IdeClient(val compiledPackages: CompiledPackages) extends ScriptLedgerClie
     })
   }
 
+  override def queryContractId(party: SParty, templateId: Identifier, cid: ContractId)(
+      implicit ec: ExecutionContext,
+      mat: Materializer): Future[Option[ScriptLedgerClient.ActiveContract]] = {
+    scenarioRunner.ledger.lookupGlobalContract(
+      view = ScenarioLedger.ParticipantView(party.value),
+      effectiveAt = scenarioRunner.ledger.currentTime,
+      cid) match {
+      case ScenarioLedger.LookupOk(_, Value.ContractInst(_, arg, _), stakeholders)
+          if stakeholders.contains(party.value) =>
+        Future.successful(Some(ScriptLedgerClient.ActiveContract(templateId, cid, arg.value)))
+      case _ =>
+        // Note that contrary to `fetch` in a scenario, we do not
+        // abort on any of the error cases. This makes sense if you
+        // consider this a wrapper around the ACS endpoint where
+        // we cannot differentiate between visibility errors
+        // and the contract not being active.
+        Future.successful(None)
+    }
+  }
+
   // Translate from a ledger command to an Update expression
   // corresponding to the same command.
   private def translateCommand(cmd: ScriptLedgerClient.Command): speedy.Command = {
@@ -635,6 +670,38 @@ class JsonLedgerClient(
       parsedResults
     }
   }
+  override def queryContractId(party: SParty, templateId: Identifier, cid: ContractId)(
+      implicit ec: ExecutionContext,
+      mat: Materializer) = {
+    val req = HttpRequest(
+      method = HttpMethods.POST,
+      uri = uri.withPath(uri.path./("v1")./("fetch")),
+      entity = HttpEntity(
+        ContentTypes.`application/json`,
+        JsonLedgerClient.FetchArgs(cid).toJson.prettyPrint),
+      headers = List(Authorization(OAuth2BearerToken(token.value)))
+    )
+    for {
+      () <- validateTokenParty(party, "queryContractId")
+      resp <- Http().singleRequest(req)
+      fetchResponse <- if (resp.status.isSuccess) {
+        Unmarshal(resp.entity).to[JsonLedgerClient.FetchResponse]
+      } else {
+        getResponseDataBytes(resp).flatMap {
+          case body => Future.failed(new RuntimeException(s"Failed to query ledger: $resp, $body"))
+        }
+      }
+    } yield {
+      val ctx = templateId.qualifiedName
+      val ifaceType = Converter.toIfaceType(ctx, TTyCon(templateId)).right.get
+      fetchResponse.result.map(r => {
+        val payload = r.payload.convertTo[Value[ContractId]](
+          LfValueCodec.apiValueJsonReader(ifaceType, damlLfTypeLookup(_)))
+        val cid = ContractId.assertFromString(r.contractId)
+        ScriptLedgerClient.ActiveContract(templateId, cid, payload)
+      })
+    }
+  }
   override def submit(
       party: SParty,
       commands: List[ScriptLedgerClient.Command],
@@ -867,6 +934,8 @@ object JsonLedgerClient {
   final case class QueryArgs(templateId: Identifier)
   final case class QueryResponse(results: List[ActiveContract])
   final case class ActiveContract(contractId: String, payload: JsValue)
+  final case class FetchArgs(contractId: ContractId)
+  final case class FetchResponse(result: Option[ActiveContract])
 
   final case class CreateArgs(templateId: Identifier, payload: JsValue)
   final case class CreateResponse(contractId: String)
@@ -911,6 +980,15 @@ object JsonLedgerClient {
         case _ => deserializationError(s"Could not parse QueryResponse: $v")
       }
     }
+    implicit val fetchWriter: JsonWriter[FetchArgs] = args =>
+      JsObject("contractId" -> args.contractId.coid.toString.toJson)
+    implicit val fetchReader: RootJsonReader[FetchResponse] = v =>
+      v.asJsObject.getFields("result") match {
+        case Seq(JsNull) => FetchResponse(None)
+        case Seq(r) => FetchResponse(Some(r.convertTo[ActiveContract]))
+        case _ => deserializationError(s"Could not parse FetchResponse: $v")
+    }
+
     implicit val activeContractReader: RootJsonReader[ActiveContract] = v => {
       v.asJsObject.getFields("contractId", "payload") match {
         case Seq(JsString(s), v) => ActiveContract(s, v)

Diff for: daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/Runner.scala

@@ -656,6 +656,26 @@ class Runner(compiledPackages: CompiledPackages, script: Script.Action, timeMode
                       new ConverterException(s"Expected record with 2 fields but got $v"))
                 }
               }
+              case SVariant(_, "QueryContractId", _, v) => {
+                v match {
+                  case SRecord(_, _, vals) if vals.size == 4 => {
+                    val continue = vals.get(3)
+                    for {
+                      party <- Converter.toFuture(Converter.toParty(vals.get(0)))
+                      tplId <- Converter.toFuture(Converter.typeRepToIdentifier(vals.get(1)))
+                      cid <- Converter.toFuture(Converter.toContractId(vals.get(2)))
+                      client <- Converter.toFuture(clients.getPartyParticipant(Party(party.value)))
+                      optR <- client.queryContractId(party, tplId, cid)
+                      optR <- Converter.toFuture(
+                        optR.traverse(Converter.fromContract(valueTranslator, _)))
+                      v <- run(SEApp(SEValue(continue), Array(SEValue(SOptional(optR)))))
+                    } yield v
+                  }
+                  case _ =>
+                    Future.failed(
+                      new ConverterException(s"Expected record with 4 fields but got $v"))
+                }
+              }
               case _ =>
                 Future.failed(
                   new ConverterException(s"Expected Submit, Query or AllocParty but got $v"))

Diff for: daml-script/test/daml-script-test-runner.sh

@@ -57,6 +57,7 @@ ScriptTest:sleepTest SUCCESS
 ScriptExample:initializeFixed SUCCESS
 ScriptTest:testStack SUCCESS
 ScriptTest:testMaxInboundMessageSize SUCCESS
+ScriptTest:testQueryContractId SUCCESS
 EOF
 )"
 

Diff for: daml-script/test/daml/ScriptTest.daml

@@ -269,3 +269,15 @@ testSetTime : Script (Time, Time) = do
   setTime (time (date 2000 Feb 2) 0 1 2)
   t1 <- getTime
   pure (t0, t1)
+
+testQueryContractId : Script () = do
+  p <- allocateParty "p"
+  jsonQueryContractId p
+
+jsonQueryContractId p = do
+  cid <- submit p do createCmd (C p 42)
+  optR <- queryContractId p cid
+  optR === Some (C p 42)
+  submit p do archiveCmd cid
+  optR <- queryContractId p cid
+  optR === None

Diff for: daml-script/test/src/com/digitalasset/daml/lf/engine/script/test/JsonApiIt.scala

@@ -361,5 +361,13 @@ final class JsonApiIt
         assert(ex.toString.contains("Cannot resolve template ID"))
       }
     }
+    "queryContractId" in {
+      for {
+        clients <- getClients()
+        result <- run(clients, QualifiedName.assertFromString("ScriptTest:jsonQueryContractId"))
+      } yield {
+        assert(result == SUnit)
+      }
+    }
   }
 }

Diff for: daml-script/test/src/com/digitalasset/daml/lf/engine/script/test/SingleParticipant.scala

@@ -408,6 +408,22 @@ case class TestContractId(dar: Dar[(PackageId, Package)], runner: TestRunner) {
   }
 }
 
+case class TestLookupFetch(dar: Dar[(PackageId, Package)], runner: TestRunner) {
+  val scriptId =
+    Identifier(dar.main._1, QualifiedName.assertFromString("ScriptTest:testQueryContractId"))
+  def runTests(): Unit = {
+    runner.genericTest(
+      "testQueryContractId",
+      scriptId,
+      None, {
+        // We test with assertions in the test
+        case SUnit => Right(())
+        case v => Left(s"Expected SUnit but got $v")
+      }
+    )
+  }
+}
+
 object SingleParticipant {
 
   private val configParser = new scopt.OptionParser[Config]("daml_script_test") {
@@ -512,6 +528,7 @@ object SingleParticipant {
         val devRunner =
           new TestRunner(participantParams, devDar, config.wallclockTime, config.rootCa)
         if (!config.auth) {
+          TestLookupFetch(dar, runner).runTests()
           TraceOrder(dar, runner).runTests()
           Test0(dar, runner).runTests()
           Test1(dar, runner).runTests()