{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
module GitLab.API.Groups where
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import GitLab.API.Members
import GitLab.API.Users
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
import Network.HTTP.Types.Status
import Network.HTTP.Types.URI
groupsWithNameOrPath ::
Text ->
GitLab (Either Status [Group])
groupsWithNameOrPath groupName = do
result <- gitlabWithAttrs "/groups" ("&search=" <> groupName)
case result of
Left {} -> return result
Right groups ->
return
( Right
$filter
( \group ->
groupName == group_name group
|| groupName == group_path group
)
groups
)
addAllUsersToGroup ::
Text ->
AccessLevel ->
GitLab [Either Status Member]
addAllUsersToGroup groupName access = do
allRegisteredUsers <- allUsers
let allUserIds = map user_username allRegisteredUsers
addUsersToGroup' groupName access allUserIds
addUserToGroup ::
Text ->
AccessLevel ->
User ->
GitLab (Either Status Member)
addUserToGroup groupName access usr =
addUserToGroup' groupName access (user_id usr)
addUserToGroup' ::
Text ->
AccessLevel ->
Int ->
GitLab (Either Status Member)
addUserToGroup' groupName access userId = do
attempt <- groupsWithNameOrPath groupName
case attempt of
Left httpStatus -> return (Left httpStatus)
Right [] -> return (Left (mkStatus 404 (T.encodeUtf8 (T.pack "cannot find group"))))
Right [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"
Right (_ : _) ->
return (Left (mkStatus 404 (T.encodeUtf8 (T.pack "too many groups found"))))
addUsersToGroup ::
Text ->
AccessLevel ->
[User] ->
GitLab [Either Status Member]
addUsersToGroup groupName access =
mapM (addUserToGroup groupName access)
addUsersToGroup' ::
Text ->
AccessLevel ->
[Text] ->
GitLab [Either Status Member]
addUsersToGroup' groupName access usernames = do
users <- catMaybes <$> mapM searchUser usernames
mapM (addUserToGroup' groupName access . user_id) users