{-# 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.MacieV2.UpdateClassificationJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Changes the status of a classification job.
module Amazonka.MacieV2.UpdateClassificationJob
  ( -- * Creating a Request
    UpdateClassificationJob (..),
    newUpdateClassificationJob,

    -- * Request Lenses
    updateClassificationJob_jobId,
    updateClassificationJob_jobStatus,

    -- * Destructuring the Response
    UpdateClassificationJobResponse (..),
    newUpdateClassificationJobResponse,

    -- * Response Lenses
    updateClassificationJobResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateClassificationJob' smart constructor.
data UpdateClassificationJob = UpdateClassificationJob'
  { -- | The unique identifier for the classification job.
    UpdateClassificationJob -> Text
jobId :: Prelude.Text,
    -- | The new status for the job. Valid values are:
    --
    -- -   CANCELLED - Stops the job permanently and cancels it. This value is
    --     valid only if the job\'s current status is IDLE, PAUSED, RUNNING, or
    --     USER_PAUSED.
    --
    --     If you specify this value and the job\'s current status is RUNNING,
    --     Amazon Macie immediately begins to stop all processing tasks for the
    --     job. You can\'t resume or restart a job after you cancel it.
    --
    -- -   RUNNING - Resumes the job. This value is valid only if the job\'s
    --     current status is USER_PAUSED.
    --
    --     If you paused the job while it was actively running and you specify
    --     this value less than 30 days after you paused the job, Macie
    --     immediately resumes processing from the point where you paused the
    --     job. Otherwise, Macie resumes the job according to the schedule and
    --     other settings for the job.
    --
    -- -   USER_PAUSED - Pauses the job temporarily. This value is valid only
    --     if the job\'s current status is IDLE, PAUSED, or RUNNING. If you
    --     specify this value and the job\'s current status is RUNNING, Macie
    --     immediately begins to pause all processing tasks for the job.
    --
    --     If you pause a one-time job and you don\'t resume it within 30 days,
    --     the job expires and Macie cancels the job. If you pause a recurring
    --     job when its status is RUNNING and you don\'t resume it within 30
    --     days, the job run expires and Macie cancels the run. To check the
    --     expiration date, refer to the UserPausedDetails.jobExpiresAt
    --     property.
    UpdateClassificationJob -> JobStatus
jobStatus :: JobStatus
  }
  deriving (UpdateClassificationJob -> UpdateClassificationJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateClassificationJob -> UpdateClassificationJob -> Bool
$c/= :: UpdateClassificationJob -> UpdateClassificationJob -> Bool
== :: UpdateClassificationJob -> UpdateClassificationJob -> Bool
$c== :: UpdateClassificationJob -> UpdateClassificationJob -> Bool
Prelude.Eq, ReadPrec [UpdateClassificationJob]
ReadPrec UpdateClassificationJob
Int -> ReadS UpdateClassificationJob
ReadS [UpdateClassificationJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateClassificationJob]
$creadListPrec :: ReadPrec [UpdateClassificationJob]
readPrec :: ReadPrec UpdateClassificationJob
$creadPrec :: ReadPrec UpdateClassificationJob
readList :: ReadS [UpdateClassificationJob]
$creadList :: ReadS [UpdateClassificationJob]
readsPrec :: Int -> ReadS UpdateClassificationJob
$creadsPrec :: Int -> ReadS UpdateClassificationJob
Prelude.Read, Int -> UpdateClassificationJob -> ShowS
[UpdateClassificationJob] -> ShowS
UpdateClassificationJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateClassificationJob] -> ShowS
$cshowList :: [UpdateClassificationJob] -> ShowS
show :: UpdateClassificationJob -> String
$cshow :: UpdateClassificationJob -> String
showsPrec :: Int -> UpdateClassificationJob -> ShowS
$cshowsPrec :: Int -> UpdateClassificationJob -> ShowS
Prelude.Show, forall x. Rep UpdateClassificationJob x -> UpdateClassificationJob
forall x. UpdateClassificationJob -> Rep UpdateClassificationJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateClassificationJob x -> UpdateClassificationJob
$cfrom :: forall x. UpdateClassificationJob -> Rep UpdateClassificationJob x
Prelude.Generic)

-- |
-- Create a value of 'UpdateClassificationJob' 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:
--
-- 'jobId', 'updateClassificationJob_jobId' - The unique identifier for the classification job.
--
-- 'jobStatus', 'updateClassificationJob_jobStatus' - The new status for the job. Valid values are:
--
-- -   CANCELLED - Stops the job permanently and cancels it. This value is
--     valid only if the job\'s current status is IDLE, PAUSED, RUNNING, or
--     USER_PAUSED.
--
--     If you specify this value and the job\'s current status is RUNNING,
--     Amazon Macie immediately begins to stop all processing tasks for the
--     job. You can\'t resume or restart a job after you cancel it.
--
-- -   RUNNING - Resumes the job. This value is valid only if the job\'s
--     current status is USER_PAUSED.
--
--     If you paused the job while it was actively running and you specify
--     this value less than 30 days after you paused the job, Macie
--     immediately resumes processing from the point where you paused the
--     job. Otherwise, Macie resumes the job according to the schedule and
--     other settings for the job.
--
-- -   USER_PAUSED - Pauses the job temporarily. This value is valid only
--     if the job\'s current status is IDLE, PAUSED, or RUNNING. If you
--     specify this value and the job\'s current status is RUNNING, Macie
--     immediately begins to pause all processing tasks for the job.
--
--     If you pause a one-time job and you don\'t resume it within 30 days,
--     the job expires and Macie cancels the job. If you pause a recurring
--     job when its status is RUNNING and you don\'t resume it within 30
--     days, the job run expires and Macie cancels the run. To check the
--     expiration date, refer to the UserPausedDetails.jobExpiresAt
--     property.
newUpdateClassificationJob ::
  -- | 'jobId'
  Prelude.Text ->
  -- | 'jobStatus'
  JobStatus ->
  UpdateClassificationJob
newUpdateClassificationJob :: Text -> JobStatus -> UpdateClassificationJob
newUpdateClassificationJob Text
pJobId_ JobStatus
pJobStatus_ =
  UpdateClassificationJob'
    { $sel:jobId:UpdateClassificationJob' :: Text
jobId = Text
pJobId_,
      $sel:jobStatus:UpdateClassificationJob' :: JobStatus
jobStatus = JobStatus
pJobStatus_
    }

-- | The unique identifier for the classification job.
updateClassificationJob_jobId :: Lens.Lens' UpdateClassificationJob Prelude.Text
updateClassificationJob_jobId :: Lens' UpdateClassificationJob Text
updateClassificationJob_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClassificationJob' {Text
jobId :: Text
$sel:jobId:UpdateClassificationJob' :: UpdateClassificationJob -> Text
jobId} -> Text
jobId) (\s :: UpdateClassificationJob
s@UpdateClassificationJob' {} Text
a -> UpdateClassificationJob
s {$sel:jobId:UpdateClassificationJob' :: Text
jobId = Text
a} :: UpdateClassificationJob)

-- | The new status for the job. Valid values are:
--
-- -   CANCELLED - Stops the job permanently and cancels it. This value is
--     valid only if the job\'s current status is IDLE, PAUSED, RUNNING, or
--     USER_PAUSED.
--
--     If you specify this value and the job\'s current status is RUNNING,
--     Amazon Macie immediately begins to stop all processing tasks for the
--     job. You can\'t resume or restart a job after you cancel it.
--
-- -   RUNNING - Resumes the job. This value is valid only if the job\'s
--     current status is USER_PAUSED.
--
--     If you paused the job while it was actively running and you specify
--     this value less than 30 days after you paused the job, Macie
--     immediately resumes processing from the point where you paused the
--     job. Otherwise, Macie resumes the job according to the schedule and
--     other settings for the job.
--
-- -   USER_PAUSED - Pauses the job temporarily. This value is valid only
--     if the job\'s current status is IDLE, PAUSED, or RUNNING. If you
--     specify this value and the job\'s current status is RUNNING, Macie
--     immediately begins to pause all processing tasks for the job.
--
--     If you pause a one-time job and you don\'t resume it within 30 days,
--     the job expires and Macie cancels the job. If you pause a recurring
--     job when its status is RUNNING and you don\'t resume it within 30
--     days, the job run expires and Macie cancels the run. To check the
--     expiration date, refer to the UserPausedDetails.jobExpiresAt
--     property.
updateClassificationJob_jobStatus :: Lens.Lens' UpdateClassificationJob JobStatus
updateClassificationJob_jobStatus :: Lens' UpdateClassificationJob JobStatus
updateClassificationJob_jobStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateClassificationJob' {JobStatus
jobStatus :: JobStatus
$sel:jobStatus:UpdateClassificationJob' :: UpdateClassificationJob -> JobStatus
jobStatus} -> JobStatus
jobStatus) (\s :: UpdateClassificationJob
s@UpdateClassificationJob' {} JobStatus
a -> UpdateClassificationJob
s {$sel:jobStatus:UpdateClassificationJob' :: JobStatus
jobStatus = JobStatus
a} :: UpdateClassificationJob)

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

instance Prelude.NFData UpdateClassificationJob where
  rnf :: UpdateClassificationJob -> ()
rnf UpdateClassificationJob' {Text
JobStatus
jobStatus :: JobStatus
jobId :: Text
$sel:jobStatus:UpdateClassificationJob' :: UpdateClassificationJob -> JobStatus
$sel:jobId:UpdateClassificationJob' :: UpdateClassificationJob -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
jobId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf JobStatus
jobStatus

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

instance Data.ToPath UpdateClassificationJob where
  toPath :: UpdateClassificationJob -> ByteString
toPath UpdateClassificationJob' {Text
JobStatus
jobStatus :: JobStatus
jobId :: Text
$sel:jobStatus:UpdateClassificationJob' :: UpdateClassificationJob -> JobStatus
$sel:jobId:UpdateClassificationJob' :: UpdateClassificationJob -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/jobs/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
jobId]

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

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

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

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

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