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

-- |
-- Module      : Projects
-- Description : Queries about projects
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.API.Projects
  ( -- * List all projects
    projects,

    -- * Get single project
    project,

    -- * Get project users
    projectUsers,

    -- * User projects
    userProjects,

    -- * starredProjects
    starredProjects,

    -- * project groups
    projectGroups,

    -- * create project
    createProject,
    createProjectForUser,

    -- * edit project
    editProject,

    -- * fork project
    forkProject,

    -- * forks of project
    projectForks,

    -- * starring projects
    starProject,
    unstarProject,
    projectStarrers,

    -- * archving projects
    archiveProject,
    unarchiveProject,

    -- * delete project
    deleteProject,

    -- * share projects with groups
    shareProjectWithGroup,
    unshareProjectWithGroup,

    -- * impport project members
    importMembersFromProject,

    -- * fork relationship
    forkRelation,
    unforkRelation,

    -- * Search for projects
    projectsWithName,
    projectWithPathAndName,

    -- * housekeeping
    houseKeeping,

    -- * Transfer projects
    transferProject,

    -- * Additional functionality beyond the GitLab Projects API
    multipleCommitters,
    commitsEmailAddresses,
    projectOfIssue,
    -- issuesCreatedByUser,
    -- issuesOnForks,
    -- projectMemebersCount,
    projectCISuccess,
    -- namespacePathToUserId,
    projectDiffs,
    addGroupToProject,
    -- transferProject,
    -- transferProject',
    defaultProjectAttrs,
    defaultProjectSearchAttrs,
    ProjectAttrs (..),
    ProjectSearchAttrs (..),
    EnabledDisabled (..),
    AutoDeployStrategy (..),
    GitStrategy (..),
    ProjectSettingAccessLevel (..),
    MergeMethod (..),
    SquashOption (..),
  )
where

import qualified Data.ByteString.Lazy as BSL
import Data.Either
import Data.List
import Data.Maybe
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import Data.Time.Clock
import GHC.Generics
import GitLab.API.Commits
import GitLab.API.Members
import GitLab.API.Pipelines
import GitLab.API.Users
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
import Network.HTTP.Client
import Network.HTTP.Types.URI

-- | Get a list of all visible projects across GitLab for the
-- authenticated user. When accessed without authentication, only
-- public projects with simple fields are returned.
projects ::
  -- | project filters
  ProjectSearchAttrs ->
  GitLab [Project]
projects :: ProjectSearchAttrs -> GitLab [Project]
projects ProjectSearchAttrs
attrs =
  forall b a. b -> Either a b -> b
fromRight (forall a. HasCallStack => [Char] -> a
error [Char]
"projects error")
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany
      Text
"/projects"
      (ProjectSearchAttrs -> [GitLabParam]
projectSearchAttrsParams ProjectSearchAttrs
attrs)

-- | Get a specific project. This endpoint can be accessed without
-- authentication if the project is publicly accessible.
project ::
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe Project))
project :: Int -> GitLab (Either (Response ByteString) (Maybe Project))
project Int
pId = do
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne Text
urlPath []
  where
    urlPath :: Text
urlPath =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
pId)

-- | Get the users list of a project.
projectUsers ::
  Project ->
  GitLab (Either (Response BSL.ByteString) [User])
projectUsers :: Project -> GitLab (Either (Response ByteString) [User])
projectUsers Project
prj = do
  Int -> GitLab (Either (Response ByteString) [User])
projectUsers' (Project -> Int
project_id Project
prj)

-- | Get the users list of a project.
projectUsers' ::
  Int ->
  GitLab (Either (Response BSL.ByteString) [User])
projectUsers' :: Int -> GitLab (Either (Response ByteString) [User])
projectUsers' Int
pId = do
  forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
urlPath []
  where
    urlPath :: Text
urlPath =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
pId)
        forall a. Semigroup a => a -> a -> a
<> Text
"/users"

-- | gets all projects for a user given their username.
--
-- > userProjects "harry"
userProjects' :: Text -> ProjectSearchAttrs -> GitLab (Maybe [Project])
userProjects' :: Text -> ProjectSearchAttrs -> GitLab (Maybe [Project])
userProjects' Text
username ProjectSearchAttrs
attrs = do
  Maybe User
userMaybe <- Text -> GitLab (Maybe User)
searchUser Text
username
  case Maybe User
userMaybe of
    Maybe User
Nothing -> forall (m :: * -> *) a. Monad m => a -> m a
return forall a. Maybe a
Nothing
    Just User
usr -> do
      Either (Response ByteString) [Project]
result <-
        forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany
          (forall {a}. Show a => a -> Text
urlPath (User -> Int
user_id User
usr))
          (ProjectSearchAttrs -> [GitLabParam]
projectSearchAttrsParams ProjectSearchAttrs
attrs)
      case Either (Response ByteString) [Project]
result of
        Left Response ByteString
_ -> forall a. HasCallStack => [Char] -> a
error [Char]
"userProjects' error"
        Right [Project]
projs -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a. a -> Maybe a
Just [Project]
projs)
  where
    urlPath :: a -> Text
urlPath a
usrId = Text
"/users/" forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show a
usrId) forall a. Semigroup a => a -> a -> a
<> Text
"/projects"

-- | gets all projects for a user.
--
-- > userProjects myUser
userProjects :: User -> ProjectSearchAttrs -> GitLab (Maybe [Project])
userProjects :: User -> ProjectSearchAttrs -> GitLab (Maybe [Project])
userProjects User
theUser =
  Text -> ProjectSearchAttrs -> GitLab (Maybe [Project])
userProjects' (User -> Text
user_username User
theUser)

-- | Get a list of visible projects starred by the given user. When
-- accessed without authentication, only public projects are returned.
--
-- > userProjects myUser
starredProjects :: User -> ProjectSearchAttrs -> GitLab [Project]
starredProjects :: User -> ProjectSearchAttrs -> GitLab [Project]
starredProjects User
usr ProjectSearchAttrs
attrs = do
  forall b a. b -> Either a b -> b
fromRight (forall a. HasCallStack => [Char] -> a
error [Char]
"starredProjects error")
    forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany
      ( Text
"/users/"
          forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (User -> Int
user_id User
usr))
          forall a. Semigroup a => a -> a -> a
<> Text
"/starred_projects"
      )
      (ProjectSearchAttrs -> [GitLabParam]
projectSearchAttrsParams ProjectSearchAttrs
attrs)

-- | Get a list of ancestor groups for this project.
projectGroups ::
  Project ->
  GitLab (Either (Response BSL.ByteString) [Group])
projectGroups :: Project -> GitLab (Either (Response ByteString) [Group])
projectGroups Project
prj = do
  Int -> GitLab (Either (Response ByteString) [Group])
projectGroups' (Project -> Int
project_id Project
prj)

-- | Get a list of ancestor groups for this project.
projectGroups' ::
  Int ->
  GitLab (Either (Response BSL.ByteString) [Group])
projectGroups' :: Int -> GitLab (Either (Response ByteString) [Group])
projectGroups' Int
gId = do
  forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
urlPath []
  where
    urlPath :: Text
urlPath =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
gId)
        forall a. Semigroup a => a -> a -> a
<> Text
"/groups"

-- | Creates a new project owned by the authenticated user.
createProject ::
  Text ->
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Project))
createProject :: Text
-> Text -> GitLab (Either (Response ByteString) (Maybe Project))
createProject Text
nameTxt Text
pathTxt = do
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
newProjectAddr [(ByteString
"name", forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
nameTxt)), (ByteString
"path", forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
pathTxt))]
  where
    newProjectAddr :: Text
    newProjectAddr :: Text
newProjectAddr =
      Text
"/projects"

-- | Creates a new project owned by the specified user. Available only
-- for administrators.
createProjectForUser ::
  -- | user to create the project for
  User ->
  -- | name of the new project
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Project))
createProjectForUser :: User
-> Text -> GitLab (Either (Response ByteString) (Maybe Project))
createProjectForUser User
usrId Text
nameTxt = do
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
newProjectAddr [(ByteString
"name", forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
nameTxt))]
  where
    newProjectAddr :: Text
    newProjectAddr :: Text
newProjectAddr =
      Text
"/projects"
        forall a. Semigroup a => a -> a -> a
<> Text
"/user/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show User
usrId)

-- | Edit a project. The 'defaultProjectAttrs' value has default project
-- search values, which is a record that can be modified with 'Just'
-- values.
--
-- For example to disable project specific email notifications:
--
-- > editProject myProject (defaultProjectAttrs { project_edit_emails_disabled = Just True })
editProject ::
  -- | project
  Project ->
  -- | project attributes
  ProjectAttrs ->
  GitLab (Either (Response BSL.ByteString) Project)
editProject :: Project
-> ProjectAttrs -> GitLab (Either (Response ByteString) Project)
editProject Project
prj = Int
-> ProjectAttrs -> GitLab (Either (Response ByteString) Project)
editProject' (Project -> Int
project_id Project
prj)

-- | Edit a project. The 'defaultProjectAttrs' value has default project
-- search values, which is a record that can be modified with 'Just'
-- values.
--
-- For example to disable project specific email notifications for a
-- project with project ID 11744514:
--
-- > editProject' 11744514 (defaultProjectAttrs { project_edit_emails_disabled = Just True })
editProject' ::
  -- | project ID
  Int ->
  -- | project attributes
  ProjectAttrs ->
  GitLab (Either (Response BSL.ByteString) Project)
editProject' :: Int
-> ProjectAttrs -> GitLab (Either (Response ByteString) Project)
editProject' Int
projId ProjectAttrs
attrs = do
  let urlPath :: Text
urlPath =
        Text
"/projects/"
          forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
projId)
  Either (Response ByteString) (Maybe Project)
result <-
    forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPut
      Text
urlPath
      (ProjectAttrs -> [GitLabParam]
projectAttrsParams ProjectAttrs
attrs)
  case Either (Response ByteString) (Maybe Project)
result of
    Left Response ByteString
resp -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left Response ByteString
resp)
    Right Maybe Project
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"editProject error"
    Right (Just Project
proj) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Project
proj)

-- | Forks a project into the user namespace of the authenticated user
-- or the one provided.
forkProject ::
  -- project to fork
  Project ->
  GitLab (Either (Response BSL.ByteString) (Maybe Project))
forkProject :: Project -> GitLab (Either (Response ByteString) (Maybe Project))
forkProject Project
prj =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr [GitLabParam]
params
  where
    params :: [GitLabParam]
    params :: [GitLabParam]
params = []
    addr :: Text
addr =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
prj))
        forall a. Semigroup a => a -> a -> a
<> Text
"/fork"

-- | List the projects accessible to the calling user that have an
-- established, forked relationship with the specified project
--
-- > projectForks "project1"
-- > projectForks "group1/project1"
projectForks ::
  -- | name or namespace of the project
  Text ->
  GitLab (Either (Response BSL.ByteString) [Project])
projectForks :: Text -> GitLab (Either (Response ByteString) [Project])
projectForks Text
projectName = do
  let urlPath :: Text
urlPath =
        Text
"/projects/"
          forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8 (Bool -> ByteString -> ByteString
urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 Text
projectName))
          forall a. Semigroup a => a -> a -> a
<> Text
"/forks"
  forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
urlPath []

-- | Stars a given project.
starProject ::
  -- project to star
  Project ->
  GitLab (Either (Response BSL.ByteString) (Maybe Project))
starProject :: Project -> GitLab (Either (Response ByteString) (Maybe Project))
starProject Project
prj =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr [GitLabParam]
params
  where
    params :: [GitLabParam]
    params :: [GitLabParam]
params = []
    addr :: Text
addr =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
prj))
        forall a. Semigroup a => a -> a -> a
<> Text
"/star"

-- | Stars a given project.
unstarProject ::
  -- project to star
  Project ->
  GitLab (Either (Response BSL.ByteString) (Maybe Project))
unstarProject :: Project -> GitLab (Either (Response ByteString) (Maybe Project))
unstarProject Project
prj =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr [GitLabParam]
params
  where
    params :: [GitLabParam]
    params :: [GitLabParam]
params = []
    addr :: Text
addr =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
prj))
        forall a. Semigroup a => a -> a -> a
<> Text
"/unstar"

-- | List the users who starred the specified project.
projectStarrers ::
  Project ->
  GitLab (Either (Response BSL.ByteString) [Group])
projectStarrers :: Project -> GitLab (Either (Response ByteString) [Group])
projectStarrers Project
prj = do
  forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
urlPath []
  where
    urlPath :: Text
urlPath =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
prj))
        forall a. Semigroup a => a -> a -> a
<> Text
"/starrers"

-- | Archives the project if the user is either an administrator or
-- the owner of this project.
archiveProject ::
  -- project to archive
  Project ->
  GitLab (Either (Response BSL.ByteString) (Maybe Project))
archiveProject :: Project -> GitLab (Either (Response ByteString) (Maybe Project))
archiveProject Project
prj =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr [GitLabParam]
params
  where
    params :: [GitLabParam]
    params :: [GitLabParam]
params = []
    addr :: Text
addr =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
prj))
        forall a. Semigroup a => a -> a -> a
<> Text
"/archive"

-- | Unarchives the project if the user is either an administrator or
-- the owner of this project.
unarchiveProject ::
  -- project to unarchive
  Project ->
  GitLab (Either (Response BSL.ByteString) (Maybe Project))
unarchiveProject :: Project -> GitLab (Either (Response ByteString) (Maybe Project))
unarchiveProject Project
prj =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr [GitLabParam]
params
  where
    params :: [GitLabParam]
    params :: [GitLabParam]
params = []
    addr :: Text
addr =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
prj))
        forall a. Semigroup a => a -> a -> a
<> Text
"/unarchive"

-- | Deletes a project including all associated resources.
deleteProject ::
  Project ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
deleteProject :: Project -> GitLab (Either (Response ByteString) (Maybe ()))
deleteProject Project
prj = do
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabDelete Text
projAddr []
  where
    projAddr :: Text
    projAddr :: Text
projAddr =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
prj))

-- | Allow to share project with group.
shareProjectWithGroup ::
  -- | group ID
  Int ->
  -- | project
  Project ->
  -- | level of access granted
  AccessLevel ->
  GitLab (Either (Response BSL.ByteString) (Maybe Project))
shareProjectWithGroup :: Int
-> Project
-> AccessLevel
-> GitLab (Either (Response ByteString) (Maybe Project))
shareProjectWithGroup Int
groupId Project
prj AccessLevel
access =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr [GitLabParam]
params
  where
    params :: [GitLabParam]
    params :: [GitLabParam]
params =
      [ (ByteString
"group_id", forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
groupId)))),
        (ByteString
"group_access", forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show AccessLevel
access))))
      ]
    addr :: Text
addr =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
prj))
        forall a. Semigroup a => a -> a -> a
<> Text
"/share"

-- | Unshare the project from the group.
unshareProjectWithGroup ::
  -- | group ID
  Int ->
  -- | project
  Project ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
unshareProjectWithGroup :: Int -> Project -> GitLab (Either (Response ByteString) (Maybe ()))
unshareProjectWithGroup Int
groupId Project
prj =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabDelete Text
addr []
  where
    addr :: Text
addr =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
prj))
        forall a. Semigroup a => a -> a -> a
<> Text
"/share/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
groupId)

-- | Import members from another project.
importMembersFromProject ::
  -- | project to receive memvers
  Project ->
  -- | source project to import members from
  Project ->
  GitLab
    (Either (Response BSL.ByteString) (Maybe Project))
importMembersFromProject :: Project
-> Project -> GitLab (Either (Response ByteString) (Maybe Project))
importMembersFromProject Project
toPrj Project
fromPrj =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr []
  where
    addr :: Text
addr =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
toPrj))
        forall a. Semigroup a => a -> a -> a
<> Text
"/import_project_members/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
fromPrj))

-- | Allows modification of the forked relationship between existing
-- projects. Available only for project owners and administrators.
forkRelation ::
  -- | forked project
  Project ->
  -- | project that was forked from
  Project ->
  GitLab
    (Either (Response BSL.ByteString) (Maybe Project))
forkRelation :: Project
-> Project -> GitLab (Either (Response ByteString) (Maybe Project))
forkRelation Project
toPrj Project
fromPrj =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr []
  where
    addr :: Text
addr =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
toPrj))
        forall a. Semigroup a => a -> a -> a
<> Text
"/fork/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
fromPrj))

-- | Delete an existing forked from relationship.
unforkRelation ::
  -- | forked project
  Project ->
  GitLab
    (Either (Response BSL.ByteString) (Maybe ()))
unforkRelation :: Project -> GitLab (Either (Response ByteString) (Maybe ()))
unforkRelation Project
prj =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabDelete Text
addr []
  where
    addr :: Text
addr =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
prj))
        forall a. Semigroup a => a -> a -> a
<> Text
"/fork"

-- | gets all projects with the given project name. It only returns
-- projects with an exact match with the project path.
--
-- > projectsWithName "project1"
projectsWithName ::
  -- | project name being searched for.
  Text ->
  GitLab [Project]
projectsWithName :: Text -> GitLab [Project]
projectsWithName Text
projectName = do
  [Project]
foundProjects <-
    forall b a. b -> Either a b -> b
fromRight (forall a. HasCallStack => [Char] -> a
error [Char]
"projectsWithName error")
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany
        Text
"/projects"
        [(ByteString
"search", forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
projectName))]
  forall (m :: * -> *) a. Monad m => a -> m a
return forall a b. (a -> b) -> a -> b
$
    forall a. (a -> Bool) -> [a] -> [a]
filter (\Project
prj -> Text
projectName forall a. Eq a => a -> a -> Bool
== Project -> Text
project_path Project
prj) [Project]
foundProjects

-- | gets a project with the given name for the given full path of the
--   namespace. E.g.
--
-- > projectWithPathAndName "user1" "project1"
--
-- looks for "user1/project1"
--
-- > projectWithPathAndName "group1/subgroup1" "project1"
--
-- looks for "project1" within the namespace with full path "group1/subgroup1"
projectWithPathAndName :: Text -> Text -> GitLab (Either (Response BSL.ByteString) (Maybe Project))
projectWithPathAndName :: Text
-> Text -> GitLab (Either (Response ByteString) (Maybe Project))
projectWithPathAndName Text
namespaceFullPath Text
projectName = do
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne
    ( Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8
          ( Bool -> ByteString -> ByteString
urlEncode
              Bool
False
              ( Text -> ByteString
T.encodeUtf8
                  (Text
namespaceFullPath forall a. Semigroup a => a -> a -> a
<> Text
"/" forall a. Semigroup a => a -> a -> a
<> Text
projectName)
              )
          )
    )
    [(ByteString
"statistics", forall a. a -> Maybe a
Just ByteString
"true")]

-- | Start the Housekeeping task for a project.
houseKeeping ::
  -- | the project
  Project ->
  GitLab (Either (Response BSL.ByteString) (Maybe Project))
houseKeeping :: Project -> GitLab (Either (Response ByteString) (Maybe Project))
houseKeeping Project
prj =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr []
  where
    addr :: Text
addr =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
prj))
        forall a. Semigroup a => a -> a -> a
<> Text
"/housekeeping"

-- | transfer a project to a new namespace.
transferProject ::
  -- | project
  Project ->
  -- | namespace where to transfer project to
  Text ->
  GitLab (Either (Response BSL.ByteString) Project)
transferProject :: Project -> Text -> GitLab (Either (Response ByteString) Project)
transferProject Project
prj = Int -> Text -> GitLab (Either (Response ByteString) Project)
transferProject' (Project -> Int
project_id Project
prj)

-- | edit a project.
transferProject' ::
  -- | project ID
  Int ->
  -- | namespace where to transfer project to
  Text ->
  GitLab (Either (Response BSL.ByteString) Project)
transferProject' :: Int -> Text -> GitLab (Either (Response ByteString) Project)
transferProject' Int
projId Text
namespaceString = do
  let urlPath :: Text
urlPath =
        Text
"/projects/"
          forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
projId)
          forall a. Semigroup a => a -> a -> a
<> Text
"/transfer"
  Either (Response ByteString) (Maybe Project)
result <-
    forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPut
      Text
urlPath
      [ (ByteString
"id", forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
projId)))),
        (ByteString
"namespace", forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
namespaceString))
      ]
  case Either (Response ByteString) (Maybe Project)
result of
    Left Response ByteString
resp -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. a -> Either a b
Left Response ByteString
resp)
    Right Maybe Project
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"transferProject error"
    Right (Just Project
proj) -> forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. b -> Either a b
Right Project
proj)

--------------------
-- Additional functionality beyond the GitLab Projects API

-- | Returns 'True' is a projecthas multiple email addresses
-- associated with all commits in a project, 'False' otherwise.
multipleCommitters :: Project -> GitLab Bool
multipleCommitters :: Project -> GitLab Bool
multipleCommitters Project
prj = do
  [Text]
emailAddresses <- Project -> GitLab [Text]
commitsEmailAddresses Project
prj
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall (t :: * -> *) a. Foldable t => t a -> Int
length (forall a. Eq a => [a] -> [a]
nub [Text]
emailAddresses) forall a. Ord a => a -> a -> Bool
> Int
1)

-- | gets the email addresses in the author information in all commit
-- for a project.
commitsEmailAddresses :: Project -> GitLab [Text]
commitsEmailAddresses :: Project -> GitLab [Text]
commitsEmailAddresses Project
prj = do
  [Commit]
commits <- Project -> GitLab [Commit]
repoCommits Project
prj
  forall (m :: * -> *) a. Monad m => a -> m a
return (forall a b. (a -> b) -> [a] -> [b]
map Commit -> Text
commit_author_email [Commit]
commits)

-- | gets the 'GitLab.Types.Project' against which the given 'Issue'
-- was created.
projectOfIssue :: Issue -> GitLab Project
projectOfIssue :: Issue -> GitLab Project
projectOfIssue Issue
iss = do
  let prId :: Int
prId = forall a. a -> Maybe a -> a
fromMaybe (forall a. HasCallStack => [Char] -> a
error [Char]
"projectOfIssue error") (Issue -> Maybe Int
issue_project_id Issue
iss)
  Either (Response ByteString) (Maybe Project)
result <- Int -> GitLab (Either (Response ByteString) (Maybe Project))
project Int
prId
  case forall b a. b -> Either a b -> b
