{-# 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.CloudFormation.GetStackPolicy
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns the stack policy for a specified stack. If a stack doesn\'t have
-- a policy, a null value is returned.
module Amazonka.CloudFormation.GetStackPolicy
  ( -- * Creating a Request
    GetStackPolicy (..),
    newGetStackPolicy,

    -- * Request Lenses
    getStackPolicy_stackName,

    -- * Destructuring the Response
    GetStackPolicyResponse (..),
    newGetStackPolicyResponse,

    -- * Response Lenses
    getStackPolicyResponse_stackPolicyBody,
    getStackPolicyResponse_httpStatus,
  )
where

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

-- | The input for the GetStackPolicy action.
--
-- /See:/ 'newGetStackPolicy' smart constructor.
data GetStackPolicy = GetStackPolicy'
  { -- | The name or unique stack ID that\'s associated with the stack whose
    -- policy you want to get.
    GetStackPolicy -> Text
stackName :: Prelude.Text
  }
  deriving (GetStackPolicy -> GetStackPolicy -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetStackPolicy -> GetStackPolicy -> Bool
$c/= :: GetStackPolicy -> GetStackPolicy -> Bool
== :: GetStackPolicy -> GetStackPolicy -> Bool
$c== :: GetStackPolicy -> GetStackPolicy -> Bool
Prelude.Eq, ReadPrec [GetStackPolicy]
ReadPrec GetStackPolicy
Int -> ReadS GetStackPolicy
ReadS [GetStackPolicy]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetStackPolicy]
$creadListPrec :: ReadPrec [GetStackPolicy]
readPrec :: ReadPrec GetStackPolicy
$creadPrec :: ReadPrec GetStackPolicy
readList :: ReadS [GetStackPolicy]
$creadList :: ReadS [GetStackPolicy]
readsPrec :: Int -> ReadS GetStackPolicy
$creadsPrec :: Int -> ReadS GetStackPolicy
Prelude.Read, Int -> GetStackPolicy -> ShowS
[GetStackPolicy] -> ShowS
GetStackPolicy -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetStackPolicy] -> ShowS
$cshowList :: [GetStackPolicy] -> ShowS
show :: GetStackPolicy -> String
$cshow :: GetStackPolicy -> String
showsPrec :: Int -> GetStackPolicy -> ShowS
$cshowsPrec :: Int -> GetStackPolicy -> ShowS
Prelude.Show, forall x. Rep GetStackPolicy x -> GetStackPolicy
forall x. GetStackPolicy -> Rep GetStackPolicy x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetStackPolicy x -> GetStackPolicy
$cfrom :: forall x. GetStackPolicy -> Rep GetStackPolicy x
Prelude.Generic)

-- |
-- Create a value of 'GetStackPolicy' 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:
--
-- 'stackName', 'getStackPolicy_stackName' - The name or unique stack ID that\'s associated with the stack whose
-- policy you want to get.
newGetStackPolicy ::
  -- | 'stackName'
  Prelude.Text ->
  GetStackPolicy
newGetStackPolicy :: Text -> GetStackPolicy
newGetStackPolicy Text
pStackName_ =
  GetStackPolicy' {$sel:stackName:GetStackPolicy' :: Text
stackName = Text
pStackName_}

-- | The name or unique stack ID that\'s associated with the stack whose
-- policy you want to get.
getStackPolicy_stackName :: Lens.Lens' GetStackPolicy Prelude.Text
getStackPolicy_stackName :: Lens' GetStackPolicy Text
getStackPolicy_stackName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStackPolicy' {Text
stackName :: Text
$sel:stackName:GetStackPolicy' :: GetStackPolicy -> Text
stackName} -> Text
stackName) (\s :: GetStackPolicy
s@GetStackPolicy' {} Text
a -> GetStackPolicy
s {$sel:stackName:GetStackPolicy' :: Text
stackName = Text
a} :: GetStackPolicy)

instance Core.AWSRequest GetStackPolicy where
  type
    AWSResponse GetStackPolicy =
      GetStackPolicyResponse
  request :: (Service -> Service) -> GetStackPolicy -> Request GetStackPolicy
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 GetStackPolicy
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetStackPolicy)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"GetStackPolicyResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> GetStackPolicyResponse
GetStackPolicyResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"StackPolicyBody")
            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 GetStackPolicy where
  hashWithSalt :: Int -> GetStackPolicy -> Int
hashWithSalt Int
_salt GetStackPolicy' {Text
stackName :: Text
$sel:stackName:GetStackPolicy' :: GetStackPolicy -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackName

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

instance Data.ToHeaders GetStackPolicy where
  toHeaders :: GetStackPolicy -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery GetStackPolicy where
  toQuery :: GetStackPolicy -> QueryString
toQuery GetStackPolicy' {Text
stackName :: Text
$sel:stackName:GetStackPolicy' :: GetStackPolicy -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"GetStackPolicy" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"StackName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
stackName
      ]

-- | The output for the GetStackPolicy action.
--
-- /See:/ 'newGetStackPolicyResponse' smart constructor.
data GetStackPolicyResponse = GetStackPolicyResponse'
  { -- | Structure containing the stack policy body. (For more information, go to
    -- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/protect-stack-resources.html Prevent Updates to Stack Resources>
    -- in the CloudFormation User Guide.)
    GetStackPolicyResponse -> Maybe Text
stackPolicyBody :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetStackPolicyResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetStackPolicyResponse -> GetStackPolicyResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetStackPolicyResponse -> GetStackPolicyResponse -> Bool
$c/= :: GetStackPolicyResponse -> GetStackPolicyResponse -> Bool
== :: GetStackPolicyResponse -> GetStackPolicyResponse -> Bool
$c== :: GetStackPolicyResponse -> GetStackPolicyResponse -> Bool
Prelude.Eq, ReadPrec [GetStackPolicyResponse]
ReadPrec GetStackPolicyResponse
Int -> ReadS GetStackPolicyResponse
ReadS [GetStackPolicyResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetStackPolicyResponse]
$creadListPrec :: ReadPrec [GetStackPolicyResponse]
readPrec :: ReadPrec GetStackPolicyResponse
$creadPrec :: ReadPrec GetStackPolicyResponse
readList :: ReadS [GetStackPolicyResponse]
$creadList :: ReadS [GetStackPolicyResponse]
readsPrec :: Int -> ReadS GetStackPolicyResponse
$creadsPrec :: Int -> ReadS GetStackPolicyResponse
Prelude.Read, Int -> GetStackPolicyResponse -> ShowS
[GetStackPolicyResponse] -> ShowS
GetStackPolicyResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetStackPolicyResponse] -> ShowS
$cshowList :: [GetStackPolicyResponse] -> ShowS
show :: GetStackPolicyResponse -> String
$cshow :: GetStackPolicyResponse -> String
showsPrec :: Int -> GetStackPolicyResponse -> ShowS
$cshowsPrec :: Int -> GetStackPolicyResponse -> ShowS
Prelude.Show, forall x. Rep GetStackPolicyResponse x -> GetStackPolicyResponse
forall x. GetStackPolicyResponse -> Rep GetStackPolicyResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetStackPolicyResponse x -> GetStackPolicyResponse
$cfrom :: forall x. GetStackPolicyResponse -> Rep GetStackPolicyResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetStackPolicyResponse' 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:
--
-- 'stackPolicyBody', 'getStackPolicyResponse_stackPolicyBody' - Structure containing the stack policy body. (For more information, go to
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/protect-stack-resources.html Prevent Updates to Stack Resources>
-- in the CloudFormation User Guide.)
--
-- 'httpStatus', 'getStackPolicyResponse_httpStatus' - The response's http status code.
newGetStackPolicyResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetStackPolicyResponse
newGetStackPolicyResponse :: Int -> GetStackPolicyResponse
newGetStackPolicyResponse Int
pHttpStatus_ =
  GetStackPolicyResponse'
    { $sel:stackPolicyBody:GetStackPolicyResponse' :: Maybe Text
stackPolicyBody =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetStackPolicyResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Structure containing the stack policy body. (For more information, go to
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/protect-stack-resources.html Prevent Updates to Stack Resources>
-- in the CloudFormation User Guide.)
getStackPolicyResponse_stackPolicyBody :: Lens.Lens' GetStackPolicyResponse (Prelude.Maybe Prelude.Text)
getStackPolicyResponse_stackPolicyBody :: Lens' GetStackPolicyResponse (Maybe Text)
getStackPolicyResponse_stackPolicyBody = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetStackPolicyResponse' {Maybe Text
stackPolicyBody :: Maybe Text
$sel:stackPolicyBody:GetStackPolicyResponse' :: GetStackPolicyResponse -> Maybe Text
stackPolicyBody} -> Maybe Text
stackPolicyBody) (\s :: GetStackPolicyResponse
s@GetStackPolicyResponse' {} Maybe Text
a -> GetStackPolicyResponse
s {$sel:stackPolicyBody:GetStackPolicyResponse' :: Maybe Text
stackPolicyBody = Maybe Text
a} :: GetStackPolicyResponse)

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

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