gitlab-haskell 0.3.1.1 → 0.3.2.0
raw patch · 36 files changed
+1047/−200 lines, 36 files
Files
- data/system-hooks/merge-request-old.json +125/−0
- data/system-hooks/merge-request.json +148/−124
- gitlab-haskell.cabal +19/−1
- src/GitLab/API/Boards.hs +34/−7
- src/GitLab/API/Groups.hs +10/−8
- src/GitLab/API/Issues.hs +9/−3
- src/GitLab/API/Members.hs +14/−9
- src/GitLab/API/Notes.hs +3/−1
- src/GitLab/API/Pipelines.hs +31/−0
- src/GitLab/API/Projects.hs +45/−1
- src/GitLab/API/Repositories.hs +6/−4
- src/GitLab/API/Todos.hs +1/−1
- src/GitLab/SystemHooks/Rules.hs +4/−0
- src/GitLab/SystemHooks/Types.hs +65/−17
- src/GitLab/Types.hs +88/−0
- src/GitLab/WebRequests/GitLabWebCalls.hs +31/−12
- tests/API/BranchesTests.hs +19/−0
- tests/API/CommitsTests.hs +19/−0
- tests/API/DiscussionsTests.hs +19/−0
- tests/API/EventsTests.hs +19/−0
- tests/API/GroupsTests.hs +19/−0
- tests/API/IssuesTests.hs +19/−0
- tests/API/JobsTests.hs +19/−0
- tests/API/MembersTests.hs +19/−0
- tests/API/MergeRequestsTests.hs +19/−0
- tests/API/NotesTests.hs +19/−0
- tests/API/PipelinesTests.hs +19/−0
- tests/API/ProjectsTests.hs +19/−0
- tests/API/RepositoriesTests.hs +19/−0
- tests/API/RepositoryFilesTests.hs +19/−0
- tests/API/TagsTests.hs +19/−0
- tests/API/TodosTests.hs +19/−0
- tests/API/UsersTests.hs +19/−0
- tests/API/VersionTests.hs +19/−0
- tests/SystemHookTests.hs +2/−11
- tests/Tests.hs +70/−1
+ data/system-hooks/merge-request-old.json view
@@ -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":""+ }++}
data/system-hooks/merge-request.json view
@@ -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+ }]+ }+ } }
gitlab-haskell.cabal view
@@ -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: <https://docs.gitlab.com/ee/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
src/GitLab/API/Boards.hs view
@@ -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]
src/GitLab/API/Groups.hs view
@@ -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 ->
src/GitLab/API/Issues.hs view
@@ -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,
src/GitLab/API/Members.hs view
@@ -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"
src/GitLab/API/Notes.hs view
@@ -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 ->
src/GitLab/API/Pipelines.hs view
@@ -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 []
src/GitLab/API/Projects.hs view
@@ -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
src/GitLab/API/Repositories.hs view
@@ -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/"
src/GitLab/API/Todos.hs view
@@ -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
src/GitLab/SystemHooks/Rules.hs view
@@ -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 ->
src/GitLab/SystemHooks/Types.hs view
@@ -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
src/GitLab/Types.hs view
@@ -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 } )
src/GitLab/WebRequests/GitLabWebCalls.hs view
@@ -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) =
+ tests/API/BranchesTests.hs view
@@ -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 =+ []
+ tests/API/CommitsTests.hs view
@@ -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 =+ []
+ tests/API/DiscussionsTests.hs view
@@ -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 =+ []
+ tests/API/EventsTests.hs view
@@ -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 =+ []
+ tests/API/GroupsTests.hs view
@@ -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 =+ []
+ tests/API/IssuesTests.hs view
@@ -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 =+ []
+ tests/API/JobsTests.hs view
@@ -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 =+ []
+ tests/API/MembersTests.hs view
@@ -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 =+ []
+ tests/API/MergeRequestsTests.hs view
@@ -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 =+ []
+ tests/API/NotesTests.hs view
@@ -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 =+ []
+ tests/API/PipelinesTests.hs view
@@ -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 =+ []
+ tests/API/ProjectsTests.hs view
@@ -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 =+ []
+ tests/API/RepositoriesTests.hs view
@@ -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 =+ []
+ tests/API/RepositoryFilesTests.hs view
@@ -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 =+ []
+ tests/API/TagsTests.hs view
@@ -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 =+ []
+ tests/API/TodosTests.hs view
@@ -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 =+ []
+ tests/API/UsersTests.hs view
@@ -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 =+ []
+ tests/API/VersionTests.hs view
@@ -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 =+ []
tests/SystemHookTests.hs view
@@ -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}}
tests/Tests.hs view
@@ -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 ] )