{-# 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.IAM.PutRolePermissionsBoundary
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds or updates the policy that is specified as the IAM role\'s
-- permissions boundary. You can use an Amazon Web Services managed policy
-- or a customer managed policy to set the boundary for a role. Use the
-- boundary to control the maximum permissions that the role can have.
-- Setting a permissions boundary is an advanced feature that can affect
-- the permissions for the role.
--
-- You cannot set the boundary for a service-linked role.
--
-- Policies used as permissions boundaries do not provide permissions. You
-- must also attach a permissions policy to the role. To learn how the
-- effective permissions for a role are evaluated, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/reference_policies_evaluation-logic.html IAM JSON policy evaluation logic>
-- in the IAM User Guide.
module Amazonka.IAM.PutRolePermissionsBoundary
  ( -- * Creating a Request
    PutRolePermissionsBoundary (..),
    newPutRolePermissionsBoundary,

    -- * Request Lenses
    putRolePermissionsBoundary_roleName,
    putRolePermissionsBoundary_permissionsBoundary,

    -- * Destructuring the Response
    PutRolePermissionsBoundaryResponse (..),
    newPutRolePermissionsBoundaryResponse,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IAM.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newPutRolePermissionsBoundary' smart constructor.
data PutRolePermissionsBoundary = PutRolePermissionsBoundary'
  { -- | The name (friendly name, not ARN) of the IAM role for which you want to
    -- set the permissions boundary.
    PutRolePermissionsBoundary -> Text
roleName :: Prelude.Text,
    -- | The ARN of the policy that is used to set the permissions boundary for
    -- the role.
    PutRolePermissionsBoundary -> Text
permissionsBoundary :: Prelude.Text
  }
  deriving (PutRolePermissionsBoundary -> PutRolePermissionsBoundary -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutRolePermissionsBoundary -> PutRolePermissionsBoundary -> Bool
$c/= :: PutRolePermissionsBoundary -> PutRolePermissionsBoundary -> Bool
== :: PutRolePermissionsBoundary -> PutRolePermissionsBoundary -> Bool
$c== :: PutRolePermissionsBoundary -> PutRolePermissionsBoundary -> Bool
Prelude.Eq, ReadPrec [PutRolePermissionsBoundary]
ReadPrec PutRolePermissionsBoundary
Int -> ReadS PutRolePermissionsBoundary
ReadS [PutRolePermissionsBoundary]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutRolePermissionsBoundary]
$creadListPrec :: ReadPrec [PutRolePermissionsBoundary]
readPrec :: ReadPrec PutRolePermissionsBoundary
$creadPrec :: ReadPrec PutRolePermissionsBoundary
readList :: ReadS [PutRolePermissionsBoundary]
$creadList :: ReadS [PutRolePermissionsBoundary]
readsPrec :: Int -> ReadS PutRolePermissionsBoundary
$creadsPrec :: Int -> ReadS PutRolePermissionsBoundary
Prelude.Read, Int -> PutRolePermissionsBoundary -> ShowS
[PutRolePermissionsBoundary] -> ShowS
PutRolePermissionsBoundary -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutRolePermissionsBoundary] -> ShowS
$cshowList :: [PutRolePermissionsBoundary] -> ShowS
show :: PutRolePermissionsBoundary -> String
$cshow :: PutRolePermissionsBoundary -> String
showsPrec :: Int -> PutRolePermissionsBoundary -> ShowS
$cshowsPrec :: Int -> PutRolePermissionsBoundary -> ShowS
Prelude.Show, forall x.
Rep PutRolePermissionsBoundary x -> PutRolePermissionsBoundary
forall x.
PutRolePermissionsBoundary -> Rep PutRolePermissionsBoundary x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutRolePermissionsBoundary x -> PutRolePermissionsBoundary
$cfrom :: forall x.
PutRolePermissionsBoundary -> Rep PutRolePermissionsBoundary x
Prelude.Generic)

-- |
-- Create a value of 'PutRolePermissionsBoundary' 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:
--
-- 'roleName', 'putRolePermissionsBoundary_roleName' - The name (friendly name, not ARN) of the IAM role for which you want to
-- set the permissions boundary.
--
-- 'permissionsBoundary', 'putRolePermissionsBoundary_permissionsBoundary' - The ARN of the policy that is used to set the permissions boundary for
-- the role.
newPutRolePermissionsBoundary ::
  -- | 'roleName'
  Prelude.Text ->
  -- | 'permissionsBoundary'
  Prelude.Text ->
  PutRolePermissionsBoundary
