{-# 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.ImportStacksToStackSet
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Import existing stacks into a new stack sets. Use the stack import
-- operation to import up to 10 stacks into a new stack set in the same
-- account as the source stack or in a different administrator account and
-- Region, by specifying the stack ID of the stack you intend to import.
--
-- @ImportStacksToStackSet@ is only supported by self-managed permissions.
module Amazonka.CloudFormation.ImportStacksToStackSet
  ( -- * Creating a Request
    ImportStacksToStackSet (..),
    newImportStacksToStackSet,

    -- * Request Lenses
    importStacksToStackSet_callAs,
    importStacksToStackSet_operationId,
    importStacksToStackSet_operationPreferences,
    importStacksToStackSet_organizationalUnitIds,
    importStacksToStackSet_stackIds,
    importStacksToStackSet_stackIdsUrl,
    importStacksToStackSet_stackSetName,

    -- * Destructuring the Response
    ImportStacksToStackSetResponse (..),
    newImportStacksToStackSetResponse,

    -- * Response Lenses
    importStacksToStackSetResponse_operationId,
    importStacksToStackSetResponse_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

-- | /See:/ 'newImportStacksToStackSet' smart constructor.
data ImportStacksToStackSet = ImportStacksToStackSet'
  { -- | By default, @SELF@ is specified. Use @SELF@ for stack sets with
    -- self-managed permissions.
    --
    -- -   If you are signed in to the management account, specify @SELF@.
    --
    -- -   For service managed stack sets, specify @DELEGATED_ADMIN@.
    ImportStacksToStackSet -> Maybe CallAs
callAs :: Prelude.Maybe CallAs,
    -- | A unique, user defined, identifier for the stack set operation.
    ImportStacksToStackSet -> Maybe Text
operationId :: Prelude.Maybe Prelude.Text,
    ImportStacksToStackSet -> Maybe StackSetOperationPreferences
operationPreferences :: Prelude.Maybe StackSetOperationPreferences,
    -- | The list of OU ID\'s to which the stacks being imported has to be mapped
    -- as deployment target.
    ImportStacksToStackSet -> Maybe [Text]
organizationalUnitIds :: Prelude.Maybe [Prelude.Text],
    -- | The IDs of the stacks you are importing into a stack set. You import up
    -- to 10 stacks per stack set at a time.
    --
    -- Specify either @StackIds@ or @StackIdsUrl@.
    ImportStacksToStackSet -> Maybe [Text]
stackIds :: Prelude.Maybe [Prelude.Text],
    -- | The Amazon S3 URL which contains list of stack ids to be inputted.
    --
    -- Specify either @StackIds@ or @StackIdsUrl@.
    ImportStacksToStackSet -> Maybe Text
stackIdsUrl :: Prelude.Maybe Prelude.Text,
    -- | The name of the stack set. The name must be unique in the Region where
    -- you create your stack set.
    ImportStacksToStackSet -> Text
stackSetName :: Prelude.Text
  }
  deriving (ImportStacksToStackSet -> ImportStacksToStackSet -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ImportStacksToStackSet -> ImportStacksToStackSet -> Bool
$c/= :: ImportStacksToStackSet -> ImportStacksToStackSet -> Bool
== :: ImportStacksToStackSet -> ImportStacksToStackSet -> Bool
$c== :: ImportStacksToStackSet -> ImportStacksToStackSet -> Bool
Prelude.Eq, ReadPrec [ImportStacksToStackSet]
ReadPrec ImportStacksToStackSet
Int -> ReadS ImportStacksToStackSet
ReadS [ImportStacksToStackSet]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ImportStacksToStackSet]
$creadListPrec :: ReadPrec [ImportStacksToStackSet]
readPrec :: ReadPrec ImportStacksToStackSet
$creadPrec :: ReadPrec ImportStacksToStackSet
readList :: ReadS [ImportStacksToStackSet]
$creadList :: ReadS [ImportStacksToStackSet]
readsPrec :: Int -> ReadS ImportStacksToStackSet
$creadsPrec :: Int -> ReadS ImportStacksToStackSet
Prelude.Read, Int -> ImportStacksToStackSet -> ShowS
[ImportStacksToStackSet] -> ShowS
ImportStacksToStackSet -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ImportStacksToStackSet] -> ShowS
$cshowList :: [ImportStacksToStackSet] -> ShowS
show :: ImportStacksToStackSet -> String
$cshow :: ImportStacksToStackSet -> String
showsPrec :: Int -> ImportStacksToStackSet -> ShowS
$cshowsPrec :: Int -> ImportStacksToStackSet -> ShowS
Prelude.Show, forall x. Rep ImportStacksToStackSet x -> ImportStacksToStackSet
forall x. ImportStacksToStackSet -> Rep ImportStacksToStackSet x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ImportStacksToStackSet x -> ImportStacksToStackSet
$cfrom :: forall x. ImportStacksToStackSet -> Rep ImportStacksToStackSet x
Prelude.Generic)

-- |
-- Create a value of 'ImportStacksToStackSet' 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:
--
-- 'callAs', 'importStacksToStackSet_callAs' - By default, @SELF@ is specified. Use @SELF@ for stack sets with
-- self-managed permissions.
--
-- -   If you are signed in to the management account, specify @SELF@.
--
-- -   For service managed stack sets, specify @DELEGATED_ADMIN@.
--
-- 'operationId', 'importStacksToStackSet_operationId' - A unique, user defined, identifier for the stack set operation.
--
-- 'operationPreferences', 'importStacksToStackSet_operationPreferences' - Undocumented member.
--
-- 'organizationalUnitIds', 'importStacksToStackSet_organizationalUnitIds' - The list of OU ID\'s to which the stacks being imported has to be mapped
-- as deployment target.
--
-- 'stackIds', 'importStacksToStackSet_stackIds' - The IDs of the stacks you are importing into a stack set. You import up
-- to 10 stacks per stack set at a time.
--
-- Specify either @StackIds@ or @StackIdsUrl@.
--
-- 'stackIdsUrl', 'importStacksToStackSet_stackIdsUrl' - The Amazon S3 URL which contains list of stack ids to be inputted.
--
-- Specify either @StackIds@ or @StackIdsUrl@.
--
-- 'stackSetName', 'importStacksToStackSet_stackSetName' - The name of the stack set. The name must be unique in the Region where
-- you create your stack set.
newImportStacksToStackSet ::
  -- | 'stackSetName'
  Prelude.Text ->
  ImportStacksToStackSet
newImportStacksToStackSet :: Text -> ImportStacksToStackSet
newImportStacksToStackSet Text
pStackSetName_ =
  ImportStacksToStackSet'
    { $sel:callAs:ImportStacksToStackSet' :: Maybe CallAs
callAs = forall a. Maybe a
Prelude.Nothing,
      $sel:operationId:ImportStacksToStackSet' :: Maybe Text
operationId = forall a. Maybe a
Prelude.Nothing,
      $sel:operationPreferences:ImportStacksToStackSet' :: Maybe StackSetOperationPreferences
operationPreferences = forall a. Maybe a
Prelude.Nothing,
      $sel:organizationalUnitIds:ImportStacksToStackSet' :: Maybe [Text]
organizationalUnitIds = forall a. Maybe a
Prelude.Nothing,
      $sel:stackIds:ImportStacksToStackSet' :: Maybe [Text]
stackIds = forall a. Maybe a
Prelude.Nothing,
      $sel:stackIdsUrl:ImportStacksToStackSet' :: Maybe Text
stackIdsUrl = forall a. Maybe a
Prelude.Nothing,
      $sel:stackSetName:ImportStacksToStackSet' :: Text
stackSetName = Text
pStackSetName_
    }

-- | By default, @SELF@ is specified. Use @SELF@ for stack sets with
-- self-managed permissions.
--
-- -   If you are signed in to the management account, specify @SELF@.
--
-- -   For service managed stack sets, specify @DELEGATED_ADMIN@.
importStacksToStackSet_callAs :: Lens.Lens' ImportStacksToStackSet (Prelude.Maybe CallAs)
importStacksToStackSet_callAs :: Lens' ImportStacksToStackSet (Maybe CallAs)
importStacksToStackSet_callAs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportStacksToStackSet' {Maybe CallAs
callAs :: Maybe CallAs
$sel:callAs:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe CallAs
callAs} -> Maybe CallAs
callAs) (\s :: ImportStacksToStackSet
s@ImportStacksToStackSet' {} Maybe CallAs
a -> ImportStacksToStackSet
s {$sel:callAs:ImportStacksToStackSet' :: Maybe CallAs
callAs = Maybe CallAs
a} :: ImportStacksToStackSet)

-- | A unique, user defined, identifier for the stack set operation.
importStacksToStackSet_operationId :: Lens.Lens' ImportStacksToStackSet (Prelude.Maybe Prelude.Text)
importStacksToStackSet_operationId :: Lens' ImportStacksToStackSet (Maybe Text)
importStacksToStackSet_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportStacksToStackSet' {Maybe Text
operationId :: Maybe Text
$sel:operationId:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe Text
operationId} -> Maybe Text
operationId) (\s :: ImportStacksToStackSet
s@ImportStacksToStackSet' {} Maybe Text
a -> ImportStacksToStackSet
s {$sel:operationId:ImportStacksToStackSet' :: Maybe Text
operationId = Maybe Text
a} :: ImportStacksToStackSet)

-- | Undocumented member.
importStacksToStackSet_operationPreferences :: Lens.Lens' ImportStacksToStackSet (Prelude.Maybe StackSetOperationPreferences)
importStacksToStackSet_operationPreferences :: Lens' ImportStacksToStackSet (Maybe StackSetOperationPreferences)
importStacksToStackSet_operationPreferences = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportStacksToStackSet' {Maybe StackSetOperationPreferences
operationPreferences :: Maybe StackSetOperationPreferences
$sel:operationPreferences:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe StackSetOperationPreferences
operationPreferences} -> Maybe StackSetOperationPreferences
operationPreferences) (\s :: ImportStacksToStackSet
s@ImportStacksToStackSet' {} Maybe StackSetOperationPreferences
a -> ImportStacksToStackSet
s {$sel:operationPreferences:ImportStacksToStackSet' :: Maybe StackSetOperationPreferences
operationPreferences = Maybe StackSetOperationPreferences
a} :: ImportStacksToStackSet)

-- | The list of OU ID\'s to which the stacks being imported has to be mapped
-- as deployment target.
importStacksToStackSet_organizationalUnitIds :: Lens.Lens' ImportStacksToStackSet (Prelude.Maybe [Prelude.Text])
importStacksToStackSet_organizationalUnitIds :: Lens' ImportStacksToStackSet (Maybe [Text])
importStacksToStackSet_organizationalUnitIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportStacksToStackSet' {Maybe [Text]
organizationalUnitIds :: Maybe [Text]
$sel:organizationalUnitIds:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe [Text]
organizationalUnitIds} -> Maybe [Text]
organizationalUnitIds) (\s :: ImportStacksToStackSet
s@ImportStacksToStackSet' {} Maybe [Text]
a -> ImportStacksToStackSet
s {$sel:organizationalUnitIds:ImportStacksToStackSet' :: Maybe [Text]
organizationalUnitIds = Maybe [Text]
a} :: ImportStacksToStackSet) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The IDs of the stacks you are importing into a stack set. You import up
-- to 10 stacks per stack set at a time.
--
-- Specify either @StackIds@ or @StackIdsUrl@.
importStacksToStackSet_stackIds :: Lens.Lens' ImportStacksToStackSet (Prelude.Maybe [Prelude.Text])
importStacksToStackSet_stackIds :: Lens' ImportStacksToStackSet (Maybe [Text])
importStacksToStackSet_stackIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportStacksToStackSet' {Maybe [Text]
stackIds :: Maybe [Text]
$sel:stackIds:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe [Text]
stackIds} -> Maybe [Text]
stackIds) (\s :: ImportStacksToStackSet
s@ImportStacksToStackSet' {} Maybe [Text]
a -> ImportStacksToStackSet
s {$sel:stackIds:ImportStacksToStackSet' :: Maybe [Text]
stackIds = Maybe [Text]
a} :: ImportStacksToStackSet) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Amazon S3 URL which contains list of stack ids to be inputted.
--
-- Specify either @StackIds@ or @StackIdsUrl@.
importStacksToStackSet_stackIdsUrl :: Lens.Lens' ImportStacksToStackSet (Prelude.Maybe Prelude.Text)
importStacksToStackSet_stackIdsUrl :: Lens' ImportStacksToStackSet (Maybe Text)
importStacksToStackSet_stackIdsUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportStacksToStackSet' {Maybe Text
stackIdsUrl :: Maybe Text
$sel:stackIdsUrl:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe Text
stackIdsUrl} -> Maybe Text
stackIdsUrl) (\s :: ImportStacksToStackSet
s@ImportStacksToStackSet' {} Maybe Text
a -> ImportStacksToStackSet
s {$sel:stackIdsUrl:ImportStacksToStackSet' :: Maybe Text
stackIdsUrl = Maybe Text
a} :: ImportStacksToStackSet)

-- | The name of the stack set. The name must be unique in the Region where
-- you create your stack set.
importStacksToStackSet_stackSetName :: Lens.Lens' ImportStacksToStackSet Prelude.Text
importStacksToStackSet_stackSetName :: Lens' ImportStacksToStackSet Text
importStacksToStackSet_stackSetName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportStacksToStackSet' {Text
stackSetName :: Text
$sel:stackSetName:ImportStacksToStackSet' :: ImportStacksToStackSet -> Text
stackSetName} -> Text
stackSetName) (\s :: ImportStacksToStackSet
s@ImportStacksToStackSet' {} Text
a -> ImportStacksToStackSet
s {$sel:stackSetName:ImportStacksToStackSet' :: Text
stackSetName = Text
a} :: ImportStacksToStackSet)

instance Core.AWSRequest ImportStacksToStackSet where
  type
    AWSResponse ImportStacksToStackSet =
      ImportStacksToStackSetResponse
  request :: (Service -> Service)
-> ImportStacksToStackSet -> Request ImportStacksToStackSet
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 ImportStacksToStackSet
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ImportStacksToStackSet)))
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
"ImportStacksToStackSetResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> ImportStacksToStackSetResponse
ImportStacksToStackSetResponse'
            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
"OperationId")
            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 ImportStacksToStackSet where
  hashWithSalt :: Int -> ImportStacksToStackSet -> Int
hashWithSalt Int
_salt ImportStacksToStackSet' {Maybe [Text]
Maybe Text
Maybe CallAs
Maybe StackSetOperationPreferences
Text
stackSetName :: Text
stackIdsUrl :: Maybe Text
stackIds :: Maybe [Text]
organizationalUnitIds :: Maybe [Text]
operationPreferences :: Maybe StackSetOperationPreferences
operationId :: Maybe Text
callAs :: Maybe CallAs
$sel:stackSetName:ImportStacksToStackSet' :: ImportStacksToStackSet -> Text
$sel:stackIdsUrl:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe Text
$sel:stackIds:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe [Text]
$sel:organizationalUnitIds:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe [Text]
$sel:operationPreferences:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe StackSetOperationPreferences
$sel:operationId:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe Text
$sel:callAs:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe CallAs
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CallAs
callAs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
operationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StackSetOperationPreferences
operationPreferences
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
organizationalUnitIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
stackIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
stackIdsUrl
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stackSetName

instance Prelude.NFData ImportStacksToStackSet where
  rnf :: ImportStacksToStackSet -> ()
rnf ImportStacksToStackSet' {Maybe [Text]
Maybe Text
Maybe CallAs
Maybe StackSetOperationPreferences
Text
stackSetName :: Text
stackIdsUrl :: Maybe Text
stackIds :: Maybe [Text]
organizationalUnitIds :: Maybe [Text]
operationPreferences :: Maybe StackSetOperationPreferences
operationId :: Maybe Text
callAs :: Maybe CallAs
$sel:stackSetName:ImportStacksToStackSet' :: ImportStacksToStackSet -> Text
$sel:stackIdsUrl:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe Text
$sel:stackIds:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe [Text]
$sel:organizationalUnitIds:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe [Text]
$sel:operationPreferences:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe StackSetOperationPreferences
$sel:operationId:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe Text
$sel:callAs:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe CallAs
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CallAs
callAs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
operationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StackSetOperationPreferences
operationPreferences
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
organizationalUnitIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
stackIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stackIdsUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stackSetName

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

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

instance Data.ToQuery ImportStacksToStackSet where
  toQuery :: ImportStacksToStackSet -> QueryString
toQuery ImportStacksToStackSet' {Maybe [Text]
Maybe Text
Maybe CallAs
Maybe StackSetOperationPreferences
Text
stackSetName :: Text
stackIdsUrl :: Maybe Text
stackIds :: Maybe [Text]
organizationalUnitIds :: Maybe [Text]
operationPreferences :: Maybe StackSetOperationPreferences
operationId :: Maybe Text
callAs :: Maybe CallAs
$sel:stackSetName:ImportStacksToStackSet' :: ImportStacksToStackSet -> Text
$sel:stackIdsUrl:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe Text
$sel:stackIds:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe [Text]
$sel:organizationalUnitIds:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe [Text]
$sel:operationPreferences:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe StackSetOperationPreferences
$sel:operationId:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe Text
$sel:callAs:ImportStacksToStackSet' :: ImportStacksToStackSet -> Maybe CallAs
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ImportStacksToStackSet" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"CallAs" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe CallAs
callAs,
        ByteString
"OperationId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
operationId,
        ByteString
"OperationPreferences" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe StackSetOperationPreferences
operationPreferences,
        ByteString
"OrganizationalUnitIds"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
organizationalUnitIds
            ),
        ByteString
"StackIds"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
stackIds),
        ByteString
"StackIdsUrl" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
stackIdsUrl,
        ByteString
"StackSetName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
stackSetName
      ]

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

-- |
-- Create a value of 'ImportStacksToStackSetResponse' 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:
--
-- 'operationId', 'importStacksToStackSetResponse_operationId' - The unique identifier for the stack set operation.
--
-- 'httpStatus', 'importStacksToStackSetResponse_httpStatus' - The response's http status code.
newImportStacksToStackSetResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ImportStacksToStackSetResponse
newImportStacksToStackSetResponse :: Int -> ImportStacksToStackSetResponse
newImportStacksToStackSetResponse Int
pHttpStatus_ =
  ImportStacksToStackSetResponse'
    { $sel:operationId:ImportStacksToStackSetResponse' :: Maybe Text
operationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ImportStacksToStackSetResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The unique identifier for the stack set operation.
importStacksToStackSetResponse_operationId :: Lens.Lens' ImportStacksToStackSetResponse (Prelude.Maybe Prelude.Text)
importStacksToStackSetResponse_operationId :: Lens' ImportStacksToStackSetResponse (Maybe Text)
importStacksToStackSetResponse_operationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ImportStacksToStackSetResponse' {Maybe Text
operationId :: Maybe Text
$sel:operationId:ImportStacksToStackSetResponse' :: ImportStacksToStackSetResponse -> Maybe Text
operationId} -> Maybe Text
operationId) (\s :: ImportStacksToStackSetResponse
s@ImportStacksToStackSetResponse' {} Maybe Text
a -> ImportStacksToStackSetResponse
s {$sel:operationId:ImportStacksToStackSetResponse' :: Maybe Text
operationId = Maybe Text
a} :: ImportStacksToStackSetResponse)

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

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