diff --git a/data/system-hooks/merge-request-gitlab-15.5.0.json b/data/system-hooks/merge-request-gitlab-15.5.0.json new file mode 100644 --- /dev/null +++ b/data/system-hooks/merge-request-gitlab-15.5.0.json @@ -0,0 +1,1 @@ +{"object_kind":"merge_request","event_type":"merge_request","user":{"id":5,"name":"Joe Bloggs","username":"joe","avatar_url":"https://gitlab.example.com/uploads/-/system/user/avatar/5/avatar.png","email":"[REDACTED]"},"project":{"id":7926,"name":"test-ci-project","description":"","web_url":"https://gitlab.example.com/joe/test-ci-project","avatar_url":null,"git_ssh_url":"git@gitlab.example.com:joe/test-ci-project.git","git_http_url":"https://gitlab.example.com/joe/test-ci-project.git","namespace":"Joe Bloggs","visibility_level":0,"path_with_namespace":"joe/test-ci-project","default_branch":"master","ci_config_path":null,"homepage":"https://gitlab.example.com/joe/test-ci-project","url":"git@gitlab.example.com:joe/test-ci-project.git","ssh_url":"git@gitlab.example.com:joe/test-ci-project.git","http_url":"https://gitlab.example.com/joe/test-ci-project.git"},"object_attributes":{"assignee_id":null,"author_id":5,"created_at":"2022-10-24 22:11:46 UTC","description":"To test the merge request event.","head_pipeline_id":null,"id":3448,"iid":1,"last_edited_at":null,"last_edited_by_id":null,"merge_commit_sha":null,"merge_error":null,"merge_params":{"force_remove_source_branch":"1"},"merge_status":"preparing","merge_user_id":null,"merge_when_pipeline_succeeds":false,"milestone_id":null,"source_branch":"another-branch","source_project_id":7926,"state_id":1,"target_branch":"master","target_project_id":7926,"time_estimate":0,"title":"A change","updated_at":"2022-10-24 22:11:46 UTC","updated_by_id":null,"url":"https://gitlab.example.com/joe/test-ci-project/-/merge_requests/1","source":{"id":7926,"name":"test-ci-project","description":"","web_url":"https://gitlab.example.com/joe/test-ci-project","avatar_url":null,"git_ssh_url":"git@gitlab.example.com:joe/test-ci-project.git","git_http_url":"https://gitlab.example.com/joe/test-ci-project.git","namespace":"Joe Bloggs","visibility_level":0,"path_with_namespace":"joe/test-ci-project","default_branch":"master","ci_config_path":null,"homepage":"https://gitlab.example.com/joe/test-ci-project","url":"git@gitlab.example.com:joe/test-ci-project.git","ssh_url":"git@gitlab.example.com:joe/test-ci-project.git","http_url":"https://gitlab.example.com/joe/test-ci-project.git"},"target":{"id":7926,"name":"test-ci-project","description":"","web_url":"https://gitlab.example.com/joe/test-ci-project","avatar_url":null,"git_ssh_url":"git@gitlab.example.com:joe/test-ci-project.git","git_http_url":"https://gitlab.example.com/joe/test-ci-project.git","namespace":"Joe Bloggs","visibility_level":0,"path_with_namespace":"joe/test-ci-project","default_branch":"master","ci_config_path":null,"homepage":"https://gitlab.example.com/joe/test-ci-project","url":"git@gitlab.example.com:joe/test-ci-project.git","ssh_url":"git@gitlab.example.com:joe/test-ci-project.git","http_url":"https://gitlab.example.com/joe/test-ci-project.git"},"last_commit":{"id":"83c2d70f8ecb1376d1d4f1e52b7a18c560a7b95c","message":"A change\n","title":"A change","timestamp":"2022-10-24T23:10:03+01:00","url":"https://gitlab.example.com/joe/test-ci-project/-/commit/83c2d70f8ecb1376d1d4f1e52b7a18c560a7b95c","author":{"name":"Joe Bloggs","email":"robstewart57@gmail.com"}},"work_in_progress":false,"total_time_spent":0,"time_change":0,"human_total_time_spent":null,"human_time_change":null,"human_time_estimate":null,"assignee_ids":[],"reviewer_ids":[],"labels":[],"state":"opened","blocking_discussions_resolved":true,"first_contribution":false,"action":"open"},"labels":[],"changes":{"merge_status":{"previous":"unchecked","current":"preparing"}},"repository":{"name":"test-ci-project","url":"git@gitlab.example.com:joe/test-ci-project.git","description":"","homepage":"https://gitlab.example.com/joe/test-ci-project"}} diff --git a/data/system-hooks/merge-request-haskell-gitlab-d1ca1037944616ac940284c5f8e49b5d9bcbf83c.json b/data/system-hooks/merge-request-haskell-gitlab-d1ca1037944616ac940284c5f8e49b5d9bcbf83c.json new file mode 100644 --- /dev/null +++ b/data/system-hooks/merge-request-haskell-gitlab-d1ca1037944616ac940284c5f8e49b5d9bcbf83c.json @@ -0,0 +1,130 @@ +{ + "object_kind": "merge_request", + "event_type": "merge_request", + "user": { + "id": 2312, + "name": "Bloggs, Joe", + "username": "joe123", + "avatar_url": "https://secure.gravatar.com/avatar/df1b70b1fd7d7eaaa5f9a41f5f5093c0?s=80&d=identicon", + "email": "[REDACTED]" + }, + "project": { + "id": 43593, + "name": "proj1", + "description": null, + "web_url": "https://gitlab.example.com/grp1/grp2/proj1", + "avatar_url": null, + "git_ssh_url": "git@gitlab.example.com:grp1/grp2/proj1.git", + "git_http_url": "https://gitlab.example.com/grp1/grp2/proj1.git", + "namespace": "grp2", + "visibility_level": 0, + "path_with_namespace": "grp1/grp2/proj1", + "default_branch": "main", + "ci_config_path": null, + "homepage": "https://gitlab.example.com/grp1/grp2/proj1", + "url": "git@gitlab.example.com:grp1/grp2/proj1.git", + "ssh_url": "git@gitlab.example.com:grp1/grp2/proj1.git", + "http_url": "https://gitlab.example.com/grp1/grp2/proj1.git" + }, + "object_attributes": { + "assignee_id": null, + "author_id": 2312, + "created_at": "2022-10-25 18:51:48 UTC", + "description": "", + "head_pipeline_id": null, + "id": 3461, + "iid": 14, + "last_edited_at": null, + "last_edited_by_id": null, + "merge_commit_sha": null, + "merge_error": null, + "merge_params": {}, + "merge_status": "preparing", + "merge_user_id": null, + "merge_when_pipeline_succeeds": false, + "milestone_id": null, + "source_branch": "main", + "source_project_id": 49668, + "state_id": 1, + "target_branch": "main", + "target_project_id": 43593, + "time_estimate": 0, + "title": "the MR title", + "updated_at": "2022-10-25 18:51:48 UTC", + "updated_by_id": null, + "url": "https://gitlab.example.com/grp1/grp2/proj1/-/merge_requests/14", + "source": { + "id": 49668, + "name": "proj1", + "description": null, + "web_url": "https://gitlab.example.com/joe123/proj1", + "avatar_url": null, + "git_ssh_url": "git@gitlab.example.com:joe123/proj1.git", + "git_http_url": "https://gitlab.example.com/joe123/proj1.git", + "namespace": "Bloggs, Joe", + "visibility_level": 0, + "path_with_namespace": "joe123/proj1", + "default_branch": "main", + "ci_config_path": null, + "homepage": "https://gitlab.example.com/joe123/proj1", + "url": "git@gitlab.example.com:joe123/proj1.git", + "ssh_url": "git@gitlab.example.com:joe123/proj1.git", + "http_url": "https://gitlab.example.com/joe123/proj1.git" + }, + "target": { + "id": 43593, + "name": "proj1", + "description": null, + "web_url": "https://gitlab.example.com/grp1/grp2/proj1", + "avatar_url": null, + "git_ssh_url": "git@gitlab.example.com:grp1/grp2/proj1.git", + "git_http_url": "https://gitlab.example.com/grp1/grp2/proj1.git", + "namespace": "grp2", + "visibility_level": 0, + "path_with_namespace": "grp1/grp2/proj1", + "default_branch": "main", + "ci_config_path": null, + "homepage": "https://gitlab.example.com/grp1/grp2/proj1", + "url": "git@gitlab.example.com:grp1/grp2/proj1.git", + "ssh_url": "git@gitlab.example.com:grp1/grp2/proj1.git", + "http_url": "https://gitlab.example.com/grp1/grp2/proj1.git" + }, + "last_commit": { + "id": "249d94fdc92825a2ca22c4fa74c511ec5f03e086", + "message": "Updated README\n", + "title": "Updated README", + "timestamp": "2022-10-08T10:37:28+01:00", + "url": "https://gitlab.example.com/grp1/grp2/proj1/-/commit/249d94fdc92825a2ca22c4fa74c511ec5f03e086", + "author": { + "name": "Hill, Harry", + "email": "harry@gmail.com" + } + }, + "work_in_progress": true, + "total_time_spent": 0, + "time_change": 0, + "human_total_time_spent": null, + "human_time_change": null, + "human_time_estimate": null, + "assignee_ids": [], + "reviewer_ids": [], + "labels": [], + "state": "opened", + "blocking_discussions_resolved": true, + "first_contribution": false, + "action": "open" + }, + "labels": [], + "changes": { + "merge_status": { + "previous": "unchecked", + "current": "preparing" + } + }, + "repository": { + "name": "proj1", + "url": "git@gitlab.example.com:grp1/grp2/proj1.git", + "description": null, + "homepage": "https://gitlab.example.com/grp1/grp2/proj1" + } +} diff --git a/data/system-hooks/push.json b/data/system-hooks/push.json --- a/data/system-hooks/push.json +++ b/data/system-hooks/push.json @@ -7,6 +7,7 @@ "user_id": 4, "user_name": "John Smith", "user_email": "john@example.com", + "user_username": "abc1", "user_avatar": "https://s.gravatar.com/avatar/d4c74594d841139328695756648b6bd6?s=8://s.gravatar.com/avatar/d4c74594d841139328695756648b6bd6?s=80", "project_id": 15, "project":{ 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: 1.0.0.1 +version: 1.0.0.3 synopsis: A Haskell library for the GitLab web API description: This library lifts the GitLab REST API into Haskell: @@ -68,6 +68,7 @@ , time >= 1.9 , temporary , unix + , mtl default-language: Haskell2010 ghc-options: -Wall -- the following two for the stan static analysis tool @@ -110,5 +111,5 @@ , ansi-wl-pprint , vector , unordered-containers + , text ghc-options: -Wall - diff --git a/src/GitLab.hs b/src/GitLab.hs --- a/src/GitLab.hs +++ b/src/GitLab.hs @@ -111,9 +111,10 @@ -- | The same as 'runGitLab', except that it also takes a connection -- manager as an argument. runGitLabWithManager :: Manager -> GitLabServerConfig -> GitLab a -> IO a -runGitLabWithManager manager cfg action = do +runGitLabWithManager manager cfg (GitLabT action) = do -- test the token access - tokenTest <- runReaderT gitlabVersion (GitLabState cfg manager) + let (GitLabT versionCheck) = gitlabVersion + tokenTest <- runReaderT versionCheck (GitLabState cfg manager) case tokenTest of Left response -> case responseStatus response of @@ -127,6 +128,6 @@ -- liftIO. Cannot speak to a GitLab server. Only useful for the -- gitlab-haskell tests. runGitLabDbg :: GitLab a -> IO a -runGitLabDbg action = do +runGitLabDbg (GitLabT action) = do liftIO $ hSetBuffering stdout LineBuffering runReaderT action undefined diff --git a/src/GitLab/API/Commits.hs b/src/GitLab/API/Commits.hs --- a/src/GitLab/API/Commits.hs +++ b/src/GitLab/API/Commits.hs @@ -270,7 +270,7 @@ <> T.pack (show projId) <> "/repository" <> "/commits/" - <> T.pack (show sha) + <> sha <> "/diff" -- | Get the diff of a commit in a project. @@ -289,7 +289,7 @@ <> T.pack (show projId) <> "/repository" <> "/commits/" - <> T.pack (show sha) + <> sha <> "/comments" -- | Adds a comment to a commit. @@ -312,7 +312,7 @@ <> T.pack (show projId) <> "/repository" <> "/commits/" - <> T.pack (show sha) + <> sha <> "/comments" -- | Get the discussions of a commit in a project. @@ -331,7 +331,7 @@ <> T.pack (show projId) <> "/repository" <> "/commits/" - <> T.pack (show sha) + <> sha <> "/discussions" -- | Get the discussions of a commit in a project. @@ -350,7 +350,7 @@ <> T.pack (show projId) <> "/repository" <> "/commits/" - <> T.pack (show sha) + <> sha <> "/merge_requests" ------------- 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 @@ -51,6 +51,7 @@ BranchProtection (..), defaultGroupFilters, defaultListGroupsFilters, + defaultGroupProjectFilters, ) where @@ -223,6 +224,11 @@ groupProjectFilter_with_custom_attributes :: Maybe Bool, groupProjectFilter_with_security_reports :: Maybe Bool } + +-- | No group filters applied, thereby returning all groups. +defaultGroupProjectFilters :: GroupProjectAttrs +defaultGroupProjectFilters = + GroupProjectAttrs Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing -- | The order of group projects in search results. data GroupProjectOrderBy 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 @@ -1,5 +1,6 @@ {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} +{-# LANGUAGE TemplateHaskell #-} -- | -- Module : Issues @@ -28,6 +29,7 @@ -- * New issue newIssue, + newIssue', -- * Edit issue editIssue, @@ -75,12 +77,14 @@ -- * Issues attributes defaultIssueFilters, + defaultIssueAttrs, IssueAttrs (..), DueDate (..), IssueState (..), ) where +import Data.Aeson.TH import qualified Data.ByteString.Lazy as BSL import Data.Either import Data.Maybe @@ -98,11 +102,11 @@ -- | the group Group -> -- | filter the issues, see https://docs.gitlab.com/ee/api/issues.html#list-issues - IssueAttrs -> + IssueFilterAttrs -> -- the GitLab issues GitLab [Issue] groupIssues grp attrs = do - result <- gitlabGetMany urlPath (issuesAttrs attrs) + result <- gitlabGetMany urlPath (issueFilters attrs) return (fromRight (error "groupsIssues error") result) where urlPath = @@ -119,7 +123,7 @@ -- | the project Project -> -- | filter the issues, see https://docs.gitlab.com/ee/api/issues.html#list-issues - IssueAttrs -> + IssueFilterAttrs -> -- the GitLab issues GitLab [Issue] projectIssues p filters = do @@ -131,11 +135,11 @@ -- | the project ID Int -> -- | filter the issues, see https://docs.gitlab.com/ee/api/issues.html#list-issues - IssueAttrs -> + IssueFilterAttrs -> -- | the GitLab issues GitLab (Either (Response BSL.ByteString) [Issue]) projectIssues' projectId attrs = - gitlabGetMany urlPath (issuesAttrs attrs) + gitlabGetMany urlPath (issueFilters attrs) where urlPath = T.pack $ @@ -185,7 +189,7 @@ where urlPath = T.pack - "/project/" + "/projects/" <> T.pack (show (project_id p)) <> "/issues/" <> T.pack (show issId) @@ -198,6 +202,8 @@ Text -> -- | issue description Text -> + -- | issue attributes + IssueAttrs -> GitLab (Either (Response BSL.ByteString) (Maybe Issue)) newIssue project = newIssue' (project_id project) @@ -210,8 +216,10 @@ Text -> -- | issue description Text -> + -- | issue attributes + IssueAttrs -> GitLab (Either (Response BSL.ByteString) (Maybe Issue)) -newIssue' projectId issueTitle issueDescription = +newIssue' projectId issueTitle issueDescription attrs = gitlabPost addr dataBody where dataBody :: [GitLabParam] @@ -219,6 +227,7 @@ [ ("title", Just (T.encodeUtf8 issueTitle)), ("description", Just (T.encodeUtf8 issueDescription)) ] + <> issueAttrs projectId attrs addr = "/projects/" <> T.pack (show projectId) @@ -229,17 +238,19 @@ Project -> -- | issue ID IssueId -> - EditIssueReq -> + -- | issue attributes + IssueAttrs -> GitLab (Either (Response BSL.ByteString) Issue) editIssue prj issueId editIssueReq = do let urlPath = - "/projects/" <> T.pack (show (project_id prj)) + "/projects/" + <> T.pack (show (project_id prj)) <> "/issues/" <> T.pack (show issueId) result <- gitlabPut urlPath - (editIssuesAttrs editIssueReq) + (issueAttrs (project_id prj) editIssueReq) case result of Left resp -> return (Left resp) Right Nothing -> error "editIssue error" @@ -275,7 +286,8 @@ GitLab (Either (Response BSL.ByteString) Issue) reorderIssue prj issueId moveAfterId moveBeforeId = do let urlPath = - "/projects/" <> T.pack (show (project_id prj)) + "/projects/" + <> T.pack (show (project_id prj)) <> "/issues/" <> T.pack (show issueId) <> "/reorder" @@ -459,11 +471,11 @@ -- | Gets issues count statistics on all issues the authenticated user has access to. issueStatisticsUser :: -- | filter the issues, see https://docs.gitlab.com/ee/api/issues_statistics.html#get-issues-statistics - IssueAttrs -> + IssueFilterAttrs -> -- | the issue statistics GitLab IssueStatistics issueStatisticsUser attrs = - gitlabUnsafe (gitlabGetOne urlPath (issuesAttrs attrs)) + gitlabUnsafe (gitlabGetOne urlPath (issueFilters attrs)) where urlPath = T.pack @@ -474,7 +486,7 @@ -- | the group Group -> -- | filter the issues, see https://docs.gitlab.com/ee/api/issues_statistics.html#get-issues-statistics - IssueAttrs -> + IssueFilterAttrs -> -- | the issue statistics GitLab IssueStatistics issueStatisticsGroup group filters = do @@ -489,11 +501,11 @@ -- | the group ID Int -> -- | filter the issues, see https://docs.gitlab.com/ee/api/issues_statistics.html#get-issues-statistics - IssueAttrs -> + IssueFilterAttrs -> -- | the issue statistics GitLab (Either (Response BSL.ByteString) (Maybe IssueStatistics)) issueStatisticsGroup' groupId attrs = - gitlabGetOne urlPath (issuesAttrs attrs) + gitlabGetOne urlPath (issueFilters attrs) where urlPath = T.pack $ @@ -506,7 +518,7 @@ -- | the project Project -> -- | filter the issues, see https://docs.gitlab.com/ee/api/issues_statistics.html#get-issues-statistics - IssueAttrs -> + IssueFilterAttrs -> -- | the issue statistics GitLab IssueStatistics issueStatisticsProject proj filters = do @@ -521,11 +533,11 @@ -- | the project ID Int -> -- | filter the issues, see https://docs.gitlab.com/ee/api/issues_statistics.html#get-issues-statistics - IssueAttrs -> + IssueFilterAttrs -> -- | the issue statistics GitLab (Either (Response BSL.ByteString) (Maybe IssueStatistics)) issueStatisticsProject' projId attrs = - gitlabGetOne urlPath (issuesAttrs attrs) + gitlabGetOne urlPath (issueFilters attrs) where urlPath = T.pack $ @@ -533,8 +545,28 @@ <> show projId <> "/issues_statistics" --- | Attributes related to a project issue +-- | issue attributes. data IssueAttrs = IssueAttrs + { set_issue_id :: ProjectId, + set_issue_title :: Maybe Text, + set_issue_description :: Maybe Text, + set_issue_confidential :: Maybe Bool, + set_issue_assignee_id :: Maybe Int, + set_issue_assignee_ids :: Maybe [Int], + set_issue_milestone_id :: Maybe Int, + set_issue_labels :: Maybe [Text], + set_issue_state_event :: Maybe Text, + set_issue_updated_at :: Maybe UTCTime, + set_issue_due_date :: Maybe UTCTime, + set_issue_weight :: Maybe Int, + set_issue_discussion_locked :: Maybe Bool, + set_issue_epic_id :: Maybe Int, + set_issue_epic_iid :: Maybe Int + } + deriving (Show) + +-- | Attributes related to a project issue +data IssueFilterAttrs = IssueFilterAttrs { issueFilter_assignee_id :: Maybe Int, issueFilter_assignee_username :: Maybe String, issueFilter_author_id :: Maybe Int, @@ -561,37 +593,42 @@ issueFilter_with_labels_details :: Maybe Bool } -editIssuesAttrs :: EditIssueReq -> [GitLabParam] -editIssuesAttrs filters = - catMaybes - [ Just ("id", textToBS (T.pack (show (edit_issue_id filters)))), - Just ("issue_id", textToBS (T.pack (show (edit_issue_issue_iid filters)))), - -- (\i -> Just ("assignee_id", textToBS (T.pack (show i)))) =<< edit_issue_issue_id filters, - (\t -> Just ("title", textToBS t)) =<< edit_issue_title filters, - (\t -> Just ("description", textToBS t)) =<< edit_issue_description filters, - (\b -> Just ("confidential", textToBS (showBool b))) =<< edit_issue_confidential filters, - -- TODO - -- (\is -> Just ("assignee_ids", textToBS )) =<< edit_issue_assignee_ids filters, - (\i -> Just ("milestone_id", textToBS (T.pack (show i)))) =<< edit_issue_milestone_id filters, - -- TODO - -- (\ts -> Just ("labels", textToBS (T.pack (show i)))) =<< edit_issue_labels filters, - (\t -> Just ("state_event", textToBS t)) =<< edit_issue_state_event filters, - (\d -> Just ("updated_at", stringToBS (show d))) =<< edit_issue_updated_at filters, - (\t -> Just ("due_date", textToBS t)) =<< edit_issue_due_date filters, - (\i -> Just ("weight", textToBS (T.pack (show i)))) =<< edit_issue_weight filters, - (\b -> Just ("discussion_locked", textToBS (showBool b))) =<< edit_issue_discussion_locked filters, - (\i -> Just ("epic_id", textToBS (T.pack (show i)))) =<< edit_issue_epic_id filters, - (\i -> Just ("epic_iid", textToBS (T.pack (show i)))) =<< edit_issue_epic_iid filters +issueAttrs :: Int -> IssueAttrs -> [GitLabParam] +issueAttrs prjId filters = + catMaybes $ + [ Just ("id", textToBS (T.pack (show prjId))), + (\i -> Just ("assignee_id", textToBS (T.pack (show i)))) =<< set_issue_assignee_id filters, + (\t -> Just ("title", textToBS t)) =<< set_issue_title filters, + (\t -> Just ("description", textToBS t)) =<< set_issue_description filters, + (\b -> Just ("confidential", textToBS (showBool b))) =<< set_issue_confidential filters, + (\i -> Just ("milestone_id", textToBS (T.pack (show i)))) =<< set_issue_milestone_id filters, + (\ts -> Just ("labels", textToBS (T.intercalate (T.pack ",") ts))) =<< set_issue_labels filters, + (\t -> Just ("state_event", textToBS t)) =<< set_issue_state_event filters, + (\d -> Just ("updated_at", stringToBS (show d))) =<< set_issue_updated_at filters, + (\d -> Just ("due_date", stringToBS (show d))) =<< set_issue_due_date filters, + (\i -> Just ("weight", textToBS (T.pack (show i)))) =<< set_issue_weight filters, + (\b -> Just ("discussion_locked", textToBS (showBool b))) =<< set_issue_discussion_locked filters, + (\i -> Just ("epic_id", textToBS (T.pack (show i)))) =<< set_issue_epic_id filters, + (\i -> Just ("epic_iid", textToBS (T.pack (show i)))) =<< set_issue_epic_iid filters ] + <> case set_issue_assignee_ids filters of + Nothing -> [] + Just ids -> + map + (\i -> Just ("assignee_ids[]", stringToBS (show i))) + ids where + -- <> (\is -> Just ("assignee_ids", arrayToBS is)) + -- =<< set_issue_assignee_ids filters + textToBS = Just . T.encodeUtf8 stringToBS = Just . T.encodeUtf8 . T.pack showBool :: Bool -> Text showBool True = "true" showBool False = "false" -issuesAttrs :: IssueAttrs -> [GitLabParam] -issuesAttrs filters = +issueFilters :: IssueFilterAttrs -> [GitLabParam] +issueFilters filters = catMaybes [ (\i -> Just ("assignee_id", textToBS (T.pack (show i)))) =<< issueFilter_assignee_id filters, (\t -> Just ("assignee_username", textToBS (T.pack t))) =<< issueFilter_assignee_username filters, @@ -651,6 +688,16 @@ show IssueClosed = "closed" -- | No issue filters, thereby returning all issues. Default scope is "all". -defaultIssueFilters :: IssueAttrs +defaultIssueFilters :: IssueFilterAttrs 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 + IssueFilterAttrs 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 + +-- | issue attributes when creating or editing issues. +defaultIssueAttrs :: + -- | project ID + Int -> + IssueAttrs +defaultIssueAttrs prjId = + IssueAttrs prjId Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing + +$(deriveJSON defaultOptions {fieldLabelModifier = drop (T.length "set_issue_"), omitNothingFields = True} ''IssueAttrs) 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 @@ -56,6 +56,7 @@ where import qualified Data.ByteString.Lazy as BSL +import Data.Either import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T @@ -73,9 +74,10 @@ -- | Gets a list of project members viewable by the authenticated -- user. Returns only direct members and not inherited members through -- ancestors groups. -membersOfProject :: Project -> GitLab (Either (Response BSL.ByteString) [Member]) +membersOfProject :: Project -> GitLab [Member] membersOfProject prj = - gitlabGetMany addr [] + fromRight (error "membersOfProject error") + <$> gitlabGetMany addr [] where addr = "/projects/" 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 @@ -81,10 +81,10 @@ -- issuesCreatedByUser, -- issuesOnForks, -- projectMemebersCount, - -- projectCISuccess, + projectCISuccess, -- namespacePathToUserId, projectDiffs, - -- addGroupToProject, + addGroupToProject, -- transferProject, -- transferProject', defaultProjectAttrs, @@ -111,6 +111,7 @@ import GHC.Generics import GitLab.API.Commits import GitLab.API.Members +import GitLab.API.Pipelines import GitLab.API.Users import GitLab.Types import GitLab.WebRequests.GitLabWebCalls @@ -627,6 +628,28 @@ ) [] +-- | add a group to a project. +addGroupToProject :: + -- | group ID + Int -> + -- | project ID + Int -> + -- | level of access granted + AccessLevel -> + GitLab (Either (Response BSL.ByteString) (Maybe GroupShare)) +addGroupToProject groupId projectId access = + gitlabPost addr params + where + params :: [GitLabParam] + params = + [ ("group_id", Just (T.encodeUtf8 (T.pack (show groupId)))), + ("group_access", Just (T.encodeUtf8 (T.pack (show access)))) + ] + addr = + "/projects/" + <> T.pack (show projectId) + <> "/share" + -- | A default set of project attributes to override with the -- 'editProject' functions. Only the project ID value is set is a -- search parameter, all other search parameters are not set and can @@ -1063,17 +1086,17 @@ -- (res :: [Member]) <- fromRight (error "projectMembersCount error") <$> gitlabGetMany addr [] -- return (map (\x -> (fromMaybe (error "projectMemebersCount error") (member_username x), fromMaybe (error "projectMemebersCount error") (member_name x))) res) --- -- | returns 'True' is the last commit for a project passes all --- -- continuous integration tests. --- projectCISuccess :: --- -- | the name or namespace of the project --- Project -> --- GitLab Bool --- projectCISuccess project = do --- pipes <- pipelines project --- case pipes of --- [] -> return False --- (x : _) -> return (pipeline_status x == "success") +-- | returns 'True' is the last commit for a project passes all +-- continuous integration tests. +projectCISuccess :: + -- | the name or namespace of the project + Project -> + GitLab Bool +projectCISuccess prj = do + pipes <- pipelines prj + case pipes of + [] -> return False + (x : _) -> return (pipeline_status x == "success") -- -- | searches for a username, and returns a user ID for that user, or -- -- 'Nothing' if a user cannot be found. diff --git a/src/GitLab/API/Users.hs b/src/GitLab/API/Users.hs --- a/src/GitLab/API/Users.hs +++ b/src/GitLab/API/Users.hs @@ -20,6 +20,7 @@ createUser, -- * User modification + userAttributes, modifyUser, -- * Delete authentication identity from user @@ -121,6 +122,44 @@ "/users/" <> T.pack (show usrId) +-- | Extracts the user attributes for a user. Useful for modifying +-- attrbibutes with 'modifyUser'. +userAttributes :: + -- | the user + User -> + -- | is the user a GitLab server administrator + Bool -> + -- | the extracted user attributes + UserAttrs +userAttributes usr isAdmin = + UserAttrs + (Just isAdmin) + (user_bio usr) + (user_can_create_group usr) + (user_email usr) + (user_extern_uid usr) + (user_external usr) -- default is false + (user_force_random_password usr) -- default is false + (user_group_id_for_saml usr) + (user_linkedin usr) + (user_location usr) + (Just (user_name usr)) + (user_note usr) + (user_organization usr) + (user_password usr) + (user_private_profile usr) -- default is false + (user_projects_limit usr) + (user_providor usr) + (user_reset_password usr) + (user_skip_confirmation usr) + (user_skype usr) + (user_theme_id usr) + (user_twitter usr) + (Just (user_username usr)) + (user_view_diffs_file_by_file usr) + (user_website_url usr) + (user_pronouns usr) + -- | Creates a new user. Note only administrators can create new -- users. Either password, reset_password, or force_random_password -- must be specified. If reset_password and force_random_password are @@ -466,7 +505,7 @@ -- | No group filters applied, thereby returning all groups. defaultUserFilters :: UserAttrs defaultUserFilters = - UserAttrs Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing + UserAttrs Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing -- | Attributes related to a group data UserAttrs = UserAttrs @@ -479,7 +518,7 @@ -- | email address userFilter_email :: Maybe Text, -- | External UID - userFilter_extern_uid :: Maybe Bool, + userFilter_extern_uid :: Maybe Int, -- | Flag the user as external - default is fale userFilter_external :: Maybe Bool, -- | Set user password to a random value - default is false @@ -519,7 +558,9 @@ -- | Flag indicating the user sees only one file diff per page userFilter_view_diffs_file_by_file :: Maybe Bool, -- | User's website URL - userFilter_website :: Maybe Text + userFilter_website :: Maybe Text, + -- | User's pronouns + userFilter_pronouns :: Maybe Text } userAttrs :: UserAttrs -> [GitLabParam] @@ -549,7 +590,8 @@ (\t -> Just ("twitter", textToBS t)) =<< userFilter_twitter filters, (\t -> Just ("username", textToBS t)) =<< userFilter_username filters, (\b -> Just ("view_diffs_file_by_file", textToBS (showBool b))) =<< userFilter_view_diffs_file_by_file filters, - (\t -> Just ("website", textToBS t)) =<< userFilter_website filters + (\t -> Just ("website", textToBS t)) =<< userFilter_website filters, + (\t -> Just ("pronouns", textToBS t)) =<< userFilter_pronouns filters ] where textToBS = Just . T.encodeUtf8 diff --git a/src/GitLab/SystemHooks/GitLabSystemHooks.hs b/src/GitLab/SystemHooks/GitLabSystemHooks.hs --- a/src/GitLab/SystemHooks/GitLabSystemHooks.hs +++ b/src/GitLab/SystemHooks/GitLabSystemHooks.hs @@ -20,7 +20,10 @@ import qualified Control.Exception as E import Control.Monad import Control.Monad.IO.Class -import Control.Monad.Trans.Reader +import qualified Control.Monad.Reader as MR +import Data.Text (Text) +import qualified Data.Text as T +import qualified Data.Text.IO as TIO import Data.Typeable import GitLab.SystemHooks.Types import GitLab.Types @@ -31,23 +34,23 @@ -- received from the GitLab server from standard input. receive :: [Rule] -> GitLab () receive rules = do - eventContent <- liftIO getContents + eventContent <- liftIO TIO.getContents receiveString eventContent rules -- | Attempts to fire each rule in sequence. Reads the JSON data -- received from a function argument. -receiveString :: String -> [Rule] -> GitLab () +receiveString :: Text -> [Rule] -> GitLab () receiveString eventContent rules = do traceSystemHook eventContent mapM_ (fire eventContent) rules -traceSystemHook :: String -> GitLab () +traceSystemHook :: Text -> GitLab () traceSystemHook eventContent = do - cfg <- serverCfg <$> ask + cfg <- serverCfg <$> MR.ask liftIO $ E.catch ( when (debugSystemHooks cfg) $ do - fpath <- writeSystemTempFile "gitlab-system-hook-" eventContent + fpath <- writeSystemTempFile "gitlab-system-hook-" (T.unpack eventContent) void $ setFileMode fpath otherReadMode ) -- runGitLabDbg must have been used, which doesn't define a GitLabServerConfig @@ -60,7 +63,7 @@ then return True else g -fire :: String -> Rule -> GitLab () +fire :: Text -> Rule -> GitLab () fire contents rule = do result <- tryFire contents rule when result $ @@ -72,7 +75,7 @@ -- | Try to fire a GitLab rule, returns 'True' if the rule fired and -- 'False' if it did not fire. -tryFire :: String -> Rule -> GitLab Bool +tryFire :: Text -> Rule -> GitLab Bool tryFire contents (Match _ f) = do fireIf' (Just (\_ -> return True)) 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 @@ -1,3 +1,4 @@ +{-# LANGUAGE CPP #-} {-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE GADTs #-} @@ -57,8 +58,8 @@ where import Data.Aeson -import qualified Data.ByteString.Lazy.Char8 as BSL import Data.Text (Text) +import qualified Data.Text.Encoding as T import Data.Typeable import GHC.Generics import GitLab.Types @@ -74,9 +75,9 @@ matchIf :: String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule -- | Parse JSON data into GitLab events. -parseEvent :: (FromJSON a) => String -> Maybe a -parseEvent string = - case eitherDecode (BSL.pack string) of +parseEvent :: (FromJSON a) => Text -> Maybe a +parseEvent eventText = + case eitherDecodeStrict (T.encodeUtf8 eventText) of Left _error -> Nothing Right event -> Just event @@ -467,7 +468,8 @@ push_checkout_sha :: Text, push_user_id :: Int, push_user_name :: Text, - push_user_email :: Text, + push_user_username :: Maybe Text, + push_user_email :: Maybe Text, push_user_avatar :: Text, push_project_id :: Int, push_project :: ProjectEvent, @@ -520,7 +522,7 @@ -- | A project event. data ProjectEvent = ProjectEvent { projectEvent_name :: Text, - projectEvent_description :: Text, + projectEvent_description :: Maybe Text, projectEvent_web_url :: Text, projectEvent_avatar_url :: Maybe Text, projectEvent_git_ssh_url :: Text, @@ -549,7 +551,7 @@ data RepositoryEvent = RepositoryEvent { repositoryEvent_name :: Text, repositoryEvent_url :: Text, - repositoryEvent_description :: Text, + repositoryEvent_description :: Maybe Text, repositoryEvent_homepage :: Maybe Text, -- these three not in the merge_request event example -- in the GitLab documentation. Is the merge_request documentation @@ -1169,6 +1171,7 @@ <*> v .: "checkout_sha" <*> v .: "user_id" <*> v .: "user_name" + <*> v .: "user_username" <*> v .: "user_email" <*> v .: "user_avatar" <*> v .: "project_id" diff --git a/src/GitLab/Types.hs b/src/GitLab/Types.hs --- a/src/GitLab/Types.hs +++ b/src/GitLab/Types.hs @@ -1,3 +1,4 @@ +{-# LANGUAGE GeneralizedNewtypeDeriving #-} {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -14,6 +15,7 @@ -- Stability : stable module GitLab.Types ( GitLab, + GitLabT (..), GitLabState (..), GitLabServerConfig (..), defaultGitLabServer, @@ -105,7 +107,10 @@ ) where -import Control.Monad.Trans.Reader +import Control.Monad.IO.Class +import qualified Control.Monad.IO.Class as MIO +import qualified Control.Monad.Reader as MR +import qualified Control.Monad.Trans.Class as MT import Data.Aeson hiding (Key) import Data.Aeson.TH import Data.Aeson.Types hiding (Key) @@ -114,9 +119,22 @@ import Data.Time.Clock import Network.HTTP.Conduit --- | type synonym for all GitLab actions. -type GitLab a = ReaderT GitLabState IO a +-- | The monad in which the GitLab operations can be run. +-- Contains the 'GitLabState' to run the requests with. +-- +-- Run it with 'runGitLab' +newtype GitLabT m a = GitLabT (MR.ReaderT GitLabState m a) + deriving (Functor, Applicative, Monad, MonadFail, MR.MonadReader GitLabState) +instance MT.MonadTrans GitLabT where + lift = GitLabT . MT.lift + +instance MIO.MonadIO m => MIO.MonadIO (GitLabT m) where + liftIO = GitLabT . MIO.liftIO + +-- | Utility type which uses 'IO' as underlying monad +type GitLab a = GitLabT IO a + -- | state used by GitLab actions, used internally. data GitLabState = GitLabState { serverCfg :: GitLabServerConfig, @@ -505,6 +523,7 @@ user_public_email :: Maybe Text, user_organization :: Maybe Text, user_job_title :: Maybe Text, + user_pronouns :: Maybe Text, user_linkedin :: Maybe Text, user_confirmed_at :: Maybe UTCTime, user_identities :: Maybe [Identity], @@ -516,8 +535,18 @@ user_state :: Text, user_avatar_url :: Maybe Text, user_web_url :: Maybe Text, + user_location :: Maybe Text, + user_extern_uid :: Maybe Int, + user_group_id_for_saml :: Maybe Int, user_discussion_locked :: Maybe Bool, -- only for author of 'TODO' type - user_created_at :: Maybe UTCTime + user_created_at :: Maybe UTCTime, + user_note :: Maybe Text, -- viewable to administrators only + user_password :: Maybe Text, -- viewable to administrators only + user_force_random_password :: Maybe Bool, + user_providor :: Maybe Text, + user_reset_password :: Maybe Bool, + user_skip_confirmation :: Maybe Bool, + user_view_diffs_file_by_file :: Maybe Bool } deriving (Show, Eq) @@ -797,7 +826,7 @@ groupshare_group_id :: Int, groupshare_group_name :: Maybe Text, groupshare_group_full_path :: Maybe Text, - groupshare_group_access_level :: Int, -- TODO change this to 'AccessLevel' + groupshare_group_access_level :: Maybe Int, -- TODO change this to 'AccessLevel' groupshare_expires_at :: Maybe Text } deriving (Show, Eq) 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 @@ -16,7 +16,7 @@ import qualified Control.Exception as Exception import Control.Monad.IO.Class -import Control.Monad.Trans.Reader +import qualified Control.Monad.Reader as MR import Data.Aeson import Data.ByteString import qualified Data.ByteString.Lazy as BSL @@ -169,8 +169,8 @@ [GitLabParam] -> GitLab (Response BSL.ByteString) gitlabHTTP httpMethod contentType urlPath urlParams contentParams = do - cfg <- serverCfg <$> ask - manager <- httpManager <$> ask + cfg <- serverCfg <$> MR.ask + manager <- httpManager <$> MR.ask let url' = url cfg <> "/api/v4" <> urlPath <> T.decodeUtf8 (renderQuery True urlParams) let request' = parseRequest_ (T.unpack url') request = @@ -277,8 +277,8 @@ tryGitLab i request maxRetries manager lastException | i == maxRetries = error (show lastException) | otherwise = - httpLbs request manager - `Exception.catch` \ex -> tryGitLab (i + 1) request maxRetries manager (Just ex) + httpLbs request manager + `Exception.catch` \ex -> tryGitLab (i + 1) request maxRetries manager (Just ex) parseOne :: FromJSON a => BSL.ByteString -> Maybe a parseOne bs = diff --git a/tests/API/BranchesTests.hs b/tests/API/BranchesTests.hs --- a/tests/API/BranchesTests.hs +++ b/tests/API/BranchesTests.hs @@ -4,14 +4,10 @@ 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] diff --git a/tests/API/EventsTests.hs b/tests/API/EventsTests.hs --- a/tests/API/EventsTests.hs +++ b/tests/API/EventsTests.hs @@ -3,14 +3,10 @@ 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] diff --git a/tests/API/IssuesTests.hs b/tests/API/IssuesTests.hs --- a/tests/API/IssuesTests.hs +++ b/tests/API/IssuesTests.hs @@ -3,14 +3,10 @@ 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] diff --git a/tests/API/JobsTests.hs b/tests/API/JobsTests.hs --- a/tests/API/JobsTests.hs +++ b/tests/API/JobsTests.hs @@ -3,14 +3,10 @@ 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] diff --git a/tests/API/MembersTests.hs b/tests/API/MembersTests.hs --- a/tests/API/MembersTests.hs +++ b/tests/API/MembersTests.hs @@ -3,14 +3,10 @@ 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] diff --git a/tests/API/NotesTests.hs b/tests/API/NotesTests.hs --- a/tests/API/NotesTests.hs +++ b/tests/API/NotesTests.hs @@ -3,14 +3,10 @@ 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] diff --git a/tests/API/PipelinesTests.hs b/tests/API/PipelinesTests.hs --- a/tests/API/PipelinesTests.hs +++ b/tests/API/PipelinesTests.hs @@ -3,14 +3,10 @@ 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] diff --git a/tests/API/RepositoriesTests.hs b/tests/API/RepositoriesTests.hs --- a/tests/API/RepositoriesTests.hs +++ b/tests/API/RepositoriesTests.hs @@ -3,14 +3,10 @@ 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] diff --git a/tests/API/TagsTests.hs b/tests/API/TagsTests.hs --- a/tests/API/TagsTests.hs +++ b/tests/API/TagsTests.hs @@ -3,14 +3,10 @@ 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] diff --git a/tests/API/TodosTests.hs b/tests/API/TodosTests.hs --- a/tests/API/TodosTests.hs +++ b/tests/API/TodosTests.hs @@ -3,14 +3,10 @@ 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] diff --git a/tests/API/UsersTests.hs b/tests/API/UsersTests.hs --- a/tests/API/UsersTests.hs +++ b/tests/API/UsersTests.hs @@ -3,14 +3,10 @@ module API.UsersTests (usersTests) where import API.Common -import Control.Monad.IO.Class import Data.Aeson hiding (Key) 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] diff --git a/tests/API/VersionTests.hs b/tests/API/VersionTests.hs --- a/tests/API/VersionTests.hs +++ b/tests/API/VersionTests.hs @@ -3,14 +3,10 @@ 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] diff --git a/tests/SystemHookTests.hs b/tests/SystemHookTests.hs --- a/tests/SystemHookTests.hs +++ b/tests/SystemHookTests.hs @@ -4,11 +4,8 @@ module SystemHookTests (systemHookTests) where import Control.Monad.IO.Class -import Data.Aeson -import qualified Data.ByteString.Lazy.Char8 as BSL +import qualified Data.Text.IO as TIO import GitLab -import GitLab.SystemHooks.GitLabSystemHooks -import GitLab.SystemHooks.Types import Test.Tasty import Test.Tasty.HUnit @@ -22,122 +19,132 @@ "GitLab system hook rules" [ testCase "project-create-event" - ( readFile "data/system-hooks/project-created.json" + ( TIO.readFile "data/system-hooks/project-created.json" >>= \eventJson -> parseEvent eventJson @?= Just projectCreatedHaskell ), testCase "project-destroy-event" - ( readFile "data/system-hooks/project-destroyed.json" + ( TIO.readFile "data/system-hooks/project-destroyed.json" >>= \eventJson -> parseEvent eventJson @?= Just projectDestroyedHaskell ), testCase "project-rename-event" - ( readFile "data/system-hooks/project-renamed.json" + ( TIO.readFile "data/system-hooks/project-renamed.json" >>= \eventJson -> parseEvent eventJson @?= Just projectRenamedHaskell ), testCase "project-transfer-event" - ( readFile "data/system-hooks/project-transferred.json" + ( TIO.readFile "data/system-hooks/project-transferred.json" >>= \eventJson -> parseEvent eventJson @?= Just projectTransferredHaskell ), testCase "project-update-event" - ( readFile "data/system-hooks/project-updated.json" + ( TIO.readFile "data/system-hooks/project-updated.json" >>= \eventJson -> parseEvent eventJson @?= Just projectUpdatedHaskell ), testCase "new-team-member-event" - ( readFile "data/system-hooks/new-team-member.json" + ( TIO.readFile "data/system-hooks/new-team-member.json" >>= \eventJson -> parseEvent eventJson @?= Just userAddedToTeamHaskell ), testCase "team-member-removed-event" - ( readFile "data/system-hooks/team-member-removed.json" + ( TIO.readFile "data/system-hooks/team-member-removed.json" >>= \eventJson -> parseEvent eventJson @?= Just userRemovedFromTeamHaskell ), testCase "team-member-updated-event" - ( readFile "data/system-hooks/team-member-updated.json" + ( TIO.readFile "data/system-hooks/team-member-updated.json" >>= \eventJson -> parseEvent eventJson @?= Just userUpdatedForTeamHaskell ), testCase "user-created-event" - ( readFile "data/system-hooks/user-created.json" + ( TIO.readFile "data/system-hooks/user-created.json" >>= \eventJson -> parseEvent eventJson @?= Just userCreatedHaskell ), testCase "user-removed-event" - ( readFile "data/system-hooks/user-removed.json" + ( TIO.readFile "data/system-hooks/user-removed.json" >>= \eventJson -> parseEvent eventJson @?= Just userRemovedHaskell ), testCase "user-failed-login-event" - ( readFile "data/system-hooks/user-failed-login.json" + ( TIO.readFile "data/system-hooks/user-failed-login.json" >>= \eventJson -> parseEvent eventJson @?= Just userFailedLoginHaskell ), testCase "user-renamed-event" - ( readFile "data/system-hooks/user-renamed.json" + ( TIO.readFile "data/system-hooks/user-renamed.json" >>= \eventJson -> parseEvent eventJson @?= Just userRenamedHaskell ), testCase "key-added-event" - ( readFile "data/system-hooks/key-added.json" + ( TIO.readFile "data/system-hooks/key-added.json" >>= \eventJson -> parseEvent eventJson @?= Just keyCreatedHaskell ), testCase "key-removed-event" - ( readFile "data/system-hooks/key-removed.json" + ( TIO.readFile "data/system-hooks/key-removed.json" >>= \eventJson -> parseEvent eventJson @?= Just keyRemovedHaskell ), testCase "group-created-event" - ( readFile "data/system-hooks/group-created.json" + ( TIO.readFile "data/system-hooks/group-created.json" >>= \eventJson -> parseEvent eventJson @?= Just groupCreatedHaskell ), testCase "group-removed-event" - ( readFile "data/system-hooks/group-removed.json" + ( TIO.readFile "data/system-hooks/group-removed.json" >>= \eventJson -> parseEvent eventJson @?= Just groupRemovedHaskell ), testCase "group-renamed-event" - ( readFile "data/system-hooks/group-renamed.json" + ( TIO.readFile "data/system-hooks/group-renamed.json" >>= \eventJson -> parseEvent eventJson @?= Just groupRenamedHaskell ), testCase "new-group-member-event" - ( readFile "data/system-hooks/new-group-member.json" + ( TIO.readFile "data/system-hooks/new-group-member.json" >>= \eventJson -> parseEvent eventJson @?= Just newGroupMemberHaskell ), testCase "group-member-removed-event" - ( readFile "data/system-hooks/group-member-removed.json" + ( TIO.readFile "data/system-hooks/group-member-removed.json" >>= \eventJson -> parseEvent eventJson @?= Just groupMemberRemovedHaskell ), testCase "group-member-updated-event" - ( readFile "data/system-hooks/group-member-updated.json" + ( TIO.readFile "data/system-hooks/group-member-updated.json" >>= \eventJson -> parseEvent eventJson @?= Just groupMemberUpdatedHaskell ), testCase "push-event" - ( readFile "data/system-hooks/push.json" + ( TIO.readFile "data/system-hooks/push.json" >>= \eventJson -> parseEvent eventJson @?= Just pushHaskell ), testCase "tag-push-event" - ( readFile "data/system-hooks/tag-push.json" + ( TIO.readFile "data/system-hooks/tag-push.json" >>= \eventJson -> parseEvent eventJson @?= Just tagPushHaskell ), testCase "merge-request-event" - ( readFile "data/system-hooks/merge-request.json" + ( TIO.readFile "data/system-hooks/merge-request.json" >>= \eventJson -> parseEvent eventJson @?= Just mergeRequestHaskell ), testCase + "merge-request-event-hw-october-2022" + ( TIO.readFile "data/system-hooks/merge-request-gitlab-15.5.0.json" + >>= \eventJson -> parseEvent eventJson @?= Just mergeRequestGitLab_15_5_0_Haskell + ), + testCase + "merge-request-event-hw-maybe-descriptions" + ( TIO.readFile "data/system-hooks/merge-request-haskell-gitlab-d1ca1037944616ac940284c5f8e49b5d9bcbf83c.json" + >>= \eventJson -> parseEvent eventJson @?= Just mergeRequestGitLab_15_5_0_maybe_descriptions_Haskell + ), + testCase "repository-update-event" - ( readFile "data/system-hooks/repository-update.json" + ( TIO.readFile "data/system-hooks/repository-update.json" >>= \eventJson -> parseEvent eventJson @?= Just repositoryUpdateHaskell ) ] @@ -146,21 +153,21 @@ matchTest lbl jsonFilename rule wrongJson wrongRule = [ testCase lbl $ runGitLabDbg - ( liftIO (readFile ("data/system-hooks/" <> jsonFilename)) + ( liftIO (TIO.readFile ("data/system-hooks/" <> jsonFilename)) >>= \eventJson -> tryFire eventJson rule ) @? (lbl <> " failed"), testCase (lbl <> "-wrong-json") $ not <$> runGitLabDbg - ( liftIO (readFile ("data/system-hooks/" <> wrongJson)) + ( liftIO (TIO.readFile ("data/system-hooks/" <> wrongJson)) >>= \eventJson -> tryFire eventJson rule ) @? (lbl <> "-wrong-json failed"), testCase (lbl <> "-wrong-rule") $ not <$> runGitLabDbg - ( liftIO (readFile ("data/system-hooks/" <> jsonFilename)) + ( liftIO (TIO.readFile ("data/system-hooks/" <> jsonFilename)) >>= \eventJson -> tryFire eventJson wrongRule ) @? (lbl <> "-wrong-rule failed") @@ -170,14 +177,14 @@ matchIfTest lbl jsonFilename yesFire noFire = [ testCase (lbl <> "-yes") $ runGitLabDbg - ( liftIO (readFile ("data/system-hooks/" <> jsonFilename)) + ( liftIO (TIO.readFile ("data/system-hooks/" <> jsonFilename)) >>= \eventJson -> tryFire eventJson yesFire ) @? (lbl <> "-fireIf-yes failed"), testCase (lbl <> "-no") $ not <$> runGitLabDbg - ( liftIO (readFile ("data/system-hooks/" <> jsonFilename)) + ( liftIO (TIO.readFile ("data/system-hooks/" <> jsonFilename)) >>= \eventJson -> tryFire eventJson noFire ) @? (lbl <> "-fireIf-no failed") @@ -185,21 +192,21 @@ -- [ testCase lbl $ -- runGitLabDbg --- ( liftIO (readFile ("data/system-hooks/" <> jsonFilename)) +-- ( liftIO (TIO.readFile ("data/system-hooks/" <> jsonFilename)) -- >>= \eventJson -> fire eventJson rule -- ) -- @? (lbl <> " failed"), -- testCase (lbl <> "-wrong-json") $ -- not -- <$> runGitLabDbg --- ( liftIO (readFile ("data/system-hooks/" <> wrongJson)) +-- ( liftIO (TIO.readFile ("data/system-hooks/" <> wrongJson)) -- >>= \eventJson -> fire eventJson rule -- ) -- @? (lbl <> "-wrong-json failed"), -- testCase (lbl <> "-wrong-rule") $ -- not -- <$> runGitLabDbg --- ( liftIO (readFile ("data/system-hooks/" <> jsonFilename)) +-- ( liftIO (TIO.readFile ("data/system-hooks/" <> jsonFilename)) -- >>= \eventJson -> fire eventJson wrongRule -- ) -- @? (lbl <> "-wrong-rule failed") @@ -267,28 +274,28 @@ "GitLab system hooks receive" [ testCase "1-rule-match" $ runGitLabDbg $ - liftIO (readFile "data/system-hooks/project-created.json") + liftIO (TIO.readFile "data/system-hooks/project-created.json") >>= \eventJson -> receiveString eventJson [projectCreateRule], testCase "1-rule-no-match" $ runGitLabDbg $ - liftIO (readFile "data/system-hooks/project-created.json") + liftIO (TIO.readFile "data/system-hooks/project-created.json") >>= \eventJson -> receiveString eventJson [projectRenameRule], testCase "2-rules" - $ runGitLabDbg $ - liftIO (readFile "data/system-hooks/project-created.json") - >>= \eventJson -> - receiveString - eventJson - [ projectCreateRule, - projectDestroyRule - ] + $ runGitLabDbg + $ liftIO (TIO.readFile "data/system-hooks/project-created.json") + >>= \eventJson -> + receiveString + eventJson + [ projectCreateRule, + projectDestroyRule + ] ] projectCreateRule :: Rule @@ -1428,11 +1435,12 @@ push_checkout_sha = "da1560886d4f094c3e6c9ef40349f7d38b5d27d7", push_user_id = 4, push_user_name = "John Smith", - push_user_email = "john@example.com", + push_user_email = Just "john@example.com", + push_user_username = Just "abc1", push_user_avatar = "https://s.gravatar.com/avatar/d4c74594d841139328695756648b6bd6?s=8://s.gravatar.com/avatar/d4c74594d841139328695756648b6bd6?s=80", push_project_id = 15, - push_project = ProjectEvent {projectEvent_name = "Diaspora", projectEvent_description = "", projectEvent_web_url = "http://example.com/mike/diaspora", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@example.com:mike/diaspora.git", projectEvent_git_http_url = "http://example.com/mike/diaspora.git", projectEvent_namespace = "Mike", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "mike/diaspora", projectEvent_default_branch = "master", projectEvent_homepage = Just "http://example.com/mike/diaspora", projectEvent_url = "git@example.com:mike/diaspora.git", projectEvent_ssh_url = "git@example.com:mike/diaspora.git", projectEvent_http_url = "http://example.com/mike/diaspora.git"}, - push_repository = RepositoryEvent {repositoryEvent_name = "Diaspora", repositoryEvent_url = "git@example.com:mike/diaspora.git", repositoryEvent_description = "", repositoryEvent_homepage = Just "http://example.com/mike/diaspora", repositoryEvent_git_http_url = Just "http://example.com/mike/diaspora.git", repositoryEvent_git_ssh_url = Just "git@example.com:mike/diaspora.git", repositoryEvent_visibility_level = Just Private}, + push_project = ProjectEvent {projectEvent_name = "Diaspora", projectEvent_description = Just "", projectEvent_web_url = "http://example.com/mike/diaspora", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@example.com:mike/diaspora.git", projectEvent_git_http_url = "http://example.com/mike/diaspora.git", projectEvent_namespace = "Mike", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "mike/diaspora", projectEvent_default_branch = "master", projectEvent_homepage = Just "http://example.com/mike/diaspora", projectEvent_url = "git@example.com:mike/diaspora.git", projectEvent_ssh_url = "git@example.com:mike/diaspora.git", projectEvent_http_url = "http://example.com/mike/diaspora.git"}, + push_repository = RepositoryEvent {repositoryEvent_name = "Diaspora", repositoryEvent_url = "git@example.com:mike/diaspora.git", repositoryEvent_description = Just "", repositoryEvent_homepage = Just "http://example.com/mike/diaspora", repositoryEvent_git_http_url = Just "http://example.com/mike/diaspora.git", repositoryEvent_git_ssh_url = Just "git@example.com:mike/diaspora.git", repositoryEvent_visibility_level = Just Private}, push_commits = [CommitEvent {commitEvent_id = "c5feabde2d8cd023215af4d2ceeb7a64839fc428", commitEvent_message = "Add simple search to projects in public area", commitEvent_timestamp = "2013-05-13T18:18:08+00:00", commitEvent_url = "https://dev.gitlab.org/gitlab/gitlabhq/commit/c5feabde2d8cd023215af4d2ceeb7a64839fc428", commitEvent_author = CommitAuthorEvent {commitAuthorEvent_name = "Example User", commitAuthorEvent_email = "user@example.com"}}], push_total_commits_count = 1 } @@ -1449,8 +1457,8 @@ tagPush_user_name = "John Smith", tagPush_user_avatar = "https://s.gravatar.com/avatar/d4c74594d841139328695756648b6bd6?s=8://s.gravatar.com/avatar/d4c74594d841139328695756648b6bd6?s=80", tagPush_project_id = 1, - tagPush_project = ProjectEvent {projectEvent_name = "Example", projectEvent_description = "", projectEvent_web_url = "http://example.com/jsmith/example", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@example.com:jsmith/example.git", projectEvent_git_http_url = "http://example.com/jsmith/example.git", projectEvent_namespace = "Jsmith", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "jsmith/example", projectEvent_default_branch = "master", projectEvent_homepage = Just "http://example.com/jsmith/example", projectEvent_url = "git@example.com:jsmith/example.git", projectEvent_ssh_url = "git@example.com:jsmith/example.git", projectEvent_http_url = "http://example.com/jsmith/example.git"}, - tagPush_repository = RepositoryEvent {repositoryEvent_name = "Example", repositoryEvent_url = "ssh://git@example.com/jsmith/example.git", repositoryEvent_description = "", repositoryEvent_homepage = Just "http://example.com/jsmith/example", repositoryEvent_git_http_url = Just "http://example.com/jsmith/example.git", repositoryEvent_git_ssh_url = Just "git@example.com:jsmith/example.git", repositoryEvent_visibility_level = Just Private}, + tagPush_project = ProjectEvent {projectEvent_name = "Example", projectEvent_description = Just "", projectEvent_web_url = "http://example.com/jsmith/example", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@example.com:jsmith/example.git", projectEvent_git_http_url = "http://example.com/jsmith/example.git", projectEvent_namespace = "Jsmith", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "jsmith/example", projectEvent_default_branch = "master", projectEvent_homepage = Just "http://example.com/jsmith/example", projectEvent_url = "git@example.com:jsmith/example.git", projectEvent_ssh_url = "git@example.com:jsmith/example.git", projectEvent_http_url = "http://example.com/jsmith/example.git"}, + tagPush_repository = RepositoryEvent {repositoryEvent_name = "Example", repositoryEvent_url = "ssh://git@example.com/jsmith/example.git", repositoryEvent_description = Just "", repositoryEvent_homepage = Just "http://example.com/jsmith/example", repositoryEvent_git_http_url = Just "http://example.com/jsmith/example.git", repositoryEvent_git_ssh_url = Just "git@example.com:jsmith/example.git", repositoryEvent_visibility_level = Just Private}, tagPush_commits = [], tagPush_total_commits_count = 0 } @@ -1464,11 +1472,21 @@ repositoryUpdate_user_email = "admin@example.com", repositoryUpdate_user_avatar = "https://s.gravatar.com/avatar/d4c74594d841139328695756648b6bd6?s=8://s.gravatar.com/avatar/d4c74594d841139328695756648b6bd6?s=80", repositoryUpdate_project_id = 1, - repositoryUpdate_project = ProjectEvent {projectEvent_name = "Example", projectEvent_description = "", projectEvent_web_url = "http://example.com/jsmith/example", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@example.com:jsmith/example.git", projectEvent_git_http_url = "http://example.com/jsmith/example.git", projectEvent_namespace = "Jsmith", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "jsmith/example", projectEvent_default_branch = "master", projectEvent_homepage = Just "http://example.com/jsmith/example", projectEvent_url = "git@example.com:jsmith/example.git", projectEvent_ssh_url = "git@example.com:jsmith/example.git", projectEvent_http_url = "http://example.com/jsmith/example.git"}, + repositoryUpdate_project = ProjectEvent {projectEvent_name = "Example", projectEvent_description = Just "", projectEvent_web_url = "http://example.com/jsmith/example", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@example.com:jsmith/example.git", projectEvent_git_http_url = "http://example.com/jsmith/example.git", projectEvent_namespace = "Jsmith", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "jsmith/example", projectEvent_default_branch = "master", projectEvent_homepage = Just "http://example.com/jsmith/example", projectEvent_url = "git@example.com:jsmith/example.git", projectEvent_ssh_url = "git@example.com:jsmith/example.git", projectEvent_http_url = "http://example.com/jsmith/example.git"}, repositoryUpdate_changes = [ProjectChanges {projectChanges_before = "8205ea8d81ce0c6b90fbe8280d118cc9fdad6130", projectChanges_after = "4045ea7a3df38697b3730a20fb73c8bed8a3e69e", projectChanges_ref = "refs/heads/master"}], repositoryUpdate_refs = ["refs/heads/master"] } mergeRequestHaskell :: MergeRequestEvent mergeRequestHaskell = - 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}} + 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 = Just "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 = Just "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 = Just "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 = Just "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}} + +mergeRequestGitLab_15_5_0_Haskell :: MergeRequestEvent +mergeRequestGitLab_15_5_0_Haskell = + MergeRequestEvent {mergeRequest_object_kind = "merge_request", mergeRequest_event_type = "merge_request", mergeRequest_user = UserEvent {userEvent_name = "Joe Bloggs", userEvent_username = "joe", userEvent_avatar_url = "https://gitlab.example.com/uploads/-/system/user/avatar/5/avatar.png"}, mergeRequest_project = ProjectEvent {projectEvent_name = "test-ci-project", projectEvent_description = Just "", projectEvent_web_url = "https://gitlab.example.com/joe/test-ci-project", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@gitlab.example.com:joe/test-ci-project.git", projectEvent_git_http_url = "https://gitlab.example.com/joe/test-ci-project.git", projectEvent_namespace = "Joe Bloggs", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "joe/test-ci-project", projectEvent_default_branch = "master", projectEvent_homepage = Just "https://gitlab.example.com/joe/test-ci-project", projectEvent_url = "git@gitlab.example.com:joe/test-ci-project.git", projectEvent_ssh_url = "git@gitlab.example.com:joe/test-ci-project.git", projectEvent_http_url = "https://gitlab.example.com/joe/test-ci-project.git"}, mergeRequest_object_attributes = ObjectAttributes {objectAttributes_id = 3448, objectAttributes_target_branch = "master", objectAttributes_source_branch = "another-branch", objectAttributes_source_project_id = 7926, objectAttributes_author_id = Just 5, objectAttributes_assignee_id = Nothing, objectAttributes_assignee_ids = Just [], objectAttributes_title = "A change", objectAttributes_created_at = "2022-10-24 22:11:46 UTC", objectAttributes_updated_at = "2022-10-24 22:11:46 UTC", objectAttributes_milestone_id = Nothing, objectAttributes_state = "opened", objectAttributes_state_id = Just 1, objectAttributes_merge_status = "preparing", objectAttributes_target_project_id = 7926, objectAttributes_iid = 1, objectAttributes_description = "To test the merge request event.", objectAttributes_updated_by_id = Nothing, objectAttributes_merge_error = Nothing, objectAttributes_merge_params = Just (MergeParams {mergeParams_force_remove_source_branch = Just "1"}), objectAttributes_merge_when_pipeline_succeeds = Just 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 = Just 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 = "test-ci-project", projectEvent_description = Just "", projectEvent_web_url = "https://gitlab.example.com/joe/test-ci-project", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@gitlab.example.com:joe/test-ci-project.git", projectEvent_git_http_url = "https://gitlab.example.com/joe/test-ci-project.git", projectEvent_namespace = "Joe Bloggs", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "joe/test-ci-project", projectEvent_default_branch = "master", projectEvent_homepage = Just "https://gitlab.example.com/joe/test-ci-project", projectEvent_url = "git@gitlab.example.com:joe/test-ci-project.git", projectEvent_ssh_url = "git@gitlab.example.com:joe/test-ci-project.git", projectEvent_http_url = "https://gitlab.example.com/joe/test-ci-project.git"}, objectAttributes_target = ProjectEvent {projectEvent_name = "test-ci-project", projectEvent_description = Just "", projectEvent_web_url = "https://gitlab.example.com/joe/test-ci-project", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@gitlab.example.com:joe/test-ci-project.git", projectEvent_git_http_url = "https://gitlab.example.com/joe/test-ci-project.git", projectEvent_namespace = "Joe Bloggs", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "joe/test-ci-project", projectEvent_default_branch = "master", projectEvent_homepage = Just "https://gitlab.example.com/joe/test-ci-project", projectEvent_url = "git@gitlab.example.com:joe/test-ci-project.git", projectEvent_ssh_url = "git@gitlab.example.com:joe/test-ci-project.git", projectEvent_http_url = "https://gitlab.example.com/joe/test-ci-project.git"}, objectAttributes_last_commit = CommitEvent {commitEvent_id = "83c2d70f8ecb1376d1d4f1e52b7a18c560a7b95c", commitEvent_message = "A change\n", commitEvent_timestamp = "2022-10-24T23:10:03+01:00", commitEvent_url = "https://gitlab.example.com/joe/test-ci-project/-/commit/83c2d70f8ecb1376d1d4f1e52b7a18c560a7b95c", commitEvent_author = CommitAuthorEvent {commitAuthorEvent_name = "Joe Bloggs", commitAuthorEvent_email = "robstewart57@gmail.com"}}, objectAttributes_work_in_progress = False, objectAttributes_total_time_spent = Just 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 = 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 = Nothing}, mergeRequest_repository = RepositoryEvent {repositoryEvent_name = "test-ci-project", repositoryEvent_url = "git@gitlab.example.com:joe/test-ci-project.git", repositoryEvent_description = Just "", repositoryEvent_homepage = Just "https://gitlab.example.com/joe/test-ci-project", repositoryEvent_git_http_url = Nothing, repositoryEvent_git_ssh_url = Nothing, repositoryEvent_visibility_level = Nothing}} + +-- | tests that this fix works: +-- https://gitlab.com/robstewart57/gitlab-haskell/-/commit/d1ca1037944616ac940284c5f8e49b5d9bcbf83c +mergeRequestGitLab_15_5_0_maybe_descriptions_Haskell :: MergeRequestEvent +mergeRequestGitLab_15_5_0_maybe_descriptions_Haskell = + MergeRequestEvent {mergeRequest_object_kind = "merge_request", mergeRequest_event_type = "merge_request", mergeRequest_user = UserEvent {userEvent_name = "Bloggs, Joe", userEvent_username = "joe123", userEvent_avatar_url = "https://secure.gravatar.com/avatar/df1b70b1fd7d7eaaa5f9a41f5f5093c0?s=80&d=identicon"}, mergeRequest_project = ProjectEvent {projectEvent_name = "proj1", projectEvent_description = Nothing, projectEvent_web_url = "https://gitlab.example.com/grp1/grp2/proj1", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@gitlab.example.com:grp1/grp2/proj1.git", projectEvent_git_http_url = "https://gitlab.example.com/grp1/grp2/proj1.git", projectEvent_namespace = "grp2", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "grp1/grp2/proj1", projectEvent_default_branch = "main", projectEvent_homepage = Just "https://gitlab.example.com/grp1/grp2/proj1", projectEvent_url = "git@gitlab.example.com:grp1/grp2/proj1.git", projectEvent_ssh_url = "git@gitlab.example.com:grp1/grp2/proj1.git", projectEvent_http_url = "https://gitlab.example.com/grp1/grp2/proj1.git"}, mergeRequest_object_attributes = ObjectAttributes {objectAttributes_id = 3461, objectAttributes_target_branch = "main", objectAttributes_source_branch = "main", objectAttributes_source_project_id = 49668, objectAttributes_author_id = Just 2312, objectAttributes_assignee_id = Nothing, objectAttributes_assignee_ids = Just [], objectAttributes_title = "the MR title", objectAttributes_created_at = "2022-10-25 18:51:48 UTC", objectAttributes_updated_at = "2022-10-25 18:51:48 UTC", objectAttributes_milestone_id = Nothing, objectAttributes_state = "opened", objectAttributes_state_id = Just 1, objectAttributes_merge_status = "preparing", objectAttributes_target_project_id = 43593, objectAttributes_iid = 14, objectAttributes_description = "", objectAttributes_updated_by_id = Nothing, objectAttributes_merge_error = Nothing, objectAttributes_merge_params = Just (MergeParams {mergeParams_force_remove_source_branch = Nothing}), objectAttributes_merge_when_pipeline_succeeds = Just 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 = Just 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 = "proj1", projectEvent_description = Nothing, projectEvent_web_url = "https://gitlab.example.com/joe123/proj1", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@gitlab.example.com:joe123/proj1.git", projectEvent_git_http_url = "https://gitlab.example.com/joe123/proj1.git", projectEvent_namespace = "Bloggs, Joe", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "joe123/proj1", projectEvent_default_branch = "main", projectEvent_homepage = Just "https://gitlab.example.com/joe123/proj1", projectEvent_url = "git@gitlab.example.com:joe123/proj1.git", projectEvent_ssh_url = "git@gitlab.example.com:joe123/proj1.git", projectEvent_http_url = "https://gitlab.example.com/joe123/proj1.git"}, objectAttributes_target = ProjectEvent {projectEvent_name = "proj1", projectEvent_description = Nothing, projectEvent_web_url = "https://gitlab.example.com/grp1/grp2/proj1", projectEvent_avatar_url = Nothing, projectEvent_git_ssh_url = "git@gitlab.example.com:grp1/grp2/proj1.git", projectEvent_git_http_url = "https://gitlab.example.com/grp1/grp2/proj1.git", projectEvent_namespace = "grp2", projectEvent_visibility_level = Private, projectEvent_path_with_namespace = "grp1/grp2/proj1", projectEvent_default_branch = "main", projectEvent_homepage = Just "https://gitlab.example.com/grp1/grp2/proj1", projectEvent_url = "git@gitlab.example.com:grp1/grp2/proj1.git", projectEvent_ssh_url = "git@gitlab.example.com:grp1/grp2/proj1.git", projectEvent_http_url = "https://gitlab.example.com/grp1/grp2/proj1.git"}, objectAttributes_last_commit = CommitEvent {commitEvent_id = "249d94fdc92825a2ca22c4fa74c511ec5f03e086", commitEvent_message = "Updated README\n", commitEvent_timestamp = "2022-10-08T10:37:28+01:00", commitEvent_url = "https://gitlab.example.com/grp1/grp2/proj1/-/commit/249d94fdc92825a2ca22c4fa74c511ec5f03e086", commitEvent_author = CommitAuthorEvent {commitAuthorEvent_name = "Hill, Harry", commitAuthorEvent_email = "harry@gmail.com"}}, objectAttributes_work_in_progress = True, objectAttributes_total_time_spent = Just 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 = 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 = Nothing}, mergeRequest_repository = RepositoryEvent {repositoryEvent_name = "proj1", repositoryEvent_url = "git@gitlab.example.com:grp1/grp2/proj1.git", repositoryEvent_description = Nothing, repositoryEvent_homepage = Just "https://gitlab.example.com/grp1/grp2/proj1", 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 @@ -22,7 +22,6 @@ import API.TodosTests import API.UsersTests import API.VersionTests -import Data.Maybe (fromJust) import SystemHookTests import Test.Tasty