diff --git a/data/system-hooks/repository-update.json b/data/system-hooks/repository-update.json --- a/data/system-hooks/repository-update.json +++ b/data/system-hooks/repository-update.json @@ -1,32 +1,32 @@ { - "event_name": "repository_update", - "user_id": 1, - "user_name": "John Smith", - "user_email": "admin@example.com", - "user_avatar": "https://s.gravatar.com/avatar/d4c74594d841139328695756648b6bd6?s=8://s.gravatar.com/avatar/d4c74594d841139328695756648b6bd6?s=80", - "project_id": 1, - "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", - "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", - }, - "changes": [ - { - "before":"8205ea8d81ce0c6b90fbe8280d118cc9fdad6130", - "after":"4045ea7a3df38697b3730a20fb73c8bed8a3e69e", - "ref":"refs/heads/master" - } - ], - "refs":["refs/heads/master"] + "event_name": "repository_update", + "user_id": 1, + "user_name": "John Smith", + "user_email": "admin@example.com", + "user_avatar": "https://s.gravatar.com/avatar/d4c74594d841139328695756648b6bd6?s=8://s.gravatar.com/avatar/d4c74594d841139328695756648b6bd6?s=80", + "project_id": 1, + "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", + "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" + }, + "changes": [ + { + "before":"8205ea8d81ce0c6b90fbe8280d118cc9fdad6130", + "after":"4045ea7a3df38697b3730a20fb73c8bed8a3e69e", + "ref":"refs/heads/master" + } + ], + "refs":["refs/heads/master"] } diff --git a/gitlab-haskell.cabal b/gitlab-haskell.cabal --- a/gitlab-haskell.cabal +++ b/gitlab-haskell.cabal @@ -1,7 +1,7 @@ cabal-version: 2.4 name: gitlab-haskell category: Git -version: 0.2.2 +version: 0.2.3 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: @@ -77,6 +77,7 @@ , GitLab.API.Version , GitLab.SystemHooks.Types , GitLab.SystemHooks.GitLabSystemHooks + , GitLab.SystemHooks.Rules other-modules: GitLab.WebRequests.GitLabWebCalls hs-source-dirs: diff --git a/src/GitLab.hs b/src/GitLab.hs --- a/src/GitLab.hs +++ b/src/GitLab.hs @@ -28,6 +28,7 @@ module GitLab.API.Version, module GitLab.SystemHooks.GitLabSystemHooks, module GitLab.SystemHooks.Types, + module GitLab.SystemHooks.Rules, ) where @@ -48,6 +49,7 @@ import GitLab.API.Users import GitLab.API.Version import GitLab.SystemHooks.GitLabSystemHooks +import GitLab.SystemHooks.Rules import GitLab.SystemHooks.Types import GitLab.Types import Network.Connection (TLSSettings (..)) 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 @@ -149,6 +149,14 @@ (Just (\_ -> return True)) (cast f :: Maybe (TagPush -> GitLab ())) (parseEvent contents :: Maybe TagPush) + `orElse` fireIf' + (Just (\_ -> return True)) + (cast f :: Maybe (RepositoryUpdate -> GitLab ())) + (parseEvent contents :: Maybe RepositoryUpdate) + `orElse` fireIf' + (Just (\_ -> return True)) + (cast f :: Maybe (MergeRequestEvent -> GitLab ())) + (parseEvent contents :: Maybe MergeRequestEvent) tryFire contents (MatchIf _ predF f) = do fireIf' (cast predF :: Maybe (ProjectCreate -> GitLab Bool)) @@ -242,6 +250,14 @@ (cast predF :: Maybe (TagPush -> GitLab Bool)) (cast f :: Maybe (TagPush -> GitLab ())) (parseEvent contents :: Maybe TagPush) + `orElse` fireIf' + (cast predF :: Maybe (RepositoryUpdate -> GitLab Bool)) + (cast f :: Maybe (RepositoryUpdate -> GitLab ())) + (parseEvent contents :: Maybe RepositoryUpdate) + `orElse` fireIf' + (cast predF :: Maybe (MergeRequestEvent -> GitLab Bool)) + (cast f :: Maybe (MergeRequestEvent -> GitLab ())) + (parseEvent contents :: Maybe MergeRequestEvent) fireIf' :: (Typeable a, Show a) => Maybe (a -> GitLab Bool) -> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool fireIf' castPred castF parsed = do diff --git a/src/GitLab/SystemHooks/Rules.hs b/src/GitLab/SystemHooks/Rules.hs new file mode 100644 --- /dev/null +++ b/src/GitLab/SystemHooks/Rules.hs @@ -0,0 +1,81 @@ +{-# LANGUAGE OverloadedStrings #-} + +-- | +-- Module : GitLab.SystemHooks.Rules +-- Description : Common GitLab system hook rules +-- Copyright : (c) Rob Stewart, Heriot-Watt University, 2020 +-- License : BSD3 +-- Maintainer : robstewart57@gmail.com +-- Stability : stable +module GitLab.SystemHooks.Rules (ruleAddMembers, ruleAddNewUserToGroups) where + +import Control.Monad +import Data.Text +import GitLab.API.Groups +import GitLab.API.Members +import GitLab.API.Projects +import GitLab.API.Users +import GitLab.SystemHooks.Types +import GitLab.Types + +ruleAddNewUserToGroups :: + -- | rule label + String -> + -- | list of (non registered) usernames + [Text] -> + -- | list of groups to add new user to + [Text] -> + Rule +ruleAddNewUserToGroups lbl nonRegisteredUsernames groupNames = + matchIf + lbl + ( \event@UserCreate {} -> do + return (userCreate_username event `elem` nonRegisteredUsernames) + ) + ( \event@UserCreate {} -> do + mapM_ + ( \groupName -> + -- will return value of type `Left Status` if user already + -- member of the group, `void` silently ignores any outcome. + addUserToGroup' groupName Reporter (userCreate_user_id event) + ) + groupNames + ) + +ruleAddMembers :: + -- | rule label + String -> + -- | project names to match on + [Text] -> + -- | user names to add as member of matched project + [Text] -> + Rule +ruleAddMembers label projectNames userNames = + matchIf + label + ( \event@ProjectCreate {} -> do + request <- searchProjectId (projectCreate_project_id event) + case request of + Left _ -> return False + Right Nothing -> return False + Right (Just prj) -> + return + ( project_path prj + `elem` projectNames + ) + ) + ( \event@ProjectCreate {} -> do + mapM_ + ( \userName -> do + request <- searchUser userName + case request of + Nothing -> return () + Just foundUser -> + void $ + addMemberToProject' + (projectCreate_project_id event) + Reporter + (user_id foundUser) + ) + userNames + ) 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 @@ -21,6 +21,7 @@ ProjectRename (..), ProjectTransfer (..), ProjectUpdate (..), + ProjectChanges (..), UserAddToTeam (..), UserUpdateForTeam (..), UserRemoveFromTeam (..), @@ -40,9 +41,14 @@ TagPush (..), ProjectEvent (..), RepositoryEvent (..), + RepositoryUpdate (..), CommitEvent (..), CommitAuthorEvent (..), Visibility (..), + MergeRequestEvent (..), + ObjectAttributes (..), + MergeParams (..), + UserEvent (..), parseEvent, ) where @@ -490,6 +496,24 @@ } deriving (Typeable, Show, Eq) +instance SystemHook RepositoryUpdate where + match = Match + matchIf = MatchIf + +-- | Tags have been pushed to the server. +data RepositoryUpdate = RepositoryUpdate + { repositoryUpdate_event_name :: Text, + repositoryUpdate_user_id :: Int, + repositoryUpdate_user_name :: Text, + repositoryUpdate_user_email :: Text, + repositoryUpdate_user_avatar :: Text, + repositoryUpdate_project_id :: Int, + repositoryUpdate_project :: ProjectEvent, + repositoryUpdate_changes :: [ProjectChanges], + repositoryUpdate_refs :: [Text] + } + deriving (Typeable, Show, Eq) + -- | A project event. data ProjectEvent = ProjectEvent { projectEvent_name :: Text, @@ -510,15 +534,26 @@ } deriving (Typeable, Show, Eq, Generic) +-- | A project event. +data ProjectChanges = ProjectChanges + { projectChanges_before :: Text, + projectChanges_after :: Text, + projectChanges_ref :: Text + } + deriving (Typeable, Show, Eq, Generic) + -- | A repository event. data RepositoryEvent = RepositoryEvent { repositoryEvent_name :: Text, repositoryEvent_url :: Text, repositoryEvent_description :: Text, repositoryEvent_homepage :: Maybe Text, - repositoryEvent_git_http_url :: Text, - repositoryEvent_git_ssh_url :: Text, - repositoryEvent_visibility_level :: Visibility + -- these three not in the merge_request event example + -- in the GitLab documentation. Is the merge_request documentation + -- out dated? + repositoryEvent_git_http_url :: Maybe Text, + repositoryEvent_git_ssh_url :: Maybe Text, + repositoryEvent_visibility_level :: Maybe Visibility } deriving (Typeable, Show, Eq, Generic) @@ -539,6 +574,75 @@ } deriving (Typeable, Show, Eq, Generic) +instance SystemHook MergeRequestEvent where + match = Match + matchIf = MatchIf + +-- | Merge request (named so, since 'MergeRequest' type already used +-- in GitLab.Types. +data MergeRequestEvent = MergeRequestEvent + { mergeRequest_object_kind :: Text, + mergeRequest_user :: UserEvent, + mergeRequest_project :: ProjectEvent, + mergeRequest_object_attributes :: ObjectAttributes, + mergeRequest_labels :: Maybe Text, + mergeRequest_repository :: RepositoryEvent + } + 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_title :: Text, + objectAttributes_created_at :: Text, + objectAttributes_updated_at :: Text, + objectAttributes_milestone_id :: Maybe Int, + objectAttributes_state :: Text, + objectAttributes_merge_status :: Text, + objectAttributes_target_project_id :: Int, + objectAttributes_iid :: Int, + objectAttributes_description :: Text, + objectAttributes_updated_by_id :: Maybe Int, + objectAttributes_merge_error :: Maybe Text, + objectAttributes_merge_params :: MergeParams, + objectAttributes_merge_when_pipeline_succeeds :: Bool, + objectAttributes_merge_user_id :: Maybe Int, + objectAttributes_merge_commit_sha :: Maybe Text, + objectAttributes_deleted_at :: Maybe Text, + objectAttributes_in_progress_merge_commit_sha :: Maybe Text, + objectAttributes_lock_version :: Maybe Int, + objectAttributes_time_estimate :: Int, + objectAttributes_last_edited_at :: Text, + objectAttributes_last_edited_by_id :: Int, + objectAttributes_head_pipeline_id :: Int, + objectAttributes_ref_fetched :: Bool, + objectAttributes_merge_jid :: Maybe Int, + objectAttributes_source :: ProjectEvent, + objectAttributes_target :: ProjectEvent, + objectAttributes_last_commit :: CommitEvent, + objectAttributes_work_in_progress :: Bool, + objectAttributes_total_time_spent :: Int, + objectAttributes_human_total_time_spent :: Maybe Int, + objectAttributes_human_time_estimate :: Maybe Int + } + deriving (Typeable, Show, Eq, Generic) + +data MergeParams = MergeParams + { mergeParams_force_remove_source_branch :: Text + } + deriving (Typeable, Show, Eq, Generic) + +data UserEvent = UserEvent + { userEvent_name :: Text, + userEvent_username :: Text, + userEvent_avatar_url :: Text + } + deriving (Typeable, Show, Eq, Generic) + data ProjectAction = ProjectCreated | ProjectDestroyed @@ -562,6 +666,8 @@ | GroupMemberUpdated | Pushed | TagPushed + | RepositoryUpdated + | MergeRequested deriving (Show, Eq) -- | Project visibility. @@ -1032,7 +1138,7 @@ instance FromJSON TagPush where parseJSON = - withObject "Push" $ \v -> do + withObject "TagPush" $ \v -> do isProjectEvent <- v .:? "event_name" case isProjectEvent of Just theEvent -> @@ -1055,6 +1161,47 @@ _unexpected -> fail "tag_push parsing failed" _unexpected -> fail "tag_push parsing failed" +instance FromJSON RepositoryUpdate where + parseJSON = + withObject "RepositoryUpdate" $ \v -> do + isProjectEvent <- v .:? "event_name" + case isProjectEvent of + Just theEvent -> + case theEvent of + RepositoryUpdated -> + RepositoryUpdate + <$> v .: "event_name" + <*> v .: "user_id" + <*> v .: "user_name" + <*> v .: "user_email" + <*> v .: "user_avatar" + <*> v .: "project_id" + <*> v .: "project" + <*> v .: "changes" + <*> v .: "refs" + _unexpected -> fail "repository_update parsing failed" + _unexpected -> fail "repository_update parsing failed" + +instance FromJSON MergeRequestEvent where + parseJSON = + withObject "MergeRequestEvent" $ \v -> do + -- Note: it's `event_name` in all other examples. + -- Bug in GitLab system hooks documentation? + isProjectEvent <- v .:? "object_kind" + case isProjectEvent of + Just theEvent -> + case theEvent of + MergeRequested -> + MergeRequestEvent + <$> v .: "object_kind" + <*> v .: "user" + <*> v .: "project" + <*> v .: "object_attributes" + <*> v .: "labels" + <*> v .: "repository" + _unexpected -> fail "merge_request parsing failed" + _unexpected -> fail "merge_request parsing failed" + bodyNoPrefix :: String -> String bodyNoPrefix "projectEvent_name" = "name" bodyNoPrefix "projectEvent_description" = "description" @@ -1071,6 +1218,9 @@ bodyNoPrefix "projectEvent_url" = "url" bodyNoPrefix "projectEvent_ssh_url" = "ssh_url" bodyNoPrefix "projectEvent_http_url" = "http_url" +bodyNoPrefix "projectChanges_before" = "before" +bodyNoPrefix "projectChanges_after" = "after" +bodyNoPrefix "projectChanges_ref" = "ref" bodyNoPrefix "repositoryEvent_name" = "name" bodyNoPrefix "repositoryEvent_url" = "url" bodyNoPrefix "repositoryEvent_description" = "description" @@ -1085,7 +1235,48 @@ bodyNoPrefix "commitEvent_author" = "author" bodyNoPrefix "commitAuthorEvent_name" = "name" bodyNoPrefix "commitAuthorEvent_email" = "email" -bodyNoPrefix s = error s +bodyNoPrefix "mergeParams_force_remove_source_branch" = "force_remove_source_branch" +bodyNoPrefix "userEvent_name" = "name" +bodyNoPrefix "userEvent_username" = "username" +bodyNoPrefix "userEvent_avatar_url" = "avatar_url" +bodyNoPrefix "objectAttributes_id" = "id" +bodyNoPrefix "objectAttributes_target_branch" = "target_branch" +bodyNoPrefix "objectAttributes_source_branch" = "source_branch" +bodyNoPrefix "objectAttributes_source_project_id" = "source_project_id" +bodyNoPrefix "objectAttributes_author_id" = "author_id" +bodyNoPrefix "objectAttributes_assignee_id" = "assignee_id" +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_merge_status" = "merge_status" +bodyNoPrefix "objectAttributes_target_project_id" = "target_project_id" +bodyNoPrefix "objectAttributes_iid" = "iid" +bodyNoPrefix "objectAttributes_description" = "description" +bodyNoPrefix "objectAttributes_updated_by_id" = "updated_by_id" +bodyNoPrefix "objectAttributes_merge_error" = "merge_error" +bodyNoPrefix "objectAttributes_merge_params" = "merge_params" +bodyNoPrefix "objectAttributes_merge_when_pipeline_succeeds" = "merge_when_pipeline_succeeds" +bodyNoPrefix "objectAttributes_merge_user_id" = "merge_user_id" +bodyNoPrefix "objectAttributes_merge_commit_sha" = "merge_commit_sha" +bodyNoPrefix "objectAttributes_deleted_at" = "deleted_at" +bodyNoPrefix "objectAttributes_in_progress_merge_commit_sha" = "in_progress_merge_commit_sha" +bodyNoPrefix "objectAttributes_lock_version" = "lock_version" +bodyNoPrefix "objectAttributes_time_estimate" = "time_estimate" +bodyNoPrefix "objectAttributes_last_edited_at" = "last_edited_at" +bodyNoPrefix "objectAttributes_last_edited_by_id" = "last_edited_by_id" +bodyNoPrefix "objectAttributes_head_pipeline_id" = "head_pipeline_id" +bodyNoPrefix "objectAttributes_ref_fetched" = "ref_fetched" +bodyNoPrefix "objectAttributes_merge_jid" = "merge_jid" +bodyNoPrefix "objectAttributes_source" = "source" +bodyNoPrefix "objectAttributes_target" = "target" +bodyNoPrefix "objectAttributes_last_commit" = "last_commit" +bodyNoPrefix "objectAttributes_work_in_progress" = "work_in_progress" +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 s = error ("uexpected JSON field prefix: " <> s) instance FromJSON ProjectEvent where parseJSON = @@ -1095,6 +1286,14 @@ } ) +instance FromJSON ProjectChanges where + parseJSON = + genericParseJSON + ( defaultOptions + { fieldLabelModifier = bodyNoPrefix + } + ) + instance FromJSON CommitEvent where parseJSON = genericParseJSON @@ -1119,6 +1318,30 @@ } ) +instance FromJSON ObjectAttributes where + parseJSON = + genericParseJSON + ( defaultOptions + { fieldLabelModifier = bodyNoPrefix + } + ) + +instance FromJSON MergeParams where + parseJSON = + genericParseJSON + ( defaultOptions + { fieldLabelModifier = bodyNoPrefix + } + ) + +instance FromJSON UserEvent where + parseJSON = + genericParseJSON + ( defaultOptions + { fieldLabelModifier = bodyNoPrefix + } + ) + instance FromJSON ProjectAction where parseJSON (String "project_create") = return ProjectCreated parseJSON (String "project_destroy") = return ProjectDestroyed @@ -1142,7 +1365,9 @@ parseJSON (String "user_update_for_group") = return GroupMemberUpdated parseJSON (String "push") = return Pushed parseJSON (String "tag_push") = return TagPushed - parseJSON s = error (show s) + parseJSON (String "repository_update") = return RepositoryUpdated + parseJSON (String "merge_request") = return MergeRequested + parseJSON s = error ("unexpected system hook event: " <> show s) instance FromJSON Visibility where parseJSON (String "public") = return Public diff --git a/tests/SystemHookTests.hs b/tests/SystemHookTests.hs --- a/tests/SystemHookTests.hs +++ b/tests/SystemHookTests.hs @@ -129,17 +129,17 @@ "tag-push-event" ( readFile "data/system-hooks/tag-push.json" >>= \eventJson -> parseEvent eventJson @?= Just tagPushHaskell + ), + testCase + "merge-request-event" + ( readFile "data/system-hooks/merge-request.json" + >>= \eventJson -> parseEvent eventJson @?= Just mergeRequestHaskell + ), + testCase + "repository-update-event" + ( readFile "data/system-hooks/repository-update.json" + >>= \eventJson -> parseEvent eventJson @?= Just repositoryUpdateHaskell ) - -- testCase - -- "merge-request-event" - -- ( readFile "data/system-hooks/merge-request.json" - -- >>= \eventJson -> parseEvent eventJson @?= Just mergeRequestHaskell - -- ), - -- testCase - -- "repository-update-event" - -- ( readFile "data/system-hooks/repository-update.json" - -- >>= \eventJson -> parseEvent eventJson @?= Just repositoryUpdateHaskell - -- ) ] matchTest :: String -> String -> Rule -> String -> Rule -> [TestTree] @@ -173,14 +173,14 @@ ( liftIO (readFile ("data/system-hooks/" <> jsonFilename)) >>= \eventJson -> tryFire eventJson yesFire ) - @? "project-create-fireIf-yes failed", + @? (lbl <> "-fireIf-yes failed"), testCase (lbl <> "-no") $ not <$> runGitLabDbg ( liftIO (readFile ("data/system-hooks/" <> jsonFilename)) >>= \eventJson -> tryFire eventJson noFire ) - @? "project-create-fireIf-no failed" + @? (lbl <> "-fireIf-no failed") ] -- [ testCase lbl $ @@ -230,6 +230,8 @@ <> matchTest "group-member-update" "group-member-updated.json" groupMemberUpdateRule "project-created.json" projectCreateRule <> matchTest "push" "push.json" pushRule "project-created.json" projectCreateRule <> matchTest "tag-push" "tag-push.json" tagPushRule "project-created.json" projectCreateRule + <> matchTest "repository-update" "repository-update.json" repositoryUpdateRule "project-created.json" projectCreateRule + <> matchTest "merge-request" "merge-request.json" mergeRequestRule "project-created.json" projectCreateRule matchIfTests :: TestTree matchIfTests = @@ -256,35 +258,37 @@ <> matchIfTest "group-member-update" "group-member-updated.json" groupMemberUpdateIfRuleYes groupMemberUpdateIfRuleNo <> matchIfTest "push" "push.json" pushIfRuleYes pushIfRuleNo <> matchIfTest "tag-push" "tag-push.json" tagPushIfRuleYes tagPushIfRuleNo + <> matchIfTest "repository-update" "repository-update.json" repositoryUpdateIfRuleYes repositoryUpdateIfRuleNo + <> matchIfTest "merge-request" "merge-request.json" mergeRequestIfRuleYes mergeRequestIfRuleNo receiveTests :: TestTree receiveTests = testGroup "GitLab system hooks receive" - [ testCase "1-rule-match" - $ runGitLabDbg - $ liftIO (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") - >>= \eventJson -> - receiveString - eventJson - [projectRenameRule], + [ testCase "1-rule-match" $ + runGitLabDbg $ + liftIO (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") + >>= \eventJson -> + receiveString + eventJson + [projectRenameRule], testCase "2-rules" - $ runGitLabDbg - $ liftIO (readFile "data/system-hooks/project-created.json") - >>= \eventJson -> - receiveString - eventJson - [ projectCreateRule, - projectDestroyRule - ] + $ runGitLabDbg $ + liftIO (readFile "data/system-hooks/project-created.json") + >>= \eventJson -> + receiveString + eventJson + [ projectCreateRule, + projectDestroyRule + ] ] projectCreateRule :: Rule @@ -1061,6 +1065,66 @@ return () ) +repositoryUpdateRule :: Rule +repositoryUpdateRule = + match + "repositoryUpdate rule" + ( \RepositoryUpdate {} -> do + return () + ) + +repositoryUpdateIfRuleYes :: Rule +repositoryUpdateIfRuleYes = + matchIf + "repositoryUpdate rule-if yes" + ( \event@RepositoryUpdate {} -> do + return (repositoryUpdate_refs event == ["refs/heads/master"]) + ) + ( \RepositoryUpdate {} -> do + return () + ) + +repositoryUpdateIfRuleNo :: Rule +repositoryUpdateIfRuleNo = + matchIf + "repositoryUpdate rule-if no" + ( \event@RepositoryUpdate {} -> do + return (repositoryUpdate_refs event == ["refs/heads/branch-1"]) + ) + ( \RepositoryUpdate {} -> do + return () + ) + +mergeRequestRule :: Rule +mergeRequestRule = + match + "mergeRequest rule" + ( \MergeRequestEvent {} -> do + return () + ) + +mergeRequestIfRuleYes :: Rule +mergeRequestIfRuleYes = + matchIf + "mergeRequest rule-if yes" + ( \event@MergeRequestEvent {} -> do + return (userEvent_name (mergeRequest_user event) == "Administrator") + ) + ( \MergeRequestEvent {} -> do + return () + ) + +mergeRequestIfRuleNo :: Rule +mergeRequestIfRuleNo = + matchIf + "mergeRequest rule-if no" + ( \event@MergeRequestEvent {} -> do + return (userEvent_name (mergeRequest_user event) == "joe") + ) + ( \MergeRequestEvent {} -> do + return () + ) + projectCreatedHaskell :: ProjectCreate projectCreatedHaskell = ProjectCreate @@ -1368,7 +1432,7 @@ 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 = "http://example.com/mike/diaspora.git", repositoryEvent_git_ssh_url = "git@example.com:mike/diaspora.git", repositoryEvent_visibility_level = Private}, + 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_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 } @@ -1386,7 +1450,32 @@ 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 = "http://example.com/jsmith/example.git", repositoryEvent_git_ssh_url = "git@example.com:jsmith/example.git", repositoryEvent_visibility_level = Private}, + 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_commits = [], tagPush_total_commits_count = 0 + } + +repositoryUpdateHaskell :: RepositoryUpdate +repositoryUpdateHaskell = + RepositoryUpdate + { repositoryUpdate_event_name = "repository_update", + repositoryUpdate_user_id = 1, + repositoryUpdate_user_name = "John Smith", + 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_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_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} }