gitlab-haskell 0.2.3 → 0.2.4

raw patch · 16 files changed

+409/−166 lines, 16 filesdep +temporarydep +unixPVP: major bump suggested

API removals or changes: PVP suggests a major version bump

Dependencies added: temporary, unix

API changes (from Hackage documentation)

Files

• README.md +22/−5
• data/system-hooks/merge-request.json +124/−113
• gitlab-haskell.cabal +10/−6
• src/GitLab.hs +2/−0
• src/GitLab/API/Groups.hs +5/−5
• src/GitLab/API/Issues.hs +2/−2
• src/GitLab/API/Members.hs +4/−4
• src/GitLab/API/MergeRequests.hs +28/−4
• src/GitLab/API/Notes.hs +53/−0
• src/GitLab/API/Projects.hs +4/−4
• src/GitLab/API/Users.hs +17/−0
• src/GitLab/SystemHooks/GitLabSystemHooks.hs +17/−0
• src/GitLab/SystemHooks/Types.hs +75/−9
• src/GitLab/Types.hs +7/−3
• src/GitLab/WebRequests/GitLabWebCalls.hs +31/−5
• tests/SystemHookTests.hs +8/−6

@@ -24,10 +24,9 @@ Run all GitLab actions with `runGitLab`:       runGitLab ::-      (MonadUnliftIO m, MonadIO m)        => GitLabServerConfig-       -> GitLab m a-       -> m a+       -> GitLab a+       -> IO a  For example: @@ -40,8 +39,26 @@  Which uses the functions: -    searchUser   :: Text -> GitLab m (Maybe User)-    userProjects :: User -> GitLab m (Maybe [Project])+    searchUser     :: Text -> GitLab (Maybe User)+    userProjects   :: User -> GitLab (Maybe [Project])+    projectCommits :: Project -> GitLab [Commit]++This library can also be used to implement rule based GitLab file+system hooks that, when deployed a GitLab server, react in real time+to GitLab events like project creation, new users, merge requests etc.++The rule based API for implementing file hooks is:++    receive :: [Rule] -> GitLab ()++    class (FromJSON a) => SystemHook a where+      match   :: String -> (a -> GitLab ()) -> Rule+      matchIf :: String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule++For more details about the file system hooks support, see post:+[GitLab automation with file hook rules](https://www.macs.hw.ac.uk/~rs46/posts/2020-06-06-gitlab-system-hooks.html).++For the complete `gitlab-haskell` API, see the [hackage documentation](https://hackage.haskell.org/package/gitlab-haskell).  The `gitlab-tools` command line tool for bulk GitLab transactions uses this library [link](https://gitlab.com/robstewart57/gitlab-tools).

@@ -1,114 +1,125 @@-{-  "object_kind": "merge_request",-  "user": {-    "name": "Administrator",-    "username": "root",-    "avatar_url": "http://www.gravatar.com/avatar/e64c7d89f26bd1972efa854d13d7dd61?s=80&d=identicon"-  },-  "project": {-    "name": "Example",-    "description": "",-    "web_url": "http://example.com/jsmith/example",-    "avatar_url": null,-    "git_ssh_url": "git@example.com:jsmith/example.git",-    "git_http_url": "http://example.com/jsmith/example.git",-    "namespace": "Jsmith",-    "visibility_level": 0,-    "path_with_namespace": "jsmith/example",-    "default_branch": "master",-    "ci_config_path": "",-    "homepage": "http://example.com/jsmith/example",-    "url": "git@example.com:jsmith/example.git",-    "ssh_url": "git@example.com:jsmith/example.git",-    "http_url": "http://example.com/jsmith/example.git"-  },-  "object_attributes": {-    "id": 90,-    "target_branch": "master",-    "source_branch": "ms-viewport",-    "source_project_id": 14,-    "author_id": 51,-    "assignee_id": 6,-    "title": "MS-Viewport",-    "created_at": "2017-09-20T08:31:45.944Z",-    "updated_at": "2017-09-28T12:23:42.365Z",-    "milestone_id": null,-    "state": "opened",-    "merge_status": "unchecked",-    "target_project_id": 14,-    "iid": 1,-    "description": "",-    "updated_by_id": 1,-    "merge_error": null,-    "merge_params": {-      "force_remove_source_branch": "0"-    },-    "merge_when_pipeline_succeeds": false,-    "merge_user_id": null,-    "merge_commit_sha": null,-    "deleted_at": null,-    "in_progress_merge_commit_sha": null,-    "lock_version": 5,-    "time_estimate": 0,-    "last_edited_at": "2017-09-27T12:43:37.558Z",-    "last_edited_by_id": 1,-    "head_pipeline_id": 61,-    "ref_fetched": true,-    "merge_jid": null,-    "source": {-      "name": "Awesome Project",-      "description": "",-      "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": "root",-      "visibility_level": 0,-      "path_with_namespace": "awesome_space/awesome_project",-      "default_branch": "master",-      "ci_config_path": "",-      "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": 0,-      "path_with_namespace": "awesome_space/awesome_project",-      "default_branch": "master",-      "ci_config_path": "",-      "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": "ba3e0d8ff79c80d5b0bbb4f3e2e343e0aaa662b7",-      "message": "fixed readme",-      "timestamp": "2017-09-26T16:12:57Z",-      "url": "http://example.com/awesome_space/awesome_project/commits/da1560886d4f094c3e6c9ef40349f7d38b5d27d7",-      "author": {-        "name": "GitLab dev user",-        "email": "gitlabdev@dv6700.(none)"-      }-    },-    "work_in_progress": false,-    "total_time_spent": 0,-    "human_total_time_spent": null,-    "human_time_estimate": null-  },-  "labels": null,-  "repository": {-    "name": "git-gpg-test",-    "url": "git@example.com:awesome_space/awesome_project.git",-    "description": "",-    "homepage": "http://example.com/awesome_space/awesome_project"-  }+{"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":""+                }+ }

@@ -1,7 +1,7 @@ cabal-version: 2.4 name:           gitlab-haskell category:       Git-version:        0.2.3+version:        0.2.4 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/>@@ -10,10 +10,10 @@             .             Run all GitLab actions with `runGitLab`:             .-            > runGitLab :: (MonadUnliftIO m, MonadIO m)+            > runGitLab ::             >  => GitLabServerConfig -- ^ the GitLab server details-            >  -> GitLab m a         -- ^ the GitLab action-            >  -> m a+            >  -> GitLab a           -- ^ the GitLab action+            >  -> IO a             .             For example:             .@@ -25,8 +25,9 @@             .             Which uses the functions:             .-            > searchUser   :: Text -> GitLab m (Maybe User)-            > userProjects :: User -> GitLab m (Maybe [Project])+            > searchUser   :: Text -> GitLab (Maybe User)+            > userProjects :: User -> GitLab (Maybe [Project])+            > projectCommits :: Project -> GitLab [Commit]             .             This library can also be used to develop rule based GitLab file hooks that react in real time to GitLab events with:             .@@ -75,6 +76,7 @@                 , GitLab.API.RepositoryFiles                 , GitLab.API.Todos                 , GitLab.API.Version+                , GitLab.API.Notes                 , GitLab.SystemHooks.Types                 , GitLab.SystemHooks.GitLabSystemHooks                 , GitLab.SystemHooks.Rules@@ -94,6 +96,8 @@               , unliftio               , unliftio-core               , time+              , temporary+              , unix   default-language: Haskell2010   ghc-options: -Wall                -- the following two for the stan static analysis tool

@@ -26,6 +26,7 @@     module GitLab.API.RepositoryFiles,     module GitLab.API.Todos,     module GitLab.API.Version,+    module GitLab.API.Notes,     module GitLab.SystemHooks.GitLabSystemHooks,     module GitLab.SystemHooks.Types,     module GitLab.SystemHooks.Rules,@@ -41,6 +42,7 @@ import GitLab.API.Jobs import GitLab.API.Members import GitLab.API.MergeRequests+import GitLab.API.Notes import GitLab.API.Pipelines import GitLab.API.Projects import GitLab.API.Repositories

@@ -49,7 +49,7 @@   Text ->   -- | level of access granted   AccessLevel ->-  GitLab [Either Status Member]+  GitLab [Either Status (Maybe Member)] addAllUsersToGroup groupName access = do   allRegisteredUsers <- allUsers   let allUserIds = map user_username allRegisteredUsers@@ -63,7 +63,7 @@   AccessLevel ->   -- | the user   User ->-  GitLab (Either Status Member)+  GitLab (Either Status (Maybe Member)) addUserToGroup groupName access usr =   addUserToGroup' groupName access (user_id usr) @@ -75,7 +75,7 @@   AccessLevel ->   -- | user ID   Int ->-  GitLab (Either Status Member)+  GitLab (Either Status (Maybe Member)) addUserToGroup' groupName access userId = do   attempt <- groupsWithNameOrPath groupName   case attempt of@@ -103,7 +103,7 @@   AccessLevel ->   -- | list of usernames to be added to the group   [User] ->-  GitLab [Either Status Member]+  GitLab [Either Status (Maybe Member)] addUsersToGroup groupName access =   mapM (addUserToGroup groupName access) @@ -115,7 +115,7 @@   AccessLevel ->   -- | list of usernames to be added to the group   [Text] ->-  GitLab [Either Status Member]+  GitLab [Either Status (Maybe Member)] addUsersToGroup' groupName access usernames = do   users <- catMaybes <$> mapM searchUser usernames   mapM (addUserToGroup' groupName access . user_id) users

@@ -63,7 +63,7 @@   Text ->   -- | issue description   Text ->-  GitLab (Either Status Issue)+  GitLab (Either Status (Maybe Issue)) newIssue project =   newIssue' (project_id project) @@ -75,7 +75,7 @@   Text ->   -- | issue description   Text ->-  GitLab (Either Status Issue)+  GitLab (Either Status (Maybe Issue)) newIssue' projectId issueTitle issueDescription =   gitlabPost addr dataBody   where

@@ -56,7 +56,7 @@   AccessLevel ->   -- | the user   User ->-  GitLab (Either Status Member)+  GitLab (Either Status (Maybe Member)) addMemberToProject project access usr =   addMemberToProject' (project_id project) access (user_id usr) @@ -70,7 +70,7 @@   AccessLevel ->   -- | user ID   Int ->-  GitLab (Either Status Member)+  GitLab (Either Status (Maybe Member)) addMemberToProject' projectId access userId =   gitlabPost addr dataBody   where@@ -90,7 +90,7 @@   AccessLevel ->   -- | users to add to the project   [User] ->-  GitLab [Either Status Member]+  GitLab [Either Status (Maybe Member)] addMembersToProject project access =   mapM (addMemberToProject project access) @@ -104,6 +104,6 @@   AccessLevel ->   -- | IDs of users to add to the project   [Int] ->-  GitLab [Either Status Member]+  GitLab [Either Status (Maybe Member)] addMembersToProject' projectId access =   mapM (addMemberToProject' projectId access)

@@ -52,7 +52,7 @@   Text ->   -- | merge request description   Text ->-  GitLab (Either Status MergeRequest)+  GitLab (Either Status (Maybe MergeRequest)) createMergeRequest project =   createMergeRequest' (project_id project) @@ -70,7 +70,7 @@   Text ->   -- | merge request description   Text ->-  GitLab (Either Status MergeRequest)+  GitLab (Either Status (Maybe MergeRequest)) createMergeRequest' projectId sourceBranch targetBranch targetProjectId mrTitle mrDescription =   gitlabPost addr dataBody   where@@ -91,7 +91,7 @@   Project ->   -- | merge request IID   Int ->-  GitLab (Either Status MergeRequest)+  GitLab (Either Status (Maybe MergeRequest)) acceptMergeRequest project =   acceptMergeRequest' (project_id project) @@ -101,7 +101,7 @@   Int ->   -- | merge request IID   Int ->-  GitLab (Either Status MergeRequest)+  GitLab (Either Status (Maybe MergeRequest)) acceptMergeRequest' projectId mergeRequestIid = gitlabPost addr dataBody   where     dataBody :: Text@@ -113,3 +113,27 @@         "/projects/" <> show projectId <> "/merge_requests/"           <> show mergeRequestIid           <> "/merge"++-- | Deletes a merge request. Only for admins and project owners.+deleteMergeRequest ::+  -- | project+  Project ->+  -- | merge request IID+  Int ->+  GitLab (Either Status ())+deleteMergeRequest project =+  deleteMergeRequest' (project_id project)++-- | Deletes a merge request. Only for admins and project owners.+deleteMergeRequest' ::+  -- | project ID+  Int ->+  -- | merge request IID+  Int ->+  GitLab (Either Status ())+deleteMergeRequest' projectId mergeRequestIid = gitlabDelete addr+  where+    addr =+      T.pack $+        "/projects/" <> show projectId <> "/merge_requests/"+          <> show mergeRequestIid

@@ -0,0 +1,53 @@+{-# LANGUAGE OverloadedStrings #-}++-- |+-- Module      : Notes+-- Description : Notes on issues, snippets, merge requests and epics.+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2020+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable+module GitLab.API.Notes where++import Data.Text (Text)+import qualified Data.Text as T+import GitLab.Types+import GitLab.WebRequests.GitLabWebCalls+import Network.HTTP.Types.Status++createMergeRequestNote ::+  -- | project+  Project ->+  -- | merge request IID+  Int ->+  -- | the note+  Text ->+  GitLab (Either Status (Maybe ()))+createMergeRequestNote project =+  createMergeRequestNote' (project_id project)++createMergeRequestNote' ::+  -- | project ID+  Int ->+  -- | merge request IID+  Int ->+  -- | the note+  Text ->+  GitLab (Either Status (Maybe ()))+createMergeRequestNote' projectId mergeRequestIID comment =+  gitlabPost addr dataBody+  where+    dataBody :: Text+    dataBody =+      T.pack $+        "id="+          <> show projectId+          <> "&merge_request_iid="+          <> show mergeRequestIID+          <> "&body="+          <> T.unpack comment+    addr =+      T.pack $+        "/projects/" <> show projectId <> "/merge_requests/"+          <> show mergeRequestIID+          <> "/notes"

@@ -226,16 +226,16 @@         <> "/diff/"     ) --- | share a project with a group.-shareProjectWithGroup ::+-- | add a group to a project.+addGroupToProject ::   -- | group ID   Int ->   -- | project ID   Int ->   -- | level of access granted   AccessLevel ->-  GitLab (Either Status GroupShare)-shareProjectWithGroup groupId projectId access =+  GitLab (Either Status (Maybe GroupShare))+addGroupToProject groupId projectId access =   gitlabPost addr dataBody   where     dataBody :: Text

@@ -13,6 +13,7 @@ import Data.List import Data.Maybe import Data.Text (Text)+import qualified Data.Text as T import GitLab.Types import GitLab.WebRequests.GitLabWebCalls @@ -21,6 +22,22 @@ allUsers = do   let path = "/users"   gitlabUnsafe path++-- | searches for a user given a user ID. Returns @Just User@ if the+-- user is found, otherwise @Nothing@.+userId ::+  -- | username to search for+  Int ->+  GitLab (Maybe User)+userId usrId = do+  let path =+        "/users/"+          <> T.pack (show usrId)+  res <- gitlabOne path+  case res of+    Left _err -> return Nothing+    Right Nothing -> return Nothing+    Right (Just user) -> return (Just user)  -- | searches for a user given a username. Returns @Just User@ if the -- user is found, otherwise @Nothing@.

@@ -17,11 +17,15 @@   ) where +import qualified Control.Exception as E import Control.Monad import Control.Monad.IO.Class+import Control.Monad.Trans.Reader import Data.Typeable import GitLab.SystemHooks.Types import GitLab.Types+import System.IO.Temp+import System.Posix.Files  -- | Attempts to fire each rule in sequence. Reads the JSON data -- received from the GitLab server from standard input.@@ -34,7 +38,20 @@ -- received from a function argument. receiveString :: String -> [Rule] -> GitLab () receiveString eventContent rules = do+  traceSystemHook eventContent   mapM_ (fire eventContent) rules++traceSystemHook :: String -> GitLab ()+traceSystemHook eventContent = do+  cfg <- serverCfg <$> ask+  liftIO $+    E.catch+      ( when (debugSystemHooks cfg) $ do+          fpath <- writeSystemTempFile "gitlab-system-hook-" eventContent+          void $ setFileMode fpath otherReadMode+      )+      -- runGitLabDbg must have been used, which doesn't define a GitLabServerConfig+      (\(_exception :: E.ErrorCall) -> return ())  orElse :: GitLab Bool -> GitLab Bool -> GitLab Bool orElse f g = do

@@ -46,6 +46,8 @@     CommitAuthorEvent (..),     Visibility (..),     MergeRequestEvent (..),+    MergeRequestChanges (..),+    MergeRequestChange (..),     ObjectAttributes (..),     MergeParams (..),     UserEvent (..),@@ -582,26 +584,51 @@ -- in GitLab.Types. data MergeRequestEvent = MergeRequestEvent   { mergeRequest_object_kind :: Text,+    mergeRequest_event_type :: Text,     mergeRequest_user :: UserEvent,     mergeRequest_project :: ProjectEvent,     mergeRequest_object_attributes :: ObjectAttributes,-    mergeRequest_labels :: Maybe Text,+    mergeRequest_labels :: Maybe [Text],+    mergeRequest_changes :: MergeRequestChanges,     mergeRequest_repository :: RepositoryEvent   }   deriving (Typeable, Show, Eq, Generic) +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+  }+  deriving (Typeable, Show, Eq, Generic)++data MergeRequestChange a = MergeRequestChange+  { mergeRequestChange_previous :: Maybe a,+    mergeRequestChange_current :: Maybe a+  }+  deriving (Typeable, Show, Eq, Generic)+ data ObjectAttributes = ObjectAttributes   { objectAttributes_id :: Int,     objectAttributes_target_branch :: Text,     objectAttributes_source_branch :: Text,     objectAttributes_source_project_id :: Int,     objectAttributes_author_id :: Int,-    objectAttributes_assignee_id :: Int,+    objectAttributes_assignee_id :: Maybe Int,+    objectAttributes_assignee_ids :: Maybe [Int],     objectAttributes_title :: Text,     objectAttributes_created_at :: Text,     objectAttributes_updated_at :: Text,     objectAttributes_milestone_id :: Maybe Int,     objectAttributes_state :: Text,+    objectAttributes_state_id :: Maybe Int,     objectAttributes_merge_status :: Text,     objectAttributes_target_project_id :: Int,     objectAttributes_iid :: Int,@@ -616,10 +643,10 @@     objectAttributes_in_progress_merge_commit_sha :: Maybe Text,     objectAttributes_lock_version :: Maybe Int,     objectAttributes_time_estimate :: Int,-    objectAttributes_last_edited_at :: Text,-    objectAttributes_last_edited_by_id :: Int,-    objectAttributes_head_pipeline_id :: Int,-    objectAttributes_ref_fetched :: Bool,+    objectAttributes_last_edited_at :: Maybe Text,+    objectAttributes_last_edited_by_id :: Maybe Int,+    objectAttributes_head_pipeline_id :: Maybe Int,+    objectAttributes_ref_fetched :: Maybe Bool,     objectAttributes_merge_jid :: Maybe Int,     objectAttributes_source :: ProjectEvent,     objectAttributes_target :: ProjectEvent,@@ -627,12 +654,13 @@     objectAttributes_work_in_progress :: Bool,     objectAttributes_total_time_spent :: Int,     objectAttributes_human_total_time_spent :: Maybe Int,-    objectAttributes_human_time_estimate :: Maybe Int+    objectAttributes_human_time_estimate :: Maybe Int,+    objectAttributes_action :: Maybe Text   }   deriving (Typeable, Show, Eq, Generic)  data MergeParams = MergeParams-  { mergeParams_force_remove_source_branch :: Text+  { mergeParams_force_remove_source_branch :: Maybe Text   }   deriving (Typeable, Show, Eq, Generic) @@ -1185,7 +1213,11 @@ instance FromJSON MergeRequestEvent where   parseJSON =     withObject "MergeRequestEvent" $ \v -> do-      -- Note: it's `event_name` in all other examples.+      -- Note: it's `event_name` in all other examples, but the GitLab+      -- documentation for MergeRequests says `object_kind`.+      --+      -- `object_kind` has been tried.+      --       -- Bug in GitLab system hooks documentation?       isProjectEvent <- v .:? "object_kind"       case isProjectEvent of@@ -1194,10 +1226,12 @@             MergeRequested ->               MergeRequestEvent                 <$> v .: "object_kind"+                <*> v .: "event_type"                 <*> v .: "user"                 <*> v .: "project"                 <*> v .: "object_attributes"                 <*> v .: "labels"+                <*> v .: "changes"                 <*> v .: "repository"             _unexpected -> fail "merge_request parsing failed"         _unexpected -> fail "merge_request parsing failed"@@ -1245,11 +1279,13 @@ bodyNoPrefix "objectAttributes_source_project_id" = "source_project_id" bodyNoPrefix "objectAttributes_author_id" = "author_id" bodyNoPrefix "objectAttributes_assignee_id" = "assignee_id"+bodyNoPrefix "objectAttributes_assignee_ids" = "assignee_ids" bodyNoPrefix "objectAttributes_title" = "title" bodyNoPrefix "objectAttributes_created_at" = "created_at" bodyNoPrefix "objectAttributes_updated_at" = "updated_at" bodyNoPrefix "objectAttributes_milestone_id" = "milestone_id" bodyNoPrefix "objectAttributes_state" = "state"+bodyNoPrefix "objectAttributes_state_id" = "state_id" bodyNoPrefix "objectAttributes_merge_status" = "merge_status" bodyNoPrefix "objectAttributes_target_project_id" = "target_project_id" bodyNoPrefix "objectAttributes_iid" = "iid"@@ -1276,6 +1312,20 @@ bodyNoPrefix "objectAttributes_total_time_spent" = "total_time_spent" bodyNoPrefix "objectAttributes_human_total_time_spent" = "human_total_time_spent" bodyNoPrefix "objectAttributes_human_time_estimate" = "human_time_estimate"+bodyNoPrefix "objectAttributes_action" = "action"+bodyNoPrefix "mergeRequestChanges_author_id" = "author_id"+bodyNoPrefix "mergeRequestChanges_created_at" = "created_at"+bodyNoPrefix "mergeRequestChanges_description" = "description"+bodyNoPrefix "mergeRequestChanges_id" = "id"+bodyNoPrefix "mergeRequestChanges_iid" = "iid"+bodyNoPrefix "mergeRequestChanges_source_branch" = "source_branch"+bodyNoPrefix "mergeRequestChanges_source_project_id" = "source_project_id"+bodyNoPrefix "mergeRequestChanges_target_branch" = "target_branch"+bodyNoPrefix "mergeRequestChanges_target_project_id" = "target_project_id"+bodyNoPrefix "mergeRequestChanges_title" = "title"+bodyNoPrefix "mergeRequestChanges_updated_at" = "updated_at"+bodyNoPrefix "mergeRequestChange_previous" = "previous"+bodyNoPrefix "mergeRequestChange_current" = "current" bodyNoPrefix s = error ("uexpected JSON field prefix: " <> s)  instance FromJSON ProjectEvent where@@ -1335,6 +1385,22 @@       )  instance FromJSON UserEvent where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON MergeRequestChanges where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance (FromJSON a) => FromJSON (MergeRequestChange a) where   parseJSON =     genericParseJSON       ( defaultOptions

@@ -81,7 +81,10 @@     -- | milliseconds     timeout :: Int,     -- | how many times to retry a HTTP request before giving up and returning an error.-    retries :: Int+    retries :: Int,+    -- | write system hook events to files in the system temporary+    -- directory.+    debugSystemHooks :: Bool   }  -- | default settings, the 'url' and 'token' values will need to be overwritten.@@ -91,7 +94,8 @@     { url = "https://gitlab.com",       token = "",       timeout = 15000000, -- 15 seconds-      retries = 5+      retries = 5,+      debugSystemHooks = False     }  -- https://docs.gitlab.com/ee/api/repositories.html#get-file-archive@@ -154,7 +158,7 @@ -- | links. data Links = Links   { self :: Text,-    issues :: Text,+    issues :: Maybe Text,     merge_requests :: Text,     repo_branches :: Text,     link_labels :: Text,

