{-# 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.CreateReplicationJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a replication job. The replication job schedules periodic
-- replication runs to replicate your server to Amazon Web Services. Each
-- replication run creates an Amazon Machine Image (AMI).
module Amazonka.SMS.CreateReplicationJob
  ( -- * Creating a Request
    CreateReplicationJob (..),
    newCreateReplicationJob,

    -- * Request Lenses
    createReplicationJob_description,
    createReplicationJob_encrypted,
    createReplicationJob_frequency,
    createReplicationJob_kmsKeyId,
    createReplicationJob_licenseType,
    createReplicationJob_numberOfRecentAmisToKeep,
    createReplicationJob_roleName,
    createReplicationJob_runOnce,
    createReplicationJob_serverId,
    createReplicationJob_seedReplicationTime,

    -- * Destructuring the Response
    CreateReplicationJobResponse (..),
    newCreateReplicationJobResponse,

    -- * Response Lenses
    createReplicationJobResponse_replicationJobId,
    createReplicationJobResponse_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:/ 'newCreateReplicationJob' smart constructor.
data CreateReplicationJob = CreateReplicationJob'
  { -- | The description of the replication job.
    CreateReplicationJob -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether the replication job produces encrypted AMIs.
    CreateReplicationJob -> Maybe Bool
encrypted :: Prelude.Maybe Prelude.Bool,
    -- | The time between consecutive replication runs, in hours.
    CreateReplicationJob -> Maybe Int
frequency :: Prelude.Maybe Prelude.Int,
    -- | The ID of the KMS key for replication jobs that produce encrypted AMIs.
    -- This value can be any of the following:
    --
    -- -   KMS key ID
    --
    -- -   KMS key alias
    --
    -- -   ARN referring to the KMS key ID
    --
    -- -   ARN referring to the KMS key alias
    --
    -- If encrypted is /true/ but a KMS key ID is not specified, the
    -- customer\'s default KMS key for Amazon EBS is used.
    CreateReplicationJob -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The license type to be used for the AMI created by a successful
    -- replication run.
    CreateReplicationJob -> Maybe LicenseType
licenseType :: Prelude.Maybe LicenseType,
    -- | The maximum number of SMS-created AMIs to retain. The oldest is deleted
    -- after the maximum number is reached and a new AMI is created.
    CreateReplicationJob -> Maybe Int
numberOfRecentAmisToKeep :: Prelude.Maybe Prelude.Int,
    -- | The name of the IAM role to be used by the Server Migration Service.
    CreateReplicationJob -> Maybe Text
roleName :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether to run the replication job one time.
    CreateReplicationJob -> Maybe Bool
runOnce :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the server.
    CreateReplicationJob -> Text
serverId :: Prelude.Text,
    -- | The seed replication time.
    CreateReplicationJob -> POSIX
seedReplicationTime :: Data.POSIX
  }
  deriving (CreateReplicationJob -> CreateReplicationJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateReplicationJob -> CreateReplicationJob -> Bool
$c/= :: CreateReplicationJob -> CreateReplicationJob -> Bool
== :: CreateReplicationJob -> CreateReplicationJob -> Bool
$c== :: CreateReplicationJob -> CreateReplicationJob -> Bool
Prelude.Eq, ReadPrec [CreateReplicationJob]
ReadPrec CreateReplicationJob
Int -> ReadS CreateReplicationJob
ReadS [CreateReplicationJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateReplicationJob]
$creadListPrec :: ReadPrec [CreateReplicationJob]
readPrec :: ReadPrec CreateReplicationJob
$creadPrec :: ReadPrec CreateReplicationJob
readList :: ReadS [CreateReplicationJob]
$creadList :: ReadS [CreateReplicationJob]
readsPrec :: Int -> ReadS CreateReplicationJob
$creadsPrec :: Int -> ReadS CreateReplicationJob
Prelude.Read, Int -> CreateReplicationJob -> ShowS
[CreateReplicationJob] -> ShowS
CreateReplicationJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateReplicationJob] -> ShowS
$cshowList :: [CreateReplicationJob] -> ShowS
show :: CreateReplicationJob -> String
$cshow :: CreateReplicationJob -> String
showsPrec :: Int -> CreateReplicationJob -> ShowS
$cshowsPrec :: Int -> CreateReplicationJob -> ShowS
Prelude.Show, forall x. Rep CreateReplicationJob x -> CreateReplicationJob
forall x. CreateReplicationJob -> Rep CreateReplicationJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateReplicationJob x -> CreateReplicationJob
$cfrom :: forall x. CreateReplicationJob -> Rep CreateReplicationJob x
Prelude.Generic)

-- |
-- Create a value of 'CreateReplicationJob' 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', 'createReplicationJob_description' - The description of the replication job.
--
-- 'encrypted', 'createReplicationJob_encrypted' - Indicates whether the replication job produces encrypted AMIs.
--
-- 'frequency', 'createReplicationJob_frequency' - The time between consecutive replication runs, in hours.
--
-- 'kmsKeyId', 'createReplicationJob_kmsKeyId' - The ID of the KMS key for replication jobs that produce encrypted AMIs.
-- This value can be any of the following:
--
-- -   KMS key ID
--
-- -   KMS key alias
--
-- -   ARN referring to the KMS key ID
--
-- -   ARN referring to the KMS key alias
--
-- If encrypted is /true/ but a KMS key ID is not specified, the
-- customer\'s default KMS key for Amazon EBS is used.
--
-- 'licenseType', 'createReplicationJob_licenseType' - The license type to be used for the AMI created by a successful
-- replication run.
--
-- 'numberOfRecentAmisToKeep', 'createReplicationJob_numberOfRecentAmisToKeep' - The maximum number of SMS-created AMIs to retain. The oldest is deleted
-- after the maximum number is reached and a new AMI is created.
--
-- 'roleName', 'createReplicationJob_roleName' - The name of the IAM role to be used by the Server Migration Service.
--
-- 'runOnce', 'createReplicationJob_runOnce' - Indicates whether to run the replication job one time.
--
-- 'serverId', 'createReplicationJob_serverId' - The ID of the server.
--
-- 'seedReplicationTime', 'createReplicationJob_seedReplicationTime' - The seed replication time.
newCreateReplicationJob ::
  -- | 'serverId'
  Prelude.Text ->
  -- | 'seedReplicationTime'
  Prelude.UTCTime ->
  CreateReplicationJob
newCreateReplicationJob :: Text -> UTCTime -> CreateReplicationJob
newCreateReplicationJob
  Text
pServerId_
  UTCTime
pSeedReplicationTime_ =
    CreateReplicationJob'
      { $sel:description:CreateReplicationJob' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:encrypted:CreateReplicationJob' :: Maybe Bool
encrypted = forall a. Maybe a
Prelude.Nothing,
        $sel:frequency:CreateReplicationJob' :: Maybe Int
frequency = forall a. Maybe a
Prelude.Nothing,
        $sel:kmsKeyId:CreateReplicationJob' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
        $sel:licenseType:CreateReplicationJob' :: Maybe LicenseType
licenseType = forall a. Maybe a
Prelude.Nothing,
        $sel:numberOfRecentAmisToKeep:CreateReplicationJob' :: Maybe Int
numberOfRecentAmisToKeep = forall a. Maybe a
Prelude.Nothing,
        $sel:roleName:CreateReplicationJob' :: Maybe Text
roleName = forall a. Maybe a
Prelude.Nothing,
        $sel:runOnce:CreateReplicationJob' :: Maybe Bool
runOnce = forall a. Maybe a
Prelude.Nothing,
        $sel:serverId:CreateReplicationJob' :: Text
serverId = Text
pServerId_,
        $sel:seedReplicationTime:CreateReplicationJob' :: POSIX
seedReplicationTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pSeedReplicationTime_
      }

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

-- | Indicates whether the replication job produces encrypted AMIs.
createReplicationJob_encrypted :: Lens.Lens' CreateReplicationJob (Prelude.Maybe Prelude.Bool)
createReplicationJob_encrypted :: Lens' CreateReplicationJob (Maybe Bool)
createReplicationJob_encrypted = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReplicationJob' {Maybe Bool
encrypted :: Maybe Bool
$sel:encrypted:CreateReplicationJob' :: CreateReplicationJob -> Maybe Bool
encrypted} -> Maybe Bool
encrypted) (\s :: CreateReplicationJob
s@CreateReplicationJob' {} Maybe Bool
a -> CreateReplicationJob
s {$sel:encrypted:CreateReplicationJob' :: Maybe Bool
encrypted = Maybe Bool
a} :: CreateReplicationJob)

-- | The time between consecutive replication runs, in hours.
createReplicationJob_frequency :: Lens.Lens' CreateReplicationJob (Prelude.Maybe Prelude.Int)
createReplicationJob_frequency :: Lens' CreateReplicationJob (Maybe Int)
createReplicationJob_frequency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReplicationJob' {Maybe Int
frequency :: Maybe Int
$sel:frequency:CreateReplicationJob' :: CreateReplicationJob -> Maybe Int
frequency} -> Maybe Int
frequency) (\s :: CreateReplicationJob
s@CreateReplicationJob' {} Maybe Int
a -> CreateReplicationJob
s {$sel:frequency:CreateReplicationJob' :: Maybe Int
frequency = Maybe Int
a} :: CreateReplicationJob)

-- | The ID of the KMS key for replication jobs that produce encrypted AMIs.
-- This value can be any of the following:
--
-- -   KMS key ID
--
-- -   KMS key alias
--
-- -   ARN referring to the KMS key ID
--
-- -   ARN referring to the KMS key alias
--
-- If encrypted is /true/ but a KMS key ID is not specified, the
-- customer\'s default KMS key for Amazon EBS is used.
createReplicationJob_kmsKeyId :: Lens.Lens' CreateReplicationJob (Prelude.Maybe Prelude.Text)
createReplicationJob_kmsKeyId :: Lens' CreateReplicationJob (Maybe Text)
createReplicationJob_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReplicationJob' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:CreateReplicationJob' :: CreateReplicationJob -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: CreateReplicationJob
s@CreateReplicationJob' {} Maybe Text
a -> CreateReplicationJob
s {$sel:kmsKeyId:CreateReplicationJob' :: Maybe Text
kmsKeyId = Maybe Text
a} :: CreateReplicationJob)

-- | The license type to be used for the AMI created by a successful
-- replication run.
createReplicationJob_licenseType :: Lens.Lens' CreateReplicationJob (Prelude.Maybe LicenseType)
createReplicationJob_licenseType :: Lens' CreateReplicationJob (Maybe LicenseType)
createReplicationJob_licenseType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReplicationJob' {Maybe LicenseType
licenseType :: Maybe LicenseType
$sel:licenseType:CreateReplicationJob' :: CreateReplicationJob -> Maybe LicenseType
licenseType} -> Maybe LicenseType
licenseType) (\s :: CreateReplicationJob
s@CreateReplicationJob' {} Maybe LicenseType
a -> CreateReplicationJob
s {$sel:licenseType:CreateReplicationJob' :: Maybe LicenseType
licenseType = Maybe LicenseType
a} :: CreateReplicationJob)

-- | The maximum number of SMS-created AMIs to retain. The oldest is deleted
-- after the maximum number is reached and a new AMI is created.
createReplicationJob_numberOfRecentAmisToKeep :: Lens.Lens' CreateReplicationJob (Prelude.Maybe Prelude.Int)
createReplicationJob_numberOfRecentAmisToKeep :: Lens' CreateReplicationJob (Maybe Int)
createReplicationJob_numberOfRecentAmisToKeep = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReplicationJob' {Maybe Int
numberOfRecentAmisToKeep :: Maybe Int
$sel:numberOfRecentAmisToKeep:CreateReplicationJob' :: CreateReplicationJob -> Maybe Int
numberOfRecentAmisToKeep} -> Maybe Int
numberOfRecentAmisToKeep) (\s :: CreateReplicationJob
s@CreateReplicationJob' {} Maybe Int
a -> CreateReplicationJob
s {$sel:numberOfRecentAmisToKeep:CreateReplicationJob' :: Maybe Int
numberOfRecentAmisToKeep = Maybe Int
a} :: CreateReplicationJob)

-- | The name of the IAM role to be used by the Server Migration Service.
createReplicationJob_roleName :: Lens.Lens' CreateReplicationJob (Prelude.Maybe Prelude.Text)
createReplicationJob_roleName :: Lens' CreateReplicationJob (Maybe Text)
createReplicationJob_roleName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReplicationJob' {Maybe Text
roleName :: Maybe Text
$sel:roleName:CreateReplicationJob' :: CreateReplicationJob -> Maybe Text
roleName} -> Maybe Text
roleName) (\s :: CreateReplicationJob
s@CreateReplicationJob' {} Maybe Text
a -> CreateReplicationJob
s {$sel:roleName:CreateReplicationJob' :: Maybe Text
roleName = Maybe Text
a} :: CreateReplicationJob)

-- | Indicates whether to run the replication job one time.
createReplicationJob_runOnce :: Lens.Lens' CreateReplicationJob (Prelude.Maybe Prelude.Bool)
createReplicationJob_runOnce :: Lens' CreateReplicationJob (Maybe Bool)
createReplicationJob_runOnce = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReplicationJob' {Maybe Bool
runOnce :: Maybe Bool
$sel:runOnce:CreateReplicationJob' :: CreateReplicationJob -> Maybe Bool
runOnce} -> Maybe Bool
runOnce) (\s :: CreateReplicationJob
s@CreateReplicationJob' {} Maybe Bool
a -> CreateReplicationJob
s {$sel:runOnce:CreateReplicationJob' :: Maybe Bool
runOnce = Maybe Bool
a} :: CreateReplicationJob)

-- | The ID of the server.
createReplicationJob_serverId :: Lens.Lens' CreateReplicationJob Prelude.Text
createReplicationJob_serverId :: Lens' CreateReplicationJob Text
createReplicationJob_serverId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReplicationJob' {Text
serverId :: Text
$sel:serverId:CreateReplicationJob' :: CreateReplicationJob -> Text
serverId} -> Text
serverId) (\s :: CreateReplicationJob
s@CreateReplicationJob' {} Text
a -> CreateReplicationJob
s {$sel:serverId:CreateReplicationJob' :: Text
serverId = Text
a} :: CreateReplicationJob)

-- | The seed replication time.
createReplicationJob_seedReplicationTime :: Lens.Lens' CreateReplicationJob Prelude.UTCTime
createReplicationJob_seedReplicationTime :: Lens' CreateReplicationJob UTCTime
createReplicationJob_seedReplicationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReplicationJob' {POSIX
seedReplicationTime :: POSIX
$sel:seedReplicationTime:CreateReplicationJob' :: CreateReplicationJob -> POSIX
seedReplicationTime} -> POSIX
seedReplicationTime) (\s :: CreateReplicationJob
s@CreateReplicationJob' {} POSIX
a -> CreateReplicationJob
s {$sel:seedReplicationTime:CreateReplicationJob' :: POSIX
seedReplicationTime = POSIX
a} :: CreateReplicationJob) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Core.AWSRequest CreateReplicationJob where
  type
    AWSResponse CreateReplicationJob =
      CreateReplicationJobResponse
  request :: (Service -> Service)
-> CreateReplicationJob -> Request CreateReplicationJob
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 CreateReplicationJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateReplicationJob)))
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 -> CreateReplicationJobResponse
CreateReplicationJobResponse'
            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
"replicationJobId")
            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 CreateReplicationJob where
  hashWithSalt :: Int -> CreateReplicationJob -> Int
hashWithSalt Int
_salt CreateReplicationJob' {Maybe Bool
Maybe Int
Maybe Text
Maybe LicenseType
Text
POSIX
seedReplicationTime :: POSIX
serverId :: Text
runOnce :: Maybe Bool
roleName :: Maybe Text
numberOfRecentAmisToKeep :: Maybe Int
licenseType :: Maybe LicenseType
kmsKeyId :: Maybe Text
frequency :: Maybe Int
encrypted :: Maybe Bool
description :: Maybe Text
$sel:seedReplicationTime:CreateReplicationJob' :: CreateReplicationJob -> POSIX
$sel:serverId:CreateReplicationJob' :: CreateReplicationJob -> Text
$sel:runOnce:CreateReplicationJob' :: CreateReplicationJob -> Maybe Bool
$sel:roleName:CreateReplicationJob' :: CreateReplicationJob -> Maybe Text
$sel:numberOfRecentAmisToKeep:CreateReplicationJob' :: CreateReplicationJob -> Maybe Int
$sel:licenseType:CreateReplicationJob' :: CreateReplicationJob -> Maybe LicenseType
$sel:kmsKeyId:CreateReplicationJob' :: CreateReplicationJob -> Maybe Text
$sel:frequency:CreateReplicationJob' :: CreateReplicationJob -> Maybe Int
$sel:encrypted:CreateReplicationJob' :: CreateReplicationJob -> Maybe Bool
$sel:description:CreateReplicationJob' :: CreateReplicationJob -> 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` Maybe Bool
encrypted
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
frequency
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LicenseType
licenseType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
numberOfRecentAmisToKeep
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
roleName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
runOnce
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serverId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` POSIX
seedReplicationTime

instance Prelude.NFData CreateReplicationJob where
  rnf :: CreateReplicationJob -> ()
rnf CreateReplicationJob' {Maybe Bool
Maybe Int
Maybe Text
Maybe LicenseType
Text
POSIX
seedReplicationTime :: POSIX
serverId :: Text
runOnce :: Maybe Bool
roleName :: Maybe Text
numberOfRecentAmisToKeep :: Maybe Int
licenseType :: Maybe LicenseType
kmsKeyId :: Maybe Text
frequency :: Maybe Int
encrypted :: Maybe Bool
description :: Maybe Text
$sel:seedReplicationTime:CreateReplicationJob' :: CreateReplicationJob -> POSIX
$sel:serverId:CreateReplicationJob' :: CreateReplicationJob -> Text
$sel:runOnce:CreateReplicationJob' :: CreateReplicationJob -> Maybe Bool
$sel:roleName:CreateReplicationJob' :: CreateReplicationJob -> Maybe Text
$sel:numberOfRecentAmisToKeep:CreateReplicationJob' :: CreateReplicationJob -> Maybe Int
$sel:licenseType:CreateReplicationJob' :: CreateReplicationJob -> Maybe LicenseType
$sel:kmsKeyId:CreateReplicationJob' :: CreateReplicationJob -> Maybe Text
$sel:frequency:CreateReplicationJob' :: CreateReplicationJob -> Maybe Int
$sel:encrypted:CreateReplicationJob' :: CreateReplicationJob -> Maybe Bool
$sel:description:CreateReplicationJob' :: CreateReplicationJob -> 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 Maybe Bool
encrypted
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
frequency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LicenseType
licenseType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
numberOfRecentAmisToKeep
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
runOnce
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serverId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
seedReplicationTime

instance Data.ToHeaders CreateReplicationJob where
  toHeaders :: CreateReplicationJob -> 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.CreateReplicationJob" ::
                          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 CreateReplicationJob where
  toJSON :: CreateReplicationJob -> Value
toJSON CreateReplicationJob' {Maybe Bool
Maybe Int
Maybe Text
Maybe LicenseType
Text
POSIX
seedReplicationTime :: POSIX
serverId :: Text
runOnce :: Maybe Bool
roleName :: Maybe Text
numberOfRecentAmisToKeep :: Maybe Int
licenseType :: Maybe LicenseType
kmsKeyId :: Maybe Text
frequency :: Maybe Int
encrypted :: Maybe Bool
description :: Maybe Text
$sel:seedReplicationTime:CreateReplicationJob' :: CreateReplicationJob -> POSIX
$sel:serverId:CreateReplicationJob' :: CreateReplicationJob -> Text
$sel:runOnce:CreateReplicationJob' :: CreateReplicationJob -> Maybe Bool
$sel:roleName:CreateReplicationJob' :: CreateReplicationJob -> Maybe Text
$sel:numberOfRecentAmisToKeep:CreateReplicationJob' :: CreateReplicationJob -> Maybe Int
$sel:licenseType:CreateReplicationJob' :: CreateReplicationJob -> Maybe LicenseType
$sel:kmsKeyId:CreateReplicationJob' :: CreateReplicationJob -> Maybe Text
$sel:frequency:CreateReplicationJob' :: CreateReplicationJob -> Maybe Int
$sel:encrypted:CreateReplicationJob' :: CreateReplicationJob -> Maybe Bool
$sel:description:CreateReplicationJob' :: CreateReplicationJob -> 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,
            (Key
"encrypted" 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 Bool
encrypted,
            (Key
"frequency" 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 Int
frequency,
            (Key
"kmsKeyId" 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
kmsKeyId,
            (Key
"licenseType" 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 LicenseType
licenseType,
            (Key
"numberOfRecentAmisToKeep" 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 Int
numberOfRecentAmisToKeep,
            (Key
"roleName" 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
roleName,
            (Key
"runOnce" 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 Bool
runOnce,
            forall a. a -> Maybe a
Prelude.Just (Key
"serverId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serverId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"seedReplicationTime" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= POSIX
seedReplicationTime)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateReplicationJobResponse' 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:
--
-- 'replicationJobId', 'createReplicationJobResponse_replicationJobId' - The unique identifier of the replication job.
--
-- 'httpStatus', 'createReplicationJobResponse_httpStatus' - The response's http status code.
newCreateReplicationJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateReplicationJobResponse
newCreateReplicationJobResponse :: Int -> CreateReplicationJobResponse
newCreateReplicationJobResponse Int
pHttpStatus_ =
  CreateReplicationJobResponse'
    { $sel:replicationJobId:CreateReplicationJobResponse' :: Maybe Text
replicationJobId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateReplicationJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The unique identifier of the replication job.
createReplicationJobResponse_replicationJobId :: Lens.Lens' CreateReplicationJobResponse (Prelude.Maybe Prelude.Text)
createReplicationJobResponse_replicationJobId :: Lens' CreateReplicationJobResponse (Maybe Text)
createReplicationJobResponse_replicationJobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateReplicationJobResponse' {Maybe Text
replicationJobId :: Maybe Text
$sel:replicationJobId:CreateReplicationJobResponse' :: CreateReplicationJobResponse -> Maybe Text
replicationJobId} -> Maybe Text
replicationJobId) (\s :: CreateReplicationJobResponse
s@CreateReplicationJobResponse' {} Maybe Text
a -> CreateReplicationJobResponse
s {$sel:replicationJobId:CreateReplicationJobResponse' :: Maybe Text
replicationJobId = Maybe Text
a} :: CreateReplicationJobResponse)

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

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