{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE OverloadedStrings #-}
module GitLab.API.Groups where
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Network.HTTP.Types.Status
import Network.HTTP.Types.URI
import qualified Data.ByteString.Char8 as C
import GitLab.API.Members
import GitLab.API.Users
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
groupsWithNameOrPath :: (MonadUnliftIO m, MonadIO m)
=> Text
-> GitLab m [Group]
groupsWithNameOrPath groupName =
filter (\group ->
groupName == group_name group
|| groupName == group_path group
) <$>
gitlabWithAttrs "/groups" ("&search=" <> groupName)
addAllUsersToGroup ::
(MonadIO m, MonadUnliftIO m)
=> Text
-> AccessLevel
-> GitLab m [Either Status Member]
addAllUsersToGroup groupName access = do
allRegisteredUsers <- allUsers
let allUserIds = map user_username allRegisteredUsers
addUsersToGroup' groupName access allUserIds
addUserToGroup ::
(MonadIO m, MonadUnliftIO m)
=> Text
-> AccessLevel
-> User
-> GitLab m (Either Status Member)
addUserToGroup groupName access usr =
addUserToGroup' groupName access (user_id usr)
addUserToGroup' ::
(MonadIO m, MonadUnliftIO m)
=> Text
-> AccessLevel
-> Int
-> GitLab m (Either Status Member)
addUserToGroup' groupName access userId = do
groups <- groupsWithNameOrPath groupName
case groups of
[] -> return (Left (mkStatus 404 (C.pack "cannot find group")))
[grp] ->
gitlabPost addr dataBody
where
dataBody :: Text
dataBody =
"user_id=" <> T.pack (show userId) <> "&access_level=" <>
T.pack (show access)
addr = "/groups/"
<> T.decodeUtf8 (urlEncode False (T.encodeUtf8 (T.pack (show (group_id grp)))))
<> "/members"
(_:_) ->
return (Left (mkStatus 404 (C.pack "too many groups found")))
addUsersToGroup ::
(MonadIO m, MonadUnliftIO m)
=> Text
-> AccessLevel
-> [User]
-> GitLab m [Either Status Member]
addUsersToGroup groupName access =
mapM (addUserToGroup groupName access)
addUsersToGroup' ::
(MonadIO m, MonadUnliftIO m)
=> Text
-> AccessLevel
-> [Text]
-> GitLab m [Either Status Member]
addUsersToGroup' groupName access usernames = do
users <- catMaybes <$> mapM searchUser usernames
mapM (addUserToGroup' groupName access . user_id) users