Skip to content

Commit

Permalink
Error handling for User Management exposed via daml-script (digital-a…
Browse files Browse the repository at this point in the history 
…sset#12416)

* Error handling for User Management exposed via daml-script

changelog_begin
changelog_end

adapt ScriptTest.daml to new user-management interface

adapt create-daml-app Setup.daml to new user-management interface

* Add deriving Ord for UserId

* change example of invalid user-id char to "%" from "." (which is no longer illegal)

* recover/reify ALREADY_EXISTS from GrpcLedgerClient.createuser

* fix testcase expected order of users from daml-script listUsers

* adapt create-saml-app Setup.daml to changed interface of user-management

* reinstate sort lost in merge

* sort user in ScriptService user-management test

* improve comment for error foobar hack

* improve doc comment for validateUserId

* use upper case as test example for invalid user-id
  • Loading branch information
@nickchapman-da
nickchapman-da authored Jan 18, 2022
1 parent 530509a commit 0c13a4f
Show file tree
Hide file tree
Showing 10 changed files with 340 additions and 156 deletions.
86 changes: 50 additions & 36 deletions compiler/damlc/tests/src/DA/Test/ScriptService.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -932,70 +932,84 @@ main =
[ "module Test where"
, "import DA.Assert"
, "import Daml.Script"
, "import DA.List (sort)"
, "isValidUserId : Text -> Script Bool"
, "isValidUserId name = try do _ <- validateUserId name; pure True catch InvalidUserId _ -> pure False"
, "userExists : UserId -> Script Bool"
, "userExists u = do try do _ <- getUser u; pure True catch UserNotFound _ -> pure False"
, "expectUserNotFound : Script a -> Script ()"
, "expectUserNotFound script = try do _ <- script; undefined catch UserNotFound _ -> pure ()"
, "testUserManagement = do"
, " True <- isValidUserId \"good\""
, " False <- isValidUserId \"BAD\""
, " u1 <- validateUserId \"user1\""
, " u2 <- validateUserId \"user2\""
, " let user1 = User u1 None"
, " let user2 = User u2 None"
, " userName u1 === \"user1\""
, " userName u2 === \"user2\""
, " 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"
, " createUser user1 []"
, " True <- userExists u1"
, " False <- userExists u2"
, " try do _ <- createUser user1 []; undefined catch UserAlreadyExists _ -> pure ()"
, " createUser user2 []"
, " True <- userExists u1"
, " True <- userExists u2"
, " u <- getUser u1"
, " u === user1"
, " u <- getUser u2"
, " u === user2"
, " users <- listUsers"
, " users === [User \"u1\" None, User \"u2\" None]"
, " deleteUser \"u1\""
, " sort users === [user1, user2]"
, " deleteUser u1"
, " users <- listUsers"
, " users === [User \"u2\" None]"
, " deleteUser \"u2\""
, " users === [user2]"
, " deleteUser u2"
, " users <- listUsers"
, " users === []"
, " nonexistent <- validateUserId \"nonexistent\""
, " expectUserNotFound (getUser nonexistent)"
, " expectUserNotFound (deleteUser nonexistent)"
, " pure ()"
, "testUserRightManagement = do"
, " p1 <- allocateParty \"p1\""
, " p2 <- allocateParty \"p2\""
, " u1 <- createUser (User \"u1\" None) []"
, " rights <- listUserRights \"u1\""
, " u1 <- validateUserId \"user1\""
, " createUser (User u1 None) []"
, " rights <- listUserRights u1"
, " rights === []"
, " newRights <- grantUserRights \"u1\" [ParticipantAdmin]"
, " newRights <- grantUserRights u1 [ParticipantAdmin]"
, " newRights === [ParticipantAdmin]"
, " newRights <- grantUserRights \"u1\" [ParticipantAdmin]"
, " newRights <- grantUserRights u1 [ParticipantAdmin]"
, " newRights === []"
, " rights <- listUserRights \"u1\""
, " rights <- listUserRights u1"
, " rights === [ParticipantAdmin]"
, " newRights <- grantUserRights \"u1\" [CanActAs p1, CanReadAs p2]"
, " newRights <- grantUserRights u1 [CanActAs p1, CanReadAs p2]"
, " newRights === [CanActAs p1, CanReadAs p2]"
, " rights <- listUserRights \"u1\""
, " rights <- listUserRights u1"
, " rights === [ParticipantAdmin, CanActAs p1, CanReadAs p2]"
, " revoked <- revokeUserRights \"u1\" [ParticipantAdmin]"
, " revoked <- revokeUserRights u1 [ParticipantAdmin]"
, " revoked === [ParticipantAdmin]"
, " revoked <- revokeUserRights \"u1\" [ParticipantAdmin]"
, " revoked <- revokeUserRights u1 [ParticipantAdmin]"
, " revoked === []"
, " rights <- listUserRights \"u1\""
, " rights <- listUserRights u1"
, " rights === [CanActAs p1, CanReadAs p2]"
, " revoked <- revokeUserRights \"u1\" [CanActAs p1, CanReadAs p2]"
, " revoked <- revokeUserRights u1 [CanActAs p1, CanReadAs p2]"
, " revoked === [CanActAs p1, CanReadAs p2]"
, " rights <- listUserRights \"u1\""
, " rights <- listUserRights u1"
, " rights === []"
, "testUserAlreadyExists = do"
, " u1 <- createUser (User \"u1\" None) []"
, " u2 <- createUser (User \"u1\" None) []"
, " pure ()"
, "testUserNotFound = do"
, " deleteUser \"nonexistent\""
, " nonexistent <- validateUserId \"nonexistent\""
, " expectUserNotFound (listUserRights nonexistent)"
, " expectUserNotFound (revokeUserRights nonexistent [])"
, " expectUserNotFound (grantUserRights nonexistent [])"
, " pure ()"
]
expectScriptSuccess rs (vr "testUserManagement") $ \r ->
matchRegex r "Active contracts: \n"
expectScriptSuccess rs (vr "testUserRightManagement") $ \r ->
matchRegex r "Active contracts: \n"
expectScriptFailure rs (vr "testUserAlreadyExists") $ \r ->
matchRegex r "User already exists: u1\n"
expectScriptFailure rs (vr "testUserNotFound") $ \r ->
matchRegex r "User not found: nonexistent\n"
]
where
scenarioConfig = SS.defaultScenarioServiceConfig {SS.cnfJvmOptions = ["-Xmx200M"]}
Expand Down
Loading

0 comments on commit 0c13a4f

Please sign in to comment.