{-# 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.UpdateRepositoryDescription
-- 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 comment or description for a repository.
--
-- The description field for a repository accepts all HTML characters and
-- all valid Unicode characters. Applications that do not HTML-encode the
-- description and display it in a webpage can expose users to potentially
-- malicious code. Make sure that you HTML-encode the description field in
-- any application that uses this API to display the repository description
-- on a webpage.
module Amazonka.CodeCommit.UpdateRepositoryDescription
  ( -- * Creating a Request
    UpdateRepositoryDescription (..),
    newUpdateRepositoryDescription,

    -- * Request Lenses
    updateRepositoryDescription_repositoryDescription,
    updateRepositoryDescription_repositoryName,

    -- * Destructuring the Response
    UpdateRepositoryDescriptionResponse (..),
    newUpdateRepositoryDescriptionResponse,
  )
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:/ 'newUpdateRepositoryDescription' smart constructor.
data UpdateRepositoryDescription = UpdateRepositoryDescription'
  { -- | The new comment or description for the specified repository. Repository
    -- descriptions are limited to 1,000 characters.
    UpdateRepositoryDescription -> Maybe Text
repositoryDescription :: Prelude.Maybe Prelude.Text,
    -- | The name of the repository to set or change the comment or description
    -- for.
    UpdateRepositoryDescription -> Text
repositoryName :: Prelude.Text
  }
  deriving (UpdateRepositoryDescription -> UpdateRepositoryDescription -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateRepositoryDescription -> UpdateRepositoryDescription -> Bool
$c/= :: UpdateRepositoryDescription -> UpdateRepositoryDescription -> Bool
== :: UpdateRepositoryDescription -> UpdateRepositoryDescription -> Bool
$c== :: UpdateRepositoryDescription -> UpdateRepositoryDescription -> Bool
Prelude.Eq, ReadPrec [UpdateRepositoryDescription]
ReadPrec UpdateRepositoryDescription
Int -> ReadS UpdateRepositoryDescription
ReadS [UpdateRepositoryDescription]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateRepositoryDescription]
$creadListPrec :: ReadPrec [UpdateRepositoryDescription]
readPrec :: ReadPrec UpdateRepositoryDescription
$creadPrec :: ReadPrec UpdateRepositoryDescription
readList :: ReadS [UpdateRepositoryDescription]
$creadList :: ReadS [UpdateRepositoryDescription]
readsPrec :: Int -> ReadS UpdateRepositoryDescription
$creadsPrec :: Int -> ReadS UpdateRepositoryDescription
Prelude.Read, Int -> UpdateRepositoryDescription -> ShowS
[UpdateRepositoryDescription] -> ShowS
UpdateRepositoryDescription -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateRepositoryDescription] -> ShowS
$cshowList :: [UpdateRepositoryDescription] -> ShowS
show :: UpdateRepositoryDescription -> String
$cshow :: UpdateRepositoryDescription -> String
showsPrec :: Int -> UpdateRepositoryDescription -> ShowS
$cshowsPrec :: Int -> UpdateRepositoryDescription -> ShowS
Prelude.Show, forall x.
Rep UpdateRepositoryDescription x -> UpdateRepositoryDescription
forall x.
UpdateRepositoryDescription -> Rep UpdateRepositoryDescription x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateRepositoryDescription x -> UpdateRepositoryDescription
$cfrom :: forall x.
UpdateRepositoryDescription -> Rep UpdateRepositoryDescription x
Prelude.Generic)

-- |
-- Create a value of 'UpdateRepositoryDescription' 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:
--
-- 'repositoryDescription', 'updateRepositoryDescription_repositoryDescription' - The new comment or description for the specified repository. Repository
-- descriptions are limited to 1,000 characters.
--
-- 'repositoryName', 'updateRepositoryDescription_repositoryName' - The name of the repository to set or change the comment or description
-- for.
newUpdateRepositoryDescription ::
  -- | 'repositoryName'
  Prelude.Text ->
  UpdateRepositoryDescription
newUpdateRepositoryDescription :: Text -> UpdateRepositoryDescription
newUpdateRepositoryDescription Text
pRepositoryName_ =
  UpdateRepositoryDescription'
    { $sel:repositoryDescription:UpdateRepositoryDescription' :: Maybe Text
repositoryDescription =
        forall a. Maybe a
Prelude.Nothing,
      $sel:repositoryName:UpdateRepositoryDescription' :: Text
repositoryName = Text
pRepositoryName_
    }

-- | The new comment or description for the specified repository. Repository
-- descriptions are limited to 1,000 characters.
updateRepositoryDescription_repositoryDescription :: Lens.Lens' UpdateRepositoryDescription (Prelude.Maybe Prelude.Text)
updateRepositoryDescription_repositoryDescription :: Lens' UpdateRepositoryDescription (Maybe Text)
updateRepositoryDescription_repositoryDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateRepositoryDescription' {Maybe Text
repositoryDescription :: Maybe Text
$sel:repositoryDescription:UpdateRepositoryDescription' :: UpdateRepositoryDescription -> Maybe Text
repositoryDescription} -> Maybe Text
repositoryDescription) (\s :: UpdateRepositoryDescription
s@UpdateRepositoryDescription' {} Maybe Text
a -> UpdateRepositoryDescription
s {$sel:repositoryDescription:UpdateRepositoryDescription' :: Maybe Text
repositoryDescription = Maybe Text
a} :: UpdateRepositoryDescription)

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

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

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

instance Prelude.NFData UpdateRepositoryDescription where
  rnf :: UpdateRepositoryDescription -> ()
rnf UpdateRepositoryDescription' {Maybe Text
Text
repositoryName :: Text
repositoryDescription :: Maybe Text
$sel:repositoryName:UpdateRepositoryDescription' :: UpdateRepositoryDescription -> Text
$sel:repositoryDescription:UpdateRepositoryDescription' :: UpdateRepositoryDescription -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
repositoryDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
repositoryName

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

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

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

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

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

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