{-# 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.LexModels.GetMigrations
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets a list of migrations between Amazon Lex V1 and Amazon Lex V2.
module Amazonka.LexModels.GetMigrations
  ( -- * Creating a Request
    GetMigrations (..),
    newGetMigrations,

    -- * Request Lenses
    getMigrations_maxResults,
    getMigrations_migrationStatusEquals,
    getMigrations_nextToken,
    getMigrations_sortByAttribute,
    getMigrations_sortByOrder,
    getMigrations_v1BotNameContains,

    -- * Destructuring the Response
    GetMigrationsResponse (..),
    newGetMigrationsResponse,

    -- * Response Lenses
    getMigrationsResponse_migrationSummaries,
    getMigrationsResponse_nextToken,
    getMigrationsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.LexModels.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetMigrations' smart constructor.
data GetMigrations = GetMigrations'
  { -- | The maximum number of migrations to return in the response. The default
    -- is 10.
    GetMigrations -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | Filters the list to contain only migrations in the specified state.
    GetMigrations -> Maybe MigrationStatus
migrationStatusEquals :: Prelude.Maybe MigrationStatus,
    -- | A pagination token that fetches the next page of migrations. If the
    -- response to this operation is truncated, Amazon Lex returns a pagination
    -- token in the response. To fetch the next page of migrations, specify the
    -- pagination token in the request.
    GetMigrations -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The field to sort the list of migrations by. You can sort by the Amazon
    -- Lex V1 bot name or the date and time that the migration was started.
    GetMigrations -> Maybe MigrationSortAttribute
sortByAttribute :: Prelude.Maybe MigrationSortAttribute,
    -- | The order so sort the list.
    GetMigrations -> Maybe SortOrder
sortByOrder :: Prelude.Maybe SortOrder,
    -- | Filters the list to contain only bots whose name contains the specified
    -- string. The string is matched anywhere in bot name.
    GetMigrations -> Maybe Text
v1BotNameContains :: Prelude.Maybe Prelude.Text
  }
  deriving (GetMigrations -> GetMigrations -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMigrations -> GetMigrations -> Bool
$c/= :: GetMigrations -> GetMigrations -> Bool
== :: GetMigrations -> GetMigrations -> Bool
$c== :: GetMigrations -> GetMigrations -> Bool
Prelude.Eq, ReadPrec [GetMigrations]
ReadPrec GetMigrations
Int -> ReadS GetMigrations
ReadS [GetMigrations]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMigrations]
$creadListPrec :: ReadPrec [GetMigrations]
readPrec :: ReadPrec GetMigrations
$creadPrec :: ReadPrec GetMigrations
readList :: ReadS [GetMigrations]
$creadList :: ReadS [GetMigrations]
readsPrec :: Int -> ReadS GetMigrations
$creadsPrec :: Int -> ReadS GetMigrations
Prelude.Read, Int -> GetMigrations -> ShowS
[GetMigrations] -> ShowS
GetMigrations -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMigrations] -> ShowS
$cshowList :: [GetMigrations] -> ShowS
show :: GetMigrations -> String
$cshow :: GetMigrations -> String
showsPrec :: Int -> GetMigrations -> ShowS
$cshowsPrec :: Int -> GetMigrations -> ShowS
Prelude.Show, forall x. Rep GetMigrations x -> GetMigrations
forall x. GetMigrations -> Rep GetMigrations x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMigrations x -> GetMigrations
$cfrom :: forall x. GetMigrations -> Rep GetMigrations x
Prelude.Generic)

-- |
-- Create a value of 'GetMigrations' 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:
--
-- 'maxResults', 'getMigrations_maxResults' - The maximum number of migrations to return in the response. The default
-- is 10.
--
-- 'migrationStatusEquals', 'getMigrations_migrationStatusEquals' - Filters the list to contain only migrations in the specified state.
--
-- 'nextToken', 'getMigrations_nextToken' - A pagination token that fetches the next page of migrations. If the
-- response to this operation is truncated, Amazon Lex returns a pagination
-- token in the response. To fetch the next page of migrations, specify the
-- pagination token in the request.
--
-- 'sortByAttribute', 'getMigrations_sortByAttribute' - The field to sort the list of migrations by. You can sort by the Amazon
-- Lex V1 bot name or the date and time that the migration was started.
--
-- 'sortByOrder', 'getMigrations_sortByOrder' - The order so sort the list.
--
-- 'v1BotNameContains', 'getMigrations_v1BotNameContains' - Filters the list to contain only bots whose name contains the specified
-- string. The string is matched anywhere in bot name.
newGetMigrations ::
  GetMigrations
newGetMigrations :: GetMigrations
newGetMigrations =
  GetMigrations'
    { $sel:maxResults:GetMigrations' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:migrationStatusEquals:GetMigrations' :: Maybe MigrationStatus
migrationStatusEquals = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetMigrations' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:sortByAttribute:GetMigrations' :: Maybe MigrationSortAttribute
sortByAttribute = forall a. Maybe a
Prelude.Nothing,
      $sel:sortByOrder:GetMigrations' :: Maybe SortOrder
sortByOrder = forall a. Maybe a
Prelude.Nothing,
      $sel:v1BotNameContains:GetMigrations' :: Maybe Text
v1BotNameContains = forall a. Maybe a
Prelude.Nothing
    }

-- | The maximum number of migrations to return in the response. The default
-- is 10.
getMigrations_maxResults :: Lens.Lens' GetMigrations (Prelude.Maybe Prelude.Natural)
getMigrations_maxResults :: Lens' GetMigrations (Maybe Natural)
getMigrations_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrations' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetMigrations' :: GetMigrations -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetMigrations
s@GetMigrations' {} Maybe Natural
a -> GetMigrations
s {$sel:maxResults:GetMigrations' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetMigrations)

-- | Filters the list to contain only migrations in the specified state.
getMigrations_migrationStatusEquals :: Lens.Lens' GetMigrations (Prelude.Maybe MigrationStatus)
getMigrations_migrationStatusEquals :: Lens' GetMigrations (Maybe MigrationStatus)
getMigrations_migrationStatusEquals = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrations' {Maybe MigrationStatus
migrationStatusEquals :: Maybe MigrationStatus
$sel:migrationStatusEquals:GetMigrations' :: GetMigrations -> Maybe MigrationStatus
migrationStatusEquals} -> Maybe MigrationStatus
migrationStatusEquals) (\s :: GetMigrations
s@GetMigrations' {} Maybe MigrationStatus
a -> GetMigrations
s {$sel:migrationStatusEquals:GetMigrations' :: Maybe MigrationStatus
migrationStatusEquals = Maybe MigrationStatus
a} :: GetMigrations)

-- | A pagination token that fetches the next page of migrations. If the
-- response to this operation is truncated, Amazon Lex returns a pagination
-- token in the response. To fetch the next page of migrations, specify the
-- pagination token in the request.
getMigrations_nextToken :: Lens.Lens' GetMigrations (Prelude.Maybe Prelude.Text)
getMigrations_nextToken :: Lens' GetMigrations (Maybe Text)
getMigrations_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrations' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetMigrations' :: GetMigrations -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetMigrations
s@GetMigrations' {} Maybe Text
a -> GetMigrations
s {$sel:nextToken:GetMigrations' :: Maybe Text
nextToken = Maybe Text
a} :: GetMigrations)

-- | The field to sort the list of migrations by. You can sort by the Amazon
-- Lex V1 bot name or the date and time that the migration was started.
getMigrations_sortByAttribute :: Lens.Lens' GetMigrations (Prelude.Maybe MigrationSortAttribute)
getMigrations_sortByAttribute :: Lens' GetMigrations (Maybe MigrationSortAttribute)
getMigrations_sortByAttribute = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrations' {Maybe MigrationSortAttribute
sortByAttribute :: Maybe MigrationSortAttribute
$sel:sortByAttribute:GetMigrations' :: GetMigrations -> Maybe MigrationSortAttribute
sortByAttribute} -> Maybe MigrationSortAttribute
sortByAttribute) (\s :: GetMigrations
s@GetMigrations' {} Maybe MigrationSortAttribute
a -> GetMigrations
s {$sel:sortByAttribute:GetMigrations' :: Maybe MigrationSortAttribute
sortByAttribute = Maybe MigrationSortAttribute
a} :: GetMigrations)

-- | The order so sort the list.
getMigrations_sortByOrder :: Lens.Lens' GetMigrations (Prelude.Maybe SortOrder)
getMigrations_sortByOrder :: Lens' GetMigrations (Maybe SortOrder)
getMigrations_sortByOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrations' {Maybe SortOrder
sortByOrder :: Maybe SortOrder
$sel:sortByOrder:GetMigrations' :: GetMigrations -> Maybe SortOrder
sortByOrder} -> Maybe SortOrder
sortByOrder) (\s :: GetMigrations
s@GetMigrations' {} Maybe SortOrder
a -> GetMigrations
s {$sel:sortByOrder:GetMigrations' :: Maybe SortOrder
sortByOrder = Maybe SortOrder
a} :: GetMigrations)

-- | Filters the list to contain only bots whose name contains the specified
-- string. The string is matched anywhere in bot name.
getMigrations_v1BotNameContains :: Lens.Lens' GetMigrations (Prelude.Maybe Prelude.Text)
getMigrations_v1BotNameContains :: Lens' GetMigrations (Maybe Text)
getMigrations_v1BotNameContains = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrations' {Maybe Text
v1BotNameContains :: Maybe Text
$sel:v1BotNameContains:GetMigrations' :: GetMigrations -> Maybe Text
v1BotNameContains} -> Maybe Text
v1BotNameContains) (\s :: GetMigrations
s@GetMigrations' {} Maybe Text
a -> GetMigrations
s {$sel:v1BotNameContains:GetMigrations' :: Maybe Text
v1BotNameContains = Maybe Text
a} :: GetMigrations)

instance Core.AWSRequest GetMigrations where
  type
    AWSResponse GetMigrations =
      GetMigrationsResponse
  request :: (Service -> Service) -> GetMigrations -> Request GetMigrations
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetMigrations
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetMigrations)))
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 [MigrationSummary]
-> Maybe Text -> Int -> GetMigrationsResponse
GetMigrationsResponse'
            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
"migrationSummaries"
                            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
"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 GetMigrations where
  hashWithSalt :: Int -> GetMigrations -> Int
hashWithSalt Int
_salt GetMigrations' {Maybe Natural
Maybe Text
Maybe MigrationSortAttribute
Maybe MigrationStatus
Maybe SortOrder
v1BotNameContains :: Maybe Text
sortByOrder :: Maybe SortOrder
sortByAttribute :: Maybe MigrationSortAttribute
nextToken :: Maybe Text
migrationStatusEquals :: Maybe MigrationStatus
maxResults :: Maybe Natural
$sel:v1BotNameContains:GetMigrations' :: GetMigrations -> Maybe Text
$sel:sortByOrder:GetMigrations' :: GetMigrations -> Maybe SortOrder
$sel:sortByAttribute:GetMigrations' :: GetMigrations -> Maybe MigrationSortAttribute
$sel:nextToken:GetMigrations' :: GetMigrations -> Maybe Text
$sel:migrationStatusEquals:GetMigrations' :: GetMigrations -> Maybe MigrationStatus
$sel:maxResults:GetMigrations' :: GetMigrations -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MigrationStatus
migrationStatusEquals
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MigrationSortAttribute
sortByAttribute
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SortOrder
sortByOrder
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
v1BotNameContains

instance Prelude.NFData GetMigrations where
  rnf :: GetMigrations -> ()
rnf GetMigrations' {Maybe Natural
Maybe Text
Maybe MigrationSortAttribute
Maybe MigrationStatus
Maybe SortOrder
v1BotNameContains :: Maybe Text
sortByOrder :: Maybe SortOrder
sortByAttribute :: Maybe MigrationSortAttribute
nextToken :: Maybe Text
migrationStatusEquals :: Maybe MigrationStatus
maxResults :: Maybe Natural
$sel:v1BotNameContains:GetMigrations' :: GetMigrations -> Maybe Text
$sel:sortByOrder:GetMigrations' :: GetMigrations -> Maybe SortOrder
$sel:sortByAttribute:GetMigrations' :: GetMigrations -> Maybe MigrationSortAttribute
$sel:nextToken:GetMigrations' :: GetMigrations -> Maybe Text
$sel:migrationStatusEquals:GetMigrations' :: GetMigrations -> Maybe MigrationStatus
$sel:maxResults:GetMigrations' :: GetMigrations -> Maybe Natural
..} =
    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 MigrationStatus
migrationStatusEquals
      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 MigrationSortAttribute
sortByAttribute
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SortOrder
sortByOrder
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
v1BotNameContains

instance Data.ToHeaders GetMigrations where
  toHeaders :: GetMigrations -> 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.ToPath GetMigrations where
  toPath :: GetMigrations -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/migrations"

instance Data.ToQuery GetMigrations where
  toQuery :: GetMigrations -> QueryString
toQuery GetMigrations' {Maybe Natural
Maybe Text
Maybe MigrationSortAttribute
Maybe MigrationStatus
Maybe SortOrder
v1BotNameContains :: Maybe Text
sortByOrder :: Maybe SortOrder
sortByAttribute :: Maybe MigrationSortAttribute
nextToken :: Maybe Text
migrationStatusEquals :: Maybe MigrationStatus
maxResults :: Maybe Natural
$sel:v1BotNameContains:GetMigrations' :: GetMigrations -> Maybe Text
$sel:sortByOrder:GetMigrations' :: GetMigrations -> Maybe SortOrder
$sel:sortByAttribute:GetMigrations' :: GetMigrations -> Maybe MigrationSortAttribute
$sel:nextToken:GetMigrations' :: GetMigrations -> Maybe Text
$sel:migrationStatusEquals:GetMigrations' :: GetMigrations -> Maybe MigrationStatus
$sel:maxResults:GetMigrations' :: GetMigrations -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"migrationStatusEquals"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe MigrationStatus
migrationStatusEquals,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"sortByAttribute" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe MigrationSortAttribute
sortByAttribute,
        ByteString
"sortByOrder" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe SortOrder
sortByOrder,
        ByteString
"v1BotNameContains" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
v1BotNameContains
      ]

-- | /See:/ 'newGetMigrationsResponse' smart constructor.
data GetMigrationsResponse = GetMigrationsResponse'
  { -- | An array of summaries for migrations from Amazon Lex V1 to Amazon Lex
    -- V2. To see details of the migration, use the @migrationId@ from the
    -- summary in a call to the operation.
    GetMigrationsResponse -> Maybe [MigrationSummary]
migrationSummaries :: Prelude.Maybe [MigrationSummary],
    -- | If the response is truncated, it includes a pagination token that you
    -- can specify in your next request to fetch the next page of migrations.
    GetMigrationsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetMigrationsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetMigrationsResponse -> GetMigrationsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMigrationsResponse -> GetMigrationsResponse -> Bool
$c/= :: GetMigrationsResponse -> GetMigrationsResponse -> Bool
== :: GetMigrationsResponse -> GetMigrationsResponse -> Bool
$c== :: GetMigrationsResponse -> GetMigrationsResponse -> Bool
Prelude.Eq, ReadPrec [GetMigrationsResponse]
ReadPrec GetMigrationsResponse
Int -> ReadS GetMigrationsResponse
ReadS [GetMigrationsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMigrationsResponse]
$creadListPrec :: ReadPrec [GetMigrationsResponse]
readPrec :: ReadPrec GetMigrationsResponse
$creadPrec :: ReadPrec GetMigrationsResponse
readList :: ReadS [GetMigrationsResponse]
$creadList :: ReadS [GetMigrationsResponse]
readsPrec :: Int -> ReadS GetMigrationsResponse
$creadsPrec :: Int -> ReadS GetMigrationsResponse
Prelude.Read, Int -> GetMigrationsResponse -> ShowS
[GetMigrationsResponse] -> ShowS
GetMigrationsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMigrationsResponse] -> ShowS
$cshowList :: [GetMigrationsResponse] -> ShowS
show :: GetMigrationsResponse -> String
$cshow :: GetMigrationsResponse -> String
showsPrec :: Int -> GetMigrationsResponse -> ShowS
$cshowsPrec :: Int -> GetMigrationsResponse -> ShowS
Prelude.Show, forall x. Rep GetMigrationsResponse x -> GetMigrationsResponse
forall x. GetMigrationsResponse -> Rep GetMigrationsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMigrationsResponse x -> GetMigrationsResponse
$cfrom :: forall x. GetMigrationsResponse -> Rep GetMigrationsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetMigrationsResponse' 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:
--
-- 'migrationSummaries', 'getMigrationsResponse_migrationSummaries' - An array of summaries for migrations from Amazon Lex V1 to Amazon Lex
-- V2. To see details of the migration, use the @migrationId@ from the
-- summary in a call to the operation.
--
-- 'nextToken', 'getMigrationsResponse_nextToken' - If the response is truncated, it includes a pagination token that you
-- can specify in your next request to fetch the next page of migrations.
--
-- 'httpStatus', 'getMigrationsResponse_httpStatus' - The response's http status code.
newGetMigrationsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMigrationsResponse
newGetMigrationsResponse :: Int -> GetMigrationsResponse
newGetMigrationsResponse Int
pHttpStatus_ =
  GetMigrationsResponse'
    { $sel:migrationSummaries:GetMigrationsResponse' :: Maybe [MigrationSummary]
migrationSummaries =
        forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetMigrationsResponse' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetMigrationsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An array of summaries for migrations from Amazon Lex V1 to Amazon Lex
-- V2. To see details of the migration, use the @migrationId@ from the
-- summary in a call to the operation.
getMigrationsResponse_migrationSummaries :: Lens.Lens' GetMigrationsResponse (Prelude.Maybe [MigrationSummary])
getMigrationsResponse_migrationSummaries :: Lens' GetMigrationsResponse (Maybe [MigrationSummary])
getMigrationsResponse_migrationSummaries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrationsResponse' {Maybe [MigrationSummary]
migrationSummaries :: Maybe [MigrationSummary]
$sel:migrationSummaries:GetMigrationsResponse' :: GetMigrationsResponse -> Maybe [MigrationSummary]
migrationSummaries} -> Maybe [MigrationSummary]
migrationSummaries) (\s :: GetMigrationsResponse
s@GetMigrationsResponse' {} Maybe [MigrationSummary]
a -> GetMigrationsResponse
s {$sel:migrationSummaries:GetMigrationsResponse' :: Maybe [MigrationSummary]
migrationSummaries = Maybe [MigrationSummary]
a} :: GetMigrationsResponse) 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

-- | If the response is truncated, it includes a pagination token that you
-- can specify in your next request to fetch the next page of migrations.
getMigrationsResponse_nextToken :: Lens.Lens' GetMigrationsResponse (Prelude.Maybe Prelude.Text)
getMigrationsResponse_nextToken :: Lens' GetMigrationsResponse (Maybe Text)
getMigrationsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrationsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetMigrationsResponse' :: GetMigrationsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetMigrationsResponse
s@GetMigrationsResponse' {} Maybe Text
a -> GetMigrationsResponse
s {$sel:nextToken:GetMigrationsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetMigrationsResponse)

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

instance Prelude.NFData GetMigrationsResponse where
  rnf :: GetMigrationsResponse -> ()
rnf GetMigrationsResponse' {Int
Maybe [MigrationSummary]
Maybe Text
httpStatus :: Int
nextToken :: Maybe Text
migrationSummaries :: Maybe [MigrationSummary]
$sel:httpStatus:GetMigrationsResponse' :: GetMigrationsResponse -> Int
$sel:nextToken:GetMigrationsResponse' :: GetMigrationsResponse -> Maybe Text
$sel:migrationSummaries:GetMigrationsResponse' :: GetMigrationsResponse -> Maybe [MigrationSummary]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [MigrationSummary]
migrationSummaries
      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