{-# 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.DeleteReplicationJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes the specified replication job.
--
-- After you delete a replication job, there are no further replication
-- runs. Amazon Web Services deletes the contents of the Amazon S3 bucket
-- used to store Server Migration Service artifacts. The AMIs created by
-- the replication runs are not deleted.
module Amazonka.SMS.DeleteReplicationJob
  ( -- * Creating a Request
    DeleteReplicationJob (..),
    newDeleteReplicationJob,

    -- * Request Lenses
    deleteReplicationJob_replicationJobId,

    -- * Destructuring the Response
    DeleteReplicationJobResponse (..),
    newDeleteReplicationJobResponse,

    -- * Response Lenses
    deleteReplicationJobResponse_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:/ 'newDeleteReplicationJob' smart constructor.
data DeleteReplicationJob = DeleteReplicationJob'
  { -- | The ID of the replication job.
    DeleteReplicationJob -> Text
replicationJobId :: Prelude.Text
  }
  deriving (DeleteReplicationJob -> DeleteReplicationJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteReplicationJob -> DeleteReplicationJob -> Bool
$c/= :: DeleteReplicationJob -> DeleteReplicationJob -> Bool
== :: DeleteReplicationJob -> DeleteReplicationJob -> Bool
$c== :: DeleteReplicationJob -> DeleteReplicationJob -> Bool
Prelude.Eq, ReadPrec [DeleteReplicationJob]
ReadPrec DeleteReplicationJob
Int -> ReadS DeleteReplicationJob
ReadS [DeleteReplicationJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteReplicationJob]
$creadListPrec :: ReadPrec [DeleteReplicationJob]
readPrec :: ReadPrec DeleteReplicationJob
$creadPrec :: ReadPrec DeleteReplicationJob
readList :: ReadS [DeleteReplicationJob]
$creadList :: ReadS [DeleteReplicationJob]
readsPrec :: Int -> ReadS DeleteReplicationJob
$creadsPrec :: Int -> ReadS DeleteReplicationJob
Prelude.Read, Int -> DeleteReplicationJob -> ShowS
[DeleteReplicationJob] -> ShowS
DeleteReplicationJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteReplicationJob] -> ShowS
$cshowList :: [DeleteReplicationJob] -> ShowS
show :: DeleteReplicationJob -> String
$cshow :: DeleteReplicationJob -> String
showsPrec :: Int -> DeleteReplicationJob -> ShowS
$cshowsPrec :: Int -> DeleteReplicationJob -> ShowS
Prelude.Show, forall x. Rep DeleteReplicationJob x -> DeleteReplicationJob
forall x. DeleteReplicationJob -> Rep DeleteReplicationJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteReplicationJob x -> DeleteReplicationJob
$cfrom :: forall x. DeleteReplicationJob -> Rep DeleteReplicationJob x
Prelude.Generic)

-- |
-- Create a value of 'DeleteReplicationJob' 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', 'deleteReplicationJob_replicationJobId' - The ID of the replication job.
newDeleteReplicationJob ::
  -- | 'replicationJobId'
  Prelude.Text ->
  DeleteReplicationJob
newDeleteReplicationJob :: Text -> DeleteReplicationJob
newDeleteReplicationJob Text
pReplicationJobId_ =
  DeleteReplicationJob'
    { $sel:replicationJobId:DeleteReplicationJob' :: Text
replicationJobId =
        Text
pReplicationJobId_
    }

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

instance Core.AWSRequest DeleteReplicationJob where
  type
    AWSResponse DeleteReplicationJob =
      DeleteReplicationJobResponse
  request :: (Service -> Service)
-> DeleteReplicationJob -> Request DeleteReplicationJob
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 DeleteReplicationJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteReplicationJob)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> DeleteReplicationJobResponse
DeleteReplicationJobResponse'
            forall (f :: * -> *) a b. Functor 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 DeleteReplicationJob where
  hashWithSalt :: Int -> DeleteReplicationJob -> Int
hashWithSalt Int
_salt DeleteReplicationJob' {Text
replicationJobId :: Text
$sel:replicationJobId:DeleteReplicationJob' :: DeleteReplicationJob -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
replicationJobId

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

instance Data.ToHeaders DeleteReplicationJob where
  toHeaders :: DeleteReplicationJob -> 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.DeleteReplicationJob" ::
                          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 DeleteReplicationJob where
  toJSON :: DeleteReplicationJob -> Value
toJSON DeleteReplicationJob' {Text
replicationJobId :: Text
$sel:replicationJobId:DeleteReplicationJob' :: DeleteReplicationJob -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ 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 DeleteReplicationJob where
  toPath :: DeleteReplicationJob -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

-- |
-- Create a value of 'DeleteReplicationJobResponse' 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:
--
-- 'httpStatus', 'deleteReplicationJobResponse_httpStatus' - The response's http status code.
newDeleteReplicationJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteReplicationJobResponse
newDeleteReplicationJobResponse :: Int -> DeleteReplicationJobResponse
newDeleteReplicationJobResponse Int
pHttpStatus_ =
  DeleteReplicationJobResponse'
    { $sel:httpStatus:DeleteReplicationJobResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData DeleteReplicationJobResponse where
  rnf :: DeleteReplicationJobResponse -> ()
rnf DeleteReplicationJobResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteReplicationJobResponse' :: DeleteReplicationJobResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus