{-# 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.AddNotificationChannels
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Add up to 2 anomaly notifications channels for a profiling group.
module Amazonka.CodeGuruProfiler.AddNotificationChannels
  ( -- * Creating a Request
    AddNotificationChannels (..),
    newAddNotificationChannels,

    -- * Request Lenses
    addNotificationChannels_channels,
    addNotificationChannels_profilingGroupName,

    -- * Destructuring the Response
    AddNotificationChannelsResponse (..),
    newAddNotificationChannelsResponse,

    -- * Response Lenses
    addNotificationChannelsResponse_notificationConfiguration,
    addNotificationChannelsResponse_httpStatus,
  )
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 AddNotificationChannelsRequest.
--
-- /See:/ 'newAddNotificationChannels' smart constructor.
data AddNotificationChannels = AddNotificationChannels'
  { -- | One or 2 channels to report to when anomalies are detected.
    AddNotificationChannels -> NonEmpty Channel
channels :: Prelude.NonEmpty Channel,
    -- | The name of the profiling group that we are setting up notifications
    -- for.
    AddNotificationChannels -> Text
profilingGroupName :: Prelude.Text
  }
  deriving (AddNotificationChannels -> AddNotificationChannels -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AddNotificationChannels -> AddNotificationChannels -> Bool
$c/= :: AddNotificationChannels -> AddNotificationChannels -> Bool
== :: AddNotificationChannels -> AddNotificationChannels -> Bool
$c== :: AddNotificationChannels -> AddNotificationChannels -> Bool
Prelude.Eq, ReadPrec [AddNotificationChannels]
ReadPrec AddNotificationChannels
Int -> ReadS AddNotificationChannels
ReadS [AddNotificationChannels]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AddNotificationChannels]
$creadListPrec :: ReadPrec [AddNotificationChannels]
readPrec :: ReadPrec AddNotificationChannels
$creadPrec :: ReadPrec AddNotificationChannels
readList :: ReadS [AddNotificationChannels]
$creadList :: ReadS [AddNotificationChannels]
readsPrec :: Int -> ReadS AddNotificationChannels
$creadsPrec :: Int -> ReadS AddNotificationChannels
Prelude.Read, Int -> AddNotificationChannels -> ShowS
[AddNotificationChannels] -> ShowS
AddNotificationChannels -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AddNotificationChannels] -> ShowS
$cshowList :: [AddNotificationChannels] -> ShowS
show :: AddNotificationChannels -> String
$cshow :: AddNotificationChannels -> String
showsPrec :: Int -> AddNotificationChannels -> ShowS
$cshowsPrec :: Int -> AddNotificationChannels -> ShowS
Prelude.Show, forall x. Rep AddNotificationChannels x -> AddNotificationChannels
forall x. AddNotificationChannels -> Rep AddNotificationChannels x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AddNotificationChannels x -> AddNotificationChannels
$cfrom :: forall x. AddNotificationChannels -> Rep AddNotificationChannels x
Prelude.Generic)

-- |
-- Create a value of 'AddNotificationChannels' 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:
--
-- 'channels', 'addNotificationChannels_channels' - One or 2 channels to report to when anomalies are detected.
--
-- 'profilingGroupName', 'addNotificationChannels_profilingGroupName' - The name of the profiling group that we are setting up notifications
-- for.
newAddNotificationChannels ::
  -- | 'channels'
  Prelude.NonEmpty Channel ->
  -- | 'profilingGroupName'
  Prelude.Text ->
  AddNotificationChannels
newAddNotificationChannels :: NonEmpty Channel -> Text -> AddNotificationChannels
newAddNotificationChannels
  NonEmpty Channel
pChannels_
  Text
pProfilingGroupName_ =
    AddNotificationChannels'
      { $sel:channels:AddNotificationChannels' :: NonEmpty Channel
channels =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Channel
pChannels_,
        $sel:profilingGroupName:AddNotificationChannels' :: Text
profilingGroupName = Text
pProfilingGroupName_
      }

-- | One or 2 channels to report to when anomalies are detected.
addNotificationChannels_channels :: Lens.Lens' AddNotificationChannels (Prelude.NonEmpty Channel)
addNotificationChannels_channels :: Lens' AddNotificationChannels (NonEmpty Channel)
addNotificationChannels_channels = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddNotificationChannels' {NonEmpty Channel
channels :: NonEmpty Channel
$sel:channels:AddNotificationChannels' :: AddNotificationChannels -> NonEmpty Channel
channels} -> NonEmpty Channel
channels) (\s :: AddNotificationChannels
s@AddNotificationChannels' {} NonEmpty Channel
a -> AddNotificationChannels
s {$sel:channels:AddNotificationChannels' :: NonEmpty Channel
channels = NonEmpty Channel
a} :: AddNotificationChannels) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The name of the profiling group that we are setting up notifications
-- for.
addNotificationChannels_profilingGroupName :: Lens.Lens' AddNotificationChannels Prelude.Text
addNotificationChannels_profilingGroupName :: Lens' AddNotificationChannels Text
addNotificationChannels_profilingGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddNotificationChannels' {Text
profilingGroupName :: Text
$sel:profilingGroupName:AddNotificationChannels' :: AddNotificationChannels -> Text
profilingGroupName} -> Text
profilingGroupName) (\s :: AddNotificationChannels
s@AddNotificationChannels' {} Text
a -> AddNotificationChannels
s {$sel:profilingGroupName:AddNotificationChannels' :: Text
profilingGroupName = Text
a} :: AddNotificationChannels)

instance Core.AWSRequest AddNotificationChannels where
  type
    AWSResponse AddNotificationChannels =
      AddNotificationChannelsResponse
  request :: (Service -> Service)
-> AddNotificationChannels -> Request AddNotificationChannels
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 AddNotificationChannels
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse AddNotificationChannels)))
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 NotificationConfiguration
-> Int -> AddNotificationChannelsResponse
AddNotificationChannelsResponse'
            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
"notificationConfiguration")
            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 AddNotificationChannels where
  hashWithSalt :: Int -> AddNotificationChannels -> Int
hashWithSalt Int
_salt AddNotificationChannels' {NonEmpty Channel
Text
profilingGroupName :: Text
channels :: NonEmpty Channel
$sel:profilingGroupName:AddNotificationChannels' :: AddNotificationChannels -> Text
$sel:channels:AddNotificationChannels' :: AddNotificationChannels -> NonEmpty Channel
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Channel
channels
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
profilingGroupName

instance Prelude.NFData AddNotificationChannels where
  rnf :: AddNotificationChannels -> ()
rnf AddNotificationChannels' {NonEmpty Channel
Text
profilingGroupName :: Text
channels :: NonEmpty Channel
$sel:profilingGroupName:AddNotificationChannels' :: AddNotificationChannels -> Text
$sel:channels:AddNotificationChannels' :: AddNotificationChannels -> NonEmpty Channel
..} =
    forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Channel
channels
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
profilingGroupName

instance Data.ToHeaders AddNotificationChannels where
  toHeaders :: AddNotificationChannels -> 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 AddNotificationChannels where
  toJSON :: AddNotificationChannels -> Value
toJSON AddNotificationChannels' {NonEmpty Channel
Text
profilingGroupName :: Text
channels :: NonEmpty Channel
$sel:profilingGroupName:AddNotificationChannels' :: AddNotificationChannels -> Text
$sel:channels:AddNotificationChannels' :: AddNotificationChannels -> NonEmpty Channel
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"channels" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Channel
channels)]
      )

instance Data.ToPath AddNotificationChannels where
  toPath :: AddNotificationChannels -> ByteString
toPath AddNotificationChannels' {NonEmpty Channel
Text
profilingGroupName :: Text
channels :: NonEmpty Channel
$sel:profilingGroupName:AddNotificationChannels' :: AddNotificationChannels -> Text
$sel:channels:AddNotificationChannels' :: AddNotificationChannels -> NonEmpty Channel
..} =
    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 AddNotificationChannels where
  toQuery :: AddNotificationChannels -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

-- |
-- Create a value of 'AddNotificationChannelsResponse' 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:
--
-- 'notificationConfiguration', 'addNotificationChannelsResponse_notificationConfiguration' - The new notification configuration for this profiling group.
--
-- 'httpStatus', 'addNotificationChannelsResponse_httpStatus' - The response's http status code.
newAddNotificationChannelsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AddNotificationChannelsResponse
newAddNotificationChannelsResponse :: Int -> AddNotificationChannelsResponse
newAddNotificationChannelsResponse Int
pHttpStatus_ =
  AddNotificationChannelsResponse'
    { $sel:notificationConfiguration:AddNotificationChannelsResponse' :: Maybe NotificationConfiguration
notificationConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:AddNotificationChannelsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The new notification configuration for this profiling group.
addNotificationChannelsResponse_notificationConfiguration :: Lens.Lens' AddNotificationChannelsResponse (Prelude.Maybe NotificationConfiguration)
addNotificationChannelsResponse_notificationConfiguration :: Lens'
  AddNotificationChannelsResponse (Maybe NotificationConfiguration)
addNotificationChannelsResponse_notificationConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AddNotificationChannelsResponse' {Maybe NotificationConfiguration
notificationConfiguration :: Maybe NotificationConfiguration
$sel:notificationConfiguration:AddNotificationChannelsResponse' :: AddNotificationChannelsResponse -> Maybe NotificationConfiguration
notificationConfiguration} -> Maybe NotificationConfiguration
notificationConfiguration) (\s :: AddNotificationChannelsResponse
s@AddNotificationChannelsResponse' {} Maybe NotificationConfiguration
a -> AddNotificationChannelsResponse
s {$sel:notificationConfiguration:AddNotificationChannelsResponse' :: Maybe NotificationConfiguration
notificationConfiguration = Maybe NotificationConfiguration
a} :: AddNotificationChannelsResponse)

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

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