{-# LANGUAGE OverloadedStrings #-}

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

    -- * Get file archive
    fileArchive,
    fileArchiveBS,

    -- * Contributors
    contributors,

    -- * Merge Base
    mergeBase,
  )
where

import Control.Monad.Except
import Control.Monad.IO.Class
import qualified Data.ByteString as BS
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.Types
import GitLab.WebRequests.GitLabWebCalls
import Network.HTTP.Client
import Network.HTTP.Types.Status

-- | returns a list of repository files and directories in a project.
repositoryTree ::
  -- | the project
  Project ->
  GitLab [Repository]
repositoryTree :: Project -> GitLab [Repository]
repositoryTree Project
project = do
  Either (Response ByteString) [Repository]
result <- Int -> GitLab (Either (Response ByteString) [Repository])
repositories' (Project -> Int
project_id Project
project)
  case Either (Response ByteString) [Repository]
result of
    Left Response ByteString
er -> GitLabError -> GitLab [Repository]
forall a. GitLabError -> GitLabT (ExceptT GitLabError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> GitLabError
GitLabError (Text
"repositories error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Response ByteString -> Text
forall payload. Response payload -> Text
responseErrorText Response ByteString
er))
    Right [Repository]
x -> [Repository] -> GitLab [Repository]
forall a. a -> GitLabT (ExceptT GitLabError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Repository]
x

-- | returns a list of repository files and directories in a project
-- given its project ID.
repositories' ::
  -- | the project ID
  Int ->
  GitLab (Either (Response BSL.ByteString) [Repository])
repositories' :: Int -> GitLab (Either (Response ByteString) [Repository])
repositories' Int
projectId =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) [Repository])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
addr []
  where
    addr :: Text
addr =
      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
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/tree"

-- | get a file archive of the repository files. For example:
--
-- > fileArchive myProject TarGz "/tmp/myProject.tar.gz"
fileArchive ::
  -- | project
  Project ->
  -- | file format
  ArchiveFormat ->
  -- | file path to store the archive
  FilePath ->
  GitLab (Either (Response BSL.ByteString) ())
fileArchive :: Project
-> ArchiveFormat
-> String
-> GitLab (Either (Response ByteString) ())
fileArchive Project
project = Int
-> ArchiveFormat
-> String
-> GitLab (Either (Response ByteString) ())
getFileArchive' (Project -> Int
project_id Project
project)

-- | get a file archive of the repository files as a
-- 'BSL.ByteString'. For example:
--
-- > fileArchiveBS myProject TarGz "/tmp/myProject.tar.gz"
fileArchiveBS ::
  -- | project
  Project ->
  -- | file format
  ArchiveFormat ->
  GitLab (Either (Response BSL.ByteString) BSL.ByteString)
fileArchiveBS :: Project
-> ArchiveFormat
-> GitLab (Either (Response ByteString) ByteString)
fileArchiveBS Project
project ArchiveFormat
format = do
  Either (Response ByteString) (Maybe ByteString)
result <- Int
-> ArchiveFormat
-> GitLab (Either (Response ByteString) (Maybe ByteString))
getFileArchiveBS' (Project -> Int
project_id Project
project) ArchiveFormat
format
  case Either (Response ByteString) (Maybe ByteString)
result of
    Left Response ByteString
resp -> Either (Response ByteString) ByteString
-> GitLab (Either (Response ByteString) ByteString)
forall a. a -> GitLabT (ExceptT GitLabError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response ByteString -> Either (Response ByteString) ByteString
forall a b. a -> Either a b
Left Response ByteString
resp)
    Right Maybe ByteString
Nothing -> GitLabError -> GitLab (Either (Response ByteString) ByteString)
forall a. GitLabError -> GitLabT (ExceptT GitLabError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> GitLabError
GitLabError Text
"fileArchiveBS could not download file")
    Right (Just ByteString
bs) -> Either (Response ByteString) ByteString
-> GitLab (Either (Response ByteString) ByteString)
forall a. a -> GitLabT (ExceptT GitLabError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (ByteString -> Either (Response ByteString) ByteString
forall a b. b -> Either a b
Right ByteString
bs)

-- | get a file archive of the repository files using the project's
--   ID. For example:
--
-- > getFileArchive' 3453 Zip "/tmp/myProject.zip"
getFileArchive' ::
  -- | project ID
  Int ->
  -- | file format
  ArchiveFormat ->
  -- | file path to store the archive
  FilePath ->
  GitLab (Either (Response BSL.ByteString) ())
getFileArchive' :: Int
-> ArchiveFormat
-> String
-> GitLab (Either (Response ByteString) ())
getFileArchive' Int
projectId ArchiveFormat
format String
fPath = do
  Either (Response ByteString) (Maybe ByteString)
attempt <- Int
-> ArchiveFormat
-> GitLab (Either (Response ByteString) (Maybe ByteString))
getFileArchiveBS' Int
projectId ArchiveFormat
format
  case Either (Response ByteString) (Maybe ByteString)
attempt of
    Left Response ByteString
st -> Either (Response ByteString) ()
-> GitLab (Either (Response ByteString) ())
forall a. a -> GitLabT (ExceptT GitLabError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response ByteString -> Either (Response ByteString) ()
forall a b. a -> Either a b
Left Response ByteString
st)
    Right Maybe ByteString
Nothing ->
      () -> Either (Response ByteString) ()
forall a b. b -> Either a b
Right (() -> Either (Response ByteString) ())
-> GitLabT (ExceptT GitLabError IO) ()
-> GitLab (Either (Response ByteString) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> GitLabError -> GitLabT (ExceptT GitLabError IO) ()
forall a. GitLabError -> GitLabT (ExceptT GitLabError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> GitLabError
GitLabError Text
"getFileArchive' could not download file")
    Right (Just ByteString
archiveData) ->
      () -> Either (Response ByteString) ()
forall a b. b -> Either a b
Right (() -> Either (Response ByteString) ())
-> GitLabT (ExceptT GitLabError IO) ()
-> GitLab (Either (Response ByteString) ())
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> IO () -> GitLabT (ExceptT GitLabError IO) ()
forall a. IO a -> GitLabT (ExceptT GitLabError IO) a
forall (m :: * -> *) a. MonadIO m => IO a -> m a
liftIO (String -> ByteString -> IO ()
BSL.writeFile String
fPath ByteString
archiveData)

-- | get a file archive of the repository files as a 'BSL.ByteString'
--   using the project's ID. For example:
--
-- > getFileArchiveBS' 3453 Zip "/tmp/myProject.zip"
getFileArchiveBS' ::
  -- | project ID
  Int ->
  -- | file format
  ArchiveFormat ->
  GitLab (Either (Response BSL.ByteString) (Maybe BSL.ByteString))
getFileArchiveBS' :: Int
-> ArchiveFormat
-> GitLab (Either (Response ByteString) (Maybe ByteString))
getFileArchiveBS' Int
projectId ArchiveFormat
format = do
  Response ByteString
result <- Text -> [GitLabParam] -> GitLab (Response ByteString)
gitlabGetByteStringResponse Text
addr []
  let (Status Int
n ByteString
_msg) = Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
result
  if Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
>= Int
200 Bool -> Bool -> Bool
&& Int
n Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
<= Int
226
    then Either (Response ByteString) (Maybe ByteString)
-> GitLab (Either (Response ByteString) (Maybe ByteString))
forall a. a -> GitLabT (ExceptT GitLabError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Maybe ByteString -> Either (Response ByteString) (Maybe ByteString)
forall a b. b -> Either a b
Right (ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
result)))
    else Either (Response ByteString) (Maybe ByteString)
-> GitLab (Either (Response ByteString) (Maybe ByteString))
forall a. a -> GitLabT (ExceptT GitLabError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response ByteString
-> Either (Response ByteString) (Maybe ByteString)
forall a b. a -> Either a b
Left Response ByteString
result)
  where
    addr :: Text
addr =
      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
projectId)
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/archive"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> String -> Text
T.pack (ArchiveFormat -> String
forall a. Show a => a -> String
show ArchiveFormat
format)

-- | Get repository contributors list.
contributors ::
  -- | project
  Project ->
  -- | Return contributors ordered by name, email, or commits (orders
  -- by commit date) fields. Default is commits.
  Maybe OrderBy ->
  -- | Return contributors sorted in asc or desc order. Default is
  -- asc.
  Maybe SortBy ->
  GitLab [Contributor]
contributors :: Project -> Maybe OrderBy -> Maybe SortBy -> GitLab [Contributor]
contributors Project
prj Maybe OrderBy
order Maybe SortBy
sort = do
  Either (Response ByteString) [Contributor]
result <- Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) [Contributor])
forall a.
FromJSON a =>
Text -> [GitLabParam] -> GitLab (Either (Response ByteString) [a])
gitlabGetMany Text
addr [GitLabParam]
params
  case Either (Response ByteString) [Contributor]
result of
    Left Response ByteString
er -> GitLabError -> GitLab [Contributor]
forall a. GitLabError -> GitLabT (ExceptT GitLabError IO) a
forall e (m :: * -> *) a. MonadError e m => e -> m a
throwError (Text -> GitLabError
GitLabError (Text
"contributors error: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Response ByteString -> Text
forall payload. Response payload -> Text
responseErrorText Response ByteString
er))
    Right [Contributor]
x -> [Contributor] -> GitLab [Contributor]
forall a. a -> GitLabT (ExceptT GitLabError IO) a
forall (m :: * -> *) a. Monad m => a -> m a
return [Contributor]
x
  where
    addr :: Text
addr =
      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
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/contributors"
    params :: [GitLabParam]
    params :: [GitLabParam]
params =
      [Maybe GitLabParam] -> [GitLabParam]
forall a. [Maybe a] -> [a]
catMaybes
        [ (\SortBy
x -> GitLabParam -> Maybe GitLabParam
forall a. a -> Maybe a
Just (ByteString
"sort", SortBy -> Maybe ByteString
forall a. Show a => a -> Maybe ByteString
showAttr SortBy
x)) (SortBy -> Maybe GitLabParam) -> Maybe SortBy -> Maybe GitLabParam
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe SortBy
sort,
          (\OrderBy
x -> GitLabParam -> Maybe GitLabParam
forall a. a -> Maybe a
Just (ByteString
"order_by", OrderBy -> Maybe ByteString
forall a. Show a => a -> Maybe ByteString
showAttr OrderBy
x)) (OrderBy -> Maybe GitLabParam)
-> Maybe OrderBy -> Maybe GitLabParam
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Maybe OrderBy
order
        ]
    showAttr :: (Show a) => a -> Maybe BS.ByteString
    showAttr :: forall a. Show a => a -> Maybe ByteString
showAttr = ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (ByteString -> Maybe ByteString)
-> (a -> ByteString) -> a -> Maybe ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> ByteString
T.encodeUtf8 (Text -> ByteString) -> (a -> Text) -> a -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Text) -> (a -> String) -> a -> Text
forall b c a. (b -> c) -> (a -> b) -> a -> c
. a -> String
forall a. Show a => a -> String
show

-- | Get the common ancestor for 2 or more refs.
mergeBase ::
  -- | project
  Project ->
  -- | The refs to find the common ancestor of, multiple refs can be
  -- passed. An example of a ref is
  -- '304d257dcb821665ab5110318fc58a007bd104ed'.
  [Text] ->
  GitLab (Either (Response BSL.ByteString) (Maybe Commit))
mergeBase :: Project
-> [Text] -> GitLab (Either (Response ByteString) (Maybe Commit))
mergeBase Project
prj [Text]
refs =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Commit))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne
    Text
addr
    [GitLabParam]
params
  where
    addr :: Text
addr =
      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
prj))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/repository"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/merge_base"
    params :: [GitLabParam]
    params :: [GitLabParam]
params =
      (Text -> GitLabParam) -> [Text] -> [GitLabParam]
forall a b. (a -> b) -> [a] -> [b]
map (\Text
ref -> (ByteString
"refs[]", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
ref))) [Text]
refs