{-# 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 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.URI

-- | Get a list of repository files and directories in a project.
repositoryFiles ::
  -- | the project
  Project ->
  -- | the file path
  Text ->
  -- | name of the branch, tag or commit
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe RepositoryFile))
repositoryFiles :: Project
-> Text
-> Text
-> GitLab (Either (Response ByteString) (Maybe RepositoryFile))
repositoryFiles Project
project = Int
-> Text
-> Text
-> GitLab (Either (Response ByteString) (Maybe RepositoryFile))
repositoryFiles' (Project -> Int
project_id Project
project)

-- | Get a list of repository files and directories in a project given
-- the project's ID.
repositoryFiles' ::
  -- | project ID
  Int ->
  -- | the file path
  Text ->
  -- | name of the branch, tag or commit
  Text ->
  GitLab (Either (Response BSL.ByteString) (Maybe RepositoryFile))
repositoryFiles' :: Int
-> Text
-> Text
-> GitLab (Either (Response ByteString) (Maybe RepositoryFile))
repositoryFiles' Int
projectId Text
filePath Text
reference =
  Text
-> Text
-> GitLab (Either (Response ByteString) (Maybe RepositoryFile))
forall a.
FromJSON a =>
Text -> Text -> GitLab (Either (Response ByteString) (Maybe a))
gitlabWithAttrsOne Text
addr (Text
"&ref=" Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> 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 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
"/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))

-- | Get raw data for a given file blob hash.
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 =
  Text -> GitLab (Either (Response ByteString) String)
gitlabReqText 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
"/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"