{-# 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.ListImports
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists all stacks that are importing an exported output value. To modify
-- or remove an exported output value, first use this action to see which
-- stacks are using it. To see the exported output values in your account,
-- see ListExports.
--
-- For more information about importing an exported output value, see the
-- <https://docs.aws.amazon.com/AWSCloudFormation/latest/UserGuide/intrinsic-function-reference-importvalue.html Fn::ImportValue>
-- function.
--
-- This operation returns paginated results.
module Amazonka.CloudFormation.ListImports
  ( -- * Creating a Request
    ListImports (..),
    newListImports,

    -- * Request Lenses
    listImports_nextToken,
    listImports_exportName,

    -- * Destructuring the Response
    ListImportsResponse (..),
    newListImportsResponse,

    -- * Response Lenses
    listImportsResponse_imports,
    listImportsResponse_nextToken,
    listImportsResponse_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:/ 'newListImports' smart constructor.
data ListImports = ListImports'
  { -- | A string (provided by the ListImports response output) that identifies
    -- the next page of stacks that are importing the specified exported output
    -- value.
    ListImports -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The name of the exported output value. CloudFormation returns the stack
    -- names that are importing this value.
    ListImports -> Text
exportName :: Prelude.Text
  }
  deriving (ListImports -> ListImports -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListImports -> ListImports -> Bool
$c/= :: ListImports -> ListImports -> Bool
== :: ListImports -> ListImports -> Bool
$c== :: ListImports -> ListImports -> Bool
Prelude.Eq, ReadPrec [ListImports]
ReadPrec ListImports
Int -> ReadS ListImports
ReadS [ListImports]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListImports]
$creadListPrec :: ReadPrec [ListImports]
readPrec :: ReadPrec ListImports
$creadPrec :: ReadPrec ListImports
readList :: ReadS [ListImports]
$creadList :: ReadS [ListImports]
readsPrec :: Int -> ReadS ListImports
$creadsPrec :: Int -> ReadS ListImports
Prelude.Read, Int -> ListImports -> ShowS
[ListImports] -> ShowS
ListImports -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListImports] -> ShowS
$cshowList :: [ListImports] -> ShowS
show :: ListImports -> String
$cshow :: ListImports -> String
showsPrec :: Int -> ListImports -> ShowS
$cshowsPrec :: Int -> ListImports -> ShowS
Prelude.Show, forall x. Rep ListImports x -> ListImports
forall x. ListImports -> Rep ListImports x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListImports x -> ListImports
$cfrom :: forall x. ListImports -> Rep ListImports x
Prelude.Generic)

-- |
-- Create a value of 'ListImports' 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:
--
-- 'nextToken', 'listImports_nextToken' - A string (provided by the ListImports response output) that identifies
-- the next page of stacks that are importing the specified exported output
-- value.
--
-- 'exportName', 'listImports_exportName' - The name of the exported output value. CloudFormation returns the stack
-- names that are importing this value.
newListImports ::
  -- | 'exportName'
  Prelude.Text ->
  ListImports
newListImports :: Text -> ListImports
newListImports Text
pExportName_ =
  ListImports'
    { $sel:nextToken:ListImports' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:exportName:ListImports' :: Text
exportName = Text
pExportName_
    }

-- | A string (provided by the ListImports response output) that identifies
-- the next page of stacks that are importing the specified exported output
-- value.
listImports_nextToken :: Lens.Lens' ListImports (Prelude.Maybe Prelude.Text)
listImports_nextToken :: Lens' ListImports (Maybe Text)
listImports_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImports' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListImports' :: ListImports -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListImports
s@ListImports' {} Maybe Text
a -> ListImports
s {$sel:nextToken:ListImports' :: Maybe Text
nextToken = Maybe Text
a} :: ListImports)

-- | The name of the exported output value. CloudFormation returns the stack
-- names that are importing this value.
listImports_exportName :: Lens.Lens' ListImports Prelude.Text
listImports_exportName :: Lens' ListImports Text
listImports_exportName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImports' {Text
exportName :: Text
$sel:exportName:ListImports' :: ListImports -> Text
exportName} -> Text
exportName) (\s :: ListImports
s@ListImports' {} Text
a -> ListImports
s {$sel:exportName:ListImports' :: Text
exportName = Text
a} :: ListImports)

instance Core.AWSPager ListImports where
  page :: ListImports -> AWSResponse ListImports -> Maybe ListImports
page ListImports
rq AWSResponse ListImports
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListImports
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListImportsResponse (Maybe Text)
listImportsResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse ListImports
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListImportsResponse (Maybe [Text])
listImportsResponse_imports
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ ListImports
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' ListImports (Maybe Text)
listImports_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse ListImports
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' ListImportsResponse (Maybe Text)
listImportsResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest ListImports where
  type AWSResponse ListImports = ListImportsResponse
  request :: (Service -> Service) -> ListImports -> Request ListImports
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 ListImports
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ListImports)))
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
"ListImportsResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe [Text] -> Maybe Text -> Int -> ListImportsResponse
ListImportsResponse'
            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
"Imports"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"NextToken")
            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 ListImports where
  hashWithSalt :: Int -> ListImports -> Int
hashWithSalt Int
_salt ListImports' {Maybe Text
Text
exportName :: Text
nextToken :: Maybe Text
$sel:exportName:ListImports' :: ListImports -> Text
$sel:nextToken:ListImports' :: ListImports -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
exportName

instance Prelude.NFData ListImports where
  rnf :: ListImports -> ()
rnf ListImports' {Maybe Text
Text
exportName :: Text
nextToken :: Maybe Text
$sel:exportName:ListImports' :: ListImports -> Text
$sel:nextToken:ListImports' :: ListImports -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
exportName

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

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

instance Data.ToQuery ListImports where
  toQuery :: ListImports -> QueryString
toQuery ListImports' {Maybe Text
Text
exportName :: Text
nextToken :: Maybe Text
$sel:exportName:ListImports' :: ListImports -> Text
$sel:nextToken:ListImports' :: ListImports -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ListImports" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2010-05-15" :: Prelude.ByteString),
        ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"ExportName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
exportName
      ]

-- | /See:/ 'newListImportsResponse' smart constructor.
data ListImportsResponse = ListImportsResponse'
  { -- | A list of stack names that are importing the specified exported output
    -- value.
    ListImportsResponse -> Maybe [Text]
imports :: Prelude.Maybe [Prelude.Text],
    -- | A string that identifies the next page of exports. If there is no
    -- additional page, this value is null.
    ListImportsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ListImportsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ListImportsResponse -> ListImportsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListImportsResponse -> ListImportsResponse -> Bool
$c/= :: ListImportsResponse -> ListImportsResponse -> Bool
== :: ListImportsResponse -> ListImportsResponse -> Bool
$c== :: ListImportsResponse -> ListImportsResponse -> Bool
Prelude.Eq, ReadPrec [ListImportsResponse]
ReadPrec ListImportsResponse
Int -> ReadS ListImportsResponse
ReadS [ListImportsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListImportsResponse]
$creadListPrec :: ReadPrec [ListImportsResponse]
readPrec :: ReadPrec ListImportsResponse
$creadPrec :: ReadPrec ListImportsResponse
readList :: ReadS [ListImportsResponse]
$creadList :: ReadS [ListImportsResponse]
readsPrec :: Int -> ReadS ListImportsResponse
$creadsPrec :: Int -> ReadS ListImportsResponse
Prelude.Read, Int -> ListImportsResponse -> ShowS
[ListImportsResponse] -> ShowS
ListImportsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListImportsResponse] -> ShowS
$cshowList :: [ListImportsResponse] -> ShowS
show :: ListImportsResponse -> String
$cshow :: ListImportsResponse -> String
showsPrec :: Int -> ListImportsResponse -> ShowS
$cshowsPrec :: Int -> ListImportsResponse -> ShowS
Prelude.Show, forall x. Rep ListImportsResponse x -> ListImportsResponse
forall x. ListImportsResponse -> Rep ListImportsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ListImportsResponse x -> ListImportsResponse
$cfrom :: forall x. ListImportsResponse -> Rep ListImportsResponse x
Prelude.Generic)

-- |
-- Create a value of 'ListImportsResponse' 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:
--
-- 'imports', 'listImportsResponse_imports' - A list of stack names that are importing the specified exported output
-- value.
--
-- 'nextToken', 'listImportsResponse_nextToken' - A string that identifies the next page of exports. If there is no
-- additional page, this value is null.
--
-- 'httpStatus', 'listImportsResponse_httpStatus' - The response's http status code.
newListImportsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListImportsResponse
newListImportsResponse :: Int -> ListImportsResponse
newListImportsResponse Int
pHttpStatus_ =
  ListImportsResponse'
    { $sel:imports:ListImportsResponse' :: Maybe [Text]
imports = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListImportsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListImportsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of stack names that are importing the specified exported output
-- value.
listImportsResponse_imports :: Lens.Lens' ListImportsResponse (Prelude.Maybe [Prelude.Text])
listImportsResponse_imports :: Lens' ListImportsResponse (Maybe [Text])
listImportsResponse_imports = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportsResponse' {Maybe [Text]
imports :: Maybe [Text]
$sel:imports:ListImportsResponse' :: ListImportsResponse -> Maybe [Text]
imports} -> Maybe [Text]
imports) (\s :: ListImportsResponse
s@ListImportsResponse' {} Maybe [Text]
a -> ListImportsResponse
s {$sel:imports:ListImportsResponse' :: Maybe [Text]
imports = Maybe [Text]
a} :: ListImportsResponse) 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

-- | A string that identifies the next page of exports. If there is no
-- additional page, this value is null.
listImportsResponse_nextToken :: Lens.Lens' ListImportsResponse (Prelude.Maybe Prelude.Text)
listImportsResponse_nextToken :: Lens' ListImportsResponse (Maybe Text)
listImportsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:ListImportsResponse' :: ListImportsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: ListImportsResponse
s@ListImportsResponse' {} Maybe Text
a -> ListImportsResponse
s {$sel:nextToken:ListImportsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: ListImportsResponse)

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

instance Prelude.NFData ListImportsResponse where
  rnf :: ListImportsResponse -> ()
rnf ListImportsResponse' {Int
Maybe [Text]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
imports :: Maybe [Text]
$sel:httpStatus:ListImportsResponse' :: ListImportsResponse -> Int
$sel:nextToken:ListImportsResponse' :: ListImportsResponse -> Maybe Text
$sel:imports:ListImportsResponse' :: ListImportsResponse -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
imports
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus