gitlab-haskell 0.1.8 → 0.2

raw patch · 22 files changed

+3509/−547 lines, 22 filesdep +gitlab-haskelldep +tastydep +tasty-hunitdep ~aesondep ~basePVP ok

version bump matches the API change (PVP)

Dependencies added: gitlab-haskell, tasty, tasty-hunit

Dependency ranges changed: aeson, base

API changes (from Hackage documentation)

Files

• gitlab-haskell.cabal +32/−2
• src/GitLab.hs +16/−6
• src/GitLab/API/Branches.hs +2/−3
• src/GitLab/API/Commits.hs +4/−9
• src/GitLab/API/Groups.hs +8/−17
• src/GitLab/API/Issues.hs +61/−8
• src/GitLab/API/Jobs.hs +2/−5
• src/GitLab/API/Members.hs +6/−11
• src/GitLab/API/MergeRequests.hs +6/−13
• src/GitLab/API/Pipelines.hs +2/−5
• src/GitLab/API/Projects.hs +24/−37
• src/GitLab/API/Repositories.hs +6/−12
• src/GitLab/API/RepositoryFiles.hs +3/−7
• src/GitLab/API/Todos.hs +1/−2
• src/GitLab/API/Users.hs +6/−9
• src/GitLab/API/Version.hs +2/−2
• src/GitLab/SystemHooks/GitLabSystemHooks.hs +262/−0
• src/GitLab/SystemHooks/Types.hs +1154/−0
• src/GitLab/Types.hs +414/−384
• src/GitLab/WebRequests/GitLabWebCalls.hs +90/−15
• tests/SystemHookTests.hs +1392/−0
• tests/Tests.hs +16/−0

@@ -1,11 +1,13 @@ cabal-version: 2.4 name:           gitlab-haskell category:       Git-version:        0.1.8+version:        0.2 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/>             .+            It also features an API for writing Gitlab file hook applications+            .             Run all GitLab actions with `runGitLab`:             .             > runGitLab :: (MonadUnliftIO m, MonadIO m)@@ -26,6 +28,16 @@             > searchUser   :: Text -> GitLab m (Maybe User)             > userProjects :: User -> GitLab m (Maybe [Project])             .+            This library can also be used to develop rule based GitLab file hooks that react in real time to GitLab events with:+            .+            > 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 hooks support: <https://www.macs.hw.ac.uk/~rs46/posts/2020-06-06-gitlab-system-hooks.html>+            .             Unsurprisingly, this library is maintained on GitLab: <https://gitlab.com/robstewart57/gitlab-haskell>  @@ -33,7 +45,7 @@ bug-reports:    https://gitlab.com/robstewart57/gitlab-haskell/issues author:         Rob Stewart maintainer:     robstewart57@gmail.com-copyright:      2019 Rob Stewart, Heriot-Watt University+copyright:      2020 Rob Stewart, Heriot-Watt University license:        BSD-3-Clause license-file:   LICENSE build-type:     Simple@@ -62,6 +74,8 @@                 , GitLab.API.RepositoryFiles                 , GitLab.API.Todos                 , GitLab.API.Version+                , GitLab.SystemHooks.Types+                , GitLab.SystemHooks.GitLabSystemHooks   other-modules:                   GitLab.WebRequests.GitLabWebCalls   hs-source-dirs:@@ -80,3 +94,19 @@               , time   default-language: Haskell2010   ghc-options: -Wall+               -- the following two for the stan static analysis tool+               -- -fwrite-ide-info+               -- -hiedir=.hie++test-suite test-gitlab-haskell+  type:          exitcode-stdio-1.0+  main-is:       Tests.hs+  other-modules: SystemHookTests+  hs-source-dirs: tests/+  default-language: Haskell2010+  build-depends: base >= 4.8.0.0 && < 6+               , tasty+               , tasty-hunit+               , gitlab-haskell+               , bytestring+               , aeson

@@ -9,6 +9,7 @@ -- Stability   : stable module GitLab   ( runGitLab,+    runGitLabDbg,     runGitLabWithManager,     module GitLab.Types,     module GitLab.API.Pipelines,@@ -25,11 +26,12 @@     module GitLab.API.RepositoryFiles,     module GitLab.API.Todos,     module GitLab.API.Version,+    module GitLab.SystemHooks.GitLabSystemHooks,+    module GitLab.SystemHooks.Types,   ) where  import Control.Monad.IO.Class-import Control.Monad.IO.Unlift import Control.Monad.Trans.Reader import GitLab.API.Branches import GitLab.API.Commits@@ -45,6 +47,8 @@ import GitLab.API.Todos import GitLab.API.Users import GitLab.API.Version+import GitLab.SystemHooks.GitLabSystemHooks+import GitLab.SystemHooks.Types import GitLab.Types import Network.Connection (TLSSettings (..)) import Network.HTTP.Conduit@@ -61,15 +65,14 @@ -- -- > projectsWithIssuesEnabled :: IO [Project] -- > projectsWithIssuesEnabled =--- >   runGitLab myConfig $ filter (issueEnabled . issues_enabled) <$> allProjects+-- >   runGitLabyConfig $ filter (issueEnabled . issues_enabled) <$> allProjects -- >   where -- >     myConfig = defaultGitLabServer -- >         { url = "https://gitlab.example.com" -- >         , token = "my_access_token" } -- >     issueEnabled Nothing = False -- >     issueEnabled (Just b) = b-runGitLab ::-  (MonadUnliftIO m, MonadIO m) => GitLabServerConfig -> GitLab m a -> m a+runGitLab :: GitLabServerConfig -> GitLab a -> IO a runGitLab cfg action = do   liftIO $ hSetBuffering stdout LineBuffering   let settings = mkManagerSettings (TLSSettingsSimple True False False) Nothing@@ -78,8 +81,7 @@  -- | The same as 'runGitLab', except that it also takes a connection -- manager as an argument.-runGitLabWithManager ::-  (MonadUnliftIO m, MonadIO m) => Manager -> GitLabServerConfig -> GitLab m a -> m a+runGitLabWithManager :: Manager -> GitLabServerConfig -> GitLab a -> IO a runGitLabWithManager manager cfg action = do   -- test the token access   tokenTest <- runReaderT gitlabVersion (GitLabState cfg manager)@@ -89,3 +91,11 @@     Right _versionInfo ->       -- it worked, run the user code.       runReaderT action (GitLabState cfg manager)++-- | Only useful for testing GitLab actions that lift IO actions with+-- liftIO. Cannot speak to a GitLab server. Only useful for the+-- gitlab-haskell tests.+runGitLabDbg :: GitLab a -> IO a+runGitLabDbg action = do+  liftIO $ hSetBuffering stdout LineBuffering+  runReaderT action undefined

@@ -9,7 +9,6 @@ -- Stability   : stable module GitLab.API.Branches where -import Control.Monad.IO.Unlift import Data.Either import qualified Data.Text as T import GitLab.Types@@ -18,14 +17,14 @@  -- | Get a list of repository branches from a project, sorted by name -- alphabetically.-branches :: (MonadIO m) => Project -> GitLab m [Branch]+branches :: Project -> GitLab [Branch] branches project = do   result <- branches' (project_id project)   return (fromRight (error "branches error") result)  -- | Get a list of repository branches from a project given its -- project ID, sorted by name alphabetically.-branches' :: (MonadIO m) => Int -> GitLab m (Either Status [Branch])+branches' :: Int -> GitLab (Either Status [Branch]) branches' projectId =   gitlab addr   where

@@ -9,7 +9,6 @@ -- Stability   : stable module GitLab.API.Commits where -import Control.Monad.IO.Unlift import Data.Either import Data.Text (Text) import qualified Data.Text as T@@ -19,20 +18,18 @@  -- | returns all commits for a project. projectCommits ::-  (MonadIO m) =>   -- | the project   Project ->-  GitLab m [Commit]+  GitLab [Commit] projectCommits project = do   result <- projectCommits' (project_id project)   return (fromRight (error "projectCommits error") result)  -- | returns all commits for a project given its project ID. projectCommits' ::-  (MonadIO m) =>   -- | project ID   Int ->-  GitLab m (Either Status [Commit])+  GitLab (Either Status [Commit]) projectCommits' projectId =   gitlabWithAttrs (commitsAddr projectId) "&with_stats=true"   where@@ -43,12 +40,11 @@ -- | returns a commit for the given project and commit hash, if such -- a commit exists. commitDetails ::-  (MonadIO m) =>   -- | the project   Project ->   -- | the commit hash   Text ->-  GitLab m (Maybe Commit)+  GitLab (Maybe Commit) commitDetails project theHash = do   result <- commitDetails' (project_id project) theHash   return (fromRight (error "commitDetails error") result)@@ -56,12 +52,11 @@ -- | returns a commit for the given project ID and commit hash, if -- such a commit exists. commitDetails' ::-  (MonadIO m) =>   -- | project ID   Int ->   -- | the commit hash   Text ->-  GitLab m (Either Status (Maybe Commit))+  GitLab (Either Status (Maybe Commit)) commitDetails' projectId hash =   gitlabOne (commitsAddr projectId)   where

@@ -10,9 +10,6 @@ -- Stability   : stable module GitLab.API.Groups where -import Control.Monad.IO.Class-import Control.Monad.IO.Unlift-import qualified Data.ByteString.Char8 as C import Data.Maybe import Data.Text (Text) import qualified Data.Text as T@@ -28,10 +25,9 @@ -- -- > projectsWithNameOrPath "group1" groupsWithNameOrPath ::-  (MonadUnliftIO m, MonadIO m) =>   -- | group name being searched for.   Text ->-  GitLab m (Either Status [Group])+  GitLab (Either Status [Group]) groupsWithNameOrPath groupName = do   result <- gitlabWithAttrs "/groups" ("&search=" <> groupName)   case result of@@ -49,12 +45,11 @@  -- | adds all registered users to a group. addAllUsersToGroup ::-  (MonadIO m, MonadUnliftIO m) =>   -- | group name   Text ->   -- | level of access granted   AccessLevel ->-  GitLab m [Either Status Member]+  GitLab [Either Status Member] addAllUsersToGroup groupName access = do   allRegisteredUsers <- allUsers   let allUserIds = map user_username allRegisteredUsers@@ -62,32 +57,30 @@  -- | adds a user to a group. addUserToGroup ::-  (MonadIO m, MonadUnliftIO m) =>   -- | group name   Text ->   -- | level of access granted   AccessLevel ->   -- | the user   User ->-  GitLab m (Either Status Member)+  GitLab (Either Status Member) addUserToGroup groupName access usr =   addUserToGroup' groupName access (user_id usr)  -- | adds a user with a given user ID to a group. addUserToGroup' ::-  (MonadIO m, MonadUnliftIO m) =>   -- | group name   Text ->   -- | level of access granted   AccessLevel ->   -- | user ID   Int ->-  GitLab m (Either Status Member)+  GitLab (Either Status Member) addUserToGroup' groupName access userId = do   attempt <- groupsWithNameOrPath groupName   case attempt of     Left httpStatus -> return (Left httpStatus)-    Right [] -> return (Left (mkStatus 404 (C.pack "cannot find group")))+    Right [] -> return (Left (mkStatus 404 (T.encodeUtf8 (T.pack "cannot find group"))))     Right [grp] ->       gitlabPost addr dataBody       where@@ -100,31 +93,29 @@             <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 (T.pack (show (group_id grp)))))             <> "/members"     Right (_ : _) ->-      return (Left (mkStatus 404 (C.pack "too many groups found")))+      return (Left (mkStatus 404 (T.encodeUtf8 (T.pack "too many groups found"))))  -- | adds a list of users to a group. addUsersToGroup ::-  (MonadIO m, MonadUnliftIO m) =>   -- | group name   Text ->   -- | level of access granted   AccessLevel ->   -- | list of usernames to be added to the group   [User] ->-  GitLab m [Either Status Member]+  GitLab [Either Status Member] addUsersToGroup groupName access =   mapM (addUserToGroup groupName access)  -- | adds a list of users to a group. addUsersToGroup' ::-  (MonadIO m, MonadUnliftIO m) =>   -- | group name   Text ->   -- | level of access granted   AccessLevel ->   -- | list of usernames to be added to the group   [Text] ->-  GitLab m [Either Status Member]+  GitLab [Either Status Member] addUsersToGroup' groupName access usernames = do   users <- catMaybes <$> mapM searchUser usernames   mapM (addUserToGroup' groupName access . user_id) users

@@ -10,30 +10,30 @@ -- Stability   : stable module GitLab.API.Issues where -import Control.Monad.IO.Class-import Control.Monad.IO.Unlift+import qualified Data.Aeson as J import Data.Either+import Data.Text (Text) import qualified Data.Text as T+import qualified Data.Text.Lazy+import qualified Data.Text.Lazy.Encoding import GitLab.Types import GitLab.WebRequests.GitLabWebCalls import Network.HTTP.Types.Status  -- | returns all issues against a project. projectOpenedIssues ::-  (MonadIO m, MonadUnliftIO m) =>   -- | the project   Project ->-  GitLab m [Issue]+  GitLab [Issue] projectOpenedIssues p = do   result <- projectOpenedIssues' (project_id p)   return (fromRight (error "projectOpenedIssues error") result)  -- | returns all issues against a project given its project ID. projectOpenedIssues' ::-  (MonadIO m, MonadUnliftIO m) =>   -- | the project ID   Int ->-  GitLab m (Either Status [Issue])+  GitLab (Either Status [Issue]) projectOpenedIssues' projectId = do   let path = "/projects/" <> T.pack (show projectId) <> "/issues"   gitlab path@@ -42,10 +42,9 @@  -- | gets all issues create by a user. userIssues ::-  (MonadIO m) =>   -- | the user   User ->-  GitLab m [Issue]+  GitLab [Issue] userIssues usr =   gitlabWithAttrsUnsafe addr attrs   where@@ -55,3 +54,57 @@         "&author_id="           <> show (user_id usr)           <> "&scope=all"++-- | create a new issue.+newIssue ::+  -- | project+  Project ->+  -- | issue title+  Text ->+  -- | issue description+  Text ->+  GitLab (Either Status Issue)+newIssue project =+  newIssue' (project_id project)++-- | create a new issue.+newIssue' ::+  -- | project ID+  Int ->+  -- | issue title+  Text ->+  -- | issue description+  Text ->+  GitLab (Either Status Issue)+newIssue' projectId issueTitle issueDescription =+  gitlabPost addr dataBody+  where+    dataBody :: Text+    dataBody =+      "title="+        <> issueTitle+        <> "&description="+        <> issueDescription+    addr =+      "/projects/"+        <> T.pack (show projectId)+        <> "/issues"++-- | edits an issue. see <https://docs.gitlab.com/ee/api/issues.html#edit-issue>+editIssue ::+  ProjectId ->+  IssueId ->+  EditIssueReq ->+  GitLab (Either Status Issue)+editIssue projId issueId editIssueReq = do+  let path =+        "/projects/" <> T.pack (show projId)+          <> "/issues/"+          <> T.pack (show issueId)+  gitlabPut+    path+    ( Data.Text.Lazy.toStrict+        ( Data.Text.Lazy.Encoding.decodeUtf8+            (J.encode editIssueReq)+        )+    )

@@ -9,7 +9,6 @@ -- Stability   : stable module GitLab.API.Jobs where -import Control.Monad.IO.Unlift import Data.Either import qualified Data.Text as T import GitLab.Types@@ -18,20 +17,18 @@  -- | returns all jobs ran on a project. jobs ::-  (MonadIO m) =>   -- | the project   Project ->-  GitLab m [Job]+  GitLab [Job] jobs project = do   result <- jobs' (project_id project)   return (fromRight (error "jobs error") result)  -- | returns all jobs ran on a project given its project ID. jobs' ::-  (MonadIO m) =>   -- | the project ID   Int ->-  GitLab m (Either Status [Job])+  GitLab (Either Status [Job]) jobs' projectId =   gitlab addr   where

@@ -10,7 +10,6 @@ -- Stability   : stable module GitLab.API.Members where -import Control.Monad.IO.Class import Data.Either import Data.Text (Text) import qualified Data.Text as T@@ -34,13 +33,13 @@   show Owner = "50"  -- | the members of a project.-membersOfProject :: (MonadIO m) => Project -> GitLab m [Member]+membersOfProject :: Project -> GitLab [Member] membersOfProject p = do   result <- membersOfProject' (project_id p)   return (fromRight (error "membersOfProject error") result)  -- | the members of a project given its ID.-membersOfProject' :: (MonadIO m) => Int -> GitLab m (Either Status [Member])+membersOfProject' :: Int -> GitLab (Either Status [Member]) membersOfProject' projectId =   gitlab addr   where@@ -51,14 +50,13 @@ -- 'Right Member' for each successful action, otherwise it returns -- 'Left Status'. addMemberToProject ::-  (MonadIO m) =>   -- | the project   Project ->   -- | level of access   AccessLevel ->   -- | the user   User ->-  GitLab m (Either Status Member)+  GitLab (Either Status Member) addMemberToProject project access usr =   addMemberToProject' (project_id project) access (user_id usr) @@ -66,14 +64,13 @@ -- project's ID and the user's ID. Returns @Right Member@ for each -- successful action, otherwise it returns @Left Status@. addMemberToProject' ::-  (MonadIO m) =>   -- | project ID   Int ->   -- | level of access   AccessLevel ->   -- | user ID   Int ->-  GitLab m (Either Status Member)+  GitLab (Either Status Member) addMemberToProject' projectId access userId =   gitlabPost addr dataBody   where@@ -87,14 +84,13 @@ -- level. Returns 'Right Member' for each successful action, otherwise -- it returns 'Left Status'. addMembersToProject ::-  (MonadIO m) =>   -- | the project   Project ->   -- | level of access   AccessLevel ->   -- | users to add to the project   [User] ->-  GitLab m [Either Status Member]+  GitLab [Either Status Member] addMembersToProject project access =   mapM (addMemberToProject project access) @@ -102,13 +98,12 @@ -- given the project's ID and the user IDs. Returns @Right Member@ for -- each successful action, otherwise it returns @Left Status@. addMembersToProject' ::-  (MonadIO m) =>   -- | project ID   Int ->   -- | level of acces   AccessLevel ->   -- | IDs of users to add to the project   [Int] ->-  GitLab m [Either Status Member]+  GitLab [Either Status Member] addMembersToProject' projectId access =   mapM (addMemberToProject' projectId access)

@@ -9,7 +9,6 @@ -- Stability   : stable module GitLab.API.MergeRequests where -import Control.Monad.IO.Unlift import Data.Either import Data.Text (Text) import qualified Data.Text as T@@ -19,20 +18,18 @@  -- | returns the merge requests for a project. mergeRequests ::-  (MonadIO m) =>   -- | the project   Project ->-  GitLab m [MergeRequest]+  GitLab [MergeRequest] mergeRequests p = do   result <- mergeRequests' (project_id p)   return (fromRight (error "mergeRequests error") result)  -- | returns the merge requests for a project given its project ID. mergeRequests' ::-  (MonadIO m) =>   -- | project ID   Int ->-  GitLab m (Either Status [MergeRequest])+  GitLab (Either Status [MergeRequest]) mergeRequests' projectId =   gitlabWithAttrs addr "&scope=all"   where@@ -43,7 +40,6 @@  -- | Creates a merge request. createMergeRequest ::-  (MonadIO m) =>   -- | project   Project ->   -- | source branch@@ -56,13 +52,12 @@   Text ->   -- | merge request description   Text ->-  GitLab m (Either Status MergeRequest)+  GitLab (Either Status MergeRequest) createMergeRequest project =   createMergeRequest' (project_id project)  -- | Creates a merge request. createMergeRequest' ::-  (MonadIO m) =>   -- | project ID   Int ->   -- | source branch@@ -75,7 +70,7 @@   Text ->   -- | merge request description   Text ->-  GitLab m (Either Status MergeRequest)+  GitLab (Either Status MergeRequest) createMergeRequest' projectId sourceBranch targetBranch targetProjectId mrTitle mrDescription =   gitlabPost addr dataBody   where@@ -92,23 +87,21 @@  -- | Accepts a merge request. acceptMergeRequest ::-  (MonadIO m) =>   -- | project   Project ->   -- | merge request IID   Int ->-  GitLab m (Either Status MergeRequest)+  GitLab (Either Status MergeRequest) acceptMergeRequest project =   acceptMergeRequest' (project_id project)  -- | Accepts a merge request. acceptMergeRequest' ::-  (MonadIO m) =>   -- | project ID   Int ->   -- | merge request IID   Int ->-  GitLab m (Either Status MergeRequest)+  GitLab (Either Status MergeRequest) acceptMergeRequest' projectId mergeRequestIid = gitlabPost addr dataBody   where     dataBody :: Text

@@ -9,7 +9,6 @@ -- Stability   : stable module GitLab.API.Pipelines where -import Control.Monad.IO.Unlift import Data.Either import qualified Data.Text as T import GitLab.Types@@ -18,20 +17,18 @@  -- | returns the pipelines for a project. pipelines ::-  (MonadIO m) =>   -- | the project   Project ->-  GitLab m [Pipeline]+  GitLab [Pipeline] pipelines p = do   result <- pipelines' (project_id p)   return (fromRight (error "pipelines error") result)  -- | returns the pipelines for a project given its project ID. pipelines' ::-  (MonadIO m) =>   -- | the project ID   Int ->-  GitLab m (Either Status [Pipeline])+  GitLab (Either Status [Pipeline]) pipelines' projectId =   gitlabWithAttrs     addr

@@ -10,11 +10,8 @@ -- Stability   : stable module GitLab.API.Projects where -import Control.Monad.IO.Class-import Control.Monad.IO.Unlift import Data.Either import Data.List-import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T@@ -30,7 +27,7 @@ import UnliftIO.Async  -- | gets all projects.-allProjects :: (MonadIO m) => GitLab m [Project]+allProjects :: GitLab [Project] allProjects =   gitlabWithAttrsUnsafe "/projects" "&statistics=true" @@ -39,10 +36,9 @@ -- > projectForks "project1" -- > projectForks "group1/project1" projectForks ::-  (MonadUnliftIO m, MonadIO m) =>   -- | name or namespace of the project   Text ->-  GitLab m (Either Status [Project])+  GitLab (Either Status [Project]) projectForks projectName = do   let urlPath =         "/projects/"@@ -53,10 +49,9 @@ -- | searches for a 'Project' with the given project ID, returns -- 'Nothing' if a project with the given ID is not found. searchProjectId ::-  (MonadIO m) =>   -- | project ID   Int ->-  GitLab m (Either Status (Maybe Project))+  GitLab (Either Status (Maybe Project)) searchProjectId projectId = do   let urlPath = T.pack ("/projects/" <> show projectId)   gitlabWithAttrsOne urlPath "&statistics=true"@@ -65,10 +60,9 @@ -- -- > projectsWithName "project1" projectsWithName ::-  (MonadUnliftIO m, MonadIO m) =>   -- | project name being searched for.   Text ->-  GitLab m [Project]+  GitLab [Project] projectsWithName projectName =   filter (\project -> projectName == project_path project)     <$> gitlabWithAttrsUnsafe "/projects" ("&search=" <> projectName)@@ -78,8 +72,7 @@ -- > projectsNamespaceName "user1" "project1" -- -- looks for "user1/project1"-projectsWithNameAndUser ::-  (MonadUnliftIO m, MonadIO m) => Text -> Text -> GitLab m (Either Status (Maybe Project))+projectsWithNameAndUser :: Text -> Text -> GitLab (Either Status (Maybe Project)) projectsWithNameAndUser username projectName =   gitlabWithAttrsOne     ( "/projects/"@@ -90,22 +83,21 @@  -- | returns 'True' if a project has multiple committers, according to -- the email addresses of the commits.-multipleCommitters :: (MonadUnliftIO m, MonadIO m) => Project -> GitLab m Bool+multipleCommitters :: Project -> GitLab Bool multipleCommitters project = do   emailAddresses <- commitsEmailAddresses project   return (length (nub emailAddresses) > 1)  -- | gets the email addresses in the author information in all commit -- for a project.-commitsEmailAddresses ::-  (MonadUnliftIO m, MonadIO m) => Project -> GitLab m [Text]+commitsEmailAddresses :: Project -> GitLab [Text] commitsEmailAddresses project = do   result <- commitsEmailAddresses' (project_id project)   return (fromRight (error "commitsEmailAddresses error") result)  -- | gets the email addresses in the author information in all commit -- for a project defined by the project's ID.-commitsEmailAddresses' :: (MonadUnliftIO m, MonadIO m) => Int -> GitLab m (Either Status [Text])+commitsEmailAddresses' :: Int -> GitLab (Either Status [Text]) commitsEmailAddresses' projectId = do   -- (commits :: [Commit]) <- projectCommits' projectId   attempt <- projectCommits' projectId@@ -117,8 +109,7 @@ -- | gets all projects for a user given their username. -- -- > userProjects "harry"-userProjects' ::-  (MonadUnliftIO m, MonadIO m) => Text -> GitLab m (Maybe [Project])+userProjects' :: Text -> GitLab (Maybe [Project]) userProjects' username = do   userMaybe <- searchUser username   case userMaybe of@@ -130,26 +121,27 @@ -- | gets all projects for a user. -- -- > userProjects myUser-userProjects ::-  (MonadUnliftIO m, MonadIO m) => User -> GitLab m (Maybe [Project])+userProjects :: User -> GitLab (Maybe [Project]) userProjects theUser =   userProjects' (user_username theUser)  -- | gets the 'GitLab.Types.Project' against which the given 'Issue' -- was created.-projectOfIssue :: (MonadIO m) => Issue -> GitLab m Project+projectOfIssue :: Issue -> GitLab Project projectOfIssue issue = do   result <- searchProjectId (issue_project_id issue)-  return (fromJust (fromRight (error "projectOfIssue error") result))+  case fromRight (error "projectOfIssue error") result of+    Nothing -> error "projectOfIssue error"+    Just proj -> return proj  -- | finds all issues created by a user. -- -- > issuesCreatedByUser "user1" ----- returns a (user,projects) tuple, where 'user' is the 'User' found+-- returns a (user,projects) tuple, where user is the 'User' found -- for the given searched username, and a list of 'Project's that the -- user has created issues for.-issuesCreatedByUser :: (MonadUnliftIO m, MonadIO m) => Text -> GitLab m (Maybe (User, [Project]))+issuesCreatedByUser :: Text -> GitLab (Maybe (User, [Project])) issuesCreatedByUser username = do   user_maybe <- searchUser username   case user_maybe of@@ -163,18 +155,16 @@ -- of triples of: 1) the found project, 2) the list of issues for the -- found projects, and 3) a list of users who've created issues. issuesOnForks ::-  (MonadUnliftIO m, MonadIO m) =>   -- | name or namespace of the project   Text ->-  GitLab m [(Project, [Issue], [User])]+  GitLab [(Project, [Issue], [User])] issuesOnForks projectName = do   projects <- projectsWithName projectName   mapM processProject projects   where     processProject ::-      (MonadUnliftIO m, MonadIO m) =>       Project ->-      GitLab m (Project, [Issue], [User])+      GitLab (Project, [Issue], [User])     processProject proj = do       (openIssues :: [Issue]) <- projectOpenedIssues proj       let authors = map issue_author openIssues@@ -184,7 +174,7 @@ -- where namespace is the namespace of the project -- e.g. "user1/project1", and members is a list of (username,name) -- tuples about all members of the project.-projectMemebersCount :: (MonadIO m) => Project -> GitLab m (Text, [(Text, Text)])+projectMemebersCount :: Project -> GitLab (Text, [(Text, Text)]) projectMemebersCount project = do   friends <- count   return (namespace_name (namespace project), friends)@@ -198,10 +188,9 @@ -- | returns 'True' is the last commit for a project passes all -- continuous integration tests. projectCISuccess ::-  (MonadIO m) =>   -- | the name or namespace of the project   Project ->-  GitLab m Bool+  GitLab Bool projectCISuccess project = do   pipes <- pipelines project   case pipes of@@ -211,10 +200,9 @@ -- | searches for a username, and returns a user ID for that user, or -- 'Nothing' if a user cannot be found. namespacePathToUserId ::-  (MonadIO m) =>   -- | name or namespace of project   Text ->-  GitLab m (Maybe Int)+  GitLab (Maybe Int) namespacePathToUserId namespacePath = do   user_maybe <- searchUser namespacePath   case user_maybe of@@ -222,13 +210,13 @@     Just usr -> return (Just (user_id usr))  -- | gets all diffs in a project for a given commit SHA.-projectDiffs :: (MonadIO m) => Project -> Text -> GitLab m (Either Status [Diff])+projectDiffs :: Project -> Text -> GitLab (Either Status [Diff]) projectDiffs proj =   projectDiffs' (project_id proj)  -- | gets all diffs in a project for a given project ID, for a given -- commit SHA.-projectDiffs' :: (MonadIO m) => Int -> Text -> GitLab m (Either Status [Diff])+projectDiffs' :: Int -> Text -> GitLab (Either Status [Diff]) projectDiffs' projId commitSha =   gitlab     ( "/projects/"@@ -240,14 +228,13 @@  -- | share a project with a group. shareProjectWithGroup ::-  (MonadIO m) =>   -- | group ID   Int ->   -- | project ID   Int ->   -- | level of access granted   AccessLevel ->-  GitLab m (Either Status GroupShare)+  GitLab (Either Status GroupShare) shareProjectWithGroup groupId projectId access =   gitlabPost addr dataBody   where

@@ -19,20 +19,18 @@  -- | returns a list of repository files and directories in a project. repositories ::-  (MonadIO m) =>   -- | the project   Project ->-  GitLab m [Repository]+  GitLab [Repository] repositories project =   fromRight (error "repositories error") <$> repositories' (project_id project)  -- | returns a list of repository files and directories in a project -- given its project ID. repositories' ::-  (MonadIO m) =>   -- | the project ID   Int ->-  GitLab m (Either Status [Repository])+  GitLab (Either Status [Repository]) repositories' projectId =   gitlab addr   where@@ -46,14 +44,13 @@ -- -- > getFileArchive myProject TarGz "/tmp/myProject.tar.gz" getFileArchive ::-  (MonadIO m) =>   -- | project   Project ->   -- | file format   ArchiveFormat ->   -- | file path to store the archive   FilePath ->-  GitLab m (Either Status ())+  GitLab (Either Status ()) getFileArchive project = getFileArchive' (project_id project)  -- | get a file archive of the repository files as a@@ -61,12 +58,11 @@ -- -- > getFileArchiveBS myProject TarGz "/tmp/myProject.tar.gz" getFileArchiveBS ::-  (MonadIO m) =>   -- | project   Project ->   -- | file format   ArchiveFormat ->-  GitLab m (Either Status BSL.ByteString)+  GitLab (Either Status BSL.ByteString) getFileArchiveBS project = getFileArchiveBS' (project_id project)  -- | get a file archive of the repository files using the project's@@ -74,14 +70,13 @@ -- -- > getFileArchive' 3453 Zip "/tmp/myProject.zip" getFileArchive' ::-  (MonadIO m) =>   -- | project ID   Int ->   -- | file format   ArchiveFormat ->   -- | file path to store the archive   FilePath ->-  GitLab m (Either Status ())+  GitLab (Either Status ()) getFileArchive' projectId format path = do   attempt <- getFileArchiveBS' projectId format   case attempt of@@ -94,12 +89,11 @@ -- -- > getFileArchiveBS' 3453 Zip "/tmp/myProject.zip" getFileArchiveBS' ::-  (MonadIO m) =>   -- | project ID   Int ->   -- | file format   ArchiveFormat ->-  GitLab m (Either Status BSL.ByteString)+  GitLab (Either Status BSL.ByteString) getFileArchiveBS' projectId format =   gitlabReqByteString addr   where

@@ -9,7 +9,6 @@ -- Stability   : stable module GitLab.API.RepositoryFiles where -import Control.Monad.IO.Unlift import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T@@ -20,27 +19,25 @@  -- | Get a list of repository files and directories in a project. repositoryFiles ::-  (MonadIO m) =>   -- | the project   Project ->   -- | the file path   Text ->   -- | name of the branch, tag or commit   Text ->-  GitLab m (Either Status (Maybe RepositoryFile))+  GitLab (Either Status (Maybe RepositoryFile)) repositoryFiles project = repositoryFiles' (project_id project)  -- | Get a list of repository files and directories in a project given -- the project's ID. repositoryFiles' ::-  (MonadIO m) =>   -- | project ID   Int ->   -- | the file path   Text ->   -- | name of the branch, tag or commit   Text ->-  GitLab m (Either Status (Maybe RepositoryFile))+  GitLab (Either Status (Maybe RepositoryFile)) repositoryFiles' projectId filePath reference =   gitlabWithAttrsOne addr ("&ref=" <> reference)   where@@ -54,12 +51,11 @@  -- | Get raw data for a given file blob hash. repositoryFileBlob ::-  (MonadIO m) =>   -- | project ID   Int ->   -- | blob SHA   Text ->-  GitLab m (Either Status String)+  GitLab (Either Status String) repositoryFileBlob projectId blobSha =   gitlabReqText addr   where

@@ -9,10 +9,9 @@ -- Stability   : stable module GitLab.API.Todos where -import Control.Monad.IO.Class import GitLab.Types import GitLab.WebRequests.GitLabWebCalls  -- | returns all pending todos for the user, as defined by the access token.-todos :: (MonadIO m) => GitLab m [Todo]+todos :: GitLab [Todo] todos = gitlabUnsafe "/todos"

@@ -10,7 +10,6 @@ -- Stability   : stable module GitLab.API.Users where -import Control.Monad.IO.Class import Data.List import Data.Maybe import Data.Text (Text)@@ -18,7 +17,7 @@ import GitLab.WebRequests.GitLabWebCalls  -- | all registered users.-allUsers :: (MonadIO m) => GitLab m [User]+allUsers :: GitLab [User] allUsers = do   let path = "/users"   gitlabUnsafe path@@ -26,25 +25,23 @@ -- | searches for a user given a username. Returns @Just User@ if the -- user is found, otherwise @Nothing@. searchUser ::-  (MonadIO m) =>   -- | username to search for   Text ->-  GitLab m (Maybe User)+  GitLab (Maybe User) searchUser username = do   let path = "/users"       attrs = "&username=" <> username   res <- gitlabWithAttrsUnsafe path attrs-  if null res-    then return Nothing-    else return (Just (head res))+  case res of+    [] -> return Nothing+    (user : _) -> return (Just user)  -- | searches for users given a list of usernames, returns them in -- alphabetical order of their usernames. orderedUsers ::-  (MonadIO m) =>   -- | usernames to search for   [Text] ->-  GitLab m [User]+  GitLab [User] orderedUsers usernames = do   users <- catMaybes <$> mapM searchUser usernames   return (orderUsersByName users)

@@ -9,12 +9,12 @@ -- Stability   : stable module GitLab.API.Version where -import Control.Monad.IO.Class import GitLab.Types import GitLab.WebRequests.GitLabWebCalls import Network.HTTP.Types.Status -gitlabVersion :: (MonadIO m) => GitLab m (Either Status (Maybe Version))+-- | Get the version of the GitLab server.+gitlabVersion :: GitLab (Either Status (Maybe Version)) gitlabVersion = do   let path = "/version"   gitlabOne path

@@ -0,0 +1,262 @@+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}++-- |+-- Module      : GitLab.SystemHooks.GitLabSystemHooks+-- Description : Haskell records corresponding to JSON data from GitLab system hooks+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2020+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable+module GitLab.SystemHooks.GitLabSystemHooks+  ( receive,+    receiveString,+    tryFire,+  )+where++import Control.Monad+import Control.Monad.IO.Class+import Data.Typeable+import GitLab.SystemHooks.Types+import GitLab.Types++-- | Attempts to fire each rule in sequence. Reads the JSON data+-- received from the GitLab server from standard input.+receive :: [Rule] -> GitLab ()+receive rules = do+  eventContent <- liftIO 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 eventContent rules = do+  mapM_ (fire eventContent) rules++orElse :: GitLab Bool -> GitLab Bool -> GitLab Bool+orElse f g = do+  x <- f+  if x+    then return True+    else g++fire :: String -> Rule -> GitLab ()+fire contents rule = do+  result <- tryFire contents rule+  when result $+    liftIO (putStrLn ("fired: " <> labelOf rule))+  where+    labelOf :: Rule -> String+    labelOf (Match lbl _) = lbl+    labelOf (MatchIf lbl _ _) = lbl++-- | 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 contents (Match _ f) = do+  fireIf'+    (Just (\_ -> return True))+    (cast f :: Maybe (ProjectCreate -> GitLab ()))+    (parseEvent contents :: Maybe ProjectCreate)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (ProjectDestroy -> GitLab ()))+      (parseEvent contents :: Maybe ProjectDestroy)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (ProjectRename -> GitLab ()))+      (parseEvent contents :: Maybe ProjectRename)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (ProjectTransfer -> GitLab ()))+      (parseEvent contents :: Maybe ProjectTransfer)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (ProjectUpdate -> GitLab ()))+      (parseEvent contents :: Maybe ProjectUpdate)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (GroupMemberUpdate -> GitLab ()))+      (parseEvent contents :: Maybe GroupMemberUpdate)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (UserAddToTeam -> GitLab ()))+      (parseEvent contents :: Maybe UserAddToTeam)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (UserUpdateForTeam -> GitLab ()))+      (parseEvent contents :: Maybe UserUpdateForTeam)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (UserRemoveFromTeam -> GitLab ()))+      (parseEvent contents :: Maybe UserRemoveFromTeam)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (UserCreate -> GitLab ()))+      (parseEvent contents :: Maybe UserCreate)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (UserRemove -> GitLab ()))+      (parseEvent contents :: Maybe UserRemove)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (UserFailedLogin -> GitLab ()))+      (parseEvent contents :: Maybe UserFailedLogin)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (UserRename -> GitLab ()))+      (parseEvent contents :: Maybe UserRename)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (KeyCreate -> GitLab ()))+      (parseEvent contents :: Maybe KeyCreate)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (KeyRemove -> GitLab ()))+      (parseEvent contents :: Maybe KeyRemove)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (GroupCreate -> GitLab ()))+      (parseEvent contents :: Maybe GroupCreate)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (GroupRemove -> GitLab ()))+      (parseEvent contents :: Maybe GroupRemove)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (GroupRename -> GitLab ()))+      (parseEvent contents :: Maybe GroupRename)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (NewGroupMember -> GitLab ()))+      (parseEvent contents :: Maybe NewGroupMember)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (GroupMemberRemove -> GitLab ()))+      (parseEvent contents :: Maybe GroupMemberRemove)+    -- `orElse` fireIf'+    --   (Just (\_ -> return True))+    --   (cast f :: Maybe (ProjectEvent -> GitLab ()))+    --   (parseEvent contents :: Maybe ProjectEvent)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (Push -> GitLab ()))+      (parseEvent contents :: Maybe Push)+    `orElse` fireIf'+      (Just (\_ -> return True))+      (cast f :: Maybe (TagPush -> GitLab ()))+      (parseEvent contents :: Maybe TagPush)+tryFire contents (MatchIf _ predF f) = do+  fireIf'+    (cast predF :: Maybe (ProjectCreate -> GitLab Bool))+    (cast f :: Maybe (ProjectCreate -> GitLab ()))+    (parseEvent contents :: Maybe ProjectCreate)+    `orElse` fireIf'+      (cast predF :: Maybe (ProjectDestroy -> GitLab Bool))+      (cast f :: Maybe (ProjectDestroy -> GitLab ()))+      (parseEvent contents :: Maybe ProjectDestroy)+    `orElse` fireIf'+      (cast predF :: Maybe (ProjectRename -> GitLab Bool))+      (cast f :: Maybe (ProjectRename -> GitLab ()))+      (parseEvent contents :: Maybe ProjectRename)+    `orElse` fireIf'+      (cast predF :: Maybe (ProjectTransfer -> GitLab Bool))+      (cast f :: Maybe (ProjectTransfer -> GitLab ()))+      (parseEvent contents :: Maybe ProjectTransfer)+    `orElse` fireIf'+      (cast predF :: Maybe (ProjectUpdate -> GitLab Bool))+      (cast f :: Maybe (ProjectUpdate -> GitLab ()))+      (parseEvent contents :: Maybe ProjectUpdate)+    `orElse` fireIf'+      (cast predF :: Maybe (GroupMemberUpdate -> GitLab Bool))+      (cast f :: Maybe (GroupMemberUpdate -> GitLab ()))+      (parseEvent contents :: Maybe GroupMemberUpdate)+    `orElse` fireIf'+      (cast predF :: Maybe (UserAddToTeam -> GitLab Bool))+      (cast f :: Maybe (UserAddToTeam -> GitLab ()))+      (parseEvent contents :: Maybe UserAddToTeam)+    `orElse` fireIf'+      (cast predF :: Maybe (UserUpdateForTeam -> GitLab Bool))+      (cast f :: Maybe (UserUpdateForTeam -> GitLab ()))+      (parseEvent contents :: Maybe UserUpdateForTeam)+    `orElse` fireIf'+      (cast predF :: Maybe (UserRemoveFromTeam -> GitLab Bool))+      (cast f :: Maybe (UserRemoveFromTeam -> GitLab ()))+      (parseEvent contents :: Maybe UserRemoveFromTeam)+    `orElse` fireIf'+      (cast predF :: Maybe (UserCreate -> GitLab Bool))+      (cast f :: Maybe (UserCreate -> GitLab ()))+      (parseEvent contents :: Maybe UserCreate)+    `orElse` fireIf'+      (cast predF :: Maybe (UserRemove -> GitLab Bool))+      (cast f :: Maybe (UserRemove -> GitLab ()))+      (parseEvent contents :: Maybe UserRemove)+    `orElse` fireIf'+      (cast predF :: Maybe (UserFailedLogin -> GitLab Bool))+      (cast f :: Maybe (UserFailedLogin -> GitLab ()))+      (parseEvent contents :: Maybe UserFailedLogin)+    `orElse` fireIf'+      (cast predF :: Maybe (UserRename -> GitLab Bool))+      (cast f :: Maybe (UserRename -> GitLab ()))+      (parseEvent contents :: Maybe UserRename)+    `orElse` fireIf'+      (cast predF :: Maybe (KeyCreate -> GitLab Bool))+      (cast f :: Maybe (KeyCreate -> GitLab ()))+      (parseEvent contents :: Maybe KeyCreate)+    `orElse` fireIf'+      (cast predF :: Maybe (KeyRemove -> GitLab Bool))+      (cast f :: Maybe (KeyRemove -> GitLab ()))+      (parseEvent contents :: Maybe KeyRemove)+    `orElse` fireIf'+      (cast predF :: Maybe (GroupCreate -> GitLab Bool))+      (cast f :: Maybe (GroupCreate -> GitLab ()))+      (parseEvent contents :: Maybe GroupCreate)+    `orElse` fireIf'+      (cast predF :: Maybe (GroupRemove -> GitLab Bool))+      (cast f :: Maybe (GroupRemove -> GitLab ()))+      (parseEvent contents :: Maybe GroupRemove)+    `orElse` fireIf'+      (cast predF :: Maybe (GroupRename -> GitLab Bool))+      (cast f :: Maybe (GroupRename -> GitLab ()))+      (parseEvent contents :: Maybe GroupRename)+    `orElse` fireIf'+      (cast predF :: Maybe (NewGroupMember -> GitLab Bool))+      (cast f :: Maybe (NewGroupMember -> GitLab ()))+      (parseEvent contents :: Maybe NewGroupMember)+    `orElse` fireIf'+      (cast predF :: Maybe (GroupMemberRemove -> GitLab Bool))+      (cast f :: Maybe (GroupMemberRemove -> GitLab ()))+      (parseEvent contents :: Maybe GroupMemberRemove)+    -- `orElse` fireIf'+    --   (cast predF :: Maybe (ProjectEvent -> GitLab Bool))+    --   (cast f :: Maybe (ProjectEvent -> GitLab ()))+    --   (parseEvent contents :: Maybe ProjectEvent)+    `orElse` fireIf'+      (cast predF :: Maybe (Push -> GitLab Bool))+      (cast f :: Maybe (Push -> GitLab ()))+      (parseEvent contents :: Maybe Push)+    `orElse` fireIf'+      (cast predF :: Maybe (TagPush -> GitLab Bool))+      (cast f :: Maybe (TagPush -> GitLab ()))+      (parseEvent contents :: Maybe TagPush)++fireIf' :: (Typeable a, Show a) => Maybe (a -> GitLab Bool) -> Maybe (a -> GitLab ()) -> Maybe a -> GitLab Bool+fireIf' castPred castF parsed = do+  case castPred of+    Nothing -> return False+    Just pred' ->+      case castF of+        Nothing -> return False+        Just f' ->+          case parsed of+            Nothing -> return False+            Just parsed' -> do+              testPred <- pred' parsed'+              if testPred+                then do+                  f' parsed'+                  return True+                else return False

@@ -0,0 +1,1154 @@+{-# LANGUAGE DeriveGeneric #-}+{-# LANGUAGE DuplicateRecordFields #-}+{-# LANGUAGE GADTs #-}+{-# LANGUAGE OverloadedStrings #-}+{-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}+{-# LANGUAGE TypeFamilies #-}++-- |+-- Module      : GitLab.SystemHooks.Types+-- Description : Haskell records corresponding to JSON data from GitLab system hook events+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2020+-- License     : BSD3+-- Maintainer  : robstewart57@gmail.com+-- Stability   : stable+module GitLab.SystemHooks.Types+  ( Rule (..),+    SystemHook (..),+    ProjectCreate (..),+    ProjectDestroy (..),+    ProjectRename (..),+    ProjectTransfer (..),+    ProjectUpdate (..),+    UserAddToTeam (..),+    UserUpdateForTeam (..),+    UserRemoveFromTeam (..),+    UserCreate (..),+    UserRemove (..),+    UserFailedLogin (..),+    UserRename (..),+    KeyCreate (..),+    KeyRemove (..),+    GroupCreate (..),+    GroupRemove (..),+    GroupRename (..),+    NewGroupMember (..),+    GroupMemberRemove (..),+    GroupMemberUpdate (..),+    Push (..),+    TagPush (..),+    ProjectEvent (..),+    RepositoryEvent (..),+    CommitEvent (..),+    CommitAuthorEvent (..),+    Visibility (..),+    parseEvent,+  )+where++import Data.Aeson+import qualified Data.ByteString.Lazy.Char8 as BSL+import Data.Text (Text)+import Data.Typeable+import GHC.Generics+import GitLab.Types++-- | Pattern matching rules on GitLab hook events.+data Rule where+  Match :: (Typeable a) => String -> (a -> GitLab ()) -> Rule+  MatchIf :: (Typeable a) => String -> (a -> GitLab Bool) -> (a -> GitLab ()) -> Rule++-- | A typeclass for GitLab hook events.+class (FromJSON a) => SystemHook a where+  match :: String -> (a -> GitLab ()) -> Rule+  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+    Left _error -> Nothing+    Right event -> Just event++instance SystemHook ProjectCreate where+  match = Match+  matchIf = MatchIf++-- | GitLab project creation.+data ProjectCreate = ProjectCreate+  { projectCreate_created_at :: Text,+    projectCreate_updated_at :: Text,+    projectCreate_action :: Text,+    projectCreate_name :: Text,+    projectCreate_owner_email :: Text,+    projectCreate_owner_name :: Text,+    projectCreate_path :: Text,+    projectCreate_path_with_namespace :: Text,+    projectCreate_project_id :: Int,+    projectCreate_project_visibility :: Visibility+  }+  deriving (Typeable, Show, Eq)++instance SystemHook ProjectDestroy where+  match = Match+  matchIf = MatchIf++-- | Removal of a GitLab removal.+data ProjectDestroy = ProjectDestroy+  { projectDestroy_created_at :: Text,+    projectDestroy_updated_at :: Text,+    projectDestroy_action :: Text,+    projectDestroy_name :: Text,+    projectDestroy_owner_email :: Text,+    projectDestroy_owner_name :: Text,+    projectDestroy_path :: Text,+    projectDestroy_path_with_namespace :: Text,+    projectDestroy_project_id :: Int,+    projectDestroy_project_visibility :: Visibility+  }+  deriving (Typeable, Show, Eq)++instance SystemHook ProjectRename where+  match = Match+  matchIf = MatchIf++-- | Renaming of a GitLab project.+data ProjectRename = ProjectRename+  { projectRename_created_at :: Text,+    projectRename_updated_at :: Text,+    projectRename_event_name :: Text,+    projectRename_name :: Text,+    projectRename_path :: Text,+    projectRename_path_with_namespace :: Text,+    projectRename_project_id :: Int,+    projectRename_owner_name :: Text,+    projectRename_owner_email :: Text,+    projectRename_project_visibility :: Visibility,+    projectRename_old_path_with_namespace :: Text+  }+  deriving (Typeable, Show, Eq)++instance SystemHook ProjectTransfer where+  match = Match+  matchIf = MatchIf++-- | A project has been transferred.+data ProjectTransfer = ProjectTransfer+  { projectTransfer_created_at :: Text,+    projectTransfer_updated_at :: Text,+    projectTransfer_event_name :: Text,+    projectTransfer_name :: Text,+    projectTransfer_path :: Text,+    projectTransfer_path_with_namespace :: Text,+    projectTransfer_project_id :: Int,+    projectTransfer_owner_name :: Text,+    projectTransfer_owner_email :: Text,+    projectTransfer_project_visibility :: Visibility,+    projectTransfer_old_path_with_namespace :: Text+  }+  deriving (Typeable, Show, Eq)++instance SystemHook ProjectUpdate where+  match = Match+  matchIf = MatchIf++-- | A project has been updated.+data ProjectUpdate = ProjectUpdate+  { projectUpdate_created_at :: Text,+    projectUpdate_updated_at :: Text,+    projectUpdate_event_name :: Text,+    projectUpdate_name :: Text,+    projectUpdate_owner_email :: Text,+    projectUpdate_owner_name :: Text,+    projectUpdate_path :: Text,+    projectUpdate_path_with_namespace :: Text,+    projectUpdate_project_id :: Int,+    projectUpdate_project_visibility :: Visibility+  }+  deriving (Typeable, Show, Eq)++instance SystemHook UserAddToTeam where+  match = Match+  matchIf = MatchIf++-- | A user has been added to a team.+data UserAddToTeam = UserAddToTeam+  { userAddTeam_created_at :: Text, -- todo improve: date+    userAddTeam_updated_at :: Text, -- todo improve: date+    userAddTeam_event_name :: Text,+    userAddTeam_access_level :: Text, -- todo improve: Maintainer/...+    userAddTeam_project_id :: Int,+    userAddTeam_project_name :: Text,+    userAddTeam_project_path :: Text,+    userAddTeam_project_path_with_namespace :: Text,+    userAddTeam_user_email :: Text,+    userAddTeam_user_name :: Text,+    userAddTeam_user_username :: Text,+    userAddTeam_user_id :: Int,+    userAddTeam_project_visibility :: Visibility+  }+  deriving (Typeable, Show, Eq)++instance SystemHook UserUpdateForTeam where+  match = Match+  matchIf = MatchIf++-- | A user in a team has been updated.+data UserUpdateForTeam = UserUpdateForTeam+  { userUpdateTeam_created_at :: Text, -- todo improve: date+    userUpdateTeam_updated_at :: Text, -- todo improve: date+    userUpdateTeam_event_name :: Text,+    userUpdateTeam_access_level :: Text, -- todo improve: Maintainer/...+    userUpdateTeam_project_id :: Int,+    userUpdateTeam_project_name :: Text,+    userUpdateTeam_project_path :: Text,+    userUpdateTeam_project_path_with_namespace :: Text,+    userUpdateTeam_user_email :: Text,+    userUpdateTeam_user_name :: Text,+    userUpdateTeam_user_username :: Text,+    userUpdateTeam_user_id :: Int,+    userUpdateTeam_project_visibility :: Visibility+  }+  deriving (Typeable, Show, Eq)++instance SystemHook UserRemoveFromTeam where+  match = Match+  matchIf = MatchIf++-- | A user has been removed from a team.+data UserRemoveFromTeam = UserRemoveFromTeam+  { userRemoveTeam_created_at :: Text, -- todo improve: date+    userRemoveTeam_updated_at :: Text, -- todo improve: date+    userRemoveTeam_event_name :: Text,+    userRemoveTeam_access_level :: Text, -- todo improve: Maintainer/...+    userRemoveTeam_project_id :: Int,+    userRemoveTeam_project_name :: Text,+    userRemoveTeam_project_path :: Text,+    userRemoveTeam_project_path_with_namespace :: Text,+    userRemoveTeam_user_email :: Text,+    userRemoveTeam_user_name :: Text,+    userRemoveTeam_user_username :: Text,+    userRemoveTeam_user_id :: Int,+    userRemoveTeam_project_visibility :: Visibility+  }+  deriving (Typeable, Show, Eq)++instance SystemHook UserCreate where+  match = Match+  matchIf = MatchIf++-- | A user has been created.+data UserCreate = UserCreate+  { userCreate_created_at :: Text, -- todo improve: date+    userCreate_updated_at :: Text, -- todo improve: date+    userCreate_email :: Text,+    userCreate_event_name :: Text,+    userCreate_name :: Text,+    userCreate_username :: Text,+    userCreate_user_id :: Int+  }+  deriving (Typeable, Show, Eq)++instance SystemHook UserRemove where+  match = Match+  matchIf = MatchIf++-- | A user has been removed.+data UserRemove = UserRemove+  { userRemove_created_at :: Text, -- todo improve: date+    userRemove_updated_at :: Text, -- todo improve: date+    userRemove_email :: Text,+    userRemove_event_name :: Text,+    userRemove_name :: Text,+    userRemove_username :: Text,+    userRemove_user_id :: Int+  }+  deriving (Typeable, Show, Eq)++instance SystemHook UserFailedLogin where+  match = Match+  matchIf = MatchIf++-- | A user has failed to log in.+data UserFailedLogin = UserFailedLogin+  { userFailedLogin_event_name :: Text,+    userFailedLogin_created_at :: Text, -- todo improve: date+    userFailedLogin_updated_at :: Text, -- todo improve: date+    userFailedLogin_name :: Text,+    userFailedLogin_email :: Text,+    userFailedLogin_user_id :: Int,+    userFailedLogin_username :: Text,+    -- create Haskell sum type for this+    userFailedLogin_state :: Text+  }+  deriving (Typeable, Show, Eq)++instance SystemHook UserRename where+  match = Match+  matchIf = MatchIf++-- | A user has been renamed.+data UserRename = UserRename+  { userRename_event_name :: Text,+    userRename_created_at :: Text, -- todo improve: date+    userRename_updated_at :: Text, -- todo improve: date+    userRename_name :: Text,+    userRename_email :: Text,+    userRename_user_id :: Int,+    userRename_username :: Text,+    userRename_old_username :: Text+  }+  deriving (Typeable, Show, Eq)++instance SystemHook KeyCreate where+  match = Match+  matchIf = MatchIf++-- | A key has been created.+data KeyCreate = KeyCreate+  { keyCreate_event_name :: Text,+    keyCreate_created_at :: Text, -- todo improve: date+    keyCreate_updated_at :: Text, -- todo improve: date+    keyCreate_username :: Text,+    keyCreate_key :: Text,+    keyCreate_id :: Int+  }+  deriving (Typeable, Show, Eq)++instance SystemHook KeyRemove where+  match = Match+  matchIf = MatchIf++-- | A key has been removed.+data KeyRemove = KeyRemove+  { keyRemove_event_name :: Text,+    keyRemove_created_at :: Text, -- todo improve: date+    keyRemove_updated_at :: Text, -- todo improve: date+    keyRemove_username :: Text,+    keyRemove_key :: Text,+    keyRemove_id :: Int+  }+  deriving (Typeable, Show, Eq)++instance SystemHook GroupCreate where+  match = Match+  matchIf = MatchIf++-- | A group has been created.+data GroupCreate = GroupCreate+  { groupCreate_created_at :: Text, -- todo improve: date+    groupCreate_updated_at :: Text, -- todo improve: date+    groupCreate_event_name :: Text,+    groupCreate_name :: Text,+    groupCreate_owner_email :: Maybe Text,+    groupCreate_owner_name :: Maybe Text,+    groupCreate_path :: Text,+    groupCreate_group_id :: Int+  }+  deriving (Typeable, Show, Eq)++instance SystemHook GroupRemove where+  match = Match+  matchIf = MatchIf++-- | A group has been removed.+data GroupRemove = GroupRemove+  { groupRemove_created_at :: Text, -- todo improve: date+    groupRemove_updated_at :: Text, -- todo improve: date+    groupRemove_event_name :: Text,+    groupRemove_name :: Text,+    groupRemove_owner_email :: Maybe Text,+    groupRemove_owner_name :: Maybe Text,+    groupRemove_path :: Text,+    groupRemove_group_id :: Int+  }+  deriving (Typeable, Show, Eq)++instance SystemHook GroupRename where+  match = Match+  matchIf = MatchIf++-- | A group has been renamed.+data GroupRename = GroupRename+  { groupRename_event_name :: Text,+    groupRename_created_at :: Text, -- todo improve: date+    groupRename_updated_at :: Text, -- todo improve: date+    groupRename_name :: Text,+    groupRename_path :: Text,+    groupRename_full_path :: Text,+    groupRename_group_id :: Int,+    groupRename_owner_name :: Maybe Text,+    groupRename_owner_email :: Maybe Text,+    groupRename_old_path :: Text,+    groupRename_old_full_path :: Text+  }+  deriving (Typeable, Show, Eq)++instance SystemHook NewGroupMember where+  match = Match+  matchIf = MatchIf++-- | A user has been added to a group.+data NewGroupMember = NewGroupMember+  { newGroupMember_created_at :: Text, -- todo improve: date+    newGroupMember_updated_at :: Text, -- todo improve: date+    newGroupMember_event_name :: Text,+    newGroupMember_group_access :: Text, -- todo Haskell type for this+    newGroupMember_group_id :: Int,+    newGroupMember_group_name :: Text,+    newGroupMember_group_path :: Text,+    newGroupMember_user_email :: Text,+    newGroupMember_user_name :: Text,+    newGroupMember_user_username :: Text,+    newGroupMember_user_id :: Int+  }+  deriving (Typeable, Show, Eq)++instance SystemHook GroupMemberRemove where+  match = Match+  matchIf = MatchIf++-- | A user has been removed from a group.+data GroupMemberRemove = GroupMemberRemove+  { groupMemberRemove_created_at :: Text, -- todo improve: date+    groupMemberRemove_updated_at :: Text, -- todo improve: date+    groupMemberRemove_event_name :: Text,+    groupMemberRemove_group_access :: Text, -- todo Haskell type for this+    groupMemberRemove_group_id :: Int,+    groupMemberRemove_group_name :: Text,+    groupMemberRemove_group_path :: Text,+    groupMemberRemove_user_email :: Text,+    groupMemberRemove_user_name :: Text,+    groupMemberRemove_user_username :: Text,+    groupMemberRemove_user_id :: Int+  }+  deriving (Typeable, Show, Eq)++instance SystemHook GroupMemberUpdate where+  match = Match+  matchIf = MatchIf++-- | A group member has been updated.+data GroupMemberUpdate = GroupMemberUpdate+  { groupMemberUpdate_created_at :: Text, -- todo improve: date+    groupMemberUpdate_updated_at :: Text, -- todo improve: date+    groupMemberUpdate_event_name :: Text,+    groupMemberUpdate_group_access :: Text, -- todo Haskell type for this+    groupMemberUpdate_group_id :: Int,+    groupMemberUpdate_group_name :: Text,+    groupMemberUpdate_group_path :: Text,+    groupMemberUpdate_user_email :: Text,+    groupMemberUpdate_user_name :: Text,+    groupMemberUpdate_user_username :: Text,+    groupMemberUpdate_user_id :: Int+  }+  deriving (Typeable, Show, Eq)++instance SystemHook Push where+  match = Match+  matchIf = MatchIf++-- | Commits have been pushed to the server.+data Push = Push+  { push_event_name :: Text,+    push_before :: Text,+    push_after :: Text,+    push_ref :: Text,+    push_checkout_sha :: Text,+    push_user_id :: Int,+    push_user_name :: Text,+    push_user_email :: Text,+    push_user_avatar :: Text,+    push_project_id :: Int,+    push_project :: ProjectEvent,+    push_repository :: RepositoryEvent,+    push_commits :: [CommitEvent],+    push_total_commits_count :: Int+  }+  deriving (Typeable, Show, Eq)++instance SystemHook TagPush where+  match = Match+  matchIf = MatchIf++-- | Tags have been pushed to the server.+data TagPush = TagPush+  { tagPush_event_name :: Text,+    tagPush_before :: Text,+    tagPush_after :: Text,+    tagPush_ref :: Text,+    tagPush_checkout_sha :: Text,+    tagPush_user_id :: Int,+    tagPush_user_name :: Text,+    tagPush_user_avatar :: Text,+    tagPush_project_id :: Int,+    tagPush_project :: ProjectEvent,+    tagPush_repository :: RepositoryEvent,+    tagPush_commits :: [CommitEvent],+    tagPush_total_commits_count :: Int+  }+  deriving (Typeable, Show, Eq)++-- | A project event.+data ProjectEvent = ProjectEvent+  { projectEvent_name :: Text,+    projectEvent_description :: Text,+    projectEvent_web_url :: Text,+    projectEvent_avatar_url :: Maybe Text,+    projectEvent_git_ssh_url :: Text,+    projectEvent_git_http_url :: Text,+    projectEvent_namespace :: Text,+    projectEvent_visibility_level :: Visibility,+    projectEvent_path_with_namespace :: Text,+    projectEvent_default_branch :: Text,+    -- projectEvent_ci_config_path :: Maybe Text,+    projectEvent_homepage :: Maybe Text,+    projectEvent_url :: Text,+    projectEvent_ssh_url :: Text,+    projectEvent_http_url :: 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+  }+  deriving (Typeable, Show, Eq, Generic)++-- | A commit event.+data CommitEvent = CommitEvent+  { commitEvent_id :: Text,+    commitEvent_message :: Text,+    commitEvent_timestamp :: Text, -- TODO improve.+    commitEvent_url :: Text,+    commitEvent_author :: CommitAuthorEvent+  }+  deriving (Typeable, Show, Eq, Generic)++-- | Commit author information.+data CommitAuthorEvent = CommitAuthorEvent+  { commitAuthorEvent_name :: Text,+    commitAuthorEvent_email :: Text+  }+  deriving (Typeable, Show, Eq, Generic)++data ProjectAction+  = ProjectCreated+  | ProjectDestroyed+  | ProjectRenamed+  | ProjectTransferred+  | ProjectUpdated+  | UserAddedToTeam+  | UserUpdatedForTeam+  | UserRemovedFromTeam+  | UserCreated+  | UserRemoved+  | UserFailedToLogin+  | UserRenamed+  | KeyCreated+  | KeyRemoved+  | GroupCreated+  | GroupRemoved+  | GroupRenamed+  | GroupMemberAdded+  | GroupMemberRemoved+  | GroupMemberUpdated+  | Pushed+  | TagPushed+  deriving (Show, Eq)++-- |  Project visibility.+data Visibility+  = Public+  | Private+  | Internal+  deriving (Show, Eq)++instance FromJSON ProjectCreate where+  parseJSON =+    withObject "ProjectCreate" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            ProjectCreated ->+              ProjectCreate+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "event_name"+                <*> v .: "name"+                <*> v .: "owner_email"+                <*> v .: "owner_name"+                <*> v .: "path"+                <*> v .: "path_with_namespace"+                <*> v .: "project_id"+                <*> v .: "project_visibility"+            _unexpected -> fail "project_create parsing failed"+        _unexpected -> fail "project_create parsing failed"++instance FromJSON ProjectDestroy where+  parseJSON =+    withObject "ProjectDestroy" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            ProjectDestroyed ->+              ProjectDestroy+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "event_name"+                <*> v .: "name"+                <*> v .: "owner_email"+                <*> v .: "owner_name"+                <*> v .: "path"+                <*> v .: "path_with_namespace"+                <*> v .: "project_id"+                <*> v .: "project_visibility"+            _unexpected -> fail "project_destroy parsing failed"+        _unexpected -> fail "project_destroy parsing failed"++instance FromJSON ProjectRename where+  parseJSON =+    withObject "ProjectRename" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            ProjectRenamed ->+              ProjectRename+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "event_name"+                <*> v .: "name"+                <*> v .: "path"+                <*> v .: "path_with_namespace"+                <*> v .: "project_id"+                <*> v .: "owner_name"+                <*> v .: "owner_email"+                <*> v .: "project_visibility"+                <*> v .: "old_path_with_namespace"+            _unexpected -> fail "project_rename parsing failed"+        _unexpected -> fail "project_rename parsing failed"++instance FromJSON ProjectTransfer where+  parseJSON =+    withObject "ProjectTransfer" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            ProjectTransferred ->+              ProjectTransfer+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "event_name"+                <*> v .: "name"+                <*> v .: "path"+                <*> v .: "path_with_namespace"+                <*> v .: "project_id"+                <*> v .: "owner_name"+                <*> v .: "owner_email"+                <*> v .: "project_visibility"+                <*> v .: "old_path_with_namespace"+            _unexpected -> fail "project_transfer parsing failed"+        _unexpected -> fail "project_transfer parsing failed"++instance FromJSON ProjectUpdate where+  parseJSON =+    withObject "ProjectUpdate" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            ProjectUpdated ->+              ProjectUpdate+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "event_name"+                <*> v .: "name"+                <*> v .: "owner_email"+                <*> v .: "owner_name"+                <*> v .: "path"+                <*> v .: "path_with_namespace"+                <*> v .: "project_id"+                <*> v .: "project_visibility"+            _unexpected -> fail "project_update parsing failed"+        _unexpected -> fail "project_update parsing failed"++instance FromJSON UserAddToTeam where+  parseJSON =+    withObject "UserAddToTeam" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            UserAddedToTeam ->+              UserAddToTeam+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "event_name"+                <*> v .: "access_level"+                <*> v .: "project_id"+                <*> v .: "project_name"+                <*> v .: "project_path"+                <*> v .: "project_path_with_namespace"+                <*> v .: "user_email"+                <*> v .: "user_name"+                <*> v .: "user_username"+                <*> v .: "user_id"+                <*> v .: "project_visibility"+            _unexpected -> fail "user_add_to_team parsing failed"+        _unexpected -> fail "user_add_to_team parsing failed"++instance FromJSON UserUpdateForTeam where+  parseJSON =+    withObject "UserUpdateForTeam" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            UserUpdatedForTeam ->+              UserUpdateForTeam+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "event_name"+                <*> v .: "access_level"+                <*> v .: "project_id"+                <*> v .: "project_name"+                <*> v .: "project_path"+                <*> v .: "project_path_with_namespace"+                <*> v .: "user_email"+                <*> v .: "user_name"+                <*> v .: "user_username"+                <*> v .: "user_id"+                <*> v .: "project_visibility"+            _unexpected -> fail "user_update_for_team parsing failed"+        _unexpected -> fail "user_update_for_team parsing failed"++instance FromJSON UserRemoveFromTeam where+  parseJSON =+    withObject "UserRemoveFromTeam" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            UserRemovedFromTeam ->+              UserRemoveFromTeam+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "event_name"+                <*> v .: "access_level"+                <*> v .: "project_id"+                <*> v .: "project_name"+                <*> v .: "project_path"+                <*> v .: "project_path_with_namespace"+                <*> v .: "user_email"+                <*> v .: "user_name"+                <*> v .: "user_username"+                <*> v .: "user_id"+                <*> v .: "project_visibility"+            _unexpected -> fail "user_remove_from_team parsing failed"+        _unexpected -> fail "user_remove_from_team parsing failed"++instance FromJSON UserCreate where+  parseJSON =+    withObject "UserCreate" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            UserCreated ->+              UserCreate+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "email"+                <*> v .: "event_name"+                <*> v .: "name"+                <*> v .: "username"+                <*> v .: "user_id"+            _unexpected -> fail "user_create parsing failed"+        _unexpected -> fail "user_create parsing failed"++instance FromJSON UserRemove where+  parseJSON =+    withObject "UserRemove" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            UserRemoved ->+              UserRemove+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "email"+                <*> v .: "event_name"+                <*> v .: "name"+                <*> v .: "username"+                <*> v .: "user_id"+            _unexpected -> fail "user_destroy parsing failed"+        _unexpected -> fail "user_destroy parsing failed"++instance FromJSON UserFailedLogin where+  parseJSON =+    withObject "UserFailedLogin" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            UserFailedToLogin ->+              UserFailedLogin+                <$> v .: "event_name"+                <*> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "name"+                <*> v .: "email"+                <*> v .: "user_id"+                <*> v .: "username"+                <*> v .: "state"+            _unexpected -> fail "user_failed_login parsing failed"+        _unexpected -> fail "user_failed_login parsing failed"++instance FromJSON UserRename where+  parseJSON =+    withObject "UserRename" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            UserRenamed ->+              UserRename+                <$> v .: "event_name"+                <*> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "name"+                <*> v .: "email"+                <*> v .: "user_id"+                <*> v .: "username"+                <*> v .: "old_username"+            _unexpected -> fail "user_rename parsing failed"+        _unexpected -> fail "user_rename parsing failed"++instance FromJSON KeyCreate where+  parseJSON =+    withObject "KeyCreate" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            KeyCreated ->+              KeyCreate+                <$> v .: "event_name"+                <*> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "username"+                <*> v .: "key"+                <*> v .: "id"+            _unexpected -> fail "key_create parsing failed"+        _unexpected -> fail "key_create parsing failed"++instance FromJSON KeyRemove where+  parseJSON =+    withObject "KeyRemove" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            KeyRemoved ->+              KeyRemove+                <$> v .: "event_name"+                <*> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "username"+                <*> v .: "key"+                <*> v .: "id"+            _unexpected -> fail "key_destroy parsing failed"+        _unexpected -> fail "key_destroy parsing failed"++instance FromJSON GroupCreate where+  parseJSON =+    withObject "GroupCreate" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            GroupCreated ->+              GroupCreate+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "event_name"+                <*> v .: "name"+                <*> v .: "owner_email"+                <*> v .: "owner_name"+                <*> v .: "path"+                <*> v .: "group_id"+            _unexpected -> fail "group_create parsing failed"+        _unexpected -> fail "group_create parsing failed"++instance FromJSON GroupRemove where+  parseJSON =+    withObject "GroupRemove" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            GroupRemoved ->+              GroupRemove+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "event_name"+                <*> v .: "name"+                <*> v .: "owner_email"+                <*> v .: "owner_name"+                <*> v .: "path"+                <*> v .: "group_id"+            _unexpected -> fail "group_remove parsing failed"+        _unexpected -> fail "group_remove parsing failed"++instance FromJSON GroupRename where+  parseJSON =+    withObject "GroupRename" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            GroupRenamed ->+              GroupRename+                <$> v .: "event_name"+                <*> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "name"+                <*> v .: "path"+                <*> v .: "full_path"+                <*> v .: "group_id"+                <*> v .: "owner_name"+                <*> v .: "owner_email"+                <*> v .: "old_path"+                <*> v .: "old_full_path"+            _unexpected -> fail "group_rename parsing failed"+        _unexpected -> fail "group_rename parsing failed"++instance FromJSON NewGroupMember where+  parseJSON =+    withObject "NewGroupMember" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            GroupMemberAdded ->+              NewGroupMember+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "event_name"+                <*> v .: "group_access"+                <*> v .: "group_id"+                <*> v .: "group_name"+                <*> v .: "group_path"+                <*> v .: "user_email"+                <*> v .: "user_name"+                <*> v .: "user_username"+                <*> v .: "user_id"+            _unexpected -> fail "user_add_to_group parsing failed"+        _unexpected -> fail "user_add_to_group parsing failed"++instance FromJSON GroupMemberRemove where+  parseJSON =+    withObject "GroupMemberRemove" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            GroupMemberRemoved ->+              GroupMemberRemove+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "event_name"+                <*> v .: "group_access"+                <*> v .: "group_id"+                <*> v .: "group_name"+                <*> v .: "group_path"+                <*> v .: "user_email"+                <*> v .: "user_name"+                <*> v .: "user_username"+                <*> v .: "user_id"+            _unexpected -> fail "user_remove_from_group parsing failed"+        _unexpected -> fail "user_remove_from_group parsing failed"++instance FromJSON GroupMemberUpdate where+  parseJSON =+    withObject "GroupMemberUpdate" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            GroupMemberUpdated ->+              GroupMemberUpdate+                <$> v .: "created_at"+                <*> v .: "updated_at"+                <*> v .: "event_name"+                <*> v .: "group_access"+                <*> v .: "group_id"+                <*> v .: "group_name"+                <*> v .: "group_path"+                <*> v .: "user_email"+                <*> v .: "user_name"+                <*> v .: "user_username"+                <*> v .: "user_id"+            _unexpected -> fail "user_update_for_group parsing failed"+        _unexpected -> fail "user_update_for_group parsing failed"++instance FromJSON Push where+  parseJSON =+    withObject "Push" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            Pushed ->+              Push+                <$> v .: "event_name"+                <*> v .: "before"+                <*> v .: "after"+                <*> v .: "ref"+                <*> v .: "checkout_sha"+                <*> v .: "user_id"+                <*> v .: "user_name"+                <*> v .: "user_email"+                <*> v .: "user_avatar"+                <*> v .: "project_id"+                <*> v .: "project"+                <*> v .: "repository"+                <*> v .: "commits"+                <*> v .: "total_commits_count"+            _unexpected -> fail "push parsing failed"+        _unexpected -> fail "push parsing failed"++instance FromJSON TagPush where+  parseJSON =+    withObject "Push" $ \v -> do+      isProjectEvent <- v .:? "event_name"+      case isProjectEvent of+        Just theEvent ->+          case theEvent of+            TagPushed ->+              TagPush+                <$> v .: "event_name"+                <*> v .: "before"+                <*> v .: "after"+                <*> v .: "ref"+                <*> v .: "checkout_sha"+                <*> v .: "user_id"+                <*> v .: "user_name"+                <*> v .: "user_avatar"+                <*> v .: "project_id"+                <*> v .: "project"+                <*> v .: "repository"+                <*> v .: "commits"+                <*> v .: "total_commits_count"+            _unexpected -> fail "tag_push parsing failed"+        _unexpected -> fail "tag_push parsing failed"++bodyNoPrefix :: String -> String+bodyNoPrefix "projectEvent_name" = "name"+bodyNoPrefix "projectEvent_description" = "description"+bodyNoPrefix "projectEvent_web_url" = "web_url"+bodyNoPrefix "projectEvent_avatar_url" = "avatar_url"+bodyNoPrefix "projectEvent_git_ssh_url" = "git_ssh_url"+bodyNoPrefix "projectEvent_git_http_url" = "git_http_url"+bodyNoPrefix "projectEvent_namespace" = "namespace"+bodyNoPrefix "projectEvent_visibility_level" = "visibility_level"+bodyNoPrefix "projectEvent_path_with_namespace" = "path_with_namespace"+bodyNoPrefix "projectEvent_default_branch" = "default_branch"+-- bodyNoPrefix "projectEvent_ci_config_path" = "ci_config_path"+bodyNoPrefix "projectEvent_homepage" = "homepage"+bodyNoPrefix "projectEvent_url" = "url"+bodyNoPrefix "projectEvent_ssh_url" = "ssh_url"+bodyNoPrefix "projectEvent_http_url" = "http_url"+bodyNoPrefix "repositoryEvent_name" = "name"+bodyNoPrefix "repositoryEvent_url" = "url"+bodyNoPrefix "repositoryEvent_description" = "description"+bodyNoPrefix "repositoryEvent_homepage" = "homepage"+bodyNoPrefix "repositoryEvent_git_http_url" = "git_http_url"+bodyNoPrefix "repositoryEvent_git_ssh_url" = "git_ssh_url"+bodyNoPrefix "repositoryEvent_visibility_level" = "visibility_level"+bodyNoPrefix "commitEvent_id" = "id"+bodyNoPrefix "commitEvent_message" = "message"+bodyNoPrefix "commitEvent_timestamp" = "timestamp"+bodyNoPrefix "commitEvent_url" = "url"+bodyNoPrefix "commitEvent_author" = "author"+bodyNoPrefix "commitAuthorEvent_name" = "name"+bodyNoPrefix "commitAuthorEvent_email" = "email"+bodyNoPrefix s = error s++instance FromJSON ProjectEvent where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON CommitEvent where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON RepositoryEvent where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON CommitAuthorEvent where+  parseJSON =+    genericParseJSON+      ( defaultOptions+          { fieldLabelModifier = bodyNoPrefix+          }+      )++instance FromJSON ProjectAction where+  parseJSON (String "project_create") = return ProjectCreated+  parseJSON (String "project_destroy") = return ProjectDestroyed+  parseJSON (String "project_rename") = return ProjectRenamed+  parseJSON (String "project_transfer") = return ProjectTransferred+  parseJSON (String "project_update") = return ProjectUpdated+  parseJSON (String "user_add_to_team") = return UserAddedToTeam+  parseJSON (String "user_update_for_team") = return UserUpdatedForTeam+  parseJSON (String "user_remove_from_team") = return UserRemovedFromTeam+  parseJSON (String "user_create") = return UserCreated+  parseJSON (String "user_destroy") = return UserRemoved+  parseJSON (String "user_failed_login") = return UserFailedToLogin+  parseJSON (String "user_rename") = return UserRenamed+  parseJSON (String "key_create") = return KeyCreated+  parseJSON (String "key_destroy") = return KeyRemoved+  parseJSON (String "group_create") = return GroupCreated+  parseJSON (String "group_destroy") = return GroupRemoved+  parseJSON (String "group_rename") = return GroupRenamed+  parseJSON (String "user_add_to_group") = return GroupMemberAdded+  parseJSON (String "user_remove_from_group") = return GroupMemberRemoved+  parseJSON (String "user_update_for_group") = return GroupMemberUpdated+  parseJSON (String "push") = return Pushed+  parseJSON (String "tag_push") = return TagPushed+  parseJSON s = error (show s)++instance FromJSON Visibility where+  parseJSON (String "public") = return Public+  parseJSON (String "private") = return Private+  parseJSON (String "internal") = return Internal+  parseJSON (Number 0) = return Private+  parseJSON (Number 10) = return Internal+  parseJSON (Number 20) = return Public+  parseJSON n = error (show n)

@@ -2,6 +2,7 @@ {-# LANGUAGE LambdaCase #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-}+{-# LANGUAGE StrictData #-}  -- | -- Module      : GitLab.Types@@ -21,11 +22,14 @@     Links (..),     Owner (..),     Permissions (..),+    ProjectId,     Project (..),     ProjectStats (..),     User (..),     Milestone (..),+    MilestoneState (..),     TimeStats (..),+    IssueId,     Issue (..),     Pipeline (..),     Commit (..),@@ -41,11 +45,13 @@     RepositoryFile (..),     MergeRequest (..),     Todo (..),+    TodoProject (..),     TodoAction (..),     TodoTarget (..),     TodoState (..),     Version (..),     URL,+    EditIssueReq (..),   ) where @@ -53,31 +59,30 @@ import Data.Aeson import Data.Aeson.Types import Data.Text (Text)+import qualified Data.Text as T import Data.Time.Clock import GHC.Generics import Network.HTTP.Conduit  -- | type synonym for all GitLab actions.-type GitLab m a = ReaderT GitLabState m a+type GitLab a = ReaderT GitLabState IO a  -- | state used by GitLab actions, used internally.-data GitLabState-  = GitLabState-      { serverCfg :: GitLabServerConfig,-        httpManager :: Manager-      }+data GitLabState = GitLabState+  { serverCfg :: GitLabServerConfig,+    httpManager :: Manager+  }  -- | configuration data specific to a GitLab server.-data GitLabServerConfig-  = GitLabServerConfig-      { url :: Text,-        -- | personal access token, see <https://docs.gitlab.com/ee/user/profile/personal_access_tokens.html>-        token :: Text,-        -- | milliseconds-        timeout :: Int,-        -- | how many times to retry a HTTP request before giving up and returning an error.-        retries :: Int-      }+data GitLabServerConfig = GitLabServerConfig+  { url :: Text,+    -- | personal access token, see <https://docs.gitlab.com/ee/user/profile/personal_access_tokens.html>+    token :: Text,+    -- | milliseconds+    timeout :: Int,+    -- | how many times to retry a HTTP request before giving up and returning an error.+    retries :: Int+  }  -- | default settings, the 'url' and 'token' values will need to be overwritten. defaultGitLabServer :: GitLabServerConfig@@ -123,138 +128,130 @@   show Zip = ".zip"  -- | member of a project.-data Member-  = Member-      { member_id :: Int,-        member_name :: Text,-        member_username :: Text,-        member_state :: Text,-        member_avatar_uri :: Maybe Text,-        member_web_url :: Maybe Text,-        access_level :: Int,-        expires_at :: Maybe Text-      }+data Member = Member+  { member_id :: Int,+    member_name :: Text,+    member_username :: Text,+    member_state :: Text,+    member_avatar_uri :: Maybe Text,+    member_web_url :: Maybe Text,+    access_level :: Int,+    expires_at :: Maybe Text+  }   deriving (Generic, Show)  -- | namespaces.-data Namespace-  = Namespace-      { namespace_id :: Int,-        namespace_name :: Text,-        namespace_path :: Text,-        kind :: Text,-        full_path :: Text,-        parent_id :: Maybe Int-      }+data Namespace = Namespace+  { namespace_id :: Int,+    namespace_name :: Text,+    namespace_path :: Text,+    kind :: Text,+    full_path :: Text,+    parent_id :: Maybe Int+  }   deriving (Generic, Show)  -- | links.-data Links-  = Links-      { self :: Text,-        issues :: Text,-        merge_requests :: Text,-        repo_branches :: Text,-        link_labels :: Text,-        link_events :: Text,-        members :: Text-      }+data Links = Links+  { self :: Text,+    issues :: Text,+    merge_requests :: Text,+    repo_branches :: Text,+    link_labels :: Text,+    link_events :: Text,+    members :: Text+  }   deriving (Generic, Show)  -- | owners.-data Owner-  = Ownwer-      { owner_id :: Int,-        owner_name :: Text,-        owner_username :: Text,-        state :: Text,-        owner_avatar_url :: Maybe Text,-        owner_web_url :: Text-      }+data Owner = Ownwer+  { owner_id :: Int,+    owner_name :: Text,+    owner_username :: Text,+    state :: Text,+    owner_avatar_url :: Maybe Text,+    owner_web_url :: Text+  }   deriving (Generic, Show)  -- | permissions.-data Permissions-  = Permissions-      { project_access :: Maybe Object,-        group_access :: Maybe Object-      }+data Permissions = Permissions+  { project_access :: Maybe Object,+    group_access :: Maybe Object+  }   deriving (Generic, Show)  -- | projects.-data Project-  = Project-      { project_id :: Int,-        description :: Maybe Text,-        project_name :: Text,-        name_with_namespace :: Text,-        project_path :: Text,-        path_with_namespace :: Text,-        project_created_at :: Text,-        default_branch :: Maybe Text,-        tag_list :: [Text], -- check-        ssh_url_to_repo :: Text,-        http_url_to_repo :: Text,-        project_web_url :: Text,-        readme_url :: Maybe Text, -- check-        project_avatar_url :: Maybe Text, -- check-        star_count :: Int,-        forks_count :: Int,-        last_activity_at :: Text,-        namespace :: Namespace,-        _links :: Maybe Links,-        archived :: Maybe Bool,-        visibility :: Maybe Text,-        owner :: Maybe Owner,-        resolve_outdated_diff_discussions :: Maybe Bool,-        container_registry_enabled :: Maybe Bool,-        issues_enabled :: Maybe Bool,-        merge_requests_enabled :: Maybe Bool,-        wiki_enabled :: Maybe Bool,-        jobs_enabled :: Maybe Bool,-        snippets_enabled :: Maybe Bool,-        shared_runners_enabled :: Maybe Bool,-        lfs_enabled :: Maybe Bool,-        creator_id :: Maybe Int,-        forked_from_project :: Maybe Project,-        import_status :: Maybe String,-        open_issues_count :: Maybe Int,-        public_jobs :: Maybe Bool,-        ci_config_path :: Maybe Text, -- check null-        shared_with_groups :: Maybe [Object],-        only_allow_merge_if_pipeline_succeeds :: Maybe Bool,-        request_access_enabled :: Maybe Bool,-        only_allow_merge_if_all_discussions_are_resolved :: Maybe Bool,-        printing_merge_request_link_enabled :: Maybe Bool,-        merge_method :: Maybe Text,-        permissions :: Maybe Permissions,-        project_stats :: Maybe ProjectStats-      }+data Project = Project+  { project_id :: Int,+    description :: Maybe Text,+    project_name :: Text,+    name_with_namespace :: Text,+    project_path :: Text,+    project_path_with_namespace :: Text,+    project_created_at :: Text,+    default_branch :: Maybe Text,+    tag_list :: [Text], -- check+    ssh_url_to_repo :: Text,+    http_url_to_repo :: Text,+    project_web_url :: Text,+    readme_url :: Maybe Text, -- check+    project_avatar_url :: Maybe Text, -- check+    star_count :: Int,+    forks_count :: Int,+    last_activity_at :: Text,+    namespace :: Namespace,+    _links :: Maybe Links,+    archived :: Maybe Bool,+    visibility :: Maybe Text,+    owner :: Maybe Owner,+    resolve_outdated_diff_discussions :: Maybe Bool,+    container_registry_enabled :: Maybe Bool,+    issues_enabled :: Maybe Bool,+    merge_requests_enabled :: Maybe Bool,+    wiki_enabled :: Maybe Bool,+    jobs_enabled :: Maybe Bool,+    snippets_enabled :: Maybe Bool,+    shared_runners_enabled :: Maybe Bool,+    lfs_enabled :: Maybe Bool,+    creator_id :: Maybe Int,+    forked_from_project :: Maybe Project,+    import_status :: Maybe String,+    open_issues_count :: Maybe Int,+    public_jobs :: Maybe Bool,+    ci_config_path :: Maybe Text, -- check null+    shared_with_groups :: Maybe [Object],+    only_allow_merge_if_pipeline_succeeds :: Maybe Bool,+    request_access_enabled :: Maybe Bool,+    only_allow_merge_if_all_discussions_are_resolved :: Maybe Bool,+    printing_merge_request_link_enabled :: Maybe Bool,+    merge_method :: Maybe Text,+    permissions :: Maybe Permissions,+    project_stats :: Maybe ProjectStats+  }   deriving (Generic, Show)  -- | project statistics.-data ProjectStats-  = ProjectStats-      { commit_count :: Int,-        storage_size :: Int,-        repository_size :: Int,-        wiki_size :: Maybe Int,-        lfs_objects_size :: Maybe Int,-        job_artifacts_size :: Maybe Int,-        packages_size :: Maybe Int-      }+data ProjectStats = ProjectStats+  { commit_count :: Int,+    storage_size :: Int,+    repository_size :: Int,+    wiki_size :: Maybe Int,+    lfs_objects_size :: Maybe Int,+    job_artifacts_size :: Maybe Int,+    packages_size :: Maybe Int+  }   deriving (Generic, Show)  -- | registered users.-data User-  = User-      { user_id :: Int,-        user_username :: Text,-        user_name :: Text,-        user_state :: Text,-        user_avatar_uri :: Maybe Text,-        user_web_url :: Maybe Text-      }+data User = User+  { user_id :: Int,+    user_username :: Text,+    user_name :: Text,+    user_state :: Text,+    user_avatar_uri :: Maybe Text,+    user_web_url :: Maybe Text+  }   deriving (Generic, Show)  -- | milestone state.@@ -269,282 +266,272 @@   parseJSON x = unexpected x  -- | milestones.-data Milestone-  = Milestone-      { milestone_project_id :: Maybe Int,-        milestone_group_id :: Maybe Int,-        milestone_description :: Text,-        milestone_state :: MilestoneState,-        milestone_due_date :: Maybe UTCTime,-        milestone_iid :: Int,-        milestone_created_at :: Maybe UTCTime,-        milestone_title :: Text,-        milestone_id :: Int,-        milestone_updated_at :: UTCTime,-        milestone_web_url :: URL-      }+data Milestone = Milestone+  { milestone_project_id :: Maybe Int,+    milestone_group_id :: Maybe Int,+    milestone_description :: Text,+    milestone_state :: MilestoneState,+    milestone_due_date :: Maybe UTCTime,+    milestone_iid :: Int,+    milestone_created_at :: Maybe UTCTime,+    milestone_title :: Text,+    milestone_id :: Int,+    milestone_updated_at :: UTCTime,+    milestone_web_url :: URL+  }   deriving (Generic, Show)  instance FromJSON Milestone where   parseJSON = genericParseJSON (defaultOptions {fieldLabelModifier = drop 10})  -- | time stats.-data TimeStats-  = TimeStats-      { time_estimate :: Int,-        total_time_spent :: Int,-        humane_time_estimate :: Maybe Int,-        human_total_time_spent :: Maybe Int-      }+data TimeStats = TimeStats+  { time_estimate :: Int,+    total_time_spent :: Int,+    humane_time_estimate :: Maybe Int,+    human_total_time_spent :: Maybe Int+  }   deriving (Generic, Show) +-- | alias for project id+type ProjectId = Int++-- | alias for issue id+type IssueId = Int+ -- | project issues.-data Issue-  = Issue-      { issue_state :: Text,-        issue_description :: Text,-        issue_author :: User,-        milestone :: Maybe Milestone,-        issue_project_id :: Int,-        assignees :: Maybe [User],-        assignee :: Maybe User,-        updated_at :: Text,-        closed_at :: Maybe Text,-        closed_by :: Maybe User,-        issue_id :: Int,-        issue_title :: Text,-        issue_created_at :: Text,-        iid :: Int,-        issue_labels :: [Text],-        upvotes :: Int,-        downvotes :: Int,-        user_notes_count :: Int,-        issue_due_date :: Maybe Text,-        issue_web_url :: Text,-        confidential :: Bool,-        weight :: Maybe Text, -- Int?-        discussion_locked :: Maybe Bool,-        time_stats :: TimeStats-      }+data Issue = Issue+  { issue_state :: Text,+    issue_description :: Maybe Text,+    issue_author :: User,+    milestone :: Maybe Milestone,+    issue_project_id :: ProjectId,+    assignees :: Maybe [User],+    assignee :: Maybe User,+    updated_at :: Text,+    closed_at :: Maybe Text,+    closed_by :: Maybe User,+    issue_id :: IssueId,+    issue_title :: Text,+    issue_created_at :: Text,+    iid :: Int,+    issue_labels :: [Text],+    upvotes :: Int,+    downvotes :: Int,+    user_notes_count :: Int,+    issue_due_date :: Maybe Text,+    issue_web_url :: Text,+    confidential :: Bool,+    weight :: Maybe Text, -- Int?+    discussion_locked :: Maybe Bool,+    time_stats :: TimeStats+  }   deriving (Generic, Show)  -- | project pipelines-data Pipeline-  = Pipeline-      { pipeline_id :: Int,-        sha :: Text,-        pipeline_ref :: Text,-        pipeline_status :: Text,-        pipeline_web_url :: Maybe Text-      }+data Pipeline = Pipeline+  { pipeline_id :: Int,+    sha :: Text,+    pipeline_ref :: Text,+    pipeline_status :: Text,+    pipeline_web_url :: Maybe Text+  }   deriving (Generic, Show)  -- | code commits.-data Commit-  = Commit-      { commit_id :: Text,-        short_id :: Text,-        title :: Text,-        author_name :: Text,-        author_email :: Text,-        authored_date :: Text,-        committer_name :: Text,-        committer_email :: Text,-        committed_date :: Text,-        commit_created_at :: Text,-        message :: Text,-        parent_ids :: Maybe [Int],-        last_pipeline :: Maybe Pipeline,-        commit_stats :: Maybe CommitStats,-        commit_status :: Maybe Text-      }+data Commit = Commit+  { commit_id :: Text,+    short_id :: Text,+    title :: Text,+    author_name :: Text,+    author_email :: Text,+    authored_date :: Text,+    committer_name :: Text,+    committer_email :: Text,+    committed_date :: Text,+    commit_created_at :: Text,+    message :: Text,+    commit_parent_ids :: Maybe [String],+    last_pipeline :: Maybe Pipeline,+    commit_stats :: Maybe CommitStats,+    commit_status :: Maybe Text+  }   deriving (Generic, Show)  -- | summary of a code commit for TODOs.-data CommitTodo-  = CommitTodo-      { todo_commit_id :: Text,-        todo_commit_short_id :: Text,-        todo_commit_created_at :: Text,-        todo_parent_ids :: Maybe [Int]-      }+data CommitTodo = CommitTodo+  { todo_commit_id :: Text,+    todo_commit_short_id :: Text,+    todo_commit_created_at :: Text,+    todo_parent_ids :: Maybe [String]+  }   deriving (Generic, Show)  -- | commit stats.-data CommitStats-  = Stats-      { additions :: Int,-        deletions :: Int,-        total :: Int-      }+data CommitStats = Stats+  { additions :: Int,+    deletions :: Int,+    total :: Int+  }   deriving (Generic, Show)  -- | diff between two commits.-data Diff-  = Diff-      { diff :: Text,-        new_path :: Text,-        old_path :: Text,-        a_mode :: Maybe Text,-        b_mode :: Maybe Text,-        new_file :: Bool,-        renamed_file :: Bool,-        deleted_file :: Bool-      }+data Diff = Diff+  { diff :: Text,+    new_path :: Text,+    old_path :: Text,+    a_mode :: Maybe Text,+    b_mode :: Maybe Text,+    new_file :: Bool,+    renamed_file :: Bool,+    deleted_file :: Bool+  }   deriving (Generic, Show)  -- | repositories.-data Repository-  = Repository-      { repository_id :: Text,-        repository_name :: Text,-        repository_type :: Text,-        repository_path :: Text,-        mode :: Text-      }+data Repository = Repository+  { repository_id :: Text,+    repository_name :: Text,+    repository_type :: Text,+    repository_path :: Text,+    mode :: Text+  }   deriving (Generic, Show)  -- | jobs.-data Job-  = Job-      { commit :: Commit,-        coverage :: Maybe Text, -- ?-        created_at :: Text,-        started_at :: Text,-        finished_at :: Text,-        duration :: Double,-        artifacts_expire_at :: Maybe Text,-        id :: Int,-        name :: Text,-        pipeline :: Pipeline,-        job_ref :: Text,-        artifacts :: [Artifact],-        -- , runner :: Maybe Text-        stage :: Text,-        status :: Text,-        tag :: Bool,-        job_web_url :: Text,-        user :: User-      }+data Job = Job+  { job_commit :: Commit,+    job_coverage :: Maybe Text, -- ?+    job_created_at :: Text,+    job_started_at :: Text,+    job_finished_at :: Text,+    job_duration :: Double,+    job_artifacts_expire_at :: Maybe Text,+    job_id :: Int,+    job_name :: Text,+    job_pipeline :: Pipeline,+    job_ref :: Text,+    job_artifacts :: [Artifact],+    -- , runner :: Maybe Text+    job_stage :: Text,+    job_status :: Text,+    job_tag :: Bool,+    job_web_url :: Text,+    job_user :: User+  }   deriving (Generic, Show)  -- | artifacts.-data Artifact-  = Artifact-      { file_type :: Text,-        size :: Int,-        filename :: Text,-        file_format :: Maybe Text-      }+data Artifact = Artifact+  { file_type :: Text,+    size :: Int,+    filename :: Text,+    file_format :: Maybe Text+  }   deriving (Generic, Show)  -- | groups.-data Group-  = Group-      { group_id :: Int,-        group_name :: Text,-        group_path :: Text,-        group_description :: Text,-        group_visibility :: Text,-        group_lfs_enabled :: Bool,-        group_avatar_url :: Maybe Text,-        group_web_url :: Text,-        group_request_access_enabled :: Bool,-        group_full_name :: Text,-        group_full_path :: Text,-        group_file_template_project_id :: Maybe Int,-        group_parent_id :: Maybe Int-      }+data Group = Group+  { group_id :: Int,+    group_name :: Text,+    group_path :: Text,+    group_description :: Text,+    group_visibility :: Text,+    group_lfs_enabled :: Bool,+    group_avatar_url :: Maybe Text,+    group_web_url :: Text,+    group_request_access_enabled :: Bool,+    group_full_name :: Text,+    group_full_path :: Text,+    group_file_template_project_id :: Maybe Int,+    group_parent_id :: Maybe Int+  }   deriving (Generic, Show)  -- | response to sharing a project with a group.-data GroupShare-  = GroupShare-      { share_id :: Int,-        share_project_id :: Int,-        share_group_id :: Int,-        share_group_access :: Int,-        share_expires_at :: Maybe Text-      }+data GroupShare = GroupShare+  { share_id :: Int,+    share_project_id :: Int,+    share_group_id :: Int,+    share_group_access :: Int,+    share_expires_at :: Maybe Text+  }   deriving (Generic, Show)  -- | code branches.-data Branch-  = Branch-      { branch_name :: Text,-        merged :: Bool,-        protected :: Bool,-        branch_default :: Bool,-        developers_can_push :: Bool,-        developers_can_merge :: Bool,-        can_push :: Bool,-        branch_commit :: Commit-      }+data Branch = Branch+  { branch_name :: Text,+    merged :: Bool,+    protected :: Bool,+    branch_default :: Bool,+    developers_can_push :: Bool,+    developers_can_merge :: Bool,+    can_push :: Bool,+    branch_commit :: Commit+  }   deriving (Generic, Show)  -- | files in a repository.-data RepositoryFile-  = RepositoryFile-      { repository_file_file_name :: Text,-        repository_file_file_path :: Text,-        repository_file_size :: Int,-        encoding :: Text,-        content :: Text,-        content_sha256 :: Text,-        ref :: Text,-        blob_id :: Text,-        repository_file_commit_id :: Text,-        last_commit_id :: Text-      }+data RepositoryFile = RepositoryFile+  { repository_file_file_name :: Text,+    repository_file_file_path :: Text,+    repository_file_size :: Int,+    encoding :: Text,+    content :: Text,+    content_sha256 :: Text,+    ref :: Text,+    blob_id :: Text,+    repository_file_commit_id :: Text,+    last_commit_id :: Text+  }   deriving (Generic, Show)  -- | project merge requests.-data MergeRequest-  = MergeRequest-      { merge_request_id :: Int,-        merge_request_iid :: Int,-        merge_request_project_id :: Int,-        merge_request_title :: Text,-        merge_request_description :: Text,-        merge_request_state :: Text,-        merge_request_merged_by :: Maybe User,-        merge_request_merged_at :: Maybe Text,-        merge_request_closed_by :: Maybe User,-        merge_request_closed_at :: Maybe Text,-        merge_request_created_at :: Text,-        merge_request_updated_at :: Text,-        merge_request_target_branch :: Text,-        merge_request_source_branch :: Text,-        merge_request_upvotes :: Int,-        merge_request_downvotes :: Int,-        merge_request_author :: User,-        merge_request_assignee :: Maybe User,-        merge_request_source_project_id :: Int,-        merge_request_target_project_id :: Int,-        merge_request_labels :: [Text],-        merge_request_work_in_progress :: Bool,-        merge_request_milestone :: Maybe Milestone,-        merge_request_merge_when_pipeline_succeeds :: Bool,-        merge_request_merge_status :: Text,-        merge_request_sha :: Text,-        merge_request_merge_commit_sha :: Maybe Text,-        merge_request_user_notes_count :: Int,-        merge_request_discussion_locked :: Maybe Bool,-        merge_request_should_remove_source_branch :: Maybe Bool,-        merge_request_force_remove_source_branch :: Maybe Bool,-        merge_request_allow_collaboration :: Maybe Bool,-        merge_request_allow_maintainer_to_push :: Maybe Bool,-        merge_request_web_url :: Text,-        merge_request_time_stats :: TimeStats,-        merge_request_squash :: Bool,-        merge_request_changes_count :: Maybe Int,-        merge_request_pipeline :: Maybe Pipeline,-        merge_request_diverged_commits_count :: Maybe Int,-        merge_request_rebase_in_progress :: Maybe Bool,-        merge_request_has_conflicts :: Bool,-        merge_request_blocking_discussions_resolved :: Maybe Bool,-        merge_request_approvals_before_merge :: Maybe Bool -- ?-      }+data MergeRequest = MergeRequest+  { merge_request_id :: Int,+    merge_request_iid :: Int,+    merge_request_project_id :: Int,+    merge_request_title :: Text,+    merge_request_description :: Text,+    merge_request_state :: Text,+    merge_request_merged_by :: Maybe User,+    merge_request_merged_at :: Maybe Text,+    merge_request_closed_by :: Maybe User,+    merge_request_closed_at :: Maybe Text,+    merge_request_created_at :: Text,+    merge_request_updated_at :: Text,+    merge_request_target_branch :: Text,+    merge_request_source_branch :: Text,+    merge_request_upvotes :: Int,+    merge_request_downvotes :: Int,+    merge_request_author :: User,+    merge_request_assignee :: Maybe User,+    merge_request_source_project_id :: Int,+    merge_request_target_project_id :: Int,+    merge_request_labels :: [Text],+    merge_request_work_in_progress :: Bool,+    merge_request_milestone :: Maybe Milestone,+    merge_request_merge_when_pipeline_succeeds :: Bool,+    merge_request_merge_status :: Text,+    merge_request_sha :: Text,+    merge_request_merge_commit_sha :: Maybe Text,+    merge_request_user_notes_count :: Int,+    merge_request_discussion_locked :: Maybe Bool,+    merge_request_should_remove_source_branch :: Maybe Bool,+    merge_request_force_remove_source_branch :: Maybe Bool,+    merge_request_allow_collaboration :: Maybe Bool,+    merge_request_allow_maintainer_to_push :: Maybe Bool,+    merge_request_web_url :: Text,+    merge_request_time_stats :: TimeStats,+    merge_request_squash :: Bool,+    merge_request_changes_count :: Maybe Int,+    merge_request_pipeline :: Maybe Pipeline,+    merge_request_diverged_commits_count :: Maybe Int,+    merge_request_rebase_in_progress :: Maybe Bool,+    merge_request_has_conflicts :: Bool,+    merge_request_blocking_discussions_resolved :: Maybe Bool,+    merge_request_approvals_before_merge :: Maybe Bool -- ?+  }   deriving (Generic, Show)  -- | TODO actions.@@ -589,34 +576,33 @@   parseJSON (String "done") = return TSDone   parseJSON x = unexpected x -data TodoProject-  = TP-      { tp_id :: Int,-        tp_description :: Text,-        tp_name :: Text,-        tp_name_with_namespace :: Text,-        tp_path :: Text,-        tp_path_with_namespace :: Text,-        tp_created_at :: UTCTime-      }+-- | A project TODO.+data TodoProject = TP+  { tp_id :: Int,+    tp_description :: Text,+    tp_name :: Text,+    tp_name_with_namespace :: Text,+    tp_path :: Text,+    tp_path_with_namespace :: Text,+    tp_created_at :: UTCTime+  }   deriving (Generic, Show)  instance FromJSON TodoProject where   parseJSON = genericParseJSON (defaultOptions {fieldLabelModifier = drop 3})  -- | TODOs.-data Todo-  = Todo-      { todo_id :: Int,-        todo_project :: TodoProject,-        todo_author :: User,-        todo_action_name :: TodoAction,-        todo_target :: TodoTarget,-        todo_target_url :: URL,-        todo_body :: Text,-        todo_state :: TodoState,-        todo_created_at :: UTCTime-      }+data Todo = Todo+  { todo_id :: Int,+    todo_project :: TodoProject,+    todo_author :: User,+    todo_action_name :: TodoAction,+    todo_target :: TodoTarget,+    todo_target_url :: URL,+    todo_body :: Text,+    todo_state :: TodoState,+    todo_created_at :: UTCTime+  }   deriving (Show)  instance FromJSON Todo where@@ -638,13 +624,32 @@       <*> v .: "created_at"  -- | version of the GitLab instance.-data Version-  = Version-      { version :: Text,-        revision :: Text-      }+data Version = Version+  { version :: Text,+    revision :: Text+  }   deriving (Generic, Show) +-- | An edit issue request.+data EditIssueReq = EditIssueReq+  { edit_issue_id :: ProjectId,+    edit_issue_issue_iid :: IssueId,+    edit_issue_title :: Maybe Text,+    edit_issue_description :: Maybe Text,+    edit_issue_confidential :: Maybe Bool,+    edit_issue_assignee_ids :: Maybe [Int],+    edit_issue_milestone_id :: Maybe Int,+    edit_issue_labels :: Maybe [Text],+    edit_issue_state_event :: Maybe Text,+    edit_issue_updated_at :: Maybe Text,+    edit_issue_due_date :: Maybe Text,+    edit_issue_weight :: Maybe Int,+    edit_issue_discussion_locked :: Maybe Bool,+    edit_issue_epic_id :: Maybe Int,+    edit_issue_epic_iid :: Maybe Int+  }+  deriving (Generic, Show)+ ----------------------------- -- JSON GitLab parsers below -----------------------------@@ -653,6 +658,7 @@ bodyNoPrefix "commit_created_at" = "created_at" bodyNoPrefix "commit_id" = "id" bodyNoPrefix "commit_status" = "status"+bodyNoPrefix "commit_parent_ids" = "parent_ids" bodyNoPrefix "todo_commit_id" = "id" bodyNoPrefix "todo_commit_short_id" = "short_id" bodyNoPrefix "todo_commit_created_at" = "created_at"@@ -667,7 +673,6 @@ bodyNoPrefix "issue_state" = "state" bodyNoPrefix "issue_title" = "title" bodyNoPrefix "issue_web_url" = "web_url"-bodyNoPrefix "job_web_url" = "web_url" bodyNoPrefix "link_events" = "events" bodyNoPrefix "link_labels" = "labels" bodyNoPrefix "member_avatar_url" = "avatar_url"@@ -692,6 +697,7 @@ bodyNoPrefix "project_id" = "id" bodyNoPrefix "project_name" = "name" bodyNoPrefix "project_path" = "path"+bodyNoPrefix "project_path_with_namespace" = "path_with_namespace" bodyNoPrefix "project_web_url" = "web_url" bodyNoPrefix "repository_id" = "id" bodyNoPrefix "repository_name" = "name"@@ -705,7 +711,6 @@ bodyNoPrefix "user_web_url" = "we_url" bodyNoPrefix "event_title" = "title" bodyNoPrefix "event_project_id" = "project_id"-bodyNoPrefix "job_ref" = "ref" bodyNoPrefix "pipeline_ref" = "ref" bodyNoPrefix "branch_name" = "name" bodyNoPrefix "branch_default" = "default"@@ -778,6 +783,23 @@ bodyNoPrefix "group_full_path" = "full_path" bodyNoPrefix "group_file_template_project_id" = "file_template_project_id" bodyNoPrefix "group_parent_id" = "parent_id"+bodyNoPrefix "job_commit" = "commit"+bodyNoPrefix "job_coverage" = "coverage"+bodyNoPrefix "job_created_at" = "created_at"+bodyNoPrefix "job_started_at" = "started_at"+bodyNoPrefix "job_finished_at" = "finished_at"+bodyNoPrefix "job_duration" = "duration"+bodyNoPrefix "job_artifacts_expire_at" = "artifacts_expire_at"+bodyNoPrefix "job_id" = "id"+bodyNoPrefix "job_name" = "name"+bodyNoPrefix "job_pipeline" = "pipeline"+bodyNoPrefix "job_ref" = "ref"+bodyNoPrefix "job_artifacts" = "artifacts"+bodyNoPrefix "job_stage" = "stage"+bodyNoPrefix "job_status" = "status"+bodyNoPrefix "job_tag" = "tag"+bodyNoPrefix "job_web_url" = "web_url"+bodyNoPrefix "job_user" = "user" -- TODO field names for Issues data type bodyNoPrefix s = s @@ -972,3 +994,11 @@           { fieldLabelModifier = bodyNoPrefix           }       )++instance ToJSON EditIssueReq where+  toEncoding =+    genericToEncoding+      defaultOptions+        { fieldLabelModifier = drop (T.length "edit_issue_"),+          omitNothingFields = True+        }

@@ -8,10 +8,12 @@     gitlabWithAttrs,     gitlabWithAttrsUnsafe,     gitlabOne,+    -- gitlabOneIO,     gitlabWithAttrsOne,     -- not currently used.     -- gitlabWithAttrsOneUnsafe,     gitlabPost,+    gitlabPut,     gitlabReqText,     gitlabReqByteString,   )@@ -31,6 +33,7 @@ import Network.HTTP.Conduit import Network.HTTP.Types.Status import Network.HTTP.Types.URI+import Text.Read  newtype GitLabException = GitLabException String   deriving (Eq, Show)@@ -41,12 +44,12 @@ -- error code responses, e.g. 404, 409.  gitlabPost ::-  (MonadIO m, FromJSON b) =>+  (FromJSON b) =>   -- | the URL to post to   Text ->   -- | the data to post   Text ->-  GitLab m (Either Status b)+  GitLab (Either Status b) gitlabPost urlPath dataBody = do   cfg <- serverCfg <$> ask   manager <- httpManager <$> ask@@ -71,6 +74,39 @@         )     else return (Left (responseStatus resp)) +gitlabPut ::+  FromJSON b =>+  -- | the URL to post to+  Text ->+  -- | the data to post+  Text ->+  GitLab (Either Status b)+gitlabPut urlPath dataBody = do+  cfg <- serverCfg <$> ask+  manager <- httpManager <$> ask+  let url' = url cfg <> "/api/v4" <> urlPath+  let request' = parseRequest_ (T.unpack url')+      request =+        request'+          { method = "PUT",+            requestHeaders =+              [ ("PRIVATE-TOKEN", T.encodeUtf8 (token cfg)),+                ("content-type", "application/json")+              ],+            requestBody = RequestBodyBS (T.encodeUtf8 dataBody)+          }+  resp <- liftIO $ tryGitLab 0 request (retries cfg) manager Nothing+  if successStatus (responseStatus resp)+    then+      return+        ( case parseBSOne (responseBody resp) of+            Just x -> Right x+            Nothing ->+              Left $+                mkStatus 409 "unable to parse PUT response"+        )+    else return (Left (responseStatus resp))+ tryGitLab ::   -- | the current retry count   Int ->@@ -102,7 +138,7 @@     Left s -> Exception.throwIO $ GitLabException s     Right xs -> return xs -gitlabReqJsonMany :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m (Either Status [a])+gitlabReqJsonMany :: (FromJSON a) => Text -> Text -> GitLab (Either Status [a]) gitlabReqJsonMany urlPath attrs =   go 1 []   where@@ -135,7 +171,32 @@             else go (i + 1) accum'         else return (Left (responseStatus resp)) -gitlabReqOne :: (MonadIO m) => (BSL.ByteString -> output) -> Text -> Text -> GitLab m (Either Status output)+-- not sure what this was planned for+--+-- gitlabReqOneIO :: Manager -> GitLabServerConfig -> (BSL.ByteString -> output) -> Text -> Text -> IO (Either Status output)+-- gitlabReqOneIO manager cfg parser urlPath attrs = go+--   where+--     go = do+--       let url' =+--             url cfg+--               <> "/api/v4"+--               <> urlPath+--               <> "?per_page=100"+--               <> "&page=1"+--               <> attrs+--       let request' = parseRequest_ (T.unpack url')+--           request =+--             request'+--               { requestHeaders =+--                   [("PRIVATE-TOKEN", T.encodeUtf8 (token cfg))],+--                 responseTimeout = responseTimeoutMicro (timeout cfg)+--               }+--       resp <- tryGitLab 0 request (retries cfg) manager Nothing+--       if successStatus (responseStatus resp)+--         then return (Right (parser (responseBody resp)))+--         else return (Left (responseStatus resp))++gitlabReqOne :: (BSL.ByteString -> output) -> Text -> Text -> GitLab (Either Status output) gitlabReqOne parser urlPath attrs = go   where     go = do@@ -160,38 +221,49 @@         then return (Right (parser (responseBody resp)))         else return (Left (responseStatus resp)) -gitlabReqJsonOne :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m (Either Status (Maybe a))+-- not sure what this was planned for+--+-- gitlabReqJsonOneIO :: (FromJSON a) => Manager -> GitLabServerConfig -> Text -> Text -> IO (Either Status (Maybe a))+-- gitlabReqJsonOneIO mgr cfg urlPath attrs =+--   gitlabReqOneIO mgr cfg parseBSOne urlPath attrs++gitlabReqJsonOne :: (FromJSON a) => Text -> Text -> GitLab (Either Status (Maybe a)) gitlabReqJsonOne =   gitlabReqOne parseBSOne -gitlabReqText :: (MonadIO m) => Text -> GitLab m (Either Status String)+gitlabReqText :: Text -> GitLab (Either Status String) gitlabReqText urlPath = gitlabReqOne C.unpack urlPath "" -gitlabReqByteString :: (MonadIO m) => Text -> GitLab m (Either Status BSL.ByteString)+gitlabReqByteString :: Text -> GitLab (Either Status BSL.ByteString) gitlabReqByteString urlPath = gitlabReqOne Prelude.id urlPath "" -gitlab :: (MonadIO m, FromJSON a) => Text -> GitLab m (Either Status [a])+gitlab :: FromJSON a => Text -> GitLab (Either Status [a]) gitlab addr = gitlabReqJsonMany addr "" -gitlabUnsafe :: (MonadIO m, FromJSON a) => Text -> GitLab m [a]+gitlabUnsafe :: (FromJSON a) => Text -> GitLab [a] gitlabUnsafe addr =   fromRight (error "gitlabUnsafe error") <$> gitlab addr -gitlabOne :: (MonadIO m, FromJSON a) => Text -> GitLab m (Either Status (Maybe a))+-- not sure what this was planned for+--+-- gitlabOneIO :: (FromJSON a) => Manager -> GitLabServerConfig -> Text -> IO (Either Status (Maybe a))+-- gitlabOneIO mgr cfg addr = gitlabReqJsonOneIO mgr cfg addr ""++gitlabOne :: (FromJSON a) => Text -> GitLab (Either Status (Maybe a)) gitlabOne addr = gitlabReqJsonOne addr "" -gitlabWithAttrs :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m (Either Status [a])+gitlabWithAttrs :: (FromJSON a) => Text -> Text -> GitLab (Either Status [a]) gitlabWithAttrs = gitlabReqJsonMany -gitlabWithAttrsUnsafe :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m [a]+gitlabWithAttrsUnsafe :: (FromJSON a) => Text -> Text -> GitLab [a] gitlabWithAttrsUnsafe gitlabURL attrs =   fromRight (error "gitlabWithAttrsUnsafe error") <$> gitlabReqJsonMany gitlabURL attrs -gitlabWithAttrsOne :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m (Either Status (Maybe a))+gitlabWithAttrsOne :: (FromJSON a) => Text -> Text -> GitLab (Either Status (Maybe a)) gitlabWithAttrsOne = gitlabReqJsonOne  -- not currently used.--- gitlabWithAttrsOneUnsafe :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab m (Maybe a)+-- gitlabWithAttrsOneUnsafe :: (MonadIO m, FromJSON a) => Text -> Text -> GitLab (Maybe a) -- gitlabWithAttrsOneUnsafe gitlabURL attrs = --   fromRight (error "gitlabWithAttrsUnsafe error") <$> gitlabReqJsonOne gitlabURL attrs @@ -201,7 +273,10 @@    in findPages hdrs   where     findPages [] = 1 -- error "cannot find X-Total-Pages in header"-    findPages (("X-Total-Pages", bs) : _) = read (T.unpack (T.decodeUtf8 bs))+    findPages (("X-Total-Pages", bs) : _) =+      case readMaybe (T.unpack (T.decodeUtf8 bs)) of+        Just s -> s+        Nothing -> error "cannot find X-Total-Pages in header"     findPages (_ : xs) = findPages xs  successStatus :: Status -> Bool

@@ -0,0 +1,1392 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++module SystemHookTests (systemHookTests) where++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++systemHookTests :: [TestTree]+systemHookTests =+  [parserTests, matchTests, matchIfTests, receiveTests]++parserTests :: TestTree+parserTests =+  testGroup+    "GitLab system hook rules"+    [ testCase+        "project-create-event"+        ( readFile "data/system-hooks/project-created.json"+            >>= \eventJson -> parseEvent eventJson @?= Just projectCreatedHaskell+        ),+      testCase+        "project-destroy-event"+        ( readFile "data/system-hooks/project-destroyed.json"+            >>= \eventJson -> parseEvent eventJson @?= Just projectDestroyedHaskell+        ),+      testCase+        "project-rename-event"+        ( readFile "data/system-hooks/project-renamed.json"+            >>= \eventJson -> parseEvent eventJson @?= Just projectRenamedHaskell+        ),+      testCase+        "project-transfer-event"+        ( readFile "data/system-hooks/project-transferred.json"+            >>= \eventJson -> parseEvent eventJson @?= Just projectTransferredHaskell+        ),+      testCase+        "project-update-event"+        ( 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"+            >>= \eventJson -> parseEvent eventJson @?= Just userAddedToTeamHaskell+        ),+      testCase+        "team-member-removed-event"+        ( 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"+            >>= \eventJson -> parseEvent eventJson @?= Just userUpdatedForTeamHaskell+        ),+      testCase+        "user-created-event"+        ( readFile "data/system-hooks/user-created.json"+            >>= \eventJson -> parseEvent eventJson @?= Just userCreatedHaskell+        ),+      testCase+        "user-removed-event"+        ( 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"+            >>= \eventJson -> parseEvent eventJson @?= Just userFailedLoginHaskell+        ),+      testCase+        "user-renamed-event"+        ( readFile "data/system-hooks/user-renamed.json"+            >>= \eventJson -> parseEvent eventJson @?= Just userRenamedHaskell+        ),+      testCase+        "key-added-event"+        ( readFile "data/system-hooks/key-added.json"+            >>= \eventJson -> parseEvent eventJson @?= Just keyCreatedHaskell+        ),+      testCase+        "key-removed-event"+        ( readFile "data/system-hooks/key-removed.json"+            >>= \eventJson -> parseEvent eventJson @?= Just keyRemovedHaskell+        ),+      testCase+        "group-created-event"+        ( readFile "data/system-hooks/group-created.json"+            >>= \eventJson -> parseEvent eventJson @?= Just groupCreatedHaskell+        ),+      testCase+        "group-removed-event"+        ( readFile "data/system-hooks/group-removed.json"+            >>= \eventJson -> parseEvent eventJson @?= Just groupRemovedHaskell+        ),+      testCase+        "group-renamed-event"+        ( 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"+            >>= \eventJson -> parseEvent eventJson @?= Just newGroupMemberHaskell+        ),+      testCase+        "group-member-removed-event"+        ( 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"+            >>= \eventJson -> parseEvent eventJson @?= Just groupMemberUpdatedHaskell+        ),+      testCase+        "push-event"+        ( readFile "data/system-hooks/push.json"+            >>= \eventJson -> parseEvent eventJson @?= Just pushHaskell+        ),+      testCase+        "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+      -- )+    ]++matchTest :: String -> String -> Rule -> String -> Rule -> [TestTree]+matchTest lbl jsonFilename rule wrongJson wrongRule =+  [ testCase lbl $+      runGitLabDbg+        ( liftIO (readFile ("data/system-hooks/" <> jsonFilename))+            >>= \eventJson -> tryFire eventJson rule+        )+        @? (lbl <> " failed"),+    testCase (lbl <> "-wrong-json") $+      not+        <$> runGitLabDbg+          ( liftIO (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))+              >>= \eventJson -> tryFire eventJson wrongRule+          )+        @? (lbl <> "-wrong-rule failed")+  ]++matchIfTest :: String -> String -> Rule -> Rule -> [TestTree]+matchIfTest lbl jsonFilename yesFire noFire =+  [ testCase (lbl <> "-yes") $+      runGitLabDbg+        ( liftIO (readFile ("data/system-hooks/" <> jsonFilename))+            >>= \eventJson -> tryFire eventJson yesFire+        )+        @? "project-create-fireIf-yes failed",+    testCase (lbl <> "-no") $+      not+        <$> runGitLabDbg+          ( liftIO (readFile ("data/system-hooks/" <> jsonFilename))+              >>= \eventJson -> tryFire eventJson noFire+          )+        @? "project-create-fireIf-no failed"+  ]++-- [ testCase lbl $+--     runGitLabDbg+--       ( liftIO (readFile ("data/system-hooks/" <> jsonFilename))+--           >>= \eventJson -> fire eventJson rule+--       )+--       @? (lbl <> " failed"),+--   testCase (lbl <> "-wrong-json") $+--     not+--       <$> runGitLabDbg+--         ( liftIO (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))+--             >>= \eventJson -> fire eventJson wrongRule+--         )+--       @? (lbl <> "-wrong-rule failed")+-- ]++matchTests :: TestTree+matchTests =+  testGroup "GitLab system hook match" $+    matchTest "project-create" "project-created.json" projectCreateRule "project-destroyed.json" projectDestroyRule+      <> matchTest "project-destroy" "project-destroyed.json" projectDestroyRule "project-created.json" projectCreateRule+      <> matchTest "project-rename" "project-renamed.json" projectRenameRule "project-created.json" projectCreateRule+      <> matchTest "project-transfer" "project-transferred.json" projectTransferRule "project-created.json" projectCreateRule+      <> matchTest "project-update" "project-updated.json" projectUpdateRule "project-created.json" projectCreateRule+      <> matchTest "user-add-to-team" "new-team-member.json" userAddToTeamRule "project-created.json" projectCreateRule+      <> matchTest "user-update-for-team" "team-member-updated.json" userUpdateForTeamRule "project-created.json" projectCreateRule+      <> matchTest "user-remove-from-team" "team-member-removed.json" userRemoveFromTeamRule "project-created.json" projectCreateRule+      <> matchTest "user-create" "user-created.json" userCreateRule "project-created.json" projectCreateRule+      <> matchTest "user-remove" "user-removed.json" userRemoveRule "project-created.json" projectCreateRule+      <> matchTest "user-failed-login" "user-failed-login.json" userFailedLoginRule "project-created.json" projectCreateRule+      <> matchTest "user-rename" "user-renamed.json" userRenameRule "project-created.json" projectCreateRule+      <> matchTest "key-create" "key-added.json" keyCreateRule "project-created.json" projectCreateRule+      <> matchTest "key-remove" "key-removed.json" keyRemoveRule "project-created.json" projectCreateRule+      <> matchTest "group-create" "group-created.json" groupCreateRule "project-created.json" projectCreateRule+      <> matchTest "group-remove" "group-removed.json" groupRemoveRule "project-created.json" projectCreateRule+      <> matchTest "group-rename" "group-renamed.json" groupRenameRule "project-created.json" projectCreateRule+      <> matchTest "new-group-member" "new-group-member.json" newGroupMemberRule "project-created.json" projectCreateRule+      <> matchTest "group-member-remove" "group-member-removed.json" groupMemberRemoveRule "project-created.json" projectCreateRule+      <> 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++matchIfTests :: TestTree+matchIfTests =+  testGroup "GitLab system hook matchIf" $+    matchIfTest "project-create" "project-created.json" projectCreateIfRuleYes projectCreateIfRuleNo+      <> matchIfTest "project-destroy" "project-destroyed.json" projectDestroyIfRuleYes projectDestroyIfRuleNo+      <> matchIfTest "project-rename" "project-renamed.json" projectRenameIfRuleYes projectRenameIfRuleNo+      <> matchIfTest "project-transfer" "project-transferred.json" projectTransferIfRuleYes projectTransferIfRuleNo+      <> matchIfTest "project-update" "project-updated.json" projectUpdateIfRuleYes projectUpdateIfRuleNo+      <> matchIfTest "user-add-to-team" "new-team-member.json" userAddToTeamIfRuleYes userAddToTeamIfRuleNo+      <> matchIfTest "user-update-for-team" "team-member-updated.json" userUpdateForTeamIfRuleYes userUpdateForTeamIfRuleNo+      <> matchIfTest "user-remove-from-team" "team-member-removed.json" userRemoveFromTeamIfRuleYes userRemoveFromTeamIfRuleNo+      <> matchIfTest "user-create" "user-created.json" userCreateIfRuleYes userCreateIfRuleNo+      <> matchIfTest "user-remove" "user-removed.json" userRemoveIfRuleYes userRemoveIfRuleNo+      <> matchIfTest "user-failed-login" "user-failed-login.json" userFailedLoginIfRuleYes userFailedLoginIfRuleNo+      <> matchIfTest "user-rename" "user-renamed.json" userRenameIfRuleYes userRenameIfRuleNo+      <> matchIfTest "key-create" "key-added.json" keyCreateIfRuleYes keyCreateIfRuleNo+      <> matchIfTest "key-remove" "key-removed.json" keyRemoveIfRuleYes keyRemoveIfRuleNo+      <> matchIfTest "group-create" "group-created.json" groupCreateIfRuleYes groupCreateIfRuleNo+      <> matchIfTest "group-remove" "group-removed.json" groupRemoveIfRuleYes groupRemoveIfRuleNo+      <> matchIfTest "group-rename" "group-renamed.json" groupRenameIfRuleYes groupRenameIfRuleNo+      <> matchIfTest "new-group-member" "new-group-member.json" newGroupMemberIfRuleYes newGroupMemberIfRuleNo+      <> matchIfTest "group-member-remove" "group-member-removed.json" groupMemberRemoveIfRuleYes groupMemberRemoveIfRuleNo+      <> matchIfTest "group-member-update" "group-member-updated.json" groupMemberUpdateIfRuleYes groupMemberUpdateIfRuleNo+      <> matchIfTest "push" "push.json" pushIfRuleYes pushIfRuleNo+      <> matchIfTest "tag-push" "tag-push.json" tagPushIfRuleYes tagPushIfRuleNo++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+        "2-rules"+        $ runGitLabDbg+        $ liftIO (readFile "data/system-hooks/project-created.json")+          >>= \eventJson ->+            receiveString+              eventJson+              [ projectCreateRule,+                projectDestroyRule+              ]+    ]++projectCreateRule :: Rule+projectCreateRule =+  match+    "projectCreate rule"+    ( \ProjectCreate {} -> do+        return ()+    )++projectCreateIfRuleYes :: Rule+projectCreateIfRuleYes =+  matchIf+    "projectCreate-if rule"+    ( \proj@ProjectCreate {} -> do+        return (projectCreate_owner_email proj == "johnsmith@gmail.com")+    )+    ( \ProjectCreate {} -> do+        return ()+    )++projectCreateIfRuleNo :: Rule+projectCreateIfRuleNo =+  matchIf+    "projectCreate-if rule"+    ( \proj@ProjectCreate {} -> do+        return (projectCreate_owner_email proj == "johnsmith@hotmail.com")+    )+    ( \ProjectCreate {} -> do+        return ()+    )++projectDestroyRule :: Rule+projectDestroyRule =+  match+    "projectDestroy rule"+    ( \ProjectDestroy {} -> do+        return ()+    )++projectDestroyIfRuleYes :: Rule+projectDestroyIfRuleYes =+  matchIf+    "projectDestroy rule-if yes"+    ( \event@ProjectDestroy {} -> do+        return+          ( projectDestroy_owner_email event+              == "johnsmith@gmail.com"+          )+    )+    ( \ProjectDestroy {} -> do+        return ()+    )++projectDestroyIfRuleNo :: Rule+projectDestroyIfRuleNo =+  matchIf+    "projectDestroy rule-if no"+    ( \event@ProjectDestroy {} -> do+        return+          ( projectDestroy_owner_email event+              == "johnsmith@hotmail.com"+          )+    )+    ( \ProjectDestroy {} -> do+        return ()+    )++projectRenameRule :: Rule+projectRenameRule =+  match+    "projectRename rule"+    ( \ProjectRename {} -> do+        return ()+    )++projectRenameIfRuleYes :: Rule+projectRenameIfRuleYes =+  matchIf+    "projectRename rule-if yes"+    ( \event@ProjectRename {} -> do+        return+          ( projectRename_created_at event+              == "2012-07-21T07:30:58Z"+          )+    )+    ( \ProjectRename {} -> do+        return ()+    )++projectRenameIfRuleNo :: Rule+projectRenameIfRuleNo =+  matchIf+    "projectRename rule-if no"+    ( \event@ProjectRename {} -> do+        return+          ( projectRename_created_at event+              == ""+          )+    )+    ( \ProjectRename {} -> do+        return ()+    )++projectTransferRule :: Rule+projectTransferRule =+  match+    "projectTransfer rule"+    ( \ProjectTransfer {} -> do+        return ()+    )++projectTransferIfRuleYes :: Rule+projectTransferIfRuleYes =+  matchIf+    "projectTransfer rule-if yes"+    ( \event@ProjectTransfer {} -> do+        return+          ( projectTransfer_owner_name event+              == "John Smith"+          )+    )+    ( \ProjectTransfer {} -> do+        return ()+    )++projectTransferIfRuleNo :: Rule+projectTransferIfRuleNo =+  matchIf+    "projectTransfer rule-if no"+    ( \event@ProjectTransfer {} -> do+        return+          ( projectTransfer_owner_name event+              == ""+          )+    )+    ( \ProjectTransfer {} -> do+        return ()+    )++projectUpdateRule :: Rule+projectUpdateRule =+  match+    "projectTransfer rule"+    ( \ProjectUpdate {} -> do+        return ()+    )++projectUpdateIfRuleYes :: Rule+projectUpdateIfRuleYes =+  matchIf+    "projectTransfer rule-if yes"+    ( \event@ProjectUpdate {} -> do+        return+          ( projectUpdate_path event+              == "storecloud"+          )+    )+    ( \ProjectUpdate {} -> do+        return ()+    )++projectUpdateIfRuleNo :: Rule+projectUpdateIfRuleNo =+  matchIf+    "projectTransfer rule-if no"+    ( \event@ProjectUpdate {} -> do+        return+          ( projectUpdate_path event+              == ""+          )+    )+    ( \ProjectUpdate {} -> do+        return ()+    )++groupMemberUpdateRule :: Rule+groupMemberUpdateRule =+  match+    "groupMemberUpdate rule"+    ( \GroupMemberUpdate {} -> do+        return ()+    )++groupMemberUpdateIfRuleYes :: Rule+groupMemberUpdateIfRuleYes =+  matchIf+    "groupMemberUpdate rule-if yes"+    ( \event@GroupMemberUpdate {} -> do+        return+          ( groupMemberUpdate_user_email event+              == "johnsmith@gmail.com"+          )+    )+    ( \GroupMemberUpdate {} -> do+        return ()+    )++groupMemberUpdateIfRuleNo :: Rule+groupMemberUpdateIfRuleNo =+  matchIf+    "groupMemberUpdate rule-if no"+    ( \event@GroupMemberUpdate {} -> do+        return+          ( groupMemberUpdate_user_email event+              == "johnsmith@hotmail.com"+          )+    )+    ( \GroupMemberUpdate {} -> do+        return ()+    )++userAddToTeamRule :: Rule+userAddToTeamRule =+  match+    "userAddToTeam rule"+    ( \UserAddToTeam {} -> do+        return ()+    )++userAddToTeamIfRuleYes :: Rule+userAddToTeamIfRuleYes =+  matchIf+    "userAddToTeam rule-if yes"+    ( \event@UserAddToTeam {} -> do+        return+          ( userAddTeam_user_email event+              == "johnsmith@gmail.com"+          )+    )+    ( \UserAddToTeam {} -> do+        return ()+    )++userAddToTeamIfRuleNo :: Rule+userAddToTeamIfRuleNo =+  matchIf+    "userAddToTeam rule-if no"+    ( \event@UserAddToTeam {} ->+        return+          ( userAddTeam_user_email event+              == "johnsmith@hotmail.com"+          )+    )+    ( \UserAddToTeam {} -> do+        return ()+    )++userUpdateForTeamRule :: Rule+userUpdateForTeamRule =+  match+    "userUpdateForTeam rule"+    ( \UserUpdateForTeam {} -> do+        return ()+    )++userUpdateForTeamIfRuleYes :: Rule+userUpdateForTeamIfRuleYes =+  matchIf+    "userUpdateForTeam rule-if yes"+    ( \event@UserUpdateForTeam {} -> do+        return+          ( userUpdateTeam_project_path_with_namespace event+              == "jsmith/storecloud"+          )+    )+    ( \UserUpdateForTeam {} -> do+        return ()+    )++userUpdateForTeamIfRuleNo :: Rule+userUpdateForTeamIfRuleNo =+  matchIf+    "userUpdateForTeam rule-if no"+    ( \event@UserUpdateForTeam {} -> do+        return+          ( userUpdateTeam_project_path_with_namespace event+              == ""+          )+    )+    ( \UserUpdateForTeam {} -> do+        return ()+    )++userRemoveFromTeamRule :: Rule+userRemoveFromTeamRule =+  match+    "userRemoveFromTeam rule"+    ( \UserRemoveFromTeam {} -> do+        return ()+    )++userRemoveFromTeamIfRuleYes :: Rule+userRemoveFromTeamIfRuleYes =+  matchIf+    "userRemoveFromTeam rule-if yes"+    ( \event@UserRemoveFromTeam {} -> do+        return+          ( userRemoveTeam_user_email event+              == "johnsmith@gmail.com"+          )+    )+    ( \UserRemoveFromTeam {} -> do+        return ()+    )++userRemoveFromTeamIfRuleNo :: Rule+userRemoveFromTeamIfRuleNo =+  matchIf+    "userRemoveFromTeam rule-if no"+    ( \event@UserRemoveFromTeam {} -> do+        return+          ( userRemoveTeam_user_email event+              == "js@gmail.com"+          )+    )+    ( \UserRemoveFromTeam {} -> do+        return ()+    )++userCreateRule :: Rule+userCreateRule =+  match+    "userCreate rule"+    ( \UserCreate {} -> do+        return ()+    )++userCreateIfRuleYes :: Rule+userCreateIfRuleYes =+  matchIf+    "userCreate rule-if yes"+    ( \event@UserCreate {} -> do+        return+          ( userCreate_email event+              == "js@gitlabhq.com"+          )+    )+    ( \UserCreate {} -> do+        return ()+    )++userCreateIfRuleNo :: Rule+userCreateIfRuleNo =+  matchIf+    "userCreate rule-if no"+    ( \event@UserCreate {} -> do+        return+          ( userCreate_email event+              == "js@gmail.com"+          )+    )+    ( \UserCreate {} -> do+        return ()+    )++userRemoveRule :: Rule+userRemoveRule =+  match+    "userRemove rule"+    ( \UserRemove {} -> do+        return ()+    )++userRemoveIfRuleYes :: Rule+userRemoveIfRuleYes =+  matchIf+    "userRemove rule-if yes"+    ( \event@UserRemove {} -> do+        return+          ( userRemove_email event+              == "js@gitlabhq.com"+          )+    )+    ( \UserRemove {} -> do+        return ()+    )++userRemoveIfRuleNo :: Rule+userRemoveIfRuleNo =+  matchIf+    "userRemove rule-if no"+    ( \event@UserRemove {} -> do+        return+          ( userRemove_email event+              == "js@gmail.com"+          )+    )+    ( \UserRemove {} -> do+        return ()+    )++userFailedLoginRule :: Rule+userFailedLoginRule =+  match+    "userFailedLogin rule"+    ( \UserFailedLogin {} -> do+        return ()+    )++userFailedLoginIfRuleYes :: Rule+userFailedLoginIfRuleYes =+  matchIf+    "userFailedLogin rule"+    ( \event@UserFailedLogin {} -> do+        return+          ( userFailedLogin_email event+              == "user4@example.com"+          )+    )+    ( \UserFailedLogin {} -> do+        return ()+    )++userFailedLoginIfRuleNo :: Rule+userFailedLoginIfRuleNo =+  matchIf+    "userFailedLogin rule"+    ( \event@UserFailedLogin {} -> do+        return+          ( userFailedLogin_email event+              == "user4@gmail.com"+          )+    )+    ( \UserFailedLogin {} -> do+        return ()+    )++userRenameRule :: Rule+userRenameRule =+  match+    "userRename rule"+    ( \UserRename {} -> do+        return ()+    )++userRenameIfRuleYes :: Rule+userRenameIfRuleYes =+  matchIf+    "userRename rule-if yes"+    ( \event@UserRename {} -> do+        return+          ( userRename_username event+              == "new-exciting-name"+          )+    )+    ( \UserRename {} -> do+        return ()+    )++userRenameIfRuleNo :: Rule+userRenameIfRuleNo =+  matchIf+    "userRename rule-if no"+    ( \event@UserRename {} -> do+        return+          ( userRename_username event+              == "old-boring-name"+          )+    )+    ( \UserRename {} -> do+        return ()+    )++keyCreateRule :: Rule+keyCreateRule =+  match+    "keyCreate rule"+    ( \KeyCreate {} -> do+        return ()+    )++keyCreateIfRuleYes :: Rule+keyCreateIfRuleYes =+  matchIf+    "keyCreate rule-if yes"+    ( \event@KeyCreate {} -> do+        return+          ( keyCreate_updated_at event+              == "2012-07-21T07:38:22Z"+          )+    )+    ( \KeyCreate {} -> do+        return ()+    )++keyCreateIfRuleNo :: Rule+keyCreateIfRuleNo =+  matchIf+    "keyCreate rule-if no"+    ( \event@KeyCreate {} -> do+        return+          ( keyCreate_updated_at event+              == ""+          )+    )+    ( \KeyCreate {} -> do+        return ()+    )++keyRemoveRule :: Rule+keyRemoveRule =+  match+    "keyRemove rule"+    ( \KeyRemove {} -> do+        return ()+    )++keyRemoveIfRuleYes :: Rule+keyRemoveIfRuleYes =+  matchIf+    "keyRemove rule-if yes"+    ( \event@KeyRemove {} -> do+        return+          ( keyRemove_updated_at event+              == "2012-07-21T07:38:22Z"+          )+    )+    ( \KeyRemove {} -> do+        return ()+    )++keyRemoveIfRuleNo :: Rule+keyRemoveIfRuleNo =+  matchIf+    "keyRemove rule-if no"+    ( \event@KeyRemove {} -> do+        return+          ( keyRemove_updated_at event+              == ""+          )+    )+    ( \KeyRemove {} -> do+        return ()+    )++groupCreateRule :: Rule+groupCreateRule =+  match+    "groupCreate rule"+    ( \GroupCreate {} -> do+        return ()+    )++groupCreateIfRuleYes :: Rule+groupCreateIfRuleYes =+  matchIf+    "groupCreate rule-if yes"+    ( \event@GroupCreate {} -> do+        return+          ( groupCreate_name event+              == "StoreCloud"+          )+    )+    ( \GroupCreate {} -> do+        return ()+    )++groupCreateIfRuleNo :: Rule+groupCreateIfRuleNo =+  matchIf+    "groupCreate rule-if no"+    ( \event@GroupCreate {} -> do+        return+          ( groupCreate_name event+              == ""+          )+    )+    ( \GroupCreate {} -> do+        return ()+    )++groupRemoveRule :: Rule+groupRemoveRule =+  match+    "groupRemove rule"+    ( \GroupRemove {} -> do+        return ()+    )++groupRemoveIfRuleYes :: Rule+groupRemoveIfRuleYes =+  matchIf+    "groupRemove rule-if yes"+    ( \event@GroupRemove {} -> do+        return+          ( groupRemove_name event+              == "StoreCloud"+          )+    )+    ( \GroupRemove {} -> do+        return ()+    )++groupRemoveIfRuleNo :: Rule+groupRemoveIfRuleNo =+  matchIf+    "groupRemove rule-if no"+    ( \event@GroupRemove {} -> do+        return+          ( groupRemove_name event+              == ""+          )+    )+    ( \GroupRemove {} -> do+        return ()+    )++groupRenameRule :: Rule+groupRenameRule =+  match+    "groupRename rule"+    ( \GroupRename {} -> do+        return ()+    )++groupRenameIfRuleYes :: Rule+groupRenameIfRuleYes =+  matchIf+    "groupRename rule-if yes"+    ( \event@GroupRename {} -> do+        return+          ( groupRename_full_path event+              == "parent-group/better-name"+          )+    )+    ( \GroupRename {} -> do+        return ()+    )++groupRenameIfRuleNo :: Rule+groupRenameIfRuleNo =+  matchIf+    "groupRename rule-if no"+    ( \event@GroupRename {} -> do+        return+          ( groupRename_full_path event+              == "parent-group/wrong-name"+          )+    )+    ( \GroupRename {} -> do+        return ()+    )++newGroupMemberRule :: Rule+newGroupMemberRule =+  match+    "newGroupMember rule"+    ( \NewGroupMember {} -> do+        return ()+    )++newGroupMemberIfRuleYes :: Rule+newGroupMemberIfRuleYes =+  matchIf+    "newGroupMember rule-if yes"+    ( \event@NewGroupMember {} -> do+        return+          ( newGroupMember_user_email event+              == "johnsmith@gmail.com"+          )+    )+    ( \NewGroupMember {} -> do+        return ()+    )++newGroupMemberIfRuleNo :: Rule+newGroupMemberIfRuleNo =+  matchIf+    "newGroupMember rule-if no"+    ( \event@NewGroupMember {} -> do+        return+          ( newGroupMember_user_email event+              == "johnsmith@hotmail.com"+          )+    )+    ( \NewGroupMember {} -> do+        return ()+    )++groupMemberRemoveRule :: Rule+groupMemberRemoveRule =+  match+    "groupMemberRemove rule"+    ( \GroupMemberRemove {} -> do+        return ()+    )++groupMemberRemoveIfRuleYes :: Rule+groupMemberRemoveIfRuleYes =+  matchIf+    "groupMemberRemove rule-if yes"+    ( \event@GroupMemberRemove {} -> do+        return+          ( groupMemberRemove_user_email event+              == "johnsmith@gmail.com"+          )+    )+    ( \GroupMemberRemove {} -> do+        return ()+    )++groupMemberRemoveIfRuleNo :: Rule+groupMemberRemoveIfRuleNo =+  matchIf+    "groupMemberRemove rule-if no"+    ( \event@GroupMemberRemove {} -> do+        return+          ( groupMemberRemove_user_email event+              == "johnsmith@hotmail.com"+          )+    )+    ( \GroupMemberRemove {} -> do+        return ()+    )++pushRule :: Rule+pushRule =+  match+    "push rule"+    ( \Push {} -> do+        return ()+    )++pushIfRuleYes :: Rule+pushIfRuleYes =+  matchIf+    "push rule-if yes"+    ( \event@Push {} -> do+        return (push_checkout_sha event == "da1560886d4f094c3e6c9ef40349f7d38b5d27d7")+    )+    ( \Push {} -> do+        return ()+    )++pushIfRuleNo :: Rule+pushIfRuleNo =+  matchIf+    "push rule-if no"+    ( \event@Push {} -> do+        return (push_checkout_sha event == "")+    )+    ( \Push {} -> do+        return ()+    )++tagPushRule :: Rule+tagPushRule =+  match+    "tagPush rule"+    ( \TagPush {} -> do+        return ()+    )++tagPushIfRuleYes :: Rule+tagPushIfRuleYes =+  matchIf+    "tagPush rule-if yes"+    ( \event@TagPush {} -> do+        return (tagPush_ref event == "refs/tags/v1.0.0")+    )+    ( \TagPush {} -> do+        return ()+    )++tagPushIfRuleNo :: Rule+tagPushIfRuleNo =+  matchIf+    "tagPush rule-if no"+    ( \event@TagPush {} -> do+        return (tagPush_ref event == "refs/tags/v2.0.0")+    )+    ( \TagPush {} -> do+        return ()+    )++projectCreatedHaskell :: ProjectCreate+projectCreatedHaskell =+  ProjectCreate+    { projectCreate_created_at = "2012-07-21T07:30:54Z",+      projectCreate_updated_at = "2012-07-21T07:38:22Z",+      projectCreate_action = "project_create",+      projectCreate_name = "StoreCloud",+      projectCreate_owner_email = "johnsmith@gmail.com",+      projectCreate_owner_name = "John Smith",+      projectCreate_path = "storecloud",+      projectCreate_path_with_namespace = "jsmith/storecloud",+      projectCreate_project_id = 74,+      projectCreate_project_visibility = Private+    }++projectDestroyedHaskell :: ProjectDestroy+projectDestroyedHaskell =+  ProjectDestroy+    { projectDestroy_created_at = "2012-07-21T07:30:58Z",+      projectDestroy_updated_at = "2012-07-21T07:38:22Z",+      projectDestroy_action = "project_destroy",+      projectDestroy_name = "Underscore",+      projectDestroy_owner_email = "johnsmith@gmail.com",+      projectDestroy_owner_name = "John Smith",+      projectDestroy_path = "underscore",+      projectDestroy_path_with_namespace = "jsmith/underscore",+      projectDestroy_project_id = 73,+      projectDestroy_project_visibility = Internal+    }++projectRenamedHaskell :: ProjectRename+projectRenamedHaskell =+  ProjectRename+    { projectRename_created_at = "2012-07-21T07:30:58Z",+      projectRename_updated_at = "2012-07-21T07:38:22Z",+      projectRename_event_name = "project_rename",+      projectRename_name = "Underscore",+      projectRename_path = "underscore",+      projectRename_path_with_namespace = "jsmith/underscore",+      projectRename_project_id = 73,+      projectRename_owner_name = "John Smith",+      projectRename_owner_email = "johnsmith@gmail.com",+      projectRename_project_visibility = Internal,+      projectRename_old_path_with_namespace = "jsmith/overscore"+    }++projectTransferredHaskell :: ProjectTransfer+projectTransferredHaskell =+  ProjectTransfer+    { projectTransfer_created_at = "2012-07-21T07:30:58Z",+      projectTransfer_updated_at = "2012-07-21T07:38:22Z",+      projectTransfer_event_name = "project_transfer",+      projectTransfer_name = "Underscore",+      projectTransfer_path = "underscore",+      projectTransfer_path_with_namespace = "scores/underscore",+      projectTransfer_project_id = 73,+      projectTransfer_owner_name = "John Smith",+      projectTransfer_owner_email = "johnsmith@gmail.com",+      projectTransfer_project_visibility = Internal,+      projectTransfer_old_path_with_namespace = "jsmith/overscore"+    }++projectUpdatedHaskell :: ProjectUpdate+projectUpdatedHaskell =+  ProjectUpdate+    { projectUpdate_created_at = "2012-07-21T07:30:54Z",+      projectUpdate_updated_at = "2012-07-21T07:38:22Z",+      projectUpdate_event_name = "project_update",+      projectUpdate_name = "StoreCloud",+      projectUpdate_owner_email = "johnsmith@gmail.com",+      projectUpdate_owner_name = "John Smith",+      projectUpdate_path = "storecloud",+      projectUpdate_path_with_namespace = "jsmith/storecloud",+      projectUpdate_project_id = 74,+      projectUpdate_project_visibility = Private+    }++userAddedToTeamHaskell :: UserAddToTeam+userAddedToTeamHaskell =+  UserAddToTeam+    { userAddTeam_created_at = "2012-07-21T07:30:56Z",+      userAddTeam_updated_at = "2012-07-21T07:38:22Z",+      userAddTeam_event_name = "user_add_to_team",+      userAddTeam_access_level = "Maintainer",+      userAddTeam_project_id = 74,+      userAddTeam_project_name = "StoreCloud",+      userAddTeam_project_path = "storecloud",+      userAddTeam_project_path_with_namespace = "jsmith/storecloud",+      userAddTeam_user_email = "johnsmith@gmail.com",+      userAddTeam_user_name = "John Smith",+      userAddTeam_user_username = "johnsmith",+      userAddTeam_user_id = 41,+      userAddTeam_project_visibility = Private+    }++userUpdatedForTeamHaskell :: UserUpdateForTeam+userUpdatedForTeamHaskell =+  UserUpdateForTeam+    { userUpdateTeam_created_at = "2012-07-21T07:30:56Z",+      userUpdateTeam_updated_at = "2012-07-21T07:38:22Z",+      userUpdateTeam_event_name = "user_update_for_team",+      userUpdateTeam_access_level = "Maintainer",+      userUpdateTeam_project_id = 74,+      userUpdateTeam_project_name = "StoreCloud",+      userUpdateTeam_project_path = "storecloud",+      userUpdateTeam_project_path_with_namespace = "jsmith/storecloud",+      userUpdateTeam_user_email = "johnsmith@gmail.com",+      userUpdateTeam_user_name = "John Smith",+      userUpdateTeam_user_username = "johnsmith",+      userUpdateTeam_user_id = 41,+      userUpdateTeam_project_visibility = Private+    }++userRemovedFromTeamHaskell :: UserRemoveFromTeam+userRemovedFromTeamHaskell =+  UserRemoveFromTeam+    { userRemoveTeam_created_at = "2012-07-21T07:30:56Z",+      userRemoveTeam_updated_at = "2012-07-21T07:38:22Z",+      userRemoveTeam_event_name = "user_remove_from_team",+      userRemoveTeam_access_level = "Maintainer",+      userRemoveTeam_project_id = 74,+      userRemoveTeam_project_name = "StoreCloud",+      userRemoveTeam_project_path = "storecloud",+      userRemoveTeam_project_path_with_namespace = "jsmith/storecloud",+      userRemoveTeam_user_email = "johnsmith@gmail.com",+      userRemoveTeam_user_name = "John Smith",+      userRemoveTeam_user_username = "johnsmith",+      userRemoveTeam_user_id = 41,+      userRemoveTeam_project_visibility = Private+    }++userCreatedHaskell :: UserCreate+userCreatedHaskell =+  UserCreate+    { userCreate_created_at = "2012-07-21T07:44:07Z",+      userCreate_updated_at = "2012-07-21T07:38:22Z",+      userCreate_email = "js@gitlabhq.com",+      userCreate_event_name = "user_create",+      userCreate_name = "John Smith",+      userCreate_username = "js",+      userCreate_user_id = 41+    }++userRemovedHaskell :: UserRemove+userRemovedHaskell =+  UserRemove+    { userRemove_created_at = "2012-07-21T07:44:07Z",+      userRemove_updated_at = "2012-07-21T07:38:22Z",+      userRemove_email = "js@gitlabhq.com",+      userRemove_event_name = "user_destroy",+      userRemove_name = "John Smith",+      userRemove_username = "js",+      userRemove_user_id = 41+    }++userFailedLoginHaskell :: UserFailedLogin+userFailedLoginHaskell =+  UserFailedLogin+    { userFailedLogin_event_name = "user_failed_login",+      userFailedLogin_created_at = "2017-10-03T06:08:48Z",+      userFailedLogin_updated_at = "2018-01-15T04:52:06Z",+      userFailedLogin_name = "John Smith",+      userFailedLogin_email = "user4@example.com",+      userFailedLogin_user_id = 26,+      userFailedLogin_username = "user4",+      userFailedLogin_state = "blocked"+    }++userRenamedHaskell :: UserRename+userRenamedHaskell =+  UserRename+    { userRename_event_name = "user_rename",+      userRename_created_at = "2017-11-01T11:21:04Z",+      userRename_updated_at = "2017-11-01T14:04:47Z",+      userRename_name = "new-name",+      userRename_email = "best-email@example.tld",+      userRename_user_id = 58,+      userRename_username = "new-exciting-name",+      userRename_old_username = "old-boring-name"+    }++keyCreatedHaskell :: KeyCreate+keyCreatedHaskell =+  KeyCreate+    { keyCreate_event_name = "key_create",+      keyCreate_created_at = "2014-08-18 18:45:16 UTC",+      keyCreate_updated_at = "2012-07-21T07:38:22Z",+      keyCreate_username = "root",+      keyCreate_key = "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC58FwqHUbebw2SdT7SP4FxZ0w+lAO/erhy2ylhlcW/tZ3GY3mBu9VeeiSGoGz8hCx80Zrz+aQv28xfFfKlC8XQFpCWwsnWnQqO2Lv9bS8V1fIHgMxOHIt5Vs+9CAWGCCvUOAurjsUDoE2ALIXLDMKnJxcxD13XjWdK54j6ZXDB4syLF0C2PnAQSVY9X7MfCYwtuFmhQhKaBussAXpaVMRHltie3UYSBUUuZaB3J4cg/7TxlmxcNd+ppPRIpSZAB0NI6aOnqoBCpimscO/VpQRJMVLr3XiSYeT6HBiDXWHnIVPfQc03OGcaFqOit6p8lYKMaP/iUQLm+pgpZqrXZ9vB john@localhost",+      keyCreate_id = 4+    }++keyRemovedHaskell :: KeyRemove+keyRemovedHaskell =+  KeyRemove+    { keyRemove_event_name = "key_destroy",+      keyRemove_created_at = "2014-08-18 18:45:16 UTC",+      keyRemove_updated_at = "2012-07-21T07:38:22Z",+      keyRemove_username = "root",+      keyRemove_key = "ssh-rsa AAAAB3NzaC1yc2EAAAADAQABAAABAQC58FwqHUbebw2SdT7SP4FxZ0w+lAO/erhy2ylhlcW/tZ3GY3mBu9VeeiSGoGz8hCx80Zrz+aQv28xfFfKlC8XQFpCWwsnWnQqO2Lv9bS8V1fIHgMxOHIt5Vs+9CAWGCCvUOAurjsUDoE2ALIXLDMKnJxcxD13XjWdK54j6ZXDB4syLF0C2PnAQSVY9X7MfCYwtuFmhQhKaBussAXpaVMRHltie3UYSBUUuZaB3J4cg/7TxlmxcNd+ppPRIpSZAB0NI6aOnqoBCpimscO/VpQRJMVLr3XiSYeT6HBiDXWHnIVPfQc03OGcaFqOit6p8lYKMaP/iUQLm+pgpZqrXZ9vB john@localhost",+      keyRemove_id = 4+    }++groupCreatedHaskell :: GroupCreate+groupCreatedHaskell =+  GroupCreate+    { groupCreate_created_at = "2012-07-21T07:30:54Z",+      groupCreate_updated_at = "2012-07-21T07:38:22Z",+      groupCreate_event_name = "group_create",+      groupCreate_name = "StoreCloud",+      groupCreate_owner_email = Nothing,+      groupCreate_owner_name = Nothing,+      groupCreate_path = "storecloud",+      groupCreate_group_id = 78+    }++groupRemovedHaskell :: GroupRemove+groupRemovedHaskell =+  GroupRemove+    { groupRemove_created_at = "2012-07-21T07:30:54Z",+      groupRemove_updated_at = "2012-07-21T07:38:22Z",+      groupRemove_event_name = "group_destroy",+      groupRemove_name = "StoreCloud",+      groupRemove_owner_email = Nothing,+      groupRemove_owner_name = Nothing,+      groupRemove_path = "storecloud",+      groupRemove_group_id = 78+    }++groupRenamedHaskell :: GroupRename+groupRenamedHaskell =+  GroupRename+    { groupRename_event_name = "group_rename",+      groupRename_created_at = "2017-10-30T15:09:00Z",+      groupRename_updated_at = "2017-11-01T10:23:52Z",+      groupRename_name = "Better Name",+      groupRename_path = "better-name",+      groupRename_full_path = "parent-group/better-name",+      groupRename_group_id = 64,+      groupRename_owner_name = Nothing,+      groupRename_owner_email = Nothing,+      groupRename_old_path = "old-name",+      groupRename_old_full_path = "parent-group/old-name"+    }++newGroupMemberHaskell :: NewGroupMember+newGroupMemberHaskell =+  NewGroupMember+    { newGroupMember_created_at = "2012-07-21T07:30:56Z",+      newGroupMember_updated_at = "2012-07-21T07:38:22Z",+      newGroupMember_event_name = "user_add_to_group",+      newGroupMember_group_access = "Maintainer",+      newGroupMember_group_id = 78,+      newGroupMember_group_name = "StoreCloud",+      newGroupMember_group_path = "storecloud",+      newGroupMember_user_email = "johnsmith@gmail.com",+      newGroupMember_user_name = "John Smith",+      newGroupMember_user_username = "johnsmith",+      newGroupMember_user_id = 41+    }++groupMemberRemovedHaskell :: GroupMemberRemove+groupMemberRemovedHaskell =+  GroupMemberRemove+    { groupMemberRemove_created_at = "2012-07-21T07:30:56Z",+      groupMemberRemove_updated_at = "2012-07-21T07:38:22Z",+      groupMemberRemove_event_name = "user_remove_from_group",+      groupMemberRemove_group_access = "Maintainer",+      groupMemberRemove_group_id = 78,+      groupMemberRemove_group_name = "StoreCloud",+      groupMemberRemove_group_path = "storecloud",+      groupMemberRemove_user_email = "johnsmith@gmail.com",+      groupMemberRemove_user_name = "John Smith",+      groupMemberRemove_user_username = "johnsmith",+      groupMemberRemove_user_id = 41+    }++groupMemberUpdatedHaskell :: GroupMemberUpdate+groupMemberUpdatedHaskell =+  GroupMemberUpdate+    { groupMemberUpdate_created_at = "2012-07-21T07:30:56Z",+      groupMemberUpdate_updated_at = "2012-07-21T07:38:22Z",+      groupMemberUpdate_event_name = "user_update_for_group",+      groupMemberUpdate_group_access = "Maintainer",+      groupMemberUpdate_group_id = 78,+      groupMemberUpdate_group_name = "StoreCloud",+      groupMemberUpdate_group_path = "storecloud",+      groupMemberUpdate_user_email = "johnsmith@gmail.com",+      groupMemberUpdate_user_name = "John Smith",+      groupMemberUpdate_user_username = "johnsmith",+      groupMemberUpdate_user_id = 41+    }++pushHaskell :: Push+pushHaskell =+  Push+    { push_event_name = "push",+      push_before = "95790bf891e76fee5e1747ab589903a6a1f80f22",+      push_after = "da1560886d4f094c3e6c9ef40349f7d38b5d27d7",+      push_ref = "refs/heads/master",+      push_checkout_sha = "da1560886d4f094c3e6c9ef40349f7d38b5d27d7",+      push_user_id = 4,+      push_user_name = "John Smith",+      push_user_email = "john@example.com",+      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_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+    }++tagPushHaskell :: TagPush+tagPushHaskell =+  TagPush+    { tagPush_event_name = "tag_push",+      tagPush_before = "0000000000000000000000000000000000000000",+      tagPush_after = "82b3d5ae55f7080f1e6022629cdb57bfae7cccc7",+      tagPush_ref = "refs/tags/v1.0.0",+      tagPush_checkout_sha = "5937ac0a7beb003549fc5fd26fc247adbce4a52e",+      tagPush_user_id = 1,+      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 = "http://example.com/jsmith/example.git", repositoryEvent_git_ssh_url = "git@example.com:jsmith/example.git", repositoryEvent_visibility_level = Private},+      tagPush_commits = [],+      tagPush_total_commits_count = 0+    }

@@ -0,0 +1,16 @@+{-# LANGUAGE FlexibleInstances #-}+{-# LANGUAGE OverloadedStrings #-}++module Main where++import Data.Maybe (fromJust)+import SystemHookTests+import Test.Tasty++main :: IO ()+main = do+  defaultMain+    ( testGroup+        "gitlab system hook tests"+        systemHookTests+    )