{-# 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.GetMigration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides details about an ongoing or complete migration from an Amazon
-- Lex V1 bot to an Amazon Lex V2 bot. Use this operation to view the
-- migration alerts and warnings related to the migration.
module Amazonka.LexModels.GetMigration
  ( -- * Creating a Request
    GetMigration (..),
    newGetMigration,

    -- * Request Lenses
    getMigration_migrationId,

    -- * Destructuring the Response
    GetMigrationResponse (..),
    newGetMigrationResponse,

    -- * Response Lenses
    getMigrationResponse_alerts,
    getMigrationResponse_migrationId,
    getMigrationResponse_migrationStatus,
    getMigrationResponse_migrationStrategy,
    getMigrationResponse_migrationTimestamp,
    getMigrationResponse_v1BotLocale,
    getMigrationResponse_v1BotName,
    getMigrationResponse_v1BotVersion,
    getMigrationResponse_v2BotId,
    getMigrationResponse_v2BotRole,
    getMigrationResponse_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:/ 'newGetMigration' smart constructor.
data GetMigration = GetMigration'
  { -- | The unique identifier of the migration to view. The @migrationID@ is
    -- returned by the operation.
    GetMigration -> Text
migrationId :: Prelude.Text
  }
  deriving (GetMigration -> GetMigration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMigration -> GetMigration -> Bool
$c/= :: GetMigration -> GetMigration -> Bool
== :: GetMigration -> GetMigration -> Bool
$c== :: GetMigration -> GetMigration -> Bool
Prelude.Eq, ReadPrec [GetMigration]
ReadPrec GetMigration
Int -> ReadS GetMigration
ReadS [GetMigration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMigration]
$creadListPrec :: ReadPrec [GetMigration]
readPrec :: ReadPrec GetMigration
$creadPrec :: ReadPrec GetMigration
readList :: ReadS [GetMigration]
$creadList :: ReadS [GetMigration]
readsPrec :: Int -> ReadS GetMigration
$creadsPrec :: Int -> ReadS GetMigration
Prelude.Read, Int -> GetMigration -> ShowS
[GetMigration] -> ShowS
GetMigration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMigration] -> ShowS
$cshowList :: [GetMigration] -> ShowS
show :: GetMigration -> String
$cshow :: GetMigration -> String
showsPrec :: Int -> GetMigration -> ShowS
$cshowsPrec :: Int -> GetMigration -> ShowS
Prelude.Show, forall x. Rep GetMigration x -> GetMigration
forall x. GetMigration -> Rep GetMigration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMigration x -> GetMigration
$cfrom :: forall x. GetMigration -> Rep GetMigration x
Prelude.Generic)

-- |
-- Create a value of 'GetMigration' 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:
--
-- 'migrationId', 'getMigration_migrationId' - The unique identifier of the migration to view. The @migrationID@ is
-- returned by the operation.
newGetMigration ::
  -- | 'migrationId'
  Prelude.Text ->
  GetMigration
newGetMigration :: Text -> GetMigration
newGetMigration Text
pMigrationId_ =
  GetMigration' {$sel:migrationId:GetMigration' :: Text
migrationId = Text
pMigrationId_}

-- | The unique identifier of the migration to view. The @migrationID@ is
-- returned by the operation.
getMigration_migrationId :: Lens.Lens' GetMigration Prelude.Text
getMigration_migrationId :: Lens' GetMigration Text
getMigration_migrationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigration' {Text
migrationId :: Text
$sel:migrationId:GetMigration' :: GetMigration -> Text
migrationId} -> Text
migrationId) (\s :: GetMigration
s@GetMigration' {} Text
a -> GetMigration
s {$sel:migrationId:GetMigration' :: Text
migrationId = Text
a} :: GetMigration)

instance Core.AWSRequest GetMigration where
  type AWSResponse GetMigration = GetMigrationResponse
  request :: (Service -> Service) -> GetMigration -> Request GetMigration
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 GetMigration
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetMigration)))
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 [MigrationAlert]
-> Maybe Text
-> Maybe MigrationStatus
-> Maybe MigrationStrategy
-> Maybe POSIX
-> Maybe Locale
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Int
-> GetMigrationResponse
GetMigrationResponse'
            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
"alerts" 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
"migrationId")
            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
"migrationStatus")
            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
"migrationStrategy")
            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
"migrationTimestamp")
            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
"v1BotLocale")
            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
"v1BotName")
            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
"v1BotVersion")
            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
"v2BotId")
            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
"v2BotRole")
            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 GetMigration where
  hashWithSalt :: Int -> GetMigration -> Int
hashWithSalt Int
_salt GetMigration' {Text
migrationId :: Text
$sel:migrationId:GetMigration' :: GetMigration -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
migrationId

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

instance Data.ToHeaders GetMigration where
  toHeaders :: GetMigration -> 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 GetMigration where
  toPath :: GetMigration -> ByteString
toPath GetMigration' {Text
migrationId :: Text
$sel:migrationId:GetMigration' :: GetMigration -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/migrations/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
migrationId]

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

-- | /See:/ 'newGetMigrationResponse' smart constructor.
data GetMigrationResponse = GetMigrationResponse'
  { -- | A list of alerts and warnings that indicate issues with the migration
    -- for the Amazon Lex V1 bot to Amazon Lex V2. You receive a warning when
    -- an Amazon Lex V1 feature has a different implementation if Amazon Lex
    -- V2.
    --
    -- For more information, see
    -- <https://docs.aws.amazon.com/lexv2/latest/dg/migrate.html Migrating a bot>
    -- in the /Amazon Lex V2 developer guide/.
    GetMigrationResponse -> Maybe [MigrationAlert]
alerts :: Prelude.Maybe [MigrationAlert],
    -- | The unique identifier of the migration. This is the same as the
    -- identifier used when calling the @GetMigration@ operation.
    GetMigrationResponse -> Maybe Text
migrationId :: Prelude.Maybe Prelude.Text,
    -- | Indicates the status of the migration. When the status is @COMPLETE@ the
    -- migration is finished and the bot is available in Amazon Lex V2. There
    -- may be alerts and warnings that need to be resolved to complete the
    -- migration.
    GetMigrationResponse -> Maybe MigrationStatus
migrationStatus :: Prelude.Maybe MigrationStatus,
    -- | The strategy used to conduct the migration.
    --
    -- -   @CREATE_NEW@ - Creates a new Amazon Lex V2 bot and migrates the
    --     Amazon Lex V1 bot to the new bot.
    --
    -- -   @UPDATE_EXISTING@ - Overwrites the existing Amazon Lex V2 bot
    --     metadata and the locale being migrated. It doesn\'t change any other
    --     locales in the Amazon Lex V2 bot. If the locale doesn\'t exist, a
    --     new locale is created in the Amazon Lex V2 bot.
    GetMigrationResponse -> Maybe MigrationStrategy
migrationStrategy :: Prelude.Maybe MigrationStrategy,
    -- | The date and time that the migration started.
    GetMigrationResponse -> Maybe POSIX
migrationTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The locale of the Amazon Lex V1 bot migrated to Amazon Lex V2.
    GetMigrationResponse -> Maybe Locale
v1BotLocale :: Prelude.Maybe Locale,
    -- | The name of the Amazon Lex V1 bot migrated to Amazon Lex V2.
    GetMigrationResponse -> Maybe Text
v1BotName :: Prelude.Maybe Prelude.Text,
    -- | The version of the Amazon Lex V1 bot migrated to Amazon Lex V2.
    GetMigrationResponse -> Maybe Text
v1BotVersion :: Prelude.Maybe Prelude.Text,
    -- | The unique identifier of the Amazon Lex V2 bot that the Amazon Lex V1 is
    -- being migrated to.
    GetMigrationResponse -> Maybe Text
v2BotId :: Prelude.Maybe Prelude.Text,
    -- | The IAM role that Amazon Lex uses to run the Amazon Lex V2 bot.
    GetMigrationResponse -> Maybe Text
v2BotRole :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetMigrationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetMigrationResponse -> GetMigrationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMigrationResponse -> GetMigrationResponse -> Bool
$c/= :: GetMigrationResponse -> GetMigrationResponse -> Bool
== :: GetMigrationResponse -> GetMigrationResponse -> Bool
$c== :: GetMigrationResponse -> GetMigrationResponse -> Bool
Prelude.Eq, ReadPrec [GetMigrationResponse]
ReadPrec GetMigrationResponse
Int -> ReadS GetMigrationResponse
ReadS [GetMigrationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMigrationResponse]
$creadListPrec :: ReadPrec [GetMigrationResponse]
readPrec :: ReadPrec GetMigrationResponse
$creadPrec :: ReadPrec GetMigrationResponse
readList :: ReadS [GetMigrationResponse]
$creadList :: ReadS [GetMigrationResponse]
readsPrec :: Int -> ReadS GetMigrationResponse
$creadsPrec :: Int -> ReadS GetMigrationResponse
Prelude.Read, Int -> GetMigrationResponse -> ShowS
[GetMigrationResponse] -> ShowS
GetMigrationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMigrationResponse] -> ShowS
$cshowList :: [GetMigrationResponse] -> ShowS
show :: GetMigrationResponse -> String
$cshow :: GetMigrationResponse -> String
showsPrec :: Int -> GetMigrationResponse -> ShowS
$cshowsPrec :: Int -> GetMigrationResponse -> ShowS
Prelude.Show, forall x. Rep GetMigrationResponse x -> GetMigrationResponse
forall x. GetMigrationResponse -> Rep GetMigrationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMigrationResponse x -> GetMigrationResponse
$cfrom :: forall x. GetMigrationResponse -> Rep GetMigrationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetMigrationResponse' 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:
--
-- 'alerts', 'getMigrationResponse_alerts' - A list of alerts and warnings that indicate issues with the migration
-- for the Amazon Lex V1 bot to Amazon Lex V2. You receive a warning when
-- an Amazon Lex V1 feature has a different implementation if Amazon Lex
-- V2.
--
-- For more information, see
-- <https://docs.aws.amazon.com/lexv2/latest/dg/migrate.html Migrating a bot>
-- in the /Amazon Lex V2 developer guide/.
--
-- 'migrationId', 'getMigrationResponse_migrationId' - The unique identifier of the migration. This is the same as the
-- identifier used when calling the @GetMigration@ operation.
--
-- 'migrationStatus', 'getMigrationResponse_migrationStatus' - Indicates the status of the migration. When the status is @COMPLETE@ the
-- migration is finished and the bot is available in Amazon Lex V2. There
-- may be alerts and warnings that need to be resolved to complete the
-- migration.
--
-- 'migrationStrategy', 'getMigrationResponse_migrationStrategy' - The strategy used to conduct the migration.
--
-- -   @CREATE_NEW@ - Creates a new Amazon Lex V2 bot and migrates the
--     Amazon Lex V1 bot to the new bot.
--
-- -   @UPDATE_EXISTING@ - Overwrites the existing Amazon Lex V2 bot
--     metadata and the locale being migrated. It doesn\'t change any other
--     locales in the Amazon Lex V2 bot. If the locale doesn\'t exist, a
--     new locale is created in the Amazon Lex V2 bot.
--
-- 'migrationTimestamp', 'getMigrationResponse_migrationTimestamp' - The date and time that the migration started.
--
-- 'v1BotLocale', 'getMigrationResponse_v1BotLocale' - The locale of the Amazon Lex V1 bot migrated to Amazon Lex V2.
--
-- 'v1BotName', 'getMigrationResponse_v1BotName' - The name of the Amazon Lex V1 bot migrated to Amazon Lex V2.
--
-- 'v1BotVersion', 'getMigrationResponse_v1BotVersion' - The version of the Amazon Lex V1 bot migrated to Amazon Lex V2.
--
-- 'v2BotId', 'getMigrationResponse_v2BotId' - The unique identifier of the Amazon Lex V2 bot that the Amazon Lex V1 is
-- being migrated to.
--
-- 'v2BotRole', 'getMigrationResponse_v2BotRole' - The IAM role that Amazon Lex uses to run the Amazon Lex V2 bot.
--
-- 'httpStatus', 'getMigrationResponse_httpStatus' - The response's http status code.
newGetMigrationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMigrationResponse
newGetMigrationResponse :: Int -> GetMigrationResponse
newGetMigrationResponse Int
pHttpStatus_ =
  GetMigrationResponse'
    { $sel:alerts:GetMigrationResponse' :: Maybe [MigrationAlert]
alerts = forall a. Maybe a
Prelude.Nothing,
      $sel:migrationId:GetMigrationResponse' :: Maybe Text
migrationId = forall a. Maybe a
Prelude.Nothing,
      $sel:migrationStatus:GetMigrationResponse' :: Maybe MigrationStatus
migrationStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:migrationStrategy:GetMigrationResponse' :: Maybe MigrationStrategy
migrationStrategy = forall a. Maybe a
Prelude.Nothing,
      $sel:migrationTimestamp:GetMigrationResponse' :: Maybe POSIX
migrationTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:v1BotLocale:GetMigrationResponse' :: Maybe Locale
v1BotLocale = forall a. Maybe a
Prelude.Nothing,
      $sel:v1BotName:GetMigrationResponse' :: Maybe Text
v1BotName = forall a. Maybe a
Prelude.Nothing,
      $sel:v1BotVersion:GetMigrationResponse' :: Maybe Text
v1BotVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:v2BotId:GetMigrationResponse' :: Maybe Text
v2BotId = forall a. Maybe a
Prelude.Nothing,
      $sel:v2BotRole:GetMigrationResponse' :: Maybe Text
v2BotRole = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetMigrationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A list of alerts and warnings that indicate issues with the migration
-- for the Amazon Lex V1 bot to Amazon Lex V2. You receive a warning when
-- an Amazon Lex V1 feature has a different implementation if Amazon Lex
-- V2.
--
-- For more information, see
-- <https://docs.aws.amazon.com/lexv2/latest/dg/migrate.html Migrating a bot>
-- in the /Amazon Lex V2 developer guide/.
getMigrationResponse_alerts :: Lens.Lens' GetMigrationResponse (Prelude.Maybe [MigrationAlert])
getMigrationResponse_alerts :: Lens' GetMigrationResponse (Maybe [MigrationAlert])
getMigrationResponse_alerts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrationResponse' {Maybe [MigrationAlert]
alerts :: Maybe [MigrationAlert]
$sel:alerts:GetMigrationResponse' :: GetMigrationResponse -> Maybe [MigrationAlert]
alerts} -> Maybe [MigrationAlert]
alerts) (\s :: GetMigrationResponse
s@GetMigrationResponse' {} Maybe [MigrationAlert]
a -> GetMigrationResponse
s {$sel:alerts:GetMigrationResponse' :: Maybe [MigrationAlert]
alerts = Maybe [MigrationAlert]
a} :: GetMigrationResponse) 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 unique identifier of the migration. This is the same as the
-- identifier used when calling the @GetMigration@ operation.
getMigrationResponse_migrationId :: Lens.Lens' GetMigrationResponse (Prelude.Maybe Prelude.Text)
getMigrationResponse_migrationId :: Lens' GetMigrationResponse (Maybe Text)
getMigrationResponse_migrationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrationResponse' {Maybe Text
migrationId :: Maybe Text
$sel:migrationId:GetMigrationResponse' :: GetMigrationResponse -> Maybe Text
migrationId} -> Maybe Text
migrationId) (\s :: GetMigrationResponse
s@GetMigrationResponse' {} Maybe Text
a -> GetMigrationResponse
s {$sel:migrationId:GetMigrationResponse' :: Maybe Text
migrationId = Maybe Text
a} :: GetMigrationResponse)

