{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : Commits
-- Description : Queries about commits in repositories
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.API.Commits
  ( -- * List repository commits
    repoCommits,

    -- * Create a commit with multiple files and actions
    createCommitMultipleFilesActions,

    -- * Get a single commit
    singleCommit,

    -- * Get references a commit is pushed to

    -- * Cherry-pick a commit
    cheryPickCommit,

    -- * Revert a commit
    revertCommit,

    -- * Get the diff of a commit
    commitDiff,

    -- * Get the comments of a commit
    commitComments,

    -- * Post comment to commit
    postCommitComment,

    -- * Get the discussions of a commit
    commitDiscussions,
    -- -- * Commit status

    -- -- * List the statuses of a commit

    -- -- * Post the build status to a commit

    -- * List merge requests associated with a commit
    commitMergeRequests,
    -- -- * Get GPG signature of a commit

    -- * Commits on specific branch
    branchCommits,

    -- * Types
    CommitAction (..),
    ContentEncoding (..),
    Action (..),
  )
where

import qualified Data.ByteString.Lazy as BSL
import Data.Either
import Data.Text (Text)
import qualified Data.Text as T
import qualified Data.Text.Encoding as T
import GitLab.Types
import GitLab.WebRequests.GitLabWebCalls
import Network.HTTP.Client

-- | Get a list of repository commits in a project.
repoCommits ::
  -- | the project
  Project ->
  GitLab [Commit]
repoCommits :: Project -> GitLab [Commit]
repoCommits Project
prj = do
  -- return an empty list if the repository could not be found.
  Either (Response ByteString) [Commit]
result <- Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) [Commit])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany (Int -> Text
commitsAddr (Project -> Int
project_id Project
prj)) [(ByteString
"with_stats", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just ByteString
"true")]
  [Commit] -> GitLab [Commit]
forall (m :: * -> *) a. Monad m => a -> m a
return ([Commit] -> Either (Response ByteString) [Commit] -> [Commit]
forall b a. b -> Either a b -> b
fromRight [] Either (Response ByteString) [Commit]
result)
  where
    commitsAddr :: Int -> Text
    commitsAddr :: Int -> Text
commitsAddr Int
projId =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
projId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits"

-- | Get a list of repository commits in a project.
createCommitMultipleFilesActions ::
  -- | the project
  Project ->
  -- | Name of the branch to commit into.
  Text ->
  -- | Commit message
  Text ->
  [CommitAction] ->
  GitLab (Maybe Commit)
createCommitMultipleFilesActions :: Project -> Text -> Text -> [CommitAction] -> GitLab (Maybe Commit)
createCommitMultipleFilesActions Project
prj Text
branchName Text
commitMsg [CommitAction]
actions = do
  -- return an empty list if the repository could not be found.
  Either (Response ByteString) (Maybe Commit)
result <-
    Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Commit))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost
      (Int -> Text
commitsAddr (Project -> Int
project_id Project
prj))
      [ (ByteString
"branch", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
branchName)),
        (ByteString
"commit_message", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
commitMsg)),
        (ByteString
"actions", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 (String -> Text
T.pack ([CommitAction] -> String
forall a. Show a => a -> String
show [CommitAction]
actions))))
      ]
  case Either (Response ByteString) (Maybe Commit)
result of
    Left Response ByteString
resp -> String -> GitLab (Maybe Commit)
forall a. HasCallStack => String -> a
error (String
"createCommitMultipleFilesActions: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> Response ByteString -> String
forall a. Show a => a -> String
show Response ByteString
resp)
    Right Maybe Commit
x -> Maybe Commit -> GitLab (Maybe Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Commit
x
  where
    commitsAddr :: Int -> Text
    commitsAddr :: Int -> Text
commitsAddr Int
projId =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
projId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits"

-- | A commit action.
data CommitAction = CommitAction
  { CommitAction -> Action
commit_action_action :: Action,
    -- | Full path to the file.
    CommitAction -> String
commit_action_file_path :: FilePath,
    -- | Original full path to the file being
    -- moved. Ex. lib/class1.rb. Only considered for move action.
    CommitAction -> Maybe Text
commit_action_previous_path :: Maybe Text,
    -- | File content, required for all except delete, chmod, and
    -- move. Move actions that do not specify content preserve the
    -- existing file content, and any other value of content overwrites
    -- the file content.
    CommitAction -> Maybe Text
commit_action_content :: Maybe Text,
    -- | text or base64. text is default.
    CommitAction -> Maybe ContentEncoding
commit_action_encoding :: Maybe ContentEncoding,
    -- | Last known file commit ID. Only considered in update, move, and
    -- delete actions.
    CommitAction -> Maybe Text
commit_action_last_commit_id :: Maybe Text,
    -- | When true/false enables/disables the execute flag on the
    -- file. Only considered for chmod action.
    CommitAction -> Maybe Bool
commit_action_execute_filemode :: Maybe Bool
  }
  deriving (Int -> CommitAction -> String -> String
[CommitAction] -> String -> String
CommitAction -> String
(Int -> CommitAction -> String -> String)
-> (CommitAction -> String)
-> ([CommitAction] -> String -> String)
-> Show CommitAction
forall a.
(Int -> a -> String -> String)
-> (a -> String) -> ([a] -> String -> String) -> Show a
showList :: [CommitAction] -> String -> String
$cshowList :: [CommitAction] -> String -> String
show :: CommitAction -> String
$cshow :: CommitAction -> String
showsPrec :: Int -> CommitAction -> String -> String
$cshowsPrec :: Int -> CommitAction -> String -> String
Show, CommitAction -> CommitAction -> Bool
(CommitAction -> CommitAction -> Bool)
-> (CommitAction -> CommitAction -> Bool) -> Eq CommitAction
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CommitAction -> CommitAction -> Bool
$c/= :: CommitAction -> CommitAction -> Bool
== :: CommitAction -> CommitAction -> Bool
$c== :: CommitAction -> CommitAction -> Bool
Eq)

-- | The actual action within a commit action.
data Action
  = ActionCreate
  | ActionDelete
  | ActionMove
  | ActionUpdate
  | ActionChmod
  deriving (Action -> Action -> Bool
(Action -> Action -> Bool)
-> (Action -> Action -> Bool) -> Eq Action
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Action -> Action -> Bool
$c/= :: Action -> Action -> Bool
== :: Action -> Action -> Bool
$c== :: Action -> Action -> Bool
Eq)

instance Show Action where
  show :: Action -> String
show Action
ActionCreate = String
"create"
  show Action
ActionDelete = String
"delete"
  show Action
ActionMove = String
"move"
  show Action
ActionUpdate = String
"update"
  show Action
ActionChmod = String
"chmod"

-- | Whether the content is text or base 64.
data ContentEncoding
  = EncodingText
  | EncodingBase64
  deriving (ContentEncoding -> ContentEncoding -> Bool
(ContentEncoding -> ContentEncoding -> Bool)
-> (ContentEncoding -> ContentEncoding -> Bool)
-> Eq ContentEncoding
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentEncoding -> ContentEncoding -> Bool
$c/= :: ContentEncoding -> ContentEncoding -> Bool
== :: ContentEncoding -> ContentEncoding -> Bool
$c== :: ContentEncoding -> ContentEncoding -> Bool
Eq)

instance Show ContentEncoding where
  show :: ContentEncoding -> String
show ContentEncoding
EncodingText = String
"text"
  show ContentEncoding
EncodingBase64 = String
"base64"

-- | returns all commits of a branch from a project
-- given its project ID and the branch name.
branchCommits ::
  -- | project
  Project ->
  -- | branch name
  Text ->
  GitLab (Either (Response BSL.ByteString) [Commit])
branchCommits :: Project -> Text -> GitLab (Either (Response ByteString) [Commit])
branchCommits Project
prj Text
branchName = do
  Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) [Commit])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany (Int -> Text
commitsAddr (Project -> Int
project_id Project
prj)) [(ByteString
"ref_name", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
branchName))]
  where
    commitsAddr :: Int -> Text
    commitsAddr :: Int -> Text
commitsAddr Int
projId =
      Text
"/projects/" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
projId) Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits"

-- | Get a specific commit identified by the commit hash or name of a
-- branch or tag.
singleCommit ::
  -- | the project
  Project ->
  -- | the commit hash
  Text ->
  GitLab (Maybe Commit)
singleCommit :: Project -> Text -> GitLab (Maybe Commit)
singleCommit Project
project Text
theHash = do
  Either (Response ByteString) (Maybe Commit)
result <- Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Commit))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne (Int -> Text
commitsAddr (Project -> Int
project_id Project
project)) []
  Maybe Commit -> GitLab (Maybe Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe Commit
-> Either (Response ByteString) (Maybe Commit) -> Maybe Commit
forall b a. b -> Either a b -> b
fromRight Maybe Commit
forall a. Maybe a
Nothing Either (Response ByteString) (Maybe Commit)
result)
  where
    commitsAddr :: Int -> Text
    commitsAddr :: Int -> Text
commitsAddr Int
projId =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
projId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
theHash

-- | Cherry-picks a commit to a given branch.
cheryPickCommit ::
  -- | the project
  Project ->
  -- | the commit hash
  Text ->
  -- | 	The name of the branch
  Text ->
  GitLab (Maybe Commit)
cheryPickCommit :: Project -> Text -> Text -> GitLab (Maybe Commit)
cheryPickCommit Project
project Text
theHash Text
branchName = do
  Either (Response ByteString) (Maybe Commit)
result <-
    Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Commit))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost
      Text
commitsAddr
      [ (ByteString
"branch", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
branchName))
      ]
  case Either (Response ByteString) (Maybe Commit)
result of
    Left Response ByteString
_ -> Maybe Commit -> GitLab (Maybe Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Commit
forall a. Maybe a
Nothing
    Right Maybe Commit
x -> Maybe Commit -> GitLab (Maybe Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Commit
x
  where
    commitsAddr :: Text
    commitsAddr :: Text
commitsAddr =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Project -> Int
project_id Project
project))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
theHash
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/cherry_pick"

-- | Reverts a commit in a given branch.
revertCommit ::
  -- | the project
  Project ->
  -- | the commit hash
  Text ->
  -- | target branch name
  Text ->
  GitLab (Maybe Commit)
revertCommit :: Project -> Text -> Text -> GitLab (Maybe Commit)
revertCommit Project
project Text
theHash Text
branchName = do
  Either (Response ByteString) (Maybe Commit)
result <-
    Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Commit))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost
      Text
commitsAddr
      [ (ByteString
"branch", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
branchName))
      ]
  case Either (Response ByteString) (Maybe Commit)
result of
    Left Response ByteString
_ -> Maybe Commit -> GitLab (Maybe Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Commit
forall a. Maybe a
Nothing
    Right Maybe Commit
x -> Maybe Commit -> GitLab (Maybe Commit)
forall (m :: * -> *) a. Monad m => a -> m a
return Maybe Commit
x
  where
    commitsAddr :: Text
    commitsAddr :: Text
commitsAddr =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show (Project -> Int
project_id Project
project))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
theHash
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/revert"

-- | Get the diff of a commit in a project.
commitDiff ::
  -- | project
  Project ->
  -- | 	The commit hash or name of a repository branch or tag
  Text ->
  GitLab (Either (Response BSL.ByteString) [Diff])
commitDiff :: Project -> Text -> GitLab (Either (Response ByteString) [Diff])
commitDiff Project
project Text
sha = do
  Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) [Diff])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany (Int -> Text
commitsAddr (Project -> Int
project_id Project
project)) []
  where
    commitsAddr :: Int -> Text
    commitsAddr :: Int -> Text
commitsAddr Int
projId =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
projId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
sha)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/diff"

-- | Get the diff of a commit in a project.
commitComments ::
  -- | project
  Project ->
  -- | 	The commit hash or name of a repository branch or tag
  Text ->
  GitLab (Either (Response BSL.ByteString) [CommitNote])
commitComments :: Project
-> Text -> GitLab (Either (Response ByteString) [CommitNote])
commitComments Project
project Text
sha = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) [CommitNote])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany (Int -> Text
commitsAddr (Project -> Int
project_id Project
project)) []
  where
    commitsAddr :: Int -> Text
    commitsAddr :: Int -> Text
commitsAddr Int
projId =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
projId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
sha)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/comments"

-- | Adds a comment to a commit.
postCommitComment ::
  -- | project
  Project ->
  -- | The commit hash or name of a repository branch or tag
  Text ->
  -- | The text of the comment
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe CommitNote))
postCommitComment :: Project
-> Text
-> Text
-> GitLab (Either (Response ByteString) (Maybe CommitNote))
postCommitComment Project
project Text
sha Text
note = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe CommitNote))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost
    (Int -> Text
commitsAddr (Project -> Int
project_id Project
project))
    [(ByteString
"note", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
note))]
  where
    commitsAddr :: Int -> Text
    commitsAddr :: Int -> Text
commitsAddr Int
projId =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
projId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
sha)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/comments"

-- | Get the discussions of a commit in a project.
commitDiscussions ::
  -- | project
  Project ->
  -- | 	The commit hash or name of a repository branch or tag
  Text ->
  GitLab (Either (Response BSL.ByteString) [Discussion])
commitDiscussions :: Project
-> Text -> GitLab (Either (Response ByteString) [Discussion])
commitDiscussions Project
project Text
sha = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) [Discussion])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany (Int -> Text
commitsAddr (Project -> Int
project_id Project
project)) []
  where
    commitsAddr :: Int -> Text
    commitsAddr :: Int -> Text
commitsAddr Int
projId =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
projId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
sha)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/discussions"

-- | Get the discussions of a commit in a project.
commitMergeRequests ::
  -- | project
  Project ->
  -- | The commit SHA
  Text ->
  GitLab (Either (Response BSL.ByteString) [MergeRequest])
commitMergeRequests :: Project
-> Text -> GitLab (Either (Response ByteString) [MergeRequest])
commitMergeRequests Project
project Text
sha = do
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) [MergeRequest])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany (Int -> Text
commitsAddr (Project -> Int
project_id Project
project)) []
  where
    commitsAddr :: Int -> Text
    commitsAddr :: Int -> Text
commitsAddr Int
projId =
      Text
"/projects/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Int -> String
forall a. Show a => a -> String
show Int
projId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/commits/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (Text -> String
forall a. Show a => a -> String
show Text
sha)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/merge_requests"

-------------
-- candidates for deletion

-- -- | returns all commits of a branch from a project given the branch
-- -- name.
-- branchCommits ::
--   -- | project
--   Project ->
--   -- | branch name
--   Text ->
--   GitLab [Commit]
-- branchCommits project branchName = do
--   result <- branchCommits' (project_id project) branchName
--   return (fromRight [] result)