{-# 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.DeleteBranch
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a branch from a repository, unless that branch is the default
-- branch for the repository.
module Amazonka.CodeCommit.DeleteBranch
  ( -- * Creating a Request
    DeleteBranch (..),
    newDeleteBranch,

    -- * Request Lenses
    deleteBranch_repositoryName,
    deleteBranch_branchName,

    -- * Destructuring the Response
    DeleteBranchResponse (..),
    newDeleteBranchResponse,

    -- * Response Lenses
    deleteBranchResponse_deletedBranch,
    deleteBranchResponse_httpStatus,
  )
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

-- | Represents the input of a delete branch operation.
--
-- /See:/ 'newDeleteBranch' smart constructor.
data DeleteBranch = DeleteBranch'
  { -- | The name of the repository that contains the branch to be deleted.
    DeleteBranch -> Text
repositoryName :: Prelude.Text,
    -- | The name of the branch to delete.
    DeleteBranch -> Text
branchName :: Prelude.Text
  }
  deriving (DeleteBranch -> DeleteBranch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteBranch -> DeleteBranch -> Bool
$c/= :: DeleteBranch -> DeleteBranch -> Bool
== :: DeleteBranch -> DeleteBranch -> Bool
$c== :: DeleteBranch -> DeleteBranch -> Bool
Prelude.Eq, ReadPrec [DeleteBranch]
ReadPrec DeleteBranch
Int -> ReadS DeleteBranch
ReadS [DeleteBranch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteBranch]
$creadListPrec :: ReadPrec [DeleteBranch]
readPrec :: ReadPrec DeleteBranch
$creadPrec :: ReadPrec DeleteBranch
readList :: ReadS [DeleteBranch]
$creadList :: ReadS [DeleteBranch]
readsPrec :: Int -> ReadS DeleteBranch
$creadsPrec :: Int -> ReadS DeleteBranch
Prelude.Read, Int -> DeleteBranch -> ShowS
[DeleteBranch] -> ShowS
DeleteBranch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteBranch] -> ShowS
$cshowList :: [DeleteBranch] -> ShowS
show :: DeleteBranch -> String
$cshow :: DeleteBranch -> String
showsPrec :: Int -> DeleteBranch -> ShowS
$cshowsPrec :: Int -> DeleteBranch -> ShowS
Prelude.Show, forall x. Rep DeleteBranch x -> DeleteBranch
forall x. DeleteBranch -> Rep DeleteBranch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteBranch x -> DeleteBranch
$cfrom :: forall x. DeleteBranch -> Rep DeleteBranch x
Prelude.Generic)

-- |
-- Create a value of 'DeleteBranch' 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:
--
-- 'repositoryName', 'deleteBranch_repositoryName' - The name of the repository that contains the branch to be deleted.
--
-- 'branchName', 'deleteBranch_branchName' - The name of the branch to delete.
newDeleteBranch ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'branchName'
  Prelude.Text ->
  DeleteBranch
newDeleteBranch :: Text -> Text -> DeleteBranch
newDeleteBranch Text
pRepositoryName_ Text
pBranchName_ =
  DeleteBranch'
    { $sel:repositoryName:DeleteBranch' :: Text
repositoryName = Text
pRepositoryName_,
      $sel:branchName:DeleteBranch' :: Text
branchName = Text
pBranchName_
    }

-- | The name of the repository that contains the branch to be deleted.
deleteBranch_repositoryName :: Lens.Lens' DeleteBranch Prelude.Text
deleteBranch_repositoryName :: Lens' DeleteBranch Text
deleteBranch_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteBranch' {Text
repositoryName :: Text
$sel:repositoryName:DeleteBranch' :: DeleteBranch -> Text
repositoryName} -> Text
repositoryName) (\s :: DeleteBranch
s@DeleteBranch' {} Text
a -> DeleteBranch
s {$sel:repositoryName:DeleteBranch' :: Text
repositoryName = Text
a} :: DeleteBranch)

-- | The name of the branch to delete.
deleteBranch_branchName :: Lens.Lens' DeleteBranch Prelude.Text
deleteBranch_branchName :: Lens' DeleteBranch Text
deleteBranch_branchName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteBranch' {Text
branchName :: Text
$sel:branchName:DeleteBranch' :: DeleteBranch -> Text
branchName} -> Text
branchName) (\s :: DeleteBranch
s@DeleteBranch' {} Text
a -> DeleteBranch
s {$sel:branchName:DeleteBranch' :: Text
branchName = Text
a} :: DeleteBranch)

instance Core.AWSRequest DeleteBranch where
  type AWSResponse DeleteBranch = DeleteBranchResponse
  request :: (Service -> Service) -> DeleteBranch -> Request DeleteBranch
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 DeleteBranch
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteBranch)))
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 ->
          Maybe BranchInfo -> Int -> DeleteBranchResponse
DeleteBranchResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"deletedBranch")
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable DeleteBranch where
  hashWithSalt :: Int -> DeleteBranch -> Int
hashWithSalt Int
_salt DeleteBranch' {Text
branchName :: Text
repositoryName :: Text
$sel:branchName:DeleteBranch' :: DeleteBranch -> Text
$sel:repositoryName:DeleteBranch' :: DeleteBranch -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
repositoryName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
branchName

instance Prelude.NFData DeleteBranch where
  rnf :: DeleteBranch -> ()
rnf DeleteBranch' {Text
branchName :: Text
repositoryName :: Text
$sel:branchName:DeleteBranch' :: DeleteBranch -> Text
$sel:repositoryName:DeleteBranch' :: DeleteBranch -> Text
..} =
    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

instance Data.ToHeaders DeleteBranch where
  toHeaders :: DeleteBranch -> 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.DeleteBranch" ::
                          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 DeleteBranch where
  toJSON :: DeleteBranch -> Value
toJSON DeleteBranch' {Text
branchName :: Text
repositoryName :: Text
$sel:branchName:DeleteBranch' :: DeleteBranch -> Text
$sel:repositoryName:DeleteBranch' :: DeleteBranch -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ 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)
          ]
      )

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

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

-- | Represents the output of a delete branch operation.
--
-- /See:/ 'newDeleteBranchResponse' smart constructor.
data DeleteBranchResponse = DeleteBranchResponse'
  { -- | Information about the branch deleted by the operation, including the
    -- branch name and the commit ID that was the tip of the branch.
    DeleteBranchResponse -> Maybe BranchInfo
deletedBranch :: Prelude.Maybe BranchInfo,
    -- | The response's http status code.
    DeleteBranchResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteBranchResponse -> DeleteBranchResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteBranchResponse -> DeleteBranchResponse -> Bool
$c/= :: DeleteBranchResponse -> DeleteBranchResponse -> Bool
== :: DeleteBranchResponse -> DeleteBranchResponse -> Bool
$c== :: DeleteBranchResponse -> DeleteBranchResponse -> Bool
Prelude.Eq, ReadPrec [DeleteBranchResponse]
ReadPrec DeleteBranchResponse
Int -> ReadS DeleteBranchResponse
ReadS [DeleteBranchResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteBranchResponse]
$creadListPrec :: ReadPrec [DeleteBranchResponse]
readPrec :: ReadPrec DeleteBranchResponse
$creadPrec :: ReadPrec DeleteBranchResponse
readList :: ReadS [DeleteBranchResponse]
$creadList :: ReadS [DeleteBranchResponse]
readsPrec :: Int -> ReadS DeleteBranchResponse
$creadsPrec :: Int -> ReadS DeleteBranchResponse
Prelude.Read, Int -> DeleteBranchResponse -> ShowS
[DeleteBranchResponse] -> ShowS
DeleteBranchResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteBranchResponse] -> ShowS
$cshowList :: [DeleteBranchResponse] -> ShowS
show :: DeleteBranchResponse -> String
$cshow :: DeleteBranchResponse -> String
showsPrec :: Int -> DeleteBranchResponse -> ShowS
$cshowsPrec :: Int -> DeleteBranchResponse -> ShowS
Prelude.Show, forall x. Rep DeleteBranchResponse x -> DeleteBranchResponse
forall x. DeleteBranchResponse -> Rep DeleteBranchResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteBranchResponse x -> DeleteBranchResponse
$cfrom :: forall x. DeleteBranchResponse -> Rep DeleteBranchResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteBranchResponse' 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:
--
-- 'deletedBranch', 'deleteBranchResponse_deletedBranch' - Information about the branch deleted by the operation, including the
-- branch name and the commit ID that was the tip of the branch.
--
-- 'httpStatus', 'deleteBranchResponse_httpStatus' - The response's http status code.
newDeleteBranchResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteBranchResponse
newDeleteBranchResponse :: Int -> DeleteBranchResponse
newDeleteBranchResponse Int
pHttpStatus_ =
  DeleteBranchResponse'
    { $sel:deletedBranch:DeleteBranchResponse' :: Maybe BranchInfo
deletedBranch =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteBranchResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the branch deleted by the operation, including the
-- branch name and the commit ID that was the tip of the branch.
deleteBranchResponse_deletedBranch :: Lens.Lens' DeleteBranchResponse (Prelude.Maybe BranchInfo)
deleteBranchResponse_deletedBranch :: Lens' DeleteBranchResponse (Maybe BranchInfo)
deleteBranchResponse_deletedBranch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteBranchResponse' {Maybe BranchInfo
deletedBranch :: Maybe BranchInfo
$sel:deletedBranch:DeleteBranchResponse' :: DeleteBranchResponse -> Maybe BranchInfo
deletedBranch} -> Maybe BranchInfo
deletedBranch) (\s :: DeleteBranchResponse
s@DeleteBranchResponse' {} Maybe BranchInfo
a -> DeleteBranchResponse
s {$sel:deletedBranch:DeleteBranchResponse' :: Maybe BranchInfo
deletedBranch = Maybe BranchInfo
a} :: DeleteBranchResponse)

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

instance Prelude.NFData DeleteBranchResponse where
  rnf :: DeleteBranchResponse -> ()
rnf DeleteBranchResponse' {Int
Maybe BranchInfo
httpStatus :: Int
deletedBranch :: Maybe BranchInfo
$sel:httpStatus:DeleteBranchResponse' :: DeleteBranchResponse -> Int
$sel:deletedBranch:DeleteBranchResponse' :: DeleteBranchResponse -> Maybe BranchInfo
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe BranchInfo
deletedBranch
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus