{-# 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 where

import qualified Data.ByteString.Lazy as BSL
import Data.Either
import Data.List
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import GitLab.API.Commits
import GitLab.API.Issues
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
import UnliftIO.Async

-- | gets all projects.
allProjects :: GitLab [Project]
allProjects :: GitLab [Project]
allProjects =
  Text -> Text -> GitLab [Project]
forall a. FromJSON a => Text -> Text -> GitLab [a]
gitlabWithAttrsUnsafe Text
"/projects" Text
"&statistics=true"

-- | gets all forks of a project. Supports use of namespaces.
--
-- > 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/"
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8 (Bool -> ByteString -> ByteString
urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 Text
projectName))
          Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/forks"
  Text -> GitLab (Either (Response ByteString) [Project])
forall a.
FromJSON a =>
Text -> GitLab (Either (Response ByteString) [a])
gitlab Text
urlPath

-- | searches for a 'Project' with the given project ID, returns
-- 'Nothing' if a project with the given ID is not found.
searchProjectId ::
  -- | project ID
  Int ->
  GitLab (Either (Response BSL.ByteString) (Maybe Project))
searchProjectId :: Int -> GitLab (Either (Response ByteString) (Maybe Project))
searchProjectId Int
projectId = do
  let urlPath :: Text
urlPath = String -> Text
T.pack (String
"/projects/" String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Int -> String
forall a. Show a => a -> String
show Int
projectId)
  Text
-> Text -> GitLab (Either (Response ByteString) (Maybe Project))
forall a.
FromJSON a =>
Text -> Text -> GitLab (Either (Response ByteString) (Maybe a))
gitlabWithAttrsOne Text
urlPath Text
"&statistics=true"

-- | gets all projects with the given project name.
--
-- > projectsWithName "project1"
projectsWithName ::
  -- | project name being searched for.
  Text ->
  GitLab [Project]
projectsWithName :: Text -> GitLab [Project]
projectsWithName Text
projectName =
  (Project -> Bool) -> [Project] -> [Project]
forall a. (a -> Bool) -> [a] -> [a]
filter (\Project
project -> Text
projectName Text -> Text -> Bool
forall a. Eq a => a -> a -> Bool
== Project -> Text
project_path Project
project)
    ([Project] -> [Project]) -> GitLab [Project] -> GitLab [Project]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> Text -> GitLab [Project]
forall a. FromJSON a => Text -> Text -> GitLab [a]
gitlabWithAttrsUnsafe Text
"/projects" (Text
"&search=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
projectName)

-- | gets a project with the given name for the given username. E.g.
--
-- > projectsWithNameAndUser "user1" "project1"
--
-- looks for "user1/project1"
projectsWithNameAndUser :: Text -> Text -> GitLab (Either (Response BSL.ByteString) (Maybe Project))
projectsWithNameAndUser :: Text
-> Text -> GitLab (Either (Response ByteString) (Maybe Project))
projectsWithNameAndUser Text
username Text
projectName =
  Text
-> Text -> GitLab (Either (Response ByteString) (Maybe Project))
forall a.
FromJSON a =>
Text -> Text -> GitLab (Either (Response ByteString) (Maybe a))
gitlabWithAttrsOne
    ( Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8
          (Bool -> ByteString -> ByteString
urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 (Text
username Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
projectName)))
    )
    Text
"&statistics=true"

-- | returns 'True' if a project has multiple committers, according to
-- the email addresses of the commits.
multipleCommitters :: Project -> GitLab Bool
multipleCommitters :: Project -> GitLab Bool
multipleCommitters Project
project = do
  [Text]
emailAddresses <- Project -> GitLab [Text]
commitsEmailAddresses Project
project
  Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Int
forall (t :: * -> *) a. Foldable t => t a -> Int
length ([Text] -> [Text]
forall a. Eq a => [a] -> [a]
nub [Text]
emailAddresses) Int -> Int -> Bool
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
project = do
  Either (Response ByteString) [Text]
