{-# 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.AssociateDRTRole
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Authorizes the Shield Response Team (SRT) using the specified role, to
-- access your Amazon Web Services account to assist with DDoS attack
-- mitigation during potential attacks. This enables the SRT to inspect
-- your WAF configuration and create or update WAF rules and web ACLs.
--
-- You can associate only one @RoleArn@ with your subscription. If you
-- submit an @AssociateDRTRole@ request for an account that already has an
-- associated role, the new @RoleArn@ will replace the existing @RoleArn@.
--
-- Prior to making the @AssociateDRTRole@ request, you must attach the
-- @AWSShieldDRTAccessPolicy@ managed policy to the role that you\'ll
-- specify in the request. You can access this policy in the IAM console at
-- <https://console.aws.amazon.com/iam/home?#/policies/arn:aws:iam::aws:policy/service-role/AWSShieldDRTAccessPolicy AWSShieldDRTAccessPolicy>.
-- For more information see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_manage-attach-detach.html Adding and removing IAM identity permissions>.
-- The role must also trust the service principal
-- @drt.shield.amazonaws.com@. For more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_policies_elements_principal.html IAM JSON policy elements: Principal>.
--
-- The SRT will have access only to your WAF and Shield resources. By
-- submitting this request, you authorize the SRT to inspect your WAF and
-- Shield configuration and create and update WAF rules and web ACLs on
-- your behalf. The SRT takes these actions only if explicitly authorized
-- by you.
--
-- You must have the @iam:PassRole@ permission to make an
-- @AssociateDRTRole@ request. For more information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_roles_use_passrole.html Granting a user permissions to pass a role to an Amazon Web Services service>.
--
-- To use the services of the SRT and make an @AssociateDRTRole@ request,
-- you must be subscribed to the
-- <http://aws.amazon.com/premiumsupport/business-support/ Business Support plan>
-- or the
-- <http://aws.amazon.com/premiumsupport/enterprise-support/ Enterprise Support plan>.
module Amazonka.Shield.AssociateDRTRole
  ( -- * Creating a Request
    AssociateDRTRole (..),
    newAssociateDRTRole,

    -- * Request Lenses
    associateDRTRole_roleArn,

    -- * Destructuring the Response
    AssociateDRTRoleResponse (..),
    newAssociateDRTRoleResponse,

    -- * Response Lenses
    associateDRTRoleResponse_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:/ 'newAssociateDRTRole' smart constructor.
data AssociateDRTRole = AssociateDRTRole'
  { -- | The Amazon Resource Name (ARN) of the role the SRT will use to access
    -- your Amazon Web Services account.
    --
    -- Prior to making the @AssociateDRTRole@ request, you must attach the
    -- <https://console.aws.amazon.com/iam/home?#/policies/arn:aws:iam::aws:policy/service-role/AWSShieldDRTAccessPolicy AWSShieldDRTAccessPolicy>
    -- managed policy to this role. For more information see
    -- <%20https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_manage-attach-detach.html Attaching and Detaching IAM Policies>.
    AssociateDRTRole -> Text
roleArn :: Prelude.Text
  }
  deriving (AssociateDRTRole -> AssociateDRTRole -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AssociateDRTRole -> AssociateDRTRole -> Bool
$c/= :: AssociateDRTRole -> AssociateDRTRole -> Bool
== :: AssociateDRTRole -> AssociateDRTRole -> Bool
$c== :: AssociateDRTRole -> AssociateDRTRole -> Bool
Prelude.Eq, ReadPrec [AssociateDRTRole]
ReadPrec AssociateDRTRole
Int -> ReadS AssociateDRTRole
ReadS [AssociateDRTRole]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AssociateDRTRole]
$creadListPrec :: ReadPrec [AssociateDRTRole]
readPrec :: ReadPrec AssociateDRTRole
$creadPrec :: ReadPrec AssociateDRTRole
readList :: ReadS [AssociateDRTRole]
$creadList :: ReadS [AssociateDRTRole]
readsPrec :: Int -> ReadS AssociateDRTRole
$creadsPrec :: Int -> ReadS AssociateDRTRole
Prelude.Read, Int -> AssociateDRTRole -> ShowS
[AssociateDRTRole] -> ShowS
AssociateDRTRole -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AssociateDRTRole] -> ShowS
$cshowList :: [AssociateDRTRole] -> ShowS
show :: AssociateDRTRole -> String
$cshow :: AssociateDRTRole -> String
showsPrec :: Int -> AssociateDRTRole -> ShowS
$cshowsPrec :: Int -> AssociateDRTRole -> ShowS
Prelude.Show, forall x. Rep AssociateDRTRole x -> AssociateDRTRole
forall x. AssociateDRTRole -> Rep AssociateDRTRole x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AssociateDRTRole x -> AssociateDRTRole
$cfrom :: forall x. AssociateDRTRole -> Rep AssociateDRTRole x
Prelude.Generic)

-- |
-- Create a value of 'AssociateDRTRole' 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:
--
-- 'roleArn', 'associateDRTRole_roleArn' - The Amazon Resource Name (ARN) of the role the SRT will use to access
-- your Amazon Web Services account.
--
-- Prior to making the @AssociateDRTRole@ request, you must attach the
-- <https://console.aws.amazon.com/iam/home?#/policies/arn:aws:iam::aws:policy/service-role/AWSShieldDRTAccessPolicy AWSShieldDRTAccessPolicy>
-- managed policy to this role. For more information see
-- <%20https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_manage-attach-detach.html Attaching and Detaching IAM Policies>.
newAssociateDRTRole ::
  -- | 'roleArn'
  Prelude.Text ->
  AssociateDRTRole
newAssociateDRTRole :: Text -> AssociateDRTRole
newAssociateDRTRole Text
pRoleArn_ =
  AssociateDRTRole' {$sel:roleArn:AssociateDRTRole' :: Text
roleArn = Text
pRoleArn_}

-- | The Amazon Resource Name (ARN) of the role the SRT will use to access
-- your Amazon Web Services account.
--
-- Prior to making the @AssociateDRTRole@ request, you must attach the
-- <https://console.aws.amazon.com/iam/home?#/policies/arn:aws:iam::aws:policy/service-role/AWSShieldDRTAccessPolicy AWSShieldDRTAccessPolicy>
-- managed policy to this role. For more information see
-- <%20https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_manage-attach-detach.html Attaching and Detaching IAM Policies>.
associateDRTRole_roleArn :: Lens.Lens' AssociateDRTRole Prelude.Text
associateDRTRole_roleArn :: Lens' AssociateDRTRole Text
associateDRTRole_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AssociateDRTRole' {Text
roleArn :: Text
$sel:roleArn:AssociateDRTRole' :: AssociateDRTRole -> Text
roleArn} -> Text
roleArn) (\s :: AssociateDRTRole
s@AssociateDRTRole' {} Text
a -> AssociateDRTRole
s {$sel:roleArn:AssociateDRTRole' :: Text
roleArn = Text
a} :: AssociateDRTRole)

instance Core.AWSRequest AssociateDRTRole where
  type
    AWSResponse AssociateDRTRole =
      AssociateDRTRoleResponse
  request :: (Service -> Service)
-> AssociateDRTRole -> Request AssociateDRTRole
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 AssociateDRTRole
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse AssociateDRTRole)))
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 -> AssociateDRTRoleResponse
AssociateDRTRoleResponse'
            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 AssociateDRTRole where
  hashWithSalt :: Int -> AssociateDRTRole -> Int
hashWithSalt Int
_salt AssociateDRTRole' {Text
roleArn :: Text
$sel:roleArn:AssociateDRTRole' :: AssociateDRTRole -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

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

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

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

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

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

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

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

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