{-# 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 =
[Project] -> Either (Response ByteString) [Project] -> [Project]
forall b a. b -> Either a b -> b
fromRight ([Char] -> [Project]
forall a. HasCallStack => [Char] -> a
error [Char]
"allProjects error")
(Either (Response ByteString) [Project] -> [Project])
-> ReaderT GitLabState IO (Either (Response ByteString) [Project])
-> GitLab [Project]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> [GitLabParam]
-> ReaderT GitLabState IO (Either (Response ByteString) [Project])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
"/projects" [(ByteString
"statistics", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"true")]
projectForks ::
Text ->
GitLab (Either (Response BSL.ByteString) [Project])
projectForks :: Text
-> ReaderT GitLabState IO (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
-> [GitLabParam]
-> ReaderT GitLabState IO (Either (Response ByteString) [Project])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany 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 = [Char] -> Text
T.pack ([Char]
"/projects/" [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show Int
projectId)
Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Project))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne Text
urlPath [(ByteString
"statistics", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"true")]
projectsWithName ::
Text ->
GitLab [Project]
projectsWithName :: Text -> GitLab [Project]
projectsWithName Text
projectName = do
Either (Response ByteString) [Project]
results <- Text
-> [GitLabParam]
-> ReaderT GitLabState IO (Either (Response ByteString) [Project])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
"/projects" [(ByteString
"search", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
projectName))]
case Either (Response ByteString) [Project]
results of
Left Response ByteString
_ -> [Char] -> GitLab [Project]
forall a. HasCallStack => [Char] -> a
error [Char]
"projectsWithName error"
Right [Project]
projects ->
[Project] -> GitLab [Project]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Project] -> GitLab [Project]) -> [Project] -> GitLab [Project]
forall a b. (a -> b) -> a -> b
$
(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]
projects
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
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Project))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne
( 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)))
)
[(ByteString
"statistics", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"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 ([Char] -> [Text]
forall a. HasCallStack => [Char] -> a
error [Char]
"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 -> do
Either (Response ByteString) [Project]
result <- Text
-> [GitLabParam]
-> ReaderT GitLabState IO (Either (Response ByteString) [Project])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany (Int -> Text
forall a. Show a => a -> Text
urlPath (User -> Int
user_id User
usr)) []
case Either (Response ByteString) [Project]
result of
Left Response ByteString
_ -> [Char] -> GitLab (Maybe [Project])
forall a. HasCallStack => [Char] -> a
error [Char]
"userProjects' error"
Right [Project]
projs -> Maybe [Project] -> GitLab (Maybe [Project])
forall (m :: * -> *) a. Monad m => a -> m a
return ([Project] -> Maybe [Project]
forall a. a -> Maybe a
Just [Project]
projs)
where
urlPath :: a -> Text
urlPath a
usrId = Text
"/users/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (a -> [Char]
forall a. Show a => a -> [Char]
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 ([Char] -> Maybe Project
forall a. HasCallStack => [Char] -> a
error [Char]
"projectOfIssue error") Either (Response ByteString) (Maybe Project)
result of
Maybe Project
Nothing -> [Char] -> GitLab Project
forall a. HasCallStack => [Char] -> a
error [Char]
"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
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show (Project -> Int
project_id Project
project)) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/members/all"
([Member]
res :: [Member]) <- [Member] -> Either (Response ByteString) [Member] -> [Member]
forall b a. b -> Either a b -> b
fromRight ([Char] -> [Member]
forall a. HasCallStack => [Char] -> a
error [Char]
"projectMembersCount error") (Either (Response ByteString) [Member] -> [Member])
-> ReaderT GitLabState IO (Either (Response ByteString) [Member])
-> ReaderT GitLabState IO [Member]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Text
-> [GitLabParam]
-> ReaderT GitLabState IO (Either (Response ByteString) [Member])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany 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
-> [GitLabParam] -> GitLab (Either (Response ByteString) [Diff])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany
( Text
"/projects/"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
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
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe GroupShare))
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", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 ([Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
groupId)))),
(ByteString
"group_access", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 ([Char] -> Text
T.pack (AccessLevel -> [Char]
forall a. Show a => a -> [Char]
show AccessLevel
access))))
]
addr :: Text
addr =
Text
"/projects/"
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> [Char] -> Text
T.pack (Int -> [Char]
forall a. Show a => a -> [Char]
show Int
projectId)
Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/share"