{-# 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.UpdateDefaultBranch
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets or changes the default branch name for the specified repository.
--
-- If you use this operation to change the default branch name to the
-- current default branch name, a success message is returned even though
-- the default branch did not change.
module Amazonka.CodeCommit.UpdateDefaultBranch
  ( -- * Creating a Request
    UpdateDefaultBranch (..),
    newUpdateDefaultBranch,

    -- * Request Lenses
    updateDefaultBranch_repositoryName,
    updateDefaultBranch_defaultBranchName,

    -- * Destructuring the Response
    UpdateDefaultBranchResponse (..),
    newUpdateDefaultBranchResponse,
  )
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 an update default branch operation.
--
-- /See:/ 'newUpdateDefaultBranch' smart constructor.
data UpdateDefaultBranch = UpdateDefaultBranch'
  { -- | The name of the repository to set or change the default branch for.
    UpdateDefaultBranch -> Text
repositoryName :: Prelude.Text,
    -- | The name of the branch to set as the default.
    UpdateDefaultBranch -> Text
defaultBranchName :: Prelude.Text
  }
  deriving (UpdateDefaultBranch -> UpdateDefaultBranch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDefaultBranch -> UpdateDefaultBranch -> Bool
$c/= :: UpdateDefaultBranch -> UpdateDefaultBranch -> Bool
== :: UpdateDefaultBranch -> UpdateDefaultBranch -> Bool
$c== :: UpdateDefaultBranch -> UpdateDefaultBranch -> Bool
Prelude.Eq, ReadPrec [UpdateDefaultBranch]
ReadPrec UpdateDefaultBranch
Int -> ReadS UpdateDefaultBranch
ReadS [UpdateDefaultBranch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDefaultBranch]
$creadListPrec :: ReadPrec [UpdateDefaultBranch]
readPrec :: ReadPrec UpdateDefaultBranch
$creadPrec :: ReadPrec UpdateDefaultBranch
readList :: ReadS [UpdateDefaultBranch]
$creadList :: ReadS [UpdateDefaultBranch]
readsPrec :: Int -> ReadS UpdateDefaultBranch
$creadsPrec :: Int -> ReadS UpdateDefaultBranch
Prelude.Read, Int -> UpdateDefaultBranch -> ShowS
[UpdateDefaultBranch] -> ShowS
UpdateDefaultBranch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDefaultBranch] -> ShowS
$cshowList :: [UpdateDefaultBranch] -> ShowS
show :: UpdateDefaultBranch -> String
$cshow :: UpdateDefaultBranch -> String
showsPrec :: Int -> UpdateDefaultBranch -> ShowS
$cshowsPrec :: Int -> UpdateDefaultBranch -> ShowS
Prelude.Show, forall x. Rep UpdateDefaultBranch x -> UpdateDefaultBranch
forall x. UpdateDefaultBranch -> Rep UpdateDefaultBranch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDefaultBranch x -> UpdateDefaultBranch
$cfrom :: forall x. UpdateDefaultBranch -> Rep UpdateDefaultBranch x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDefaultBranch' 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', 'updateDefaultBranch_repositoryName' - The name of the repository to set or change the default branch for.
--
-- 'defaultBranchName', 'updateDefaultBranch_defaultBranchName' - The name of the branch to set as the default.
newUpdateDefaultBranch ::
  -- | 'repositoryName'
  Prelude.Text ->
  -- | 'defaultBranchName'
  Prelude.Text ->
  UpdateDefaultBranch
newUpdateDefaultBranch :: Text -> Text -> UpdateDefaultBranch
newUpdateDefaultBranch
  Text
pRepositoryName_
  Text
pDefaultBranchName_ =
    UpdateDefaultBranch'
      { $sel:repositoryName:UpdateDefaultBranch' :: Text
repositoryName =
          Text
pRepositoryName_,
        $sel:defaultBranchName:UpdateDefaultBranch' :: Text
defaultBranchName = Text
pDefaultBranchName_
      }

-- | The name of the repository to set or change the default branch for.
updateDefaultBranch_repositoryName :: Lens.Lens' UpdateDefaultBranch Prelude.Text
updateDefaultBranch_repositoryName :: Lens' UpdateDefaultBranch Text
updateDefaultBranch_repositoryName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDefaultBranch' {Text
repositoryName :: Text
$sel:repositoryName:UpdateDefaultBranch' :: UpdateDefaultBranch -> Text
repositoryName} -> Text
repositoryName) (\s :: UpdateDefaultBranch
s@UpdateDefaultBranch' {} Text
a -> UpdateDefaultBranch
s {$sel:repositoryName:UpdateDefaultBranch' :: Text
repositoryName = Text
a} :: UpdateDefaultBranch)

-- | The name of the branch to set as the default.
updateDefaultBranch_defaultBranchName :: Lens.Lens' UpdateDefaultBranch Prelude.Text
updateDefaultBranch_defaultBranchName :: Lens' UpdateDefaultBranch Text
updateDefaultBranch_defaultBranchName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDefaultBranch' {Text
defaultBranchName :: Text
$sel:defaultBranchName:UpdateDefaultBranch' :: UpdateDefaultBranch -> Text
defaultBranchName} -> Text
defaultBranchName) (\s :: UpdateDefaultBranch
s@UpdateDefaultBranch' {} Text
a -> UpdateDefaultBranch
s {$sel:defaultBranchName:UpdateDefaultBranch' :: Text
defaultBranchName = Text
a} :: UpdateDefaultBranch)

instance Core.AWSRequest UpdateDefaultBranch where
  type
    AWSResponse UpdateDefaultBranch =
      UpdateDefaultBranchResponse
  request :: (Service -> Service)
-> UpdateDefaultBranch -> Request UpdateDefaultBranch
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 UpdateDefaultBranch
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateDefaultBranch)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull UpdateDefaultBranchResponse
UpdateDefaultBranchResponse'

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

instance Prelude.NFData UpdateDefaultBranch where
  rnf :: UpdateDefaultBranch -> ()
rnf UpdateDefaultBranch' {Text
defaultBranchName :: Text
repositoryName :: Text
$sel:defaultBranchName:UpdateDefaultBranch' :: UpdateDefaultBranch -> Text
$sel:repositoryName:UpdateDefaultBranch' :: UpdateDefaultBranch -> 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
defaultBranchName

instance Data.ToHeaders UpdateDefaultBranch where
  toHeaders :: UpdateDefaultBranch -> [Header]
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 -> [Header]
Data.=# ( ByteString
"CodeCommit_20150413.UpdateDefaultBranch" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateDefaultBranch where
  toJSON :: UpdateDefaultBranch -> Value
toJSON UpdateDefaultBranch' {Text
defaultBranchName :: Text
repositoryName :: Text
$sel:defaultBranchName:UpdateDefaultBranch' :: UpdateDefaultBranch -> Text
$sel:repositoryName:UpdateDefaultBranch' :: UpdateDefaultBranch -> 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
"defaultBranchName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
defaultBranchName)
          ]
      )

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

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

-- | /See:/ 'newUpdateDefaultBranchResponse' smart constructor.
data UpdateDefaultBranchResponse = UpdateDefaultBranchResponse'
  {
  }
  deriving (UpdateDefaultBranchResponse -> UpdateDefaultBranchResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDefaultBranchResponse -> UpdateDefaultBranchResponse -> Bool
$c/= :: UpdateDefaultBranchResponse -> UpdateDefaultBranchResponse -> Bool
== :: UpdateDefaultBranchResponse -> UpdateDefaultBranchResponse -> Bool
$c== :: UpdateDefaultBranchResponse -> UpdateDefaultBranchResponse -> Bool
Prelude.Eq, ReadPrec [UpdateDefaultBranchResponse]
ReadPrec UpdateDefaultBranchResponse
Int -> ReadS UpdateDefaultBranchResponse
ReadS [UpdateDefaultBranchResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDefaultBranchResponse]
$creadListPrec :: ReadPrec [UpdateDefaultBranchResponse]
readPrec :: ReadPrec UpdateDefaultBranchResponse
$creadPrec :: ReadPrec UpdateDefaultBranchResponse
readList :: ReadS [UpdateDefaultBranchResponse]
$creadList :: ReadS [UpdateDefaultBranchResponse]
readsPrec :: Int -> ReadS UpdateDefaultBranchResponse
$creadsPrec :: Int -> ReadS UpdateDefaultBranchResponse
Prelude.Read, Int -> UpdateDefaultBranchResponse -> ShowS
[UpdateDefaultBranchResponse] -> ShowS
UpdateDefaultBranchResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDefaultBranchResponse] -> ShowS
$cshowList :: [UpdateDefaultBranchResponse] -> ShowS
show :: UpdateDefaultBranchResponse -> String
$cshow :: UpdateDefaultBranchResponse -> String
showsPrec :: Int -> UpdateDefaultBranchResponse -> ShowS
$cshowsPrec :: Int -> UpdateDefaultBranchResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateDefaultBranchResponse x -> UpdateDefaultBranchResponse
forall x.
UpdateDefaultBranchResponse -> Rep UpdateDefaultBranchResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateDefaultBranchResponse x -> UpdateDefaultBranchResponse
$cfrom :: forall x.
UpdateDefaultBranchResponse -> Rep UpdateDefaultBranchResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDefaultBranchResponse' 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.
newUpdateDefaultBranchResponse ::
  UpdateDefaultBranchResponse
newUpdateDefaultBranchResponse :: UpdateDefaultBranchResponse
newUpdateDefaultBranchResponse =
  UpdateDefaultBranchResponse
UpdateDefaultBranchResponse'

instance Prelude.NFData UpdateDefaultBranchResponse where
  rnf :: UpdateDefaultBranchResponse -> ()
rnf UpdateDefaultBranchResponse
_ = ()