newPutRolePermissionsBoundary :: Text -> Text -> PutRolePermissionsBoundary
newPutRolePermissionsBoundary
  Text
pRoleName_
  Text
pPermissionsBoundary_ =
    PutRolePermissionsBoundary'
      { $sel:roleName:PutRolePermissionsBoundary' :: Text
roleName = Text
pRoleName_,
        $sel:permissionsBoundary:PutRolePermissionsBoundary' :: Text
permissionsBoundary = Text
pPermissionsBoundary_
      }

-- | The name (friendly name, not ARN) of the IAM role for which you want to
-- set the permissions boundary.
putRolePermissionsBoundary_roleName :: Lens.Lens' PutRolePermissionsBoundary Prelude.Text
putRolePermissionsBoundary_roleName :: Lens' PutRolePermissionsBoundary Text
putRolePermissionsBoundary_roleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRolePermissionsBoundary' {Text
roleName :: Text
$sel:roleName:PutRolePermissionsBoundary' :: PutRolePermissionsBoundary -> Text
roleName} -> Text
roleName) (\s :: PutRolePermissionsBoundary
s@PutRolePermissionsBoundary' {} Text
a -> PutRolePermissionsBoundary
s {$sel:roleName:PutRolePermissionsBoundary' :: Text
roleName = Text
a} :: PutRolePermissionsBoundary)

-- | The ARN of the policy that is used to set the permissions boundary for
-- the role.
putRolePermissionsBoundary_permissionsBoundary :: Lens.Lens' PutRolePermissionsBoundary Prelude.Text
putRolePermissionsBoundary_permissionsBoundary :: Lens' PutRolePermissionsBoundary Text
putRolePermissionsBoundary_permissionsBoundary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRolePermissionsBoundary' {Text
permissionsBoundary :: Text
$sel:permissionsBoundary:PutRolePermissionsBoundary' :: PutRolePermissionsBoundary -> Text
permissionsBoundary} -> Text
permissionsBoundary) (\s :: PutRolePermissionsBoundary
s@PutRolePermissionsBoundary' {} Text
a -> PutRolePermissionsBoundary
s {$sel:permissionsBoundary:PutRolePermissionsBoundary' :: Text
permissionsBoundary = Text
a} :: PutRolePermissionsBoundary)

instance Core.AWSRequest PutRolePermissionsBoundary where
  type
    AWSResponse PutRolePermissionsBoundary =
      PutRolePermissionsBoundaryResponse
  request :: (Service -> Service)
-> PutRolePermissionsBoundary -> Request PutRolePermissionsBoundary
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutRolePermissionsBoundary
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutRolePermissionsBoundary)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      PutRolePermissionsBoundaryResponse
PutRolePermissionsBoundaryResponse'

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

instance Prelude.NFData PutRolePermissionsBoundary where
  rnf :: PutRolePermissionsBoundary -> ()
rnf PutRolePermissionsBoundary' {Text
permissionsBoundary :: Text
roleName :: Text
$sel:permissionsBoundary:PutRolePermissionsBoundary' :: PutRolePermissionsBoundary -> Text
$sel:roleName:PutRolePermissionsBoundary' :: PutRolePermissionsBoundary -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
roleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
permissionsBoundary

instance Data.ToHeaders PutRolePermissionsBoundary where
  toHeaders :: PutRolePermissionsBoundary -> [Header]
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery PutRolePermissionsBoundary where
  toQuery :: PutRolePermissionsBoundary -> QueryString
toQuery PutRolePermissionsBoundary' {Text
permissionsBoundary :: Text
roleName :: Text
$sel:permissionsBoundary:PutRolePermissionsBoundary' :: PutRolePermissionsBoundary -> Text
$sel:roleName:PutRolePermissionsBoundary' :: PutRolePermissionsBoundary -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"PutRolePermissionsBoundary" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"RoleName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
roleName,
        ByteString
"PermissionsBoundary" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
permissionsBoundary
      ]

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

-- |
-- Create a value of 'PutRolePermissionsBoundaryResponse' 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.
newPutRolePermissionsBoundaryResponse ::
  PutRolePermissionsBoundaryResponse
newPutRolePermissionsBoundaryResponse :: PutRolePermissionsBoundaryResponse
newPutRolePermissionsBoundaryResponse =
  PutRolePermissionsBoundaryResponse
PutRolePermissionsBoundaryResponse'

instance
  Prelude.NFData
    PutRolePermissionsBoundaryResponse
  where
  rnf :: PutRolePermissionsBoundaryResponse -> ()
rnf PutRolePermissionsBoundaryResponse
_ = ()