{-# 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.CreateWebhook
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- For an existing CodeBuild build project that has its source code stored
-- in a GitHub or Bitbucket repository, enables CodeBuild to start
-- rebuilding the source code every time a code change is pushed to the
-- repository.
--
-- If you enable webhooks for an CodeBuild project, and the project is used
-- as a build step in CodePipeline, then two identical builds are created
-- for each commit. One build is triggered through webhooks, and one
-- through CodePipeline. Because billing is on a per-build basis, you are
-- billed for both builds. Therefore, if you are using CodePipeline, we
-- recommend that you disable webhooks in CodeBuild. In the CodeBuild
-- console, clear the Webhook box. For more information, see step 5 in
-- <https://docs.aws.amazon.com/codebuild/latest/userguide/change-project.html#change-project-console Change a Build Project\'s Settings>.
module Amazonka.CodeBuild.CreateWebhook
  ( -- * Creating a Request
    CreateWebhook (..),
    newCreateWebhook,

    -- * Request Lenses
    createWebhook_branchFilter,
    createWebhook_buildType,
    createWebhook_filterGroups,
    createWebhook_projectName,

    -- * Destructuring the Response
    CreateWebhookResponse (..),
    newCreateWebhookResponse,

    -- * Response Lenses
    createWebhookResponse_webhook,
    createWebhookResponse_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:/ 'newCreateWebhook' smart constructor.
data CreateWebhook = CreateWebhook'
  { -- | 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@.
    CreateWebhook -> Maybe Text
branchFilter :: Prelude.Maybe Prelude.Text,
    -- | Specifies the type of build this webhook will trigger.
    CreateWebhook -> Maybe WebhookBuildType
buildType :: Prelude.Maybe WebhookBuildType,
    -- | An array of arrays of @WebhookFilter@ objects used to determine which
    -- webhooks are triggered. At least one @WebhookFilter@ in the array must
    -- specify @EVENT@ as its @type@.
    --
    -- For a build to be triggered, at least one filter group in the
    -- @filterGroups@ array must pass. For a filter group to pass, each of its
    -- filters must pass.
    CreateWebhook -> Maybe [[WebhookFilter]]
filterGroups :: Prelude.Maybe [[WebhookFilter]],
    -- | The name of the CodeBuild project.
    CreateWebhook -> Text
projectName :: Prelude.Text
  }
  deriving (CreateWebhook -> CreateWebhook -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateWebhook -> CreateWebhook -> Bool
$c/= :: CreateWebhook -> CreateWebhook -> Bool
== :: CreateWebhook -> CreateWebhook -> Bool
$c== :: CreateWebhook -> CreateWebhook -> Bool
Prelude.Eq, ReadPrec [CreateWebhook]
ReadPrec CreateWebhook
Int -> ReadS CreateWebhook
ReadS [CreateWebhook]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateWebhook]
$creadListPrec :: ReadPrec [CreateWebhook]
readPrec :: ReadPrec CreateWebhook
$creadPrec :: ReadPrec CreateWebhook
readList :: ReadS [CreateWebhook]
$creadList :: ReadS [CreateWebhook]
readsPrec :: Int -> ReadS CreateWebhook
$creadsPrec :: Int -> ReadS CreateWebhook
Prelude.Read, Int -> CreateWebhook -> ShowS
[CreateWebhook] -> ShowS
CreateWebhook -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateWebhook] -> ShowS
$cshowList :: [CreateWebhook] -> ShowS
show :: CreateWebhook -> String
$cshow :: CreateWebhook -> String
showsPrec :: Int -> CreateWebhook -> ShowS
$cshowsPrec :: Int -> CreateWebhook -> ShowS
Prelude.Show, forall x. Rep CreateWebhook x -> CreateWebhook
forall x. CreateWebhook -> Rep CreateWebhook x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateWebhook x -> CreateWebhook
$cfrom :: forall x. CreateWebhook -> Rep CreateWebhook x
Prelude.Generic)

-- |
-- Create a value of 'CreateWebhook' 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', 'createWebhook_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', 'createWebhook_buildType' - Specifies the type of build this webhook will trigger.
--
-- 'filterGroups', 'createWebhook_filterGroups' - An array of arrays of @WebhookFilter@ objects used to determine which
-- webhooks are triggered. At least one @WebhookFilter@ in the array must
-- specify @EVENT@ as its @type@.
--
-- For a build to be triggered, at least one filter group in the
-- @filterGroups@ array must pass. For a filter group to pass, each of its
-- filters must pass.
--
-- 'projectName', 'createWebhook_projectName' - The name of the CodeBuild project.
newCreateWebhook ::
  -- | 'projectName'
  Prelude.Text ->
  CreateWebhook
newCreateWebhook :: Text -> CreateWebhook
newCreateWebhook Text
pProjectName_ =
  CreateWebhook'
    { $sel:branchFilter:CreateWebhook' :: Maybe Text
branchFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:buildType:CreateWebhook' :: Maybe WebhookBuildType
buildType = forall a. Maybe a
Prelude.Nothing,
      $sel:filterGroups:CreateWebhook' :: Maybe [[WebhookFilter]]
filterGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:projectName:CreateWebhook' :: 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@.
createWebhook_branchFilter :: Lens.Lens' CreateWebhook (Prelude.Maybe Prelude.Text)
createWebhook_branchFilter :: Lens' CreateWebhook (Maybe Text)
createWebhook_branchFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWebhook' {Maybe Text
branchFilter :: Maybe Text
$sel:branchFilter:CreateWebhook' :: CreateWebhook -> Maybe Text
branchFilter} -> Maybe Text
branchFilter) (\s :: CreateWebhook
s@CreateWebhook' {} Maybe Text
a -> CreateWebhook
s {$sel:branchFilter:CreateWebhook' :: Maybe Text
branchFilter = Maybe Text
a} :: CreateWebhook)

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

-- | An array of arrays of @WebhookFilter@ objects used to determine which
-- webhooks are triggered. At least one @WebhookFilter@ in the array must
-- specify @EVENT@ as its @type@.
--
-- For a build to be triggered, at least one filter group in the
-- @filterGroups@ array must pass. For a filter group to pass, each of its
-- filters must pass.
createWebhook_filterGroups :: Lens.Lens' CreateWebhook (Prelude.Maybe [[WebhookFilter]])
createWebhook_filterGroups :: Lens' CreateWebhook (Maybe [[WebhookFilter]])
createWebhook_filterGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWebhook' {Maybe [[WebhookFilter]]
filterGroups :: Maybe [[WebhookFilter]]
$sel:filterGroups:CreateWebhook' :: CreateWebhook -> Maybe [[WebhookFilter]]
filterGroups} -> Maybe [[WebhookFilter]]
filterGroups) (\s :: CreateWebhook
s@CreateWebhook' {} Maybe [[WebhookFilter]]
a -> CreateWebhook
s {$sel:filterGroups:CreateWebhook' :: Maybe [[WebhookFilter]]
filterGroups = Maybe [[WebhookFilter]]
a} :: CreateWebhook) 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 name of the CodeBuild project.
createWebhook_projectName :: Lens.Lens' CreateWebhook Prelude.Text
createWebhook_projectName :: Lens' CreateWebhook Text
createWebhook_projectName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWebhook' {Text
projectName :: Text
$sel:projectName:CreateWebhook' :: CreateWebhook -> Text
projectName} -> Text
projectName) (\s :: CreateWebhook
s@CreateWebhook' {} Text
a -> CreateWebhook
s {$sel:projectName:CreateWebhook' :: Text
projectName = Text
a} :: CreateWebhook)

instance Core.AWSRequest CreateWebhook where
  type
    AWSResponse CreateWebhook =
      CreateWebhookResponse
  request :: (Service -> Service) -> CreateWebhook -> Request CreateWebhook
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 CreateWebhook
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateWebhook)))
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 -> CreateWebhookResponse
CreateWebhookResponse'
            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 CreateWebhook where
  hashWithSalt :: Int -> CreateWebhook -> Int
hashWithSalt Int
_salt CreateWebhook' {Maybe [[WebhookFilter]]
Maybe Text
Maybe WebhookBuildType
Text
projectName :: Text
filterGroups :: Maybe [[WebhookFilter]]
buildType :: Maybe WebhookBuildType
branchFilter :: Maybe Text
$sel:projectName:CreateWebhook' :: CreateWebhook -> Text
$sel:filterGroups:CreateWebhook' :: CreateWebhook -> Maybe [[WebhookFilter]]
$sel:buildType:CreateWebhook' :: CreateWebhook -> Maybe WebhookBuildType
$sel:branchFilter:CreateWebhook' :: CreateWebhook -> 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` Text
projectName

instance Prelude.NFData CreateWebhook where
  rnf :: CreateWebhook -> ()
rnf CreateWebhook' {Maybe [[WebhookFilter]]
Maybe Text
Maybe WebhookBuildType
Text
projectName :: Text
filterGroups :: Maybe [[WebhookFilter]]
buildType :: Maybe WebhookBuildType
branchFilter :: Maybe Text
$sel:projectName:CreateWebhook' :: CreateWebhook -> Text
$sel:filterGroups:CreateWebhook' :: CreateWebhook -> Maybe [[WebhookFilter]]
$sel:buildType:CreateWebhook' :: CreateWebhook -> Maybe WebhookBuildType
$sel:branchFilter:CreateWebhook' :: CreateWebhook -> 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 Text
projectName

instance Data.ToHeaders CreateWebhook where
  toHeaders :: CreateWebhook -> 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.CreateWebhook" ::
                          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 CreateWebhook where
  toJSON :: CreateWebhook -> Value
toJSON CreateWebhook' {Maybe [[WebhookFilter]]
Maybe Text
Maybe WebhookBuildType
Text
projectName :: Text
filterGroups :: Maybe [[WebhookFilter]]
buildType :: Maybe WebhookBuildType
branchFilter :: Maybe Text
$sel:projectName:CreateWebhook' :: CreateWebhook -> Text
$sel:filterGroups:CreateWebhook' :: CreateWebhook -> Maybe [[WebhookFilter]]
$sel:buildType:CreateWebhook' :: CreateWebhook -> Maybe WebhookBuildType
$sel:branchFilter:CreateWebhook' :: CreateWebhook -> 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,
            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 CreateWebhook where
  toPath :: CreateWebhook -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'CreateWebhookResponse' 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', 'createWebhookResponse_webhook' - Information about a webhook that connects repository events to a build
-- project in CodeBuild.
--
-- 'httpStatus', 'createWebhookResponse_httpStatus' - The response's http status code.
newCreateWebhookResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateWebhookResponse
newCreateWebhookResponse :: Int -> CreateWebhookResponse
newCreateWebhookResponse Int
pHttpStatus_ =
  CreateWebhookResponse'
    { $sel:webhook:CreateWebhookResponse' :: Maybe Webhook
webhook = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateWebhookResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about a webhook that connects repository events to a build
-- project in CodeBuild.
createWebhookResponse_webhook :: Lens.Lens' CreateWebhookResponse (Prelude.Maybe Webhook)
createWebhookResponse_webhook :: Lens' CreateWebhookResponse (Maybe Webhook)
createWebhookResponse_webhook = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateWebhookResponse' {Maybe Webhook
webhook :: Maybe Webhook
$sel:webhook:CreateWebhookResponse' :: CreateWebhookResponse -> Maybe Webhook
webhook} -> Maybe Webhook
webhook) (\s :: CreateWebhookResponse
s@CreateWebhookResponse' {} Maybe Webhook
a -> CreateWebhookResponse
s {$sel:webhook:CreateWebhookResponse' :: Maybe Webhook
webhook = Maybe Webhook
a} :: CreateWebhookResponse)

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

instance Prelude.NFData CreateWebhookResponse where
  rnf :: CreateWebhookResponse -> ()
rnf CreateWebhookResponse' {Int
Maybe Webhook
httpStatus :: Int
webhook :: Maybe Webhook
$sel:httpStatus:CreateWebhookResponse' :: CreateWebhookResponse -> Int
$sel:webhook:CreateWebhookResponse' :: CreateWebhookResponse -> 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