{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- |
-- Module      : Members
-- Description : Queries about and updates to members of projects
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2021
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.API.Members
  ( AccessLevel (..),

    -- * Projects

    -- * Project membership
    membersOfProject,
    membersOfProject',

    -- ** Adding project members
    addMemberToProject,
    addMemberToProject',
    addMembersToProject,
    addMembersToProject',

    -- ** Removing project members
    removeUserFromProject,
    removeUserFromProject',

    -- * Groups

    -- * Group membership
    membersOfGroup,
    membersOfGroup',

    -- ** Adding group members
    addAllUsersToGroup,
    addUserToGroup,
    addUserToGroup',
    addUsersToGroup,
    addUsersToGroup',

    -- ** Removing group members
    removeUserFromGroup,
    removeUserFromGroup',
  )
where

import qualified Data.ByteString.Lazy as BSL
import Data.Either
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import GitLab.API.Groups
import GitLab.API.Users
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
import Network.HTTP.Client
import Network.HTTP.Types.URI

-- | the access levels for project members. See <https://docs.gitlab.com/ee/user/permissions.html#project-members-permissions>
data AccessLevel
  = Guest
  | Reporter
  | Developer
  | Maintainer
  | Owner

instance Show AccessLevel where
  show :: AccessLevel -> String
show AccessLevel
Guest = String
"10"
  show AccessLevel
Reporter = String
"20"
  show AccessLevel
Developer = String
"30"
  show AccessLevel
Maintainer = String
"40"
  show AccessLevel
Owner = String
"50"

-- | the members of a project.
membersOfProject :: Project -> GitLab [Member]
membersOfProject :: Project -> GitLab [Member]
membersOfProject Project
p = do
  Either (Response ByteString) [Member]
result <- Int -> GitLab (Either (Response ByteString) [Member])
membersOfProject' (Project -> Int
project_id Project
p)
  [Member] -> GitLab [Member]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Member] -> Either (Response ByteString) [Member] -> [Member]
forall b a. b -> Either a b -> b
fromRight (String -> [Member]
forall a. HasCallStack => String -> a
error String
"membersOfProject error") Either (Response ByteString) [Member]
result)

-- | the members of a project given its ID.
membersOfProject' :: Int -> GitLab (Either (Response BSL.ByteString) [Member])
membersOfProject' :: Int -> GitLab (Either (Response ByteString) [Member])
membersOfProject' Int
projectId =
  Int -> Text -> GitLab (Either (Response ByteString) [Member])
membersOfEntity' Int
projectId Text
"projects"

-- | adds a user to a project with the given access level. Returns
-- 'Right Member' for each successful action, otherwise it returns
-- 'Left Status'.
addMemberToProject ::
  -- | the project
  Project ->
  -- | level of access
  AccessLevel ->
  -- | the user
  User ->
  GitLab (Either (Response BSL.ByteString) (Maybe Member))
addMemberToProject :: Project
-> AccessLevel
-> User
-> GitLab (Either (Response ByteString) (Maybe Member))
addMemberToProject Project
project AccessLevel
access User
usr =
  Int
-> AccessLevel
-> Int
-> GitLab (Either (Response ByteString) (Maybe Member))
addMemberToProject' (Project -> Int
project_id Project
project) AccessLevel
access (User -> Int
user_id User
usr)

-- | adds a user to a project with the given access level, given the
-- project's ID and the user's ID. Returns @Right Member@ for each
-- successful action, otherwise it returns @Left Status@.
addMemberToProject' ::
  -- | project ID
  Int ->
  -- | level of access
  AccessLevel ->
  -- | user ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe Member))
addMemberToProject' :: Int
-> AccessLevel
-> Int
-> GitLab (Either (Response ByteString) (Maybe Member))
addMemberToProject' Int
projectId AccessLevel
access Int
usrId =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Member))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr [GitLabParam]
params
  where
    params :: [GitLabParam]
    params :: [GitLabParam]
params =
      [ (ByteString
"user_id", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
usrId)))),
        (ByteString
"access_level", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack (AccessLevel -> String
forall a. Show a => a -> String
show AccessLevel
access))))
      ]
    addr :: Text
addr =
      Text
"/projects/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
projectId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/members"

-- | adds a list of users to a project with the given access
-- level. Returns 'Right Member' for each successful action, otherwise
-- it returns 'Left Status'.
addMembersToProject ::
  -- | the project
  Project ->
  -- | level of access
  AccessLevel ->
  -- | users to add to the project
  [User] ->
  GitLab [Either (Response BSL.ByteString) (Maybe Member)]
addMembersToProject :: Project
-> AccessLevel
-> [User]
-> GitLab [Either (Response ByteString) (Maybe Member)]
addMembersToProject Project
project AccessLevel
access =
  (User -> GitLab (Either (Response ByteString) (Maybe Member)))
-> [User] -> GitLab [Either (Response ByteString) (Maybe Member)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Project
-> AccessLevel
-> User
-> GitLab (Either (Response ByteString) (Maybe Member))
addMemberToProject Project
project AccessLevel
access)

-- | adds a list of users to a project with the given access level,
-- given the project's ID and the user IDs. Returns @Right Member@ for
-- each successful action, otherwise it returns @Left Status@.
addMembersToProject' ::
  -- | project ID
  Int ->
  -- | level of acces
  AccessLevel ->
  -- | IDs of users to add to the project
  [Int] ->
  GitLab [Either (Response BSL.ByteString) (Maybe Member)]
addMembersToProject' :: Int
-> AccessLevel
-> [Int]
-> GitLab [Either (Response ByteString) (Maybe Member)]
addMembersToProject' Int
projectId AccessLevel
access =
  (Int -> GitLab (Either (Response ByteString) (Maybe Member)))
-> [Int] -> GitLab [Either (Response ByteString) (Maybe Member)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Int
-> AccessLevel
-> Int
-> GitLab (Either (Response ByteString) (Maybe Member))
addMemberToProject' Int
projectId AccessLevel
access)

-- | the members of a group.
membersOfGroup :: Group -> GitLab [Member]
membersOfGroup :: Group -> GitLab [Member]
membersOfGroup Group
p = do
  Either (Response ByteString) [Member]
result <- Int -> GitLab (Either (Response ByteString) [Member])
membersOfGroup' (Group -> Int
group_id Group
p)
  [Member] -> GitLab [Member]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Member] -> Either (Response ByteString) [Member] -> [Member]
forall b a. b -> Either a b -> b
fromRight (String -> [Member]
forall a. HasCallStack => String -> a
error String
"membersOfGroup error") Either (Response ByteString) [Member]
result)

-- | the members of a group given its ID.
membersOfGroup' :: Int -> GitLab (Either (Response BSL.ByteString) [Member])
membersOfGroup' :: Int -> GitLab (Either (Response ByteString) [Member])
membersOfGroup' Int
projectId =
  Int -> Text -> GitLab (Either (Response ByteString) [Member])
membersOfEntity' Int
projectId Text
"groups"

-- | adds all registered users to a group.
addAllUsersToGroup ::
  -- | group name
  Text ->
  -- | level of access granted
  AccessLevel ->
  GitLab [Either (Response BSL.ByteString) (Maybe Member)]
addAllUsersToGroup :: Text
-> AccessLevel
-> GitLab [Either (Response ByteString) (Maybe Member)]
addAllUsersToGroup Text
groupName AccessLevel
access = do
  [User]
allRegisteredUsers <- GitLab [User]
allUsers
  let allUserIds :: [Text]
allUserIds = (User -> Text) -> [User] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map User -> Text
user_username [User]
allRegisteredUsers
  Text
-> AccessLevel
-> [Text]
-> GitLab [Either (Response ByteString) (Maybe Member)]
addUsersToGroup' Text
groupName AccessLevel
access [Text]
allUserIds

-- | adds a user to a group.
addUserToGroup ::
  -- | group name
  Text ->
  -- | level of access granted
  AccessLevel ->
  -- | the user
  User ->
  GitLab (Either (Response BSL.ByteString) (Maybe Member))
addUserToGroup :: Text
-> AccessLevel
-> User
-> GitLab (Either (Response ByteString) (Maybe Member))
addUserToGroup Text
groupName AccessLevel
access User
usr =
  Text
-> AccessLevel
-> Int
-> GitLab (Either (Response ByteString) (Maybe Member))
addUserToGroup' Text
groupName AccessLevel
access (User -> Int
user_id User
usr)

-- | adds a user with a given user ID to a group.
addUserToGroup' ::
  -- | group name
  Text ->
  -- | level of access granted
  AccessLevel ->
  -- | user ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe Member))
addUserToGroup' :: Text
-> AccessLevel
-> Int
-> GitLab (Either (Response ByteString) (Maybe Member))
addUserToGroup' Text
groupName AccessLevel
access Int
usrId = do
  Either (Response ByteString) [Group]
attempt <- Text -> GitLab (Either (Response ByteString) [Group])
groupsWithNameOrPath Text
groupName
  case Either (Response ByteString) [Group]
attempt of
    Left Response ByteString
resp -> Either (Response ByteString) (Maybe Member)
-> GitLab (Either (Response ByteString) (Maybe Member))
forall (m :: * -> *) a. Monad m => a -> m a
return (Response ByteString -> Either (Response ByteString) (Maybe Member)
forall a b. a -> Either a b
Left Response ByteString
resp)
    Right [] ->
      Either (Response ByteString) (Maybe Member)
-> GitLab (Either (Response ByteString) (Maybe Member))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Member -> Either (Response ByteString) (Maybe Member)
forall a b. b -> Either a b
Right Maybe Member
forall a. Maybe a
Nothing)
    Right [Group
grp] ->
      Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Member))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr [GitLabParam]
params
      where
        params :: [GitLabParam]
        params :: [GitLabParam]
params =
          [ (ByteString
"user_id", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
usrId)))),
            (ByteString
"access_level", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack (AccessLevel -> String
forall a. Show a => a -> String
show AccessLevel
access))))
          ]
        addr :: Text
addr =
          Text
"/groups/"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8 (Bool -> ByteString -> ByteString
urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Group -> Int
group_id Group
grp)))))
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/members"
    Right (Group
_ : [Group]
_) ->
      Either (Response ByteString) (Maybe Member)
-> GitLab (Either (Response ByteString) (Maybe Member))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Member -> Either (Response ByteString) (Maybe Member)
forall a b. b -> Either a b
Right Maybe Member
forall a. Maybe a
Nothing)

-- | adds a list of users to a group.
addUsersToGroup ::
  -- | group name
  Text ->
  -- | level of access granted
  AccessLevel ->
  -- | list of usernames to be added to the group
  [User] ->
  GitLab [Either (Response BSL.ByteString) (Maybe Member)]
addUsersToGroup :: Text
-> AccessLevel
-> [User]
-> GitLab [Either (Response ByteString) (Maybe Member)]
addUsersToGroup Text
groupName AccessLevel
access =
  (User -> GitLab (Either (Response ByteString) (Maybe Member)))
-> [User] -> GitLab [Either (Response ByteString) (Maybe Member)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text
-> AccessLevel
-> User
-> GitLab (Either (Response ByteString) (Maybe Member))
addUserToGroup Text
groupName AccessLevel
access)

-- | adds a list of users to a group.
addUsersToGroup' ::
  -- | group name
  Text ->
  -- | level of access granted
  AccessLevel ->
  -- | list of usernames to be added to the group
  [Text] ->
  GitLab [Either (Response BSL.ByteString) (Maybe Member)]
addUsersToGroup' :: Text
-> AccessLevel
-> [Text]
-> GitLab [Either (Response ByteString) (Maybe Member)]
addUsersToGroup' Text
groupName AccessLevel
access [Text]
usernames = do
  [User]
users <- [Maybe User] -> [User]
forall a. [Maybe a] -> [a]
catMaybes ([Maybe User] -> [User])
-> ReaderT GitLabState IO [Maybe User] -> GitLab [User]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Text -> ReaderT GitLabState IO (Maybe User))
-> [Text] -> ReaderT GitLabState IO [Maybe User]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Text -> ReaderT GitLabState IO (Maybe User)
searchUser [Text]
usernames
  (User -> GitLab (Either (Response ByteString) (Maybe Member)))
-> [User] -> GitLab [Either (Response ByteString) (Maybe Member)]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM (Text
-> AccessLevel
-> Int
-> GitLab (Either (Response ByteString) (Maybe Member))
addUserToGroup' Text
groupName AccessLevel
access (Int -> GitLab (Either (Response ByteString) (Maybe Member)))
-> (User -> Int)
-> User
-> GitLab (Either (Response ByteString) (Maybe Member))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. User -> Int
user_id) [User]
users

-- | Removes a user from a project where the user has been explicitly assigned a role
removeUserFromProject ::
  -- | project name
  Text ->
  -- | user
  User ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
removeUserFromProject :: Text -> User -> GitLab (Either (Response ByteString) (Maybe ()))
removeUserFromProject Text
grpName User
usr =
  Text
-> Text -> User -> GitLab (Either (Response ByteString) (Maybe ()))
removeUserFromEntity Text
grpName Text
"projects" User
usr

-- | Removes a user from a project where the user has been explicitly assigned a role
removeUserFromProject' ::
  -- | project name
  Text ->
  -- | user ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
removeUserFromProject' :: Text -> Int -> GitLab (Either (Response ByteString) (Maybe ()))
removeUserFromProject' Text
grpName Int
usrId =
  Text
-> Text -> Int -> GitLab (Either (Response ByteString) (Maybe ()))
removeUserFromEntity' Text
grpName Text
"projects" Int
usrId

-- | Removes a user from a group where the user has been explicitly assigned a role
removeUserFromGroup ::
  -- | group name
  Text ->
  -- | user
  User ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
removeUserFromGroup :: Text -> User -> GitLab (Either (Response ByteString) (Maybe ()))
removeUserFromGroup Text
grpName User
usr =
  Text
-> Text -> User -> GitLab (Either (Response ByteString) (Maybe ()))
removeUserFromEntity Text
grpName Text
"groups" User
usr

-- | Removes a user from a group where the user has been explicitly assigned a role
removeUserFromGroup' ::
  -- | group name
  Text ->
  -- | user ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
removeUserFromGroup' :: Text -> Int -> GitLab (Either (Response ByteString) (Maybe ()))
removeUserFromGroup' Text
grpName Int
usrId =
  Text
-> Text -> Int -> GitLab (Either (Response ByteString) (Maybe ()))
removeUserFromEntity' Text
grpName Text
"groups" Int
usrId

-----------------------
-- Internal functions.

-- | removes a user from a group or project.
removeUserFromEntity ::
  -- | group name
  Text ->
  -- | entity ("groups" or "projects)
  Text ->
  -- | user
  User ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
removeUserFromEntity :: Text
-> Text -> User -> GitLab (Either (Response ByteString) (Maybe ()))
removeUserFromEntity Text
groupName Text
entity User
usr =
  Text
-> Text -> Int -> GitLab (Either (Response ByteString) (Maybe ()))
removeUserFromEntity' Text
groupName Text
entity (User -> Int
user_id User
usr)

-- | removes a user with a given user ID from a group or project.
removeUserFromEntity' ::
  -- | group name
  Text ->
  -- | entity ("groups" or "projects")
  Text ->
  -- | user ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
removeUserFromEntity' :: Text
-> Text -> Int -> GitLab (Either (Response ByteString) (Maybe ()))
removeUserFromEntity' Text
groupName Text
entity Int
usrId = do
  Either (Response ByteString) [Group]
attempt <- Text -> GitLab (Either (Response ByteString) [Group])
groupsWithNameOrPath Text
groupName
  case Either (Response ByteString) [Group]
attempt of
    Left Response ByteString
resp -> Either (Response ByteString) (Maybe ())
-> GitLab (Either (Response ByteString) (Maybe ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Response ByteString -> Either (Response ByteString) (Maybe ())
forall a b. a -> Either a b
Left Response ByteString
resp)
    Right [] ->
      Either (Response ByteString) (Maybe ())
-> GitLab (Either (Response ByteString) (Maybe ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe () -> Either (Response ByteString) (Maybe ())
forall a b. b -> Either a b
Right Maybe ()
forall a. Maybe a
Nothing)
    Right [Group
grp] -> do
      Either (Response ByteString) (Maybe Version)
result <- Text -> GitLab (Either (Response ByteString) (Maybe Version))
forall a.
FromJSON a =>
Text -> GitLab (Either (Response ByteString) (Maybe a))
gitlabDelete Text
addr
      case Either (Response ByteString) (Maybe Version)
result of
        Left Response ByteString
err -> Either (Response ByteString) (Maybe ())
-> GitLab (Either (Response ByteString) (Maybe ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Response ByteString -> Either (Response ByteString) (Maybe ())
forall a b. a -> Either a b
Left Response ByteString
err)
        -- GitLab version 14.2.3 returns Version JSON info when a
        -- member is removed from a group/project. I'm not sure if
        -- this is new behaviour, anyway we catch it here.
        Right (Just (Version {})) -> Either (Response ByteString) (Maybe ())
-> GitLab (Either (Response ByteString) (Maybe ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe () -> Either (Response ByteString) (Maybe ())
forall a b. b -> Either a b
Right (() -> Maybe ()
forall a. a -> Maybe a
Just ()))
        Right Maybe Version
Nothing -> Either (Response ByteString) (Maybe ())
-> GitLab (Either (Response ByteString) (Maybe ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe () -> Either (Response ByteString) (Maybe ())
forall a b. b -> Either a b
Right (() -> Maybe ()
forall a. a -> Maybe a
Just ()))
      where
        addr :: Text
addr =
          Text
"/"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
entity
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8 (Bool -> ByteString -> ByteString
urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Group -> Int
group_id Group
grp)))))
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/members/"
            Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8 (Bool -> ByteString -> ByteString
urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
usrId))))
    Right (Group
_ : [Group]
_) ->
      Either (Response ByteString) (Maybe ())
-> GitLab (Either (Response ByteString) (Maybe ()))
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe () -> Either (Response ByteString) (Maybe ())
forall a b. b -> Either a b
Right Maybe ()
forall a. Maybe a
Nothing)

-- | the members of a project given its ID.
membersOfEntity' ::
  -- | group or project ID
  Int ->
  -- | entity ("groups" or "projects")
  Text ->
  GitLab (Either (Response BSL.ByteString) [Member])
membersOfEntity' :: Int -> Text -> GitLab (Either (Response ByteString) [Member])
membersOfEntity' Int
projectId Text
entity =
  Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) [Member])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
addr []
  where
    addr :: Text
addr =
      Text
"/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
entity
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/members"