{-# 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.DescribeNotebookExecution
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides details of a notebook execution.
module Amazonka.EMR.DescribeNotebookExecution
  ( -- * Creating a Request
    DescribeNotebookExecution (..),
    newDescribeNotebookExecution,

    -- * Request Lenses
    describeNotebookExecution_notebookExecutionId,

    -- * Destructuring the Response
    DescribeNotebookExecutionResponse (..),
    newDescribeNotebookExecutionResponse,

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

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

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

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

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

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

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

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

-- |
-- Create a value of 'DescribeNotebookExecutionResponse' 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:
--
-- 'notebookExecution', 'describeNotebookExecutionResponse_notebookExecution' - Properties of the notebook execution.
--
-- 'httpStatus', 'describeNotebookExecutionResponse_httpStatus' - The response's http status code.
newDescribeNotebookExecutionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeNotebookExecutionResponse
newDescribeNotebookExecutionResponse :: Int -> DescribeNotebookExecutionResponse
newDescribeNotebookExecutionResponse Int
pHttpStatus_ =
  DescribeNotebookExecutionResponse'
    { $sel:notebookExecution:DescribeNotebookExecutionResponse' :: Maybe NotebookExecution
notebookExecution =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeNotebookExecutionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Properties of the notebook execution.
describeNotebookExecutionResponse_notebookExecution :: Lens.Lens' DescribeNotebookExecutionResponse (Prelude.Maybe NotebookExecution)
describeNotebookExecutionResponse_notebookExecution :: Lens' DescribeNotebookExecutionResponse (Maybe NotebookExecution)
describeNotebookExecutionResponse_notebookExecution = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeNotebookExecutionResponse' {Maybe NotebookExecution
notebookExecution :: Maybe NotebookExecution
$sel:notebookExecution:DescribeNotebookExecutionResponse' :: DescribeNotebookExecutionResponse -> Maybe NotebookExecution
notebookExecution} -> Maybe NotebookExecution
notebookExecution) (\s :: DescribeNotebookExecutionResponse
s@DescribeNotebookExecutionResponse' {} Maybe NotebookExecution
a -> DescribeNotebookExecutionResponse
s {$sel:notebookExecution:DescribeNotebookExecutionResponse' :: Maybe NotebookExecution
notebookExecution = Maybe NotebookExecution
a} :: DescribeNotebookExecutionResponse)

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

instance
  Prelude.NFData
    DescribeNotebookExecutionResponse
  where
  rnf :: DescribeNotebookExecutionResponse -> ()
rnf DescribeNotebookExecutionResponse' {Int
Maybe NotebookExecution
httpStatus :: Int
notebookExecution :: Maybe NotebookExecution
$sel:httpStatus:DescribeNotebookExecutionResponse' :: DescribeNotebookExecutionResponse -> Int
$sel:notebookExecution:DescribeNotebookExecutionResponse' :: DescribeNotebookExecutionResponse -> Maybe NotebookExecution
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe NotebookExecution
notebookExecution
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus