{-# 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.SSM.PutResourcePolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates or updates a Systems Manager resource policy. A resource policy
-- helps you to define the IAM entity (for example, an Amazon Web Services
-- account) that can manage your Systems Manager resources. Currently,
-- @OpsItemGroup@ is the only resource that supports Systems Manager
-- resource policies. The resource policy for @OpsItemGroup@ enables Amazon
-- Web Services accounts to view and interact with OpsCenter operational
-- work items (OpsItems).
module Amazonka.SSM.PutResourcePolicy
  ( -- * Creating a Request
    PutResourcePolicy (..),
    newPutResourcePolicy,

    -- * Request Lenses
    putResourcePolicy_policyHash,
    putResourcePolicy_policyId,
    putResourcePolicy_resourceArn,
    putResourcePolicy_policy,

    -- * Destructuring the Response
    PutResourcePolicyResponse (..),
    newPutResourcePolicyResponse,

    -- * Response Lenses
    putResourcePolicyResponse_policyHash,
    putResourcePolicyResponse_policyId,
    putResourcePolicyResponse_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.SSM.Types

-- | /See:/ 'newPutResourcePolicy' smart constructor.
data PutResourcePolicy = PutResourcePolicy'
  { -- | ID of the current policy version. The hash helps to prevent a situation
    -- where multiple users attempt to overwrite a policy. You must provide
    -- this hash when updating or deleting a policy.
    PutResourcePolicy -> Maybe Text
policyHash :: Prelude.Maybe Prelude.Text,
    -- | The policy ID.
    PutResourcePolicy -> Maybe Text
policyId :: Prelude.Maybe Prelude.Text,
    -- | Amazon Resource Name (ARN) of the resource to which you want to attach a
    -- policy.
    PutResourcePolicy -> Text
resourceArn :: Prelude.Text,
    -- | A policy you want to associate with a resource.
    PutResourcePolicy -> Text
policy :: Prelude.Text
  }
  deriving (PutResourcePolicy -> PutResourcePolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutResourcePolicy -> PutResourcePolicy -> Bool
$c/= :: PutResourcePolicy -> PutResourcePolicy -> Bool
== :: PutResourcePolicy -> PutResourcePolicy -> Bool
$c== :: PutResourcePolicy -> PutResourcePolicy -> Bool
Prelude.Eq, ReadPrec [PutResourcePolicy]
ReadPrec PutResourcePolicy
Int -> ReadS PutResourcePolicy
ReadS [PutResourcePolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutResourcePolicy]
$creadListPrec :: ReadPrec [PutResourcePolicy]
readPrec :: ReadPrec PutResourcePolicy
$creadPrec :: ReadPrec PutResourcePolicy
readList :: ReadS [PutResourcePolicy]
$creadList :: ReadS [PutResourcePolicy]
readsPrec :: Int -> ReadS PutResourcePolicy
$creadsPrec :: Int -> ReadS PutResourcePolicy
Prelude.Read, Int -> PutResourcePolicy -> ShowS
[PutResourcePolicy] -> ShowS
PutResourcePolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutResourcePolicy] -> ShowS
$cshowList :: [PutResourcePolicy] -> ShowS
show :: PutResourcePolicy -> String
$cshow :: PutResourcePolicy -> String
showsPrec :: Int -> PutResourcePolicy -> ShowS
$cshowsPrec :: Int -> PutResourcePolicy -> ShowS
Prelude.Show, forall x. Rep PutResourcePolicy x -> PutResourcePolicy
forall x. PutResourcePolicy -> Rep PutResourcePolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutResourcePolicy x -> PutResourcePolicy
$cfrom :: forall x. PutResourcePolicy -> Rep PutResourcePolicy x
Prelude.Generic)

-- |
-- Create a value of 'PutResourcePolicy' 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:
--
-- 'policyHash', 'putResourcePolicy_policyHash' - ID of the current policy version. The hash helps to prevent a situation
-- where multiple users attempt to overwrite a policy. You must provide
-- this hash when updating or deleting a policy.
--
-- 'policyId', 'putResourcePolicy_policyId' - The policy ID.
--
-- 'resourceArn', 'putResourcePolicy_resourceArn' - Amazon Resource Name (ARN) of the resource to which you want to attach a
-- policy.
--
-- 'policy', 'putResourcePolicy_policy' - A policy you want to associate with a resource.
newPutResourcePolicy ::
  -- | 'resourceArn'
  Prelude.Text ->
  -- | 'policy'
  Prelude.Text ->
  PutResourcePolicy
newPutResourcePolicy :: Text -> Text -> PutResourcePolicy
newPutResourcePolicy Text
pResourceArn_ Text
pPolicy_ =
  PutResourcePolicy'
    { $sel:policyHash:PutResourcePolicy' :: Maybe Text
policyHash = forall a. Maybe a
Prelude.Nothing,
      $sel:policyId:PutResourcePolicy' :: Maybe Text
policyId = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceArn:PutResourcePolicy' :: Text
resourceArn = Text
pResourceArn_,
      $sel:policy:PutResourcePolicy' :: Text
policy = Text
pPolicy_
    }

-- | ID of the current policy version. The hash helps to prevent a situation
-- where multiple users attempt to overwrite a policy. You must provide
-- this hash when updating or deleting a policy.
putResourcePolicy_policyHash :: Lens.Lens' PutResourcePolicy (Prelude.Maybe Prelude.Text)
putResourcePolicy_policyHash :: Lens' PutResourcePolicy (Maybe Text)
putResourcePolicy_policyHash = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourcePolicy' {Maybe Text
policyHash :: Maybe Text
$sel:policyHash:PutResourcePolicy' :: PutResourcePolicy -> Maybe Text
policyHash} -> Maybe Text
policyHash) (\s :: PutResourcePolicy
s@PutResourcePolicy' {} Maybe Text
a -> PutResourcePolicy
s {$sel:policyHash:PutResourcePolicy' :: Maybe Text
policyHash = Maybe Text
a} :: PutResourcePolicy)

-- | The policy ID.
putResourcePolicy_policyId :: Lens.Lens' PutResourcePolicy (Prelude.Maybe Prelude.Text)
putResourcePolicy_policyId :: Lens' PutResourcePolicy (Maybe Text)
putResourcePolicy_policyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourcePolicy' {Maybe Text
policyId :: Maybe Text
$sel:policyId:PutResourcePolicy' :: PutResourcePolicy -> Maybe Text
policyId} -> Maybe Text
policyId) (\s :: PutResourcePolicy
s@PutResourcePolicy' {} Maybe Text
a -> PutResourcePolicy
s {$sel:policyId:PutResourcePolicy' :: Maybe Text
policyId = Maybe Text
a} :: PutResourcePolicy)

-- | Amazon Resource Name (ARN) of the resource to which you want to attach a
-- policy.
putResourcePolicy_resourceArn :: Lens.Lens' PutResourcePolicy Prelude.Text
putResourcePolicy_resourceArn :: Lens' PutResourcePolicy Text
putResourcePolicy_resourceArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourcePolicy' {Text
resourceArn :: Text
$sel:resourceArn:PutResourcePolicy' :: PutResourcePolicy -> Text
resourceArn} -> Text
resourceArn) (\s :: PutResourcePolicy
s@PutResourcePolicy' {} Text
a -> PutResourcePolicy
s {$sel:resourceArn:PutResourcePolicy' :: Text
resourceArn = Text
a} :: PutResourcePolicy)

-- | A policy you want to associate with a resource.
putResourcePolicy_policy :: Lens.Lens' PutResourcePolicy Prelude.Text
putResourcePolicy_policy :: Lens' PutResourcePolicy Text
putResourcePolicy_policy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourcePolicy' {Text
policy :: Text
$sel:policy:PutResourcePolicy' :: PutResourcePolicy -> Text
policy} -> Text
policy) (\s :: PutResourcePolicy
s@PutResourcePolicy' {} Text
a -> PutResourcePolicy
s {$sel:policy:PutResourcePolicy' :: Text
policy = Text
a} :: PutResourcePolicy)

instance Core.AWSRequest PutResourcePolicy where
  type
    AWSResponse PutResourcePolicy =
      PutResourcePolicyResponse
  request :: (Service -> Service)
-> PutResourcePolicy -> Request PutResourcePolicy
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 PutResourcePolicy
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutResourcePolicy)))
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 Text -> Maybe Text -> Int -> PutResourcePolicyResponse
PutResourcePolicyResponse'
            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
"PolicyHash")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PolicyId")
            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 PutResourcePolicy where
  hashWithSalt :: Int -> PutResourcePolicy -> Int
hashWithSalt Int
_salt PutResourcePolicy' {Maybe Text
Text
policy :: Text
resourceArn :: Text
policyId :: Maybe Text
policyHash :: Maybe Text
$sel:policy:PutResourcePolicy' :: PutResourcePolicy -> Text
$sel:resourceArn:PutResourcePolicy' :: PutResourcePolicy -> Text
$sel:policyId:PutResourcePolicy' :: PutResourcePolicy -> Maybe Text
$sel:policyHash:PutResourcePolicy' :: PutResourcePolicy -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
policyHash
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
policyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
policy

instance Prelude.NFData PutResourcePolicy where
  rnf :: PutResourcePolicy -> ()
rnf PutResourcePolicy' {Maybe Text
Text
policy :: Text
resourceArn :: Text
policyId :: Maybe Text
policyHash :: Maybe Text
$sel:policy:PutResourcePolicy' :: PutResourcePolicy -> Text
$sel:resourceArn:PutResourcePolicy' :: PutResourcePolicy -> Text
$sel:policyId:PutResourcePolicy' :: PutResourcePolicy -> Maybe Text
$sel:policyHash:PutResourcePolicy' :: PutResourcePolicy -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policyHash
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
policy

instance Data.ToHeaders PutResourcePolicy where
  toHeaders :: PutResourcePolicy -> 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
"AmazonSSM.PutResourcePolicy" ::
                          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 PutResourcePolicy where
  toJSON :: PutResourcePolicy -> Value
toJSON PutResourcePolicy' {Maybe Text
Text
policy :: Text
resourceArn :: Text
policyId :: Maybe Text
policyHash :: Maybe Text
$sel:policy:PutResourcePolicy' :: PutResourcePolicy -> Text
$sel:resourceArn:PutResourcePolicy' :: PutResourcePolicy -> Text
$sel:policyId:PutResourcePolicy' :: PutResourcePolicy -> Maybe Text
$sel:policyHash:PutResourcePolicy' :: PutResourcePolicy -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"PolicyHash" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
policyHash,
            (Key
"PolicyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
policyId,
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"Policy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
policy)
          ]
      )

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

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

-- | /See:/ 'newPutResourcePolicyResponse' smart constructor.
data PutResourcePolicyResponse = PutResourcePolicyResponse'
  { -- | ID of the current policy version.
    PutResourcePolicyResponse -> Maybe Text
policyHash :: Prelude.Maybe Prelude.Text,
    -- | The policy ID. To update a policy, you must specify @PolicyId@ and
    -- @PolicyHash@.
    PutResourcePolicyResponse -> Maybe Text
policyId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PutResourcePolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutResourcePolicyResponse -> PutResourcePolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutResourcePolicyResponse -> PutResourcePolicyResponse -> Bool
$c/= :: PutResourcePolicyResponse -> PutResourcePolicyResponse -> Bool
== :: PutResourcePolicyResponse -> PutResourcePolicyResponse -> Bool
$c== :: PutResourcePolicyResponse -> PutResourcePolicyResponse -> Bool
Prelude.Eq, ReadPrec [PutResourcePolicyResponse]
ReadPrec PutResourcePolicyResponse
Int -> ReadS PutResourcePolicyResponse
ReadS [PutResourcePolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutResourcePolicyResponse]
$creadListPrec :: ReadPrec [PutResourcePolicyResponse]
readPrec :: ReadPrec PutResourcePolicyResponse
$creadPrec :: ReadPrec PutResourcePolicyResponse
readList :: ReadS [PutResourcePolicyResponse]
$creadList :: ReadS [PutResourcePolicyResponse]
readsPrec :: Int -> ReadS PutResourcePolicyResponse
$creadsPrec :: Int -> ReadS PutResourcePolicyResponse
Prelude.Read, Int -> PutResourcePolicyResponse -> ShowS
[PutResourcePolicyResponse] -> ShowS
PutResourcePolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutResourcePolicyResponse] -> ShowS
$cshowList :: [PutResourcePolicyResponse] -> ShowS
show :: PutResourcePolicyResponse -> String
$cshow :: PutResourcePolicyResponse -> String
showsPrec :: Int -> PutResourcePolicyResponse -> ShowS
$cshowsPrec :: Int -> PutResourcePolicyResponse -> ShowS
Prelude.Show, forall x.
Rep PutResourcePolicyResponse x -> PutResourcePolicyResponse
forall x.
PutResourcePolicyResponse -> Rep PutResourcePolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutResourcePolicyResponse x -> PutResourcePolicyResponse
$cfrom :: forall x.
PutResourcePolicyResponse -> Rep PutResourcePolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutResourcePolicyResponse' 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:
--
-- 'policyHash', 'putResourcePolicyResponse_policyHash' - ID of the current policy version.
--
-- 'policyId', 'putResourcePolicyResponse_policyId' - The policy ID. To update a policy, you must specify @PolicyId@ and
-- @PolicyHash@.
--
-- 'httpStatus', 'putResourcePolicyResponse_httpStatus' - The response's http status code.
newPutResourcePolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutResourcePolicyResponse
newPutResourcePolicyResponse :: Int -> PutResourcePolicyResponse
newPutResourcePolicyResponse Int
pHttpStatus_ =
  PutResourcePolicyResponse'
    { $sel:policyHash:PutResourcePolicyResponse' :: Maybe Text
policyHash =
        forall a. Maybe a
Prelude.Nothing,
      $sel:policyId:PutResourcePolicyResponse' :: Maybe Text
policyId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutResourcePolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | ID of the current policy version.
putResourcePolicyResponse_policyHash :: Lens.Lens' PutResourcePolicyResponse (Prelude.Maybe Prelude.Text)
putResourcePolicyResponse_policyHash :: Lens' PutResourcePolicyResponse (Maybe Text)
putResourcePolicyResponse_policyHash = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourcePolicyResponse' {Maybe Text
policyHash :: Maybe Text
$sel:policyHash:PutResourcePolicyResponse' :: PutResourcePolicyResponse -> Maybe Text
policyHash} -> Maybe Text
policyHash) (\s :: PutResourcePolicyResponse
s@PutResourcePolicyResponse' {} Maybe Text
a -> PutResourcePolicyResponse
s {$sel:policyHash:PutResourcePolicyResponse' :: Maybe Text
policyHash = Maybe Text
a} :: PutResourcePolicyResponse)

-- | The policy ID. To update a policy, you must specify @PolicyId@ and
-- @PolicyHash@.
putResourcePolicyResponse_policyId :: Lens.Lens' PutResourcePolicyResponse (Prelude.Maybe Prelude.Text)
putResourcePolicyResponse_policyId :: Lens' PutResourcePolicyResponse (Maybe Text)
putResourcePolicyResponse_policyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutResourcePolicyResponse' {Maybe Text
policyId :: Maybe Text
$sel:policyId:PutResourcePolicyResponse' :: PutResourcePolicyResponse -> Maybe Text
policyId} -> Maybe Text
policyId) (\s :: PutResourcePolicyResponse
s@PutResourcePolicyResponse' {} Maybe Text
a -> PutResourcePolicyResponse
s {$sel:policyId:PutResourcePolicyResponse' :: Maybe Text
policyId = Maybe Text
a} :: PutResourcePolicyResponse)

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

instance Prelude.NFData PutResourcePolicyResponse where
  rnf :: PutResourcePolicyResponse -> ()
rnf PutResourcePolicyResponse' {Int
Maybe Text
httpStatus :: Int
policyId :: Maybe Text
policyHash :: Maybe Text
$sel:httpStatus:PutResourcePolicyResponse' :: PutResourcePolicyResponse -> Int
$sel:policyId:PutResourcePolicyResponse' :: PutResourcePolicyResponse -> Maybe Text
$sel:policyHash:PutResourcePolicyResponse' :: PutResourcePolicyResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policyHash
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
policyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus