{-# 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.LexV2Models.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 the imports for a bot, bot locale, or custom vocabulary. Imports
-- are kept in the list for 7 days.
module Amazonka.LexV2Models.ListImports
  ( -- * Creating a Request
    ListImports (..),
    newListImports,

    -- * Request Lenses
    listImports_botId,
    listImports_botVersion,
    listImports_filters,
    listImports_localeId,
    listImports_maxResults,
    listImports_nextToken,
    listImports_sortBy,

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

    -- * Response Lenses
    listImportsResponse_botId,
    listImportsResponse_botVersion,
    listImportsResponse_importSummaries,
    listImportsResponse_localeId,
    listImportsResponse_nextToken,
    listImportsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.LexV2Models.Types
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'
  { -- | The unique identifier that Amazon Lex assigned to the bot.
    ListImports -> Maybe Text
botId :: Prelude.Maybe Prelude.Text,
    -- | The version of the bot to list imports for.
    ListImports -> Maybe Text
botVersion :: Prelude.Maybe Prelude.Text,
    -- | Provides the specification of a filter used to limit the bots in the
    -- response to only those that match the filter specification. You can only
    -- specify one filter and one string to filter on.
    ListImports -> Maybe (NonEmpty ImportFilter)
filters :: Prelude.Maybe (Prelude.NonEmpty ImportFilter),
    -- | Specifies the locale that should be present in the list. If you don\'t
    -- specify a resource type in the @filters@ parameter, the list contains
    -- both bot locales and custom vocabularies.
    ListImports -> Maybe Text
localeId :: Prelude.Maybe Prelude.Text,
    -- | The maximum number of imports to return in each page of results. If
    -- there are fewer results than the max page size, only the actual number
    -- of results are returned.
    ListImports -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | If the response from the @ListImports@ operation contains more results
    -- than specified in the @maxResults@ parameter, a token is returned in the
    -- response.
    --
    -- Use the returned token in the @nextToken@ parameter of a @ListImports@
    -- request to return the next page of results. For a complete set of
    -- results, call the @ListImports@ operation until the @nextToken@ returned
    -- in the response is null.
    ListImports -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Determines the field that the list of imports is sorted by. You can sort
    -- by the @LastUpdatedDateTime@ field in ascending or descending order.
    ListImports -> Maybe ImportSortBy
sortBy :: Prelude.Maybe ImportSortBy
  }
  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:
--
-- 'botId', 'listImports_botId' - The unique identifier that Amazon Lex assigned to the bot.
--
-- 'botVersion', 'listImports_botVersion' - The version of the bot to list imports for.
--
-- 'filters', 'listImports_filters' - Provides the specification of a filter used to limit the bots in the
-- response to only those that match the filter specification. You can only
-- specify one filter and one string to filter on.
--
-- 'localeId', 'listImports_localeId' - Specifies the locale that should be present in the list. If you don\'t
-- specify a resource type in the @filters@ parameter, the list contains
-- both bot locales and custom vocabularies.
--
-- 'maxResults', 'listImports_maxResults' - The maximum number of imports to return in each page of results. If
-- there are fewer results than the max page size, only the actual number
-- of results are returned.
--
-- 'nextToken', 'listImports_nextToken' - If the response from the @ListImports@ operation contains more results
-- than specified in the @maxResults@ parameter, a token is returned in the
-- response.
--
-- Use the returned token in the @nextToken@ parameter of a @ListImports@
-- request to return the next page of results. For a complete set of
-- results, call the @ListImports@ operation until the @nextToken@ returned
-- in the response is null.
--
-- 'sortBy', 'listImports_sortBy' - Determines the field that the list of imports is sorted by. You can sort
-- by the @LastUpdatedDateTime@ field in ascending or descending order.
newListImports ::
  ListImports
newListImports :: ListImports
newListImports =
  ListImports'
    { $sel:botId:ListImports' :: Maybe Text
botId = forall a. Maybe a
Prelude.Nothing,
      $sel:botVersion:ListImports' :: Maybe Text
botVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:ListImports' :: Maybe (NonEmpty ImportFilter)
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:localeId:ListImports' :: Maybe Text
localeId = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:ListImports' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:ListImports' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sortBy:ListImports' :: Maybe ImportSortBy
sortBy = forall a. Maybe a
Prelude.Nothing
    }

-- | The unique identifier that Amazon Lex assigned to the bot.
listImports_botId :: Lens.Lens' ListImports (Prelude.Maybe Prelude.Text)
listImports_botId :: Lens' ListImports (Maybe Text)
listImports_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImports' {Maybe Text
botId :: Maybe Text
$sel:botId:ListImports' :: ListImports -> Maybe Text
botId} -> Maybe Text
botId) (\s :: ListImports
s@ListImports' {} Maybe Text
a -> ListImports
s {$sel:botId:ListImports' :: Maybe Text
botId = Maybe Text
a} :: ListImports)

-- | The version of the bot to list imports for.
listImports_botVersion :: Lens.Lens' ListImports (Prelude.Maybe Prelude.Text)
listImports_botVersion :: Lens' ListImports (Maybe Text)
listImports_botVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImports' {Maybe Text
botVersion :: Maybe Text
$sel:botVersion:ListImports' :: ListImports -> Maybe Text
botVersion} -> Maybe Text
botVersion) (\s :: ListImports
s@ListImports' {} Maybe Text
a -> ListImports
s {$sel:botVersion:ListImports' :: Maybe Text
botVersion = Maybe Text
a} :: ListImports)

-- | Provides the specification of a filter used to limit the bots in the
-- response to only those that match the filter specification. You can only
-- specify one filter and one string to filter on.
listImports_filters :: Lens.Lens' ListImports (Prelude.Maybe (Prelude.NonEmpty ImportFilter))
listImports_filters :: Lens' ListImports (Maybe (NonEmpty ImportFilter))
listImports_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImports' {Maybe (NonEmpty ImportFilter)
filters :: Maybe (NonEmpty ImportFilter)
$sel:filters:ListImports' :: ListImports -> Maybe (NonEmpty ImportFilter)
filters} -> Maybe (NonEmpty ImportFilter)
filters) (\s :: ListImports
s@ListImports' {} Maybe (NonEmpty ImportFilter)
a -> ListImports
s {$sel:filters:ListImports' :: Maybe (NonEmpty ImportFilter)
filters = Maybe (NonEmpty ImportFilter)
a} :: ListImports) 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

-- | Specifies the locale that should be present in the list. If you don\'t
-- specify a resource type in the @filters@ parameter, the list contains
-- both bot locales and custom vocabularies.
listImports_localeId :: Lens.Lens' ListImports (Prelude.Maybe Prelude.Text)
listImports_localeId :: Lens' ListImports (Maybe Text)
listImports_localeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImports' {Maybe Text
localeId :: Maybe Text
$sel:localeId:ListImports' :: ListImports -> Maybe Text
localeId} -> Maybe Text
localeId) (\s :: ListImports
s@ListImports' {} Maybe Text
a -> ListImports
s {$sel:localeId:ListImports' :: Maybe Text
localeId = Maybe Text
a} :: ListImports)

-- | The maximum number of imports to return in each page of results. If
-- there are fewer results than the max page size, only the actual number
-- of results are returned.
listImports_maxResults :: Lens.Lens' ListImports (Prelude.Maybe Prelude.Natural)
listImports_maxResults :: Lens' ListImports (Maybe Natural)
listImports_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImports' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:ListImports' :: ListImports -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: ListImports
s@ListImports' {} Maybe Natural
a -> ListImports
s {$sel:maxResults:ListImports' :: Maybe Natural
maxResults = Maybe Natural
a} :: ListImports)

-- | If the response from the @ListImports@ operation contains more results
-- than specified in the @maxResults@ parameter, a token is returned in the
-- response.
--
-- Use the returned token in the @nextToken@ parameter of a @ListImports@
-- request to return the next page of results. For a complete set of
-- results, call the @ListImports@ operation until the @nextToken@ returned
-- in the response is null.
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)

-- | Determines the field that the list of imports is sorted by. You can sort
-- by the @LastUpdatedDateTime@ field in ascending or descending order.
listImports_sortBy :: Lens.Lens' ListImports (Prelude.Maybe ImportSortBy)
listImports_sortBy :: Lens' ListImports (Maybe ImportSortBy)
listImports_sortBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImports' {Maybe ImportSortBy
sortBy :: Maybe ImportSortBy
$sel:sortBy:ListImports' :: ListImports -> Maybe ImportSortBy
sortBy} -> Maybe ImportSortBy
sortBy) (\s :: ListImports
s@ListImports' {} Maybe ImportSortBy
a -> ListImports
s {$sel:sortBy:ListImports' :: Maybe ImportSortBy
sortBy = Maybe ImportSortBy
a} :: ListImports)

instance Core.AWSRequest ListImports where
  type AWSResponse ListImports = ListImportsResponse
  request :: (Service -> Service) -> ListImports -> Request ListImports
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (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 =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe [ImportSummary]
-> Maybe Text
-> Maybe Text
-> Int
-> ListImportsResponse
ListImportsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"botId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"botVersion")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"importSummaries"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"localeId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"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 Natural
Maybe (NonEmpty ImportFilter)
Maybe Text
Maybe ImportSortBy
sortBy :: Maybe ImportSortBy
nextToken :: Maybe Text
maxResults :: Maybe Natural
localeId :: Maybe Text
filters :: Maybe (NonEmpty ImportFilter)
botVersion :: Maybe Text
botId :: Maybe Text
$sel:sortBy:ListImports' :: ListImports -> Maybe ImportSortBy
$sel:nextToken:ListImports' :: ListImports -> Maybe Text
$sel:maxResults:ListImports' :: ListImports -> Maybe Natural
$sel:localeId:ListImports' :: ListImports -> Maybe Text
$sel:filters:ListImports' :: ListImports -> Maybe (NonEmpty ImportFilter)
$sel:botVersion:ListImports' :: ListImports -> Maybe Text
$sel:botId:ListImports' :: ListImports -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
botId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
botVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty ImportFilter)
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
localeId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ImportSortBy
sortBy

instance Prelude.NFData ListImports where
  rnf :: ListImports -> ()
rnf ListImports' {Maybe Natural
Maybe (NonEmpty ImportFilter)
Maybe Text
Maybe ImportSortBy
sortBy :: Maybe ImportSortBy
nextToken :: Maybe Text
maxResults :: Maybe Natural
localeId :: Maybe Text
filters :: Maybe (NonEmpty ImportFilter)
botVersion :: Maybe Text
botId :: Maybe Text
$sel:sortBy:ListImports' :: ListImports -> Maybe ImportSortBy
$sel:nextToken:ListImports' :: ListImports -> Maybe Text
$sel:maxResults:ListImports' :: ListImports -> Maybe Natural
$sel:localeId:ListImports' :: ListImports -> Maybe Text
$sel:filters:ListImports' :: ListImports -> Maybe (NonEmpty ImportFilter)
$sel:botVersion:ListImports' :: ListImports -> Maybe Text
$sel:botId:ListImports' :: ListImports -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty ImportFilter)
filters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
localeId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      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 Maybe ImportSortBy
sortBy

instance Data.ToHeaders ListImports where
  toHeaders :: ListImports -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON ListImports where
  toJSON :: ListImports -> Value
toJSON ListImports' {Maybe Natural
Maybe (NonEmpty ImportFilter)
Maybe Text
Maybe ImportSortBy
sortBy :: Maybe ImportSortBy
nextToken :: Maybe Text
maxResults :: Maybe Natural
localeId :: Maybe Text
filters :: Maybe (NonEmpty ImportFilter)
botVersion :: Maybe Text
botId :: Maybe Text
$sel:sortBy:ListImports' :: ListImports -> Maybe ImportSortBy
$sel:nextToken:ListImports' :: ListImports -> Maybe Text
$sel:maxResults:ListImports' :: ListImports -> Maybe Natural
$sel:localeId:ListImports' :: ListImports -> Maybe Text
$sel:filters:ListImports' :: ListImports -> Maybe (NonEmpty ImportFilter)
$sel:botVersion:ListImports' :: ListImports -> Maybe Text
$sel:botId:ListImports' :: ListImports -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"botId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
botId,
            (Key
"botVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
botVersion,
            (Key
"filters" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty ImportFilter)
filters,
            (Key
"localeId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
localeId,
            (Key
"maxResults" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
maxResults,
            (Key
"nextToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
nextToken,
            (Key
"sortBy" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe ImportSortBy
sortBy
          ]
      )

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

instance Data.ToQuery ListImports where
  toQuery :: ListImports -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newListImportsResponse' smart constructor.
data ListImportsResponse = ListImportsResponse'
  { -- | The unique identifier assigned by Amazon Lex to the bot.
    ListImportsResponse -> Maybe Text
botId :: Prelude.Maybe Prelude.Text,
    -- | The version of the bot that was imported. It will always be @DRAFT@.
    ListImportsResponse -> Maybe Text
botVersion :: Prelude.Maybe Prelude.Text,
    -- | Summary information for the imports that meet the filter criteria
    -- specified in the request. The length of the list is specified in the
    -- @maxResults@ parameter. If there are more imports available, the
    -- @nextToken@ field contains a token to get the next page of results.
    ListImportsResponse -> Maybe [ImportSummary]
importSummaries :: Prelude.Maybe [ImportSummary],
    -- | The locale specified in the request.
    ListImportsResponse -> Maybe Text
localeId :: Prelude.Maybe Prelude.Text,
    -- | A token that indicates whether there are more results to return in a
    -- response to the @ListImports@ operation. If the @nextToken@ field is
    -- present, you send the contents as the @nextToken@ parameter of a
    -- @ListImports@ operation request to get the next page of results.
    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:
--
-- 'botId', 'listImportsResponse_botId' - The unique identifier assigned by Amazon Lex to the bot.
--
-- 'botVersion', 'listImportsResponse_botVersion' - The version of the bot that was imported. It will always be @DRAFT@.
--
-- 'importSummaries', 'listImportsResponse_importSummaries' - Summary information for the imports that meet the filter criteria
-- specified in the request. The length of the list is specified in the
-- @maxResults@ parameter. If there are more imports available, the
-- @nextToken@ field contains a token to get the next page of results.
--
-- 'localeId', 'listImportsResponse_localeId' - The locale specified in the request.
--
-- 'nextToken', 'listImportsResponse_nextToken' - A token that indicates whether there are more results to return in a
-- response to the @ListImports@ operation. If the @nextToken@ field is
-- present, you send the contents as the @nextToken@ parameter of a
-- @ListImports@ operation request to get the next page of results.
--
-- 'httpStatus', 'listImportsResponse_httpStatus' - The response's http status code.
newListImportsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListImportsResponse
newListImportsResponse :: Int -> ListImportsResponse
newListImportsResponse Int
pHttpStatus_ =
  ListImportsResponse'
    { $sel:botId:ListImportsResponse' :: Maybe Text
botId = forall a. Maybe a
Prelude.Nothing,
      $sel:botVersion:ListImportsResponse' :: Maybe Text
botVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:importSummaries:ListImportsResponse' :: Maybe [ImportSummary]
importSummaries = forall a. Maybe a
Prelude.Nothing,
      $sel:localeId:ListImportsResponse' :: Maybe Text
localeId = 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_
    }

-- | The unique identifier assigned by Amazon Lex to the bot.
listImportsResponse_botId :: Lens.Lens' ListImportsResponse (Prelude.Maybe Prelude.Text)
listImportsResponse_botId :: Lens' ListImportsResponse (Maybe Text)
listImportsResponse_botId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportsResponse' {Maybe Text
botId :: Maybe Text
$sel:botId:ListImportsResponse' :: ListImportsResponse -> Maybe Text
botId} -> Maybe Text
botId) (\s :: ListImportsResponse
s@ListImportsResponse' {} Maybe Text
a -> ListImportsResponse
s {$sel:botId:ListImportsResponse' :: Maybe Text
botId = Maybe Text
a} :: ListImportsResponse)

-- | The version of the bot that was imported. It will always be @DRAFT@.
listImportsResponse_botVersion :: Lens.Lens' ListImportsResponse (Prelude.Maybe Prelude.Text)
listImportsResponse_botVersion :: Lens' ListImportsResponse (Maybe Text)
listImportsResponse_botVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportsResponse' {Maybe Text
botVersion :: Maybe Text
$sel:botVersion:ListImportsResponse' :: ListImportsResponse -> Maybe Text
botVersion} -> Maybe Text
botVersion) (\s :: ListImportsResponse
s@ListImportsResponse' {} Maybe Text
a -> ListImportsResponse
s {$sel:botVersion:ListImportsResponse' :: Maybe Text
botVersion = Maybe Text
a} :: ListImportsResponse)

-- | Summary information for the imports that meet the filter criteria
-- specified in the request. The length of the list is specified in the
-- @maxResults@ parameter. If there are more imports available, the
-- @nextToken@ field contains a token to get the next page of results.
listImportsResponse_importSummaries :: Lens.Lens' ListImportsResponse (Prelude.Maybe [ImportSummary])
listImportsResponse_importSummaries :: Lens' ListImportsResponse (Maybe [ImportSummary])
listImportsResponse_importSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportsResponse' {Maybe [ImportSummary]
importSummaries :: Maybe [ImportSummary]
$sel:importSummaries:ListImportsResponse' :: ListImportsResponse -> Maybe [ImportSummary]
importSummaries} -> Maybe [ImportSummary]
importSummaries) (\s :: ListImportsResponse
s@ListImportsResponse' {} Maybe [ImportSummary]
a -> ListImportsResponse
s {$sel:importSummaries:ListImportsResponse' :: Maybe [ImportSummary]
importSummaries = Maybe [ImportSummary]
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

-- | The locale specified in the request.
listImportsResponse_localeId :: Lens.Lens' ListImportsResponse (Prelude.Maybe Prelude.Text)
listImportsResponse_localeId :: Lens' ListImportsResponse (Maybe Text)
listImportsResponse_localeId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListImportsResponse' {Maybe Text
localeId :: Maybe Text
$sel:localeId:ListImportsResponse' :: ListImportsResponse -> Maybe Text
localeId} -> Maybe Text
localeId) (\s :: ListImportsResponse
s@ListImportsResponse' {} Maybe Text
a -> ListImportsResponse
s {$sel:localeId:ListImportsResponse' :: Maybe Text
localeId = Maybe Text
a} :: ListImportsResponse)

-- | A token that indicates whether there are more results to return in a
-- response to the @ListImports@ operation. If the @nextToken@ field is
-- present, you send the contents as the @nextToken@ parameter of a
-- @ListImports@ operation request to get the next page of results.
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 [ImportSummary]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
localeId :: Maybe Text
importSummaries :: Maybe [ImportSummary]
botVersion :: Maybe Text
botId :: Maybe Text
$sel:httpStatus:ListImportsResponse' :: ListImportsResponse -> Int
$sel:nextToken:ListImportsResponse' :: ListImportsResponse -> Maybe Text
$sel:localeId:ListImportsResponse' :: ListImportsResponse -> Maybe Text
$sel:importSummaries:ListImportsResponse' :: ListImportsResponse -> Maybe [ImportSummary]
$sel:botVersion:ListImportsResponse' :: ListImportsResponse -> Maybe Text
$sel:botId:ListImportsResponse' :: ListImportsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
botVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ImportSummary]
importSummaries
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
localeId
      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