{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.CodeCommit.PutFile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds or updates a file in a branch in an AWS CodeCommit repository, and
-- generates a commit for the addition in the specified branch.
module Amazonka.CodeCommit.PutFile
  ( -- * Creating a Request
    PutFile (..),
    newPutFile,

    -- * Request Lenses
    putFile_commitMessage,
    putFile_email,
    putFile_fileMode,
    putFile_name,
    putFile_parentCommitId,
    putFile_repositoryName,
    putFile_branchName,
    putFile_fileContent,
    putFile_filePath,

    -- * Destructuring the Response
    PutFileResponse (..),
    newPutFileResponse,

    -- * Response Lenses
    putFileResponse_httpStatus,
    putFileResponse_commitId,
    putFileResponse_blobId,
    putFileResponse_treeId,
  )
where

import Amazonka.CodeCommit.Types
import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newPutFile' smart constructor.
data PutFile = PutFile'
  { -- | A message about why this file was added or updated. Although it is
    -- optional, a message makes the commit history for your repository more
    -- useful.
    PutFile -> Maybe Text
commitMessage :: Prelude.Maybe Prelude.Text,
    -- | An email address for the person adding or updating the file.
    PutFile -> Maybe Text
email :: Prelude.Maybe Prelude.Text,
    -- | The file mode permissions of the blob. Valid file mode permissions are
    -- listed here.
    PutFile -> Maybe FileModeTypeEnum
fileMode :: Prelude.Maybe FileModeTypeEnum,
    -- | The name of the person adding or updating the file. Although it is
    -- optional, a name makes the commit history for your repository more
    -- useful.
    PutFile -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The full commit ID of the head commit in the branch where you want to
    -- add or update the file. If this is an empty repository, no commit ID is
    -- required. If this is not an empty repository, a commit ID is required.
    --
    -- The commit ID must match the ID of the head commit at the time of the
    -- operation. Otherwise, an error occurs, and the file is not added or
    -- updated.
    PutFile -> Maybe Text
parentCommitId :: Prelude.Maybe Prelude.Text,
    -- | The name of the repository where you want to add or update the file.
    PutFile -> Text
repositoryName :: Prelude.Text,
    -- | The name of the branch where you want to add or update the file. If this
    -- is an empty repository, this branch is created.
    PutFile -> Text
branchName :: Prelude.Text,
    -- | The content of the file, in binary object format.
    PutFile -> Base64
fileContent :: Data.Base64,
    -- | The name of the file you want to add or update, including the relative
    -- path to the file in the repository.
    --
    -- If the path does not currently exist in the repository, the path is
    -- created as part of adding the file.
    PutFile -> Text
filePath :: Prelude.Text
  }
  deriving (PutFile -> PutFile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutFile -> PutFile -> Bool
$c/= :: PutFile -> PutFile -> Bool
== :: PutFile -> PutFile -> Bool
$c== :: PutFile -> PutFile -> Bool
Prelude.Eq, ReadPrec [PutFile]
ReadPrec PutFile
Int -> ReadS PutFile
ReadS [PutFile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutFile]
$creadListPrec :: ReadPrec [PutFile]
readPrec :: ReadPrec PutFile
$creadPrec :: ReadPrec PutFile
readList :: ReadS [PutFile]
$creadList :: ReadS [PutFile]
readsPrec :: Int -> ReadS PutFile
$creadsPrec :: Int -> ReadS PutFile
Prelude.Read, Int -> PutFile -> ShowS
[PutFile] -> ShowS
PutFile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutFile] -> ShowS
$cshowList :: [PutFile] -> ShowS
show :: PutFile -> String
$cshow :: PutFile -> String
showsPrec :: Int -> PutFile -> ShowS
$cshowsPrec :: Int -> PutFile -> ShowS
Prelude.Show, forall x. Rep PutFile x -> PutFile
forall x. PutFile -> Rep PutFile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutFile x -> PutFile
$cfrom :: forall x. PutFile -> Rep PutFile x
Prelude.Generic)

