{-# 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.UpdateRepositoryName
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Renames a repository. The repository name must be unique across the
-- calling AWS account. Repository names are limited to 100 alphanumeric,
-- dash, and underscore characters, and cannot include certain characters.
-- The suffix .git is prohibited. For more information about the limits on
-- repository names, see
-- <https://docs.aws.amazon.com/codecommit/latest/userguide/limits.html Limits>
-- in the AWS CodeCommit User Guide.
module Amazonka.CodeCommit.UpdateRepositoryName
  ( -- * Creating a Request
    UpdateRepositoryName (..),
    newUpdateRepositoryName,

    -- * Request Lenses
    updateRepositoryName_oldName,
    updateRepositoryName_newName,

    -- * Destructuring the Response
    UpdateRepositoryNameResponse (..),
    newUpdateRepositoryNameResponse,
  )
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 repository description operation.
--
-- /See:/ 'newUpdateRepositoryName' smart constructor.
data UpdateRepositoryName = UpdateRepositoryName'
  { -- | The current name of the repository.
    UpdateRepositoryName -> Text
oldName :: Prelude.Text,
    -- | The new name for the repository.
    UpdateRepositoryName -> Text
newName' :: Prelude.Text
  }
  deriving (UpdateRepositoryName -> UpdateRepositoryName -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRepositoryName -> UpdateRepositoryName -> Bool
$c/= :: UpdateRepositoryName -> UpdateRepositoryName -> Bool
== :: UpdateRepositoryName -> UpdateRepositoryName -> Bool
$c== :: UpdateRepositoryName -> UpdateRepositoryName -> Bool
Prelude.Eq, ReadPrec [UpdateRepositoryName]
ReadPrec UpdateRepositoryName
Int -> ReadS UpdateRepositoryName
ReadS [UpdateRepositoryName]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRepositoryName]
$creadListPrec :: ReadPrec [UpdateRepositoryName]
readPrec :: ReadPrec UpdateRepositoryName
$creadPrec :: ReadPrec UpdateRepositoryName
readList :: ReadS [UpdateRepositoryName]
$creadList :: ReadS [UpdateRepositoryName]
readsPrec :: Int -> ReadS UpdateRepositoryName
$creadsPrec :: Int -> ReadS UpdateRepositoryName
Prelude.Read, Int -> UpdateRepositoryName -> ShowS
[UpdateRepositoryName] -> ShowS
UpdateRepositoryName -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRepositoryName] -> ShowS
$cshowList :: [UpdateRepositoryName] -> ShowS
show :: UpdateRepositoryName -> String
$cshow :: UpdateRepositoryName -> String
showsPrec :: Int -> UpdateRepositoryName -> ShowS
$cshowsPrec :: Int -> UpdateRepositoryName -> ShowS
Prelude.Show, forall x. Rep UpdateRepositoryName x -> UpdateRepositoryName
forall x. UpdateRepositoryName -> Rep UpdateRepositoryName x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateRepositoryName x -> UpdateRepositoryName
$cfrom :: forall x. UpdateRepositoryName -> Rep UpdateRepositoryName x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRepositoryName' 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:
--
-- 'oldName', 'updateRepositoryName_oldName' - The current name of the repository.
--
-- 'newName'', 'updateRepositoryName_newName' - The new name for the repository.
newUpdateRepositoryName ::
  -- | 'oldName'
  Prelude.Text ->
  -- | 'newName''
  Prelude.Text ->
  UpdateRepositoryName
newUpdateRepositoryName :: Text -> Text -> UpdateRepositoryName
newUpdateRepositoryName Text
pOldName_ Text
pNewName_ =
  UpdateRepositoryName'
    { $sel:oldName:UpdateRepositoryName' :: Text
oldName = Text
pOldName_,
      $sel:newName':UpdateRepositoryName' :: Text
newName' = Text
pNewName_
    }

-- | The current name of the repository.
updateRepositoryName_oldName :: Lens.Lens' UpdateRepositoryName Prelude.Text
updateRepositoryName_oldName :: Lens' UpdateRepositoryName Text
updateRepositoryName_oldName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRepositoryName' {Text
oldName :: Text
$sel:oldName:UpdateRepositoryName' :: UpdateRepositoryName -> Text
oldName} -> Text
oldName) (\s :: UpdateRepositoryName
s@UpdateRepositoryName' {} Text
a -> UpdateRepositoryName
s {$sel:oldName:UpdateRepositoryName' :: Text
oldName = Text
a} :: UpdateRepositoryName)

-- | The new name for the repository.
updateRepositoryName_newName :: Lens.Lens' UpdateRepositoryName Prelude.Text
updateRepositoryName_newName :: Lens' UpdateRepositoryName Text
updateRepositoryName_newName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRepositoryName' {Text
newName' :: Text
$sel:newName':UpdateRepositoryName' :: UpdateRepositoryName -> Text
newName'} -> Text
newName') (\s :: UpdateRepositoryName
s@UpdateRepositoryName' {} Text
a -> UpdateRepositoryName
s {$sel:newName':UpdateRepositoryName' :: Text
newName' = Text
a} :: UpdateRepositoryName)

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

instance Prelude.Hashable UpdateRepositoryName where
  hashWithSalt :: Int -> UpdateRepositoryName -> Int
hashWithSalt Int
_salt UpdateRepositoryName' {Text
newName' :: Text
oldName :: Text
$sel:newName':UpdateRepositoryName' :: UpdateRepositoryName -> Text
$sel:oldName:UpdateRepositoryName' :: UpdateRepositoryName -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
oldName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
newName'

instance Prelude.NFData UpdateRepositoryName where
  rnf :: UpdateRepositoryName -> ()
rnf UpdateRepositoryName' {Text
newName' :: Text
oldName :: Text
$sel:newName':UpdateRepositoryName' :: UpdateRepositoryName -> Text
$sel:oldName:UpdateRepositoryName' :: UpdateRepositoryName -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
oldName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
newName'

instance Data.ToHeaders UpdateRepositoryName where
  toHeaders :: UpdateRepositoryName -> [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.UpdateRepositoryName" ::
                          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 UpdateRepositoryName where
  toJSON :: UpdateRepositoryName -> Value
toJSON UpdateRepositoryName' {Text
newName' :: Text
oldName :: Text
$sel:newName':UpdateRepositoryName' :: UpdateRepositoryName -> Text
$sel:oldName:UpdateRepositoryName' :: UpdateRepositoryName -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"oldName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
oldName),
            forall a. a -> Maybe a
Prelude.Just (Key
"newName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
newName')
          ]
      )

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

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

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

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

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