{-# 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.DescribeStep
-- 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 more detail about the cluster step.
module Amazonka.EMR.DescribeStep
  ( -- * Creating a Request
    DescribeStep (..),
    newDescribeStep,

    -- * Request Lenses
    describeStep_clusterId,
    describeStep_stepId,

    -- * Destructuring the Response
    DescribeStepResponse (..),
    newDescribeStepResponse,

    -- * Response Lenses
    describeStepResponse_step,
    describeStepResponse_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

-- | This input determines which step to describe.
--
-- /See:/ 'newDescribeStep' smart constructor.
data DescribeStep = DescribeStep'
  { -- | The identifier of the cluster with steps to describe.
    DescribeStep -> Text
clusterId :: Prelude.Text,
    -- | The identifier of the step to describe.
    DescribeStep -> Text
stepId :: Prelude.Text
  }
  deriving (DescribeStep -> DescribeStep -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeStep -> DescribeStep -> Bool
$c/= :: DescribeStep -> DescribeStep -> Bool
== :: DescribeStep -> DescribeStep -> Bool
$c== :: DescribeStep -> DescribeStep -> Bool
Prelude.Eq, ReadPrec [DescribeStep]
ReadPrec DescribeStep
Int -> ReadS DescribeStep
ReadS [DescribeStep]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeStep]
$creadListPrec :: ReadPrec [DescribeStep]
readPrec :: ReadPrec DescribeStep
$creadPrec :: ReadPrec DescribeStep
readList :: ReadS [DescribeStep]
$creadList :: ReadS [DescribeStep]
readsPrec :: Int -> ReadS DescribeStep
$creadsPrec :: Int -> ReadS DescribeStep
Prelude.Read, Int -> DescribeStep -> ShowS
[DescribeStep] -> ShowS
DescribeStep -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeStep] -> ShowS
$cshowList :: [DescribeStep] -> ShowS
show :: DescribeStep -> String
$cshow :: DescribeStep -> String
showsPrec :: Int -> DescribeStep -> ShowS
$cshowsPrec :: Int -> DescribeStep -> ShowS
Prelude.Show, forall x. Rep DescribeStep x -> DescribeStep
forall x. DescribeStep -> Rep DescribeStep x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeStep x -> DescribeStep
$cfrom :: forall x. DescribeStep -> Rep DescribeStep x
Prelude.Generic)

-- |
-- Create a value of 'DescribeStep' 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:
--
-- 'clusterId', 'describeStep_clusterId' - The identifier of the cluster with steps to describe.
--
-- 'stepId', 'describeStep_stepId' - The identifier of the step to describe.
newDescribeStep ::
  -- | 'clusterId'
  Prelude.Text ->
  -- | 'stepId'
  Prelude.Text ->
  DescribeStep
newDescribeStep :: Text -> Text -> DescribeStep
newDescribeStep Text
pClusterId_ Text
pStepId_ =
  DescribeStep'
    { $sel:clusterId:DescribeStep' :: Text
clusterId = Text
pClusterId_,
      $sel:stepId:DescribeStep' :: Text
stepId = Text
pStepId_
    }

-- | The identifier of the cluster with steps to describe.
describeStep_clusterId :: Lens.Lens' DescribeStep Prelude.Text
describeStep_clusterId :: Lens' DescribeStep Text
describeStep_clusterId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStep' {Text
clusterId :: Text
$sel:clusterId:DescribeStep' :: DescribeStep -> Text
clusterId} -> Text
clusterId) (\s :: DescribeStep
s@DescribeStep' {} Text
a -> DescribeStep
s {$sel:clusterId:DescribeStep' :: Text
clusterId = Text
a} :: DescribeStep)

-- | The identifier of the step to describe.
describeStep_stepId :: Lens.Lens' DescribeStep Prelude.Text
describeStep_stepId :: Lens' DescribeStep Text
describeStep_stepId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStep' {Text
stepId :: Text
$sel:stepId:DescribeStep' :: DescribeStep -> Text
stepId} -> Text
stepId) (\s :: DescribeStep
s@DescribeStep' {} Text
a -> DescribeStep
s {$sel:stepId:DescribeStep' :: Text
stepId = Text
a} :: DescribeStep)

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

instance Prelude.NFData DescribeStep where
  rnf :: DescribeStep -> ()
rnf DescribeStep' {Text
stepId :: Text
clusterId :: Text
$sel:stepId:DescribeStep' :: DescribeStep -> Text
$sel:clusterId:DescribeStep' :: DescribeStep -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
clusterId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stepId

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

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

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

-- | This output contains the description of the cluster step.
--
-- /See:/ 'newDescribeStepResponse' smart constructor.
data DescribeStepResponse = DescribeStepResponse'
  { -- | The step details for the requested step identifier.
    DescribeStepResponse -> Maybe Step
step :: Prelude.Maybe Step,
    -- | The response's http status code.
    DescribeStepResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeStepResponse -> DescribeStepResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeStepResponse -> DescribeStepResponse -> Bool
$c/= :: DescribeStepResponse -> DescribeStepResponse -> Bool
== :: DescribeStepResponse -> DescribeStepResponse -> Bool
$c== :: DescribeStepResponse -> DescribeStepResponse -> Bool
Prelude.Eq, ReadPrec [DescribeStepResponse]
ReadPrec DescribeStepResponse
Int -> ReadS DescribeStepResponse
ReadS [DescribeStepResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeStepResponse]
$creadListPrec :: ReadPrec [DescribeStepResponse]
readPrec :: ReadPrec DescribeStepResponse
$creadPrec :: ReadPrec DescribeStepResponse
readList :: ReadS [DescribeStepResponse]
$creadList :: ReadS [DescribeStepResponse]
readsPrec :: Int -> ReadS DescribeStepResponse
$creadsPrec :: Int -> ReadS DescribeStepResponse
Prelude.Read, Int -> DescribeStepResponse -> ShowS
[DescribeStepResponse] -> ShowS
DescribeStepResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeStepResponse] -> ShowS
$cshowList :: [DescribeStepResponse] -> ShowS
show :: DescribeStepResponse -> String
$cshow :: DescribeStepResponse -> String
showsPrec :: Int -> DescribeStepResponse -> ShowS
$cshowsPrec :: Int -> DescribeStepResponse -> ShowS
Prelude.Show, forall x. Rep DescribeStepResponse x -> DescribeStepResponse
forall x. DescribeStepResponse -> Rep DescribeStepResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeStepResponse x -> DescribeStepResponse
$cfrom :: forall x. DescribeStepResponse -> Rep DescribeStepResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeStepResponse' 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:
--
-- 'step', 'describeStepResponse_step' - The step details for the requested step identifier.
--
-- 'httpStatus', 'describeStepResponse_httpStatus' - The response's http status code.
newDescribeStepResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeStepResponse
newDescribeStepResponse :: Int -> DescribeStepResponse
newDescribeStepResponse Int
pHttpStatus_ =
  DescribeStepResponse'
    { $sel:step:DescribeStepResponse' :: Maybe Step
step = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeStepResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The step details for the requested step identifier.
describeStepResponse_step :: Lens.Lens' DescribeStepResponse (Prelude.Maybe Step)
describeStepResponse_step :: Lens' DescribeStepResponse (Maybe Step)
describeStepResponse_step = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStepResponse' {Maybe Step
step :: Maybe Step
$sel:step:DescribeStepResponse' :: DescribeStepResponse -> Maybe Step
step} -> Maybe Step
step) (\s :: DescribeStepResponse
s@DescribeStepResponse' {} Maybe Step
a -> DescribeStepResponse
s {$sel:step:DescribeStepResponse' :: Maybe Step
step = Maybe Step
a} :: DescribeStepResponse)

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

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