{-# 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.StopDominantLanguageDetectionJob
-- 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 dominant language 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.StopDominantLanguageDetectionJob
  ( -- * Creating a Request
    StopDominantLanguageDetectionJob (..),
    newStopDominantLanguageDetectionJob,

    -- * Request Lenses
    stopDominantLanguageDetectionJob_jobId,

    -- * Destructuring the Response
    StopDominantLanguageDetectionJobResponse (..),
    newStopDominantLanguageDetectionJobResponse,

    -- * Response Lenses
    stopDominantLanguageDetectionJobResponse_jobId,
    stopDominantLanguageDetectionJobResponse_jobStatus,
    stopDominantLanguageDetectionJobResponse_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:/ 'newStopDominantLanguageDetectionJob' smart constructor.
data StopDominantLanguageDetectionJob = StopDominantLanguageDetectionJob'
  { -- | The identifier of the dominant language detection job to stop.
    StopDominantLanguageDetectionJob -> Text
jobId :: Prelude.Text
  }
  deriving (StopDominantLanguageDetectionJob
-> StopDominantLanguageDetectionJob -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopDominantLanguageDetectionJob
-> StopDominantLanguageDetectionJob -> Bool
$c/= :: StopDominantLanguageDetectionJob
-> StopDominantLanguageDetectionJob -> Bool
== :: StopDominantLanguageDetectionJob
-> StopDominantLanguageDetectionJob -> Bool
$c== :: StopDominantLanguageDetectionJob
-> StopDominantLanguageDetectionJob -> Bool
Prelude.Eq, ReadPrec [StopDominantLanguageDetectionJob]
ReadPrec StopDominantLanguageDetectionJob
Int -> ReadS StopDominantLanguageDetectionJob
ReadS [StopDominantLanguageDetectionJob]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopDominantLanguageDetectionJob]
$creadListPrec :: ReadPrec [StopDominantLanguageDetectionJob]
readPrec :: ReadPrec StopDominantLanguageDetectionJob
$creadPrec :: ReadPrec StopDominantLanguageDetectionJob
readList :: ReadS [StopDominantLanguageDetectionJob]
$creadList :: ReadS [StopDominantLanguageDetectionJob]
readsPrec :: Int -> ReadS StopDominantLanguageDetectionJob
$creadsPrec :: Int -> ReadS StopDominantLanguageDetectionJob
Prelude.Read, Int -> StopDominantLanguageDetectionJob -> ShowS
[StopDominantLanguageDetectionJob] -> ShowS
StopDominantLanguageDetectionJob -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopDominantLanguageDetectionJob] -> ShowS
$cshowList :: [StopDominantLanguageDetectionJob] -> ShowS
show :: StopDominantLanguageDetectionJob -> String
$cshow :: StopDominantLanguageDetectionJob -> String
showsPrec :: Int -> StopDominantLanguageDetectionJob -> ShowS
$cshowsPrec :: Int -> StopDominantLanguageDetectionJob -> ShowS
Prelude.Show, forall x.
Rep StopDominantLanguageDetectionJob x
-> StopDominantLanguageDetectionJob
forall x.
StopDominantLanguageDetectionJob
-> Rep StopDominantLanguageDetectionJob x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StopDominantLanguageDetectionJob x
-> StopDominantLanguageDetectionJob
$cfrom :: forall x.
StopDominantLanguageDetectionJob
-> Rep StopDominantLanguageDetectionJob x
Prelude.Generic)

-- |
-- Create a value of 'StopDominantLanguageDetectionJob' 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', 'stopDominantLanguageDetectionJob_jobId' - The identifier of the dominant language detection job to stop.
newStopDominantLanguageDetectionJob ::
  -- | 'jobId'
  Prelude.Text ->
  StopDominantLanguageDetectionJob
newStopDominantLanguageDetectionJob :: Text -> StopDominantLanguageDetectionJob
newStopDominantLanguageDetectionJob Text
pJobId_ =
  StopDominantLanguageDetectionJob' {$sel:jobId:StopDominantLanguageDetectionJob' :: Text
jobId = Text
pJobId_}

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

instance
  Core.AWSRequest
    StopDominantLanguageDetectionJob
  where
  type
    AWSResponse StopDominantLanguageDetectionJob =
      StopDominantLanguageDetectionJobResponse
  request :: (Service -> Service)
-> StopDominantLanguageDetectionJob
-> Request StopDominantLanguageDetectionJob
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 StopDominantLanguageDetectionJob
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse StopDominantLanguageDetectionJob)))
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
-> StopDominantLanguageDetectionJobResponse
StopDominantLanguageDetectionJobResponse'
            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
    StopDominantLanguageDetectionJob
  where
  hashWithSalt :: Int -> StopDominantLanguageDetectionJob -> Int
hashWithSalt
    Int
_salt
    StopDominantLanguageDetectionJob' {Text
jobId :: Text
$sel:jobId:StopDominantLanguageDetectionJob' :: StopDominantLanguageDetectionJob -> Text
..} =
      Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
jobId

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

instance
  Data.ToHeaders
    StopDominantLanguageDetectionJob
  where
  toHeaders :: StopDominantLanguageDetectionJob -> 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.StopDominantLanguageDetectionJob" ::
                          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 StopDominantLanguageDetectionJob where
  toJSON :: StopDominantLanguageDetectionJob -> Value
toJSON StopDominantLanguageDetectionJob' {Text
jobId :: Text
$sel:jobId:StopDominantLanguageDetectionJob' :: StopDominantLanguageDetectionJob -> 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 StopDominantLanguageDetectionJob where
  toPath :: StopDominantLanguageDetectionJob -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newStopDominantLanguageDetectionJobResponse' smart constructor.
data StopDominantLanguageDetectionJobResponse = StopDominantLanguageDetectionJobResponse'
  { -- | The identifier of the dominant language detection job to stop.
    StopDominantLanguageDetectionJobResponse -> 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
    -- @StopDominantLanguageDetectionJob@ operation.
    StopDominantLanguageDetectionJobResponse -> Maybe JobStatus
jobStatus :: Prelude.Maybe JobStatus,
    -- | The response's http status code.
    StopDominantLanguageDetectionJobResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (StopDominantLanguageDetectionJobResponse
-> StopDominantLanguageDetectionJobResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopDominantLanguageDetectionJobResponse
-> StopDominantLanguageDetectionJobResponse -> Bool
$c/= :: StopDominantLanguageDetectionJobResponse
-> StopDominantLanguageDetectionJobResponse -> Bool
== :: StopDominantLanguageDetectionJobResponse
-> StopDominantLanguageDetectionJobResponse -> Bool
$c== :: StopDominantLanguageDetectionJobResponse
-> StopDominantLanguageDetectionJobResponse -> Bool
Prelude.Eq, ReadPrec [StopDominantLanguageDetectionJobResponse]
ReadPrec StopDominantLanguageDetectionJobResponse
Int -> ReadS StopDominantLanguageDetectionJobResponse
ReadS [StopDominantLanguageDetectionJobResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopDominantLanguageDetectionJobResponse]
$creadListPrec :: ReadPrec [StopDominantLanguageDetectionJobResponse]
readPrec :: ReadPrec StopDominantLanguageDetectionJobResponse
$creadPrec :: ReadPrec StopDominantLanguageDetectionJobResponse
readList :: ReadS [StopDominantLanguageDetectionJobResponse]
$creadList :: ReadS [StopDominantLanguageDetectionJobResponse]
readsPrec :: Int -> ReadS StopDominantLanguageDetectionJobResponse
$creadsPrec :: Int -> ReadS StopDominantLanguageDetectionJobResponse
Prelude.Read, Int -> StopDominantLanguageDetectionJobResponse -> ShowS
[StopDominantLanguageDetectionJobResponse] -> ShowS
StopDominantLanguageDetectionJobResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopDominantLanguageDetectionJobResponse] -> ShowS
$cshowList :: [StopDominantLanguageDetectionJobResponse] -> ShowS
show :: StopDominantLanguageDetectionJobResponse -> String
$cshow :: StopDominantLanguageDetectionJobResponse -> String
showsPrec :: Int -> StopDominantLanguageDetectionJobResponse -> ShowS
$cshowsPrec :: Int -> StopDominantLanguageDetectionJobResponse -> ShowS
Prelude.Show, forall x.
Rep StopDominantLanguageDetectionJobResponse x
-> StopDominantLanguageDetectionJobResponse
forall x.
StopDominantLanguageDetectionJobResponse
-> Rep StopDominantLanguageDetectionJobResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep StopDominantLanguageDetectionJobResponse x
-> StopDominantLanguageDetectionJobResponse
$cfrom :: forall x.
StopDominantLanguageDetectionJobResponse
-> Rep StopDominantLanguageDetectionJobResponse x
Prelude.Generic)

-- |
-- Create a value of 'StopDominantLanguageDetectionJobResponse' 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', 'stopDominantLanguageDetectionJobResponse_jobId' - The identifier of the dominant language detection job to stop.
--
-- 'jobStatus', 'stopDominantLanguageDetectionJobResponse_jobStatus' - Either @STOP_REQUESTED@ if the job is currently running, or @STOPPED@ if
-- the job was previously stopped with the
-- @StopDominantLanguageDetectionJob@ operation.
--
-- 'httpStatus', 'stopDominantLanguageDetectionJobResponse_httpStatus' - The response's http status code.
newStopDominantLanguageDetectionJobResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  StopDominantLanguageDetectionJobResponse
newStopDominantLanguageDetectionJobResponse :: Int -> StopDominantLanguageDetectionJobResponse
newStopDominantLanguageDetectionJobResponse
  Int
pHttpStatus_ =
    StopDominantLanguageDetectionJobResponse'
      { $sel:jobId:StopDominantLanguageDetectionJobResponse' :: Maybe Text
jobId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:jobStatus:StopDominantLanguageDetectionJobResponse' :: Maybe JobStatus
jobStatus = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:StopDominantLanguageDetectionJobResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

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

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

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

instance
  Prelude.NFData
    StopDominantLanguageDetectionJobResponse
  where
  rnf :: StopDominantLanguageDetectionJobResponse -> ()
rnf StopDominantLanguageDetectionJobResponse' {Int
Maybe Text
Maybe JobStatus
httpStatus :: Int
jobStatus :: Maybe JobStatus
jobId :: Maybe Text
$sel:httpStatus:StopDominantLanguageDetectionJobResponse' :: StopDominantLanguageDetectionJobResponse -> Int
$sel:jobStatus:StopDominantLanguageDetectionJobResponse' :: StopDominantLanguageDetectionJobResponse -> Maybe JobStatus
$sel:jobId:StopDominantLanguageDetectionJobResponse' :: StopDominantLanguageDetectionJobResponse -> 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