fromRight (forall a. HasCallStack => [Char] -> a
error [Char]
"projectOfIssue error") Either (Response ByteString) (Maybe Project)
result of
    Maybe Project
Nothing -> forall a. HasCallStack => [Char] -> a
error [Char]
"projectOfIssue error"
    Just Project
proj -> forall (m :: * -> *) a. Monad m => a -> m a
return Project
proj

-- | gets all diffs in a project for a given commit SHA.
projectDiffs :: Project -> Text -> GitLab (Either (Response BSL.ByteString) [Diff])
projectDiffs :: Project -> Text -> GitLab (Either (Response ByteString) [Diff])
projectDiffs Project
proj =
  Int -> Text -> GitLab (Either (Response ByteString) [Diff])
projectDiffs' (Project -> Int
project_id Project
proj)

-- | gets all diffs in a project for a given project ID, for a given
-- commit SHA.
projectDiffs' :: Int -> Text -> GitLab (Either (Response BSL.ByteString) [Diff])
projectDiffs' :: Int -> Text -> GitLab (Either (Response ByteString) [Diff])
projectDiffs' Int
projId Text
commitSha =
  forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany
    ( Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
projId)
        forall a. Semigroup a => a -> a -> a
<> Text
"/repository/commits/"
        forall a. Semigroup a => a -> a -> a
<> Text
commitSha
        forall a. Semigroup a => a -> a -> a
<> Text
"/diff/"
    )
    []

-- | add a group to a project.
addGroupToProject ::
  -- | group ID
  Int ->
  -- | project ID
  Int ->
  -- | level of access granted
  AccessLevel ->
  GitLab (Either (Response BSL.ByteString) (Maybe GroupShare))
addGroupToProject :: Int
-> Int
-> AccessLevel
-> GitLab (Either (Response ByteString) (Maybe GroupShare))
addGroupToProject Int
groupId Int
projectId AccessLevel
access =
  forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr [GitLabParam]
params
  where
    params :: [GitLabParam]
    params :: [GitLabParam]
params =
      [ (ByteString
"group_id", forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
groupId)))),
        (ByteString
"group_access", forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show AccessLevel
access))))
      ]
    addr :: Text
addr =
      Text
"/projects/"
        forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
projectId)
        forall a. Semigroup a => a -> a -> a
<> Text
"/share"

-- | A default set of project attributes to override with the
-- 'editProject' functions. Only the project ID value is set is a
-- search parameter, all other search parameters are not set and can
-- be overwritten.
defaultProjectAttrs ::
  -- | project ID
  Int ->
  ProjectAttrs
defaultProjectAttrs :: Int -> ProjectAttrs
defaultProjectAttrs Int
projId =
  Maybe Bool
-> Maybe Text
-> Maybe Int
-> Maybe EnabledDisabled
-> Maybe AutoDeployStrategy
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe GitStrategy
-> Maybe Int
-> Maybe ProjectSettingAccessLevel
-> Maybe Text
-> Maybe Int
-> Maybe Bool
-> Maybe ProjectSettingAccessLevel
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe ProjectSettingAccessLevel
-> Int
-> Maybe Text
-> Maybe ProjectSettingAccessLevel
-> Maybe Bool
-> Maybe MergeMethod
-> Maybe ProjectSettingAccessLevel
-> Maybe Bool
-> Maybe Bool
-> Maybe Int
-> Maybe Bool
-> Maybe Text
-> Maybe ProjectSettingAccessLevel
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe ProjectSettingAccessLevel
-> Maybe ProjectSettingAccessLevel
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe ProjectSettingAccessLevel
-> Maybe Text
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe ProjectSettingAccessLevel
-> Maybe SquashOption
-> Maybe Text
-> Maybe Visibility
-> Maybe ProjectSettingAccessLevel
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> ProjectAttrs
ProjectAttrs forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing Int
projId forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

projectAttrsParams :: ProjectAttrs -> [GitLabParam]
projectAttrsParams :: ProjectAttrs -> [GitLabParam]
projectAttrsParams ProjectAttrs
filters =
  forall a. [Maybe a] -> [a]
catMaybes
    [ (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"allow_merge_on_skipped_pipeline", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_allow_merge_on_skipped_pipeline ProjectAttrs
filters,
      (\Text
x -> forall a. a -> Maybe a
Just (ByteString
"analytics_access_level", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Text
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Text
project_edit_analytics_access_level ProjectAttrs
filters,
      (\Int
i -> forall a. a -> Maybe a
Just (ByteString
"approvals_before_merge", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
i)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Int
project_edit_approvals_before_merge ProjectAttrs
filters,
      (\EnabledDisabled
x -> forall a. a -> Maybe a
Just (ByteString
"auto_cancel_pending_pipelines", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show EnabledDisabled
x))))
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe EnabledDisabled
project_edit_auto_cancel_pending_pipelines
          ProjectAttrs
filters,
      (\AutoDeployStrategy
x -> forall a. a -> Maybe a
Just (ByteString
"auto_devops_deploy_strategy", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show AutoDeployStrategy
x))))
        forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe AutoDeployStrategy
project_edit_auto_devops_deploy_strategy ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"auto_devops_enabled", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_auto_devops_enabled ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"autoclose_referenced_issues", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_autoclose_referenced_issues ProjectAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"build_coverage_regex", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Text
project_edit_build_coverage_regex ProjectAttrs
filters,
      (\GitStrategy
x -> forall a. a -> Maybe a
Just (ByteString
"build_git_strategy", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show GitStrategy
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe GitStrategy
project_edit_build_git_strategy ProjectAttrs
filters,
      (\Int
i -> forall a. a -> Maybe a
Just (ByteString
"build_timeout", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
i)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Int
project_edit_build_timeout ProjectAttrs
filters,
      (\ProjectSettingAccessLevel
x -> forall a. a -> Maybe a
Just (ByteString
"builds_access_level", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ProjectSettingAccessLevel
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_builds_access_level ProjectAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"ci_config_path", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Text
project_edit_ci_config_path ProjectAttrs
filters,
      (\Int
i -> forall a. a -> Maybe a
Just (ByteString
"ci_default_git_depth", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
i)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Int
project_edit_ci_default_git_depth ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"ci_forward_deployment_enabled", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_ci_forward_deployment_enabled ProjectAttrs
filters,
      (\ProjectSettingAccessLevel
x -> forall a. a -> Maybe a
Just (ByteString
"container_registry_access_level", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ProjectSettingAccessLevel
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_container_registry_access_level ProjectAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"default_branch", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Text
project_edit_default_branch ProjectAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"description", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Text
project_edit_description ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"emails_disabled", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_emails_disabled ProjectAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"external_authorization_classification_label", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Text
project_edit_external_authorization_classification_label ProjectAttrs
filters,
      (\ProjectSettingAccessLevel
x -> forall a. a -> Maybe a
Just (ByteString
"forking_access_level", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ProjectSettingAccessLevel
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_forking_access_level ProjectAttrs
filters,
      forall a. a -> Maybe a
Just (ByteString
"id", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show (ProjectAttrs -> Int
project_edit_id ProjectAttrs
filters)))),
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"import_url", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Text
project_edit_import_url ProjectAttrs
filters,
      (\ProjectSettingAccessLevel
x -> forall a. a -> Maybe a
Just (ByteString
"issues_access_level", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ProjectSettingAccessLevel
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_issues_access_level ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"lfs_enabled", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_lfs_enabled ProjectAttrs
filters,
      (\MergeMethod
x -> forall a. a -> Maybe a
Just (ByteString
"merge_method", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show MergeMethod
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe MergeMethod
project_edit_merge_method ProjectAttrs
filters,
      (\ProjectSettingAccessLevel
x -> forall a. a -> Maybe a
Just (ByteString
"merge_requests_access_level", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ProjectSettingAccessLevel
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_merge_requests_access_level ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"mirror_overwrites_diverged_branches", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_mirror_overwrites_diverged_branches ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"mirror_trigger_builds", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_mirror_trigger_builds ProjectAttrs
filters,
      (\Int
i -> forall a. a -> Maybe a
Just (ByteString
"mirror_user_id", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
i)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Int
project_edit_mirror_user_id ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"mirror", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_mirror ProjectAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"name", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Text
project_edit_name ProjectAttrs
filters,
      (\ProjectSettingAccessLevel
x -> forall a. a -> Maybe a
Just (ByteString
"operations_access_level", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ProjectSettingAccessLevel
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_operations_access_level ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"only_allow_merge_if_all_discussions_are_resolved", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_only_allow_merge_if_all_discussions_are_resolved ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"only_allow_merge_if_pipeline_succeeds", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_only_allow_merge_if_pipeline_succeeds ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"only_mirror_protected_branches", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_only_mirror_protected_branches ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"packages_enabled", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_packages_enabled ProjectAttrs
filters,
      (\ProjectSettingAccessLevel
x -> forall a. a -> Maybe a
Just (ByteString
"pages_access_level", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ProjectSettingAccessLevel
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_pages_access_level ProjectAttrs
filters,
      (\ProjectSettingAccessLevel
x -> forall a. a -> Maybe a
Just (ByteString
"requirements_access_level", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ProjectSettingAccessLevel
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_requirements_access_level ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"restrict_user_defined_variables", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_restrict_user_defined_variables ProjectAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"path", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Text
project_edit_path ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"public_builds", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_public_builds ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"remove_source_branch_after_merge", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_remove_source_branch_after_merge ProjectAttrs
filters,
      (\ProjectSettingAccessLevel
x -> forall a. a -> Maybe a
Just (ByteString
"repository_access_level", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ProjectSettingAccessLevel
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_repository_access_level ProjectAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"repository_storage", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Text
project_edit_repository_storage ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"request_access_enabled", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_request_access_enabled ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"resolve_outdated_diff_discussions", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_resolve_outdated_diff_discussions ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"service_desk_enabled", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_service_desk_enabled ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"shared_runners_enabled", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_shared_runners_enabled ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"show_default_award_emojis", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_show_default_award_emojis ProjectAttrs
filters,
      (\ProjectSettingAccessLevel
x -> forall a. a -> Maybe a
Just (ByteString
"snippets_access_level", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ProjectSettingAccessLevel
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_snippets_access_level ProjectAttrs
filters,
      (\SquashOption
x -> forall a. a -> Maybe a
Just (ByteString
"squash_option", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show SquashOption
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe SquashOption
project_edit_squash_option ProjectAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"suggestion_commit_message", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Text
project_edit_suggestion_commit_message ProjectAttrs
filters,
      (\Visibility
x -> forall a. a -> Maybe a
Just (ByteString
"visibility", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Visibility
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Visibility
project_edit_visibility ProjectAttrs
filters,
      (\ProjectSettingAccessLevel
x -> forall a. a -> Maybe a
Just (ByteString
"wiki_access_level", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show ProjectSettingAccessLevel
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_wiki_access_level ProjectAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"issues_template", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Text
project_edit_issues_template ProjectAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"merge_requests_template", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Text
project_edit_merge_requests_template ProjectAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"keep_latest_artifact", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectAttrs -> Maybe Bool
project_edit_keep_latest_artifact ProjectAttrs
filters
    ]
  where
    textToBS :: Text -> Maybe ByteString
textToBS = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
    showBool :: Bool -> Text
    showBool :: Bool -> Text
showBool Bool
True = Text
"true"
    showBool Bool
False = Text
"false"

-- | Attributes for updating when editing a project with the
-- 'editProject' functions.
data ProjectAttrs = ProjectAttrs
  { -- | Set whether or not merge requests can be merged with skipped jobs.
    ProjectAttrs -> Maybe Bool
project_edit_allow_merge_on_skipped_pipeline :: Maybe Bool,
    -- | One of disabled, private or enabled.
    ProjectAttrs -> Maybe Text
project_edit_analytics_access_level :: Maybe Text,
    -- | How many approvers should approve merge request by default.
    ProjectAttrs -> Maybe Int
project_edit_approvals_before_merge :: Maybe Int,
    -- | Auto-cancel pending pipelines.
    ProjectAttrs -> Maybe EnabledDisabled
project_edit_auto_cancel_pending_pipelines :: Maybe EnabledDisabled,
    -- | Auto Deploy strategy (continuous, manual, or timed_incremental).
    ProjectAttrs -> Maybe AutoDeployStrategy
project_edit_auto_devops_deploy_strategy :: Maybe AutoDeployStrategy,
    -- | Enable Auto DevOps for this project.
    ProjectAttrs -> Maybe Bool
project_edit_auto_devops_enabled :: Maybe Bool,
    -- | Set whether auto-closing referenced issues on default branch.
    ProjectAttrs -> Maybe Bool
project_edit_autoclose_referenced_issues :: Maybe Bool,
    -- | Test coverage parsing.
    ProjectAttrs -> Maybe Text
project_edit_build_coverage_regex :: Maybe Text,
    -- | The Git strategy. Defaults to fetch.
    ProjectAttrs -> Maybe GitStrategy
project_edit_build_git_strategy :: Maybe GitStrategy,
    -- | The maximum amount of time, in seconds, that a job can run.
    ProjectAttrs -> Maybe Int
project_edit_build_timeout :: Maybe Int,
    -- | One of disabled, private, or enabled.
    ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_builds_access_level :: Maybe ProjectSettingAccessLevel,
    -- | The path to CI configuration file.
    ProjectAttrs -> Maybe Text
project_edit_ci_config_path :: Maybe Text,
    -- | Default number of revisions for shallow cloning.
    ProjectAttrs -> Maybe Int
project_edit_ci_default_git_depth :: Maybe Int,
    -- | When a new deployment job starts, skip older deployment jobs that are still pending.
    ProjectAttrs -> Maybe Bool
project_edit_ci_forward_deployment_enabled :: Maybe Bool,
    -- | Set visibility of container registry, for this project, to one of disabled, private or enabled.
    ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_container_registry_access_level :: Maybe ProjectSettingAccessLevel,
    -- | The default branch name.
    ProjectAttrs -> Maybe Text
project_edit_default_branch :: Maybe Text,
    -- | Short project description.
    ProjectAttrs -> Maybe Text
project_edit_description :: Maybe Text,
    -- | Disable email notifications.
    ProjectAttrs -> Maybe Bool
project_edit_emails_disabled :: Maybe Bool,
    -- | The classification label for the project.
    ProjectAttrs -> Maybe Text
project_edit_external_authorization_classification_label :: Maybe Text,
    -- | One of disabled, private, or enabled.
    ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_forking_access_level :: Maybe ProjectSettingAccessLevel,
    -- | The ID or URL-encoded path of the project.
    ProjectAttrs -> Int
project_edit_id :: Int,
    -- | URL to import repository from.
    ProjectAttrs -> Maybe Text
project_edit_import_url :: Maybe Text,
    -- | One of disabled, private, or enabled.
    ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_issues_access_level :: Maybe ProjectSettingAccessLevel,
    -- | Enable LFS.
    ProjectAttrs -> Maybe Bool
project_edit_lfs_enabled :: Maybe Bool,
    -- | Set the merge method used.
    ProjectAttrs -> Maybe MergeMethod
project_edit_merge_method :: Maybe MergeMethod,
    -- | One of disabled, private, or enabled.
    ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_merge_requests_access_level :: Maybe ProjectSettingAccessLevel,
    -- | Pull mirror overwrites diverged branches.
    ProjectAttrs -> Maybe Bool
project_edit_mirror_overwrites_diverged_branches :: Maybe Bool,
    -- | Pull mirroring triggers builds.
    ProjectAttrs -> Maybe Bool
project_edit_mirror_trigger_builds :: Maybe Bool,
    -- | User responsible for all the activity surrounding a pull mirror event. (admins only)
    ProjectAttrs -> Maybe Int
project_edit_mirror_user_id :: Maybe Int,
    -- | Enables pull mirroring in a project.
    ProjectAttrs -> Maybe Bool
project_edit_mirror :: Maybe Bool,
    -- | The name of the project.
    ProjectAttrs -> Maybe Text
project_edit_name :: Maybe Text,
    -- | One of disabled, private, or enabled.
    ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_operations_access_level :: Maybe ProjectSettingAccessLevel,
    -- | Set whether merge requests can only be merged when all the discussions are resolved.
    ProjectAttrs -> Maybe Bool
project_edit_only_allow_merge_if_all_discussions_are_resolved :: Maybe Bool,
    -- | Set whether merge requests can only be merged with successful jobs.
    ProjectAttrs -> Maybe Bool
project_edit_only_allow_merge_if_pipeline_succeeds :: Maybe Bool,
    -- | Only mirror protected branches.
    ProjectAttrs -> Maybe Bool
project_edit_only_mirror_protected_branches :: Maybe Bool,
    -- | Enable or disable packages repository feature.
    ProjectAttrs -> Maybe Bool
project_edit_packages_enabled :: Maybe Bool,
    -- | One of disabled, private, enabled, or public.
    ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_pages_access_level :: Maybe ProjectSettingAccessLevel,
    -- | One of disabled, private, enabled or public.
    ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_requirements_access_level :: Maybe ProjectSettingAccessLevel,
    -- | Allow only maintainers to pass user-defined variables when triggering a pipeline. For example when the pipeline is triggered in the UI, with the API, or by a trigger token.
    ProjectAttrs -> Maybe Bool
project_edit_restrict_user_defined_variables :: Maybe Bool,
    -- | Custom repository name for the project. By default generated based on name.
    ProjectAttrs -> Maybe Text
project_edit_path :: Maybe Text,
    -- | If true, jobs can be viewed by non-project members.
    ProjectAttrs -> Maybe Bool
project_edit_public_builds :: Maybe Bool,
    -- | Enable Delete source branch option by default for all new merge requests.
    ProjectAttrs -> Maybe Bool
project_edit_remove_source_branch_after_merge :: Maybe Bool,
    -- | One of disabled, private, or enabled.
    ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_repository_access_level :: Maybe ProjectSettingAccessLevel,
    -- | Which storage shard the repository is on. (admins only)
    ProjectAttrs -> Maybe Text
project_edit_repository_storage :: Maybe Text,
    -- | Allow users to request member access.
    ProjectAttrs -> Maybe Bool
project_edit_request_access_enabled :: Maybe Bool,
    -- | Automatically resolve merge request diffs discussions on lines changed with a push.
    ProjectAttrs -> Maybe Bool
project_edit_resolve_outdated_diff_discussions :: Maybe Bool,
    -- | Enable or disable Service Desk feature.
    ProjectAttrs -> Maybe Bool
project_edit_service_desk_enabled :: Maybe Bool,
    -- | Enable shared runners for this project.
    ProjectAttrs -> Maybe Bool
project_edit_shared_runners_enabled :: Maybe Bool,
    -- | Show default award emojis.
    ProjectAttrs -> Maybe Bool
project_edit_show_default_award_emojis :: Maybe Bool,
    -- | One of disabled, private, or enabled.
    ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_snippets_access_level :: Maybe ProjectSettingAccessLevel,
    -- | One of never, always, default_on, or default_off.
    ProjectAttrs -> Maybe SquashOption
project_edit_squash_option :: Maybe SquashOption,
    -- | The commit message used to apply merge request suggestions.
    ProjectAttrs -> Maybe Text
project_edit_suggestion_commit_message :: Maybe Text,
    ProjectAttrs -> Maybe Visibility
project_edit_visibility :: Maybe Visibility,
    -- | One of disabled, private, or enabled.
    ProjectAttrs -> Maybe ProjectSettingAccessLevel
project_edit_wiki_access_level :: Maybe ProjectSettingAccessLevel,
    -- | Default description for Issues. Description is parsed with GitLab Flavored Markdown. See Templates for issues and merge requests.
    ProjectAttrs -> Maybe Text
project_edit_issues_template :: Maybe Text,
    -- | Default description for Merge Requests. Description is parsed with GitLab Flavored Markdown.
    ProjectAttrs -> Maybe Text
project_edit_merge_requests_template :: Maybe Text,
    -- | Disable or enable the ability to keep the latest artifact for this project.
    ProjectAttrs -> Maybe Bool
project_edit_keep_latest_artifact :: Maybe Bool
  }
  deriving (forall x. Rep ProjectAttrs x -> ProjectAttrs
forall x. ProjectAttrs -> Rep ProjectAttrs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ProjectAttrs x -> ProjectAttrs
$cfrom :: forall x. ProjectAttrs -> Rep ProjectAttrs x
Generic, Int -> ProjectAttrs -> ShowS
[ProjectAttrs] -> ShowS
ProjectAttrs -> [Char]
forall a.
(Int -> a -> ShowS) -> (a -> [Char]) -> ([a] -> ShowS) -> Show a
showList :: [ProjectAttrs] -> ShowS
$cshowList :: [ProjectAttrs] -> ShowS
show :: ProjectAttrs -> [Char]
$cshow :: ProjectAttrs -> [Char]
showsPrec :: Int -> ProjectAttrs -> ShowS
$cshowsPrec :: Int -> ProjectAttrs -> ShowS
Show, ProjectAttrs -> ProjectAttrs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectAttrs -> ProjectAttrs -> Bool
$c/= :: ProjectAttrs -> ProjectAttrs -> Bool
== :: ProjectAttrs -> ProjectAttrs -> Bool
$c== :: ProjectAttrs -> ProjectAttrs -> Bool
Eq)

-- | Is auto-cancel pending pipelines enabled or disabled
data EnabledDisabled
  = Enabled
  | Disabled
  deriving (EnabledDisabled -> EnabledDisabled -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnabledDisabled -> EnabledDisabled -> Bool
$c/= :: EnabledDisabled -> EnabledDisabled -> Bool
== :: EnabledDisabled -> EnabledDisabled -> Bool
$c== :: EnabledDisabled -> EnabledDisabled -> Bool
Eq)

instance Show EnabledDisabled where
  show :: EnabledDisabled -> [Char]
show EnabledDisabled
Enabled = [Char]
"enabled"
  show EnabledDisabled
Disabled = [Char]
"disabled"

-- | Auto Deploy strategy: continuous, manual, or timed_incremental,
-- for the 'editProject' functions
data AutoDeployStrategy
  = Continuous
  | Manual
  | TimedIncremental
  deriving (AutoDeployStrategy -> AutoDeployStrategy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AutoDeployStrategy -> AutoDeployStrategy -> Bool
$c/= :: AutoDeployStrategy -> AutoDeployStrategy -> Bool
== :: AutoDeployStrategy -> AutoDeployStrategy -> Bool
$c== :: AutoDeployStrategy -> AutoDeployStrategy -> Bool
Eq)

instance Show AutoDeployStrategy where
  show :: AutoDeployStrategy -> [Char]
show AutoDeployStrategy
Continuous = [Char]
"continuous"
  show AutoDeployStrategy
Manual = [Char]
"manual"
  show AutoDeployStrategy
TimedIncremental = [Char]
"timed_incremental"

-- | The Git strategy, defaults to fetch, for the 'editProject' functions
data GitStrategy
  = Clone
  | Fetch
  | None
  deriving (GitStrategy -> GitStrategy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GitStrategy -> GitStrategy -> Bool
$c/= :: GitStrategy -> GitStrategy -> Bool
== :: GitStrategy -> GitStrategy -> Bool
$c== :: GitStrategy -> GitStrategy -> Bool
Eq)

instance Show GitStrategy where
  show :: GitStrategy -> [Char]
show GitStrategy
Clone = [Char]
"clone"
  show GitStrategy
Fetch = [Char]
"fetch"
  show GitStrategy
None = [Char]
"none"

-- | The project access level setting, for the 'editProject' functions
data ProjectSettingAccessLevel
  = DisabledAccess
  | PrivateAccess
  | EnabledAccess
  | PublicAccess
  deriving (ProjectSettingAccessLevel -> ProjectSettingAccessLevel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ProjectSettingAccessLevel -> ProjectSettingAccessLevel -> Bool
$c/= :: ProjectSettingAccessLevel -> ProjectSettingAccessLevel -> Bool
== :: ProjectSettingAccessLevel -> ProjectSettingAccessLevel -> Bool
$c== :: ProjectSettingAccessLevel -> ProjectSettingAccessLevel -> Bool
Eq)

instance Show ProjectSettingAccessLevel where
  show :: ProjectSettingAccessLevel -> [Char]
show ProjectSettingAccessLevel
DisabledAccess = [Char]
"disabled"
  show ProjectSettingAccessLevel
PrivateAccess = [Char]
"private"
  show ProjectSettingAccessLevel
EnabledAccess = [Char]
"enabled"
  show ProjectSettingAccessLevel
PublicAccess = [Char]
"public"

-- | The project git merge method, for the 'editProject' functions
data MergeMethod
  = Merge
  | RebaseMerge
  | FF
  deriving (MergeMethod -> MergeMethod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MergeMethod -> MergeMethod -> Bool
$c/= :: MergeMethod -> MergeMethod -> Bool
== :: MergeMethod -> MergeMethod -> Bool
$c== :: MergeMethod -> MergeMethod -> Bool
Eq)

instance Show MergeMethod where
  show :: MergeMethod -> [Char]
show MergeMethod
Merge = [Char]
"merge"
  show MergeMethod
RebaseMerge = [Char]
"rebase_merge"
  show MergeMethod
FF = [Char]
"ff"

-- | The project git merge squash option, for the 'editProject' functions
data SquashOption
  = NeverSquash
  | AlwaysSquash
  | DefaultOnSquash
  | DefaultOffSquash
  deriving (SquashOption -> SquashOption -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SquashOption -> SquashOption -> Bool
$c/= :: SquashOption -> SquashOption -> Bool
== :: SquashOption -> SquashOption -> Bool
$c== :: SquashOption -> SquashOption -> Bool
Eq)

instance Show SquashOption where
  show :: SquashOption -> [Char]
show SquashOption
NeverSquash = [Char]
"never"
  show SquashOption
AlwaysSquash = [Char]
"always"
  show SquashOption
DefaultOnSquash = [Char]
"default_on"
  show SquashOption
DefaultOffSquash = [Char]
"default_off"

-- | A default set of project searc filters where no project filters
-- are applied, thereby returning all projects.
defaultProjectSearchAttrs :: ProjectSearchAttrs
defaultProjectSearchAttrs :: ProjectSearchAttrs
defaultProjectSearchAttrs =
  Maybe Bool
-> Maybe Int
-> Maybe Bool
-> Maybe Bool
-> Maybe UTCTime
-> Maybe UTCTime
-> Maybe Bool
-> Maybe AccessLevel
-> Maybe OrderBy
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe SortBy
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> Maybe Int
-> Maybe Visibility
-> Maybe Bool
-> Maybe Bool
-> Maybe Bool
-> Maybe Text
-> ProjectSearchAttrs
ProjectSearchAttrs forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing forall a. Maybe a
Nothing

-- | Attributes related to a group
data ProjectSearchAttrs = ProjectSearchAttrs
  { -- | Limit by archived status.
    ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_archived :: Maybe Bool,
    -- | Limit results to projects with IDs greater than the specified
    -- ID.
    ProjectSearchAttrs -> Maybe Int
projectSearchFilter_id_after :: Maybe Int,
    -- | Limit results to projects with IDs less than the specified
    -- ID.
    ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_id_before :: Maybe Bool,
    -- | Limit results to projects which were imported from external
    -- systems by current user.
    ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_imported :: Maybe Bool,
    -- | Limit results to projects with last_activity after specified
    -- time.
    ProjectSearchAttrs -> Maybe UTCTime
projectSearchFilter_last_activity_after :: Maybe UTCTime,
    -- | Limit results to projects with last_activity before specified
    -- time.
    ProjectSearchAttrs -> Maybe UTCTime
projectSearchFilter_last_activity_before :: Maybe UTCTime,
    -- | Limit by projects that the current user is a member of.
    ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_membership :: Maybe Bool,
    -- | Limit by current user minimal access level.
    ProjectSearchAttrs -> Maybe AccessLevel
projectSearchFilter_min_access_level :: Maybe AccessLevel,
    -- | Return projects ordered by a given criteria.
    ProjectSearchAttrs -> Maybe OrderBy
projectSearchFilter_order_by :: Maybe OrderBy,
    -- | Limit by projects explicitly owned by the current user.
    ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_owned :: Maybe Bool,
    -- | Limit projects where the repository checksum calculation has
    -- failed.
    ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_repository_checksum_failed :: Maybe Bool,
    -- | Limit results to projects stored on
    -- repository_storage. (administrators only).
    ProjectSearchAttrs -> Maybe Text
projectSearchFilter_repository_storage :: Maybe Text,
    -- | Include ancestor namespaces when matching search
    -- criteria. Default is false.
    ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_search_namespaces :: Maybe Bool,
    -- | Return list of projects matching the search criteria.
    ProjectSearchAttrs -> Maybe Text
projectSearchFilter_search :: Maybe Text,
    -- | Return only limited fields for each project. This is a no-op
    -- without authentication as then only simple fields are returned.
    ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_simple :: Maybe Bool,
    -- | Return projects sorted in asc or desc order. Default is desc.
    ProjectSearchAttrs -> Maybe SortBy
projectSearchFilter_sort :: Maybe SortBy,
    -- | Limit by projects starred by the current user.
    ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_starred :: Maybe Bool,
    -- | Include project statistics. Only available to Reporter or
    -- higher level role members.
    ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_statistics :: Maybe Bool,
    -- | Comma-separated topic names. Limit results to projects that
    -- match all of given topics.
    ProjectSearchAttrs -> Maybe Text
projectSearchFilter_topic :: Maybe Text,
    -- | Limit results to projects with the assigned topic given by
    -- the topic ID.
    ProjectSearchAttrs -> Maybe Int
projectSearchFilter_topic_id :: Maybe Int,
    -- | Limit by visibility.
    ProjectSearchAttrs -> Maybe Visibility
projectSearchFilter_visibility :: Maybe Visibility,
    -- | Include custom attributes in response. (administrator only).
    ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_with_custom_attributes :: Maybe Bool,
    -- | Limit by enabled issues feature.
    ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_with_issues_enabled :: Maybe Bool,
    -- | Limit by enabled merge requests feature.
    ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_with_merge_requests_enabled :: Maybe Bool,
    -- | Limit by projects which use the given programming language.
    ProjectSearchAttrs -> Maybe Text
projectSearchFilter_with_programming_language :: Maybe Text
  }

projectSearchAttrsParams :: ProjectSearchAttrs -> [GitLabParam]
projectSearchAttrsParams :: ProjectSearchAttrs -> [GitLabParam]
projectSearchAttrsParams ProjectSearchAttrs
filters =
  forall a. [Maybe a] -> [a]
catMaybes
    [ (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"archived", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_archived ProjectSearchAttrs
filters,
      (\Int
i -> forall a. a -> Maybe a
Just (ByteString
"id_after", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
i)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Int
projectSearchFilter_id_after ProjectSearchAttrs
filters,
      (\Bool
i -> forall a. a -> Maybe a
Just (ByteString
"id_before", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Bool
i)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_id_before ProjectSearchAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"imported", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_imported ProjectSearchAttrs
filters,
      (\UTCTime
x -> forall a. a -> Maybe a
Just (ByteString
"last_activity_after", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show UTCTime
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe UTCTime
projectSearchFilter_last_activity_after ProjectSearchAttrs
filters,
      (\UTCTime
x -> forall a. a -> Maybe a
Just (ByteString
"last_activity_before", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show UTCTime
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe UTCTime
projectSearchFilter_last_activity_before ProjectSearchAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"membership", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_membership ProjectSearchAttrs
filters,
      (\AccessLevel
x -> forall a. a -> Maybe a
Just (ByteString
"min_access_level", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show AccessLevel
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe AccessLevel
projectSearchFilter_min_access_level ProjectSearchAttrs
filters,
      (\OrderBy
x -> forall a. a -> Maybe a
Just (ByteString
"order_by", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show OrderBy
x)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe OrderBy
projectSearchFilter_order_by ProjectSearchAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"owned", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_owned ProjectSearchAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"repository_checksum_failed", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_repository_checksum_failed ProjectSearchAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"repository_storage", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Text
projectSearchFilter_repository_storage ProjectSearchAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"search_namespaces", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_search_namespaces ProjectSearchAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"search", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Text
projectSearchFilter_search ProjectSearchAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"simple", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_simple ProjectSearchAttrs
filters,
      (\SortBy
i -> forall a. a -> Maybe a
Just (ByteString
"sort", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show SortBy
i)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe SortBy
projectSearchFilter_sort ProjectSearchAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"starred", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_starred ProjectSearchAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"statistics", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_statistics ProjectSearchAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"topic", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Text
projectSearchFilter_topic ProjectSearchAttrs
filters,
      (\Int
i -> forall a. a -> Maybe a
Just (ByteString
"topic_id", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Int
i)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Int
projectSearchFilter_topic_id ProjectSearchAttrs
filters,
      (\Visibility
i -> forall a. a -> Maybe a
Just (ByteString
"visibility", Text -> Maybe ByteString
textToBS ([Char] -> Text
T.pack (forall a. Show a => a -> [Char]
show Visibility
i)))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Visibility
projectSearchFilter_visibility ProjectSearchAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"with_custom_attributes", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_with_custom_attributes ProjectSearchAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"with_issues_enabled", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_with_issues_enabled ProjectSearchAttrs
filters,
      (\Bool
b -> forall a. a -> Maybe a
Just (ByteString
"with_merge_requests_enabled", Text -> Maybe ByteString
textToBS (Bool -> Text
showBool Bool
b))) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Bool
projectSearchFilter_with_merge_requests_enabled ProjectSearchAttrs
filters,
      (\Text
t -> forall a. a -> Maybe a
Just (ByteString
"with_programming_language", Text -> Maybe ByteString
textToBS Text
t)) forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< ProjectSearchAttrs -> Maybe Text
projectSearchFilter_with_programming_language ProjectSearchAttrs
filters
    ]
  where
    textToBS :: Text -> Maybe ByteString
textToBS = forall a. a -> Maybe a
Just forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8
    showBool :: Bool -> Text
    showBool :: Bool -> Text
showBool Bool
True = Text
"true"
    showBool Bool
False = Text
"false"

------------------
-- functions below are candidates for deletion

-- -- | finds all issues created by a user.
-- --
-- -- > issuesCreatedByUser "user1"
-- --
-- -- returns a (user,projects) tuple, where user is the 'User' found
-- -- for the given searched username, and a list of 'Project's that the
-- -- user has created issues for.
-- issuesCreatedByUser :: Text -> GitLab (Maybe (User, [Project]))
-- issuesCreatedByUser username = do
--   user_maybe <- searchUser username
--   case user_maybe of
--     Nothing -> return Nothing
--     Just usr -> do
--       usersIssues <- userIssues usr
--       projects <- mapM projectOfIssue usersIssues
--       return (Just (usr, projects))

-- -- | searches for all projects with the given name, and returns a list
-- -- of triples of: 1) the found project, 2) the list of issues for the
-- -- found projects, and 3) a list of users who've created issues.
-- issuesOnForks ::
--   -- | name or namespace of the project
--   Text ->
--   GitLab [(Project, [Issue], [User])]
-- issuesOnForks projectName = do
--   projects <- projectsWithName projectName
--   mapM processProject projects
--   where
--     processProject ::
--       Project ->
--       GitLab (Project, [Issue], [User])
--     processProject proj = do
--       (openIssues :: [Issue]) <- projectIssues proj defaultIssueFilters
--       let authors = map (fromMaybe (error "issuesOnForks error") . issue_author) openIssues
--       return (proj, openIssues, authors)

-- -- | returns a (namespace,members) tuple for the given 'Project',
-- -- where namespace is the namespace of the project
-- -- e.g. "user1/project1", and members is a list of (username,name)
-- -- tuples about all members of the project.
-- projectMemebersCount :: Project -> GitLab (Text, [(Text, Text)])
-- projectMemebersCount project = do
--   friends <- count
--   return (namespace_name (fromMaybe (error "projectMemebersCount error") (project_namespace project)), friends)
--   where
--     count = do
--       let addr =
--             "/projects/" <> T.pack (show (project_id project)) <> "/members/all"
--       (res :: [Member]) <- fromRight (error "projectMembersCount error") <$> gitlabGetMany addr []
--       return (map (\x -> (fromMaybe (error "projectMemebersCount error") (member_username x), fromMaybe (error "projectMemebersCount error") (member_name x))) res)

-- | returns 'True' is the last commit for a project passes all
-- continuous integration tests.
projectCISuccess ::
  -- | the name or namespace of the project
  Project ->
  GitLab Bool
projectCISuccess :: Project -> GitLab Bool
projectCISuccess Project
prj = do
  [Pipeline]
pipes <- Project -> GitLab [Pipeline]
pipelines Project
prj
  case [Pipeline]
pipes of
    [] -> forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    (Pipeline
x : [Pipeline]
_) -> forall (m :: * -> *) a. Monad m => a -> m a
return (Pipeline -> Text
pipeline_status Pipeline
x forall a. Eq a => a -> a -> Bool
== Text
"success")

-- -- | searches for a username, and returns a user ID for that user, or
-- -- 'Nothing' if a user cannot be found.
-- namespacePathToUserId ::
--   -- | name or namespace of project
--   Text ->
--   GitLab (Maybe Int)
-- namespacePathToUserId namespacePath = do
--   user_maybe <- searchUser namespacePath
--   case user_maybe of
--     Nothing -> return Nothing
--     Just usr -> return (Just (user_id usr))