{-# 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.GetWebhook
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the webhook information that corresponds to a specified webhook
-- ID.
module Amazonka.Amplify.GetWebhook
  ( -- * Creating a Request
    GetWebhook (..),
    newGetWebhook,

    -- * Request Lenses
    getWebhook_webhookId,

    -- * Destructuring the Response
    GetWebhookResponse (..),
    newGetWebhookResponse,

    -- * Response Lenses
    getWebhookResponse_httpStatus,
    getWebhookResponse_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 get webhook request.
--
-- /See:/ 'newGetWebhook' smart constructor.
data GetWebhook = GetWebhook'
  { -- | The unique ID for a webhook.
    GetWebhook -> Text
webhookId :: Prelude.Text
  }
  deriving (GetWebhook -> GetWebhook -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWebhook -> GetWebhook -> Bool
$c/= :: GetWebhook -> GetWebhook -> Bool
== :: GetWebhook -> GetWebhook -> Bool
$c== :: GetWebhook -> GetWebhook -> Bool
Prelude.Eq, ReadPrec [GetWebhook]
ReadPrec GetWebhook
Int -> ReadS GetWebhook
ReadS [GetWebhook]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWebhook]
$creadListPrec :: ReadPrec [GetWebhook]
readPrec :: ReadPrec GetWebhook
$creadPrec :: ReadPrec GetWebhook
readList :: ReadS [GetWebhook]
$creadList :: ReadS [GetWebhook]
readsPrec :: Int -> ReadS GetWebhook
$creadsPrec :: Int -> ReadS GetWebhook
Prelude.Read, Int -> GetWebhook -> ShowS
[GetWebhook] -> ShowS
GetWebhook -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWebhook] -> ShowS
$cshowList :: [GetWebhook] -> ShowS
show :: GetWebhook -> String
$cshow :: GetWebhook -> String
showsPrec :: Int -> GetWebhook -> ShowS
$cshowsPrec :: Int -> GetWebhook -> ShowS
Prelude.Show, forall x. Rep GetWebhook x -> GetWebhook
forall x. GetWebhook -> Rep GetWebhook x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetWebhook x -> GetWebhook
$cfrom :: forall x. GetWebhook -> Rep GetWebhook x
Prelude.Generic)

-- |
-- Create a value of 'GetWebhook' 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:
--
-- 'webhookId', 'getWebhook_webhookId' - The unique ID for a webhook.
newGetWebhook ::
  -- | 'webhookId'
  Prelude.Text ->
  GetWebhook
newGetWebhook :: Text -> GetWebhook
newGetWebhook Text
pWebhookId_ =
  GetWebhook' {$sel:webhookId:GetWebhook' :: Text
webhookId = Text
pWebhookId_}

-- | The unique ID for a webhook.
getWebhook_webhookId :: Lens.Lens' GetWebhook Prelude.Text
getWebhook_webhookId :: Lens' GetWebhook Text
getWebhook_webhookId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWebhook' {Text
webhookId :: Text
$sel:webhookId:GetWebhook' :: GetWebhook -> Text
webhookId} -> Text
webhookId) (\s :: GetWebhook
s@GetWebhook' {} Text
a -> GetWebhook
s {$sel:webhookId:GetWebhook' :: Text
webhookId = Text
a} :: GetWebhook)

instance Core.AWSRequest GetWebhook where
  type AWSResponse GetWebhook = GetWebhookResponse
  request :: (Service -> Service) -> GetWebhook -> Request GetWebhook
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetWebhook
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetWebhook)))
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 -> GetWebhookResponse
GetWebhookResponse'
            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 GetWebhook where
  hashWithSalt :: Int -> GetWebhook -> Int
hashWithSalt Int
_salt GetWebhook' {Text
webhookId :: Text
$sel:webhookId:GetWebhook' :: GetWebhook -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
webhookId

instance Prelude.NFData GetWebhook where
  rnf :: GetWebhook -> ()
rnf GetWebhook' {Text
webhookId :: Text
$sel:webhookId:GetWebhook' :: GetWebhook -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
webhookId

instance Data.ToHeaders GetWebhook where
  toHeaders :: GetWebhook -> 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.ToPath GetWebhook where
  toPath :: GetWebhook -> ByteString
toPath GetWebhook' {Text
webhookId :: Text
$sel:webhookId:GetWebhook' :: GetWebhook -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/webhooks/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
webhookId]

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

-- | The result structure for the get webhook request.
--
-- /See:/ 'newGetWebhookResponse' smart constructor.
data GetWebhookResponse = GetWebhookResponse'
  { -- | The response's http status code.
    GetWebhookResponse -> Int
httpStatus :: Prelude.Int,
    -- | Describes the structure of a webhook.
    GetWebhookResponse -> Webhook
webhook :: Webhook
  }
  deriving (GetWebhookResponse -> GetWebhookResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetWebhookResponse -> GetWebhookResponse -> Bool
$c/= :: GetWebhookResponse -> GetWebhookResponse -> Bool
== :: GetWebhookResponse -> GetWebhookResponse -> Bool
$c== :: GetWebhookResponse -> GetWebhookResponse -> Bool
Prelude.Eq, ReadPrec [GetWebhookResponse]
ReadPrec GetWebhookResponse
Int -> ReadS GetWebhookResponse
ReadS [GetWebhookResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetWebhookResponse]
$creadListPrec :: ReadPrec [GetWebhookResponse]
readPrec :: ReadPrec GetWebhookResponse
$creadPrec :: ReadPrec GetWebhookResponse
readList :: ReadS [GetWebhookResponse]
$creadList :: ReadS [GetWebhookResponse]
readsPrec :: Int -> ReadS GetWebhookResponse
$creadsPrec :: Int -> ReadS GetWebhookResponse
Prelude.Read, Int -> GetWebhookResponse -> ShowS
[GetWebhookResponse] -> ShowS
GetWebhookResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetWebhookResponse] -> ShowS
$cshowList :: [GetWebhookResponse] -> ShowS
show :: GetWebhookResponse -> String
$cshow :: GetWebhookResponse -> String
showsPrec :: Int -> GetWebhookResponse -> ShowS
$cshowsPrec :: Int -> GetWebhookResponse -> ShowS
Prelude.Show, forall x. Rep GetWebhookResponse x -> GetWebhookResponse
forall x. GetWebhookResponse -> Rep GetWebhookResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetWebhookResponse x -> GetWebhookResponse
$cfrom :: forall x. GetWebhookResponse -> Rep GetWebhookResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetWebhookResponse' 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', 'getWebhookResponse_httpStatus' - The response's http status code.
--
-- 'webhook', 'getWebhookResponse_webhook' - Describes the structure of a webhook.
newGetWebhookResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'webhook'
  Webhook ->
  GetWebhookResponse
newGetWebhookResponse :: Int -> Webhook -> GetWebhookResponse
newGetWebhookResponse Int
pHttpStatus_ Webhook
pWebhook_ =
  GetWebhookResponse'
    { $sel:httpStatus:GetWebhookResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:webhook:GetWebhookResponse' :: Webhook
webhook = Webhook
pWebhook_
    }

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

-- | Describes the structure of a webhook.
getWebhookResponse_webhook :: Lens.Lens' GetWebhookResponse Webhook
getWebhookResponse_webhook :: Lens' GetWebhookResponse Webhook
getWebhookResponse_webhook = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetWebhookResponse' {Webhook
webhook :: Webhook
$sel:webhook:GetWebhookResponse' :: GetWebhookResponse -> Webhook
webhook} -> Webhook
webhook) (\s :: GetWebhookResponse
s@GetWebhookResponse' {} Webhook
a -> GetWebhookResponse
s {$sel:webhook:GetWebhookResponse' :: Webhook
webhook = Webhook
a} :: GetWebhookResponse)

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