{-# 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.CodeBuild.UpdateProjectVisibility
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Changes the public visibility for a project. The project\'s build
-- results, logs, and artifacts are available to the general public. For
-- more information, see
-- <https://docs.aws.amazon.com/codebuild/latest/userguide/public-builds.html Public build projects>
-- in the /CodeBuild User Guide/.
--
-- The following should be kept in mind when making your projects public:
--
-- -   All of a project\'s build results, logs, and artifacts, including
--     builds that were run when the project was private, are available to
--     the general public.
--
-- -   All build logs and artifacts are available to the public.
--     Environment variables, source code, and other sensitive information
--     may have been output to the build logs and artifacts. You must be
--     careful about what information is output to the build logs. Some
--     best practice are:
--
--     -   Do not store sensitive values, especially Amazon Web Services
--         access key IDs and secret access keys, in environment variables.
--         We recommend that you use an Amazon EC2 Systems Manager
--         Parameter Store or Secrets Manager to store sensitive values.
--
--     -   Follow
--         <https://docs.aws.amazon.com/codebuild/latest/userguide/webhooks.html#webhook-best-practices Best practices for using webhooks>
--         in the /CodeBuild User Guide/ to limit which entities can
--         trigger a build, and do not store the buildspec in the project
--         itself, to ensure that your webhooks are as secure as possible.
--
-- -   A malicious user can use public builds to distribute malicious
--     artifacts. We recommend that you review all pull requests to verify
--     that the pull request is a legitimate change. We also recommend that
--     you validate any artifacts with their checksums to make sure that
--     the correct artifacts are being downloaded.
module Amazonka.CodeBuild.UpdateProjectVisibility
  ( -- * Creating a Request
    UpdateProjectVisibility (..),
    newUpdateProjectVisibility,

    -- * Request Lenses
    updateProjectVisibility_resourceAccessRole,
    updateProjectVisibility_projectArn,
    updateProjectVisibility_projectVisibility,

    -- * Destructuring the Response
    UpdateProjectVisibilityResponse (..),
    newUpdateProjectVisibilityResponse,

    -- * Response Lenses
    updateProjectVisibilityResponse_projectArn,
    updateProjectVisibilityResponse_projectVisibility,
    updateProjectVisibilityResponse_publicProjectAlias,
    updateProjectVisibilityResponse_httpStatus,
  )
where

import Amazonka.CodeBuild.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:/ 'newUpdateProjectVisibility' smart constructor.
data UpdateProjectVisibility = UpdateProjectVisibility'
  { -- | The ARN of the IAM role that enables CodeBuild to access the CloudWatch
    -- Logs and Amazon S3 artifacts for the project\'s builds.
    UpdateProjectVisibility -> Maybe Text
resourceAccessRole :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the build project.
    UpdateProjectVisibility -> Text
projectArn :: Prelude.Text,
    UpdateProjectVisibility -> ProjectVisibilityType
projectVisibility :: ProjectVisibilityType
  }
  deriving (UpdateProjectVisibility -> UpdateProjectVisibility -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateProjectVisibility -> UpdateProjectVisibility -> Bool
$c/= :: UpdateProjectVisibility -> UpdateProjectVisibility -> Bool
== :: UpdateProjectVisibility -> UpdateProjectVisibility -> Bool
$c== :: UpdateProjectVisibility -> UpdateProjectVisibility -> Bool
Prelude.Eq, ReadPrec [UpdateProjectVisibility]
ReadPrec UpdateProjectVisibility
Int -> ReadS UpdateProjectVisibility
ReadS [UpdateProjectVisibility]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateProjectVisibility]
$creadListPrec :: ReadPrec [UpdateProjectVisibility]
readPrec :: ReadPrec UpdateProjectVisibility
$creadPrec :: ReadPrec UpdateProjectVisibility
readList :: ReadS [UpdateProjectVisibility]
$creadList :: ReadS [UpdateProjectVisibility]
readsPrec :: Int -> ReadS UpdateProjectVisibility
$creadsPrec :: Int -> ReadS UpdateProjectVisibility
Prelude.Read, Int -> UpdateProjectVisibility -> ShowS
[UpdateProjectVisibility] -> ShowS
UpdateProjectVisibility -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateProjectVisibility] -> ShowS
$cshowList :: [UpdateProjectVisibility] -> ShowS
show :: UpdateProjectVisibility -> String
$cshow :: UpdateProjectVisibility -> String
showsPrec :: Int -> UpdateProjectVisibility -> ShowS
$cshowsPrec :: Int -> UpdateProjectVisibility -> ShowS
Prelude.Show, forall x. Rep UpdateProjectVisibility x -> UpdateProjectVisibility
forall x. UpdateProjectVisibility -> Rep UpdateProjectVisibility x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateProjectVisibility x -> UpdateProjectVisibility
$cfrom :: forall x. UpdateProjectVisibility -> Rep UpdateProjectVisibility x
Prelude.Generic)

-- |
-- Create a value of 'UpdateProjectVisibility' 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:
--
-- 'resourceAccessRole', 'updateProjectVisibility_resourceAccessRole' - The ARN of the IAM role that enables CodeBuild to access the CloudWatch
-- Logs and Amazon S3 artifacts for the project\'s builds.
--
-- 'projectArn', 'updateProjectVisibility_projectArn' - The Amazon Resource Name (ARN) of the build project.
--
-- 'projectVisibility', 'updateProjectVisibility_projectVisibility' - Undocumented member.
newUpdateProjectVisibility ::
  -- | 'projectArn'
  Prelude.Text ->
  -- | 'projectVisibility'
  ProjectVisibilityType ->
  UpdateProjectVisibility
newUpdateProjectVisibility :: Text -> ProjectVisibilityType -> UpdateProjectVisibility
newUpdateProjectVisibility
  Text
pProjectArn_
  ProjectVisibilityType
pProjectVisibility_ =
    UpdateProjectVisibility'
      { $sel:resourceAccessRole:UpdateProjectVisibility' :: Maybe Text
resourceAccessRole =
          forall a. Maybe a
Prelude.Nothing,
        $sel:projectArn:UpdateProjectVisibility' :: Text
projectArn = Text
pProjectArn_,
        $sel:projectVisibility:UpdateProjectVisibility' :: ProjectVisibilityType
projectVisibility = ProjectVisibilityType
pProjectVisibility_
      }

-- | The ARN of the IAM role that enables CodeBuild to access the CloudWatch
-- Logs and Amazon S3 artifacts for the project\'s builds.
updateProjectVisibility_resourceAccessRole :: Lens.Lens' UpdateProjectVisibility (Prelude.Maybe Prelude.Text)
updateProjectVisibility_resourceAccessRole :: Lens' UpdateProjectVisibility (Maybe Text)
updateProjectVisibility_resourceAccessRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProjectVisibility' {Maybe Text
resourceAccessRole :: Maybe Text
$sel:resourceAccessRole:UpdateProjectVisibility' :: UpdateProjectVisibility -> Maybe Text
resourceAccessRole} -> Maybe Text
resourceAccessRole) (\s :: UpdateProjectVisibility
s@UpdateProjectVisibility' {} Maybe Text
a -> UpdateProjectVisibility
s {$sel:resourceAccessRole:UpdateProjectVisibility' :: Maybe Text
resourceAccessRole = Maybe Text
a} :: UpdateProjectVisibility)

-- | The Amazon Resource Name (ARN) of the build project.
updateProjectVisibility_projectArn :: Lens.Lens' UpdateProjectVisibility Prelude.Text
updateProjectVisibility_projectArn :: Lens' UpdateProjectVisibility Text
updateProjectVisibility_projectArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProjectVisibility' {Text
projectArn :: Text
$sel:projectArn:UpdateProjectVisibility' :: UpdateProjectVisibility -> Text
projectArn} -> Text
projectArn) (\s :: UpdateProjectVisibility
s@UpdateProjectVisibility' {} Text
a -> UpdateProjectVisibility
s {$sel:projectArn:UpdateProjectVisibility' :: Text
projectArn = Text
a} :: UpdateProjectVisibility)

-- | Undocumented member.
updateProjectVisibility_projectVisibility :: Lens.Lens' UpdateProjectVisibility ProjectVisibilityType
updateProjectVisibility_projectVisibility :: Lens' UpdateProjectVisibility ProjectVisibilityType
updateProjectVisibility_projectVisibility = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProjectVisibility' {ProjectVisibilityType
projectVisibility :: ProjectVisibilityType
$sel:projectVisibility:UpdateProjectVisibility' :: UpdateProjectVisibility -> ProjectVisibilityType
projectVisibility} -> ProjectVisibilityType
projectVisibility) (\s :: UpdateProjectVisibility
s@UpdateProjectVisibility' {} ProjectVisibilityType
a -> UpdateProjectVisibility
s {$sel:projectVisibility:UpdateProjectVisibility' :: ProjectVisibilityType
projectVisibility = ProjectVisibilityType
a} :: UpdateProjectVisibility)

instance Core.AWSRequest UpdateProjectVisibility where
  type
    AWSResponse UpdateProjectVisibility =
      UpdateProjectVisibilityResponse
  request :: (Service -> Service)
-> UpdateProjectVisibility -> Request UpdateProjectVisibility
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 UpdateProjectVisibility
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateProjectVisibility)))
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 Text
-> Maybe ProjectVisibilityType
-> Maybe Text
-> Int
-> UpdateProjectVisibilityResponse
UpdateProjectVisibilityResponse'
            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
"projectArn")
            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
"projectVisibility")
            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
"publicProjectAlias")
            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 UpdateProjectVisibility where
  hashWithSalt :: Int -> UpdateProjectVisibility -> Int
hashWithSalt Int
_salt UpdateProjectVisibility' {Maybe Text
Text
ProjectVisibilityType
projectVisibility :: ProjectVisibilityType
projectArn :: Text
resourceAccessRole :: Maybe Text
$sel:projectVisibility:UpdateProjectVisibility' :: UpdateProjectVisibility -> ProjectVisibilityType
$sel:projectArn:UpdateProjectVisibility' :: UpdateProjectVisibility -> Text
$sel:resourceAccessRole:UpdateProjectVisibility' :: UpdateProjectVisibility -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resourceAccessRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
projectArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ProjectVisibilityType
projectVisibility

instance Prelude.NFData UpdateProjectVisibility where
  rnf :: UpdateProjectVisibility -> ()
rnf UpdateProjectVisibility' {Maybe Text
Text
ProjectVisibilityType
projectVisibility :: ProjectVisibilityType
projectArn :: Text
resourceAccessRole :: Maybe Text
$sel:projectVisibility:UpdateProjectVisibility' :: UpdateProjectVisibility -> ProjectVisibilityType
$sel:projectArn:UpdateProjectVisibility' :: UpdateProjectVisibility -> Text
$sel:resourceAccessRole:UpdateProjectVisibility' :: UpdateProjectVisibility -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceAccessRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
projectArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ProjectVisibilityType
projectVisibility

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

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

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

-- | /See:/ 'newUpdateProjectVisibilityResponse' smart constructor.
data UpdateProjectVisibilityResponse = UpdateProjectVisibilityResponse'
  { -- | The Amazon Resource Name (ARN) of the build project.
    UpdateProjectVisibilityResponse -> Maybe Text
projectArn :: Prelude.Maybe Prelude.Text,
    UpdateProjectVisibilityResponse -> Maybe ProjectVisibilityType
projectVisibility :: Prelude.Maybe ProjectVisibilityType,
    -- | Contains the project identifier used with the public build APIs.
    UpdateProjectVisibilityResponse -> Maybe Text
publicProjectAlias :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    UpdateProjectVisibilityResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateProjectVisibilityResponse
-> UpdateProjectVisibilityResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateProjectVisibilityResponse
-> UpdateProjectVisibilityResponse -> Bool
$c/= :: UpdateProjectVisibilityResponse
-> UpdateProjectVisibilityResponse -> Bool
== :: UpdateProjectVisibilityResponse
-> UpdateProjectVisibilityResponse -> Bool
$c== :: UpdateProjectVisibilityResponse
-> UpdateProjectVisibilityResponse -> Bool
Prelude.Eq, ReadPrec [UpdateProjectVisibilityResponse]
ReadPrec UpdateProjectVisibilityResponse
Int -> ReadS UpdateProjectVisibilityResponse
ReadS [UpdateProjectVisibilityResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateProjectVisibilityResponse]
$creadListPrec :: ReadPrec [UpdateProjectVisibilityResponse]
readPrec :: ReadPrec UpdateProjectVisibilityResponse
$creadPrec :: ReadPrec UpdateProjectVisibilityResponse
readList :: ReadS [UpdateProjectVisibilityResponse]
$creadList :: ReadS [UpdateProjectVisibilityResponse]
readsPrec :: Int -> ReadS UpdateProjectVisibilityResponse
$creadsPrec :: Int -> ReadS UpdateProjectVisibilityResponse
Prelude.Read, Int -> UpdateProjectVisibilityResponse -> ShowS
[UpdateProjectVisibilityResponse] -> ShowS
UpdateProjectVisibilityResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateProjectVisibilityResponse] -> ShowS
$cshowList :: [UpdateProjectVisibilityResponse] -> ShowS
show :: UpdateProjectVisibilityResponse -> String
$cshow :: UpdateProjectVisibilityResponse -> String
showsPrec :: Int -> UpdateProjectVisibilityResponse -> ShowS
$cshowsPrec :: Int -> UpdateProjectVisibilityResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateProjectVisibilityResponse x
-> UpdateProjectVisibilityResponse
forall x.
UpdateProjectVisibilityResponse
-> Rep UpdateProjectVisibilityResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateProjectVisibilityResponse x
-> UpdateProjectVisibilityResponse
$cfrom :: forall x.
UpdateProjectVisibilityResponse
-> Rep UpdateProjectVisibilityResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateProjectVisibilityResponse' 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:
--
-- 'projectArn', 'updateProjectVisibilityResponse_projectArn' - The Amazon Resource Name (ARN) of the build project.
--
-- 'projectVisibility', 'updateProjectVisibilityResponse_projectVisibility' - Undocumented member.
--
-- 'publicProjectAlias', 'updateProjectVisibilityResponse_publicProjectAlias' - Contains the project identifier used with the public build APIs.
--
-- 'httpStatus', 'updateProjectVisibilityResponse_httpStatus' - The response's http status code.
newUpdateProjectVisibilityResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateProjectVisibilityResponse
newUpdateProjectVisibilityResponse :: Int -> UpdateProjectVisibilityResponse
newUpdateProjectVisibilityResponse Int
pHttpStatus_ =
  UpdateProjectVisibilityResponse'
    { $sel:projectArn:UpdateProjectVisibilityResponse' :: Maybe Text
projectArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:projectVisibility:UpdateProjectVisibilityResponse' :: Maybe ProjectVisibilityType
projectVisibility = forall a. Maybe a
Prelude.Nothing,
      $sel:publicProjectAlias:UpdateProjectVisibilityResponse' :: Maybe Text
publicProjectAlias = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateProjectVisibilityResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the build project.
updateProjectVisibilityResponse_projectArn :: Lens.Lens' UpdateProjectVisibilityResponse (Prelude.Maybe Prelude.Text)
updateProjectVisibilityResponse_projectArn :: Lens' UpdateProjectVisibilityResponse (Maybe Text)
updateProjectVisibilityResponse_projectArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProjectVisibilityResponse' {Maybe Text
projectArn :: Maybe Text
$sel:projectArn:UpdateProjectVisibilityResponse' :: UpdateProjectVisibilityResponse -> Maybe Text
projectArn} -> Maybe Text
projectArn) (\s :: UpdateProjectVisibilityResponse
s@UpdateProjectVisibilityResponse' {} Maybe Text
a -> UpdateProjectVisibilityResponse
s {$sel:projectArn:UpdateProjectVisibilityResponse' :: Maybe Text
projectArn = Maybe Text
a} :: UpdateProjectVisibilityResponse)

-- | Undocumented member.
updateProjectVisibilityResponse_projectVisibility :: Lens.Lens' UpdateProjectVisibilityResponse (Prelude.Maybe ProjectVisibilityType)
updateProjectVisibilityResponse_projectVisibility :: Lens' UpdateProjectVisibilityResponse (Maybe ProjectVisibilityType)
updateProjectVisibilityResponse_projectVisibility = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProjectVisibilityResponse' {Maybe ProjectVisibilityType
projectVisibility :: Maybe ProjectVisibilityType
$sel:projectVisibility:UpdateProjectVisibilityResponse' :: UpdateProjectVisibilityResponse -> Maybe ProjectVisibilityType
projectVisibility} -> Maybe ProjectVisibilityType
projectVisibility) (\s :: UpdateProjectVisibilityResponse
s@UpdateProjectVisibilityResponse' {} Maybe ProjectVisibilityType
a -> UpdateProjectVisibilityResponse
s {$sel:projectVisibility:UpdateProjectVisibilityResponse' :: Maybe ProjectVisibilityType
projectVisibility = Maybe ProjectVisibilityType
a} :: UpdateProjectVisibilityResponse)

-- | Contains the project identifier used with the public build APIs.
updateProjectVisibilityResponse_publicProjectAlias :: Lens.Lens' UpdateProjectVisibilityResponse (Prelude.Maybe Prelude.Text)
updateProjectVisibilityResponse_publicProjectAlias :: Lens' UpdateProjectVisibilityResponse (Maybe Text)
updateProjectVisibilityResponse_publicProjectAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateProjectVisibilityResponse' {Maybe Text
publicProjectAlias :: Maybe Text
$sel:publicProjectAlias:UpdateProjectVisibilityResponse' :: UpdateProjectVisibilityResponse -> Maybe Text
publicProjectAlias} -> Maybe Text
publicProjectAlias) (\s :: UpdateProjectVisibilityResponse
s@UpdateProjectVisibilityResponse' {} Maybe Text
a -> UpdateProjectVisibilityResponse
s {$sel:publicProjectAlias:UpdateProjectVisibilityResponse' :: Maybe Text
publicProjectAlias = Maybe Text
a} :: UpdateProjectVisibilityResponse)

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

instance
  Prelude.NFData
    UpdateProjectVisibilityResponse
  where
  rnf :: UpdateProjectVisibilityResponse -> ()
rnf UpdateProjectVisibilityResponse' {Int
Maybe Text
Maybe ProjectVisibilityType
httpStatus :: Int
publicProjectAlias :: Maybe Text
projectVisibility :: Maybe ProjectVisibilityType
projectArn :: Maybe Text
$sel:httpStatus:UpdateProjectVisibilityResponse' :: UpdateProjectVisibilityResponse -> Int
$sel:publicProjectAlias:UpdateProjectVisibilityResponse' :: UpdateProjectVisibilityResponse -> Maybe Text
$sel:projectVisibility:UpdateProjectVisibilityResponse' :: UpdateProjectVisibilityResponse -> Maybe ProjectVisibilityType
$sel:projectArn:UpdateProjectVisibilityResponse' :: UpdateProjectVisibilityResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
projectArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProjectVisibilityType
projectVisibility
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
publicProjectAlias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus