diff --git a/data/system-hooks/merge-request-old.json b/data/system-hooks/merge-request-old.json new file mode 100644 --- /dev/null +++ b/data/system-hooks/merge-request-old.json @@ -0,0 +1,125 @@ +{"object_kind":"merge_request", + "event_type":"merge_request", + "user": + {"name":"Rob", "username":"abc123", + "avatar_url":"", + "email":"" + }, + "project": {"id":8879, + "name":"", + "description":"", + "web_url":"", + "avatar_url":null,"git_ssh_url":"", + "git_http_url":"", + "namespace":"", + "visibility_level":0,"path_with_namespace":"", + "default_branch":"master", "ci_config_path":null, + "homepage":"", + "url":"", + "ssh_url":"", + "http_url":"" + }, + "object_attributes":{"assignee_id":null, + "author_id":5, + "created_at":"2020-12-21 22:56:31 UTC", + "description":"", + "head_pipeline_id":null, + "id":1567, + "iid":7, + "last_edited_at":null, + "last_edited_by_id":null, + "merge_commit_sha":null, + "merge_error":null, + "merge_params":{}, + "merge_status":"unchecked", + "merge_user_id":null, + "merge_when_pipeline_succeeds":false, + "milestone_id":null, + "source_branch":"master", + "source_project_id":8987, + "state_id":1, + "target_branch":"master", + "target_project_id":8879, + "time_estimate":0, + "title":"Master", + "updated_at":"2020-12-21 22:56:31 UTC", + "updated_by_id":null, + "url":"", + "source":{"id":8987, "name":"", + "description":"", + "web_url":"", + "avatar_url":null, + "git_ssh_url":"", + "git_http_url":"", + "namespace":"Rob", "visibility_level":0, + "path_with_namespace":"", + "default_branch":"master", "ci_config_path":null, + "homepage":"", + "url":"", + "ssh_url":"", + "http_url":"" + }, + "target":{"id":8879, "name":"", + "description":"", + "web_url":"", + "avatar_url":null, + "git_ssh_url":"", + "git_http_url":"", + "namespace":"", "visibility_level":0, + "path_with_namespace":"", + "default_branch":"master", "ci_config_path":null, + "homepage":"", + "url":"", + "ssh_url":"", + "http_url":"" + }, + "last_commit":{"id":"", + "message":"", + "title":"", + "timestamp":"2020-09-28T16:13:42+01:00", + "url":"", + "author":{ + "name":"Rob", + "email":"" + } + }, + "work_in_progress":false, + "total_time_spent":0, + "human_total_time_spent":null, + "human_time_estimate":null, + "assignee_ids":[], + "state":"opened", + "action":"open" + }, + "labels":[], + "changes":{"author_id": + {"previous":null, + "current":5 + }, + "created_at": + {"previous":null, + "current":"2020-12-21 22:56:31 UTC" + }, + "description": + {"previous":null, + "current":"" + }, + "id": + {"previous":null, + "current":1567 + }, + "iid":{"previous":null, "current":7}, + "source_branch":{"previous":null, "current":"master"}, + "source_project_id":{"previous":null, "current":8987}, + "target_branch":{"previous":null, "current":"master"}, + "target_project_id":{"previous":null, "current":8879}, + "title":{"previous":null, "current":"Master"}, + "updated_at":{"previous":null, "current":"2020-12-21 22:56:31 UTC"} + }, + "repository": { "name":"", + "url":"", + "description":"", + "homepage":"" + } + +} diff --git a/data/system-hooks/merge-request.json b/data/system-hooks/merge-request.json --- a/data/system-hooks/merge-request.json +++ b/data/system-hooks/merge-request.json @@ -1,125 +1,149 @@ -{"object_kind":"merge_request", - "event_type":"merge_request", - "user": - {"name":"Rob", "username":"abc123", - "avatar_url":"", - "email":"" - }, - "project": {"id":8879, - "name":"", - "description":"", - "web_url":"", - "avatar_url":null,"git_ssh_url":"", - "git_http_url":"", - "namespace":"", - "visibility_level":0,"path_with_namespace":"", - "default_branch":"master", "ci_config_path":null, - "homepage":"", - "url":"", - "ssh_url":"", - "http_url":"" - }, - "object_attributes":{"assignee_id":null, - "author_id":5, - "created_at":"2020-12-21 22:56:31 UTC", - "description":"", - "head_pipeline_id":null, - "id":1567, - "iid":7, - "last_edited_at":null, - "last_edited_by_id":null, - "merge_commit_sha":null, - "merge_error":null, - "merge_params":{}, - "merge_status":"unchecked", - "merge_user_id":null, - "merge_when_pipeline_succeeds":false, - "milestone_id":null, - "source_branch":"master", - "source_project_id":8987, - "state_id":1, - "target_branch":"master", - "target_project_id":8879, - "time_estimate":0, - "title":"Master", - "updated_at":"2020-12-21 22:56:31 UTC", - "updated_by_id":null, - "url":"", - "source":{"id":8987, "name":"", - "description":"", - "web_url":"", - "avatar_url":null, - "git_ssh_url":"", - "git_http_url":"", - "namespace":"Rob", "visibility_level":0, - "path_with_namespace":"", - "default_branch":"master", "ci_config_path":null, - "homepage":"", - "url":"", - "ssh_url":"", - "http_url":"" - }, - "target":{"id":8879, "name":"", - "description":"", - "web_url":"", - "avatar_url":null, - "git_ssh_url":"", - "git_http_url":"", - "namespace":"", "visibility_level":0, - "path_with_namespace":"", - "default_branch":"master", "ci_config_path":null, - "homepage":"", - "url":"", - "ssh_url":"", - "http_url":"" - }, - "last_commit":{"id":"", - "message":"", - "title":"", - "timestamp":"2020-09-28T16:13:42+01:00", - "url":"", - "author":{ - "name":"Rob", - "email":"" - } - }, - "work_in_progress":false, - "total_time_spent":0, - "human_total_time_spent":null, - "human_time_estimate":null, - "assignee_ids":[], - "state":"opened", - "action":"open" - }, - "labels":[], - "changes":{"author_id": - {"previous":null, - "current":5 - }, - "created_at": - {"previous":null, - "current":"2020-12-21 22:56:31 UTC" - }, - "description": - {"previous":null, - "current":"" - }, - "id": - {"previous":null, - "current":1567 - }, - "iid":{"previous":null, "current":7}, - "source_branch":{"previous":null, "current":"master"}, - "source_project_id":{"previous":null, "current":8987}, - "target_branch":{"previous":null, "current":"master"}, - "target_project_id":{"previous":null, "current":8879}, - "title":{"previous":null, "current":"Master"}, - "updated_at":{"previous":null, "current":"2020-12-21 22:56:31 UTC"} - }, - "repository": { "name":"", - "url":"", - "description":"", - "homepage":"" - } - +{ + "object_kind": "merge_request", + "event_type": "merge_request", + "user": { + "id": 1, + "name": "Administrator", + "username": "root", + "avatar_url": "http://www.gravatar.com/avatar/e64c7d89f26bd1972efa854d13d7dd61?s=40\u0026d=identicon", + "email": "admin@example.com" + }, + "project": { + "id": 1, + "name":"Gitlab Test", + "description":"Aut reprehenderit ut est.", + "web_url":"http://example.com/gitlabhq/gitlab-test", + "avatar_url":null, + "git_ssh_url":"git@example.com:gitlabhq/gitlab-test.git", + "git_http_url":"http://example.com/gitlabhq/gitlab-test.git", + "namespace":"GitlabHQ", + "visibility_level":20, + "path_with_namespace":"gitlabhq/gitlab-test", + "default_branch":"master", + "homepage":"http://example.com/gitlabhq/gitlab-test", + "url":"http://example.com/gitlabhq/gitlab-test.git", + "ssh_url":"git@example.com:gitlabhq/gitlab-test.git", + "http_url":"http://example.com/gitlabhq/gitlab-test.git" + }, + "repository": { + "name": "Gitlab Test", + "url": "http://example.com/gitlabhq/gitlab-test.git", + "description": "Aut reprehenderit ut est.", + "homepage": "http://example.com/gitlabhq/gitlab-test" + }, + "object_attributes": { + "id": 99, + "target_branch": "master", + "source_branch": "ms-viewport", + "source_project_id": 14, + "author_id": 51, + "assignee_id": 6, + "title": "MS-Viewport", + "created_at": "2013-12-03T17:23:34Z", + "updated_at": "2013-12-03T17:23:34Z", + "milestone_id": null, + "state": "opened", + "merge_status": "unchecked", + "target_project_id": 14, + "iid": 1, + "description": "", + "source": { + "name":"Awesome Project", + "description":"Aut reprehenderit ut est.", + "web_url":"http://example.com/awesome_space/awesome_project", + "avatar_url":null, + "git_ssh_url":"git@example.com:awesome_space/awesome_project.git", + "git_http_url":"http://example.com/awesome_space/awesome_project.git", + "namespace":"Awesome Space", + "visibility_level":20, + "path_with_namespace":"awesome_space/awesome_project", + "default_branch":"master", + "homepage":"http://example.com/awesome_space/awesome_project", + "url":"http://example.com/awesome_space/awesome_project.git", + "ssh_url":"git@example.com:awesome_space/awesome_project.git", + "http_url":"http://example.com/awesome_space/awesome_project.git" + }, + "target": { + "name":"Awesome Project", + "description":"Aut reprehenderit ut est.", + "web_url":"http://example.com/awesome_space/awesome_project", + "avatar_url":null, + "git_ssh_url":"git@example.com:awesome_space/awesome_project.git", + "git_http_url":"http://example.com/awesome_space/awesome_project.git", + "namespace":"Awesome Space", + "visibility_level":20, + "path_with_namespace":"awesome_space/awesome_project", + "default_branch":"master", + "homepage":"http://example.com/awesome_space/awesome_project", + "url":"http://example.com/awesome_space/awesome_project.git", + "ssh_url":"git@example.com:awesome_space/awesome_project.git", + "http_url":"http://example.com/awesome_space/awesome_project.git" + }, + "last_commit": { + "id": "da1560886d4f094c3e6c9ef40349f7d38b5d27d7", + "message": "fixed readme", + "timestamp": "2012-01-03T23:36:29+02:00", + "url": "http://example.com/awesome_space/awesome_project/commits/da1560886d4f094c3e6c9ef40349f7d38b5d27d7", + "author": { + "name": "GitLab dev user", + "email": "gitlabdev@dv6700.(none)" + } + }, + "work_in_progress": false, + "url": "http://example.com/diaspora/merge_requests/1", + "action": "open", + "assignee": { + "name": "User1", + "username": "user1", + "avatar_url": "http://www.gravatar.com/avatar/e64c7d89f26bd1972efa854d13d7dd61?s=40\u0026d=identicon" + } + }, + "labels": [{ + "id": 206, + "title": "API", + "color": "#ffffff", + "project_id": 14, + "created_at": "2013-12-03T17:15:43Z", + "updated_at": "2013-12-03T17:15:43Z", + "template": false, + "description": "API related issues", + "type": "ProjectLabel", + "group_id": 41 + }], + "changes": { + "updated_by_id": { + "previous": null, + "current": 1 + }, + "updated_at": { + "previous": "2017-09-15 16:50:55 UTC", + "current":"2017-09-15 16:52:00 UTC" + }, + "labels": { + "previous": [{ + "id": 206, + "title": "API", + "color": "#ffffff", + "project_id": 14, + "created_at": "2013-12-03T17:15:43Z", + "updated_at": "2013-12-03T17:15:43Z", + "template": false, + "description": "API related issues", + "type": "ProjectLabel", + "group_id": 41 + }], + "current": [{ + "id": 205, + "title": "Platform", + "color": "#123123", + "project_id": 14, + "created_at": "2013-12-03T17:15:43Z", + "updated_at": "2013-12-03T17:15:43Z", + "template": false, + "description": "Platform related issues", + "type": "ProjectLabel", + "group_id": 41 + }] + } + } } diff --git a/gitlab-haskell.cabal b/gitlab-haskell.cabal --- a/gitlab-haskell.cabal +++ b/gitlab-haskell.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: gitlab-haskell category: Git -version: 0.3.1.1 +version: 0.3.2.0 synopsis: A Haskell library for the GitLab web API description: This Haskell library queries and updates the database of a GitLab instance using the GitLab web API: @@ -114,6 +114,24 @@ main-is: Tests.hs other-modules: SystemHookTests , API.BoardsTests + , API.BranchesTests + , API.CommitsTests + , API.DiscussionsTests + , API.EventsTests + , API.GroupsTests + , API.IssuesTests + , API.JobsTests + , API.MembersTests + , API.MergeRequestsTests + , API.NotesTests + , API.PipelinesTests + , API.ProjectsTests + , API.RepositoriesTests + , API.RepositoryFilesTests + , API.TagsTests + , API.TodosTests + , API.UsersTests + , API.VersionTests , API.Common hs-source-dirs: tests/ default-language: Haskell2010 diff --git a/src/GitLab/API/Boards.hs b/src/GitLab/API/Boards.hs --- a/src/GitLab/API/Boards.hs +++ b/src/GitLab/API/Boards.hs @@ -7,7 +7,32 @@ -- License : BSD3 -- Maintainer : robstewart57@gmail.com -- Stability : stable -module GitLab.API.Boards where +module GitLab.API.Boards + ( projectIssueBoards, + projectIssueBoards', + projectIssueBoard, + projectIssueBoard', + createIssueBoard, + createIssueBoard', + updateIssueBoard', + deleteIssueBoard, + deleteIssueBoard', + projectBoardLists, + projectBoardLists', + boardList, + boardList', + createBoardList, + createBoardList', + reorderBoardList, + reorderBoardList', + deleteBoardList, + deleteBoardList', + UpdateBoardAttrs (..), + defaultUpdateBoardAttrs, + defaultCreateBoardAttrs, + CreateBoardAttrs (..), + ) +where import qualified Data.ByteString.Lazy as BSL import Data.Either @@ -296,6 +321,8 @@ <> "/lists/" <> T.pack (show listId) +-- | Attributes for updating when editing a board with the +-- functions for updating issue boards. data UpdateBoardAttrs = UpdateBoardAttrs { updateBoard_new_name :: Maybe String, updateBoard_assignee_id :: Maybe Int, @@ -304,9 +331,9 @@ updateBoard_weight :: Maybe Int } --- | no attributes for board update. -noUpdateBoardAttrs :: UpdateBoardAttrs -noUpdateBoardAttrs = +-- | default attributes for board update. +defaultUpdateBoardAttrs :: UpdateBoardAttrs +defaultUpdateBoardAttrs = UpdateBoardAttrs Nothing Nothing Nothing Nothing Nothing updateBoardAttrs :: UpdateBoardAttrs -> [GitLabParam] @@ -326,9 +353,9 @@ createBoard_milestone_id :: Maybe Int } --- | no attributes for board creation. -noCreateBoardAttrs :: CreateBoardAttrs -noCreateBoardAttrs = +-- | default attributes for board creation. +defaultCreateBoardAttrs :: CreateBoardAttrs +defaultCreateBoardAttrs = CreateBoardAttrs Nothing Nothing Nothing createBoardAttrs :: CreateBoardAttrs -> [GitLabParam] diff --git a/src/GitLab/API/Groups.hs b/src/GitLab/API/Groups.hs --- a/src/GitLab/API/Groups.hs +++ b/src/GitLab/API/Groups.hs @@ -31,16 +31,17 @@ Left {} -> return result Right groups -> return - ( Right - $filter - ( \group -> - groupName == group_name group - || groupName == group_path group - || groupName == group_full_path group - ) - groups + ( Right $ + filter + ( \group -> + groupName == group_name group + || groupName == group_path group + || groupName == group_full_path group + ) + groups ) +-- | Get a list of projects in this group groupProjects :: -- | group Group -> @@ -48,6 +49,7 @@ groupProjects group = do groupProjects' (group_id group) +-- | Get a list of projects in this group groupProjects' :: -- | group ID Int -> diff --git a/src/GitLab/API/Issues.hs b/src/GitLab/API/Issues.hs --- a/src/GitLab/API/Issues.hs +++ b/src/GitLab/API/Issues.hs @@ -48,6 +48,7 @@ defaultIssueFilters = IssueAttrs Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing (Just All) Nothing Nothing Nothing Nothing Nothing Nothing +-- | When an issue is due data DueDate = NoDueDate | Overdue @@ -62,6 +63,7 @@ show Month = "month" show NextMonthPreviousTwoWeeks = "next_month_and_previous_two_weeks" +-- | Where to filter a search within data IssueSearchIn = JustTitle | JustDescription @@ -72,6 +74,7 @@ show JustDescription = "description" show TitleAndDescription = "title,description" +-- | Ordering search results data IssueOrderBy = CreatedAt | UpdatedAt @@ -94,6 +97,7 @@ show Popularity = "popularity" show Weight = "weight" +-- | Scope of issue search results data IssueScope = CreatedByMe | AssignedToMe @@ -104,6 +108,7 @@ show AssignedToMe = "assigned_to_me" show All = "all" +-- | Sort issues in ascending or descending order data IssueSortBy = Ascending | Descending @@ -112,6 +117,7 @@ show Ascending = "asc" show Descending = "desc" +-- | Is a project issues open or closed data IssueState = IssueOpen | IssueClosed @@ -120,6 +126,7 @@ show IssueOpen = "opened" show IssueClosed = "closed" +-- | Get a list of a project’s issues projectIssues :: -- | the project Project -> @@ -131,6 +138,7 @@ result <- projectIssues' (project_id p) filters return (fromRight (error "projectIssues error") result) +-- | Get a list of a project’s issues projectIssues' :: -- | the project ID Int -> @@ -293,9 +301,7 @@ Right Nothing -> error "editIssue error" Right (Just issue) -> return (Right issue) -------------------------------- --- Internal functions and types - +-- | Attributes related to a project issue data IssueAttrs = IssueAttrs { issueFilter_assignee_id :: Maybe Int, issueFilter_assignee_username :: Maybe String, diff --git a/src/GitLab/API/Members.hs b/src/GitLab/API/Members.hs --- a/src/GitLab/API/Members.hs +++ b/src/GitLab/API/Members.hs @@ -239,6 +239,7 @@ users <- catMaybes <$> mapM searchUser usernames mapM (addUserToGroup' groupName access . user_id) users +-- | Removes a user from a project where the user has been explicitly assigned a role removeUserFromProject :: -- | project name Text -> @@ -248,6 +249,7 @@ removeUserFromProject grpName usr = removeUserFromEntity grpName "projects" usr +-- | Removes a user from a project where the user has been explicitly assigned a role removeUserFromProject' :: -- | project name Text -> @@ -257,6 +259,7 @@ removeUserFromProject' grpName usrId = removeUserFromEntity' grpName "projects" usrId +-- | Removes a user from a group where the user has been explicitly assigned a role removeUserFromGroup :: -- | group name Text -> @@ -266,6 +269,7 @@ removeUserFromGroup grpName usr = removeUserFromEntity grpName "groups" usr +-- | Removes a user from a group where the user has been explicitly assigned a role removeUserFromGroup' :: -- | group name Text -> @@ -275,6 +279,9 @@ removeUserFromGroup' grpName usrId = removeUserFromEntity' grpName "groups" usrId +----------------------- +-- Internal functions. + -- | removes a user from a group or project. removeUserFromEntity :: -- | group name @@ -308,7 +315,7 @@ Left err -> return (Left err) -- GitLab version 14.2.3 returns Version JSON info when a -- member is removed from a group/project. I'm not sure if - -- this is new behaviour, anyway we catch it here. + -- this is new behaviour, anyway we catch it here. Right (Just (Version {})) -> return (Right (Just ())) Right Nothing -> return (Right (Just ())) where @@ -322,13 +329,11 @@ Right (_ : _) -> return (Right Nothing) - - -- | the members of a project given its ID. membersOfEntity' :: - -- ^ group or project ID + -- | group or project ID Int -> - -- ^ entity ("groups" or "projects") + -- | entity ("groups" or "projects") Text -> GitLab (Either (Response BSL.ByteString) [Member]) membersOfEntity' projectId entity = @@ -336,7 +341,7 @@ where addr = "/" - <> entity - <> "/" - <> T.pack (show projectId) - <> "/members" + <> entity + <> "/" + <> T.pack (show projectId) + <> "/members" diff --git a/src/GitLab/API/Notes.hs b/src/GitLab/API/Notes.hs --- a/src/GitLab/API/Notes.hs +++ b/src/GitLab/API/Notes.hs @@ -2,7 +2,7 @@ -- | -- Module : Notes --- Description : Notes on issues, snippets, merge requests and epics. +-- Description : Notes on issues, snippets, merge requests and epics -- Copyright : (c) Rob Stewart, Heriot-Watt University, 2020 -- License : BSD3 -- Maintainer : robstewart57@gmail.com @@ -17,6 +17,7 @@ import GitLab.WebRequests.GitLabWebCalls import Network.HTTP.Client +-- | Creates a new note for a single merge request. createMergeRequestNote :: -- | project Project -> @@ -28,6 +29,7 @@ createMergeRequestNote project = createMergeRequestNote' (project_id project) +-- | Creates a new note for a single merge request. createMergeRequestNote' :: -- | project ID Int -> diff --git a/src/GitLab/API/Pipelines.hs b/src/GitLab/API/Pipelines.hs --- a/src/GitLab/API/Pipelines.hs +++ b/src/GitLab/API/Pipelines.hs @@ -39,3 +39,34 @@ "/projects/" <> T.pack (show projectId) <> "/pipelines" + +-- | get a pipeline’s test report. Since GitLab 13.0. +pipelineTestReport :: + -- | the project + Project -> + -- | the pipeline + Pipeline -> + GitLab TestReport +pipelineTestReport proj pipeline = do + result <- pipelineTestReport' (project_id proj) (pipeline_id pipeline) + case fromRight (error "pipelineTestReport error") result of + Nothing -> error "pipelineTestReport error" + Just testReport -> return testReport + +-- | get a pipeline’s test report. Since GitLab 13.0. +pipelineTestReport' :: + -- | the project ID + Int -> + -- | the pipeline ID + Int -> + GitLab (Either (Response BSL.ByteString) (Maybe TestReport)) +pipelineTestReport' projId pipelineId = do + let urlPath = + T.pack + ( "/projects/" + <> show projId + <> "/pipelines/" + <> show pipelineId + <> "/test_report" + ) + gitlabGetOne urlPath [] diff --git a/src/GitLab/API/Projects.hs b/src/GitLab/API/Projects.hs --- a/src/GitLab/API/Projects.hs +++ b/src/GitLab/API/Projects.hs @@ -9,7 +9,40 @@ -- License : BSD3 -- Maintainer : robstewart57@gmail.com -- Stability : stable -module GitLab.API.Projects where +module GitLab.API.Projects + ( allProjects, + projectForks, + searchProjectId, + projectsWithName, + projectsWithNameAndUser, + multipleCommitters, + commitsEmailAddresses, + commitsEmailAddresses', + userProjects, + userProjects', + projectOfIssue, + issuesCreatedByUser, + issuesOnForks, + projectMemebersCount, + projectCISuccess, + namespacePathToUserId, + projectDiffs, + projectDiffs', + addGroupToProject, + transferProject, + transferProject', + editProject, + editProject', + defaultEditProjectAttrs, + EditProjectAttrs (..), + EnabledDisabled (..), + AutoDeployStrategy (..), + GitStrategy (..), + ProjectSettingAccessLevel (..), + MergeMethod (..), + SquashOption (..), + ) +where import qualified Data.ByteString.Lazy as BSL import Data.Either @@ -322,6 +355,8 @@ Right Nothing -> error "editProject error" Right (Just proj) -> return (Right proj) +-- | A default set of project attributes to override with the +-- 'editProject' functions. defaultEditProjectAttrs :: -- | project ID Int -> @@ -399,6 +434,8 @@ showBool True = "true" showBool False = "false" +-- | Attributes for updating when editing a project with the +-- 'editProject' functions. data EditProjectAttrs = EditProjectAttrs { -- | Set whether or not merge requests can be merged with skipped jobs. project_edit_allow_merge_on_skipped_pipeline :: Maybe Bool, @@ -516,6 +553,7 @@ } deriving (Generic, Show, Eq) +-- | Is auto-cancel pending pipelines enabled or disabled data EnabledDisabled = Enabled | Disabled @@ -525,6 +563,8 @@ show Enabled = "enabled" show Disabled = "disabled" +-- | Auto Deploy strategy: continuous, manual, or timed_incremental, +-- for the 'editProject' functions data AutoDeployStrategy = Continuous | Manual @@ -536,6 +576,7 @@ show Manual = "manual" show TimedIncremental = "timed_incremental" +-- | The Git strategy, defaults to fetch, for the 'editProject' functions data GitStrategy = Clone | Fetch @@ -547,6 +588,7 @@ show Fetch = "fetch" show None = "none" +-- | The project access level setting, for the 'editProject' functions data ProjectSettingAccessLevel = DisabledAccess | PrivateAccess @@ -560,6 +602,7 @@ show EnabledAccess = "enabled" show PublicAccess = "public" +-- | The project git merge method, for the 'editProject' functions data MergeMethod = Merge | RebaseMerge @@ -571,6 +614,7 @@ show RebaseMerge = "rebase_merge" show FF = "ff" +-- | The project git merge squash option, for the 'editProject' functions data SquashOption = NeverSquash | AlwaysSquash diff --git a/src/GitLab/API/Repositories.hs b/src/GitLab/API/Repositories.hs --- a/src/GitLab/API/Repositories.hs +++ b/src/GitLab/API/Repositories.hs @@ -16,6 +16,7 @@ import GitLab.Types import GitLab.WebRequests.GitLabWebCalls import Network.HTTP.Client +import Network.HTTP.Types.Status -- | returns a list of repository files and directories in a project. repositories :: @@ -102,10 +103,11 @@ ArchiveFormat -> GitLab (Either (Response BSL.ByteString) (Maybe BSL.ByteString)) getFileArchiveBS' projectId format = do - result <- gitlabGetOne addr [] :: GitLab (Either (Response BSL.ByteString) (Maybe Bool)) - case result of - Left response -> return (Right (Just (responseBody response))) - Right _b -> error "impossible" -- we're asking it to parse BS as a Bool, which shouldn't be possible. + result <- gitlabGetByteStringResponse addr [] + let (Status n _msg) = responseStatus result + if n >= 200 && n <= 226 + then return (Right (Just (responseBody result))) + else return (Left result) where addr = "/projects/" diff --git a/src/GitLab/API/Todos.hs b/src/GitLab/API/Todos.hs --- a/src/GitLab/API/Todos.hs +++ b/src/GitLab/API/Todos.hs @@ -2,7 +2,7 @@ -- | -- Module : Todos --- Description : Queries about todos for users. +-- Description : Queries about todos for users -- Copyright : (c) Rob Stewart, Heriot-Watt University, 2019 -- License : BSD3 -- Maintainer : robstewart57@gmail.com diff --git a/src/GitLab/SystemHooks/Rules.hs b/src/GitLab/SystemHooks/Rules.hs --- a/src/GitLab/SystemHooks/Rules.hs +++ b/src/GitLab/SystemHooks/Rules.hs @@ -17,6 +17,8 @@ import GitLab.SystemHooks.Types import GitLab.Types +-- | When a new user creates an account on a GitLab server they are +-- added to all groups in the specified group list ruleAddNewUserToGroups :: -- | rule label String -> @@ -41,6 +43,8 @@ groupNames ) +-- | Add specified users with a 'Reporter' role to all specified +-- projects with a given project name ruleAddMembers :: -- | rule label String -> diff --git a/src/GitLab/SystemHooks/Types.hs b/src/GitLab/SystemHooks/Types.hs --- a/src/GitLab/SystemHooks/Types.hs +++ b/src/GitLab/SystemHooks/Types.hs @@ -46,6 +46,7 @@ CommitAuthorEvent (..), Visibility (..), MergeRequestEvent (..), + Label (..), MergeRequestChanges (..), MergeRequestChange (..), ObjectAttributes (..), @@ -588,39 +589,58 @@ mergeRequest_user :: UserEvent, mergeRequest_project :: ProjectEvent, mergeRequest_object_attributes :: ObjectAttributes, - mergeRequest_labels :: Maybe [Text], + mergeRequest_labels :: Maybe [Label], mergeRequest_changes :: MergeRequestChanges, mergeRequest_repository :: RepositoryEvent } deriving (Typeable, Show, Eq, Generic) +-- | Label associated with a merge request +data Label = Label + { label_id :: Maybe Int, + label_title :: Maybe Text, + label_color :: Maybe Text, + label_project_id :: Maybe Int, + label_created_at :: Maybe Text, -- TODO date from e.g. "2013-12-03T17:15:43Z" + label_updated_at :: Maybe Text, -- TODO date + label_template :: Maybe Bool, + label_description :: Maybe Text, + label_type :: Maybe Text, -- TODO type from "ProjectLabel" + label_group_id :: Maybe Int + } + deriving (Typeable, Show, Eq, Generic) + +-- | Changes that a merge request will make data MergeRequestChanges = MergeRequestChanges - { mergeRequestChanges_author_id :: MergeRequestChange Int, - mergeRequestChanges_created_at :: MergeRequestChange Text, - mergeRequestChanges_description :: MergeRequestChange Text, - mergeRequestChanges_id :: MergeRequestChange Int, - mergeRequestChanges_iid :: MergeRequestChange Int, - mergeRequestChanges_source_branch :: MergeRequestChange Text, - mergeRequestChanges_source_project_id :: MergeRequestChange Int, - mergeRequestChanges_target_branch :: MergeRequestChange Text, - mergeRequestChanges_target_project_id :: MergeRequestChange Int, - mergeRequestChanges_title :: MergeRequestChange Text, - mergeRequestChanges_updated_at :: MergeRequestChange Text + { mergeRequestChanges_author_id :: Maybe (MergeRequestChange Int), + mergeRequestChanges_created_at :: Maybe (MergeRequestChange Text), + mergeRequestChanges_description :: Maybe (MergeRequestChange Text), + mergeRequestChanges_id :: Maybe (MergeRequestChange Int), + mergeRequestChanges_iid :: Maybe (MergeRequestChange Int), + mergeRequestChanges_source_branch :: Maybe (MergeRequestChange Text), + mergeRequestChanges_source_project_id :: Maybe (MergeRequestChange Int), + mergeRequestChanges_target_branch :: Maybe (MergeRequestChange Text), + mergeRequestChanges_target_project_id :: Maybe (MergeRequestChange Int), + mergeRequestChanges_title :: Maybe (MergeRequestChange Text), + mergeRequestChanges_updated_at :: Maybe (MergeRequestChange Text) } deriving (Typeable, Show, Eq, Generic) +-- | The change between for a given GitLab data field a merge request +-- will make data MergeRequestChange a = MergeRequestChange { mergeRequestChange_previous :: Maybe a, mergeRequestChange_current :: Maybe a } deriving (Typeable, Show, Eq, Generic) +-- | Attributes associated with a merge request data ObjectAttributes = ObjectAttributes { objectAttributes_id :: Int, objectAttributes_target_branch :: Text, objectAttributes_source_branch :: Text, objectAttributes_source_project_id :: Int, - objectAttributes_author_id :: Int, + objectAttributes_author_id :: Maybe Int, objectAttributes_assignee_id :: Maybe Int, objectAttributes_assignee_ids :: Maybe [Int], objectAttributes_title :: Text, @@ -635,14 +655,14 @@ objectAttributes_description :: Text, objectAttributes_updated_by_id :: Maybe Int, objectAttributes_merge_error :: Maybe Text, - objectAttributes_merge_params :: MergeParams, - objectAttributes_merge_when_pipeline_succeeds :: Bool, + objectAttributes_merge_params :: Maybe MergeParams, + objectAttributes_merge_when_pipeline_succeeds :: Maybe Bool, objectAttributes_merge_user_id :: Maybe Int, objectAttributes_merge_commit_sha :: Maybe Text, objectAttributes_deleted_at :: Maybe Text, objectAttributes_in_progress_merge_commit_sha :: Maybe Text, objectAttributes_lock_version :: Maybe Int, - objectAttributes_time_estimate :: Int, + objectAttributes_time_estimate :: Maybe Int, objectAttributes_last_edited_at :: Maybe Text, objectAttributes_last_edited_by_id :: Maybe Int, objectAttributes_head_pipeline_id :: Maybe Int, @@ -652,18 +672,20 @@ objectAttributes_target :: ProjectEvent, objectAttributes_last_commit :: CommitEvent, objectAttributes_work_in_progress :: Bool, - objectAttributes_total_time_spent :: Int, + objectAttributes_total_time_spent :: Maybe Int, objectAttributes_human_total_time_spent :: Maybe Int, objectAttributes_human_time_estimate :: Maybe Int, objectAttributes_action :: Maybe Text } deriving (Typeable, Show, Eq, Generic) +-- | Merge parameters associated with a merge request data MergeParams = MergeParams { mergeParams_force_remove_source_branch :: Maybe Text } deriving (Typeable, Show, Eq, Generic) +-- | User associated with a merge request data UserEvent = UserEvent { userEvent_name :: Text, userEvent_username :: Text, @@ -1400,6 +1422,32 @@ { fieldLabelModifier = bodyNoPrefix } ) + +instance FromJSON Label where + parseJSON = withObject "Label" $ \obj -> do + labelId <- obj .:? "id" + labelTitle <- obj .:? "title" + labelColor <- obj .:? "color" + labelProjectId <- obj .:? "project_id" + labelCreatedAt <- obj .:? "created_at" + labelUpdatedAt <- obj .:? "updated_at" + labelTemplate <- obj .:? "template" + labelDescription <- obj .:? "description" + labelType <- obj .:? "type" + labelGroupId <- obj .:? "group_id" + return $ + Label + { label_id = labelId, + label_title = labelTitle, + label_color = labelColor, + label_project_id = labelProjectId, + label_created_at = labelCreatedAt, + label_updated_at = labelUpdatedAt, + label_template = labelTemplate, + label_description = labelDescription, + label_type = labelType, + label_group_id = labelGroupId + } instance FromJSON ProjectAction where parseJSON (String "project_create") = return ProjectCreated diff --git a/src/GitLab/Types.hs b/src/GitLab/Types.hs --- a/src/GitLab/Types.hs +++ b/src/GitLab/Types.hs @@ -36,6 +36,7 @@ CommitTodo (..), CommitStats (..), Tag (..), + Release (..), Diff (..), Repository (..), Job (..), @@ -54,13 +55,18 @@ URL, EditIssueReq (..), Discussion (..), + Note (..), IssueStatistics (..), + IssueStats (..), IssueCounts (..), IssueBoard (..), BoardIssue (..), BoardIssueLabel (..), ProjectBoard (..), Visibility (..), + TestReport (..), + TestSuite (..), + TestCase (..), ) where @@ -399,6 +405,7 @@ } deriving (Generic, Show) +-- | Release associated with a tag data Release = Release { release_tag_name :: Text, release_description :: Text @@ -707,16 +714,19 @@ } deriving (Generic, Show) +-- | Statistics and an issue newtype IssueStatistics = IssueStatistics { issues_statistics :: IssueStats } deriving (Generic, Show) +-- | Issue statistics newtype IssueStats = IssueStats { issues_counts :: IssueCounts } deriving (Generic, Show) +-- | A count of all, open and closed issues against a project data IssueCounts = IssueCounts { issues_all :: Int, issues_closed :: Int, @@ -724,6 +734,7 @@ } deriving (Generic, Show) +-- | Project issue boards https://docs.gitlab.com/ee/user/project/issue_board.html data IssueBoard = IssueBoard { board_id :: Int, board_name :: Text, @@ -737,6 +748,7 @@ } deriving (Generic, Show, Eq) +-- | Issues associated with a project issue board data BoardIssue = BoardIssue { board_issue_id :: Int, board_issue_label :: BoardIssueLabel, @@ -748,6 +760,7 @@ } deriving (Generic, Show, Eq) +-- | Label of an issues for a project issue board data BoardIssueLabel = BoardIssueLabel { board_issue_label_id :: Maybe Int, board_issue_label_name :: Text, @@ -756,6 +769,7 @@ } deriving (Generic, Show, Eq) +-- | A project board data ProjectBoard = ProjectBoard { project_board_id :: Int, project_board_name :: Text, @@ -783,6 +797,60 @@ parseJSON (Number 20) = return Public parseJSON n = error (show n) +-- | Unit test reports for a CI pipeline https://docs.gitlab.com/ee/ci/unit_test_reports.html +data TestReport = TestReport + { total_time :: Double, + total_count :: Int, + success_count :: Int, + failed_count :: Int, + skipped_count :: Int, + error_count :: Int, + test_suites :: [TestSuite] + } + deriving (Generic, Show, Eq) + +-- | Testsuites associated with a test report +data TestSuite = TestSuite + { testsuite_name :: Text, + testsuite_total_time :: Double, + testsuite_success_count :: Int, + testsuite_failed_count :: Int, + testsuite_skipped_count :: Int, + testsuite_error_count :: Int, + testsuite_test_cases :: [TestCase] + } + deriving (Generic, Show, Eq) + +testsuitePrefix :: String -> String +testsuitePrefix "testsuite_name" = "name" +testsuitePrefix "testsuite_total_time" = "total_time" +testsuitePrefix "testsuite_success_count" = "success_count" +testsuitePrefix "testsuite_failed_count" = "failed_count" +testsuitePrefix "testsuite_skipped_count" = "skipped_count" +testsuitePrefix "testsuite_error_count" = "error_count" +testsuitePrefix "testsuite_test_cases" = "test_cases" +testsuitePrefix s = s + +-- | Test case associated with a testsuite +data TestCase = TestCase + { testcase_status :: Text, -- could turn this into a type e.g. for "success" + testcase_name :: Text, + testcase_classname :: Text, + testcase_execution_time :: Double, + testcase_system_output :: Maybe Text, + testcase_stack_trace :: Maybe Text + } + deriving (Generic, Show, Eq) + +testcasePrefix :: String -> String +testcasePrefix "testcase_status" = "status" +testcasePrefix "testcase_name" = "name" +testcasePrefix "testcase_classname" = "classname" +testcasePrefix "testcase_execution_time" = "execution_time" +testcasePrefix "testcase_system_output" = "system_output" +testcasePrefix "testcase_stack_trace" = "stack_trace" +testcasePrefix s = s + ----------------------------- -- JSON GitLab parsers below ----------------------------- @@ -1286,5 +1354,25 @@ genericParseJSON ( defaultOptions { fieldLabelModifier = boardsPrefix + } + ) + +instance FromJSON TestReport where + parseJSON = + genericParseJSON defaultOptions + +instance FromJSON TestSuite where + parseJSON = + genericParseJSON + ( defaultOptions + { fieldLabelModifier = testsuitePrefix + } + ) + +instance FromJSON TestCase where + parseJSON = + genericParseJSON + ( defaultOptions + { fieldLabelModifier = testcasePrefix } ) diff --git a/src/GitLab/WebRequests/GitLabWebCalls.hs b/src/GitLab/WebRequests/GitLabWebCalls.hs --- a/src/GitLab/WebRequests/GitLabWebCalls.hs +++ b/src/GitLab/WebRequests/GitLabWebCalls.hs @@ -10,6 +10,7 @@ gitlabPut, gitlabDelete, gitlabUnsafe, + gitlabGetByteStringResponse, ) where @@ -19,6 +20,7 @@ import Data.Aeson import Data.ByteString import qualified Data.ByteString.Lazy as BSL +import Data.Maybe (isJust) import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T @@ -130,6 +132,25 @@ Right Nothing -> error "gitlabUnsafe error" Right (Just x) -> return x +-- | Lower level query that returns the raw bytestring response from a +-- GitLab HTTP query. Useful for downloading project archives files. +gitlabGetByteStringResponse :: + -- | the URL to post to + Text -> + -- | the data to post + [GitLabParam] -> + GitLab (Response BSL.ByteString) +gitlabGetByteStringResponse urlPath params = + request + where + request = + gitlabHTTP + "GET" + "application/x-www-form-urlencoded" + urlPath + params + [] + --------------------- -- internal functions @@ -219,24 +240,22 @@ case parseMany (responseBody response) of Nothing -> return (Right accum) Just moreResults -> do - let numPages = totalPages response - accum' = accum <> moreResults - if pageNum == numPages - then return (Right accum') - else go (pageNum + 1) accum' + let accum' = accum <> moreResults + if hasNextPage response + then go (pageNum + 1) accum' + else return (Right accum') else return (Left response) -totalPages :: Response a -> Int -totalPages resp = +hasNextPage :: Response a -> Bool +hasNextPage resp = let hdrs = responseHeaders resp in findPages hdrs where - findPages [] = 1 -- error "cannot find X-Total-Pages in header" - findPages (("X-Total-Pages", bs) : _) = - case readMaybe (T.unpack (T.decodeUtf8 bs)) of - Just s -> s - Nothing -> error "cannot find X-Total-Pages in header" + findPages [] = False + findPages (("X-Next-Page", bs) : _) = isJust $ readNP bs findPages (_ : xs) = findPages xs + readNP :: ByteString -> Maybe Int + readNP bs = readMaybe (T.unpack (T.decodeUtf8 bs)) successStatus :: Status -> Bool successStatus (Status n _msg) = diff --git a/tests/API/BranchesTests.hs b/tests/API/BranchesTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/BranchesTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.BranchesTests (branchesTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/branches.html +branchesTests :: [TestTree] +branchesTests = + [] diff --git a/tests/API/CommitsTests.hs b/tests/API/CommitsTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/CommitsTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.CommitsTests (commitsTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/commits.html +commitsTests :: [TestTree] +commitsTests = + [] diff --git a/tests/API/DiscussionsTests.hs b/tests/API/DiscussionsTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/DiscussionsTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.DiscussionsTests (discussionsTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/discussions.html +discussionsTests :: [TestTree] +discussionsTests = + [] diff --git a/tests/API/EventsTests.hs b/tests/API/EventsTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/EventsTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.EventsTests (eventsTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/events.html +eventsTests :: [TestTree] +eventsTests = + [] diff --git a/tests/API/GroupsTests.hs b/tests/API/GroupsTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/GroupsTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.GroupsTests (groupsTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/groups.html +groupsTests :: [TestTree] +groupsTests = + [] diff --git a/tests/API/IssuesTests.hs b/tests/API/IssuesTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/IssuesTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.IssuesTests (issuesTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/issues.html +issuesTests :: [TestTree] +issuesTests = + [] diff --git a/tests/API/JobsTests.hs b/tests/API/JobsTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/JobsTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.JobsTests (jobsTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/jobs.html +jobsTests :: [TestTree] +jobsTests = + [] diff --git a/tests/API/MembersTests.hs b/tests/API/MembersTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/MembersTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.MembersTests (membersTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/members.html +membersTests :: [TestTree] +membersTests = + [] diff --git a/tests/API/MergeRequestsTests.hs b/tests/API/MergeRequestsTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/MergeRequestsTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.MergeRequestsTests (mergeRequestsTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/merge_requests.html +mergeRequestsTests :: [TestTree] +mergeRequestsTests = + [] diff --git a/tests/API/NotesTests.hs b/tests/API/NotesTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/NotesTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.NotesTests (notesTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/notes.html +notesTests :: [TestTree] +notesTests = + [] diff --git a/tests/API/PipelinesTests.hs b/tests/API/PipelinesTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/PipelinesTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.PipelinesTests (pipelinesTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/pipelines.html +pipelinesTests :: [TestTree] +pipelinesTests = + [] diff --git a/tests/API/ProjectsTests.hs b/tests/API/ProjectsTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/ProjectsTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.ProjectsTests (projectsTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/projects.html +projectsTests :: [TestTree] +projectsTests = + [] diff --git a/tests/API/RepositoriesTests.hs b/tests/API/RepositoriesTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/RepositoriesTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.RepositoriesTests (repositoriesTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/repositories.html +repositoriesTests :: [TestTree] +repositoriesTests = + [] diff --git a/tests/API/RepositoryFilesTests.hs b/tests/API/RepositoryFilesTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/RepositoryFilesTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.RepositoryFilesTests (repositoryFilesTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/repository_files.html +repositoryFilesTests :: [TestTree] +repositoryFilesTests = + [] diff --git a/tests/API/TagsTests.hs b/tests/API/TagsTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/TagsTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.TagsTests (tagsTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/tags.html +tagsTests :: [TestTree] +tagsTests = + [] diff --git a/tests/API/TodosTests.hs b/tests/API/TodosTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/TodosTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.TodosTests (todosTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/todos.html +todosTests :: [TestTree] +todosTests = + [] diff --git a/tests/API/UsersTests.hs b/tests/API/UsersTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/UsersTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.UsersTests (usersTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/users.html +usersTests :: [TestTree] +usersTests = + [] diff --git a/tests/API/VersionTests.hs b/tests/API/VersionTests.hs new file mode 100644 --- /dev/null +++ b/tests/API/VersionTests.hs @@ -0,0 +1,19 @@ +{-# LANGUAGE FlexibleInstances #-} +{-# LANGUAGE OverloadedStrings #-} + +module API.VersionTests (versionTests) where + +import API.Common +import Control.Monad.IO.Class +import Data.Aeson +import qualified Data.ByteString.Lazy.Char8 as BSL +import GitLab +import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Types +import Test.Tasty +import Test.Tasty.HUnit + +-- | https://docs.gitlab.com/ee/api/version.html +versionTests :: [TestTree] +versionTests = + [] diff --git a/tests/SystemHookTests.hs b/tests/SystemHookTests.hs --- a/tests/SystemHookTests.hs +++ b/tests/SystemHookTests.hs @@ -1108,7 +1108,7 @@ matchIf "mergeRequest rule-if yes" ( \event@MergeRequestEvent {} -> do - return (userEvent_name (mergeRequest_user event) == "Rob") + return (userEvent_name (mergeRequest_user event) == "Administrator") ) ( \MergeRequestEvent {} -> do return () @@ -1471,13 +1471,4 @@ mergeRequestHaskell :: MergeRequestEvent mergeRequestHaskell = - MergeRequestEvent - { mergeRequest_object_kind = "merge_request", - mergeRequest_event_type = "merge_request", - mergeRequest_user = UserEvent {userEvent_name = "Rob", userEvent_username = "abc123", userEvent_avatar_url = ""}, - mergeRequest_project = ProjectEvent {projectEvent_name = "", projectEvent_description = "", projectEvent_web_url = "", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "", projectEvent_git_http_url = "", projectEvent_namespace = "", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "", projectEvent_default_branch = "master", projectEvent_homepage = Just "", projectEvent_url = "", projectEvent_ssh_url = "", projectEvent_http_url = ""}, - mergeRequest_object_attributes = ObjectAttributes {objectAttributes_id = 1567, objectAttributes_target_branch = "master", objectAttributes_source_branch = "master", objectAttributes_source_project_id = 8987, objectAttributes_author_id = 5, objectAttributes_assignee_id = Nothing, objectAttributes_assignee_ids = Just [], objectAttributes_title = "Master", objectAttributes_created_at = "2020-12-21 22:56:31 UTC", objectAttributes_updated_at = "2020-12-21 22:56:31 UTC", objectAttributes_milestone_id = Nothing, objectAttributes_state = "opened", objectAttributes_state_id = Just 1, objectAttributes_merge_status = "unchecked", objectAttributes_target_project_id = 8879, objectAttributes_iid = 7, objectAttributes_description = "", objectAttributes_updated_by_id = Nothing, objectAttributes_merge_error = Nothing, objectAttributes_merge_params = MergeParams {mergeParams_force_remove_source_branch = Nothing}, objectAttributes_merge_when_pipeline_succeeds = False, objectAttributes_merge_user_id = Nothing, objectAttributes_merge_commit_sha = Nothing, objectAttributes_deleted_at = Nothing, objectAttributes_in_progress_merge_commit_sha = Nothing, objectAttributes_lock_version = Nothing, objectAttributes_time_estimate = 0, objectAttributes_last_edited_at = Nothing, objectAttributes_last_edited_by_id = Nothing, objectAttributes_head_pipeline_id = Nothing, objectAttributes_ref_fetched = Nothing, objectAttributes_merge_jid = Nothing, objectAttributes_source = ProjectEvent {projectEvent_name = "", projectEvent_description = "", projectEvent_web_url = "", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "", projectEvent_git_http_url = "", projectEvent_namespace = "Rob", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "", projectEvent_default_branch = "master", projectEvent_homepage = Just "", projectEvent_url = "", projectEvent_ssh_url = "", projectEvent_http_url = ""}, objectAttributes_target = ProjectEvent {projectEvent_name = "", projectEvent_description = "", projectEvent_web_url = "", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "", projectEvent_git_http_url = "", projectEvent_namespace = "", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "", projectEvent_default_branch = "master", projectEvent_homepage = Just "", projectEvent_url = "", projectEvent_ssh_url = "", projectEvent_http_url = ""}, objectAttributes_last_commit = CommitEvent {commitEvent_id = "", commitEvent_message = "", commitEvent_timestamp = "2020-09-28T16:13:42+01:00", commitEvent_url = "", commitEvent_author = CommitAuthorEvent {commitAuthorEvent_name = "Rob", commitAuthorEvent_email = ""}}, objectAttributes_work_in_progress = False, objectAttributes_total_time_spent = 0, objectAttributes_human_total_time_spent = Nothing, objectAttributes_human_time_estimate = Nothing, objectAttributes_action = Just "open"}, - mergeRequest_labels = Just [], - mergeRequest_changes = MergeRequestChanges {mergeRequestChanges_author_id = MergeRequestChange {mergeRequestChange_previous = Nothing, mergeRequestChange_current = Just 5}, mergeRequestChanges_created_at = MergeRequestChange {mergeRequestChange_previous = Nothing, mergeRequestChange_current = Just "2020-12-21 22:56:31 UTC"}, mergeRequestChanges_description = MergeRequestChange {mergeRequestChange_previous = Nothing, mergeRequestChange_current = Just ""}, mergeRequestChanges_id = MergeRequestChange {mergeRequestChange_previous = Nothing, mergeRequestChange_current = Just 1567}, mergeRequestChanges_iid = MergeRequestChange {mergeRequestChange_previous = Nothing, mergeRequestChange_current = Just 7}, mergeRequestChanges_source_branch = MergeRequestChange {mergeRequestChange_previous = Nothing, mergeRequestChange_current = Just "master"}, mergeRequestChanges_source_project_id = MergeRequestChange {mergeRequestChange_previous = Nothing, mergeRequestChange_current = Just 8987}, mergeRequestChanges_target_branch = MergeRequestChange {mergeRequestChange_previous = Nothing, mergeRequestChange_current = Just "master"}, mergeRequestChanges_target_project_id = MergeRequestChange {mergeRequestChange_previous = Nothing, mergeRequestChange_current = Just 8879}, mergeRequestChanges_title = MergeRequestChange {mergeRequestChange_previous = Nothing, mergeRequestChange_current = Just "Master"}, mergeRequestChanges_updated_at = MergeRequestChange {mergeRequestChange_previous = Nothing, mergeRequestChange_current = Just "2020-12-21 22:56:31 UTC"}}, - mergeRequest_repository = RepositoryEvent {repositoryEvent_name = "", repositoryEvent_url = "", repositoryEvent_description = "", repositoryEvent_homepage = Just "", repositoryEvent_git_http_url = Nothing, repositoryEvent_git_ssh_url = Nothing, repositoryEvent_visibility_level = Nothing} - } + MergeRequestEvent {mergeRequest_object_kind = "merge_request", mergeRequest_event_type = "merge_request", mergeRequest_user = UserEvent {userEvent_name = "Administrator", userEvent_username = "root", userEvent_avatar_url = "http://www.gravatar.com/avatar/e64c7d89f26bd1972efa854d13d7dd61?s=40&d=identicon"}, mergeRequest_project = ProjectEvent {projectEvent_name = "Gitlab Test", projectEvent_description = "Aut reprehenderit ut est.", projectEvent_web_url = "http://example.com/gitlabhq/gitlab-test", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@example.com:gitlabhq/gitlab-test.git", projectEvent_git_http_url = "http://example.com/gitlabhq/gitlab-test.git", projectEvent_namespace = "GitlabHQ", projectEvent_visibility_level = Public, projectEvent_path_with_namespace = "gitlabhq/gitlab-test", projectEvent_default_branch = "master", projectEvent_homepage = Just "http://example.com/gitlabhq/gitlab-test", projectEvent_url = "http://example.com/gitlabhq/gitlab-test.git", projectEvent_ssh_url = "git@example.com:gitlabhq/gitlab-test.git", projectEvent_http_url = "http://example.com/gitlabhq/gitlab-test.git"}, mergeRequest_object_attributes = ObjectAttributes {objectAttributes_id = 99, objectAttributes_target_branch = "master", objectAttributes_source_branch = "ms-viewport", objectAttributes_source_project_id = 14, objectAttributes_author_id = Just 51, objectAttributes_assignee_id = Just 6, objectAttributes_assignee_ids = Nothing, objectAttributes_title = "MS-Viewport", objectAttributes_created_at = "2013-12-03T17:23:34Z", objectAttributes_updated_at = "2013-12-03T17:23:34Z", objectAttributes_milestone_id = Nothing, objectAttributes_state = "opened", objectAttributes_state_id = Nothing, objectAttributes_merge_status = "unchecked", objectAttributes_target_project_id = 14, objectAttributes_iid = 1, objectAttributes_description = "", objectAttributes_updated_by_id = Nothing, objectAttributes_merge_error = Nothing, objectAttributes_merge_params = Nothing, objectAttributes_merge_when_pipeline_succeeds = Nothing, objectAttributes_merge_user_id = Nothing, objectAttributes_merge_commit_sha = Nothing, objectAttributes_deleted_at = Nothing, objectAttributes_in_progress_merge_commit_sha = Nothing, objectAttributes_lock_version = Nothing, objectAttributes_time_estimate = Nothing, objectAttributes_last_edited_at = Nothing, objectAttributes_last_edited_by_id = Nothing, objectAttributes_head_pipeline_id = Nothing, objectAttributes_ref_fetched = Nothing, objectAttributes_merge_jid = Nothing, objectAttributes_source = ProjectEvent {projectEvent_name = "Awesome Project", projectEvent_description = "Aut reprehenderit ut est.", projectEvent_web_url = "http://example.com/awesome_space/awesome_project", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@example.com:awesome_space/awesome_project.git", projectEvent_git_http_url = "http://example.com/awesome_space/awesome_project.git", projectEvent_namespace = "Awesome Space", projectEvent_visibility_level = Public, projectEvent_path_with_namespace = "awesome_space/awesome_project", projectEvent_default_branch = "master", projectEvent_homepage = Just "http://example.com/awesome_space/awesome_project", projectEvent_url = "http://example.com/awesome_space/awesome_project.git", projectEvent_ssh_url = "git@example.com:awesome_space/awesome_project.git", projectEvent_http_url = "http://example.com/awesome_space/awesome_project.git"}, objectAttributes_target = ProjectEvent {projectEvent_name = "Awesome Project", projectEvent_description = "Aut reprehenderit ut est.", projectEvent_web_url = "http://example.com/awesome_space/awesome_project", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@example.com:awesome_space/awesome_project.git", projectEvent_git_http_url = "http://example.com/awesome_space/awesome_project.git", projectEvent_namespace = "Awesome Space", projectEvent_visibility_level = Public, projectEvent_path_with_namespace = "awesome_space/awesome_project", projectEvent_default_branch = "master", projectEvent_homepage = Just "http://example.com/awesome_space/awesome_project", projectEvent_url = "http://example.com/awesome_space/awesome_project.git", projectEvent_ssh_url = "git@example.com:awesome_space/awesome_project.git", projectEvent_http_url = "http://example.com/awesome_space/awesome_project.git"}, objectAttributes_last_commit = CommitEvent {commitEvent_id = "da1560886d4f094c3e6c9ef40349f7d38b5d27d7", commitEvent_message = "fixed readme", commitEvent_timestamp = "2012-01-03T23:36:29+02:00", commitEvent_url = "http://example.com/awesome_space/awesome_project/commits/da1560886d4f094c3e6c9ef40349f7d38b5d27d7", commitEvent_author = CommitAuthorEvent {commitAuthorEvent_name = "GitLab dev user", commitAuthorEvent_email = "gitlabdev@dv6700.(none)"}}, objectAttributes_work_in_progress = False, objectAttributes_total_time_spent = Nothing, objectAttributes_human_total_time_spent = Nothing, objectAttributes_human_time_estimate = Nothing, objectAttributes_action = Just "open"}, mergeRequest_labels = Just [Label {label_id = Just 206, label_title = Just "API", label_color = Just "#ffffff", label_project_id = Just 14, label_created_at = Just "2013-12-03T17:15:43Z", label_updated_at = Just "2013-12-03T17:15:43Z", label_template = Just False, label_description = Just "API related issues", label_type = Just "ProjectLabel", label_group_id = Just 41}], mergeRequest_changes = MergeRequestChanges {mergeRequestChanges_author_id = Nothing, mergeRequestChanges_created_at = Nothing, mergeRequestChanges_description = Nothing, mergeRequestChanges_id = Nothing, mergeRequestChanges_iid = Nothing, mergeRequestChanges_source_branch = Nothing, mergeRequestChanges_source_project_id = Nothing, mergeRequestChanges_target_branch = Nothing, mergeRequestChanges_target_project_id = Nothing, mergeRequestChanges_title = Nothing, mergeRequestChanges_updated_at = Just (MergeRequestChange {mergeRequestChange_previous = Just "2017-09-15 16:50:55 UTC", mergeRequestChange_current = Just "2017-09-15 16:52:00 UTC"})}, mergeRequest_repository = RepositoryEvent {repositoryEvent_name = "Gitlab Test", repositoryEvent_url = "http://example.com/gitlabhq/gitlab-test.git", repositoryEvent_description = "Aut reprehenderit ut est.", repositoryEvent_homepage = Just "http://example.com/gitlabhq/gitlab-test", repositoryEvent_git_http_url = Nothing, repositoryEvent_git_ssh_url = Nothing, repositoryEvent_visibility_level = Nothing}} diff --git a/tests/Tests.hs b/tests/Tests.hs --- a/tests/Tests.hs +++ b/tests/Tests.hs @@ -4,6 +4,24 @@ module Main where import API.BoardsTests +import API.BranchesTests +import API.CommitsTests +import API.DiscussionsTests +import API.EventsTests +import API.GroupsTests +import API.IssuesTests +import API.JobsTests +import API.MembersTests +import API.MergeRequestsTests +import API.NotesTests +import API.PipelinesTests +import API.ProjectsTests +import API.RepositoriesTests +import API.RepositoryFilesTests +import API.TagsTests +import API.TodosTests +import API.UsersTests +import API.VersionTests import Data.Maybe (fromJust) import SystemHookTests import Test.Tasty @@ -18,6 +36,57 @@ systemHookTests, testGroup "api-boards" - boardsTests + boardsTests, + testGroup + "api-branches" + branchesTests, + testGroup + "api-commits" + commitsTests, + testGroup + "api-discussions" + discussionsTests, + testGroup + "api-events" + eventsTests, + testGroup + "api-groups" + groupsTests, + testGroup + "api-issues" + issuesTests, + testGroup + "api-jobs" + jobsTests, + testGroup + "api-members" + membersTests, + testGroup + "api-merge-requests" + mergeRequestsTests, + testGroup + "api-notes" + notesTests, + testGroup + "api-pipelines" + pipelinesTests, + testGroup + "api-projects" + projectsTests, + testGroup + "api-repositories" + repositoriesTests, + testGroup + "api-tags" + tagsTests, + testGroup + "api-todos" + todosTests, + testGroup + "api-users" + usersTests, + testGroup + "api-version" + versionTests ] )