packages feed

gitlab-haskell 0.3.0.2 → 0.3.1

raw patch · 10 files changed

+612/−123 lines, 10 filesdep ~time

Dependency ranges changed: time

Files

README.md view
@@ -16,6 +16,11 @@ * Repository files * Users * Discussions+* Tags+* Todos+* Version+* Notes+* Boards  The library parses JSON results into Haskell data types in the `GitLab.Types` module, allowing you to work with statically typed
gitlab-haskell.cabal view
@@ -1,7 +1,7 @@ cabal-version: 2.4 name:           gitlab-haskell category:       Git-version:        0.3.0.2+version:        0.3.1 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/>@@ -102,7 +102,7 @@               , transformers               , unliftio               , unliftio-core-              , time+              , time >= 1.9               , temporary               , unix   default-language: Haskell2010
src/GitLab.hs view
@@ -9,6 +9,7 @@ -- Stability   : stable module GitLab   ( runGitLab,+    runGitLabPassPrompt,     runGitLabDbg,     runGitLabWithManager,     module GitLab.Types,@@ -38,6 +39,7 @@  import Control.Monad.IO.Class import Control.Monad.Trans.Reader+import qualified Data.Text as T import GitLab.API.Boards import GitLab.API.Branches import GitLab.API.Commits@@ -88,6 +90,23 @@   let settings = mkManagerSettings (TLSSettingsSimple True False False) Nothing   manager <- liftIO $ newManager settings   runGitLabWithManager manager cfg action++-- | The same as 'runGitLab', except that it prompts for a GitLab+-- access token before running the GitLab action.+--+-- In this case you can just use 'defaultGitLabServer' with no+-- modification of the record field values, because these values will+-- be asked for at runtime:+--+-- > runGitLabPassPrompt defaultGitLabServer myGitLabProgram+runGitLabPassPrompt :: GitLabServerConfig -> GitLab a -> IO a+runGitLabPassPrompt cfg action = do+  liftIO $ hSetBuffering stdout NoBuffering+  liftIO (putStr "Enter GitLab server URL\n> ")+  hostUrl <- getLine+  liftIO (putStr "Enter GitLab access token\n> ")+  pass <- getLine+  runGitLab (cfg {url = T.pack hostUrl, token = T.pack pass}) action  -- | The same as 'runGitLab', except that it also takes a connection -- manager as an argument.
src/GitLab/API/Groups.hs view
@@ -11,18 +11,14 @@ module GitLab.API.Groups where  import qualified Data.ByteString.Lazy as BSL-import Data.Maybe import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T-import GitLab.API.Members-import GitLab.API.Users import GitLab.Types import GitLab.WebRequests.GitLabWebCalls import Network.HTTP.Client-import Network.HTTP.Types.URI --- | gets groups with the given group name or path.+-- | gets groups with the given group name, path or full path. -- -- > projectsWithNameOrPath "group1" groupsWithNameOrPath ::@@ -40,95 +36,10 @@             ( \group ->                 groupName == group_name group                   || groupName == group_path group+                  || groupName == group_full_path group             )             groups         )---- | adds all registered users to a group.-addAllUsersToGroup ::-  -- | group name-  Text ->-  -- | level of access granted-  AccessLevel ->-  GitLab [Either (Response BSL.ByteString) (Maybe Member)]-addAllUsersToGroup groupName access = do-  allRegisteredUsers <- allUsers-  let allUserIds = map user_username allRegisteredUsers-  addUsersToGroup' groupName access allUserIds---- | adds a user to a group.-addUserToGroup ::-  -- | group name-  Text ->-  -- | level of access granted-  AccessLevel ->-  -- | the user-  User ->-  GitLab (Either (Response BSL.ByteString) (Maybe Member))-addUserToGroup groupName access usr =-  addUserToGroup' groupName access (user_id usr)---- | adds a user with a given user ID to a group.-addUserToGroup' ::-  -- | group name-  Text ->-  -- | level of access granted-  AccessLevel ->-  -- | user ID-  Int ->-  GitLab (Either (Response BSL.ByteString) (Maybe Member))-addUserToGroup' groupName access usrId = do-  attempt <- groupsWithNameOrPath groupName-  case attempt of-    Left resp -> return (Left resp)-    Right [] ->-      -- TODO crreate response-      error "foo"-    -- return (Left (mk (Response BSL.ByteString) 404 (T.encodeUtf8 (T.pack "cannot find group"))))-    -- return (Left (mk (Response (T.encodeUtf8 (T.pack "cannot find group"))))-    Right [grp] ->-      gitlabPost addr params-      where-        params :: [GitLabParam]-        params =-          [ ("user_id", Just (T.encodeUtf8 (T.pack (show usrId)))),-            ("access_level", Just (T.encodeUtf8 (T.pack (show access))))-          ]-        addr =-          "/groups/"-            <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 (T.pack (show (group_id grp)))))-            <> "/members"-    Right (_ : _) ->-      -- return (Left (Response (T.encodeUtf8 (T.pack "too many groups found"))))-      -- TODO crreate response-      error "foo"---- return (Left (mk (Response BSL.ByteString) 404 (T.encodeUtf8 (T.pack "too many groups found"))))---- | adds a list of users to a group.-addUsersToGroup ::-  -- | group name-  Text ->-  -- | level of access granted-  AccessLevel ->-  -- | list of usernames to be added to the group-  [User] ->-  GitLab [Either (Response BSL.ByteString) (Maybe Member)]-addUsersToGroup groupName access =-  mapM (addUserToGroup groupName access)---- | adds a list of users to a group.-addUsersToGroup' ::-  -- | group name-  Text ->-  -- | level of access granted-  AccessLevel ->-  -- | list of usernames to be added to the group-  [Text] ->-  GitLab [Either (Response BSL.ByteString) (Maybe Member)]-addUsersToGroup' groupName access usernames = do-  users <- catMaybes <$> mapM searchUser usernames-  mapM (addUserToGroup' groupName access . user_id) users  groupProjects ::   -- | group
src/GitLab/API/Members.hs view
@@ -4,19 +4,60 @@ -- | -- Module      : Members -- Description : Queries about and updates to members of projects--- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019+-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2021 -- License     : BSD3 -- Maintainer  : robstewart57@gmail.com -- Stability   : stable-module GitLab.API.Members where+module GitLab.API.Members+  ( AccessLevel (..), +    -- * Projects++    -- * Project membership+    membersOfProject,+    membersOfProject',++    -- ** Adding project members+    addMemberToProject,+    addMemberToProject',+    addMembersToProject,+    addMembersToProject',++    -- ** Removing project members+    removeUserFromProject,+    removeUserFromProject',++    -- * Groups++    -- * Group membership+    membersOfGroup,+    membersOfGroup',++    -- ** Adding group members+    addAllUsersToGroup,+    addUserToGroup,+    addUserToGroup',+    addUsersToGroup,+    addUsersToGroup',++    -- ** Removing group members+    removeUserFromGroup,+    removeUserFromGroup',+  )+where+ import qualified Data.ByteString.Lazy as BSL import Data.Either+import Data.Maybe+import Data.Text (Text) import qualified Data.Text as T import qualified Data.Text.Encoding as T+import GitLab.API.Groups+import GitLab.API.Users import GitLab.Types import GitLab.WebRequests.GitLabWebCalls import Network.HTTP.Client+import Network.HTTP.Types.URI  -- | the access levels for project members. See <https://docs.gitlab.com/ee/user/permissions.html#project-members-permissions> data AccessLevel@@ -42,10 +83,7 @@ -- | the members of a project given its ID. membersOfProject' :: Int -> GitLab (Either (Response BSL.ByteString) [Member]) membersOfProject' projectId =-  gitlabGetMany addr []-  where-    addr =-      "/projects/" <> T.pack (show projectId) <> "/members"+  membersOfEntity' projectId "projects"  -- | adds a user to a project with the given access level. Returns -- 'Right Member' for each successful action, otherwise it returns@@ -72,12 +110,12 @@   -- | user ID   Int ->   GitLab (Either (Response BSL.ByteString) (Maybe Member))-addMemberToProject' projectId access userId =+addMemberToProject' projectId access usrId =   gitlabPost addr params   where     params :: [GitLabParam]     params =-      [ ("user_id", Just (T.encodeUtf8 (T.pack (show userId)))),+      [ ("user_id", Just (T.encodeUtf8 (T.pack (show usrId)))),         ("access_level", Just (T.encodeUtf8 (T.pack (show access))))       ]     addr =@@ -110,3 +148,195 @@   GitLab [Either (Response BSL.ByteString) (Maybe Member)] addMembersToProject' projectId access =   mapM (addMemberToProject' projectId access)++-- | the members of a group.+membersOfGroup :: Group -> GitLab [Member]+membersOfGroup p = do+  result <- membersOfGroup' (group_id p)+  return (fromRight (error "membersOfGroup error") result)++-- | the members of a group given its ID.+membersOfGroup' :: Int -> GitLab (Either (Response BSL.ByteString) [Member])+membersOfGroup' projectId =+  membersOfEntity' projectId "groups"++-- | adds all registered users to a group.+addAllUsersToGroup ::+  -- | group name+  Text ->+  -- | level of access granted+  AccessLevel ->+  GitLab [Either (Response BSL.ByteString) (Maybe Member)]+addAllUsersToGroup groupName access = do+  allRegisteredUsers <- allUsers+  let allUserIds = map user_username allRegisteredUsers+  addUsersToGroup' groupName access allUserIds++-- | adds a user to a group.+addUserToGroup ::+  -- | group name+  Text ->+  -- | level of access granted+  AccessLevel ->+  -- | the user+  User ->+  GitLab (Either (Response BSL.ByteString) (Maybe Member))+addUserToGroup groupName access usr =+  addUserToGroup' groupName access (user_id usr)++-- | adds a user with a given user ID to a group.+addUserToGroup' ::+  -- | group name+  Text ->+  -- | level of access granted+  AccessLevel ->+  -- | user ID+  Int ->+  GitLab (Either (Response BSL.ByteString) (Maybe Member))+addUserToGroup' groupName access usrId = do+  attempt <- groupsWithNameOrPath groupName+  case attempt of+    Left resp -> return (Left resp)+    Right [] ->+      return (Right Nothing)+    Right [grp] ->+      gitlabPost addr params+      where+        params :: [GitLabParam]+        params =+          [ ("user_id", Just (T.encodeUtf8 (T.pack (show usrId)))),+            ("access_level", Just (T.encodeUtf8 (T.pack (show access))))+          ]+        addr =+          "/groups/"+            <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 (T.pack (show (group_id grp)))))+            <> "/members"+    Right (_ : _) ->+      return (Right Nothing)++-- | adds a list of users to a group.+addUsersToGroup ::+  -- | group name+  Text ->+  -- | level of access granted+  AccessLevel ->+  -- | list of usernames to be added to the group+  [User] ->+  GitLab [Either (Response BSL.ByteString) (Maybe Member)]+addUsersToGroup groupName access =+  mapM (addUserToGroup groupName access)++-- | adds a list of users to a group.+addUsersToGroup' ::+  -- | group name+  Text ->+  -- | level of access granted+  AccessLevel ->+  -- | list of usernames to be added to the group+  [Text] ->+  GitLab [Either (Response BSL.ByteString) (Maybe Member)]+addUsersToGroup' groupName access usernames = do+  users <- catMaybes <$> mapM searchUser usernames+  mapM (addUserToGroup' groupName access . user_id) users++removeUserFromProject ::+  -- | project name+  Text ->+  -- | user+  User ->+  GitLab (Either (Response BSL.ByteString) (Maybe ()))+removeUserFromProject grpName usr =+  removeUserFromEntity grpName "projects" usr++removeUserFromProject' ::+  -- | project name+  Text ->+  -- | user ID+  Int ->+  GitLab (Either (Response BSL.ByteString) (Maybe ()))+removeUserFromProject' grpName usrId =+  removeUserFromEntity' grpName "projects" usrId++removeUserFromGroup ::+  -- | group name+  Text ->+  -- | user+  User ->+  GitLab (Either (Response BSL.ByteString) (Maybe ()))+removeUserFromGroup grpName usr =+  removeUserFromEntity grpName "groups" usr++removeUserFromGroup' ::+  -- | group name+  Text ->+  -- | user ID+  Int ->+  GitLab (Either (Response BSL.ByteString) (Maybe ()))+removeUserFromGroup' grpName usrId =+  removeUserFromEntity' grpName "groups" usrId++-- | removes a user from a group or project.+removeUserFromEntity ::+  -- | group name+  Text ->+  -- | entity ("groups" or "projects)+  Text ->+  -- | user+  User ->+  GitLab (Either (Response BSL.ByteString) (Maybe ()))+removeUserFromEntity groupName entity usr =+  removeUserFromEntity' groupName entity (user_id usr)++-- | removes a user with a given user ID from a group or project.+removeUserFromEntity' ::+  -- | group name+  Text ->+  -- | entity ("groups" or "projects")+  Text ->+  -- | user ID+  Int ->+  GitLab (Either (Response BSL.ByteString) (Maybe ()))+removeUserFromEntity' groupName entity usrId = do+  attempt <- groupsWithNameOrPath groupName+  case attempt of+    Left resp -> return (Left resp)+    Right [] ->+      return (Right Nothing)+    Right [grp] -> do+      result <- gitlabDelete addr+      case result of+        Left err -> return (Left err)+        -- GitLab version 14.2.3 returns Version JSON info when a+        -- member is removed from a group/project. I'm not sure if+        -- this is new behaviour, anyway we catch it here. +        Right (Just (Version {})) -> return (Right (Just ()))+        Right Nothing -> return (Right (Just ()))+      where+        addr =+          "/"+            <> entity+            <> "/"+            <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 (T.pack (show (group_id grp)))))+            <> "/members/"+            <> T.decodeUtf8 (urlEncode False (T.encodeUtf8 (T.pack (show usrId))))+    Right (_ : _) ->+      return (Right Nothing)++++-- | the members of a project given its ID.+membersOfEntity' ::+  -- ^ group or project ID+  Int ->+  -- ^ entity ("groups" or "projects")+  Text ->+  GitLab (Either (Response BSL.ByteString) [Member])+membersOfEntity' projectId entity =+  gitlabGetMany addr []+  where+    addr =+      "/"+      <> entity+      <> "/"+      <> T.pack (show projectId)+      <> "/members"
src/GitLab/API/Projects.hs view
@@ -1,3 +1,4 @@+{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE ScopedTypeVariables #-} @@ -13,9 +14,11 @@ import qualified Data.ByteString.Lazy as BSL 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+import GHC.Generics import GitLab.API.Commits import GitLab.API.Issues import GitLab.API.Members@@ -258,3 +261,326 @@       "/projects/"         <> T.pack (show projectId)         <> "/share"++-- | transfer a project to a new namespace.+transferProject ::+  -- | project+  Project ->+  -- | namespace where to transfer project to+  Text ->+  GitLab (Either (Response BSL.ByteString) Project)+transferProject prj = transferProject' (project_id prj)++-- | edit a project.+transferProject' ::+  -- | project ID+  Int ->+  -- | namespace where to transfer project to+  Text ->+  GitLab (Either (Response BSL.ByteString) Project)+transferProject' projId namespaceString = do+  let urlPath =+        "/projects/"+          <> T.pack (show projId)+          <> "/transfer"+  result <-+    gitlabPut+      urlPath+      [ ("id", Just (T.encodeUtf8 (T.pack (show projId)))),+        ("namespace", Just (T.encodeUtf8 namespaceString))+      ]+  case result of+    Left resp -> return (Left resp)+    Right Nothing -> error "transferProject error"+    Right (Just proj) -> return (Right proj)++-- | edit a project.+editProject ::+  -- | project+  Project ->+  -- | EditProjectAttributes+  EditProjectAttrs ->+  GitLab (Either (Response BSL.ByteString) Project)+editProject prj = editProject' (project_id prj)++-- | edit a project.+editProject' ::+  -- | project ID+  Int ->+  -- | EditProjectAttributes+  EditProjectAttrs ->+  GitLab (Either (Response BSL.ByteString) Project)+editProject' projId attrs = do+  let urlPath =+        "/projects/"+          <> T.pack (show projId)+  result <-+    gitlabPut+      urlPath+      (editProjectAttrs attrs)+  case result of+    Left resp -> return (Left resp)+    Right Nothing -> error "editProject error"+    Right (Just proj) -> return (Right proj)++defaultEditProjectAttrs ::+  -- | project ID+  Int ->+  EditProjectAttrs+defaultEditProjectAttrs projId =+  EditProjectAttrs Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing projId Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing Nothing++editProjectAttrs :: EditProjectAttrs -> [GitLabParam]+editProjectAttrs filters =+  catMaybes+    [ (\b -> Just ("allow_merge_on_skipped_pipeline", textToBS (showBool b))) =<< project_edit_allow_merge_on_skipped_pipeline filters,+      (\x -> Just ("analytics_access_level", textToBS (T.pack (show x)))) =<< project_edit_analytics_access_level filters,+      (\i -> Just ("approvals_before_merge", textToBS (T.pack (show i)))) =<< project_edit_approvals_before_merge filters,+      (\x -> Just ("auto_cancel_pending_pipelines", textToBS (T.pack (show x))))+        =<< project_edit_auto_cancel_pending_pipelines+          filters,+      (\x -> Just ("auto_devops_deploy_strategy", textToBS (T.pack (show x))))+        =<< project_edit_auto_devops_deploy_strategy filters,+      (\b -> Just ("auto_devops_enabled", textToBS (showBool b))) =<< project_edit_auto_devops_enabled filters,+      (\b -> Just ("autoclose_referenced_issues", textToBS (showBool b))) =<< project_edit_autoclose_referenced_issues filters,+      (\t -> Just ("build_coverage_regex", textToBS t)) =<< project_edit_build_coverage_regex filters,+      (\x -> Just ("build_git_strategy", textToBS (T.pack (show x)))) =<< project_edit_build_git_strategy filters,+      (\i -> Just ("build_timeout", textToBS (T.pack (show i)))) =<< project_edit_build_timeout filters,+      (\x -> Just ("builds_access_level", textToBS (T.pack (show x)))) =<< project_edit_builds_access_level filters,+      (\t -> Just ("ci_config_path", textToBS t)) =<< project_edit_ci_config_path filters,+      (\i -> Just ("ci_default_git_depth", textToBS (T.pack (show i)))) =<< project_edit_ci_default_git_depth filters,+      (\b -> Just ("ci_forward_deployment_enabled", textToBS (showBool b))) =<< project_edit_ci_forward_deployment_enabled filters,+      (\x -> Just ("container_registry_access_level", textToBS (T.pack (show x)))) =<< project_edit_container_registry_access_level filters,+      (\t -> Just ("default_branch", textToBS t)) =<< project_edit_default_branch filters,+      (\t -> Just ("description", textToBS t)) =<< project_edit_description filters,+      (\b -> Just ("emails_disabled", textToBS (showBool b))) =<< project_edit_emails_disabled filters,+      (\t -> Just ("external_authorization_classification_label", textToBS t)) =<< project_edit_external_authorization_classification_label filters,+      (\x -> Just ("forking_access_level", textToBS (T.pack (show x)))) =<< project_edit_forking_access_level filters,+      (Just ("id", textToBS (T.pack (show (project_edit_id filters))))),+      (\t -> Just ("import_url", textToBS t)) =<< project_edit_import_url filters,+      (\x -> Just ("issues_access_level", textToBS (T.pack (show x)))) =<< project_edit_issues_access_level filters,+      (\b -> Just ("lfs_enabled", textToBS (showBool b))) =<< project_edit_lfs_enabled filters,+      (\x -> Just ("merge_method", textToBS (T.pack (show x)))) =<< project_edit_merge_method filters,+      (\x -> Just ("merge_requests_access_level", textToBS (T.pack (show x)))) =<< project_edit_merge_requests_access_level filters,+      (\b -> Just ("mirror_overwrites_diverged_branches", textToBS (showBool b))) =<< project_edit_mirror_overwrites_diverged_branches filters,+      (\b -> Just ("mirror_trigger_builds", textToBS (showBool b))) =<< project_edit_mirror_trigger_builds filters,+      (\i -> Just ("mirror_user_id", textToBS (T.pack (show i)))) =<< project_edit_mirror_user_id filters,+      (\b -> Just ("mirror", textToBS (showBool b))) =<< project_edit_mirror filters,+      (\t -> Just ("name", textToBS t)) =<< project_edit_name filters,+      (\x -> Just ("operations_access_level", textToBS (T.pack (show x)))) =<< project_edit_operations_access_level filters,+      (\b -> Just ("only_allow_merge_if_all_discussions_are_resolved", textToBS (showBool b))) =<< project_edit_only_allow_merge_if_all_discussions_are_resolved filters,+      (\b -> Just ("only_allow_merge_if_pipeline_succeeds", textToBS (showBool b))) =<< project_edit_only_allow_merge_if_pipeline_succeeds filters,+      (\b -> Just ("only_mirror_protected_branches", textToBS (showBool b))) =<< project_edit_only_mirror_protected_branches filters,+      (\b -> Just ("packages_enabled", textToBS (showBool b))) =<< project_edit_packages_enabled filters,+      (\x -> Just ("pages_access_level", textToBS (T.pack (show x)))) =<< project_edit_pages_access_level filters,+      (\x -> Just ("requirements_access_level", textToBS (T.pack (show x)))) =<< project_edit_requirements_access_level filters,+      (\b -> Just ("restrict_user_defined_variables", textToBS (showBool b))) =<< project_edit_restrict_user_defined_variables filters,+      (\t -> Just ("path", textToBS t)) =<< project_edit_path filters,+      (\b -> Just ("public_builds", textToBS (showBool b))) =<< project_edit_public_builds filters,+      (\b -> Just ("remove_source_branch_after_merge", textToBS (showBool b))) =<< project_edit_remove_source_branch_after_merge filters,+      (\x -> Just ("repository_access_level", textToBS (T.pack (show x)))) =<< project_edit_repository_access_level filters,+      (\t -> Just ("repository_storage", textToBS t)) =<< project_edit_repository_storage filters,+      (\b -> Just ("request_access_enabled", textToBS (showBool b))) =<< project_edit_request_access_enabled filters,+      (\b -> Just ("resolve_outdated_diff_discussions", textToBS (showBool b))) =<< project_edit_resolve_outdated_diff_discussions filters,+      (\b -> Just ("service_desk_enabled", textToBS (showBool b))) =<< project_edit_service_desk_enabled filters,+      (\b -> Just ("shared_runners_enabled", textToBS (showBool b))) =<< project_edit_shared_runners_enabled filters,+      (\b -> Just ("show_default_award_emojis", textToBS (showBool b))) =<< project_edit_show_default_award_emojis filters,+      (\x -> Just ("snippets_access_level", textToBS (T.pack (show x)))) =<< project_edit_snippets_access_level filters,+      (\x -> Just ("squash_option", textToBS (T.pack (show x)))) =<< project_edit_squash_option filters,+      (\t -> Just ("suggestion_commit_message", textToBS t)) =<< project_edit_suggestion_commit_message filters,+      (\x -> Just ("visibility", textToBS (T.pack (show x)))) =<< project_edit_visibility filters,+      (\x -> Just ("wiki_access_level", textToBS (T.pack (show x)))) =<< project_edit_wiki_access_level filters,+      (\t -> Just ("issues_template", textToBS t)) =<< project_edit_issues_template filters,+      (\t -> Just ("merge_requests_template", textToBS t)) =<< project_edit_merge_requests_template filters,+      (\b -> Just ("keep_latest_artifact", textToBS (showBool b))) =<< project_edit_keep_latest_artifact filters+    ]+  where+    textToBS = Just . T.encodeUtf8+    showBool :: Bool -> Text+    showBool True = "true"+    showBool False = "false"++data EditProjectAttrs = EditProjectAttrs+  { -- | Set whether or not merge requests can be merged with skipped jobs.+    project_edit_allow_merge_on_skipped_pipeline :: Maybe Bool,+    -- | One of disabled, private or enabled.+    project_edit_analytics_access_level :: Maybe Text,+    -- | How many approvers should approve merge request by default.+    project_edit_approvals_before_merge :: Maybe Int,+    -- | Auto-cancel pending pipelines.+    project_edit_auto_cancel_pending_pipelines :: Maybe EnabledDisabled,+    -- | Auto Deploy strategy (continuous, manual, or timed_incremental).+    project_edit_auto_devops_deploy_strategy :: Maybe AutoDeployStrategy,+    -- | Enable Auto DevOps for this project.+    project_edit_auto_devops_enabled :: Maybe Bool,+    -- | Set whether auto-closing referenced issues on default branch.+    project_edit_autoclose_referenced_issues :: Maybe Bool,+    -- | Test coverage parsing.+    project_edit_build_coverage_regex :: Maybe Text,+    -- | The Git strategy. Defaults to fetch.+    project_edit_build_git_strategy :: Maybe GitStrategy,+    -- | The maximum amount of time, in seconds, that a job can run.+    project_edit_build_timeout :: Maybe Int,+    -- | One of disabled, private, or enabled.+    project_edit_builds_access_level :: Maybe ProjectSettingAccessLevel,+    -- | The path to CI configuration file.+    project_edit_ci_config_path :: Maybe Text,+    -- | Default number of revisions for shallow cloning.+    project_edit_ci_default_git_depth :: Maybe Int,+    -- | When a new deployment job starts, skip older deployment jobs that are still pending.+    project_edit_ci_forward_deployment_enabled :: Maybe Bool,+    -- | Set visibility of container registry, for this project, to one of disabled, private or enabled.+    project_edit_container_registry_access_level :: Maybe ProjectSettingAccessLevel,+    -- | The default branch name.+    project_edit_default_branch :: Maybe Text,+    -- | Short project description.+    project_edit_description :: Maybe Text,+    -- | Disable email notifications.+    project_edit_emails_disabled :: Maybe Bool,+    -- | The classification label for the project.+    project_edit_external_authorization_classification_label :: Maybe Text,+    -- | One of disabled, private, or enabled.+    project_edit_forking_access_level :: Maybe ProjectSettingAccessLevel,+    -- | The ID or URL-encoded path of the project.+    project_edit_id :: Int,+    -- | URL to import repository from.+    project_edit_import_url :: Maybe Text,+    -- | One of disabled, private, or enabled.+    project_edit_issues_access_level :: Maybe ProjectSettingAccessLevel,+    -- | Enable LFS.+    project_edit_lfs_enabled :: Maybe Bool,+    -- | Set the merge method used.+    project_edit_merge_method :: Maybe MergeMethod,+    -- | One of disabled, private, or enabled.+    project_edit_merge_requests_access_level :: Maybe ProjectSettingAccessLevel,+    -- | Pull mirror overwrites diverged branches.+    project_edit_mirror_overwrites_diverged_branches :: Maybe Bool,+    -- | Pull mirroring triggers builds.+    project_edit_mirror_trigger_builds :: Maybe Bool,+    -- | User responsible for all the activity surrounding a pull mirror event. (admins only)+    project_edit_mirror_user_id :: Maybe Int,+    -- | Enables pull mirroring in a project.+    project_edit_mirror :: Maybe Bool,+    -- | The name of the project.+    project_edit_name :: Maybe Text,+    -- | One of disabled, private, or enabled.+    project_edit_operations_access_level :: Maybe ProjectSettingAccessLevel,+    -- | Set whether merge requests can only be merged when all the discussions are resolved.+    project_edit_only_allow_merge_if_all_discussions_are_resolved :: Maybe Bool,+    -- | Set whether merge requests can only be merged with successful jobs.+    project_edit_only_allow_merge_if_pipeline_succeeds :: Maybe Bool,+    -- | Only mirror protected branches.+    project_edit_only_mirror_protected_branches :: Maybe Bool,+    -- | Enable or disable packages repository feature.+    project_edit_packages_enabled :: Maybe Bool,+    -- | One of disabled, private, enabled, or public.+    project_edit_pages_access_level :: Maybe ProjectSettingAccessLevel,+    -- | One of disabled, private, enabled or public.+    project_edit_requirements_access_level :: Maybe ProjectSettingAccessLevel,+    -- | Allow only maintainers to pass user-defined variables when triggering a pipeline. For example when the pipeline is triggered in the UI, with the API, or by a trigger token.+    project_edit_restrict_user_defined_variables :: Maybe Bool,+    -- | Custom repository name for the project. By default generated based on name.+    project_edit_path :: Maybe Text,+    -- | If true, jobs can be viewed by non-project members.+    project_edit_public_builds :: Maybe Bool,+    -- | Enable Delete source branch option by default for all new merge requests.+    project_edit_remove_source_branch_after_merge :: Maybe Bool,+    -- | One of disabled, private, or enabled.+    project_edit_repository_access_level :: Maybe ProjectSettingAccessLevel,+    -- | Which storage shard the repository is on. (admins only)+    project_edit_repository_storage :: Maybe Text,+    -- | Allow users to request member access.+    project_edit_request_access_enabled :: Maybe Bool,+    -- | Automatically resolve merge request diffs discussions on lines changed with a push.+    project_edit_resolve_outdated_diff_discussions :: Maybe Bool,+    -- | Enable or disable Service Desk feature.+    project_edit_service_desk_enabled :: Maybe Bool,+    -- | Enable shared runners for this project.+    project_edit_shared_runners_enabled :: Maybe Bool,+    -- | Show default award emojis.+    project_edit_show_default_award_emojis :: Maybe Bool,+    -- | One of disabled, private, or enabled.+    project_edit_snippets_access_level :: Maybe ProjectSettingAccessLevel,+    -- | One of never, always, default_on, or default_off.+    project_edit_squash_option :: Maybe SquashOption,+    -- | The commit message used to apply merge request suggestions.+    project_edit_suggestion_commit_message :: Maybe Text,+    project_edit_visibility :: Maybe Visibility,+    -- | One of disabled, private, or enabled.+    project_edit_wiki_access_level :: Maybe ProjectSettingAccessLevel,+    -- | Default description for Issues. Description is parsed with GitLab Flavored Markdown. See Templates for issues and merge requests.+    project_edit_issues_template :: Maybe Text,+    -- | Default description for Merge Requests. Description is parsed with GitLab Flavored Markdown.+    project_edit_merge_requests_template :: Maybe Text,+    -- | Disable or enable the ability to keep the latest artifact for this project.+    project_edit_keep_latest_artifact :: Maybe Bool+  }+  deriving (Generic, Show, Eq)++data EnabledDisabled+  = Enabled+  | Disabled+  deriving (Eq)++instance Show EnabledDisabled where+  show Enabled = "enabled"+  show Disabled = "disabled"++data AutoDeployStrategy+  = Continuous+  | Manual+  | TimedIncremental+  deriving (Eq)++instance Show AutoDeployStrategy where+  show Continuous = "continuous"+  show Manual = "manual"+  show TimedIncremental = "timed_incremental"++data GitStrategy+  = Clone+  | Fetch+  | None+  deriving (Eq)++instance Show GitStrategy where+  show Clone = "clone"+  show Fetch = "fetch"+  show None = "none"++data ProjectSettingAccessLevel+  = DisabledAccess+  | PrivateAccess+  | EnabledAccess+  | PublicAccess+  deriving (Eq)++instance Show ProjectSettingAccessLevel where+  show DisabledAccess = "disabled"+  show PrivateAccess = "private"+  show EnabledAccess = "enabled"+  show PublicAccess = "public"++data MergeMethod+  = Merge+  | RebaseMerge+  | FF+  deriving (Eq)++instance Show MergeMethod where+  show Merge = "merge"+  show RebaseMerge = "rebase_merge"+  show FF = "ff"++data SquashOption+  = NeverSquash+  | AlwaysSquash+  | DefaultOnSquash+  | DefaultOffSquash+  deriving (Eq)++instance Show SquashOption where+  show NeverSquash = "never"+  show AlwaysSquash = "always"+  show DefaultOnSquash = "default_on"+  show DefaultOffSquash = "default_off"
src/GitLab/SystemHooks/Rules.hs view
@@ -11,7 +11,6 @@  import Control.Monad import Data.Text-import GitLab.API.Groups import GitLab.API.Members import GitLab.API.Projects import GitLab.API.Users
src/GitLab/SystemHooks/Types.hs view
@@ -698,13 +698,6 @@   | MergeRequested   deriving (Show, Eq) --- |  Project visibility.-data Visibility-  = Public-  | Private-  | Internal-  deriving (Show, Eq)- instance FromJSON ProjectCreate where   parseJSON =     withObject "ProjectCreate" $ \v -> do@@ -1434,12 +1427,3 @@   parseJSON (String "repository_update") = return RepositoryUpdated   parseJSON (String "merge_request") = return MergeRequested   parseJSON s = error ("unexpected system hook event: " <> show s)--instance FromJSON Visibility where-  parseJSON (String "public") = return Public-  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)
src/GitLab/Types.hs view
@@ -60,6 +60,7 @@     BoardIssue (..),     BoardIssueLabel (..),     ProjectBoard (..),+    Visibility (..),   ) where @@ -765,6 +766,22 @@     project_board_web_url :: Text   }   deriving (Generic, Show, Eq)++-- |  Project visibility.+data Visibility+  = Public+  | Private+  | Internal+  deriving (Show, Eq)++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)  ----------------------------- -- JSON GitLab parsers below
src/GitLab/WebRequests/GitLabWebCalls.hs view
@@ -105,14 +105,12 @@         params  gitlabDelete ::+  FromJSON a =>   -- | the URL to post to   Text ->-  GitLab (Either (Response BSL.ByteString) (Maybe ()))+  GitLab (Either (Response BSL.ByteString) (Maybe a)) gitlabDelete urlPath = do-  result <- request-  case result of-    Right (Just _) -> return (Right (Just ()))-    x -> return x+  request   where     request =       gitlabHTTPOne