{-# LANGUAGE OverloadedStrings #-} -- | -- Module : MergeRequests -- Description : Queries about merge requests against projects -- Copyright : (c) Rob Stewart, Heriot-Watt University, 2019 -- License : BSD3 -- Maintainer : robstewart57@gmail.com -- Stability : stable module GitLab.API.MergeRequests ( -- * List merge requests mergeRequests, mergeRequestsWith, -- -- * Merge requests list response notes -- -- * List project merge requests -- -- * List group merge requests -- * Get single MR mergeRequest, -- -- * Single merge request response notes -- -- * Get single MR participants -- -- * Get single MR reviewers -- -- * Get single MR commits -- -- * Get single MR changes -- -- * List MR pipelines -- -- * Create MR Pipeline -- * Create MR createMergeRequest, -- -- * Update MR -- * Accept MR acceptMergeRequest, -- * Delete a merge request deleteMergeRequest, -- * merge request attributes mrAttrs, MergeProjectAttrs (..), MergeRequestState (..), WIP (..), ) where import qualified Data.ByteString as BS 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 Data.Time.Clock import Data.Time.Format.ISO8601 import GitLab.Types import GitLab.WebRequests.GitLabWebCalls import Network.HTTP.Client -- | returns the merge request for a project given its merge request -- IID. mergeRequest :: -- | project Project -> -- | merge request IID Int -> GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) mergeRequest project = mergeRequest' (project_id project) -- | returns the merge request for a project given its project ID and -- merge request IID. mergeRequest' :: -- | project ID Int -> -- | merge request IID Int -> GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) mergeRequest' projectId mergeRequestIID = gitlabGetOne addr [] where addr = "/projects/" <> T.pack (show projectId) <> "/merge_requests/" <> T.pack (show mergeRequestIID) -- | returns the merge requests for a project. mergeRequests :: -- | the project Project -> 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' :: -- | project ID Int -> GitLab (Either (Response BSL.ByteString) [MergeRequest]) mergeRequests' projectId = gitlabGetMany addr [("scope", Just "all")] where addr = "/projects/" <> T.pack (show projectId) <> "/merge_requests" -- | returns the merge requests for a project and a set of search -- attributes as 'Just' values in 'MergeProjectAttrs'. The 'mrAttrs' -- value has default merge request search values, which is a record -- that can be modified with 'Just' values. -- -- For example to search only for open merge requests for a project: -- -- > mergeRequestsWith myProject (mrAttrs {mr_attr_state = Just MROpened}) mergeRequestsWith :: -- | the project Project -> -- | merge request search attributes MergeProjectAttrs -> GitLab [MergeRequest] mergeRequestsWith p attrs = do result <- mergeRequestsWith' (project_id p) attrs return (fromRight (error "mergeRequests error") result) -- | returns the merge requests for a project given its project ID and -- a set of search attributes as 'Just' values in 'MergeProjectAttrs'. -- The 'mrAttrs' value has default merge request search values, which -- is a record that can be modified with 'Just' values. -- -- For example to search only for open merge requests for project with -- ID 11744514: -- -- > mergeRequestsWith' 11744514 (mrAttrs {mr_attr_state = Just MROpened}) mergeRequestsWith' :: -- | project ID Int -> -- | merge request search attributes MergeProjectAttrs -> GitLab (Either (Response BSL.ByteString) [MergeRequest]) mergeRequestsWith' projectId attrs = gitlabGetMany addr (mrAttrsParams attrs) where addr = "/projects/" <> T.pack (show projectId) <> "/merge_requests" -- | Creates a merge request. createMergeRequest :: -- | project Project -> -- | source branch Text -> -- | target branch Text -> -- | target project ID Int -> -- | merge request title Text -> -- | merge request description Text -> GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) createMergeRequest project = createMergeRequest' (project_id project) -- | Creates a merge request. createMergeRequest' :: -- | project ID Int -> -- | source branch Text -> -- | target branch Text -> -- | target project ID Int -> -- | merge request title Text -> -- | merge request description Text -> GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) createMergeRequest' projectId sourceBranch targetBranch targetProjectId mrTitle mrDescription = gitlabPost addr params where params :: [GitLabParam] params = [ ("source_branch", Just (T.encodeUtf8 sourceBranch)), ("target_branch", Just (T.encodeUtf8 targetBranch)), ("target_project_id", Just (T.encodeUtf8 (T.pack (show targetProjectId)))), ("title", Just (T.encodeUtf8 mrTitle)), ("description", Just (T.encodeUtf8 mrDescription)) ] addr = T.pack $ "/projects/" <> show projectId <> "/merge_requests" -- | Accepts a merge request. acceptMergeRequest :: -- | project Project -> -- | merge request IID Int -> GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) acceptMergeRequest project = acceptMergeRequest' (project_id project) -- | Accepts a merge request. acceptMergeRequest' :: -- | project ID Int -> -- | merge request IID Int -> GitLab (Either (Response BSL.ByteString) (Maybe MergeRequest)) acceptMergeRequest' projectId mergeRequestIid = gitlabPost addr params where params :: [GitLabParam] params = [ ("id", Just (T.encodeUtf8 (T.pack (show projectId)))), ("merge_request_iid", Just (T.encodeUtf8 (T.pack (show mergeRequestIid)))) ] addr = T.pack $ "/projects/" <> show projectId <> "/merge_requests/" <> show mergeRequestIid <> "/merge" -- | Deletes a merge request. Only for admins and project owners. deleteMergeRequest :: -- | project Project -> -- | merge request IID Int -> GitLab (Either (Response BSL.ByteString) (Maybe ())) deleteMergeRequest project = deleteMergeRequest' (project_id project) -- | Deletes a merge request. Only for admins and project owners. deleteMergeRequest' :: -- | project ID Int -> -- | merge request IID Int -> GitLab (Either (Response BSL.ByteString) (Maybe ())) deleteMergeRequest' projectId mergeRequestIid = gitlabDelete addr [] where addr = T.pack $ "/projects/" <> show projectId <> "/merge_requests/" <> show mergeRequestIid -- | Attributes when searching for merge requests with the -- 'mergeRequestsWith' functions. data MergeProjectAttrs = MergeProjectAttrs { -- | Return all merge requests or just those that are opened, -- closed, locked, or merged. mr_attr_state :: Maybe MergeRequestState, -- | Return requests ordered by created_at or updated_at -- fields. Default is created_at. Note that the 'OrderBy' type has -- more options, but only 'CreatedAt' and 'UpdatedAt' are -- applicable for ordering merge requests. mr_attr_order_by :: Maybe OrderBy, -- | Return requests sorted in asc or desc order. Default is desc. mr_attr_sort :: Maybe SortBy, -- | Return merge requests for a specific milestone. None returns -- merge requests with no milestone. Any returns merge requests -- that have an assigned milestone. mr_attr_milestone :: Maybe Milestone, -- -- | If simple, returns the iid, URL, title, description, and -- -- basic state of merge request. -- merge_request_view :: Maybe MergeRequestView, -- | Return merge requests matching a comma separated list of -- labels. mr_attr_labels :: Maybe Text, -- | If true, response returns more details for each label in -- labels field: :name, :color, :description, :description_html, -- :text_color. Default is false. mr_attr_with_labels_details :: Maybe Bool, -- | If true, this projection requests (but does not guarantee) -- that the merge_status field be recalculated -- asynchronously. Default is false. mr_attr_with_merge_status_recheck :: Maybe Bool, -- | Return merge requests created on or after the given time. mr_attr_created_after :: Maybe UTCTime, -- | Return merge requests created on or before the given time. mr_attr_created_before :: Maybe UTCTime, -- | Return merge requests updated on or after the given time. mr_attr_updated_after :: Maybe UTCTime, -- | Return merge requests updated on or before the given time. mr_attr_updated_before :: Maybe UTCTime, -- | Return merge requests for the given scope: created_by_me, -- assigned_to_me or all. Defaults to created_by_me. mr_attr_scope :: Maybe Scope, -- | Returns merge requests created by the given user id. Mutually -- exclusive with author_username. Combine with scope=all or -- scope=assigned_to_me. mr_attr_author_id :: Maybe Int, -- | Returns merge requests created by the given -- username. Mutually exclusive with author_id. mr_attr_author_username :: Maybe Text, -- | Returns merge requests assigned to the given user id. mr_attr_assignee_id :: Maybe Int, -- | Returns merge requests which have specified all the users -- with the given ids as individual approvers. mr_attr_approver_ids :: Maybe [Int], -- | Returns merge requests which have been approved by all the -- users with the given ids (Max: 5). mr_attr_approved_by_ids :: Maybe [Int], -- | Returns merge requests which have the user as a reviewer with -- the given user id. Mutually exclusive with reviewer_username. mr_attr_reviewer_id :: Maybe Int, -- | Returns merge requests which have the user as a reviewer with -- the given username. Mutually exclusive with reviewer_id. mr_attr_reviewer_username :: Maybe Text, -- | Return merge requests reacted by the authenticated user by -- the given emoji. mr_attr_my_reaction_emoji :: Maybe Text, -- | Return merge requests with the given source branch. mr_attr_source_branch :: Maybe Text, -- | Return merge requests with the given target branch. mr_attr_target_branch :: Maybe Text, -- | Search merge requests against their title and description. mr_attr_search :: Maybe Text, -- | Modify the scope of the search attribute. title, description, -- or a string joining them with comma. Default is -- title,description. mr_attr_in :: Maybe SearchIn, -- | Filter merge requests against their wip status. yes to return -- only draft merge requests, no to return non-draft merge -- requests. mr_attr_wip :: Maybe WIP, -- -- | Return merge requests that do not match the parameters -- -- supplied. Accepts: labels, milestone, author_id, -- -- author_username, assignee_id, assignee_username, reviewer_id, -- -- reviewer_username, my_reaction_emoji. -- merge_request_not :: Maybe Text, -- | Returns merge requests deployed to the given environment. mr_attr_environment :: Maybe UTCTime, -- | Return merge requests deployed before the given date/time. mr_attr_deployed_before :: Maybe UTCTime, -- | Return merge requests deployed after the given date/time. mr_attr_deployed_after :: Maybe UTCTime } -- TODO create types for merge_request_my_reaction_emoji -- | for filtering by merge request state. data MergeRequestState = -- | return only opened merge requests MROpened | -- | return only closed merge requests MRClosed | -- | return only locked merge requests MRLocked | -- | return only merged merge requests MRMerged instance Show MergeRequestState where show MROpened = "opened" show MRClosed = "closed" show MRLocked = "locked" show MRMerged = "merged" -- | WIP status of merge requests data WIP = -- | return only draft merge requests WIPYes | -- | return non-draft merge requests WIPNo instance Show WIP where show WIPYes = "yes" show WIPNo = "no" -- | No merge request search filters, thereby returning all merge requests. Default scope is "all". mrAttrs :: MergeProjectAttrs mrAttrs = MergeProjectAttrs 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 mrAttrsParams :: MergeProjectAttrs -> [GitLabParam] mrAttrsParams attrs = catMaybes [ (\x -> Just ("state", showAttr x)) =<< mr_attr_state attrs, (\x -> Just ("order_by", showAttr x)) =<< mr_attr_order_by attrs, (\x -> Just ("sort", showAttr x)) =<< mr_attr_sort attrs, (\x -> Just ("milestone", showAttr x)) =<< mr_attr_milestone attrs, (\t -> Just ("labels", showAttrT t)) =<< mr_attr_labels attrs, (\b -> Just ("with_labels_details", showBool b)) =<< mr_attr_with_labels_details attrs, (\b -> Just ("with_merge_status_recheck", showBool b)) =<< mr_attr_with_merge_status_recheck attrs, (\t -> Just ("created_after", showTime t)) =<< mr_attr_created_after attrs, (\t -> Just ("created_before", showTime t)) =<< mr_attr_created_before attrs, (\t -> Just ("updated_after", showTime t)) =<< mr_attr_updated_after attrs, (\t -> Just ("updated_before", showTime t)) =<< mr_attr_updated_before attrs, (\x -> Just ("scope", showAttr x)) =<< mr_attr_scope attrs, (\i -> Just ("author_id", showAttr i)) =<< mr_attr_author_id attrs, (\t -> Just ("author_username", showAttrT t)) =<< mr_attr_author_username attrs, (\i -> Just ("assignee_id", showAttr i)) =<< mr_attr_assignee_id attrs, (\i -> Just ("approver_ids", showAttr i)) =<< mr_attr_approver_ids attrs, (\is -> Just ("approved_by_ids", showAttr is)) =<< mr_attr_approved_by_ids attrs, (\i -> Just ("reviewer_id", showAttr i)) =<< mr_attr_reviewer_id attrs, (\t -> Just ("reviewer_username", showAttrT t)) =<< mr_attr_reviewer_username attrs, (\t -> Just ("my_reaction_emoji", showAttrT t)) =<< mr_attr_my_reaction_emoji attrs, (\t -> Just ("source_branch", showAttrT t)) =<< mr_attr_source_branch attrs, (\t -> Just ("target_branch", showAttrT t)) =<< mr_attr_target_branch attrs, (\t -> Just ("search", showAttrT t)) =<< mr_attr_search attrs, (\x -> Just ("in", showAttr x)) =<< mr_attr_in attrs, (\x -> Just ("wip", showAttr x)) =<< mr_attr_wip attrs, (\t -> Just ("environment", showTime t)) =<< mr_attr_environment attrs, (\t -> Just ("deployed_before", showTime t)) =<< mr_attr_deployed_before attrs, (\t -> Just ("deployed_after", showTime t)) =<< mr_attr_deployed_after attrs ] where showAttr :: (Show a) => a -> Maybe BS.ByteString showAttr = Just . T.encodeUtf8 . T.pack . show showAttrT = Just . T.encodeUtf8 showBool :: Bool -> Maybe BS.ByteString showBool True = Just (T.encodeUtf8 (T.pack "true")) showBool False = Just (T.encodeUtf8 (T.pack "false")) showTime :: UTCTime -> Maybe BS.ByteString showTime = Just . T.encodeUtf8 . T.pack . iso8601Show