{-# 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.Amplify.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 a webhook.
module Amazonka.Amplify.UpdateWebhook
  ( -- * Creating a Request
    UpdateWebhook (..),
    newUpdateWebhook,

    -- * Request Lenses
    updateWebhook_branchName,
    updateWebhook_description,
    updateWebhook_webhookId,

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

    -- * Response Lenses
    updateWebhookResponse_httpStatus,
    updateWebhookResponse_webhook,
  )
where

import Amazonka.Amplify.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

-- | The request structure for the update webhook request.
--
-- /See:/ 'newUpdateWebhook' smart constructor.
data UpdateWebhook = UpdateWebhook'
  { -- | The name for a branch that is part of an Amplify app.
    UpdateWebhook -> Maybe Text
branchName :: Prelude.Maybe Prelude.Text,
    -- | The description for a webhook.
    UpdateWebhook -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The unique ID for a webhook.
    UpdateWebhook -> Text
webhookId :: 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:
--
-- 'branchName', 'updateWebhook_branchName' - The name for a branch that is part of an Amplify app.
--
-- 'description', 'updateWebhook_description' - The description for a webhook.
--
-- 'webhookId', 'updateWebhook_webhookId' - The unique ID for a webhook.
newUpdateWebhook ::
  -- | 'webhookId'
  Prelude.Text ->
  UpdateWebhook
newUpdateWebhook :: Text -> UpdateWebhook
newUpdateWebhook Text
pWebhookId_ =
  UpdateWebhook'
    { $sel:branchName:UpdateWebhook' :: Maybe Text
branchName = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateWebhook' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:webhookId:UpdateWebhook' :: Text
webhookId = Text
pWebhookId_
    }

-- | The name for a branch that is part of an Amplify app.
updateWebhook_branchName :: Lens.Lens' UpdateWebhook (Prelude.Maybe Prelude.Text)
updateWebhook_branchName :: Lens' UpdateWebhook (Maybe Text)
updateWebhook_branchName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebhook' {Maybe Text
branchName :: Maybe Text
$sel:branchName:UpdateWebhook' :: UpdateWebhook -> Maybe Text
branchName} -> Maybe Text
branchName) (\s :: UpdateWebhook
s@UpdateWebhook' {} Maybe Text
a -> UpdateWebhook
s {$sel:branchName:UpdateWebhook' :: Maybe Text
branchName = Maybe Text
a} :: UpdateWebhook)

-- | The description for a webhook.
updateWebhook_description :: Lens.Lens' UpdateWebhook (Prelude.Maybe Prelude.Text)
updateWebhook_description :: Lens' UpdateWebhook (Maybe Text)
updateWebhook_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebhook' {Maybe Text
description :: Maybe Text
$sel:description:UpdateWebhook' :: UpdateWebhook -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateWebhook
s@UpdateWebhook' {} Maybe Text
a -> UpdateWebhook
s {$sel:description:UpdateWebhook' :: Maybe Text
description = Maybe Text
a} :: UpdateWebhook)

-- | The unique ID for a webhook.
updateWebhook_webhookId :: Lens.Lens' UpdateWebhook Prelude.Text
updateWebhook_webhookId :: Lens' UpdateWebhook Text
updateWebhook_webhookId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebhook' {Text
webhookId :: Text
$sel:webhookId:UpdateWebhook' :: UpdateWebhook -> Text
webhookId} -> Text
webhookId) (\s :: UpdateWebhook
s@UpdateWebhook' {} Text
a -> UpdateWebhook
s {$sel:webhookId:UpdateWebhook' :: Text
webhookId = 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 ->
          Int -> Webhook -> UpdateWebhookResponse
UpdateWebhookResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"webhook")
      )

instance Prelude.Hashable UpdateWebhook where
  hashWithSalt :: Int -> UpdateWebhook -> Int
hashWithSalt Int
_salt UpdateWebhook' {Maybe Text
Text
webhookId :: Text
description :: Maybe Text
branchName :: Maybe Text
$sel:webhookId:UpdateWebhook' :: UpdateWebhook -> Text
$sel:description:UpdateWebhook' :: UpdateWebhook -> Maybe Text
$sel:branchName:UpdateWebhook' :: UpdateWebhook -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
branchName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
webhookId

instance Prelude.NFData UpdateWebhook where
  rnf :: UpdateWebhook -> ()
rnf UpdateWebhook' {Maybe Text
Text
webhookId :: Text
description :: Maybe Text
branchName :: Maybe Text
$sel:webhookId:UpdateWebhook' :: UpdateWebhook -> Text
$sel:description:UpdateWebhook' :: UpdateWebhook -> Maybe Text
$sel:branchName:UpdateWebhook' :: UpdateWebhook -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
branchName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
webhookId

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
"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 Text
Text
webhookId :: Text
description :: Maybe Text
branchName :: Maybe Text
$sel:webhookId:UpdateWebhook' :: UpdateWebhook -> Text
$sel:description:UpdateWebhook' :: UpdateWebhook -> Maybe Text
$sel:branchName:UpdateWebhook' :: UpdateWebhook -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"branchName" 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
branchName,
            (Key
"description" 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
description
          ]
      )

instance Data.ToPath UpdateWebhook where
  toPath :: UpdateWebhook -> ByteString
toPath UpdateWebhook' {Maybe Text
Text
webhookId :: Text
description :: Maybe Text
branchName :: Maybe Text
$sel:webhookId:UpdateWebhook' :: UpdateWebhook -> Text
$sel:description:UpdateWebhook' :: UpdateWebhook -> Maybe Text
$sel:branchName:UpdateWebhook' :: UpdateWebhook -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/webhooks/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
webhookId]

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

-- | The result structure for the update webhook request.
--
-- /See:/ 'newUpdateWebhookResponse' smart constructor.
data UpdateWebhookResponse = UpdateWebhookResponse'
  { -- | The response's http status code.
    UpdateWebhookResponse -> Int
httpStatus :: Prelude.Int,
    -- | Describes a webhook that connects repository events to an Amplify app.
    UpdateWebhookResponse -> Webhook
webhook :: Webhook
  }
  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:
--
-- 'httpStatus', 'updateWebhookResponse_httpStatus' - The response's http status code.
--
-- 'webhook', 'updateWebhookResponse_webhook' - Describes a webhook that connects repository events to an Amplify app.
newUpdateWebhookResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'webhook'
  Webhook ->
  UpdateWebhookResponse
newUpdateWebhookResponse :: Int -> Webhook -> UpdateWebhookResponse
newUpdateWebhookResponse Int
pHttpStatus_ Webhook
pWebhook_ =
  UpdateWebhookResponse'
    { $sel:httpStatus:UpdateWebhookResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:webhook:UpdateWebhookResponse' :: Webhook
webhook = Webhook
pWebhook_
    }

-- | 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)

-- | Describes a webhook that connects repository events to an Amplify app.
updateWebhookResponse_webhook :: Lens.Lens' UpdateWebhookResponse Webhook
updateWebhookResponse_webhook :: Lens' UpdateWebhookResponse Webhook
updateWebhookResponse_webhook = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWebhookResponse' {Webhook
webhook :: Webhook
$sel:webhook:UpdateWebhookResponse' :: UpdateWebhookResponse -> Webhook
webhook} -> Webhook
webhook) (\s :: UpdateWebhookResponse
s@UpdateWebhookResponse' {} Webhook
a -> UpdateWebhookResponse
s {$sel:webhook:UpdateWebhookResponse' :: Webhook
webhook = Webhook
a} :: UpdateWebhookResponse)

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