{-# 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.CodeGuruReviewer.AssociateRepository
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use to associate an Amazon Web Services CodeCommit repository or a
-- repository managed by Amazon Web Services CodeStar Connections with
-- Amazon CodeGuru Reviewer. When you associate a repository, CodeGuru
-- Reviewer reviews source code changes in the repository\'s pull requests
-- and provides automatic recommendations. You can view recommendations
-- using the CodeGuru Reviewer console. For more information, see
-- <https://docs.aws.amazon.com/codeguru/latest/reviewer-ug/recommendations.html Recommendations in Amazon CodeGuru Reviewer>
-- in the /Amazon CodeGuru Reviewer User Guide./
--
-- If you associate a CodeCommit or S3 repository, it must be in the same
-- Amazon Web Services Region and Amazon Web Services account where its
-- CodeGuru Reviewer code reviews are configured.
--
-- Bitbucket and GitHub Enterprise Server repositories are managed by
-- Amazon Web Services CodeStar Connections to connect to CodeGuru
-- Reviewer. For more information, see
-- <https://docs.aws.amazon.com/codeguru/latest/reviewer-ug/getting-started-associate-repository.html Associate a repository>
-- in the /Amazon CodeGuru Reviewer User Guide./
--
-- You cannot use the CodeGuru Reviewer SDK or the Amazon Web Services CLI
-- to associate a GitHub repository with Amazon CodeGuru Reviewer. To
-- associate a GitHub repository, use the console. For more information,
-- see
-- <https://docs.aws.amazon.com/codeguru/latest/reviewer-ug/getting-started-with-guru.html Getting started with CodeGuru Reviewer>
-- in the /CodeGuru Reviewer User Guide./
module Amazonka.CodeGuruReviewer.AssociateRepository
  ( -- * Creating a Request
    AssociateRepository (..),
    newAssociateRepository,

    -- * Request Lenses
    associateRepository_clientRequestToken,
    associateRepository_kmsKeyDetails,
    associateRepository_tags,
    associateRepository_repository,

    -- * Destructuring the Response
    AssociateRepositoryResponse (..),
    newAssociateRepositoryResponse,

    -- * Response Lenses
    associateRepositoryResponse_repositoryAssociation,
    associateRepositoryResponse_tags,
    associateRepositoryResponse_httpStatus,
  )
where

import Amazonka.CodeGuruReviewer.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:/ 'newAssociateRepository' smart constructor.
data AssociateRepository = AssociateRepository'
  { -- | Amazon CodeGuru Reviewer uses this value to prevent the accidental
    -- creation of duplicate repository associations if there are failures and
    -- retries.
    AssociateRepository -> Maybe Text
clientRequestToken :: Prelude.Maybe Prelude.Text,
    -- | A @KMSKeyDetails@ object that contains:
    --
    -- -   The encryption option for this repository association. It is either
    --     owned by Amazon Web Services Key Management Service (KMS)
    --     (@AWS_OWNED_CMK@) or customer managed (@CUSTOMER_MANAGED_CMK@).
    --
    -- -   The ID of the Amazon Web Services KMS key that is associated with
    --     this repository association.
    AssociateRepository -> Maybe KMSKeyDetails
kmsKeyDetails :: Prelude.Maybe KMSKeyDetails,
    -- | An array of key-value pairs used to tag an associated repository. A tag
    -- is a custom attribute label with two parts:
    --
    -- -   A /tag key/ (for example, @CostCenter@, @Environment@, @Project@, or
    --     @Secret@). Tag keys are case sensitive.
    --
    -- -   An optional field known as a /tag value/ (for example,
    --     @111122223333@, @Production@, or a team name). Omitting the tag
    --     value is the same as using an empty string. Like tag keys, tag
    --     values are case sensitive.
    AssociateRepository -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The repository to associate.
    AssociateRepository -> Repository
repository :: Repository
  }
  deriving (AssociateRepository -> AssociateRepository -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateRepository -> AssociateRepository -> Bool
$c/= :: AssociateRepository -> AssociateRepository -> Bool
== :: AssociateRepository -> AssociateRepository -> Bool
$c== :: AssociateRepository -> AssociateRepository -> Bool
Prelude.Eq, ReadPrec [AssociateRepository]
ReadPrec AssociateRepository
Int -> ReadS AssociateRepository
ReadS [AssociateRepository]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateRepository]
$creadListPrec :: ReadPrec [AssociateRepository]
readPrec :: ReadPrec AssociateRepository
$creadPrec :: ReadPrec AssociateRepository
readList :: ReadS [AssociateRepository]
$creadList :: ReadS [AssociateRepository]
readsPrec :: Int -> ReadS AssociateRepository
$creadsPrec :: Int -> ReadS AssociateRepository
Prelude.Read, Int -> AssociateRepository -> ShowS
[AssociateRepository] -> ShowS
AssociateRepository -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateRepository] -> ShowS
$cshowList :: [AssociateRepository] -> ShowS
show :: AssociateRepository -> String
$cshow :: AssociateRepository -> String
showsPrec :: Int -> AssociateRepository -> ShowS
$cshowsPrec :: Int -> AssociateRepository -> ShowS
Prelude.Show, forall x. Rep AssociateRepository x -> AssociateRepository
forall x. AssociateRepository -> Rep AssociateRepository x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssociateRepository x -> AssociateRepository
$cfrom :: forall x. AssociateRepository -> Rep AssociateRepository x
Prelude.Generic)

