diff --git a/backend/src/Datarekisteri/Backend/API.hs b/backend/src/Datarekisteri/Backend/API.hs index 6e9d6cf..29bc321 100644 --- a/backend/src/Datarekisteri/Backend/API.hs +++ b/backend/src/Datarekisteri/Backend/API.hs @@ -83,18 +83,24 @@ sendVerificationSecret DBUser {..} = do sendVerificationEmail secret' pendingEmail' >> pure True _ -> pure False -updateArgsToData :: (MonadTime m, MonadRandom m, MonadError GQLError m, MonadDB m) => +updateArgsToData :: (MonadTime m, MonadRandom m, MonadError GQLError m, MonadDB m, MonadPermissions m) => UpdateArgs -> UserID -> m UpdateData updateArgsToData UpdateArgs {..} user = do when (maybe False T.null name) $ throwError "Name must not be empty" when (maybe False T.null password) $ throwError "Password must not be empty" when (maybe False T.null homeplace) $ throwError "Homeplace must not be empty" - isMember <- dbGetUser user >>= liftDBEither >>= fmap isJust . dbUserAccepted + requestPermissions <- currentPermissions + let permissions' = inputPermissionsToPermissions <$> permissions + when (maybe False (> requestPermissions) permissions') $ throwError "Permissions must not be greater than the request's" + dbUser <- dbGetUser user >>= liftDBEither + isMember <- fmap isJust $ dbUserAccepted $ dbUser when (isMember && isJust application) $ throwError "Members can't update their applications" passwordHash <- sequence $ hashPassword <$> password updateTime <- currentTime verificationSecret <- genVerificationSecret - pure UpdateData {..} + oldPermissions <- dbUserPermissions dbUser + pure UpdateData {permissions = (<> oldPermissions) <$> permissions', ..} + -- Map's (and thus Permissions') <> prefers values from the left operand updateUser :: (MonadRandom m, MonadDB m, MonadEmail m, MonadError GQLError m, MonadTime m, MonadPermissions m) => UserID -> UpdateArgs -> m (User m) @@ -204,6 +210,7 @@ data UpdateArgs = UpdateArgs , nickname :: Maybe Text , homeplace :: Maybe Text , application :: Maybe Text + , permissions :: Maybe [InputScopePermission] } deriving (Generic, GQLType, Eq, Show) data NewKeyArgs = NewKeyArgs { comment :: Maybe Text, keyData :: Base64, expires :: Maybe Time } diff --git a/backend/src/Datarekisteri/Backend/Sql.hs b/backend/src/Datarekisteri/Backend/Sql.hs index 3863c3f..788acc0 100644 --- a/backend/src/Datarekisteri/Backend/Sql.hs +++ b/backend/src/Datarekisteri/Backend/Sql.hs @@ -31,7 +31,10 @@ dbUpdateUser UpdateData {..} = do , SetUserPhoneNumber <$> phoneNumber , SetUserApplication <$> application ] - userUpdates = maybeToList $ (SqlUserPasswordCrypt =.) <$> passwordHash + userUpdates = catMaybes + [ (SqlUserPasswordCrypt =.) <$> passwordHash + , (SqlUserPermissions =.) <$> permissions + ] sqlUser <- runQuery $ do Sql.updateUserData user userUpdates memberDataUpdates case email of diff --git a/backend/src/Datarekisteri/Backend/Types.hs b/backend/src/Datarekisteri/Backend/Types.hs index 01c7536..7a70b44 100644 --- a/backend/src/Datarekisteri/Backend/Types.hs +++ b/backend/src/Datarekisteri/Backend/Types.hs @@ -78,6 +78,7 @@ data UpdateData = UpdateData , user :: UserID , updateTime :: Time , verificationSecret :: Text + , permissions :: Maybe Permissions } deriving (Generic, Eq, Show) data NewKeyData = NewKeyData diff --git a/frontend/schema.gql b/frontend/schema.gql index 6395c25..3768e0e 100644 --- a/frontend/schema.gql +++ b/frontend/schema.gql @@ -81,7 +81,7 @@ type Mutation { apply(email: Email!, phoneNumber: PhoneNumber!, password: String!, name: String!, nickname: String, birthdate: Date!, homeplace: String!, application: String!): User! verifyEmail(secret: String!): Boolean! resendVerificationEmail(user: UserID): Unit! - update(email: Email, phoneNumber: PhoneNumber, password: String, name: String, nickname: String, homeplace: String, application: String, user: UserID): User! + update(email: Email, phoneNumber: PhoneNumber, password: String, name: String, nickname: String, homeplace: String, application: String, permissions: [InputScopePermission!], user: UserID): User! newToken(comment: String, name: String, permissions: [InputScopePermission!]): Token! newKey(comment: String, keyData: Base64!, expires: Time): PGPKey! accept(user: UserID!): Unit!