{-# 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.DataBrew.StopJobRun
-- 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 particular run of a job.
module Amazonka.DataBrew.StopJobRun
  ( -- * Creating a Request
    StopJobRun (..),
    newStopJobRun,

    -- * Request Lenses
    stopJobRun_name,
    stopJobRun_runId,

    -- * Destructuring the Response
    StopJobRunResponse (..),
    newStopJobRunResponse,

    -- * Response Lenses
    stopJobRunResponse_httpStatus,
    stopJobRunResponse_runId,
  )
where

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

-- | /See:/ 'newStopJobRun' smart constructor.
data StopJobRun = StopJobRun'
  { -- | The name of the job to be stopped.
    StopJobRun -> Text
name :: Prelude.Text,
    -- | The ID of the job run to be stopped.
    StopJobRun -> Text
runId :: Prelude.Text
  }
  deriving (StopJobRun -> StopJobRun -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopJobRun -> StopJobRun -> Bool
$c/= :: StopJobRun -> StopJobRun -> Bool
== :: StopJobRun -> StopJobRun -> Bool
$c== :: StopJobRun -> StopJobRun -> Bool
Prelude.Eq, ReadPrec [StopJobRun]
ReadPrec StopJobRun
Int -> ReadS StopJobRun
ReadS [StopJobRun]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopJobRun]
$creadListPrec :: ReadPrec [StopJobRun]
readPrec :: ReadPrec StopJobRun
$creadPrec :: ReadPrec StopJobRun
readList :: ReadS [StopJobRun]
$creadList :: ReadS [StopJobRun]
readsPrec :: Int -> ReadS StopJobRun
$creadsPrec :: Int -> ReadS StopJobRun
Prelude.Read, Int -> StopJobRun -> ShowS
[StopJobRun] -> ShowS
StopJobRun -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopJobRun] -> ShowS
$cshowList :: [StopJobRun] -> ShowS
show :: StopJobRun -> String
$cshow :: StopJobRun -> String
showsPrec :: Int -> StopJobRun -> ShowS
$cshowsPrec :: Int -> StopJobRun -> ShowS
Prelude.Show, forall x. Rep StopJobRun x -> StopJobRun
forall x. StopJobRun -> Rep StopJobRun x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopJobRun x -> StopJobRun
$cfrom :: forall x. StopJobRun -> Rep StopJobRun x
Prelude.Generic)

-- |
-- Create a value of 'StopJobRun' 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:
--
-- 'name', 'stopJobRun_name' - The name of the job to be stopped.
--
-- 'runId', 'stopJobRun_runId' - The ID of the job run to be stopped.
newStopJobRun ::
  -- | 'name'
  Prelude.Text ->
  -- | 'runId'
  Prelude.Text ->
  StopJobRun
newStopJobRun :: Text -> Text -> StopJobRun
newStopJobRun Text
pName_ Text
pRunId_ =
  StopJobRun' {$sel:name:StopJobRun' :: Text
name = Text
pName_, $sel:runId:StopJobRun' :: Text
runId = Text
pRunId_}

-- | The name of the job to be stopped.
stopJobRun_name :: Lens.Lens' StopJobRun Prelude.Text
stopJobRun_name :: Lens' StopJobRun Text
stopJobRun_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopJobRun' {Text
name :: Text
$sel:name:StopJobRun' :: StopJobRun -> Text
name} -> Text
name) (\s :: StopJobRun
s@StopJobRun' {} Text
a -> StopJobRun
s {$sel:name:StopJobRun' :: Text
name = Text
a} :: StopJobRun)

-- | The ID of the job run to be stopped.
stopJobRun_runId :: Lens.Lens' StopJobRun Prelude.Text
stopJobRun_runId :: Lens' StopJobRun Text
stopJobRun_runId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopJobRun' {Text
runId :: Text
$sel:runId:StopJobRun' :: StopJobRun -> Text
runId} -> Text
runId) (\s :: StopJobRun
s@StopJobRun' {} Text
a -> StopJobRun
s {$sel:runId:StopJobRun' :: Text
runId = Text
a} :: StopJobRun)

instance Core.AWSRequest StopJobRun where
  type AWSResponse StopJobRun = StopJobRunResponse
  request :: (Service -> Service) -> StopJobRun -> Request StopJobRun
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 StopJobRun
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StopJobRun)))
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 ->
          Int -> Text -> StopJobRunResponse
StopJobRunResponse'
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"RunId")
      )

instance Prelude.Hashable StopJobRun where
  hashWithSalt :: Int -> StopJobRun -> Int
hashWithSalt Int
_salt StopJobRun' {Text
runId :: Text
name :: Text
$sel:runId:StopJobRun' :: StopJobRun -> Text
$sel:name:StopJobRun' :: StopJobRun -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
runId

instance Prelude.NFData StopJobRun where
  rnf :: StopJobRun -> ()
rnf StopJobRun' {Text
runId :: Text
name :: Text
$sel:runId:StopJobRun' :: StopJobRun -> Text
$sel:name:StopJobRun' :: StopJobRun -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
name seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
runId

instance Data.ToHeaders StopJobRun where
  toHeaders :: StopJobRun -> 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 StopJobRun where
  toJSON :: StopJobRun -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath StopJobRun where
  toPath :: StopJobRun -> ByteString
toPath StopJobRun' {Text
runId :: Text
name :: Text
$sel:runId:StopJobRun' :: StopJobRun -> Text
$sel:name:StopJobRun' :: StopJobRun -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/jobs/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
name,
        ByteString
"/jobRun/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
runId,
        ByteString
"/stopJobRun"
      ]

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

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

-- |
-- Create a value of 'StopJobRunResponse' 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', 'stopJobRunResponse_httpStatus' - The response's http status code.
--
-- 'runId', 'stopJobRunResponse_runId' - The ID of the job run that you stopped.
newStopJobRunResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'runId'
  Prelude.Text ->
  StopJobRunResponse
newStopJobRunResponse :: Int -> Text -> StopJobRunResponse
newStopJobRunResponse Int
pHttpStatus_ Text
pRunId_ =
  StopJobRunResponse'
    { $sel:httpStatus:StopJobRunResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:runId:StopJobRunResponse' :: Text
runId = Text
pRunId_
    }

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

-- | The ID of the job run that you stopped.
stopJobRunResponse_runId :: Lens.Lens' StopJobRunResponse Prelude.Text
stopJobRunResponse_runId :: Lens' StopJobRunResponse Text
stopJobRunResponse_runId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopJobRunResponse' {Text
runId :: Text
$sel:runId:StopJobRunResponse' :: StopJobRunResponse -> Text
runId} -> Text
runId) (\s :: StopJobRunResponse
s@StopJobRunResponse' {} Text
a -> StopJobRunResponse
s {$sel:runId:StopJobRunResponse' :: Text
runId = Text
a} :: StopJobRunResponse)

instance Prelude.NFData StopJobRunResponse where
  rnf :: StopJobRunResponse -> ()
rnf StopJobRunResponse' {Int
Text
runId :: Text
httpStatus :: Int
$sel:runId:StopJobRunResponse' :: StopJobRunResponse -> Text
$sel:httpStatus:StopJobRunResponse' :: StopJobRunResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
runId