{-# 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.SetSecurityTokenServicePreferences
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Sets the specified version of the global endpoint token as the token
-- version used for the Amazon Web Services account.
--
-- By default, Security Token Service (STS) is available as a global
-- service, and all STS requests go to a single endpoint at
-- @https:\/\/sts.amazonaws.com@. Amazon Web Services recommends using
-- Regional STS endpoints to reduce latency, build in redundancy, and
-- increase session token availability. For information about Regional
-- endpoints for STS, see
-- <https://docs.aws.amazon.com/general/latest/gr/sts.html Security Token Service endpoints and quotas>
-- in the /Amazon Web Services General Reference/.
--
-- If you make an STS call to the global endpoint, the resulting session
-- tokens might be valid in some Regions but not others. It depends on the
-- version that is set in this operation. Version 1 tokens are valid only
-- in Amazon Web Services Regions that are available by default. These
-- tokens do not work in manually enabled Regions, such as Asia Pacific
-- (Hong Kong). Version 2 tokens are valid in all Regions. However, version
-- 2 tokens are longer and might affect systems where you temporarily store
-- tokens. For information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_temp_enable-regions.html Activating and deactivating STS in an Amazon Web Services Region>
-- in the /IAM User Guide/.
--
-- To view the current session token version, see the
-- @GlobalEndpointTokenVersion@ entry in the response of the
-- GetAccountSummary operation.
module Amazonka.IAM.SetSecurityTokenServicePreferences
  ( -- * Creating a Request
    SetSecurityTokenServicePreferences (..),
    newSetSecurityTokenServicePreferences,

    -- * Request Lenses
    setSecurityTokenServicePreferences_globalEndpointTokenVersion,

    -- * Destructuring the Response
    SetSecurityTokenServicePreferencesResponse (..),
    newSetSecurityTokenServicePreferencesResponse,
  )
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:/ 'newSetSecurityTokenServicePreferences' smart constructor.
data SetSecurityTokenServicePreferences = SetSecurityTokenServicePreferences'
  { -- | The version of the global endpoint token. Version 1 tokens are valid
    -- only in Amazon Web Services Regions that are available by default. These
    -- tokens do not work in manually enabled Regions, such as Asia Pacific
    -- (Hong Kong). Version 2 tokens are valid in all Regions. However, version
    -- 2 tokens are longer and might affect systems where you temporarily store
    -- tokens.
    --
    -- For information, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_temp_enable-regions.html Activating and deactivating STS in an Amazon Web Services Region>
    -- in the /IAM User Guide/.
    SetSecurityTokenServicePreferences -> GlobalEndpointTokenVersion
globalEndpointTokenVersion :: GlobalEndpointTokenVersion
  }
  deriving (SetSecurityTokenServicePreferences
-> SetSecurityTokenServicePreferences -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SetSecurityTokenServicePreferences
-> SetSecurityTokenServicePreferences -> Bool
$c/= :: SetSecurityTokenServicePreferences
-> SetSecurityTokenServicePreferences -> Bool
== :: SetSecurityTokenServicePreferences
-> SetSecurityTokenServicePreferences -> Bool
$c== :: SetSecurityTokenServicePreferences
-> SetSecurityTokenServicePreferences -> Bool
Prelude.Eq, ReadPrec [SetSecurityTokenServicePreferences]
ReadPrec SetSecurityTokenServicePreferences
Int -> ReadS SetSecurityTokenServicePreferences
ReadS [SetSecurityTokenServicePreferences]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SetSecurityTokenServicePreferences]
$creadListPrec :: ReadPrec [SetSecurityTokenServicePreferences]
readPrec :: ReadPrec SetSecurityTokenServicePreferences
$creadPrec :: ReadPrec SetSecurityTokenServicePreferences
readList :: ReadS [SetSecurityTokenServicePreferences]
$creadList :: ReadS [SetSecurityTokenServicePreferences]
readsPrec :: Int -> ReadS SetSecurityTokenServicePreferences
$creadsPrec :: Int -> ReadS SetSecurityTokenServicePreferences
Prelude.Read, Int -> SetSecurityTokenServicePreferences -> ShowS
[SetSecurityTokenServicePreferences] -> ShowS
SetSecurityTokenServicePreferences -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SetSecurityTokenServicePreferences] -> ShowS
$cshowList :: [SetSecurityTokenServicePreferences] -> ShowS
show :: SetSecurityTokenServicePreferences -> String
$cshow :: SetSecurityTokenServicePreferences -> String
showsPrec :: Int -> SetSecurityTokenServicePreferences -> ShowS
$cshowsPrec :: Int -> SetSecurityTokenServicePreferences -> ShowS
Prelude.Show, forall x.
Rep SetSecurityTokenServicePreferences x
-> SetSecurityTokenServicePreferences
forall x.
SetSecurityTokenServicePreferences
-> Rep SetSecurityTokenServicePreferences x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep SetSecurityTokenServicePreferences x
-> SetSecurityTokenServicePreferences
$cfrom :: forall x.
SetSecurityTokenServicePreferences
-> Rep SetSecurityTokenServicePreferences x
Prelude.Generic)

-- |
-- Create a value of 'SetSecurityTokenServicePreferences' 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:
--
-- 'globalEndpointTokenVersion', 'setSecurityTokenServicePreferences_globalEndpointTokenVersion' - The version of the global endpoint token. Version 1 tokens are valid
-- only in Amazon Web Services Regions that are available by default. These
-- tokens do not work in manually enabled Regions, such as Asia Pacific
-- (Hong Kong). Version 2 tokens are valid in all Regions. However, version
-- 2 tokens are longer and might affect systems where you temporarily store
-- tokens.
--
-- For information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_temp_enable-regions.html Activating and deactivating STS in an Amazon Web Services Region>
-- in the /IAM User Guide/.
newSetSecurityTokenServicePreferences ::
  -- | 'globalEndpointTokenVersion'
  GlobalEndpointTokenVersion ->
  SetSecurityTokenServicePreferences
newSetSecurityTokenServicePreferences :: GlobalEndpointTokenVersion -> SetSecurityTokenServicePreferences
newSetSecurityTokenServicePreferences
  GlobalEndpointTokenVersion
pGlobalEndpointTokenVersion_ =
    SetSecurityTokenServicePreferences'
      { $sel:globalEndpointTokenVersion:SetSecurityTokenServicePreferences' :: GlobalEndpointTokenVersion
globalEndpointTokenVersion =
          GlobalEndpointTokenVersion
pGlobalEndpointTokenVersion_
      }

-- | The version of the global endpoint token. Version 1 tokens are valid
-- only in Amazon Web Services Regions that are available by default. These
-- tokens do not work in manually enabled Regions, such as Asia Pacific
-- (Hong Kong). Version 2 tokens are valid in all Regions. However, version
-- 2 tokens are longer and might affect systems where you temporarily store
-- tokens.
--
-- For information, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_credentials_temp_enable-regions.html Activating and deactivating STS in an Amazon Web Services Region>
-- in the /IAM User Guide/.
setSecurityTokenServicePreferences_globalEndpointTokenVersion :: Lens.Lens' SetSecurityTokenServicePreferences GlobalEndpointTokenVersion
setSecurityTokenServicePreferences_globalEndpointTokenVersion :: Lens' SetSecurityTokenServicePreferences GlobalEndpointTokenVersion
setSecurityTokenServicePreferences_globalEndpointTokenVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SetSecurityTokenServicePreferences' {GlobalEndpointTokenVersion
globalEndpointTokenVersion :: GlobalEndpointTokenVersion
$sel:globalEndpointTokenVersion:SetSecurityTokenServicePreferences' :: SetSecurityTokenServicePreferences -> GlobalEndpointTokenVersion
globalEndpointTokenVersion} -> GlobalEndpointTokenVersion
globalEndpointTokenVersion) (\s :: SetSecurityTokenServicePreferences
s@SetSecurityTokenServicePreferences' {} GlobalEndpointTokenVersion
a -> SetSecurityTokenServicePreferences
s {$sel:globalEndpointTokenVersion:SetSecurityTokenServicePreferences' :: GlobalEndpointTokenVersion
globalEndpointTokenVersion = GlobalEndpointTokenVersion
a} :: SetSecurityTokenServicePreferences)

instance
  Core.AWSRequest
    SetSecurityTokenServicePreferences
  where
  type
    AWSResponse SetSecurityTokenServicePreferences =
      SetSecurityTokenServicePreferencesResponse
  request :: (Service -> Service)
-> SetSecurityTokenServicePreferences
-> Request SetSecurityTokenServicePreferences
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 SetSecurityTokenServicePreferences
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse SetSecurityTokenServicePreferences)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      SetSecurityTokenServicePreferencesResponse
SetSecurityTokenServicePreferencesResponse'

instance
  Prelude.Hashable
    SetSecurityTokenServicePreferences
  where
  hashWithSalt :: Int -> SetSecurityTokenServicePreferences -> Int
hashWithSalt
    Int
_salt
    SetSecurityTokenServicePreferences' {GlobalEndpointTokenVersion
globalEndpointTokenVersion :: GlobalEndpointTokenVersion
$sel:globalEndpointTokenVersion:SetSecurityTokenServicePreferences' :: SetSecurityTokenServicePreferences -> GlobalEndpointTokenVersion
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` GlobalEndpointTokenVersion
globalEndpointTokenVersion

instance
  Prelude.NFData
    SetSecurityTokenServicePreferences
  where
  rnf :: SetSecurityTokenServicePreferences -> ()
rnf SetSecurityTokenServicePreferences' {GlobalEndpointTokenVersion
globalEndpointTokenVersion :: GlobalEndpointTokenVersion
$sel:globalEndpointTokenVersion:SetSecurityTokenServicePreferences' :: SetSecurityTokenServicePreferences -> GlobalEndpointTokenVersion
..} =
    forall a. NFData a => a -> ()
Prelude.rnf GlobalEndpointTokenVersion
globalEndpointTokenVersion

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

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

instance
  Data.ToQuery
    SetSecurityTokenServicePreferences
  where
  toQuery :: SetSecurityTokenServicePreferences -> QueryString
toQuery SetSecurityTokenServicePreferences' {GlobalEndpointTokenVersion
globalEndpointTokenVersion :: GlobalEndpointTokenVersion
$sel:globalEndpointTokenVersion:SetSecurityTokenServicePreferences' :: SetSecurityTokenServicePreferences -> GlobalEndpointTokenVersion
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: ( ByteString
"SetSecurityTokenServicePreferences" ::
                      Prelude.ByteString
                  ),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-08" :: Prelude.ByteString),
        ByteString
"GlobalEndpointTokenVersion"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: GlobalEndpointTokenVersion
globalEndpointTokenVersion
      ]

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

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

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