{-# 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.Shield.AssociateProactiveEngagementDetails
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Initializes proactive engagement and sets the list of contacts for the
-- Shield Response Team (SRT) to use. You must provide at least one phone
-- number in the emergency contact list.
--
-- After you have initialized proactive engagement using this call, to
-- disable or enable proactive engagement, use the calls
-- @DisableProactiveEngagement@ and @EnableProactiveEngagement@.
--
-- This call defines the list of email addresses and phone numbers that the
-- SRT can use to contact you for escalations to the SRT and to initiate
-- proactive customer support.
--
-- The contacts that you provide in the request replace any contacts that
-- were already defined. If you already have contacts defined and want to
-- use them, retrieve the list using @DescribeEmergencyContactSettings@ and
-- then provide it to this call.
module Amazonka.Shield.AssociateProactiveEngagementDetails
  ( -- * Creating a Request
    AssociateProactiveEngagementDetails (..),
    newAssociateProactiveEngagementDetails,

    -- * Request Lenses
    associateProactiveEngagementDetails_emergencyContactList,

    -- * Destructuring the Response
    AssociateProactiveEngagementDetailsResponse (..),
    newAssociateProactiveEngagementDetailsResponse,

    -- * Response Lenses
    associateProactiveEngagementDetailsResponse_httpStatus,
  )
where

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
import Amazonka.Shield.Types

-- | /See:/ 'newAssociateProactiveEngagementDetails' smart constructor.
data AssociateProactiveEngagementDetails = AssociateProactiveEngagementDetails'
  { -- | A list of email addresses and phone numbers that the Shield Response
    -- Team (SRT) can use to contact you for escalations to the SRT and to
    -- initiate proactive customer support.
    --
    -- To enable proactive engagement, the contact list must include at least
    -- one phone number.
    --
    -- The contacts that you provide here replace any contacts that were
    -- already defined. If you already have contacts defined and want to use
    -- them, retrieve the list using @DescribeEmergencyContactSettings@ and
    -- then provide it here.
    AssociateProactiveEngagementDetails -> [EmergencyContact]
emergencyContactList :: [EmergencyContact]
  }
  deriving (AssociateProactiveEngagementDetails
-> AssociateProactiveEngagementDetails -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateProactiveEngagementDetails
-> AssociateProactiveEngagementDetails -> Bool
$c/= :: AssociateProactiveEngagementDetails
-> AssociateProactiveEngagementDetails -> Bool
== :: AssociateProactiveEngagementDetails
-> AssociateProactiveEngagementDetails -> Bool
$c== :: AssociateProactiveEngagementDetails
-> AssociateProactiveEngagementDetails -> Bool
Prelude.Eq, ReadPrec [AssociateProactiveEngagementDetails]
ReadPrec AssociateProactiveEngagementDetails
Int -> ReadS AssociateProactiveEngagementDetails
ReadS [AssociateProactiveEngagementDetails]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateProactiveEngagementDetails]
$creadListPrec :: ReadPrec [AssociateProactiveEngagementDetails]
readPrec :: ReadPrec AssociateProactiveEngagementDetails
$creadPrec :: ReadPrec AssociateProactiveEngagementDetails
readList :: ReadS [AssociateProactiveEngagementDetails]
$creadList :: ReadS [AssociateProactiveEngagementDetails]
readsPrec :: Int -> ReadS AssociateProactiveEngagementDetails
$creadsPrec :: Int -> ReadS AssociateProactiveEngagementDetails
Prelude.Read, Int -> AssociateProactiveEngagementDetails -> ShowS
[AssociateProactiveEngagementDetails] -> ShowS
AssociateProactiveEngagementDetails -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateProactiveEngagementDetails] -> ShowS
$cshowList :: [AssociateProactiveEngagementDetails] -> ShowS
show :: AssociateProactiveEngagementDetails -> String
$cshow :: AssociateProactiveEngagementDetails -> String
showsPrec :: Int -> AssociateProactiveEngagementDetails -> ShowS
$cshowsPrec :: Int -> AssociateProactiveEngagementDetails -> ShowS
Prelude.Show, forall x.
Rep AssociateProactiveEngagementDetails x
-> AssociateProactiveEngagementDetails
forall x.
AssociateProactiveEngagementDetails
-> Rep AssociateProactiveEngagementDetails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep AssociateProactiveEngagementDetails x
-> AssociateProactiveEngagementDetails
$cfrom :: forall x.
AssociateProactiveEngagementDetails
-> Rep AssociateProactiveEngagementDetails x
Prelude.Generic)

-- |
-- Create a value of 'AssociateProactiveEngagementDetails' 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:
--
-- 'emergencyContactList', 'associateProactiveEngagementDetails_emergencyContactList' - A list of email addresses and phone numbers that the Shield Response
-- Team (SRT) can use to contact you for escalations to the SRT and to
-- initiate proactive customer support.
--
-- To enable proactive engagement, the contact list must include at least
-- one phone number.
--
-- The contacts that you provide here replace any contacts that were
-- already defined. If you already have contacts defined and want to use
-- them, retrieve the list using @DescribeEmergencyContactSettings@ and
-- then provide it here.
newAssociateProactiveEngagementDetails ::
  AssociateProactiveEngagementDetails
newAssociateProactiveEngagementDetails :: AssociateProactiveEngagementDetails
newAssociateProactiveEngagementDetails =
  AssociateProactiveEngagementDetails'
    { $sel:emergencyContactList:AssociateProactiveEngagementDetails' :: [EmergencyContact]
emergencyContactList =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | A list of email addresses and phone numbers that the Shield Response
-- Team (SRT) can use to contact you for escalations to the SRT and to
-- initiate proactive customer support.
--
-- To enable proactive engagement, the contact list must include at least
-- one phone number.
--
-- The contacts that you provide here replace any contacts that were
-- already defined. If you already have contacts defined and want to use
-- them, retrieve the list using @DescribeEmergencyContactSettings@ and
-- then provide it here.
associateProactiveEngagementDetails_emergencyContactList :: Lens.Lens' AssociateProactiveEngagementDetails [EmergencyContact]
associateProactiveEngagementDetails_emergencyContactList :: Lens' AssociateProactiveEngagementDetails [EmergencyContact]
associateProactiveEngagementDetails_emergencyContactList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateProactiveEngagementDetails' {[EmergencyContact]
emergencyContactList :: [EmergencyContact]
$sel:emergencyContactList:AssociateProactiveEngagementDetails' :: AssociateProactiveEngagementDetails -> [EmergencyContact]
emergencyContactList} -> [EmergencyContact]
emergencyContactList) (\s :: AssociateProactiveEngagementDetails
s@AssociateProactiveEngagementDetails' {} [EmergencyContact]
a -> AssociateProactiveEngagementDetails
s {$sel:emergencyContactList:AssociateProactiveEngagementDetails' :: [EmergencyContact]
emergencyContactList = [EmergencyContact]
a} :: AssociateProactiveEngagementDetails) 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

instance
  Core.AWSRequest
    AssociateProactiveEngagementDetails
  where
  type
    AWSResponse AssociateProactiveEngagementDetails =
      AssociateProactiveEngagementDetailsResponse
  request :: (Service -> Service)
-> AssociateProactiveEngagementDetails
-> Request AssociateProactiveEngagementDetails
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 AssociateProactiveEngagementDetails
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse AssociateProactiveEngagementDetails)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> AssociateProactiveEngagementDetailsResponse
AssociateProactiveEngagementDetailsResponse'
            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))
      )

instance
  Prelude.Hashable
    AssociateProactiveEngagementDetails
  where
  hashWithSalt :: Int -> AssociateProactiveEngagementDetails -> Int
hashWithSalt
    Int
_salt
    AssociateProactiveEngagementDetails' {[EmergencyContact]
emergencyContactList :: [EmergencyContact]
$sel:emergencyContactList:AssociateProactiveEngagementDetails' :: AssociateProactiveEngagementDetails -> [EmergencyContact]
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [EmergencyContact]
emergencyContactList

instance
  Prelude.NFData
    AssociateProactiveEngagementDetails
  where
  rnf :: AssociateProactiveEngagementDetails -> ()
rnf AssociateProactiveEngagementDetails' {[EmergencyContact]
emergencyContactList :: [EmergencyContact]
$sel:emergencyContactList:AssociateProactiveEngagementDetails' :: AssociateProactiveEngagementDetails -> [EmergencyContact]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [EmergencyContact]
emergencyContactList

instance
  Data.ToHeaders
    AssociateProactiveEngagementDetails
  where
  toHeaders :: AssociateProactiveEngagementDetails -> 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
"AWSShield_20160616.AssociateProactiveEngagementDetails" ::
                          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
    AssociateProactiveEngagementDetails
  where
  toJSON :: AssociateProactiveEngagementDetails -> Value
toJSON AssociateProactiveEngagementDetails' {[EmergencyContact]
emergencyContactList :: [EmergencyContact]
$sel:emergencyContactList:AssociateProactiveEngagementDetails' :: AssociateProactiveEngagementDetails -> [EmergencyContact]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              ( Key
"EmergencyContactList"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [EmergencyContact]
emergencyContactList
              )
          ]
      )

instance
  Data.ToPath
    AssociateProactiveEngagementDetails
  where
  toPath :: AssociateProactiveEngagementDetails -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'AssociateProactiveEngagementDetailsResponse' 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', 'associateProactiveEngagementDetailsResponse_httpStatus' - The response's http status code.
newAssociateProactiveEngagementDetailsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  AssociateProactiveEngagementDetailsResponse
newAssociateProactiveEngagementDetailsResponse :: Int -> AssociateProactiveEngagementDetailsResponse
newAssociateProactiveEngagementDetailsResponse
  Int
pHttpStatus_ =
    AssociateProactiveEngagementDetailsResponse'
      { $sel:httpStatus:AssociateProactiveEngagementDetailsResponse' :: Int
httpStatus =
          Int
pHttpStatus_
      }

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

instance
  Prelude.NFData
    AssociateProactiveEngagementDetailsResponse
  where
  rnf :: AssociateProactiveEngagementDetailsResponse -> ()
rnf AssociateProactiveEngagementDetailsResponse' {Int
httpStatus :: Int
$sel:httpStatus:AssociateProactiveEngagementDetailsResponse' :: AssociateProactiveEngagementDetailsResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus