{-# 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.DMS.ReloadTables
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Reloads the target database table with the source data.
--
-- You can only use this operation with a task in the @RUNNING@ state,
-- otherwise the service will throw an @InvalidResourceStateFault@
-- exception.
module Amazonka.DMS.ReloadTables
  ( -- * Creating a Request
    ReloadTables (..),
    newReloadTables,

    -- * Request Lenses
    reloadTables_reloadOption,
    reloadTables_replicationTaskArn,
    reloadTables_tablesToReload,

    -- * Destructuring the Response
    ReloadTablesResponse (..),
    newReloadTablesResponse,

    -- * Response Lenses
    reloadTablesResponse_replicationTaskArn,
    reloadTablesResponse_httpStatus,
  )
where

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

-- | /See:/ 'newReloadTables' smart constructor.
data ReloadTables = ReloadTables'
  { -- | Options for reload. Specify @data-reload@ to reload the data and
    -- re-validate it if validation is enabled. Specify @validate-only@ to
    -- re-validate the table. This option applies only when validation is
    -- enabled for the task.
    --
    -- Valid values: data-reload, validate-only
    --
    -- Default value is data-reload.
    ReloadTables -> Maybe ReloadOptionValue
reloadOption :: Prelude.Maybe ReloadOptionValue,
    -- | The Amazon Resource Name (ARN) of the replication task.
    ReloadTables -> Text
replicationTaskArn :: Prelude.Text,
    -- | The name and schema of the table to be reloaded.
    ReloadTables -> [TableToReload]
tablesToReload :: [TableToReload]
  }
  deriving (ReloadTables -> ReloadTables -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReloadTables -> ReloadTables -> Bool
$c/= :: ReloadTables -> ReloadTables -> Bool
== :: ReloadTables -> ReloadTables -> Bool
$c== :: ReloadTables -> ReloadTables -> Bool
Prelude.Eq, ReadPrec [ReloadTables]
ReadPrec ReloadTables
Int -> ReadS ReloadTables
ReadS [ReloadTables]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReloadTables]
$creadListPrec :: ReadPrec [ReloadTables]
readPrec :: ReadPrec ReloadTables
$creadPrec :: ReadPrec ReloadTables
readList :: ReadS [ReloadTables]
$creadList :: ReadS [ReloadTables]
readsPrec :: Int -> ReadS ReloadTables
$creadsPrec :: Int -> ReadS ReloadTables
Prelude.Read, Int -> ReloadTables -> ShowS
[ReloadTables] -> ShowS
ReloadTables -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReloadTables] -> ShowS
$cshowList :: [ReloadTables] -> ShowS
show :: ReloadTables -> String
$cshow :: ReloadTables -> String
showsPrec :: Int -> ReloadTables -> ShowS
$cshowsPrec :: Int -> ReloadTables -> ShowS
Prelude.Show, forall x. Rep ReloadTables x -> ReloadTables
forall x. ReloadTables -> Rep ReloadTables x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReloadTables x -> ReloadTables
$cfrom :: forall x. ReloadTables -> Rep ReloadTables x
Prelude.Generic)

-- |
-- Create a value of 'ReloadTables' 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:
--
-- 'reloadOption', 'reloadTables_reloadOption' - Options for reload. Specify @data-reload@ to reload the data and
-- re-validate it if validation is enabled. Specify @validate-only@ to
-- re-validate the table. This option applies only when validation is
-- enabled for the task.
--
-- Valid values: data-reload, validate-only
--
-- Default value is data-reload.
--
-- 'replicationTaskArn', 'reloadTables_replicationTaskArn' - The Amazon Resource Name (ARN) of the replication task.
--
-- 'tablesToReload', 'reloadTables_tablesToReload' - The name and schema of the table to be reloaded.
newReloadTables ::
  -- | 'replicationTaskArn'
  Prelude.Text ->
  ReloadTables
newReloadTables :: Text -> ReloadTables
newReloadTables Text
pReplicationTaskArn_ =
  ReloadTables'
    { $sel:reloadOption:ReloadTables' :: Maybe ReloadOptionValue
reloadOption = forall a. Maybe a
Prelude.Nothing,
      $sel:replicationTaskArn:ReloadTables' :: Text
replicationTaskArn = Text
pReplicationTaskArn_,
      $sel:tablesToReload:ReloadTables' :: [TableToReload]
tablesToReload = forall a. Monoid a => a
Prelude.mempty
    }

-- | Options for reload. Specify @data-reload@ to reload the data and
-- re-validate it if validation is enabled. Specify @validate-only@ to
-- re-validate the table. This option applies only when validation is
-- enabled for the task.
--
-- Valid values: data-reload, validate-only
--
-- Default value is data-reload.
reloadTables_reloadOption :: Lens.Lens' ReloadTables (Prelude.Maybe ReloadOptionValue)
reloadTables_reloadOption :: Lens' ReloadTables (Maybe ReloadOptionValue)
reloadTables_reloadOption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReloadTables' {Maybe ReloadOptionValue
reloadOption :: Maybe ReloadOptionValue
$sel:reloadOption:ReloadTables' :: ReloadTables -> Maybe ReloadOptionValue
reloadOption} -> Maybe ReloadOptionValue
reloadOption) (\s :: ReloadTables
s@ReloadTables' {} Maybe ReloadOptionValue
a -> ReloadTables
s {$sel:reloadOption:ReloadTables' :: Maybe ReloadOptionValue
reloadOption = Maybe ReloadOptionValue
a} :: ReloadTables)

-- | The Amazon Resource Name (ARN) of the replication task.
reloadTables_replicationTaskArn :: Lens.Lens' ReloadTables Prelude.Text
reloadTables_replicationTaskArn :: Lens' ReloadTables Text
reloadTables_replicationTaskArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReloadTables' {Text
replicationTaskArn :: Text
$sel:replicationTaskArn:ReloadTables' :: ReloadTables -> Text
replicationTaskArn} -> Text
replicationTaskArn) (\s :: ReloadTables
s@ReloadTables' {} Text
a -> ReloadTables
s {$sel:replicationTaskArn:ReloadTables' :: Text
replicationTaskArn = Text
a} :: ReloadTables)

-- | The name and schema of the table to be reloaded.
reloadTables_tablesToReload :: Lens.Lens' ReloadTables [TableToReload]
reloadTables_tablesToReload :: Lens' ReloadTables [TableToReload]
reloadTables_tablesToReload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReloadTables' {[TableToReload]
tablesToReload :: [TableToReload]
$sel:tablesToReload:ReloadTables' :: ReloadTables -> [TableToReload]
tablesToReload} -> [TableToReload]
tablesToReload) (\s :: ReloadTables
s@ReloadTables' {} [TableToReload]
a -> ReloadTables
s {$sel:tablesToReload:ReloadTables' :: [TableToReload]
tablesToReload = [TableToReload]
a} :: ReloadTables) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest ReloadTables where
  type AWSResponse ReloadTables = ReloadTablesResponse
  request :: (Service -> Service) -> ReloadTables -> Request ReloadTables
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 ReloadTables
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse ReloadTables)))
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 -> Int -> ReloadTablesResponse
ReloadTablesResponse'
            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
"ReplicationTaskArn")
            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 ReloadTables where
  hashWithSalt :: Int -> ReloadTables -> Int
hashWithSalt Int
_salt ReloadTables' {[TableToReload]
Maybe ReloadOptionValue
Text
tablesToReload :: [TableToReload]
replicationTaskArn :: Text
reloadOption :: Maybe ReloadOptionValue
$sel:tablesToReload:ReloadTables' :: ReloadTables -> [TableToReload]
$sel:replicationTaskArn:ReloadTables' :: ReloadTables -> Text
$sel:reloadOption:ReloadTables' :: ReloadTables -> Maybe ReloadOptionValue
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ReloadOptionValue
reloadOption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
replicationTaskArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [TableToReload]
tablesToReload

instance Prelude.NFData ReloadTables where
  rnf :: ReloadTables -> ()
rnf ReloadTables' {[TableToReload]
Maybe ReloadOptionValue
Text
tablesToReload :: [TableToReload]
replicationTaskArn :: Text
reloadOption :: Maybe ReloadOptionValue
$sel:tablesToReload:ReloadTables' :: ReloadTables -> [TableToReload]
$sel:replicationTaskArn:ReloadTables' :: ReloadTables -> Text
$sel:reloadOption:ReloadTables' :: ReloadTables -> Maybe ReloadOptionValue
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ReloadOptionValue
reloadOption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
replicationTaskArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [TableToReload]
tablesToReload

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

instance Data.ToJSON ReloadTables where
  toJSON :: ReloadTables -> Value
toJSON ReloadTables' {[TableToReload]
Maybe ReloadOptionValue
Text
tablesToReload :: [TableToReload]
replicationTaskArn :: Text
reloadOption :: Maybe ReloadOptionValue
$sel:tablesToReload:ReloadTables' :: ReloadTables -> [TableToReload]
$sel:replicationTaskArn:ReloadTables' :: ReloadTables -> Text
$sel:reloadOption:ReloadTables' :: ReloadTables -> Maybe ReloadOptionValue
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ReloadOption" 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 ReloadOptionValue
reloadOption,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"ReplicationTaskArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
replicationTaskArn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TablesToReload" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [TableToReload]
tablesToReload)
          ]
      )

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

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

-- | /See:/ 'newReloadTablesResponse' smart constructor.
data ReloadTablesResponse = ReloadTablesResponse'
  { -- | The Amazon Resource Name (ARN) of the replication task.
    ReloadTablesResponse -> Maybe Text
replicationTaskArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    ReloadTablesResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ReloadTablesResponse -> ReloadTablesResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ReloadTablesResponse -> ReloadTablesResponse -> Bool
$c/= :: ReloadTablesResponse -> ReloadTablesResponse -> Bool
== :: ReloadTablesResponse -> ReloadTablesResponse -> Bool
$c== :: ReloadTablesResponse -> ReloadTablesResponse -> Bool
Prelude.Eq, ReadPrec [ReloadTablesResponse]
ReadPrec ReloadTablesResponse
Int -> ReadS ReloadTablesResponse
ReadS [ReloadTablesResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ReloadTablesResponse]
$creadListPrec :: ReadPrec [ReloadTablesResponse]
readPrec :: ReadPrec ReloadTablesResponse
$creadPrec :: ReadPrec ReloadTablesResponse
readList :: ReadS [ReloadTablesResponse]
$creadList :: ReadS [ReloadTablesResponse]
readsPrec :: Int -> ReadS ReloadTablesResponse
$creadsPrec :: Int -> ReadS ReloadTablesResponse
Prelude.Read, Int -> ReloadTablesResponse -> ShowS
[ReloadTablesResponse] -> ShowS
ReloadTablesResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ReloadTablesResponse] -> ShowS
$cshowList :: [ReloadTablesResponse] -> ShowS
show :: ReloadTablesResponse -> String
$cshow :: ReloadTablesResponse -> String
showsPrec :: Int -> ReloadTablesResponse -> ShowS
$cshowsPrec :: Int -> ReloadTablesResponse -> ShowS
Prelude.Show, forall x. Rep ReloadTablesResponse x -> ReloadTablesResponse
forall x. ReloadTablesResponse -> Rep ReloadTablesResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ReloadTablesResponse x -> ReloadTablesResponse
$cfrom :: forall x. ReloadTablesResponse -> Rep ReloadTablesResponse x
Prelude.Generic)

-- |
-- Create a value of 'ReloadTablesResponse' 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:
--
-- 'replicationTaskArn', 'reloadTablesResponse_replicationTaskArn' - The Amazon Resource Name (ARN) of the replication task.
--
-- 'httpStatus', 'reloadTablesResponse_httpStatus' - The response's http status code.
newReloadTablesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ReloadTablesResponse
newReloadTablesResponse :: Int -> ReloadTablesResponse
newReloadTablesResponse Int
pHttpStatus_ =
  ReloadTablesResponse'
    { $sel:replicationTaskArn:ReloadTablesResponse' :: Maybe Text
replicationTaskArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ReloadTablesResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The Amazon Resource Name (ARN) of the replication task.
reloadTablesResponse_replicationTaskArn :: Lens.Lens' ReloadTablesResponse (Prelude.Maybe Prelude.Text)
reloadTablesResponse_replicationTaskArn :: Lens' ReloadTablesResponse (Maybe Text)
reloadTablesResponse_replicationTaskArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ReloadTablesResponse' {Maybe Text
replicationTaskArn :: Maybe Text
$sel:replicationTaskArn:ReloadTablesResponse' :: ReloadTablesResponse -> Maybe Text
replicationTaskArn} -> Maybe Text
replicationTaskArn) (\s :: ReloadTablesResponse
s@ReloadTablesResponse' {} Maybe Text
a -> ReloadTablesResponse
s {$sel:replicationTaskArn:ReloadTablesResponse' :: Maybe Text
replicationTaskArn = Maybe Text
a} :: ReloadTablesResponse)

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

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