Wire up user management to ScriptLedgerClient (#11889)

part of #11997

changelog_begin
changelog_end

compiler/damlc/tests/src/DA/Test/ScriptService.hs

@@ -926,7 +926,63 @@ main =
                 expectScriptSuccess rs (vr "test") $ \r ->
                   matchRegex r "Active contracts:  #0:0\n"
                 expectScriptFailure rs (vr "unhandledOffLedger") $ \r -> matchRegex r "Unhandled exception"
-                expectScriptFailure rs (vr "unhandledOnLedger") $ \r -> matchRegex r "Unhandled exception"
+                expectScriptFailure rs (vr "unhandledOnLedger") $ \r -> matchRegex r "Unhandled exception",
+              testCase "user management" $ do
+                rs <- runScripts scriptService
+                  [ "module Test where"
+                  , "import DA.Assert"
+                  , "import Daml.Script"
+                  , "testUserManagement = do"
+                  , "  users <- listUsers"
+                  , "  users === []"
+                  , "  u1 <- createUser (User \"u1\" None) []"
+                  , "  u1 === User \"u1\" None"
+                  , "  u2 <- createUser (User \"u2\" None) []"
+                  , "  u2 === User \"u2\" None"
+                  , "  u <- getUser \"u1\""
+                  , "  u === Some u1"
+                  , "  u <- getUser \"u2\""
+                  , "  u === Some u2"
+                  , "  u <- getUser \"nonexistent\""
+                  , "  u === None"
+                  , "  users <- listUsers"
+                  , "  users === [User \"u1\" None, User \"u2\" None]"
+                  , "  deleteUser \"u1\""
+                  , "  users <- listUsers"
+                  , "  users === [User \"u2\" None]"
+                  , "  deleteUser \"u2\""
+                  , "  users <- listUsers"
+                  , "  users === []"
+                  , "  pure ()"
+                  , "testUserRightManagement = do"
+                  , "  p1 <- allocateParty \"p1\""
+                  , "  p2 <- allocateParty \"p2\""
+                  , "  u1 <- createUser (User \"u1\" None) []"
+                  , "  rights <- listUserRights \"u1\""
+                  , "  rights === []"
+                  , "  newRights <- grantUserRights \"u1\" [ParticipantAdmin]"
+                  , "  newRights === [ParticipantAdmin]"
+                  , "  newRights <- grantUserRights \"u1\" [ParticipantAdmin]"
+                  , "  newRights === []"
+                  , "  rights <- listUserRights \"u1\""
+                  , "  rights === [ParticipantAdmin]"
+                  , "  newRights <- grantUserRights \"u1\" [CanActAs p1, CanReadAs p2]"
+                  , "  newRights === [CanActAs p1, CanReadAs p2]"
+                  , "  rights <- listUserRights \"u1\""
+                  , "  rights === [ParticipantAdmin, CanActAs p1, CanReadAs p2]"
+                  , "  revoked <- revokeUserRights \"u1\" [ParticipantAdmin]"
+                  , "  revoked === [ParticipantAdmin]"
+                  , "  revoked <- revokeUserRights \"u1\" [ParticipantAdmin]"
+                  , "  revoked === []"
+                  , "  rights <- listUserRights \"u1\""
+                  , "  rights === [CanActAs p1, CanReadAs p2]"
+                  , "  revoked <- revokeUserRights \"u1\" [CanActAs p1, CanReadAs p2]"
+                  , "  revoked === [CanActAs p1, CanReadAs p2]"
+                  , "  rights <- listUserRights \"u1\""
+                  , "  rights === []"
+                  ]
+                expectScriptSuccess rs (vr "testUserManagement") $ \r ->
+                    matchRegex r "Active contracts: \n"
             ]
   where
     scenarioConfig = SS.defaultScenarioServiceConfig {SS.cnfJvmOptions = ["-Xmx200M"]}

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

@@ -5,7 +5,7 @@ package com.daml.lf
 package engine
 package script
 
-import com.daml.ledger.api.domain.PartyDetails
+import com.daml.ledger.api.domain.{PartyDetails, User, UserRight}
 import com.daml.ledger.api.v1.transaction.{TransactionTree, TreeEvent}
 import com.daml.ledger.api.v1.value
 import com.daml.ledger.api.validation.NoLoggingValueValidator
@@ -28,6 +28,7 @@ import com.daml.script.converter.ConverterException
 import io.grpc.StatusRuntimeException
 import scalaz.std.list._
 import scalaz.std.either._
+import scalaz.std.option._
 import scalaz.std.vector._
 import scalaz.syntax.traverse._
 import scalaz.{-\/, OneAnd, \/-}
@@ -532,6 +533,22 @@ object Converter {
     case v => Left(s"Expected SInt64 but got $v")
   }
 
+  def toList[A](v: SValue, convertElem: SValue => Either[String, A]): Either[String, List[A]] =
+    v match {
+      case SList(xs) =>
+        xs.toImmArray.toList.traverse(convertElem)
+      case _ => Left(s"Expected SList but got $v")
+    }
+
+  def toOptional[A](
+      v: SValue,
+      convertElem: SValue => Either[String, A],
+  ): Either[String, Option[A]] =
+    v match {
+      case SOptional(v) => v.traverse(convertElem)
+      case _ => Left(s"Expected SOptional but got $v")
+    }
+
   private case class SrcLoc(
       pkgId: PackageId,
       module: ModuleName,
@@ -643,6 +660,57 @@ object Converter {
     )
   }
 
+  def fromOptional[A](x: Option[A], f: A => Either[String, SValue]): Either[String, SOptional] =
+    x.traverse(f).map(SOptional(_))
+
+  def fromUser(scriptIds: ScriptIds, user: User): Either[String, SValue] =
+    Right(
+      record(
+        scriptIds.damlScript("User"),
+        ("id", SText(user.id)),
+        ("primaryParty", SOptional(user.primaryParty.map(SParty(_)))),
+      )
+    )
+
+  def toUser(v: SValue): Either[String, User] =
+    v match {
+      case SRecord(_, _, vals) if vals.size == 2 =>
+        for {
+          id <- toUserId(vals.get(0))
+          primaryParty <- toOptional(vals.get(1), toParty)
+        } yield User(id, primaryParty)
+      case _ => Left(s"Expected User but got $v")
+    }
+
+  def toUserId(v: SValue): Either[String, UserId] =
+    // TODO https://github.com/digital-asset/daml/issues/11997
+    // Produce a sensible error for invalid user ids.
+    toText(v).flatMap(UserId.fromString(_))
+
+  def fromUserRight(
+      scriptIds: ScriptIds,
+      right: UserRight,
+  ): Either[String, SValue] = {
+    def toRight(constructor: String, rank: Int, value: SValue): SValue =
+      SVariant(scriptIds.damlScript("UserRight"), Name.assertFromString(constructor), rank, value)
+    Right(right match {
+      case UserRight.ParticipantAdmin => toRight("ParticipantAdmin", 0, SUnit)
+      case UserRight.CanActAs(p) => toRight("CanActAs", 1, SParty(p))
+      case UserRight.CanReadAs(p) => toRight("CanReadAs", 2, SParty(p))
+    })
+  }
+
+  def toUserRight(v: SValue): Either[String, UserRight] =
+    v match {
+      case SVariant(_, "ParticipantAdmin", _, SUnit) =>
+        Right(UserRight.ParticipantAdmin)
+      case SVariant(_, "CanReadAs", _, v) =>
+        toParty(v).map(UserRight.CanReadAs(_))
+      case SVariant(_, "CanActAs", _, v) =>
+        toParty(v).map(UserRight.CanActAs(_))
+      case _ => Left(s"Expected ParticipantAdmin, CanReadAs or CanActAs but got $v")
+    }
+
   def toIfaceType(
       ctx: QualifiedName,
       astTy: Type,

daml-script/runner/src/main/scala/com/digitalasset/daml/lf/engine/script/ScriptF.scala

@@ -8,10 +8,11 @@ import java.time.Clock
 
 import akka.stream.Materializer
 import com.daml.grpc.adapter.ExecutionSequencerFactory
+import com.daml.ledger.api.domain.{User, UserRight}
 import com.daml.lf.data.FrontStack
 import com.daml.lf.{CompiledPackages, command}
 import com.daml.lf.engine.preprocessing.ValueTranslator
-import com.daml.lf.data.Ref.{Identifier, Name, PackageId, Party}
+import com.daml.lf.data.Ref.{Identifier, Name, PackageId, Party, UserId}
 import com.daml.lf.data.Time.Timestamp
 import com.daml.lf.engine.script.ledgerinteraction.{ScriptLedgerClient, ScriptTimeMode}
 import com.daml.lf.language.Ast
@@ -411,6 +412,154 @@ object ScriptF {
     }
   }
 