-- |
-- Create a value of 'PutFile' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'commitMessage', 'putFile_commitMessage' - A message about why this file was added or updated. Although it is
-- optional, a message makes the commit history for your repository more
-- useful.
--
-- 'email', 'putFile_email' - An email address for the person adding or updating the file.
--
-- 'fileMode', 'putFile_fileMode' - The file mode permissions of the blob. Valid file mode permissions are
-- listed here.
--
-- 'name', 'putFile_name' - The name of the person adding or updating the file. Although it is
-- optional, a name makes the commit history for your repository more
-- useful.
--
-- 'parentCommitId', 'putFile_parentCommitId' - The full commit ID of the head commit in the branch where you want to
-- add or update the file. If this is an empty repository, no commit ID is
-- required. If this is not an empty repository, a commit ID is required.
--
-- The commit ID must match the ID of the head commit at the time of the
-- operation. Otherwise, an error occurs, and the file is not added or
-- updated.
--
-- 'repositoryName', 'putFile_repositoryName' - The name of the repository where you want to add or update the file.
--
-- 'branchName', 'putFile_branchName' - The name of the branch where you want to add or update the file. If this
-- is an empty repository, this branch is created.
--
-- 'fileContent', 'putFile_fileContent' - The content of the file, in binary object format.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'filePath', 'putFile_filePath' - The name of the file you want to add or update, including the relative
-- path to the file in the repository.
--
-- If the path does not currently exist in the repository, the path is
-- created as part of adding the file.
newPutFile ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'branchName'
  Prelude.Text ->
  -- | 'fileContent'
  Prelude.ByteString ->
  -- | 'filePath'
  Prelude.Text ->
  PutFile
newPutFile :: Text -> Text -> ByteString -> Text -> PutFile
newPutFile
  Text
pRepositoryName_
  Text
pBranchName_
  ByteString
pFileContent_
  Text
pFilePath_ =
    PutFile'
      { $sel:commitMessage:PutFile' :: Maybe Text
commitMessage = forall a. Maybe a
Prelude.Nothing,
        $sel:email:PutFile' :: Maybe Text
email = forall a. Maybe a
Prelude.Nothing,
        $sel:fileMode:PutFile' :: Maybe FileModeTypeEnum
fileMode = forall a. Maybe a
Prelude.Nothing,
        $sel:name:PutFile' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
        $sel:parentCommitId:PutFile' :: Maybe Text
parentCommitId = forall a. Maybe a
Prelude.Nothing,
        $sel:repositoryName:PutFile' :: Text
repositoryName = Text
pRepositoryName_,
        $sel:branchName:PutFile' :: Text
branchName = Text
pBranchName_,
        $sel:fileContent:PutFile' :: Base64
fileContent = Iso' Base64 ByteString
Data._Base64 forall t b. AReview t b -> b -> t
Lens.# ByteString
pFileContent_,
        $sel:filePath:PutFile' :: Text
filePath = Text
pFilePath_
      }

-- | A message about why this file was added or updated. Although it is
-- optional, a message makes the commit history for your repository more
-- useful.
putFile_commitMessage :: Lens.Lens' PutFile (Prelude.Maybe Prelude.Text)
putFile_commitMessage :: Lens' PutFile (Maybe Text)
putFile_commitMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutFile' {Maybe Text
commitMessage :: Maybe Text
$sel:commitMessage:PutFile' :: PutFile -> Maybe Text
commitMessage} -> Maybe Text
commitMessage) (\s :: PutFile
s@PutFile' {} Maybe Text
a -> PutFile
s {$sel:commitMessage:PutFile' :: Maybe Text
commitMessage = Maybe Text
a} :: PutFile)

