{-# 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.EMR.StopNotebookExecution
-- 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 notebook execution.
module Amazonka.EMR.StopNotebookExecution
  ( -- * Creating a Request
    StopNotebookExecution (..),
    newStopNotebookExecution,

    -- * Request Lenses
    stopNotebookExecution_notebookExecutionId,

    -- * Destructuring the Response
    StopNotebookExecutionResponse (..),
    newStopNotebookExecutionResponse,
  )
where

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

-- | /See:/ 'newStopNotebookExecution' smart constructor.
data StopNotebookExecution = StopNotebookExecution'
  { -- | The unique identifier of the notebook execution.
    StopNotebookExecution -> Text
notebookExecutionId :: Prelude.Text
  }
  deriving (StopNotebookExecution -> StopNotebookExecution -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StopNotebookExecution -> StopNotebookExecution -> Bool
$c/= :: StopNotebookExecution -> StopNotebookExecution -> Bool
== :: StopNotebookExecution -> StopNotebookExecution -> Bool
$c== :: StopNotebookExecution -> StopNotebookExecution -> Bool
Prelude.Eq, ReadPrec [StopNotebookExecution]
ReadPrec StopNotebookExecution
Int -> ReadS StopNotebookExecution
ReadS [StopNotebookExecution]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StopNotebookExecution]
$creadListPrec :: ReadPrec [StopNotebookExecution]
readPrec :: ReadPrec StopNotebookExecution
$creadPrec :: ReadPrec StopNotebookExecution
readList :: ReadS [StopNotebookExecution]
$creadList :: ReadS [StopNotebookExecution]
readsPrec :: Int -> ReadS StopNotebookExecution
$creadsPrec :: Int -> ReadS StopNotebookExecution
Prelude.Read, Int -> StopNotebookExecution -> ShowS
[StopNotebookExecution] -> ShowS
StopNotebookExecution -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StopNotebookExecution] -> ShowS
$cshowList :: [StopNotebookExecution] -> ShowS
show :: StopNotebookExecution -> String
$cshow :: StopNotebookExecution -> String
showsPrec :: Int -> StopNotebookExecution -> ShowS
$cshowsPrec :: Int -> StopNotebookExecution -> ShowS
Prelude.Show, forall x. Rep StopNotebookExecution x -> StopNotebookExecution
forall x. StopNotebookExecution -> Rep StopNotebookExecution x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StopNotebookExecution x -> StopNotebookExecution
$cfrom :: forall x. StopNotebookExecution -> Rep StopNotebookExecution x
Prelude.Generic)

-- |
-- Create a value of 'StopNotebookExecution' 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:
--
-- 'notebookExecutionId', 'stopNotebookExecution_notebookExecutionId' - The unique identifier of the notebook execution.
newStopNotebookExecution ::
  -- | 'notebookExecutionId'
  Prelude.Text ->
  StopNotebookExecution
newStopNotebookExecution :: Text -> StopNotebookExecution
newStopNotebookExecution Text
pNotebookExecutionId_ =
  StopNotebookExecution'
    { $sel:notebookExecutionId:StopNotebookExecution' :: Text
notebookExecutionId =
        Text
pNotebookExecutionId_
    }

-- | The unique identifier of the notebook execution.
stopNotebookExecution_notebookExecutionId :: Lens.Lens' StopNotebookExecution Prelude.Text
stopNotebookExecution_notebookExecutionId :: Lens' StopNotebookExecution Text
stopNotebookExecution_notebookExecutionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StopNotebookExecution' {Text
notebookExecutionId :: Text
$sel:notebookExecutionId:StopNotebookExecution' :: StopNotebookExecution -> Text
notebookExecutionId} -> Text
notebookExecutionId) (\s :: StopNotebookExecution
s@StopNotebookExecution' {} Text
a -> StopNotebookExecution
s {$sel:notebookExecutionId:StopNotebookExecution' :: Text
notebookExecutionId = Text
a} :: StopNotebookExecution)

instance Core.AWSRequest StopNotebookExecution where
  type
    AWSResponse StopNotebookExecution =
      StopNotebookExecutionResponse
  request :: (Service -> Service)
-> StopNotebookExecution -> Request StopNotebookExecution
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 StopNotebookExecution
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse StopNotebookExecution)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull StopNotebookExecutionResponse
StopNotebookExecutionResponse'

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

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

instance Data.ToHeaders StopNotebookExecution where
  toHeaders :: StopNotebookExecution -> [Header]
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 -> [Header]
Data.=# ( ByteString
"ElasticMapReduce.StopNotebookExecution" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON StopNotebookExecution where
  toJSON :: StopNotebookExecution -> Value
toJSON StopNotebookExecution' {Text
notebookExecutionId :: Text
$sel:notebookExecutionId:StopNotebookExecution' :: StopNotebookExecution -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"NotebookExecutionId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
notebookExecutionId)
          ]
      )

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

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

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

-- |
-- Create a value of 'StopNotebookExecutionResponse' 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.
newStopNotebookExecutionResponse ::
  StopNotebookExecutionResponse
newStopNotebookExecutionResponse :: StopNotebookExecutionResponse
newStopNotebookExecutionResponse =
  StopNotebookExecutionResponse
StopNotebookExecutionResponse'

instance Prelude.NFData StopNotebookExecutionResponse where
  rnf :: StopNotebookExecutionResponse -> ()
rnf StopNotebookExecutionResponse
_ = ()