{-# LANGUAGE OverloadedStrings #-}

-- |
-- Module      : RepositoryFiles
-- Description : Queries about project repository files
-- Copyright   : (c) Rob Stewart, Heriot-Watt University, 2019
-- License     : BSD3
-- Maintainer  : robstewart57@gmail.com
-- Stability   : stable
module GitLab.API.RepositoryFiles where

import qualified Data.ByteString.Lazy as BSL
import qualified Data.ByteString.Lazy.Char8 as BSL8
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
import Network.HTTP.Types.URI

-- | Allows you to receive information about file in repository like
-- name, size, content. File content is Base64 encoded.
repositoryFile ::
  -- | the project
  Project ->
  -- | the file path
  Text ->
  -- | name of the branch, tag or commit
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe RepositoryFile))
repositoryFile :: Project
-> Text
-> Text
-> GitLab (Either (Response ByteString) (Maybe RepositoryFile))
repositoryFile Project
prj Text
filePath Text
reference =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe RepositoryFile))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne Text
addr [(ByteString
"ref", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
reference))]
  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
"/files"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8 (Bool -> ByteString -> ByteString
urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 Text
filePath))

-- | Allows you to receive blame information. Each blame range
-- contains lines and corresponding commit information.
repositoryFileBlame ::
  -- | the project
  Project ->
  -- | the file path
  Text ->
  -- | name of the branch, tag or commit
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe RepositoryFileBlame))
repositoryFileBlame :: Project
-> Text
-> Text
-> GitLab
     (Either (Response ByteString) (Maybe RepositoryFileBlame))
repositoryFileBlame Project
prj Text
filePath Text
reference =
  Text
-> [GitLabParam]
-> GitLab
     (Either (Response ByteString) (Maybe RepositoryFileBlame))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne Text
addr [(ByteString
"ref", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
reference))]
  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
"/files"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8 (Bool -> ByteString -> ByteString
urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 Text
filePath))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/blame"

-- | Get a raw file from a repository.
repositoryFileRawFile ::
  -- | the project
  Project ->
  -- | the file path
  Text ->
  -- | The name of branch, tag or commit. Default is the HEAD of the
  -- project.
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe Text))
repositoryFileRawFile :: Project
-> Text
-> Text
-> GitLab (Either (Response ByteString) (Maybe Text))
repositoryFileRawFile Project
prj Text
filePath Text
reference =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe Text))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabGetOne Text
addr [(ByteString
"ref", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
reference))]
  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
"/files"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8 (Bool -> ByteString -> ByteString
urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 Text
filePath))
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/raw"

-- | Allows you to receive information about blob in repository like
-- size and content. Blob content is Base64 encoded.
repositoryFileBlob ::
  -- | project ID
  Int ->
  -- | blob SHA
  Text ->
  GitLab (Either (Response BSL.ByteString) String)
repositoryFileBlob :: Int -> Text -> GitLab (Either (Response ByteString) String)
repositoryFileBlob Int
projectId Text
blobSha = do
  Response ByteString
resp <- Text -> [GitLabParam] -> GitLab (Response ByteString)
gitlabGetByteStringResponse Text
addr []
  if Status -> Bool
successStatus (Response ByteString -> Status
forall body. Response body -> Status
responseStatus Response ByteString
resp)
    then Either (Response ByteString) String
-> GitLab (Either (Response ByteString) String)
forall a. a -> GitLabT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (String -> Either (Response ByteString) String
forall a b. b -> Either a b
Right (ByteString -> String
BSL8.unpack (Response ByteString -> ByteString
forall body. Response body -> body
responseBody Response ByteString
resp)))
    else Either (Response ByteString) String
-> GitLab (Either (Response ByteString) String)
forall a. a -> GitLabT IO a
forall (m :: * -> *) a. Monad m => a -> m a
return (Response ByteString -> Either (Response ByteString) String
forall a b. a -> Either a b
Left Response ByteString
resp)
  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
"/blobs/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
blobSha
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Text
"/raw"
    successStatus :: Status -> Bool
    successStatus :: Status -> Bool
successStatus (Status Int
n ByteString
_msg) =
      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

-- | This allows you to create a single file. For creating multiple
-- files with a single request see the commits API.
createRepositoryFile ::
  -- | the project
  Project ->
  -- | the file path
  Text ->
  -- | Name of the new branch to create. The commit is added to this
  -- branch.
  Text ->
  -- | The file’s content
  Text ->
  -- | The commit message
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe RepositoryFileSimple))
createRepositoryFile :: Project
-> Text
-> Text
-> Text
-> Text
-> GitLab
     (Either (Response ByteString) (Maybe RepositoryFileSimple))
createRepositoryFile Project
prj Text
filePath Text
branchName Text
fContent Text
commitMsg =
  Text
-> [GitLabParam]
-> GitLab
     (Either (Response ByteString) (Maybe RepositoryFileSimple))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPost Text
addr [(ByteString
"branch", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
branchName)), (ByteString
"content", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
fContent)), (ByteString
"commit_message", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
commitMsg))]
  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
"/files/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8 (Bool -> ByteString -> ByteString
urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 Text
filePath))

-- | This allows you to update a single file. For updating multiple
-- files with a single request see the commits API.
updateRepositoryFile ::
  -- | the project
  Project ->
  -- | the file path
  Text ->
  -- | Name of the new branch to create. The commit is added to this
  -- branch.
  Text ->
  -- | The file’s content
  Text ->
  -- | The commit message
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe RepositoryFileSimple))
updateRepositoryFile :: Project
-> Text
-> Text
-> Text
-> Text
-> GitLab
     (Either (Response ByteString) (Maybe RepositoryFileSimple))
updateRepositoryFile Project
prj Text
filePath Text
branchName Text
fContent Text
commitMsg =
  Text
-> [GitLabParam]
-> GitLab
     (Either (Response ByteString) (Maybe RepositoryFileSimple))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabPut Text
addr [(ByteString
"branch", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
branchName)), (ByteString
"content", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
fContent)), (ByteString
"commit_message", ByteString -> Maybe ByteString
forall a. a -> Maybe a
Just (Text -> ByteString
T.encodeUtf8 Text
commitMsg))]
  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
"/files/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8 (Bool -> ByteString -> ByteString
urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 Text
filePath))

-- | This allows you to delete a single file. For deleting multiple files with a single request, see the commits API.
deleteRepositoryFile ::
  -- | the project
  Project ->
  -- | the file path
  Text ->
  -- | Name of the new branch to create. The commit is added to this
  -- branch.
  Text ->
  -- | The commit message
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe ()))
deleteRepositoryFile :: Project
-> Text
-> Text
-> Text
-> GitLab (Either (Response ByteString) (Maybe ()))
deleteRepositoryFile Project
prj Text
filePath Text
branchName Text
commitMsg =
  Text
-> [GitLabParam]
-> GitLab (Either (Response ByteString) (Maybe ()))
forall a.
FromJSON a =>
Text
-> [GitLabParam] -> GitLab (Either (Response ByteString) (Maybe a))
gitlabDelete Text
addr [(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))]
  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
"/files/"
        Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> ByteString -> Text
T.decodeUtf8 (Bool -> ByteString -> ByteString
urlEncode Bool
False (Text -> ByteString
T.encodeUtf8 Text
filePath))