Projects.hs

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

{-|
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 Control.Monad
import Control.Monad.IO.Class
import Control.Monad.IO.Unlift
import Control.Monad.Trans.Reader
import Data.Aeson
import qualified Data.ByteString.Lazy as BSL
import Data.List
import Data.Map (Map)
import qualified Data.Map as Map
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 Network.HTTP.Conduit
import Network.HTTP.Types.Status
import Network.HTTP.Types.URI
import System.IO
import UnliftIO.Async

import GitLab.API.Commits
import GitLab.API.Issues
import GitLab.API.Pipelines
import GitLab.API.Users
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls

-- | gets all projects.
allProjects :: (MonadIO m) => GitLab m [Project]
allProjects =
  gitlab "/projects"

-- | gets all forks of a project. Supports use of namespaces.
--
-- > projectForks "project1"
-- > projectForks "group1/project1"
projectForks :: (MonadUnliftIO m, MonadIO m)
  => Text -- ^ name or namespace of the project
  -> GitLab m [Project]
projectForks projectName = do
  let path =
        "/projects/" <>
        T.decodeUtf8 (urlEncode False (T.encodeUtf8 projectName)) <>
        "/forks"
  gitlab path

-- | searches for a 'Project' with the given project ID, returns
-- 'Nothing' if a project with the given ID is not found.
searchProjectId :: (MonadIO m)
  => Int -- ^ project ID
  -> GitLab m (Maybe Project)
searchProjectId projectId = do
  let path = T.pack ("/projects/" <> show projectId)
  gitlabOne path

-- | gets all projects with the given project name.
--
-- > projectsWithName "project1"
projectsWithName :: (MonadUnliftIO m, MonadIO m)
  => Text -- ^ project name being searched for.
  -> GitLab m [Project]
projectsWithName projectName =
  filter (\project -> projectName == project_path project) <$>
  gitlabWithAttrs "/projects" ("&search=" <> projectName)

-- | gets a project with the given name for the given username. E.g. 
--
-- > projectsNamespaceName "user1" "project1"
--
-- looks for "user1/project1"
projectsWithNameAndUser ::
     (MonadUnliftIO m, MonadIO m) => Text -> Text -> GitLab m (Maybe Project)
projectsWithNameAndUser username projectName =
  gitlabOne
  ("/projects/" <>
   T.decodeUtf8
      (urlEncode False (T.encodeUtf8 (username <> "/" <> projectName))))

-- | returns 'True' if a project has multiple committers, according to
-- the email addresses of the commits.
multipleCommitters :: (MonadUnliftIO m, MonadIO m) => Project -> GitLab m Bool
multipleCommitters project = do
  emailAddresses <- commitsEmailAddresses project
  return (length (nub emailAddresses) > 1)

-- | gets the email addresses in the author information in all commit
-- for a project. 
commitsEmailAddresses ::
     (MonadUnliftIO m, MonadIO m) => Project -> GitLab m [Text]
commitsEmailAddresses = commitsEmailAddresses' . project_id

-- | gets the email addresses in the author information in all commit
-- for a project defined by the project's ID. 
commitsEmailAddresses' :: (MonadUnliftIO m, MonadIO m) => Int -> GitLab m [Text]
commitsEmailAddresses' projectId = do
  (commits :: [Commit]) <- projectCommits' projectId
  return (map author_email commits)

-- | gets all projects for a user's username.
--
-- > userProjects "harry"
userProjects ::
     (MonadUnliftIO m, MonadIO m) => Text -> GitLab m (Maybe [Project])
userProjects username = do
  userMaybe <- searchUser username
  case userMaybe of
    Nothing -> return Nothing
    Just user -> Just <$> gitlab (path (user_id user))
  where
    path userId = "/users/" <> T.pack (show userId) <> "/projects"

-- | gets the 'GitLab.Types.Project' against which the given 'Issue'
-- was created.
projectOfIssue :: (MonadIO m) => Issue -> GitLab m Project
projectOfIssue issue =
  fromJust <$> searchProjectId (issue_project_id issue)

-- | 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 :: (MonadUnliftIO m, MonadIO m) => Text -> GitLab m (Maybe (User,[Project]))
issuesCreatedByUser username = do
  user <- searchUser username
  case user of
    Nothing -> return Nothing
    Just usr -> do
      issues <- userIssues usr
      projects <- mapConcurrently projectOfIssue issues
      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 ::
     (MonadUnliftIO m, MonadIO m)
  => Text -- ^ name or namespace of the project
  -> GitLab m [(Project, [Issue], [User])]
issuesOnForks projectName = do
  projects <- projectsWithName projectName
  mapM processProject projects
  where
    processProject proj = do
      issues <- projectOpenedIssues proj
      let authors = map issue_author issues
      return (proj, issues, 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 :: (MonadIO m) => Project -> GitLab m (Text,[(Text,Text)])
projectMemebersCount project = do
  friends <- count
  return (namespace_name (namespace project), friends)
  where
    count = do
      let addr =
            "/projects/" <> T.pack (show (project_id project)) <> "/members/all"
      (res :: [Member]) <- gitlab addr
      return (map (\x -> (member_username x, member_name x)) res)

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

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