@@ -14,6 +14,7 @@     -- gitlabWithAttrsOneUnsafe,     gitlabPost,     gitlabPut,+    gitlabDelete,     gitlabReqText,     gitlabReqByteString,   )@@ -23,6 +24,7 @@ import Control.Monad.IO.Class import Control.Monad.Trans.Reader import Data.Aeson+import qualified Data.ByteString as BS import qualified Data.ByteString.Lazy as BSL import Data.ByteString.Lazy.Char8 as C import Data.Either@@ -49,7 +51,7 @@   Text ->   -- | the data to post   Text ->-  GitLab (Either Status b)+  GitLab (Either Status (Maybe b)) gitlabPost urlPath dataBody = do   cfg <- serverCfg <$> ask   manager <- httpManager <$> ask@@ -67,10 +69,11 @@     then       return         ( case parseBSOne (responseBody resp) of-            Just x -> Right x-            Nothing ->-              Left $-                mkStatus 409 "unable to parse POST response"+            Just x -> Right (Just x)+            Nothing -> Right Nothing+            -- Nothing ->+            --   Left $+            --     mkStatus 409 "unable to parse POST response"         )     else return (Left (responseStatus resp)) @@ -105,6 +108,29 @@               Left $                 mkStatus 409 "unable to parse PUT response"         )+    else return (Left (responseStatus resp))++gitlabDelete ::+  -- | the URL to post to+  Text ->+  GitLab (Either Status ())+gitlabDelete urlPath = do+  cfg <- serverCfg <$> ask+  manager <- httpManager <$> ask+  let url' = url cfg <> "/api/v4" <> urlPath+  let request' = parseRequest_ (T.unpack url')+      request =+        request'+          { method = "DELETE",+            requestHeaders =+              [ ("PRIVATE-TOKEN", T.encodeUtf8 (token cfg)),+                ("content-type", "application/json")+              ],+            requestBody = RequestBodyBS BS.empty+          }+  resp <- liftIO $ tryGitLab 0 request (retries cfg) manager Nothing+  if successStatus (responseStatus resp)+    then return (Right ())     else return (Left (responseStatus resp))  tryGitLab ::

@@ -1108,7 +1108,7 @@   matchIf     "mergeRequest rule-if yes"     ( \event@MergeRequestEvent {} -> do-        return (userEvent_name (mergeRequest_user event) == "Administrator")+        return (userEvent_name (mergeRequest_user event) == "Rob")     )     ( \MergeRequestEvent {} -> do         return ()@@ -1473,9 +1473,11 @@ mergeRequestHaskell =   MergeRequestEvent     { mergeRequest_object_kind = "merge_request",-      mergeRequest_user = UserEvent {userEvent_name = "Administrator", userEvent_username = "root", userEvent_avatar_url = "http://www.gravatar.com/avatar/e64c7d89f26bd1972efa854d13d7dd61?s=80&d=identicon"},-      mergeRequest_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"},-      mergeRequest_object_attributes = ObjectAttributes {objectAttributes_id = 90, objectAttributes_target_branch = "master", objectAttributes_source_branch = "ms-viewport", objectAttributes_source_project_id = 14, objectAttributes_author_id = 51, objectAttributes_assignee_id = 6, objectAttributes_title = "MS-Viewport", objectAttributes_created_at = "2017-09-20T08:31:45.944Z", objectAttributes_updated_at = "2017-09-28T12:23:42.365Z", objectAttributes_milestone_id = Nothing, objectAttributes_state = "opened", objectAttributes_merge_status = "unchecked", objectAttributes_target_project_id = 14, objectAttributes_iid = 1, objectAttributes_description = "", objectAttributes_updated_by_id = Just 1, objectAttributes_merge_error = Nothing, objectAttributes_merge_params = MergeParams {mergeParams_force_remove_source_branch = "0"}, 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 = Just 5, objectAttributes_time_estimate = 0, objectAttributes_last_edited_at = "2017-09-27T12:43:37.558Z", objectAttributes_last_edited_by_id = 1, objectAttributes_head_pipeline_id = 61, objectAttributes_ref_fetched = True, objectAttributes_merge_jid = Nothing, objectAttributes_source = ProjectEvent {projectEvent_name = "Awesome Project", projectEvent_description = "", 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 = "root", projectEvent_visibility_level = Private, 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 = Private, 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 = "ba3e0d8ff79c80d5b0bbb4f3e2e343e0aaa662b7", commitEvent_message = "fixed readme", commitEvent_timestamp = "2017-09-26T16:12:57Z", 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 = 0, objectAttributes_human_total_time_spent = Nothing, objectAttributes_human_time_estimate = Nothing},-      mergeRequest_labels = Nothing,-      mergeRequest_repository = RepositoryEvent {repositoryEvent_name = "git-gpg-test", repositoryEvent_url = "git@example.com:awesome_space/awesome_project.git", repositoryEvent_description = "", repositoryEvent_homepage = Just "http://example.com/awesome_space/awesome_project", repositoryEvent_git_http_url = Nothing, repositoryEvent_git_ssh_url = Nothing, repositoryEvent_visibility_level = Nothing}+      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}     }