-- | Indicates the status of the migration. When the status is @COMPLETE@ the
-- migration is finished and the bot is available in Amazon Lex V2. There
-- may be alerts and warnings that need to be resolved to complete the
-- migration.
getMigrationResponse_migrationStatus :: Lens.Lens' GetMigrationResponse (Prelude.Maybe MigrationStatus)
getMigrationResponse_migrationStatus :: Lens' GetMigrationResponse (Maybe MigrationStatus)
getMigrationResponse_migrationStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrationResponse' {Maybe MigrationStatus
migrationStatus :: Maybe MigrationStatus
$sel:migrationStatus:GetMigrationResponse' :: GetMigrationResponse -> Maybe MigrationStatus
migrationStatus} -> Maybe MigrationStatus
migrationStatus) (\s :: GetMigrationResponse
s@GetMigrationResponse' {} Maybe MigrationStatus
a -> GetMigrationResponse
s {$sel:migrationStatus:GetMigrationResponse' :: Maybe MigrationStatus
migrationStatus = Maybe MigrationStatus
a} :: GetMigrationResponse)

-- | The strategy used to conduct the migration.
--
-- -   @CREATE_NEW@ - Creates a new Amazon Lex V2 bot and migrates the
--     Amazon Lex V1 bot to the new bot.
--
-- -   @UPDATE_EXISTING@ - Overwrites the existing Amazon Lex V2 bot
--     metadata and the locale being migrated. It doesn\'t change any other
--     locales in the Amazon Lex V2 bot. If the locale doesn\'t exist, a
--     new locale is created in the Amazon Lex V2 bot.
getMigrationResponse_migrationStrategy :: Lens.Lens' GetMigrationResponse (Prelude.Maybe MigrationStrategy)
getMigrationResponse_migrationStrategy :: Lens' GetMigrationResponse (Maybe MigrationStrategy)
getMigrationResponse_migrationStrategy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrationResponse' {Maybe MigrationStrategy
migrationStrategy :: Maybe MigrationStrategy
$sel:migrationStrategy:GetMigrationResponse' :: GetMigrationResponse -> Maybe MigrationStrategy
migrationStrategy} -> Maybe MigrationStrategy
migrationStrategy) (\s :: GetMigrationResponse
s@GetMigrationResponse' {} Maybe MigrationStrategy
a -> GetMigrationResponse
s {$sel:migrationStrategy:GetMigrationResponse' :: Maybe MigrationStrategy
migrationStrategy = Maybe MigrationStrategy
a} :: GetMigrationResponse)

-- | The date and time that the migration started.
getMigrationResponse_migrationTimestamp :: Lens.Lens' GetMigrationResponse (Prelude.Maybe Prelude.UTCTime)
getMigrationResponse_migrationTimestamp :: Lens' GetMigrationResponse (Maybe UTCTime)
getMigrationResponse_migrationTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrationResponse' {Maybe POSIX
migrationTimestamp :: Maybe POSIX
$sel:migrationTimestamp:GetMigrationResponse' :: GetMigrationResponse -> Maybe POSIX
migrationTimestamp} -> Maybe POSIX
migrationTimestamp) (\s :: GetMigrationResponse
s@GetMigrationResponse' {} Maybe POSIX
a -> GetMigrationResponse
s {$sel:migrationTimestamp:GetMigrationResponse' :: Maybe POSIX
migrationTimestamp = Maybe POSIX
a} :: GetMigrationResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The locale of the Amazon Lex V1 bot migrated to Amazon Lex V2.
getMigrationResponse_v1BotLocale :: Lens.Lens' GetMigrationResponse (Prelude.Maybe Locale)
getMigrationResponse_v1BotLocale :: Lens' GetMigrationResponse (Maybe Locale)
getMigrationResponse_v1BotLocale = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrationResponse' {Maybe Locale
v1BotLocale :: Maybe Locale
$sel:v1BotLocale:GetMigrationResponse' :: GetMigrationResponse -> Maybe Locale
v1BotLocale} -> Maybe Locale
v1BotLocale) (\s :: GetMigrationResponse
s@GetMigrationResponse' {} Maybe Locale
a -> GetMigrationResponse
s {$sel:v1BotLocale:GetMigrationResponse' :: Maybe Locale
v1BotLocale = Maybe Locale
a} :: GetMigrationResponse)

-- | The name of the Amazon Lex V1 bot migrated to Amazon Lex V2.
getMigrationResponse_v1BotName :: Lens.Lens' GetMigrationResponse (Prelude.Maybe Prelude.Text)
getMigrationResponse_v1BotName :: Lens' GetMigrationResponse (Maybe Text)
getMigrationResponse_v1BotName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrationResponse' {Maybe Text
v1BotName :: Maybe Text
$sel:v1BotName:GetMigrationResponse' :: GetMigrationResponse -> Maybe Text
v1BotName} -> Maybe Text
v1BotName) (\s :: GetMigrationResponse
s@GetMigrationResponse' {} Maybe Text
a -> GetMigrationResponse
s {$sel:v1BotName:GetMigrationResponse' :: Maybe Text
v1BotName = Maybe Text
a} :: GetMigrationResponse)

-- | The version of the Amazon Lex V1 bot migrated to Amazon Lex V2.
getMigrationResponse_v1BotVersion :: Lens.Lens' GetMigrationResponse (Prelude.Maybe Prelude.Text)
getMigrationResponse_v1BotVersion :: Lens' GetMigrationResponse (Maybe Text)
getMigrationResponse_v1BotVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrationResponse' {Maybe Text
v1BotVersion :: Maybe Text
$sel:v1BotVersion:GetMigrationResponse' :: GetMigrationResponse -> Maybe Text
v1BotVersion} -> Maybe Text
v1BotVersion) (\s :: GetMigrationResponse
s@GetMigrationResponse' {} Maybe Text
a -> GetMigrationResponse
s {$sel:v1BotVersion:GetMigrationResponse' :: Maybe Text
v1BotVersion = Maybe Text
a} :: GetMigrationResponse)

-- | The unique identifier of the Amazon Lex V2 bot that the Amazon Lex V1 is
-- being migrated to.
getMigrationResponse_v2BotId :: Lens.Lens' GetMigrationResponse (Prelude.Maybe Prelude.Text)
getMigrationResponse_v2BotId :: Lens' GetMigrationResponse (Maybe Text)
getMigrationResponse_v2BotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrationResponse' {Maybe Text
v2BotId :: Maybe Text
$sel:v2BotId:GetMigrationResponse' :: GetMigrationResponse -> Maybe Text
v2BotId} -> Maybe Text
v2BotId) (\s :: GetMigrationResponse
s@GetMigrationResponse' {} Maybe Text
a -> GetMigrationResponse
s {$sel:v2BotId:GetMigrationResponse' :: Maybe Text
v2BotId = Maybe Text
a} :: GetMigrationResponse)

-- | The IAM role that Amazon Lex uses to run the Amazon Lex V2 bot.
getMigrationResponse_v2BotRole :: Lens.Lens' GetMigrationResponse (Prelude.Maybe Prelude.Text)
getMigrationResponse_v2BotRole :: Lens' GetMigrationResponse (Maybe Text)
getMigrationResponse_v2BotRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMigrationResponse' {Maybe Text
v2BotRole :: Maybe Text
$sel:v2BotRole:GetMigrationResponse' :: GetMigrationResponse -> Maybe Text
v2BotRole} -> Maybe Text
v2BotRole) (\s :: GetMigrationResponse
s@GetMigrationResponse' {} Maybe Text
a -> GetMigrationResponse
s {$sel:v2BotRole:GetMigrationResponse' :: Maybe Text
v2BotRole = Maybe Text
a} :: GetMigrationResponse)

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

instance Prelude.NFData GetMigrationResponse where
  rnf :: GetMigrationResponse -> ()
rnf GetMigrationResponse' {Int
Maybe [MigrationAlert]
Maybe Text
Maybe POSIX
Maybe Locale
Maybe MigrationStatus
Maybe MigrationStrategy
httpStatus :: Int
v2BotRole :: Maybe Text
v2BotId :: Maybe Text
v1BotVersion :: Maybe Text
v1BotName :: Maybe Text
v1BotLocale :: Maybe Locale
migrationTimestamp :: Maybe POSIX
migrationStrategy :: Maybe MigrationStrategy
migrationStatus :: Maybe MigrationStatus
migrationId :: Maybe Text
alerts :: Maybe [MigrationAlert]
$sel:httpStatus:GetMigrationResponse' :: GetMigrationResponse -> Int
$sel:v2BotRole:GetMigrationResponse' :: GetMigrationResponse -> Maybe Text
$sel:v2BotId:GetMigrationResponse' :: GetMigrationResponse -> Maybe Text
$sel:v1BotVersion:GetMigrationResponse' :: GetMigrationResponse -> Maybe Text
$sel:v1BotName:GetMigrationResponse' :: GetMigrationResponse -> Maybe Text
$sel:v1BotLocale:GetMigrationResponse' :: GetMigrationResponse -> Maybe Locale
$sel:migrationTimestamp:GetMigrationResponse' :: GetMigrationResponse -> Maybe POSIX
$sel:migrationStrategy:GetMigrationResponse' :: GetMigrationResponse -> Maybe MigrationStrategy
$sel:migrationStatus:GetMigrationResponse' :: GetMigrationResponse -> Maybe MigrationStatus
$sel:migrationId:GetMigrationResponse' :: GetMigrationResponse -> Maybe Text
$sel:alerts:GetMigrationResponse' :: GetMigrationResponse -> Maybe [MigrationAlert]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [MigrationAlert]
alerts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
migrationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MigrationStatus
migrationStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MigrationStrategy
migrationStrategy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
migrationTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Locale
v1BotLocale
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
v1BotName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
v1BotVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
v2BotId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
v2BotRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus