{-# 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.CodeGuruProfiler.GetNotificationConfiguration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get the current configuration for anomaly notifications for a profiling
-- group.
module Amazonka.CodeGuruProfiler.GetNotificationConfiguration
  ( -- * Creating a Request
    GetNotificationConfiguration (..),
    newGetNotificationConfiguration,

    -- * Request Lenses
    getNotificationConfiguration_profilingGroupName,

    -- * Destructuring the Response
    GetNotificationConfigurationResponse (..),
    newGetNotificationConfigurationResponse,

    -- * Response Lenses
    getNotificationConfigurationResponse_httpStatus,
    getNotificationConfigurationResponse_notificationConfiguration,
  )
where

import Amazonka.CodeGuruProfiler.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 structure representing the GetNotificationConfigurationRequest.
--
-- /See:/ 'newGetNotificationConfiguration' smart constructor.
data GetNotificationConfiguration = GetNotificationConfiguration'
  { -- | The name of the profiling group we want to get the notification
    -- configuration for.
    GetNotificationConfiguration -> Text
profilingGroupName :: Prelude.Text
  }
  deriving (GetNotificationConfiguration
-> GetNotificationConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetNotificationConfiguration
-> GetNotificationConfiguration -> Bool
$c/= :: GetNotificationConfiguration
-> GetNotificationConfiguration -> Bool
== :: GetNotificationConfiguration
-> GetNotificationConfiguration -> Bool
$c== :: GetNotificationConfiguration
-> GetNotificationConfiguration -> Bool
Prelude.Eq, ReadPrec [GetNotificationConfiguration]
ReadPrec GetNotificationConfiguration
Int -> ReadS GetNotificationConfiguration
ReadS [GetNotificationConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetNotificationConfiguration]
$creadListPrec :: ReadPrec [GetNotificationConfiguration]
readPrec :: ReadPrec GetNotificationConfiguration
$creadPrec :: ReadPrec GetNotificationConfiguration
readList :: ReadS [GetNotificationConfiguration]
$creadList :: ReadS [GetNotificationConfiguration]
readsPrec :: Int -> ReadS GetNotificationConfiguration
$creadsPrec :: Int -> ReadS GetNotificationConfiguration
Prelude.Read, Int -> GetNotificationConfiguration -> ShowS
[GetNotificationConfiguration] -> ShowS
GetNotificationConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetNotificationConfiguration] -> ShowS
$cshowList :: [GetNotificationConfiguration] -> ShowS
show :: GetNotificationConfiguration -> String
$cshow :: GetNotificationConfiguration -> String
showsPrec :: Int -> GetNotificationConfiguration -> ShowS
$cshowsPrec :: Int -> GetNotificationConfiguration -> ShowS
Prelude.Show, forall x.
Rep GetNotificationConfiguration x -> GetNotificationConfiguration
forall x.
GetNotificationConfiguration -> Rep GetNotificationConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetNotificationConfiguration x -> GetNotificationConfiguration
$cfrom :: forall x.
GetNotificationConfiguration -> Rep GetNotificationConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'GetNotificationConfiguration' 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:
--
-- 'profilingGroupName', 'getNotificationConfiguration_profilingGroupName' - The name of the profiling group we want to get the notification
-- configuration for.
newGetNotificationConfiguration ::
  -- | 'profilingGroupName'
  Prelude.Text ->
  GetNotificationConfiguration
newGetNotificationConfiguration :: Text -> GetNotificationConfiguration
newGetNotificationConfiguration Text
pProfilingGroupName_ =
  GetNotificationConfiguration'
    { $sel:profilingGroupName:GetNotificationConfiguration' :: Text
profilingGroupName =
        Text
pProfilingGroupName_
    }

-- | The name of the profiling group we want to get the notification
-- configuration for.
getNotificationConfiguration_profilingGroupName :: Lens.Lens' GetNotificationConfiguration Prelude.Text
getNotificationConfiguration_profilingGroupName :: Lens' GetNotificationConfiguration Text
getNotificationConfiguration_profilingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetNotificationConfiguration' {Text
profilingGroupName :: Text
$sel:profilingGroupName:GetNotificationConfiguration' :: GetNotificationConfiguration -> Text
profilingGroupName} -> Text
profilingGroupName) (\s :: GetNotificationConfiguration
s@GetNotificationConfiguration' {} Text
a -> GetNotificationConfiguration
s {$sel:profilingGroupName:GetNotificationConfiguration' :: Text
profilingGroupName = Text
a} :: GetNotificationConfiguration)

instance Core.AWSRequest GetNotificationConfiguration where
  type
    AWSResponse GetNotificationConfiguration =
      GetNotificationConfigurationResponse
  request :: (Service -> Service)
-> GetNotificationConfiguration
-> Request GetNotificationConfiguration
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 GetNotificationConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetNotificationConfiguration)))
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
-> NotificationConfiguration
-> GetNotificationConfigurationResponse
GetNotificationConfigurationResponse'
            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
"notificationConfiguration")
      )

instance
  Prelude.Hashable
    GetNotificationConfiguration
  where
  hashWithSalt :: Int -> GetNotificationConfiguration -> Int
hashWithSalt Int
_salt GetNotificationConfiguration' {Text
profilingGroupName :: Text
$sel:profilingGroupName:GetNotificationConfiguration' :: GetNotificationConfiguration -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profilingGroupName

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

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

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

-- | The structure representing the GetNotificationConfigurationResponse.
--
-- /See:/ 'newGetNotificationConfigurationResponse' smart constructor.
data GetNotificationConfigurationResponse = GetNotificationConfigurationResponse'
  { -- | The response's http status code.
    GetNotificationConfigurationResponse -> Int
httpStatus :: Prelude.Int,
    -- | The current notification configuration for this profiling group.
    GetNotificationConfigurationResponse -> NotificationConfiguration
notificationConfiguration :: NotificationConfiguration
  }
  deriving (GetNotificationConfigurationResponse
-> GetNotificationConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetNotificationConfigurationResponse
-> GetNotificationConfigurationResponse -> Bool
$c/= :: GetNotificationConfigurationResponse
-> GetNotificationConfigurationResponse -> Bool
== :: GetNotificationConfigurationResponse
-> GetNotificationConfigurationResponse -> Bool
$c== :: GetNotificationConfigurationResponse
-> GetNotificationConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [GetNotificationConfigurationResponse]
ReadPrec GetNotificationConfigurationResponse
Int -> ReadS GetNotificationConfigurationResponse
ReadS [GetNotificationConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetNotificationConfigurationResponse]
$creadListPrec :: ReadPrec [GetNotificationConfigurationResponse]
readPrec :: ReadPrec GetNotificationConfigurationResponse
$creadPrec :: ReadPrec GetNotificationConfigurationResponse
readList :: ReadS [GetNotificationConfigurationResponse]
$creadList :: ReadS [GetNotificationConfigurationResponse]
readsPrec :: Int -> ReadS GetNotificationConfigurationResponse
$creadsPrec :: Int -> ReadS GetNotificationConfigurationResponse
Prelude.Read, Int -> GetNotificationConfigurationResponse -> ShowS
[GetNotificationConfigurationResponse] -> ShowS
GetNotificationConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetNotificationConfigurationResponse] -> ShowS
$cshowList :: [GetNotificationConfigurationResponse] -> ShowS
show :: GetNotificationConfigurationResponse -> String
$cshow :: GetNotificationConfigurationResponse -> String
showsPrec :: Int -> GetNotificationConfigurationResponse -> ShowS
$cshowsPrec :: Int -> GetNotificationConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep GetNotificationConfigurationResponse x
-> GetNotificationConfigurationResponse
forall x.
GetNotificationConfigurationResponse
-> Rep GetNotificationConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetNotificationConfigurationResponse x
-> GetNotificationConfigurationResponse
$cfrom :: forall x.
GetNotificationConfigurationResponse
-> Rep GetNotificationConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetNotificationConfigurationResponse' 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', 'getNotificationConfigurationResponse_httpStatus' - The response's http status code.
--
-- 'notificationConfiguration', 'getNotificationConfigurationResponse_notificationConfiguration' - The current notification configuration for this profiling group.
newGetNotificationConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'notificationConfiguration'
  NotificationConfiguration ->
  GetNotificationConfigurationResponse
newGetNotificationConfigurationResponse :: Int
-> NotificationConfiguration
-> GetNotificationConfigurationResponse
newGetNotificationConfigurationResponse
  Int
pHttpStatus_
  NotificationConfiguration
pNotificationConfiguration_ =
    GetNotificationConfigurationResponse'
      { $sel:httpStatus:GetNotificationConfigurationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:notificationConfiguration:GetNotificationConfigurationResponse' :: NotificationConfiguration
notificationConfiguration =
          NotificationConfiguration
pNotificationConfiguration_
      }

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

-- | The current notification configuration for this profiling group.
getNotificationConfigurationResponse_notificationConfiguration :: Lens.Lens' GetNotificationConfigurationResponse NotificationConfiguration
getNotificationConfigurationResponse_notificationConfiguration :: Lens'
  GetNotificationConfigurationResponse NotificationConfiguration
getNotificationConfigurationResponse_notificationConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetNotificationConfigurationResponse' {NotificationConfiguration
notificationConfiguration :: NotificationConfiguration
$sel:notificationConfiguration:GetNotificationConfigurationResponse' :: GetNotificationConfigurationResponse -> NotificationConfiguration
notificationConfiguration} -> NotificationConfiguration
notificationConfiguration) (\s :: GetNotificationConfigurationResponse
s@GetNotificationConfigurationResponse' {} NotificationConfiguration
a -> GetNotificationConfigurationResponse
s {$sel:notificationConfiguration:GetNotificationConfigurationResponse' :: NotificationConfiguration
notificationConfiguration = NotificationConfiguration
a} :: GetNotificationConfigurationResponse)

instance
  Prelude.NFData
    GetNotificationConfigurationResponse
  where
  rnf :: GetNotificationConfigurationResponse -> ()
rnf GetNotificationConfigurationResponse' {Int
NotificationConfiguration
notificationConfiguration :: NotificationConfiguration
httpStatus :: Int
$sel:notificationConfiguration:GetNotificationConfigurationResponse' :: GetNotificationConfigurationResponse -> NotificationConfiguration
$sel:httpStatus:GetNotificationConfigurationResponse' :: GetNotificationConfigurationResponse -> 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 NotificationConfiguration
notificationConfiguration