{-# 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.SageMakerGeoSpatial.DeleteEarthObservationJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use this operation to delete an Earth Observation job.
module Amazonka.SageMakerGeoSpatial.DeleteEarthObservationJob
  ( -- * Creating a Request
    DeleteEarthObservationJob (..),
    newDeleteEarthObservationJob,

    -- * Request Lenses
    deleteEarthObservationJob_arn,

    -- * Destructuring the Response
    DeleteEarthObservationJobResponse (..),
    newDeleteEarthObservationJobResponse,

    -- * Response Lenses
    deleteEarthObservationJobResponse_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.SageMakerGeoSpatial.Types

-- | /See:/ 'newDeleteEarthObservationJob' smart constructor.
data DeleteEarthObservationJob = DeleteEarthObservationJob'
  { -- | The Amazon Resource Name (ARN) of the Earth Observation job being
    -- deleted.
    DeleteEarthObservationJob -> Text
arn :: Prelude.Text
  }
  deriving (DeleteEarthObservationJob -> DeleteEarthObservationJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteEarthObservationJob -> DeleteEarthObservationJob -> Bool
$c/= :: DeleteEarthObservationJob -> DeleteEarthObservationJob -> Bool
== :: DeleteEarthObservationJob -> DeleteEarthObservationJob -> Bool
$c== :: DeleteEarthObservationJob -> DeleteEarthObservationJob -> Bool
Prelude.Eq, ReadPrec [DeleteEarthObservationJob]
ReadPrec DeleteEarthObservationJob
Int -> ReadS DeleteEarthObservationJob
ReadS [DeleteEarthObservationJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteEarthObservationJob]
$creadListPrec :: ReadPrec [DeleteEarthObservationJob]
readPrec :: ReadPrec DeleteEarthObservationJob
$creadPrec :: ReadPrec DeleteEarthObservationJob
readList :: ReadS [DeleteEarthObservationJob]
$creadList :: ReadS [DeleteEarthObservationJob]
readsPrec :: Int -> ReadS DeleteEarthObservationJob
$creadsPrec :: Int -> ReadS DeleteEarthObservationJob
Prelude.Read, Int -> DeleteEarthObservationJob -> ShowS
[DeleteEarthObservationJob] -> ShowS
DeleteEarthObservationJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteEarthObservationJob] -> ShowS
$cshowList :: [DeleteEarthObservationJob] -> ShowS
show :: DeleteEarthObservationJob -> String
$cshow :: DeleteEarthObservationJob -> String
showsPrec :: Int -> DeleteEarthObservationJob -> ShowS
$cshowsPrec :: Int -> DeleteEarthObservationJob -> ShowS
Prelude.Show, forall x.
Rep DeleteEarthObservationJob x -> DeleteEarthObservationJob
forall x.
DeleteEarthObservationJob -> Rep DeleteEarthObservationJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteEarthObservationJob x -> DeleteEarthObservationJob
$cfrom :: forall x.
DeleteEarthObservationJob -> Rep DeleteEarthObservationJob x
Prelude.Generic)

-- |
-- Create a value of 'DeleteEarthObservationJob' 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:
--
-- 'arn', 'deleteEarthObservationJob_arn' - The Amazon Resource Name (ARN) of the Earth Observation job being
-- deleted.
newDeleteEarthObservationJob ::
  -- | 'arn'
  Prelude.Text ->
  DeleteEarthObservationJob
newDeleteEarthObservationJob :: Text -> DeleteEarthObservationJob
newDeleteEarthObservationJob Text
pArn_ =
  DeleteEarthObservationJob' {$sel:arn:DeleteEarthObservationJob' :: Text
arn = Text
pArn_}

-- | The Amazon Resource Name (ARN) of the Earth Observation job being
-- deleted.
deleteEarthObservationJob_arn :: Lens.Lens' DeleteEarthObservationJob Prelude.Text
deleteEarthObservationJob_arn :: Lens' DeleteEarthObservationJob Text
deleteEarthObservationJob_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteEarthObservationJob' {Text
arn :: Text
$sel:arn:DeleteEarthObservationJob' :: DeleteEarthObservationJob -> Text
arn} -> Text
arn) (\s :: DeleteEarthObservationJob
s@DeleteEarthObservationJob' {} Text
a -> DeleteEarthObservationJob
s {$sel:arn:DeleteEarthObservationJob' :: Text
arn = Text
a} :: DeleteEarthObservationJob)

instance Core.AWSRequest DeleteEarthObservationJob where
  type
    AWSResponse DeleteEarthObservationJob =
      DeleteEarthObservationJobResponse
  request :: (Service -> Service)
-> DeleteEarthObservationJob -> Request DeleteEarthObservationJob
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteEarthObservationJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteEarthObservationJob)))
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 -> DeleteEarthObservationJobResponse
DeleteEarthObservationJobResponse'
            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 DeleteEarthObservationJob where
  hashWithSalt :: Int -> DeleteEarthObservationJob -> Int
hashWithSalt Int
_salt DeleteEarthObservationJob' {Text
arn :: Text
$sel:arn:DeleteEarthObservationJob' :: DeleteEarthObservationJob -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

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

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

instance Data.ToPath DeleteEarthObservationJob where
  toPath :: DeleteEarthObservationJob -> ByteString
toPath DeleteEarthObservationJob' {Text
arn :: Text
$sel:arn:DeleteEarthObservationJob' :: DeleteEarthObservationJob -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/earth-observation-jobs/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
arn]

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

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

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

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

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