+  final case class CreateUser(
+      user: User,
+      rights: List[UserRight],
+      stackTrace: StackTrace,
+      continue: SValue,
+  ) extends Cmd {
+    override def description = "createUser"
+    override def execute(env: Env)(implicit
+        ec: ExecutionContext,
+        mat: Materializer,
+        esf: ExecutionSequencerFactory,
+    ): Future[SExpr] =
+      for {
+        // TODO https://github.com/digital-asset/daml/issues/11997
+        // support multiple participants
+        client <- Converter.toFuture(env.clients.getParticipant(None))
+        user <- client.createUser(user, rights)
+        user <- Converter.toFuture(Converter.fromUser(env.scriptIds, user))
+      } yield SEApp(SEValue(continue), Array(SEValue(user)))
+  }
+
+  final case class GetUser(
+      userId: UserId,
+      stackTrace: StackTrace,
+      continue: SValue,
+  ) extends Cmd {
+    override def description = "getUser"
+    override def execute(env: Env)(implicit
+        ec: ExecutionContext,
+        mat: Materializer,
+        esf: ExecutionSequencerFactory,
+    ): Future[SExpr] =
+      for {
+        // TODO https://github.com/digital-asset/daml/issues/11997
+        // support multiple participants
+        client <- Converter.toFuture(env.clients.getParticipant(None))
+        user <- client.getUser(userId)
+        user <- Converter.toFuture(
+          Converter.fromOptional(user, Converter.fromUser(env.scriptIds, _))
+        )
+      } yield SEApp(SEValue(continue), Array(SEValue(user)))
+  }
+
+  final case class DeleteUser(
+      userId: UserId,
+      stackTrace: StackTrace,
+      continue: SValue,
+  ) extends Cmd {
+    override def description = "deleteUser"
+    override def execute(env: Env)(implicit
+        ec: ExecutionContext,
+        mat: Materializer,
+        esf: ExecutionSequencerFactory,
+    ): Future[SExpr] =
+      for {
+        // TODO https://github.com/digital-asset/daml/issues/11997
+        // support multiple participants
+        client <- Converter.toFuture(env.clients.getParticipant(None))
+        _ <- client.deleteUser(userId)
+      } yield SEApp(SEValue(continue), Array(SEValue(SUnit)))
+  }
+
+  final case class ListUsers(stackTrace: StackTrace, continue: SValue) extends Cmd {
+    override def description = "listUsers"
+    override def execute(env: Env)(implicit
+        ec: ExecutionContext,
+        mat: Materializer,
+        esf: ExecutionSequencerFactory,
+    ): Future[SExpr] =
+      for {
+        // TODO https://github.com/digital-asset/daml/issues/11997
+        // support multiple participants
+        client <- Converter.toFuture(env.clients.getParticipant(None))
+        users <- client.listUsers()
+        users <- Converter.toFuture(
+          users.to(FrontStack).traverse(Converter.fromUser(env.scriptIds, _))
+        )
+      } yield SEApp(SEValue(continue), Array(SEValue(SList(users))))
+  }
+
+  final case class GrantUserRights(
+      userId: UserId,
+      rights: List[UserRight],
+      stackTrace: StackTrace,
+      continue: SValue,
+  ) extends Cmd {
+    override def description = "grantUserRights"
+    override def execute(env: Env)(implicit
+        ec: ExecutionContext,
+        mat: Materializer,
+        esf: ExecutionSequencerFactory,
+    ): Future[SExpr] =
+      for {
+        // TODO https://github.com/digital-asset/daml/issues/11997
+        // support multiple participants
+        client <- Converter.toFuture(env.clients.getParticipant(None))
+        rights <- client.grantUserRights(userId, rights)
+        rights <- Converter.toFuture(
+          rights.to(FrontStack).traverse(Converter.fromUserRight(env.scriptIds, _))
+        )
+      } yield SEApp(SEValue(continue), Array(SEValue(SList(rights))))
+  }
+
+  final case class RevokeUserRights(
+      userId: UserId,
+      rights: List[UserRight],
+      stackTrace: StackTrace,
+      continue: SValue,
+  ) extends Cmd {
+    override def description = "revokeUserRights"
+    override def execute(env: Env)(implicit
+        ec: ExecutionContext,
+        mat: Materializer,
+        esf: ExecutionSequencerFactory,
+    ): Future[SExpr] =
+      for {
+        // TODO https://github.com/digital-asset/daml/issues/11997
+        // support multiple participants
+        client <- Converter.toFuture(env.clients.getParticipant(None))
+        rights <- client.revokeUserRights(userId, rights)
+        rights <- Converter.toFuture(
+          rights.to(FrontStack).traverse(Converter.fromUserRight(env.scriptIds, _))
+        )
+      } yield SEApp(SEValue(continue), Array(SEValue(SList(rights))))
+  }
+
+  final case class ListUserRights(
+      userId: UserId,
+      stackTrace: StackTrace,
+      continue: SValue,
+  ) extends Cmd {
+    override def description = "listUserRights"
+    override def execute(env: Env)(implicit
+        ec: ExecutionContext,
+        mat: Materializer,
+        esf: ExecutionSequencerFactory,
+    ): Future[SExpr] =
+      for {
+        // TODO https://github.com/digital-asset/daml/issues/11997
+        // support multiple participants
+        client <- Converter.toFuture(env.clients.getParticipant(None))
+        rights <- client.listUserRights(userId)
+        rights <- Converter.toFuture(
+          rights.to(FrontStack).traverse(Converter.fromUserRight(env.scriptIds, _))
+        )
+      } yield SEApp(SEValue(continue), Array(SEValue(SList(rights))))
+  }
+
   // Shared between Submit, SubmitMustFail and SubmitTree
   final case class SubmitData(
       actAs: OneAnd[Set, Party],
@@ -645,6 +794,78 @@ object ScriptF {
 
   }
 
+  private def parseCreateUser(ctx: Ctx, v: SValue): Either[String, CreateUser] =
+    v match {
+      case SRecord(_, _, JavaList(user, rights, continue, stackTrace)) =>
+        for {
+          user <- Converter.toUser(user)
+          rights <- Converter.toList(rights, Converter.toUserRight)
+          stackTrace <- toStackTrace(ctx, Some(stackTrace))
+        } yield CreateUser(user, rights, stackTrace, continue)
+      case _ => Left(s"Exected CreateUser payload but got $v")
+    }
+
+  private def parseGetUser(ctx: Ctx, v: SValue): Either[String, GetUser] =
+    v match {
+      case SRecord(_, _, JavaList(userId, continue, stackTrace)) =>
+        for {
+          userId <- Converter.toUserId(userId)
+          stackTrace <- toStackTrace(ctx, Some(stackTrace))
+        } yield GetUser(userId, stackTrace, continue)
+      case _ => Left(s"Expected GetUser payload but got $v")
+    }
+
+  private def parseDeleteUser(ctx: Ctx, v: SValue): Either[String, DeleteUser] =
+    v match {
+      case SRecord(_, _, JavaList(userId, continue, stackTrace)) =>
+        for {
+          userId <- Converter.toUserId(userId)
+          stackTrace <- toStackTrace(ctx, Some(stackTrace))
+        } yield DeleteUser(userId, stackTrace, continue)
+      case _ => Left(s"Expected DeleteUser payload but got $v")
+    }
+
+  private def parseListUsers(ctx: Ctx, v: SValue): Either[String, ListUsers] =
+    v match {
+      case SRecord(_, _, JavaList(continue, stackTrace)) =>
+        for {
+          stackTrace <- toStackTrace(ctx, Some(stackTrace))
+        } yield ListUsers(stackTrace, continue)
+      case _ => Left(s"Expected ListUsers payload but got $v")
+    }
+
+  private def parseGrantUserRights(ctx: Ctx, v: SValue): Either[String, GrantUserRights] =
+    v match {
+      case SRecord(_, _, JavaList(userId, rights, continue, stackTrace)) =>
+        for {
+          userId <- Converter.toUserId(userId)
+          rights <- Converter.toList(rights, Converter.toUserRight)
+          stackTrace <- toStackTrace(ctx, Some(stackTrace))
+        } yield GrantUserRights(userId, rights, stackTrace, continue)
+      case _ => Left(s"Expected GrantUserRights payload but got $v")
+    }
+
+  private def parseRevokeUserRights(ctx: Ctx, v: SValue): Either[String, RevokeUserRights] =
+    v match {
+      case SRecord(_, _, JavaList(userId, rights, continue, stackTrace)) =>
+        for {
+          userId <- Converter.toUserId(userId)
+          rights <- Converter.toList(rights, Converter.toUserRight)
+          stackTrace <- toStackTrace(ctx, Some(stackTrace))
+        } yield RevokeUserRights(userId, rights, stackTrace, continue)
+      case _ => Left(s"Expected RevokeUserRights payload but got $v")
+    }
+
+  private def parseListUserRights(ctx: Ctx, v: SValue): Either[String, ListUserRights] =
+    v match {
+      case SRecord(_, _, JavaList(userId, continue, stackTrace)) =>
+        for {
+          userId <- Converter.toUserId(userId)
+          stackTrace <- toStackTrace(ctx, Some(stackTrace))
+        } yield ListUserRights(userId, stackTrace, continue)
+      case _ => Left(s"Expected ListUserRights payload but got $v")
+    }
+
   def parse(ctx: Ctx, constr: Ast.VariantConName, v: SValue): Either[String, ScriptF] =
     constr match {
       case "Submit" => parseSubmit(ctx, v).map(Submit(_))
@@ -660,6 +881,13 @@ object ScriptF {
       case "Sleep" => parseSleep(ctx, v)
       case "Catch" => parseCatch(v)
       case "Throw" => parseThrow(v)
+      case "CreateUser" => parseCreateUser(ctx, v)
+      case "GetUser" => parseGetUser(ctx, v)
+      case "DeleteUser" => parseDeleteUser(ctx, v)
+      case "ListUsers" => parseListUsers(ctx, v)
+      case "GrantUserRights" => parseGrantUserRights(ctx, v)
+      case "RevokeUserRights" => parseRevokeUserRights(ctx, v)
+      case "ListUserRights" => parseListUserRights(ctx, v)
       case _ => Left(s"Unknown constructor $constr")
     }