result <- Int -> GitLab (Either (Response ByteString) [Text])
commitsEmailAddresses' (Project -> Int
project_id Project
project)
  [Text] -> GitLab [Text]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Either (Response ByteString) [Text] -> [Text]
forall b a. b -> Either a b -> b
fromRight (String -> [Text]
forall a. HasCallStack => String -> a
error String
"commitsEmailAddresses error") Either (Response ByteString) [Text]
result)

-- | gets the email addresses in the author information in all commit
-- for a project defined by the project's ID.
commitsEmailAddresses' :: Int -> GitLab (Either (Response BSL.ByteString) [Text])
commitsEmailAddresses' :: Int -> GitLab (Either (Response ByteString) [Text])
commitsEmailAddresses' Int
projectId = do
  -- (commits :: [Commit]) <- projectCommits' projectId
  Either (Response ByteString) [Commit]
attempt <- Int -> GitLab (Either (Response ByteString) [Commit])
projectCommits' Int
projectId
  case Either (Response ByteString) [Commit]
attempt of
    Left Response ByteString
resp -> Either (Response ByteString) [Text]
-> GitLab (Either (Response ByteString) [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return (Response ByteString -> Either (Response ByteString) [Text]
forall a b. a -> Either a b
Left Response ByteString
resp)
    Right ([Commit]
commits :: [Commit]) ->
      Either (Response ByteString) [Text]
-> GitLab (Either (Response ByteString) [Text])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Text] -> Either (Response ByteString) [Text]
forall a b. b -> Either a b
Right ((Commit -> Text) -> [Commit] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map Commit -> Text
author_email [Commit]
commits))

-- | gets all projects for a user given their username.
--
-- > userProjects "harry"
userProjects' :: Text -> GitLab (Maybe [Project])
userProjects' :: Text -> GitLab (Maybe [Project])
userProjects' Text
username = do
  Maybe User
userMaybe <- Text -> GitLab (Maybe User)
searchUser Text
username
  case Maybe User
userMaybe of
    Maybe User
Nothing -> Maybe [Project] -> GitLab (Maybe [Project])
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe [Project]
forall a. Maybe a
Nothing
    Just User
usr -> [Project] -> Maybe [Project]
forall a. a -> Maybe a
Just ([Project] -> Maybe [Project])
-> GitLab [Project] -> GitLab (Maybe [Project])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text -> GitLab [Project]
forall a. FromJSON a => Text -> GitLab [a]
gitlabUnsafe (Int -> Text
forall a. Show a => a -> Text
urlPath (User -> Int
user_id User
usr))
  where
    urlPath :: a -> Text
urlPath a
usrId = Text
"/users/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (a -> String
forall a. Show a => a -> String
show a
usrId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/projects"

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

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

-- | 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 :: Text -> GitLab (Maybe (User, [Project]))
issuesCreatedByUser Text
username = do
  Maybe User
user_maybe <- Text -> GitLab (Maybe User)
searchUser Text
username
  case Maybe User
user_maybe of
    Maybe User
Nothing -> Maybe (User, [Project]) -> GitLab (Maybe (User, [Project]))
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe (User, [Project])
forall a. Maybe a
Nothing
    Just User
usr -> do
      [Issue]
usersIssues <- User -> GitLab [Issue]
userIssues User
usr
      [Project]
projects <- (Issue -> GitLab Project) -> [Issue] -> GitLab [Project]
forall (m :: * -> *) (t :: * -> *) a b.
(MonadUnliftIO m, Traversable t) =>
(a -> m b) -> t a -> m (t b)
mapConcurrently Issue -> GitLab Project
projectOfIssue [Issue]
usersIssues
      Maybe (User, [Project]) -> GitLab (Maybe (User, [Project]))
forall (m :: * -> *) a. Monad m => a -> m a
return ((User, [Project]) -> Maybe (User, [Project])
forall a. a -> Maybe a
Just (User
usr, [Project]
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 :: Text -> GitLab [(Project, [Issue], [User])]
issuesOnForks Text
projectName = do
  [Project]
projects <- Text -> GitLab [Project]
projectsWithName Text
projectName
  (Project -> ReaderT GitLabState IO (Project, [Issue], [User]))
-> [Project] -> GitLab [(Project, [Issue], [User])]
forall (t :: * -> *) (m :: * -> *) a b.
(Traversable t, Monad m) =>
(a -> m b) -> t a -> m (t b)
mapM Project -> ReaderT GitLabState IO (Project, [Issue], [User])
processProject [Project]
projects
  where
    processProject ::
      Project ->
      GitLab (Project, [Issue], [User])
    processProject :: Project -> ReaderT GitLabState IO (Project, [Issue], [User])
processProject Project
proj = do
      ([Issue]
openIssues :: [Issue]) <- Project -> IssueAttrs -> GitLab [Issue]
projectIssues Project
proj IssueAttrs
defaultIssueFilters
      let authors :: [User]
authors = (Issue -> User) -> [Issue] -> [User]
forall a b. (a -> b) -> [a] -> [b]
map Issue -> User
issue_author [Issue]
openIssues
      (Project, [Issue], [User])
-> ReaderT GitLabState IO (Project, [Issue], [User])
forall (m :: * -> *) a. Monad m => a -> m a
return (Project
proj, [Issue]
openIssues, [User]
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 -> GitLab (Text, [(Text, Text)])
projectMemebersCount Project
project = do
  [(Text, Text)]
friends <- ReaderT GitLabState IO [(Text, Text)]
count
  (Text, [(Text, Text)]) -> GitLab (Text, [(Text, Text)])
forall (m :: * -> *) a. Monad m => a -> m a
return (Namespace -> Text
namespace_name (Project -> Namespace
namespace Project
project), [(Text, Text)]
friends)
  where
    count :: ReaderT GitLabState IO [(Text, Text)]
count = do
      let 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 (Project -> Int
project_id Project
project)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/members/all"
      ([Member]
res :: [Member]) <- Text -> GitLab [Member]
forall a. FromJSON a => Text -> GitLab [a]
gitlabUnsafe Text
addr
      [(Text, Text)] -> ReaderT GitLabState IO [(Text, Text)]
forall (m :: * -> *) a. Monad m => a -> m a
return ((Member -> (Text, Text)) -> [Member] -> [(Text, Text)]
forall a b. (a -> b) -> [a] -> [b]
map (\Member
x -> (Member -> Text
member_username Member
x, Member -> Text
member_name Member
x)) [Member]
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
project = do
  [Pipeline]
pipes <- Project -> GitLab [Pipeline]
pipelines Project
project
  case [Pipeline]
pipes of
    [] -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return Bool
False
    (Pipeline
x : [Pipeline]
_) -> Bool -> GitLab Bool
forall (m :: * -> *) a. Monad m => a -> m a
return (Pipeline -> Text
pipeline_status Pipeline
x Text -> Text -> Bool
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 :: Text -> GitLab (Maybe Int)
namespacePathToUserId Text
namespacePath = do
  Maybe User
user_maybe <- Text -> GitLab (Maybe User)
searchUser Text
namespacePath
  case Maybe User
user_maybe of
    Maybe User
Nothing -> Maybe Int -> GitLab (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Int
forall a. Maybe a
Nothing
    Just User
usr -> Maybe Int -> GitLab (Maybe Int)
forall (m :: * -> *) a. Monad m => a -> m a
return (Int -> Maybe Int
forall a. a -> Maybe a
Just (User -> Int
user_id User
usr))

-- | 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 =
  Text -> GitLab (Either (Response ByteString) [Diff])
forall a.
FromJSON a =>
Text -> GitLab (Either (Response ByteString) [a])
gitlab
    ( 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
projId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository/commits/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
commitSha
        Text -> Text -> Text
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 =
  Text
-> Text -> GitLab (Either (Response ByteString) (Maybe GroupShare))
forall a.
FromJSON a =>
Text -> Text -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr Text
dataBody
  where
    dataBody :: Text
    dataBody :: Text
dataBody =
      Text
"group_id="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
groupId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"&group_access="
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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
"/share"