{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE ScopedTypeVariables #-}
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
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"
projectForks ::
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
searchProjectId ::
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"
projectsWithName ::
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)
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"
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)
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)
commitsEmailAddresses' :: Int -> GitLab (Either (Response BSL.ByteString) [Text])
commitsEmailAddresses' :: Int -> GitLab (Either (Response ByteString) [Text])
commitsEmailAddresses' Int
projectId = do
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))
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"
userProjects :: User -> GitLab (Maybe [Project])
userProjects :: User -> GitLab (Maybe [Project])
userProjects User
theUser =
Text -> GitLab (Maybe [Project])
userProjects' (User -> Text
user_username User
theUser)
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
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))
issuesOnForks ::
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)
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)
projectCISuccess ::
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")
namespacePathToUserId ::
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))
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)
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/"
)
addGroupToProject ::
Int ->
Int ->
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"