{-# 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.ElastiCache.CompleteMigration
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Complete the migration of data.
module Amazonka.ElastiCache.CompleteMigration
  ( -- * Creating a Request
    CompleteMigration (..),
    newCompleteMigration,

    -- * Request Lenses
    completeMigration_force,
    completeMigration_replicationGroupId,

    -- * Destructuring the Response
    CompleteMigrationResponse (..),
    newCompleteMigrationResponse,

    -- * Response Lenses
    completeMigrationResponse_replicationGroup,
    completeMigrationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCompleteMigration' smart constructor.
data CompleteMigration = CompleteMigration'
  { -- | Forces the migration to stop without ensuring that data is in sync. It
    -- is recommended to use this option only to abort the migration and not
    -- recommended when application wants to continue migration to ElastiCache.
    CompleteMigration -> Maybe Bool
force :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the replication group to which data is being migrated.
    CompleteMigration -> Text
replicationGroupId :: Prelude.Text
  }
  deriving (CompleteMigration -> CompleteMigration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CompleteMigration -> CompleteMigration -> Bool
$c/= :: CompleteMigration -> CompleteMigration -> Bool
== :: CompleteMigration -> CompleteMigration -> Bool
$c== :: CompleteMigration -> CompleteMigration -> Bool
Prelude.Eq, ReadPrec [CompleteMigration]
ReadPrec CompleteMigration
Int -> ReadS CompleteMigration
ReadS [CompleteMigration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CompleteMigration]
$creadListPrec :: ReadPrec [CompleteMigration]
readPrec :: ReadPrec CompleteMigration
$creadPrec :: ReadPrec CompleteMigration
readList :: ReadS [CompleteMigration]
$creadList :: ReadS [CompleteMigration]
readsPrec :: Int -> ReadS CompleteMigration
$creadsPrec :: Int -> ReadS CompleteMigration
Prelude.Read, Int -> CompleteMigration -> ShowS
[CompleteMigration] -> ShowS
CompleteMigration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CompleteMigration] -> ShowS
$cshowList :: [CompleteMigration] -> ShowS
show :: CompleteMigration -> String
$cshow :: CompleteMigration -> String
showsPrec :: Int -> CompleteMigration -> ShowS
$cshowsPrec :: Int -> CompleteMigration -> ShowS
Prelude.Show, forall x. Rep CompleteMigration x -> CompleteMigration
forall x. CompleteMigration -> Rep CompleteMigration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CompleteMigration x -> CompleteMigration
$cfrom :: forall x. CompleteMigration -> Rep CompleteMigration x
Prelude.Generic)

-- |
-- Create a value of 'CompleteMigration' 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:
--
-- 'force', 'completeMigration_force' - Forces the migration to stop without ensuring that data is in sync. It
-- is recommended to use this option only to abort the migration and not
-- recommended when application wants to continue migration to ElastiCache.
--
-- 'replicationGroupId', 'completeMigration_replicationGroupId' - The ID of the replication group to which data is being migrated.
newCompleteMigration ::
  -- | 'replicationGroupId'
  Prelude.Text ->
  CompleteMigration
newCompleteMigration :: Text -> CompleteMigration
newCompleteMigration Text
pReplicationGroupId_ =
  CompleteMigration'
    { $sel:force:CompleteMigration' :: Maybe Bool
force = forall a. Maybe a
Prelude.Nothing,
      $sel:replicationGroupId:CompleteMigration' :: Text
replicationGroupId = Text
pReplicationGroupId_
    }

-- | Forces the migration to stop without ensuring that data is in sync. It
-- is recommended to use this option only to abort the migration and not
-- recommended when application wants to continue migration to ElastiCache.
completeMigration_force :: Lens.Lens' CompleteMigration (Prelude.Maybe Prelude.Bool)
completeMigration_force :: Lens' CompleteMigration (Maybe Bool)
completeMigration_force = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteMigration' {Maybe Bool
force :: Maybe Bool
$sel:force:CompleteMigration' :: CompleteMigration -> Maybe Bool
force} -> Maybe Bool
force) (\s :: CompleteMigration
s@CompleteMigration' {} Maybe Bool
a -> CompleteMigration
s {$sel:force:CompleteMigration' :: Maybe Bool
force = Maybe Bool
a} :: CompleteMigration)

-- | The ID of the replication group to which data is being migrated.
completeMigration_replicationGroupId :: Lens.Lens' CompleteMigration Prelude.Text
completeMigration_replicationGroupId :: Lens' CompleteMigration Text
completeMigration_replicationGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteMigration' {Text
replicationGroupId :: Text
$sel:replicationGroupId:CompleteMigration' :: CompleteMigration -> Text
replicationGroupId} -> Text
replicationGroupId) (\s :: CompleteMigration
s@CompleteMigration' {} Text
a -> CompleteMigration
s {$sel:replicationGroupId:CompleteMigration' :: Text
replicationGroupId = Text
a} :: CompleteMigration)

instance Core.AWSRequest CompleteMigration where
  type
    AWSResponse CompleteMigration =
      CompleteMigrationResponse
  request :: (Service -> Service)
-> CompleteMigration -> Request CompleteMigration
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 CompleteMigration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CompleteMigration)))
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
"CompleteMigrationResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe ReplicationGroup -> Int -> CompleteMigrationResponse
CompleteMigrationResponse'
            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
"ReplicationGroup")
            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 CompleteMigration where
  hashWithSalt :: Int -> CompleteMigration -> Int
hashWithSalt Int
_salt CompleteMigration' {Maybe Bool
Text
replicationGroupId :: Text
force :: Maybe Bool
$sel:replicationGroupId:CompleteMigration' :: CompleteMigration -> Text
$sel:force:CompleteMigration' :: CompleteMigration -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
force
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
replicationGroupId

instance Prelude.NFData CompleteMigration where
  rnf :: CompleteMigration -> ()
rnf CompleteMigration' {Maybe Bool
Text
replicationGroupId :: Text
force :: Maybe Bool
$sel:replicationGroupId:CompleteMigration' :: CompleteMigration -> Text
$sel:force:CompleteMigration' :: CompleteMigration -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
force
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
replicationGroupId

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

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

instance Data.ToQuery CompleteMigration where
  toQuery :: CompleteMigration -> QueryString
toQuery CompleteMigration' {Maybe Bool
Text
replicationGroupId :: Text
force :: Maybe Bool
$sel:replicationGroupId:CompleteMigration' :: CompleteMigration -> Text
$sel:force:CompleteMigration' :: CompleteMigration -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CompleteMigration" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2015-02-02" :: Prelude.ByteString),
        ByteString
"Force" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
force,
        ByteString
"ReplicationGroupId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
replicationGroupId
      ]

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

-- |
-- Create a value of 'CompleteMigrationResponse' 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:
--
-- 'replicationGroup', 'completeMigrationResponse_replicationGroup' - Undocumented member.
--
-- 'httpStatus', 'completeMigrationResponse_httpStatus' - The response's http status code.
newCompleteMigrationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CompleteMigrationResponse
newCompleteMigrationResponse :: Int -> CompleteMigrationResponse
newCompleteMigrationResponse Int
pHttpStatus_ =
  CompleteMigrationResponse'
    { $sel:replicationGroup:CompleteMigrationResponse' :: Maybe ReplicationGroup
replicationGroup =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CompleteMigrationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
completeMigrationResponse_replicationGroup :: Lens.Lens' CompleteMigrationResponse (Prelude.Maybe ReplicationGroup)
completeMigrationResponse_replicationGroup :: Lens' CompleteMigrationResponse (Maybe ReplicationGroup)
completeMigrationResponse_replicationGroup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CompleteMigrationResponse' {Maybe ReplicationGroup
replicationGroup :: Maybe ReplicationGroup
$sel:replicationGroup:CompleteMigrationResponse' :: CompleteMigrationResponse -> Maybe ReplicationGroup
replicationGroup} -> Maybe ReplicationGroup
replicationGroup) (\s :: CompleteMigrationResponse
s@CompleteMigrationResponse' {} Maybe ReplicationGroup
a -> CompleteMigrationResponse
s {$sel:replicationGroup:CompleteMigrationResponse' :: Maybe ReplicationGroup
replicationGroup = Maybe ReplicationGroup
a} :: CompleteMigrationResponse)

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

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