{-# 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.IoTAnalytics.DescribePipeline
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves information about a pipeline.
module Amazonka.IoTAnalytics.DescribePipeline
  ( -- * Creating a Request
    DescribePipeline (..),
    newDescribePipeline,

    -- * Request Lenses
    describePipeline_pipelineName,

    -- * Destructuring the Response
    DescribePipelineResponse (..),
    newDescribePipelineResponse,

    -- * Response Lenses
    describePipelineResponse_pipeline,
    describePipelineResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDescribePipeline' smart constructor.
data DescribePipeline = DescribePipeline'
  { -- | The name of the pipeline whose information is retrieved.
    DescribePipeline -> Text
pipelineName :: Prelude.Text
  }
  deriving (DescribePipeline -> DescribePipeline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePipeline -> DescribePipeline -> Bool
$c/= :: DescribePipeline -> DescribePipeline -> Bool
== :: DescribePipeline -> DescribePipeline -> Bool
$c== :: DescribePipeline -> DescribePipeline -> Bool
Prelude.Eq, ReadPrec [DescribePipeline]
ReadPrec DescribePipeline
Int -> ReadS DescribePipeline
ReadS [DescribePipeline]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePipeline]
$creadListPrec :: ReadPrec [DescribePipeline]
readPrec :: ReadPrec DescribePipeline
$creadPrec :: ReadPrec DescribePipeline
readList :: ReadS [DescribePipeline]
$creadList :: ReadS [DescribePipeline]
readsPrec :: Int -> ReadS DescribePipeline
$creadsPrec :: Int -> ReadS DescribePipeline
Prelude.Read, Int -> DescribePipeline -> ShowS
[DescribePipeline] -> ShowS
DescribePipeline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePipeline] -> ShowS
$cshowList :: [DescribePipeline] -> ShowS
show :: DescribePipeline -> String
$cshow :: DescribePipeline -> String
showsPrec :: Int -> DescribePipeline -> ShowS
$cshowsPrec :: Int -> DescribePipeline -> ShowS
Prelude.Show, forall x. Rep DescribePipeline x -> DescribePipeline
forall x. DescribePipeline -> Rep DescribePipeline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribePipeline x -> DescribePipeline
$cfrom :: forall x. DescribePipeline -> Rep DescribePipeline x
Prelude.Generic)

-- |
-- Create a value of 'DescribePipeline' 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:
--
-- 'pipelineName', 'describePipeline_pipelineName' - The name of the pipeline whose information is retrieved.
newDescribePipeline ::
  -- | 'pipelineName'
  Prelude.Text ->
  DescribePipeline
newDescribePipeline :: Text -> DescribePipeline
newDescribePipeline Text
pPipelineName_ =
  DescribePipeline' {$sel:pipelineName:DescribePipeline' :: Text
pipelineName = Text
pPipelineName_}

-- | The name of the pipeline whose information is retrieved.
describePipeline_pipelineName :: Lens.Lens' DescribePipeline Prelude.Text
describePipeline_pipelineName :: Lens' DescribePipeline Text
describePipeline_pipelineName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeline' {Text
pipelineName :: Text
$sel:pipelineName:DescribePipeline' :: DescribePipeline -> Text
pipelineName} -> Text
pipelineName) (\s :: DescribePipeline
s@DescribePipeline' {} Text
a -> DescribePipeline
s {$sel:pipelineName:DescribePipeline' :: Text
pipelineName = Text
a} :: DescribePipeline)

instance Core.AWSRequest DescribePipeline where
  type
    AWSResponse DescribePipeline =
      DescribePipelineResponse
  request :: (Service -> Service)
-> DescribePipeline -> Request DescribePipeline
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribePipeline
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribePipeline)))
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 Pipeline -> Int -> DescribePipelineResponse
DescribePipelineResponse'
            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
"pipeline")
            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 DescribePipeline where
  hashWithSalt :: Int -> DescribePipeline -> Int
hashWithSalt Int
_salt DescribePipeline' {Text
pipelineName :: Text
$sel:pipelineName:DescribePipeline' :: DescribePipeline -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pipelineName

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

instance Data.ToHeaders DescribePipeline where
  toHeaders :: DescribePipeline -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath DescribePipeline where
  toPath :: DescribePipeline -> ByteString
toPath DescribePipeline' {Text
pipelineName :: Text
$sel:pipelineName:DescribePipeline' :: DescribePipeline -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/pipelines/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
pipelineName]

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

-- | /See:/ 'newDescribePipelineResponse' smart constructor.
data DescribePipelineResponse = DescribePipelineResponse'
  { -- | A @Pipeline@ object that contains information about the pipeline.
    DescribePipelineResponse -> Maybe Pipeline
pipeline :: Prelude.Maybe Pipeline,
    -- | The response's http status code.
    DescribePipelineResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribePipelineResponse -> DescribePipelineResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePipelineResponse -> DescribePipelineResponse -> Bool
$c/= :: DescribePipelineResponse -> DescribePipelineResponse -> Bool
== :: DescribePipelineResponse -> DescribePipelineResponse -> Bool
$c== :: DescribePipelineResponse -> DescribePipelineResponse -> Bool
Prelude.Eq, ReadPrec [DescribePipelineResponse]
ReadPrec DescribePipelineResponse
Int -> ReadS DescribePipelineResponse
ReadS [DescribePipelineResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePipelineResponse]
$creadListPrec :: ReadPrec [DescribePipelineResponse]
readPrec :: ReadPrec DescribePipelineResponse
$creadPrec :: ReadPrec DescribePipelineResponse
readList :: ReadS [DescribePipelineResponse]
$creadList :: ReadS [DescribePipelineResponse]
readsPrec :: Int -> ReadS DescribePipelineResponse
$creadsPrec :: Int -> ReadS DescribePipelineResponse
Prelude.Read, Int -> DescribePipelineResponse -> ShowS
[DescribePipelineResponse] -> ShowS
DescribePipelineResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePipelineResponse] -> ShowS
$cshowList :: [DescribePipelineResponse] -> ShowS
show :: DescribePipelineResponse -> String
$cshow :: DescribePipelineResponse -> String
showsPrec :: Int -> DescribePipelineResponse -> ShowS
$cshowsPrec :: Int -> DescribePipelineResponse -> ShowS
Prelude.Show, forall x.
Rep DescribePipelineResponse x -> DescribePipelineResponse
forall x.
DescribePipelineResponse -> Rep DescribePipelineResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribePipelineResponse x -> DescribePipelineResponse
$cfrom :: forall x.
DescribePipelineResponse -> Rep DescribePipelineResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribePipelineResponse' 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:
--
-- 'pipeline', 'describePipelineResponse_pipeline' - A @Pipeline@ object that contains information about the pipeline.
--
-- 'httpStatus', 'describePipelineResponse_httpStatus' - The response's http status code.
newDescribePipelineResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribePipelineResponse
newDescribePipelineResponse :: Int -> DescribePipelineResponse
newDescribePipelineResponse Int
pHttpStatus_ =
  DescribePipelineResponse'
    { $sel:pipeline:DescribePipelineResponse' :: Maybe Pipeline
pipeline =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribePipelineResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A @Pipeline@ object that contains information about the pipeline.
describePipelineResponse_pipeline :: Lens.Lens' DescribePipelineResponse (Prelude.Maybe Pipeline)
describePipelineResponse_pipeline :: Lens' DescribePipelineResponse (Maybe Pipeline)
describePipelineResponse_pipeline = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipelineResponse' {Maybe Pipeline
pipeline :: Maybe Pipeline
$sel:pipeline:DescribePipelineResponse' :: DescribePipelineResponse -> Maybe Pipeline
pipeline} -> Maybe Pipeline
pipeline) (\s :: DescribePipelineResponse
s@DescribePipelineResponse' {} Maybe Pipeline
a -> DescribePipelineResponse
s {$sel:pipeline:DescribePipelineResponse' :: Maybe Pipeline
pipeline = Maybe Pipeline
a} :: DescribePipelineResponse)

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

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