-- |
-- Create a value of 'AssociateRepository' 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:
--
-- 'clientRequestToken', 'associateRepository_clientRequestToken' - Amazon CodeGuru Reviewer uses this value to prevent the accidental
-- creation of duplicate repository associations if there are failures and
-- retries.
--
-- 'kmsKeyDetails', 'associateRepository_kmsKeyDetails' - A @KMSKeyDetails@ object that contains:
--
-- -   The encryption option for this repository association. It is either
--     owned by Amazon Web Services Key Management Service (KMS)
--     (@AWS_OWNED_CMK@) or customer managed (@CUSTOMER_MANAGED_CMK@).
--
-- -   The ID of the Amazon Web Services KMS key that is associated with
--     this repository association.
--
-- 'tags', 'associateRepository_tags' - An array of key-value pairs used to tag an associated repository. A tag
-- is a custom attribute label with two parts:
--
-- -   A /tag key/ (for example, @CostCenter@, @Environment@, @Project@, or
--     @Secret@). Tag keys are case sensitive.
--
-- -   An optional field known as a /tag value/ (for example,
--     @111122223333@, @Production@, or a team name). Omitting the tag
--     value is the same as using an empty string. Like tag keys, tag
--     values are case sensitive.
--
-- 'repository', 'associateRepository_repository' - The repository to associate.
newAssociateRepository ::
  -- | 'repository'
  Repository ->
  AssociateRepository
newAssociateRepository :: Repository -> AssociateRepository
newAssociateRepository Repository
pRepository_ =
  AssociateRepository'
    { $sel:clientRequestToken:AssociateRepository' :: Maybe Text
clientRequestToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyDetails:AssociateRepository' :: Maybe KMSKeyDetails
kmsKeyDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:AssociateRepository' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:repository:AssociateRepository' :: Repository
repository = Repository
pRepository_
    }

-- | Amazon CodeGuru Reviewer uses this value to prevent the accidental
-- creation of duplicate repository associations if there are failures and
-- retries.
associateRepository_clientRequestToken :: Lens.Lens' AssociateRepository (Prelude.Maybe Prelude.Text)
associateRepository_clientRequestToken :: Lens' AssociateRepository (Maybe Text)
associateRepository_clientRequestToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateRepository' {Maybe Text
clientRequestToken :: Maybe Text
$sel:clientRequestToken:AssociateRepository' :: AssociateRepository -> Maybe Text
clientRequestToken} -> Maybe Text
clientRequestToken) (\s :: AssociateRepository
s@AssociateRepository' {} Maybe Text
a -> AssociateRepository
s {$sel:clientRequestToken:AssociateRepository' :: Maybe Text
clientRequestToken = Maybe Text
a} :: AssociateRepository)

-- | A @KMSKeyDetails@ object that contains:
--
-- -   The encryption option for this repository association. It is either
--     owned by Amazon Web Services Key Management Service (KMS)
--     (@AWS_OWNED_CMK@) or customer managed (@CUSTOMER_MANAGED_CMK@).
--
-- -   The ID of the Amazon Web Services KMS key that is associated with
--     this repository association.
associateRepository_kmsKeyDetails :: Lens.Lens' AssociateRepository (Prelude.Maybe KMSKeyDetails)
associateRepository_kmsKeyDetails :: Lens' AssociateRepository (Maybe KMSKeyDetails)
associateRepository_kmsKeyDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateRepository' {Maybe KMSKeyDetails
kmsKeyDetails :: Maybe KMSKeyDetails
$sel:kmsKeyDetails:AssociateRepository' :: AssociateRepository -> Maybe KMSKeyDetails
kmsKeyDetails} -> Maybe KMSKeyDetails
kmsKeyDetails) (\s :: AssociateRepository
s@AssociateRepository' {} Maybe KMSKeyDetails
a -> AssociateRepository
s {$sel:kmsKeyDetails:AssociateRepository' :: Maybe KMSKeyDetails
kmsKeyDetails = Maybe KMSKeyDetails
a} :: AssociateRepository)

-- | An array of key-value pairs used to tag an associated repository. A tag
-- is a custom attribute label with two parts:
--
-- -   A /tag key/ (for example, @CostCenter@, @Environment@, @Project@, or
--     @Secret@). Tag keys are case sensitive.
--
-- -   An optional field known as a /tag value/ (for example,
--     @111122223333@, @Production@, or a team name). Omitting the tag
--     value is the same as using an empty string. Like tag keys, tag
--     values are case sensitive.
associateRepository_tags :: Lens.Lens' AssociateRepository (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
associateRepository_tags :: Lens' AssociateRepository (Maybe (HashMap Text Text))
associateRepository_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateRepository' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:AssociateRepository' :: AssociateRepository -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: AssociateRepository
s@AssociateRepository' {} Maybe (HashMap Text Text)
a -> AssociateRepository
s {$sel:tags:AssociateRepository' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: AssociateRepository) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The repository to associate.
associateRepository_repository :: Lens.Lens' AssociateRepository Repository
associateRepository_repository :: Lens' AssociateRepository Repository
associateRepository_repository = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateRepository' {Repository
repository :: Repository
$sel:repository:AssociateRepository' :: AssociateRepository -> Repository
repository} -> Repository
repository) (\s :: AssociateRepository
s@AssociateRepository' {} Repository
a -> AssociateRepository
s {$sel:repository:AssociateRepository' :: Repository
repository = Repository
a} :: AssociateRepository)

instance Core.AWSRequest AssociateRepository where
  type
    AWSResponse AssociateRepository =
      AssociateRepositoryResponse
  request :: (Service -> Service)
-> AssociateRepository -> Request AssociateRepository
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 AssociateRepository
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AssociateRepository)))
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 RepositoryAssociation
-> Maybe (HashMap Text Text) -> Int -> AssociateRepositoryResponse
AssociateRepositoryResponse'
            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
"RepositoryAssociation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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 AssociateRepository where
  hashWithSalt :: Int -> AssociateRepository -> Int
hashWithSalt Int
_salt AssociateRepository' {Maybe Text
Maybe (HashMap Text Text)
Maybe KMSKeyDetails
Repository
repository :: Repository
tags :: Maybe (HashMap Text Text)
kmsKeyDetails :: Maybe KMSKeyDetails
clientRequestToken :: Maybe Text
$sel:repository:AssociateRepository' :: AssociateRepository -> Repository
$sel:tags:AssociateRepository' :: AssociateRepository -> Maybe (HashMap Text Text)
$sel:kmsKeyDetails:AssociateRepository' :: AssociateRepository -> Maybe KMSKeyDetails
$sel:clientRequestToken:AssociateRepository' :: AssociateRepository -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientRequestToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe KMSKeyDetails
kmsKeyDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Repository
repository

instance Prelude.NFData AssociateRepository where
  rnf :: AssociateRepository -> ()
rnf AssociateRepository' {Maybe Text
Maybe (HashMap Text Text)
Maybe KMSKeyDetails
Repository
repository :: Repository
tags :: Maybe (HashMap Text Text)
kmsKeyDetails :: Maybe KMSKeyDetails
clientRequestToken :: Maybe Text
$sel:repository:AssociateRepository' :: AssociateRepository -> Repository
$sel:tags:AssociateRepository' :: AssociateRepository -> Maybe (HashMap Text Text)
$sel:kmsKeyDetails:AssociateRepository' :: AssociateRepository -> Maybe KMSKeyDetails
$sel:clientRequestToken:AssociateRepository' :: AssociateRepository -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientRequestToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe KMSKeyDetails
kmsKeyDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Repository
repository

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

instance Data.ToJSON AssociateRepository where
  toJSON :: AssociateRepository -> Value
toJSON AssociateRepository' {Maybe Text
Maybe (HashMap Text Text)
Maybe KMSKeyDetails
Repository
repository :: Repository
tags :: Maybe (HashMap Text Text)
kmsKeyDetails :: Maybe KMSKeyDetails
clientRequestToken :: Maybe Text
$sel:repository:AssociateRepository' :: AssociateRepository -> Repository
$sel:tags:AssociateRepository' :: AssociateRepository -> Maybe (HashMap Text Text)
$sel:kmsKeyDetails:AssociateRepository' :: AssociateRepository -> Maybe KMSKeyDetails
$sel:clientRequestToken:AssociateRepository' :: AssociateRepository -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ClientRequestToken" 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
clientRequestToken,
            (Key
"KMSKeyDetails" 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 KMSKeyDetails
kmsKeyDetails,
            (Key
"Tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"Repository" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Repository
repository)
          ]
      )

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

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

-- | /See:/ 'newAssociateRepositoryResponse' smart constructor.
data AssociateRepositoryResponse = AssociateRepositoryResponse'
  { -- | Information about the repository association.
    AssociateRepositoryResponse -> Maybe RepositoryAssociation
repositoryAssociation :: Prelude.Maybe RepositoryAssociation,
    -- | An array of key-value pairs used to tag an associated repository. A tag
    -- is a custom attribute label with two parts:
    --
    -- -   A /tag key/ (for example, @CostCenter@, @Environment@, @Project@, or
    --     @Secret@). Tag keys are case sensitive.
    --
    -- -   An optional field known as a /tag value/ (for example,
    --     @111122223333@, @Production@, or a team name). Omitting the tag
    --     value is the same as using an empty string. Like tag keys, tag
    --     values are case sensitive.
    AssociateRepositoryResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    AssociateRepositoryResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (AssociateRepositoryResponse -> AssociateRepositoryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateRepositoryResponse -> AssociateRepositoryResponse -> Bool
$c/= :: AssociateRepositoryResponse -> AssociateRepositoryResponse -> Bool
== :: AssociateRepositoryResponse -> AssociateRepositoryResponse -> Bool
$c== :: AssociateRepositoryResponse -> AssociateRepositoryResponse -> Bool
Prelude.Eq, ReadPrec [AssociateRepositoryResponse]
ReadPrec AssociateRepositoryResponse
Int -> ReadS AssociateRepositoryResponse
ReadS [AssociateRepositoryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateRepositoryResponse]
$creadListPrec :: ReadPrec [AssociateRepositoryResponse]
readPrec :: ReadPrec AssociateRepositoryResponse
$creadPrec :: ReadPrec AssociateRepositoryResponse
readList :: ReadS [AssociateRepositoryResponse]
$creadList :: ReadS [AssociateRepositoryResponse]
readsPrec :: Int -> ReadS AssociateRepositoryResponse
$creadsPrec :: Int -> ReadS AssociateRepositoryResponse
Prelude.Read, Int -> AssociateRepositoryResponse -> ShowS
[AssociateRepositoryResponse] -> ShowS
AssociateRepositoryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateRepositoryResponse] -> ShowS
$cshowList :: [AssociateRepositoryResponse] -> ShowS
show :: AssociateRepositoryResponse -> String
$cshow :: AssociateRepositoryResponse -> String
showsPrec :: Int -> AssociateRepositoryResponse -> ShowS
$cshowsPrec :: Int -> AssociateRepositoryResponse -> ShowS
Prelude.Show, forall x.
Rep AssociateRepositoryResponse x -> AssociateRepositoryResponse
forall x.
AssociateRepositoryResponse -> Rep AssociateRepositoryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateRepositoryResponse x -> AssociateRepositoryResponse
$cfrom :: forall x.
AssociateRepositoryResponse -> Rep AssociateRepositoryResponse x
Prelude.Generic)

-- |
-- Create a value of 'AssociateRepositoryResponse' 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:
--
-- 'repositoryAssociation', 'associateRepositoryResponse_repositoryAssociation' - Information about the repository association.
--
-- 'tags', 'associateRepositoryResponse_tags' - An array of key-value pairs used to tag an associated repository. A tag
-- is a custom attribute label with two parts:
--
-- -   A /tag key/ (for example, @CostCenter@, @Environment@, @Project@, or
--     @Secret@). Tag keys are case sensitive.
--
-- -   An optional field known as a /tag value/ (for example,
--     @111122223333@, @Production@, or a team name). Omitting the tag
--     value is the same as using an empty string. Like tag keys, tag
--     values are case sensitive.
--
-- 'httpStatus', 'associateRepositoryResponse_httpStatus' - The response's http status code.
newAssociateRepositoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateRepositoryResponse
newAssociateRepositoryResponse :: Int -> AssociateRepositoryResponse
newAssociateRepositoryResponse Int
pHttpStatus_ =
  AssociateRepositoryResponse'
    { $sel:repositoryAssociation:AssociateRepositoryResponse' :: Maybe RepositoryAssociation
repositoryAssociation =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tags:AssociateRepositoryResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AssociateRepositoryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the repository association.
associateRepositoryResponse_repositoryAssociation :: Lens.Lens' AssociateRepositoryResponse (Prelude.Maybe RepositoryAssociation)
associateRepositoryResponse_repositoryAssociation :: Lens' AssociateRepositoryResponse (Maybe RepositoryAssociation)
associateRepositoryResponse_repositoryAssociation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateRepositoryResponse' {Maybe RepositoryAssociation
repositoryAssociation :: Maybe RepositoryAssociation
$sel:repositoryAssociation:AssociateRepositoryResponse' :: AssociateRepositoryResponse -> Maybe RepositoryAssociation
repositoryAssociation} -> Maybe RepositoryAssociation
repositoryAssociation) (\s :: AssociateRepositoryResponse
s@AssociateRepositoryResponse' {} Maybe RepositoryAssociation
a -> AssociateRepositoryResponse
s {$sel:repositoryAssociation:AssociateRepositoryResponse' :: Maybe RepositoryAssociation
repositoryAssociation = Maybe RepositoryAssociation
a} :: AssociateRepositoryResponse)

-- | An array of key-value pairs used to tag an associated repository. A tag
-- is a custom attribute label with two parts:
--
-- -   A /tag key/ (for example, @CostCenter@, @Environment@, @Project@, or
--     @Secret@). Tag keys are case sensitive.
--
-- -   An optional field known as a /tag value/ (for example,
--     @111122223333@, @Production@, or a team name). Omitting the tag
--     value is the same as using an empty string. Like tag keys, tag
--     values are case sensitive.
associateRepositoryResponse_tags :: Lens.Lens' AssociateRepositoryResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
associateRepositoryResponse_tags :: Lens' AssociateRepositoryResponse (Maybe (HashMap Text Text))
associateRepositoryResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateRepositoryResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:AssociateRepositoryResponse' :: AssociateRepositoryResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: AssociateRepositoryResponse
s@AssociateRepositoryResponse' {} Maybe (HashMap Text Text)
a -> AssociateRepositoryResponse
s {$sel:tags:AssociateRepositoryResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: AssociateRepositoryResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

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

instance Prelude.NFData AssociateRepositoryResponse where
  rnf :: AssociateRepositoryResponse -> ()
rnf AssociateRepositoryResponse' {Int
Maybe (HashMap Text Text)
Maybe RepositoryAssociation
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
repositoryAssociation :: Maybe RepositoryAssociation
$sel:httpStatus:AssociateRepositoryResponse' :: AssociateRepositoryResponse -> Int
$sel:tags:AssociateRepositoryResponse' :: AssociateRepositoryResponse -> Maybe (HashMap Text Text)
$sel:repositoryAssociation:AssociateRepositoryResponse' :: AssociateRepositoryResponse -> Maybe RepositoryAssociation
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe RepositoryAssociation
repositoryAssociation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus