{-# 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.UpdateWebhook
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the webhook associated with an CodeBuild build project.
--
-- If you use Bitbucket for your repository, @rotateSecret@ is ignored.
module Amazonka.CodeBuild.UpdateWebhook
  ( -- * Creating a Request
    UpdateWebhook (..),
    newUpdateWebhook,

    -- * Request Lenses
    updateWebhook_branchFilter,
    updateWebhook_buildType,
    updateWebhook_filterGroups,
    updateWebhook_rotateSecret,
    updateWebhook_projectName,

    -- * Destructuring the Response
    UpdateWebhookResponse (..),
    newUpdateWebhookResponse,

    -- * Response Lenses
    updateWebhookResponse_webhook,
    updateWebhookResponse_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:/ 'newUpdateWebhook' smart constructor.
data UpdateWebhook = UpdateWebhook'
  { -- | A regular expression used to determine which repository branches are
    -- built when a webhook is triggered. If the name of a branch matches the
    -- regular expression, then it is built. If @branchFilter@ is empty, then
    -- all branches are built.
    --
    -- It is recommended that you use @filterGroups@ instead of @branchFilter@.
    UpdateWebhook -> Maybe Text
branchFilter :: Prelude.Maybe Prelude.Text,
    -- | Specifies the type of build this webhook will trigger.
    UpdateWebhook -> Maybe WebhookBuildType
buildType :: Prelude.Maybe WebhookBuildType,
    -- | An array of arrays of @WebhookFilter@ objects used to determine if a
    -- webhook event can trigger a build. A filter group must contain at least
    -- one @EVENT@ @WebhookFilter@.
    UpdateWebhook -> Maybe [[WebhookFilter]]
filterGroups :: Prelude.Maybe [[WebhookFilter]],
    -- | A boolean value that specifies whether the associated GitHub
    -- repository\'s secret token should be updated. If you use Bitbucket for
    -- your repository, @rotateSecret@ is ignored.
    UpdateWebhook -> Maybe Bool
rotateSecret :: Prelude.Maybe Prelude.Bool,
    -- | The name of the CodeBuild project.
    UpdateWebhook -> Text
projectName :: Prelude.Text
  }
  deriving (UpdateWebhook -> UpdateWebhook -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWebhook -> UpdateWebhook -> Bool
$c/= :: UpdateWebhook -> UpdateWebhook -> Bool
== :: UpdateWebhook -> UpdateWebhook -> Bool
$c== :: UpdateWebhook -> UpdateWebhook -> Bool
Prelude.Eq, ReadPrec [UpdateWebhook]
ReadPrec UpdateWebhook
Int -> ReadS UpdateWebhook
ReadS [UpdateWebhook]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWebhook]
$creadListPrec :: ReadPrec [UpdateWebhook]
readPrec :: ReadPrec UpdateWebhook
$creadPrec :: ReadPrec UpdateWebhook
readList :: ReadS [UpdateWebhook]
$creadList :: ReadS [UpdateWebhook]
readsPrec :: Int -> ReadS UpdateWebhook
$creadsPrec :: Int -> ReadS UpdateWebhook
Prelude.Read, Int -> UpdateWebhook -> ShowS
[UpdateWebhook] -> ShowS
UpdateWebhook -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWebhook] -> ShowS
$cshowList :: [UpdateWebhook] -> ShowS
show :: UpdateWebhook -> String
$cshow :: UpdateWebhook -> String
showsPrec :: Int -> UpdateWebhook -> ShowS
$cshowsPrec :: Int -> UpdateWebhook -> ShowS
Prelude.Show, forall x. Rep UpdateWebhook x -> UpdateWebhook
forall x. UpdateWebhook -> Rep UpdateWebhook x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateWebhook x -> UpdateWebhook
$cfrom :: forall x. UpdateWebhook -> Rep UpdateWebhook x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWebhook' 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:
--
-- 'branchFilter', 'updateWebhook_branchFilter' - A regular expression used to determine which repository branches are
-- built when a webhook is triggered. If the name of a branch matches the
-- regular expression, then it is built. If @branchFilter@ is empty, then
-- all branches are built.
--
-- It is recommended that you use @filterGroups@ instead of @branchFilter@.
--
-- 'buildType', 'updateWebhook_buildType' - Specifies the type of build this webhook will trigger.
--
-- 'filterGroups', 'updateWebhook_filterGroups' - An array of arrays of @WebhookFilter@ objects used to determine if a
-- webhook event can trigger a build. A filter group must contain at least
-- one @EVENT@ @WebhookFilter@.
--
-- 'rotateSecret', 'updateWebhook_rotateSecret' - A boolean value that specifies whether the associated GitHub
-- repository\'s secret token should be updated. If you use Bitbucket for
-- your repository, @rotateSecret@ is ignored.
--
-- 'projectName', 'updateWebhook_projectName' - The name of the CodeBuild project.
newUpdateWebhook ::
  -- | 'projectName'
  Prelude.Text ->
  UpdateWebhook
newUpdateWebhook :: Text -> UpdateWebhook
newUpdateWebhook Text
pProjectName_ =
  UpdateWebhook'
    { $sel:branchFilter:UpdateWebhook' :: Maybe Text
branchFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:buildType:UpdateWebhook' :: Maybe WebhookBuildType
buildType = forall a. Maybe a
Prelude.Nothing,
      $sel:filterGroups:UpdateWebhook' :: Maybe [[WebhookFilter]]
filterGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:rotateSecret:UpdateWebhook' :: Maybe Bool
rotateSecret = forall a. Maybe a
Prelude.Nothing,
      $sel:projectName:UpdateWebhook' :: Text
projectName = Text
pProjectName_
    }

-- | A regular expression used to determine which repository branches are
-- built when a webhook is triggered. If the name of a branch matches the
-- regular expression, then it is built. If @branchFilter@ is empty, then
-- all branches are built.
--
-- It is recommended that you use @filterGroups@ instead of @branchFilter@.
updateWebhook_branchFilter :: Lens.Lens' UpdateWebhook (Prelude.Maybe Prelude.Text)
updateWebhook_branchFilter :: Lens' UpdateWebhook (Maybe Text)
updateWebhook_branchFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebhook' {Maybe Text
branchFilter :: Maybe Text
$sel:branchFilter:UpdateWebhook' :: UpdateWebhook -> Maybe Text
branchFilter} -> Maybe Text
branchFilter) (\s :: UpdateWebhook
s@UpdateWebhook' {} Maybe Text
a -> UpdateWebhook
s {$sel:branchFilter:UpdateWebhook' :: Maybe Text
branchFilter = Maybe Text
a} :: UpdateWebhook)

-- | Specifies the type of build this webhook will trigger.
updateWebhook_buildType :: Lens.Lens' UpdateWebhook (Prelude.Maybe WebhookBuildType)
updateWebhook_buildType :: Lens' UpdateWebhook (Maybe WebhookBuildType)
updateWebhook_buildType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebhook' {Maybe WebhookBuildType
buildType :: Maybe WebhookBuildType
$sel:buildType:UpdateWebhook' :: UpdateWebhook -> Maybe WebhookBuildType
buildType} -> Maybe WebhookBuildType
buildType) (\s :: UpdateWebhook
s@UpdateWebhook' {} Maybe WebhookBuildType
a -> UpdateWebhook
s {$sel:buildType:UpdateWebhook' :: Maybe WebhookBuildType
buildType = Maybe WebhookBuildType
a} :: UpdateWebhook)

-- | An array of arrays of @WebhookFilter@ objects used to determine if a
-- webhook event can trigger a build. A filter group must contain at least
-- one @EVENT@ @WebhookFilter@.
updateWebhook_filterGroups :: Lens.Lens' UpdateWebhook (Prelude.Maybe [[WebhookFilter]])
updateWebhook_filterGroups :: Lens' UpdateWebhook (Maybe [[WebhookFilter]])
updateWebhook_filterGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebhook' {Maybe [[WebhookFilter]]
filterGroups :: Maybe [[WebhookFilter]]
$sel:filterGroups:UpdateWebhook' :: UpdateWebhook -> Maybe [[WebhookFilter]]
filterGroups} -> Maybe [[WebhookFilter]]
filterGroups) (\s :: UpdateWebhook
s@UpdateWebhook' {} Maybe [[WebhookFilter]]
a -> UpdateWebhook
s {$sel:filterGroups:UpdateWebhook' :: Maybe [[WebhookFilter]]
filterGroups = Maybe [[WebhookFilter]]
a} :: UpdateWebhook) 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

-- | A boolean value that specifies whether the associated GitHub
-- repository\'s secret token should be updated. If you use Bitbucket for
-- your repository, @rotateSecret@ is ignored.
updateWebhook_rotateSecret :: Lens.Lens' UpdateWebhook (Prelude.Maybe Prelude.Bool)
updateWebhook_rotateSecret :: Lens' UpdateWebhook (Maybe Bool)
updateWebhook_rotateSecret = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebhook' {Maybe Bool
rotateSecret :: Maybe Bool
$sel:rotateSecret:UpdateWebhook' :: UpdateWebhook -> Maybe Bool
rotateSecret} -> Maybe Bool
rotateSecret) (\s :: UpdateWebhook
s@UpdateWebhook' {} Maybe Bool
a -> UpdateWebhook
s {$sel:rotateSecret:UpdateWebhook' :: Maybe Bool
rotateSecret = Maybe Bool
a} :: UpdateWebhook)

-- | The name of the CodeBuild project.
updateWebhook_projectName :: Lens.Lens' UpdateWebhook Prelude.Text
updateWebhook_projectName :: Lens' UpdateWebhook Text
updateWebhook_projectName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebhook' {Text
projectName :: Text
$sel:projectName:UpdateWebhook' :: UpdateWebhook -> Text
projectName} -> Text
projectName) (\s :: UpdateWebhook
s@UpdateWebhook' {} Text
a -> UpdateWebhook
s {$sel:projectName:UpdateWebhook' :: Text
projectName = Text
a} :: UpdateWebhook)

instance Core.AWSRequest UpdateWebhook where
  type
    AWSResponse UpdateWebhook =
      UpdateWebhookResponse
  request :: (Service -> Service) -> UpdateWebhook -> Request UpdateWebhook
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 UpdateWebhook
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateWebhook)))
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 Webhook -> Int -> UpdateWebhookResponse
UpdateWebhookResponse'
            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
"webhook")
            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 UpdateWebhook where
  hashWithSalt :: Int -> UpdateWebhook -> Int
hashWithSalt Int
_salt UpdateWebhook' {Maybe Bool
Maybe [[WebhookFilter]]
Maybe Text
Maybe WebhookBuildType
Text
projectName :: Text
rotateSecret :: Maybe Bool
filterGroups :: Maybe [[WebhookFilter]]
buildType :: Maybe WebhookBuildType
branchFilter :: Maybe Text
$sel:projectName:UpdateWebhook' :: UpdateWebhook -> Text
$sel:rotateSecret:UpdateWebhook' :: UpdateWebhook -> Maybe Bool
$sel:filterGroups:UpdateWebhook' :: UpdateWebhook -> Maybe [[WebhookFilter]]
$sel:buildType:UpdateWebhook' :: UpdateWebhook -> Maybe WebhookBuildType
$sel:branchFilter:UpdateWebhook' :: UpdateWebhook -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
branchFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WebhookBuildType
buildType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [[WebhookFilter]]
filterGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
rotateSecret
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
projectName

instance Prelude.NFData UpdateWebhook where
  rnf :: UpdateWebhook -> ()
rnf UpdateWebhook' {Maybe Bool
Maybe [[WebhookFilter]]
Maybe Text
Maybe WebhookBuildType
Text
projectName :: Text
rotateSecret :: Maybe Bool
filterGroups :: Maybe [[WebhookFilter]]
buildType :: Maybe WebhookBuildType
branchFilter :: Maybe Text
$sel:projectName:UpdateWebhook' :: UpdateWebhook -> Text
$sel:rotateSecret:UpdateWebhook' :: UpdateWebhook -> Maybe Bool
$sel:filterGroups:UpdateWebhook' :: UpdateWebhook -> Maybe [[WebhookFilter]]
$sel:buildType:UpdateWebhook' :: UpdateWebhook -> Maybe WebhookBuildType
$sel:branchFilter:UpdateWebhook' :: UpdateWebhook -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
branchFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WebhookBuildType
buildType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [[WebhookFilter]]
filterGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
rotateSecret
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
projectName

instance Data.ToHeaders UpdateWebhook where
  toHeaders :: UpdateWebhook -> 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.UpdateWebhook" ::
                          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 UpdateWebhook where
  toJSON :: UpdateWebhook -> Value
toJSON UpdateWebhook' {Maybe Bool
Maybe [[WebhookFilter]]
Maybe Text
Maybe WebhookBuildType
Text
projectName :: Text
rotateSecret :: Maybe Bool
filterGroups :: Maybe [[WebhookFilter]]
buildType :: Maybe WebhookBuildType
branchFilter :: Maybe Text
$sel:projectName:UpdateWebhook' :: UpdateWebhook -> Text
$sel:rotateSecret:UpdateWebhook' :: UpdateWebhook -> Maybe Bool
$sel:filterGroups:UpdateWebhook' :: UpdateWebhook -> Maybe [[WebhookFilter]]
$sel:buildType:UpdateWebhook' :: UpdateWebhook -> Maybe WebhookBuildType
$sel:branchFilter:UpdateWebhook' :: UpdateWebhook -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"branchFilter" 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
branchFilter,
            (Key
"buildType" 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 WebhookBuildType
buildType,
            (Key
"filterGroups" 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 [[WebhookFilter]]
filterGroups,
            (Key
"rotateSecret" 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 Bool
rotateSecret,
            forall a. a -> Maybe a
Prelude.Just (Key
"projectName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
projectName)
          ]
      )

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

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

-- | /See:/ 'newUpdateWebhookResponse' smart constructor.
data UpdateWebhookResponse = UpdateWebhookResponse'
  { -- | Information about a repository\'s webhook that is associated with a
    -- project in CodeBuild.
    UpdateWebhookResponse -> Maybe Webhook
webhook :: Prelude.Maybe Webhook,
    -- | The response's http status code.
    UpdateWebhookResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateWebhookResponse -> UpdateWebhookResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWebhookResponse -> UpdateWebhookResponse -> Bool
$c/= :: UpdateWebhookResponse -> UpdateWebhookResponse -> Bool
== :: UpdateWebhookResponse -> UpdateWebhookResponse -> Bool
$c== :: UpdateWebhookResponse -> UpdateWebhookResponse -> Bool
Prelude.Eq, ReadPrec [UpdateWebhookResponse]
ReadPrec UpdateWebhookResponse
Int -> ReadS UpdateWebhookResponse
ReadS [UpdateWebhookResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWebhookResponse]
$creadListPrec :: ReadPrec [UpdateWebhookResponse]
readPrec :: ReadPrec UpdateWebhookResponse
$creadPrec :: ReadPrec UpdateWebhookResponse
readList :: ReadS [UpdateWebhookResponse]
$creadList :: ReadS [UpdateWebhookResponse]
readsPrec :: Int -> ReadS UpdateWebhookResponse
$creadsPrec :: Int -> ReadS UpdateWebhookResponse
Prelude.Read, Int -> UpdateWebhookResponse -> ShowS
[UpdateWebhookResponse] -> ShowS
UpdateWebhookResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWebhookResponse] -> ShowS
$cshowList :: [UpdateWebhookResponse] -> ShowS
show :: UpdateWebhookResponse -> String
$cshow :: UpdateWebhookResponse -> String
showsPrec :: Int -> UpdateWebhookResponse -> ShowS
$cshowsPrec :: Int -> UpdateWebhookResponse -> ShowS
Prelude.Show, forall x. Rep UpdateWebhookResponse x -> UpdateWebhookResponse
forall x. UpdateWebhookResponse -> Rep UpdateWebhookResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateWebhookResponse x -> UpdateWebhookResponse
$cfrom :: forall x. UpdateWebhookResponse -> Rep UpdateWebhookResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWebhookResponse' 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:
--
-- 'webhook', 'updateWebhookResponse_webhook' - Information about a repository\'s webhook that is associated with a
-- project in CodeBuild.
--
-- 'httpStatus', 'updateWebhookResponse_httpStatus' - The response's http status code.
newUpdateWebhookResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateWebhookResponse
newUpdateWebhookResponse :: Int -> UpdateWebhookResponse
newUpdateWebhookResponse Int
pHttpStatus_ =
  UpdateWebhookResponse'
    { $sel:webhook:UpdateWebhookResponse' :: Maybe Webhook
webhook = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateWebhookResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about a repository\'s webhook that is associated with a
-- project in CodeBuild.
updateWebhookResponse_webhook :: Lens.Lens' UpdateWebhookResponse (Prelude.Maybe Webhook)
updateWebhookResponse_webhook :: Lens' UpdateWebhookResponse (Maybe Webhook)
updateWebhookResponse_webhook = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebhookResponse' {Maybe Webhook
webhook :: Maybe Webhook
$sel:webhook:UpdateWebhookResponse' :: UpdateWebhookResponse -> Maybe Webhook
webhook} -> Maybe Webhook
webhook) (\s :: UpdateWebhookResponse
s@UpdateWebhookResponse' {} Maybe Webhook
a -> UpdateWebhookResponse
s {$sel:webhook:UpdateWebhookResponse' :: Maybe Webhook
webhook = Maybe Webhook
a} :: UpdateWebhookResponse)

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

instance Prelude.NFData UpdateWebhookResponse where
  rnf :: UpdateWebhookResponse -> ()
rnf UpdateWebhookResponse' {Int
Maybe Webhook
httpStatus :: Int
webhook :: Maybe Webhook
$sel:httpStatus:UpdateWebhookResponse' :: UpdateWebhookResponse -> Int
$sel:webhook:UpdateWebhookResponse' :: UpdateWebhookResponse -> Maybe Webhook
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Webhook
webhook
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus