{-# 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.SMS.StartOnDemandReplicationRun
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts an on-demand replication run for the specified replication job.
-- This replication run starts immediately. This replication run is in
-- addition to the ones already scheduled.
--
-- There is a limit on the number of on-demand replications runs that you
-- can request in a 24-hour period.
module Amazonka.SMS.StartOnDemandReplicationRun
  ( -- * Creating a Request
    StartOnDemandReplicationRun (..),
    newStartOnDemandReplicationRun,

    -- * Request Lenses
    startOnDemandReplicationRun_description,
    startOnDemandReplicationRun_replicationJobId,

    -- * Destructuring the Response
    StartOnDemandReplicationRunResponse (..),
    newStartOnDemandReplicationRunResponse,

    -- * Response Lenses
    startOnDemandReplicationRunResponse_replicationRunId,
    startOnDemandReplicationRunResponse_httpStatus,
  )
where

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

-- | /See:/ 'newStartOnDemandReplicationRun' smart constructor.
data StartOnDemandReplicationRun = StartOnDemandReplicationRun'
  { -- | The description of the replication run.
    StartOnDemandReplicationRun -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The ID of the replication job.
    StartOnDemandReplicationRun -> Text
replicationJobId :: Prelude.Text
  }
  deriving (StartOnDemandReplicationRun -> StartOnDemandReplicationRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartOnDemandReplicationRun -> StartOnDemandReplicationRun -> Bool
$c/= :: StartOnDemandReplicationRun -> StartOnDemandReplicationRun -> Bool
== :: StartOnDemandReplicationRun -> StartOnDemandReplicationRun -> Bool
$c== :: StartOnDemandReplicationRun -> StartOnDemandReplicationRun -> Bool
Prelude.Eq, ReadPrec [StartOnDemandReplicationRun]
ReadPrec StartOnDemandReplicationRun
Int -> ReadS StartOnDemandReplicationRun
ReadS [StartOnDemandReplicationRun]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartOnDemandReplicationRun]
$creadListPrec :: ReadPrec [StartOnDemandReplicationRun]
readPrec :: ReadPrec StartOnDemandReplicationRun
$creadPrec :: ReadPrec StartOnDemandReplicationRun
readList :: ReadS [StartOnDemandReplicationRun]
$creadList :: ReadS [StartOnDemandReplicationRun]
readsPrec :: Int -> ReadS StartOnDemandReplicationRun
$creadsPrec :: Int -> ReadS StartOnDemandReplicationRun
Prelude.Read, Int -> StartOnDemandReplicationRun -> ShowS
[StartOnDemandReplicationRun] -> ShowS
StartOnDemandReplicationRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartOnDemandReplicationRun] -> ShowS
$cshowList :: [StartOnDemandReplicationRun] -> ShowS
show :: StartOnDemandReplicationRun -> String
$cshow :: StartOnDemandReplicationRun -> String
showsPrec :: Int -> StartOnDemandReplicationRun -> ShowS
$cshowsPrec :: Int -> StartOnDemandReplicationRun -> ShowS
Prelude.Show, forall x.
Rep StartOnDemandReplicationRun x -> StartOnDemandReplicationRun
forall x.
StartOnDemandReplicationRun -> Rep StartOnDemandReplicationRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StartOnDemandReplicationRun x -> StartOnDemandReplicationRun
$cfrom :: forall x.
StartOnDemandReplicationRun -> Rep StartOnDemandReplicationRun x
Prelude.Generic)

-- |
-- Create a value of 'StartOnDemandReplicationRun' 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:
--
-- 'description', 'startOnDemandReplicationRun_description' - The description of the replication run.
--
-- 'replicationJobId', 'startOnDemandReplicationRun_replicationJobId' - The ID of the replication job.
newStartOnDemandReplicationRun ::
  -- | 'replicationJobId'
  Prelude.Text ->
  StartOnDemandReplicationRun
newStartOnDemandReplicationRun :: Text -> StartOnDemandReplicationRun
newStartOnDemandReplicationRun Text
pReplicationJobId_ =
  StartOnDemandReplicationRun'
    { $sel:description:StartOnDemandReplicationRun' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:replicationJobId:StartOnDemandReplicationRun' :: Text
replicationJobId = Text
pReplicationJobId_
    }

-- | The description of the replication run.
startOnDemandReplicationRun_description :: Lens.Lens' StartOnDemandReplicationRun (Prelude.Maybe Prelude.Text)
startOnDemandReplicationRun_description :: Lens' StartOnDemandReplicationRun (Maybe Text)
startOnDemandReplicationRun_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartOnDemandReplicationRun' {Maybe Text
description :: Maybe Text
$sel:description:StartOnDemandReplicationRun' :: StartOnDemandReplicationRun -> Maybe Text
description} -> Maybe Text
description) (\s :: StartOnDemandReplicationRun
s@StartOnDemandReplicationRun' {} Maybe Text
a -> StartOnDemandReplicationRun
s {$sel:description:StartOnDemandReplicationRun' :: Maybe Text
description = Maybe Text
a} :: StartOnDemandReplicationRun)

-- | The ID of the replication job.
startOnDemandReplicationRun_replicationJobId :: Lens.Lens' StartOnDemandReplicationRun Prelude.Text
startOnDemandReplicationRun_replicationJobId :: Lens' StartOnDemandReplicationRun Text
startOnDemandReplicationRun_replicationJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartOnDemandReplicationRun' {Text
replicationJobId :: Text
$sel:replicationJobId:StartOnDemandReplicationRun' :: StartOnDemandReplicationRun -> Text
replicationJobId} -> Text
replicationJobId) (\s :: StartOnDemandReplicationRun
s@StartOnDemandReplicationRun' {} Text
a -> StartOnDemandReplicationRun
s {$sel:replicationJobId:StartOnDemandReplicationRun' :: Text
replicationJobId = Text
a} :: StartOnDemandReplicationRun)

instance Core.AWSRequest StartOnDemandReplicationRun where
  type
    AWSResponse StartOnDemandReplicationRun =
      StartOnDemandReplicationRunResponse
  request :: (Service -> Service)
-> StartOnDemandReplicationRun
-> Request StartOnDemandReplicationRun
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 StartOnDemandReplicationRun
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StartOnDemandReplicationRun)))
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 -> StartOnDemandReplicationRunResponse
StartOnDemandReplicationRunResponse'
            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
"replicationRunId")
            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 StartOnDemandReplicationRun where
  hashWithSalt :: Int -> StartOnDemandReplicationRun -> Int
hashWithSalt Int
_salt StartOnDemandReplicationRun' {Maybe Text
Text
replicationJobId :: Text
description :: Maybe Text
$sel:replicationJobId:StartOnDemandReplicationRun' :: StartOnDemandReplicationRun -> Text
$sel:description:StartOnDemandReplicationRun' :: StartOnDemandReplicationRun -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
replicationJobId

instance Prelude.NFData StartOnDemandReplicationRun where
  rnf :: StartOnDemandReplicationRun -> ()
rnf StartOnDemandReplicationRun' {Maybe Text
Text
replicationJobId :: Text
description :: Maybe Text
$sel:replicationJobId:StartOnDemandReplicationRun' :: StartOnDemandReplicationRun -> Text
$sel:description:StartOnDemandReplicationRun' :: StartOnDemandReplicationRun -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
replicationJobId

instance Data.ToHeaders StartOnDemandReplicationRun where
  toHeaders :: StartOnDemandReplicationRun -> 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
"AWSServerMigrationService_V2016_10_24.StartOnDemandReplicationRun" ::
                          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 StartOnDemandReplicationRun where
  toJSON :: StartOnDemandReplicationRun -> Value
toJSON StartOnDemandReplicationRun' {Maybe Text
Text
replicationJobId :: Text
description :: Maybe Text
$sel:replicationJobId:StartOnDemandReplicationRun' :: StartOnDemandReplicationRun -> Text
$sel:description:StartOnDemandReplicationRun' :: StartOnDemandReplicationRun -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" 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
description,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"replicationJobId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
replicationJobId)
          ]
      )

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

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

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

-- |
-- Create a value of 'StartOnDemandReplicationRunResponse' 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:
--
-- 'replicationRunId', 'startOnDemandReplicationRunResponse_replicationRunId' - The ID of the replication run.
--
-- 'httpStatus', 'startOnDemandReplicationRunResponse_httpStatus' - The response's http status code.
newStartOnDemandReplicationRunResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StartOnDemandReplicationRunResponse
newStartOnDemandReplicationRunResponse :: Int -> StartOnDemandReplicationRunResponse
newStartOnDemandReplicationRunResponse Int
pHttpStatus_ =
  StartOnDemandReplicationRunResponse'
    { $sel:replicationRunId:StartOnDemandReplicationRunResponse' :: Maybe Text
replicationRunId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StartOnDemandReplicationRunResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the replication run.
startOnDemandReplicationRunResponse_replicationRunId :: Lens.Lens' StartOnDemandReplicationRunResponse (Prelude.Maybe Prelude.Text)
startOnDemandReplicationRunResponse_replicationRunId :: Lens' StartOnDemandReplicationRunResponse (Maybe Text)
startOnDemandReplicationRunResponse_replicationRunId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartOnDemandReplicationRunResponse' {Maybe Text
replicationRunId :: Maybe Text
$sel:replicationRunId:StartOnDemandReplicationRunResponse' :: StartOnDemandReplicationRunResponse -> Maybe Text
replicationRunId} -> Maybe Text
replicationRunId) (\s :: StartOnDemandReplicationRunResponse
s@StartOnDemandReplicationRunResponse' {} Maybe Text
a -> StartOnDemandReplicationRunResponse
s {$sel:replicationRunId:StartOnDemandReplicationRunResponse' :: Maybe Text
replicationRunId = Maybe Text
a} :: StartOnDemandReplicationRunResponse)

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

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