{-# 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.Comprehend.StopKeyPhrasesDetectionJob
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stops a key phrases detection job in progress.
--
-- If the job state is @IN_PROGRESS@ the job is marked for termination and
-- put into the @STOP_REQUESTED@ state. If the job completes before it can
-- be stopped, it is put into the @COMPLETED@ state; otherwise the job is
-- stopped and put into the @STOPPED@ state.
--
-- If the job is in the @COMPLETED@ or @FAILED@ state when you call the
-- @StopDominantLanguageDetectionJob@ operation, the operation returns a
-- 400 Internal Request Exception.
--
-- When a job is stopped, any documents already processed are written to
-- the output location.
module Amazonka.Comprehend.StopKeyPhrasesDetectionJob
  ( -- * Creating a Request
    StopKeyPhrasesDetectionJob (..),
    newStopKeyPhrasesDetectionJob,

    -- * Request Lenses
    stopKeyPhrasesDetectionJob_jobId,

    -- * Destructuring the Response
    StopKeyPhrasesDetectionJobResponse (..),
    newStopKeyPhrasesDetectionJobResponse,

    -- * Response Lenses
    stopKeyPhrasesDetectionJobResponse_jobId,
    stopKeyPhrasesDetectionJobResponse_jobStatus,
    stopKeyPhrasesDetectionJobResponse_httpStatus,
  )
where

import Amazonka.Comprehend.Types
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

-- | /See:/ 'newStopKeyPhrasesDetectionJob' smart constructor.
data StopKeyPhrasesDetectionJob = StopKeyPhrasesDetectionJob'
  { -- | The identifier of the key phrases detection job to stop.
    StopKeyPhrasesDetectionJob -> Text
jobId :: Prelude.Text
  }
  deriving (StopKeyPhrasesDetectionJob -> StopKeyPhrasesDetectionJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopKeyPhrasesDetectionJob -> StopKeyPhrasesDetectionJob -> Bool
$c/= :: StopKeyPhrasesDetectionJob -> StopKeyPhrasesDetectionJob -> Bool
== :: StopKeyPhrasesDetectionJob -> StopKeyPhrasesDetectionJob -> Bool
$c== :: StopKeyPhrasesDetectionJob -> StopKeyPhrasesDetectionJob -> Bool
Prelude.Eq, ReadPrec [StopKeyPhrasesDetectionJob]
ReadPrec StopKeyPhrasesDetectionJob
Int -> ReadS StopKeyPhrasesDetectionJob
ReadS [StopKeyPhrasesDetectionJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopKeyPhrasesDetectionJob]
$creadListPrec :: ReadPrec [StopKeyPhrasesDetectionJob]
readPrec :: ReadPrec StopKeyPhrasesDetectionJob
$creadPrec :: ReadPrec StopKeyPhrasesDetectionJob
readList :: ReadS [StopKeyPhrasesDetectionJob]
$creadList :: ReadS [StopKeyPhrasesDetectionJob]
readsPrec :: Int -> ReadS StopKeyPhrasesDetectionJob
$creadsPrec :: Int -> ReadS StopKeyPhrasesDetectionJob
Prelude.Read, Int -> StopKeyPhrasesDetectionJob -> ShowS
[StopKeyPhrasesDetectionJob] -> ShowS
StopKeyPhrasesDetectionJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopKeyPhrasesDetectionJob] -> ShowS
$cshowList :: [StopKeyPhrasesDetectionJob] -> ShowS
show :: StopKeyPhrasesDetectionJob -> String
$cshow :: StopKeyPhrasesDetectionJob -> String
showsPrec :: Int -> StopKeyPhrasesDetectionJob -> ShowS
$cshowsPrec :: Int -> StopKeyPhrasesDetectionJob -> ShowS
Prelude.Show, forall x.
Rep StopKeyPhrasesDetectionJob x -> StopKeyPhrasesDetectionJob
forall x.
StopKeyPhrasesDetectionJob -> Rep StopKeyPhrasesDetectionJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StopKeyPhrasesDetectionJob x -> StopKeyPhrasesDetectionJob
$cfrom :: forall x.
StopKeyPhrasesDetectionJob -> Rep StopKeyPhrasesDetectionJob x
Prelude.Generic)

-- |
-- Create a value of 'StopKeyPhrasesDetectionJob' 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', 'stopKeyPhrasesDetectionJob_jobId' - The identifier of the key phrases detection job to stop.
newStopKeyPhrasesDetectionJob ::
  -- | 'jobId'
  Prelude.Text ->
  StopKeyPhrasesDetectionJob
newStopKeyPhrasesDetectionJob :: Text -> StopKeyPhrasesDetectionJob
newStopKeyPhrasesDetectionJob Text
pJobId_ =
  StopKeyPhrasesDetectionJob' {$sel:jobId:StopKeyPhrasesDetectionJob' :: Text
jobId = Text
pJobId_}

-- | The identifier of the key phrases detection job to stop.
stopKeyPhrasesDetectionJob_jobId :: Lens.Lens' StopKeyPhrasesDetectionJob Prelude.Text
stopKeyPhrasesDetectionJob_jobId :: Lens' StopKeyPhrasesDetectionJob Text
stopKeyPhrasesDetectionJob_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopKeyPhrasesDetectionJob' {Text
jobId :: Text
$sel:jobId:StopKeyPhrasesDetectionJob' :: StopKeyPhrasesDetectionJob -> Text
jobId} -> Text
jobId) (\s :: StopKeyPhrasesDetectionJob
s@StopKeyPhrasesDetectionJob' {} Text
a -> StopKeyPhrasesDetectionJob
s {$sel:jobId:StopKeyPhrasesDetectionJob' :: Text
jobId = Text
a} :: StopKeyPhrasesDetectionJob)

instance Core.AWSRequest StopKeyPhrasesDetectionJob where
  type
    AWSResponse StopKeyPhrasesDetectionJob =
      StopKeyPhrasesDetectionJobResponse
  request :: (Service -> Service)
-> StopKeyPhrasesDetectionJob -> Request StopKeyPhrasesDetectionJob
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 StopKeyPhrasesDetectionJob
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StopKeyPhrasesDetectionJob)))
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
-> Maybe JobStatus -> Int -> StopKeyPhrasesDetectionJobResponse
StopKeyPhrasesDetectionJobResponse'
            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
"JobId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"JobStatus")
            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 StopKeyPhrasesDetectionJob where
  hashWithSalt :: Int -> StopKeyPhrasesDetectionJob -> Int
hashWithSalt Int
_salt StopKeyPhrasesDetectionJob' {Text
jobId :: Text
$sel:jobId:StopKeyPhrasesDetectionJob' :: StopKeyPhrasesDetectionJob -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

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

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

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

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

-- | /See:/ 'newStopKeyPhrasesDetectionJobResponse' smart constructor.
data StopKeyPhrasesDetectionJobResponse = StopKeyPhrasesDetectionJobResponse'
  { -- | The identifier of the key phrases detection job to stop.
    StopKeyPhrasesDetectionJobResponse -> Maybe Text
jobId :: Prelude.Maybe Prelude.Text,
    -- | Either @STOP_REQUESTED@ if the job is currently running, or @STOPPED@ if
    -- the job was previously stopped with the @StopKeyPhrasesDetectionJob@
    -- operation.
    StopKeyPhrasesDetectionJobResponse -> Maybe JobStatus
jobStatus :: Prelude.Maybe JobStatus,
    -- | The response's http status code.
    StopKeyPhrasesDetectionJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StopKeyPhrasesDetectionJobResponse
-> StopKeyPhrasesDetectionJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopKeyPhrasesDetectionJobResponse
-> StopKeyPhrasesDetectionJobResponse -> Bool
$c/= :: StopKeyPhrasesDetectionJobResponse
-> StopKeyPhrasesDetectionJobResponse -> Bool
== :: StopKeyPhrasesDetectionJobResponse
-> StopKeyPhrasesDetectionJobResponse -> Bool
$c== :: StopKeyPhrasesDetectionJobResponse
-> StopKeyPhrasesDetectionJobResponse -> Bool
Prelude.Eq, ReadPrec [StopKeyPhrasesDetectionJobResponse]
ReadPrec StopKeyPhrasesDetectionJobResponse
Int -> ReadS StopKeyPhrasesDetectionJobResponse
ReadS [StopKeyPhrasesDetectionJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopKeyPhrasesDetectionJobResponse]
$creadListPrec :: ReadPrec [StopKeyPhrasesDetectionJobResponse]
readPrec :: ReadPrec StopKeyPhrasesDetectionJobResponse
$creadPrec :: ReadPrec StopKeyPhrasesDetectionJobResponse
readList :: ReadS [StopKeyPhrasesDetectionJobResponse]
$creadList :: ReadS [StopKeyPhrasesDetectionJobResponse]
readsPrec :: Int -> ReadS StopKeyPhrasesDetectionJobResponse
$creadsPrec :: Int -> ReadS StopKeyPhrasesDetectionJobResponse
Prelude.Read, Int -> StopKeyPhrasesDetectionJobResponse -> ShowS
[StopKeyPhrasesDetectionJobResponse] -> ShowS
StopKeyPhrasesDetectionJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopKeyPhrasesDetectionJobResponse] -> ShowS
$cshowList :: [StopKeyPhrasesDetectionJobResponse] -> ShowS
show :: StopKeyPhrasesDetectionJobResponse -> String
$cshow :: StopKeyPhrasesDetectionJobResponse -> String
showsPrec :: Int -> StopKeyPhrasesDetectionJobResponse -> ShowS
$cshowsPrec :: Int -> StopKeyPhrasesDetectionJobResponse -> ShowS
Prelude.Show, forall x.
Rep StopKeyPhrasesDetectionJobResponse x
-> StopKeyPhrasesDetectionJobResponse
forall x.
StopKeyPhrasesDetectionJobResponse
-> Rep StopKeyPhrasesDetectionJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StopKeyPhrasesDetectionJobResponse x
-> StopKeyPhrasesDetectionJobResponse
$cfrom :: forall x.
StopKeyPhrasesDetectionJobResponse
-> Rep StopKeyPhrasesDetectionJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'StopKeyPhrasesDetectionJobResponse' 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', 'stopKeyPhrasesDetectionJobResponse_jobId' - The identifier of the key phrases detection job to stop.
--
-- 'jobStatus', 'stopKeyPhrasesDetectionJobResponse_jobStatus' - Either @STOP_REQUESTED@ if the job is currently running, or @STOPPED@ if
-- the job was previously stopped with the @StopKeyPhrasesDetectionJob@
-- operation.
--
-- 'httpStatus', 'stopKeyPhrasesDetectionJobResponse_httpStatus' - The response's http status code.
newStopKeyPhrasesDetectionJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StopKeyPhrasesDetectionJobResponse
newStopKeyPhrasesDetectionJobResponse :: Int -> StopKeyPhrasesDetectionJobResponse
newStopKeyPhrasesDetectionJobResponse Int
pHttpStatus_ =
  StopKeyPhrasesDetectionJobResponse'
    { $sel:jobId:StopKeyPhrasesDetectionJobResponse' :: Maybe Text
jobId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:jobStatus:StopKeyPhrasesDetectionJobResponse' :: Maybe JobStatus
jobStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:StopKeyPhrasesDetectionJobResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The identifier of the key phrases detection job to stop.
stopKeyPhrasesDetectionJobResponse_jobId :: Lens.Lens' StopKeyPhrasesDetectionJobResponse (Prelude.Maybe Prelude.Text)
stopKeyPhrasesDetectionJobResponse_jobId :: Lens' StopKeyPhrasesDetectionJobResponse (Maybe Text)
stopKeyPhrasesDetectionJobResponse_jobId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopKeyPhrasesDetectionJobResponse' {Maybe Text
jobId :: Maybe Text
$sel:jobId:StopKeyPhrasesDetectionJobResponse' :: StopKeyPhrasesDetectionJobResponse -> Maybe Text
jobId} -> Maybe Text
jobId) (\s :: StopKeyPhrasesDetectionJobResponse
s@StopKeyPhrasesDetectionJobResponse' {} Maybe Text
a -> StopKeyPhrasesDetectionJobResponse
s {$sel:jobId:StopKeyPhrasesDetectionJobResponse' :: Maybe Text
jobId = Maybe Text
a} :: StopKeyPhrasesDetectionJobResponse)

-- | Either @STOP_REQUESTED@ if the job is currently running, or @STOPPED@ if
-- the job was previously stopped with the @StopKeyPhrasesDetectionJob@
-- operation.
stopKeyPhrasesDetectionJobResponse_jobStatus :: Lens.Lens' StopKeyPhrasesDetectionJobResponse (Prelude.Maybe JobStatus)
stopKeyPhrasesDetectionJobResponse_jobStatus :: Lens' StopKeyPhrasesDetectionJobResponse (Maybe JobStatus)
stopKeyPhrasesDetectionJobResponse_jobStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopKeyPhrasesDetectionJobResponse' {Maybe JobStatus
jobStatus :: Maybe JobStatus
$sel:jobStatus:StopKeyPhrasesDetectionJobResponse' :: StopKeyPhrasesDetectionJobResponse -> Maybe JobStatus
jobStatus} -> Maybe JobStatus
jobStatus) (\s :: StopKeyPhrasesDetectionJobResponse
s@StopKeyPhrasesDetectionJobResponse' {} Maybe JobStatus
a -> StopKeyPhrasesDetectionJobResponse
s {$sel:jobStatus:StopKeyPhrasesDetectionJobResponse' :: Maybe JobStatus
jobStatus = Maybe JobStatus
a} :: StopKeyPhrasesDetectionJobResponse)

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

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