-- | An email address for the person adding or updating the file.
putFile_email :: Lens.Lens' PutFile (Prelude.Maybe Prelude.Text)
putFile_email :: Lens' PutFile (Maybe Text)
putFile_email = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutFile' {Maybe Text
email :: Maybe Text
$sel:email:PutFile' :: PutFile -> Maybe Text
email} -> Maybe Text
email) (\s :: PutFile
s@PutFile' {} Maybe Text
a -> PutFile
s {$sel:email:PutFile' :: Maybe Text
email = Maybe Text
a} :: PutFile)

-- | The file mode permissions of the blob. Valid file mode permissions are
-- listed here.
putFile_fileMode :: Lens.Lens' PutFile (Prelude.Maybe FileModeTypeEnum)
putFile_fileMode :: Lens' PutFile (Maybe FileModeTypeEnum)
putFile_fileMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutFile' {Maybe FileModeTypeEnum
fileMode :: Maybe FileModeTypeEnum
$sel:fileMode:PutFile' :: PutFile -> Maybe FileModeTypeEnum
fileMode} -> Maybe FileModeTypeEnum
fileMode) (\s :: PutFile
s@PutFile' {} Maybe FileModeTypeEnum
a -> PutFile
s {$sel:fileMode:PutFile' :: Maybe FileModeTypeEnum
fileMode = Maybe FileModeTypeEnum
a} :: PutFile)

-- | The name of the person adding or updating the file. Although it is
-- optional, a name makes the commit history for your repository more
-- useful.
putFile_name :: Lens.Lens' PutFile (Prelude.Maybe Prelude.Text)
putFile_name :: Lens' PutFile (Maybe Text)
putFile_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutFile' {Maybe Text
name :: Maybe Text
$sel:name:PutFile' :: PutFile -> Maybe Text
name} -> Maybe Text
name) (\s :: PutFile
s@PutFile' {} Maybe Text
a -> PutFile
s {$sel:name:PutFile' :: Maybe Text
name = Maybe Text
a} :: PutFile)

-- | The full commit ID of the head commit in the branch where you want to
-- add or update the file. If this is an empty repository, no commit ID is
-- required. If this is not an empty repository, a commit ID is required.
--
-- The commit ID must match the ID of the head commit at the time of the
-- operation. Otherwise, an error occurs, and the file is not added or
-- updated.
putFile_parentCommitId :: Lens.Lens' PutFile (Prelude.Maybe Prelude.Text)
putFile_parentCommitId :: Lens' PutFile (Maybe Text)
putFile_parentCommitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutFile' {Maybe Text
parentCommitId :: Maybe Text
$sel:parentCommitId:PutFile' :: PutFile -> Maybe Text
parentCommitId} -> Maybe Text
parentCommitId) (\s :: PutFile
s@PutFile' {} Maybe Text
a -> PutFile
s {$sel:parentCommitId:PutFile' :: Maybe Text
parentCommitId = Maybe Text
a} :: PutFile)

-- | The name of the repository where you want to add or update the file.
putFile_repositoryName :: Lens.Lens' PutFile Prelude.Text
putFile_repositoryName :: Lens' PutFile Text
putFile_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutFile' {Text
repositoryName :: Text
$sel:repositoryName:PutFile' :: PutFile -> Text
repositoryName} -> Text
repositoryName) (\s :: PutFile
s@PutFile' {} Text
a -> PutFile
s {$sel:repositoryName:PutFile' :: Text
repositoryName = Text
a} :: PutFile)

-- | The name of the branch where you want to add or update the file. If this
-- is an empty repository, this branch is created.
putFile_branchName :: Lens.Lens' PutFile Prelude.Text
putFile_branchName :: Lens' PutFile Text
putFile_branchName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutFile' {Text
branchName :: Text
$sel:branchName:PutFile' :: PutFile -> Text
branchName} -> Text
branchName) (\s :: PutFile
s@PutFile' {} Text
a -> PutFile
s {$sel:branchName:PutFile' :: Text
branchName = Text
a} :: PutFile)

-- | The content of the file, in binary object format.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
putFile_fileContent :: Lens.Lens' PutFile Prelude.ByteString
putFile_fileContent :: Lens' PutFile ByteString
putFile_fileContent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutFile' {Base64
fileContent :: Base64
$sel:fileContent:PutFile' :: PutFile -> Base64
fileContent} -> Base64
fileContent) (\s :: PutFile
s@PutFile' {} Base64
a -> PutFile
s {$sel:fileContent:PutFile' :: Base64
fileContent = Base64
a} :: PutFile) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. Iso' Base64 ByteString
Data._Base64

-- | The name of the file you want to add or update, including the relative
-- path to the file in the repository.
--
-- If the path does not currently exist in the repository, the path is
-- created as part of adding the file.
putFile_filePath :: Lens.Lens' PutFile Prelude.Text
putFile_filePath :: Lens' PutFile Text
putFile_filePath = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutFile' {Text
filePath :: Text
$sel:filePath:PutFile' :: PutFile -> Text
filePath} -> Text
filePath) (\s :: PutFile
s@PutFile' {} Text
a -> PutFile
s {$sel:filePath:PutFile' :: Text
filePath = Text
a} :: PutFile)

instance Core.AWSRequest PutFile where
  type AWSResponse PutFile = PutFileResponse
  request :: (Service -> Service) -> PutFile -> Request PutFile
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutFile
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutFile)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Text -> Text -> Text -> PutFileResponse
PutFileResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"commitId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"blobId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"treeId")
      )

instance Prelude.Hashable PutFile where
  hashWithSalt :: Int -> PutFile -> Int
hashWithSalt Int
_salt PutFile' {Maybe Text
Maybe FileModeTypeEnum
Text
Base64
filePath :: Text
fileContent :: Base64
branchName :: Text
repositoryName :: Text
parentCommitId :: Maybe Text
name :: Maybe Text
fileMode :: Maybe FileModeTypeEnum
email :: Maybe Text
commitMessage :: Maybe Text
$sel:filePath:PutFile' :: PutFile -> Text
$sel:fileContent:PutFile' :: PutFile -> Base64
$sel:branchName:PutFile' :: PutFile -> Text
$sel:repositoryName:PutFile' :: PutFile -> Text
$sel:parentCommitId:PutFile' :: PutFile -> Maybe Text
$sel:name:PutFile' :: PutFile -> Maybe Text
$sel:fileMode:PutFile' :: PutFile -> Maybe FileModeTypeEnum
$sel:email:PutFile' :: PutFile -> Maybe Text
$sel:commitMessage:PutFile' :: PutFile -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
commitMessage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
email
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FileModeTypeEnum
fileMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
parentCommitId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
branchName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Base64
fileContent
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
filePath

instance Prelude.NFData PutFile where
  rnf :: PutFile -> ()
rnf PutFile' {Maybe Text
Maybe FileModeTypeEnum
Text
Base64
filePath :: Text
fileContent :: Base64
branchName :: Text
repositoryName :: Text
parentCommitId :: Maybe Text
name :: Maybe Text
fileMode :: Maybe FileModeTypeEnum
email :: Maybe Text
commitMessage :: Maybe Text
$sel:filePath:PutFile' :: PutFile -> Text
$sel:fileContent:PutFile' :: PutFile -> Base64
$sel:branchName:PutFile' :: PutFile -> Text
$sel:repositoryName:PutFile' :: PutFile -> Text
$sel:parentCommitId:PutFile' :: PutFile -> Maybe Text
$sel:name:PutFile' :: PutFile -> Maybe Text
$sel:fileMode:PutFile' :: PutFile -> Maybe FileModeTypeEnum
$sel:email:PutFile' :: PutFile -> Maybe Text
$sel:commitMessage:PutFile' :: PutFile -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
commitMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
email
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FileModeTypeEnum
fileMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
parentCommitId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
repositoryName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
branchName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Base64
fileContent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
filePath

instance Data.ToHeaders PutFile where
  toHeaders :: PutFile -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"CodeCommit_20150413.PutFile" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON PutFile where
  toJSON :: PutFile -> Value
toJSON PutFile' {Maybe Text
Maybe FileModeTypeEnum
Text
Base64
filePath :: Text
fileContent :: Base64
branchName :: Text
repositoryName :: Text
parentCommitId :: Maybe Text
name :: Maybe Text
fileMode :: Maybe FileModeTypeEnum
email :: Maybe Text
commitMessage :: Maybe Text
$sel:filePath:PutFile' :: PutFile -> Text
$sel:fileContent:PutFile' :: PutFile -> Base64
$sel:branchName:PutFile' :: PutFile -> Text
$sel:repositoryName:PutFile' :: PutFile -> Text
$sel:parentCommitId:PutFile' :: PutFile -> Maybe Text
$sel:name:PutFile' :: PutFile -> Maybe Text
$sel:fileMode:PutFile' :: PutFile -> Maybe FileModeTypeEnum
$sel:email:PutFile' :: PutFile -> Maybe Text
$sel:commitMessage:PutFile' :: PutFile -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"commitMessage" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
commitMessage,
            (Key
"email" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
email,
            (Key
"fileMode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe FileModeTypeEnum
fileMode,
            (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
name,
            (Key
"parentCommitId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
parentCommitId,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"repositoryName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
repositoryName),
            forall a. a -> Maybe a
Prelude.Just (Key
"branchName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
branchName),
            forall a. a -> Maybe a
Prelude.Just (Key
"fileContent" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Base64
fileContent),
            forall a. a -> Maybe a
Prelude.Just (Key
"filePath" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
filePath)
          ]
      )

instance Data.ToPath PutFile where
  toPath :: PutFile -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery PutFile where
  toQuery :: PutFile -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newPutFileResponse' smart constructor.
data PutFileResponse = PutFileResponse'
  { -- | The response's http status code.
    PutFileResponse -> Int
httpStatus :: Prelude.Int,
    -- | The full SHA ID of the commit that contains this file change.
    PutFileResponse -> Text
commitId :: Prelude.Text,
    -- | The ID of the blob, which is its SHA-1 pointer.
    PutFileResponse -> Text
blobId :: Prelude.Text,
    -- | The full SHA-1 pointer of the tree information for the commit that
    -- contains this file change.
    PutFileResponse -> Text
treeId :: Prelude.Text
  }
  deriving (PutFileResponse -> PutFileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutFileResponse -> PutFileResponse -> Bool
$c/= :: PutFileResponse -> PutFileResponse -> Bool
== :: PutFileResponse -> PutFileResponse -> Bool
$c== :: PutFileResponse -> PutFileResponse -> Bool
Prelude.Eq, ReadPrec [PutFileResponse]
ReadPrec PutFileResponse
Int -> ReadS PutFileResponse
ReadS [PutFileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutFileResponse]
$creadListPrec :: ReadPrec [PutFileResponse]
readPrec :: ReadPrec PutFileResponse
$creadPrec :: ReadPrec PutFileResponse
readList :: ReadS [PutFileResponse]
$creadList :: ReadS [PutFileResponse]
readsPrec :: Int -> ReadS PutFileResponse
$creadsPrec :: Int -> ReadS PutFileResponse
Prelude.Read, Int -> PutFileResponse -> ShowS
[PutFileResponse] -> ShowS
PutFileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutFileResponse] -> ShowS
$cshowList :: [PutFileResponse] -> ShowS
show :: PutFileResponse -> String
$cshow :: PutFileResponse -> String
showsPrec :: Int -> PutFileResponse -> ShowS
$cshowsPrec :: Int -> PutFileResponse -> ShowS
Prelude.Show, forall x. Rep PutFileResponse x -> PutFileResponse
forall x. PutFileResponse -> Rep PutFileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutFileResponse x -> PutFileResponse
$cfrom :: forall x. PutFileResponse -> Rep PutFileResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutFileResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'putFileResponse_httpStatus' - The response's http status code.
--
-- 'commitId', 'putFileResponse_commitId' - The full SHA ID of the commit that contains this file change.
--
-- 'blobId', 'putFileResponse_blobId' - The ID of the blob, which is its SHA-1 pointer.
--
-- 'treeId', 'putFileResponse_treeId' - The full SHA-1 pointer of the tree information for the commit that
-- contains this file change.
newPutFileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'commitId'
  Prelude.Text ->
  -- | 'blobId'
  Prelude.Text ->
  -- | 'treeId'
  Prelude.Text ->
  PutFileResponse
newPutFileResponse :: Int -> Text -> Text -> Text -> PutFileResponse
newPutFileResponse
  Int
pHttpStatus_
  Text
pCommitId_
  Text
pBlobId_
  Text
pTreeId_ =
    PutFileResponse'
      { $sel:httpStatus:PutFileResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:commitId:PutFileResponse' :: Text
commitId = Text
pCommitId_,
        $sel:blobId:PutFileResponse' :: Text
blobId = Text
pBlobId_,
        $sel:treeId:PutFileResponse' :: Text
treeId = Text
pTreeId_
      }

-- | The response's http status code.
putFileResponse_httpStatus :: Lens.Lens' PutFileResponse Prelude.Int
putFileResponse_httpStatus :: Lens' PutFileResponse Int
putFileResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutFileResponse' {Int
httpStatus :: Int
$sel:httpStatus:PutFileResponse' :: PutFileResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: PutFileResponse
s@PutFileResponse' {} Int
a -> PutFileResponse
s {$sel:httpStatus:PutFileResponse' :: Int
httpStatus = Int
a} :: PutFileResponse)

-- | The full SHA ID of the commit that contains this file change.
putFileResponse_commitId :: Lens.Lens' PutFileResponse Prelude.Text
putFileResponse_commitId :: Lens' PutFileResponse Text
putFileResponse_commitId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutFileResponse' {Text
commitId :: Text
$sel:commitId:PutFileResponse' :: PutFileResponse -> Text
commitId} -> Text
commitId) (\s :: PutFileResponse
s@PutFileResponse' {} Text
a -> PutFileResponse
s {$sel:commitId:PutFileResponse' :: Text
commitId = Text
a} :: PutFileResponse)

-- | The ID of the blob, which is its SHA-1 pointer.
putFileResponse_blobId :: Lens.Lens' PutFileResponse Prelude.Text
putFileResponse_blobId :: Lens' PutFileResponse Text
putFileResponse_blobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutFileResponse' {Text
blobId :: Text
$sel:blobId:PutFileResponse' :: PutFileResponse -> Text
blobId} -> Text
blobId) (\s :: PutFileResponse
s@PutFileResponse' {} Text
a -> PutFileResponse
s {$sel:blobId:PutFileResponse' :: Text
blobId = Text
a} :: PutFileResponse)

-- | The full SHA-1 pointer of the tree information for the commit that
-- contains this file change.
putFileResponse_treeId :: Lens.Lens' PutFileResponse Prelude.Text
putFileResponse_treeId :: Lens' PutFileResponse Text
putFileResponse_treeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutFileResponse' {Text
treeId :: Text
$sel:treeId:PutFileResponse' :: PutFileResponse -> Text
treeId} -> Text
treeId) (\s :: PutFileResponse
s@PutFileResponse' {} Text
a -> PutFileResponse
s {$sel:treeId:PutFileResponse' :: Text
treeId = Text
a} :: PutFileResponse)

instance Prelude.NFData PutFileResponse where
  rnf :: PutFileResponse -> ()
rnf PutFileResponse' {Int
Text
treeId :: Text
blobId :: Text
commitId :: Text
httpStatus :: Int
$sel:treeId:PutFileResponse' :: PutFileResponse -> Text
$sel:blobId:PutFileResponse' :: PutFileResponse -> Text
$sel:commitId:PutFileResponse' :: PutFileResponse -> Text
$sel:httpStatus:PutFileResponse' :: PutFileResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
commitId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
blobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
treeId