{-# 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.Pipes.DescribePipe
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get the information about an existing pipe. For more information about
-- pipes, see
-- <https://docs.aws.amazon.com/eventbridge/latest/userguide/eb-pipes.html Amazon EventBridge Pipes>
-- in the Amazon EventBridge User Guide.
module Amazonka.Pipes.DescribePipe
  ( -- * Creating a Request
    DescribePipe (..),
    newDescribePipe,

    -- * Request Lenses
    describePipe_name,

    -- * Destructuring the Response
    DescribePipeResponse (..),
    newDescribePipeResponse,

    -- * Response Lenses
    describePipeResponse_arn,
    describePipeResponse_creationTime,
    describePipeResponse_currentState,
    describePipeResponse_description,
    describePipeResponse_desiredState,
    describePipeResponse_enrichment,
    describePipeResponse_enrichmentParameters,
    describePipeResponse_lastModifiedTime,
    describePipeResponse_name,
    describePipeResponse_roleArn,
    describePipeResponse_source,
    describePipeResponse_sourceParameters,
    describePipeResponse_stateReason,
    describePipeResponse_tags,
    describePipeResponse_target,
    describePipeResponse_targetParameters,
    describePipeResponse_httpStatus,
  )
where

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

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

-- |
-- Create a value of 'DescribePipe' 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', 'describePipe_name' - The name of the pipe.
newDescribePipe ::
  -- | 'name'
  Prelude.Text ->
  DescribePipe
newDescribePipe :: Text -> DescribePipe
newDescribePipe Text
pName_ = DescribePipe' {$sel:name:DescribePipe' :: Text
name = Text
pName_}

-- | The name of the pipe.
describePipe_name :: Lens.Lens' DescribePipe Prelude.Text
describePipe_name :: Lens' DescribePipe Text
describePipe_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipe' {Text
name :: Text
$sel:name:DescribePipe' :: DescribePipe -> Text
name} -> Text
name) (\s :: DescribePipe
s@DescribePipe' {} Text
a -> DescribePipe
s {$sel:name:DescribePipe' :: Text
name = Text
a} :: DescribePipe)

instance Core.AWSRequest DescribePipe where
  type AWSResponse DescribePipe = DescribePipeResponse
  request :: (Service -> Service) -> DescribePipe -> Request DescribePipe
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 DescribePipe
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribePipe)))
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 Text
-> Maybe POSIX
-> Maybe PipeState
-> Maybe (Sensitive Text)
-> Maybe RequestedPipeStateDescribeResponse
-> Maybe Text
-> Maybe PipeEnrichmentParameters
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe PipeSourceParameters
-> Maybe Text
-> Maybe (HashMap Text (Sensitive Text))
-> Maybe Text
-> Maybe PipeTargetParameters
-> Int
-> DescribePipeResponse
DescribePipeResponse'
            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
"Arn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CreationTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"CurrentState")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DesiredState")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Enrichment")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"EnrichmentParameters")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"LastModifiedTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"RoleArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Source")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SourceParameters")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StateReason")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Target")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TargetParameters")
            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 DescribePipe where
  hashWithSalt :: Int -> DescribePipe -> Int
hashWithSalt Int
_salt DescribePipe' {Text
name :: Text
$sel:name:DescribePipe' :: DescribePipe -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

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

instance Data.ToHeaders DescribePipe where
  toHeaders :: DescribePipe -> 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.ToPath DescribePipe where
  toPath :: DescribePipe -> ByteString
toPath DescribePipe' {Text
name :: Text
$sel:name:DescribePipe' :: DescribePipe -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/v1/pipes/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
name]

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

-- | /See:/ 'newDescribePipeResponse' smart constructor.
data DescribePipeResponse = DescribePipeResponse'
  { -- | The ARN of the pipe.
    DescribePipeResponse -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The time the pipe was created.
    DescribePipeResponse -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The state the pipe is in.
    DescribePipeResponse -> Maybe PipeState
currentState :: Prelude.Maybe PipeState,
    -- | A description of the pipe.
    DescribePipeResponse -> Maybe (Sensitive Text)
description :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The state the pipe should be in.
    DescribePipeResponse -> Maybe RequestedPipeStateDescribeResponse
desiredState :: Prelude.Maybe RequestedPipeStateDescribeResponse,
    -- | The ARN of the enrichment resource.
    DescribePipeResponse -> Maybe Text
enrichment :: Prelude.Maybe Prelude.Text,
    -- | The parameters required to set up enrichment on your pipe.
    DescribePipeResponse -> Maybe PipeEnrichmentParameters
enrichmentParameters :: Prelude.Maybe PipeEnrichmentParameters,
    -- | When the pipe was last updated, in
    -- <https://www.w3.org/TR/NOTE-datetime ISO-8601 format>
    -- (YYYY-MM-DDThh:mm:ss.sTZD).
    DescribePipeResponse -> Maybe POSIX
lastModifiedTime :: Prelude.Maybe Data.POSIX,
    -- | The name of the pipe.
    DescribePipeResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the role that allows the pipe to send data to the target.
    DescribePipeResponse -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the source resource.
    DescribePipeResponse -> Maybe Text
source :: Prelude.Maybe Prelude.Text,
    -- | The parameters required to set up a source for your pipe.
    DescribePipeResponse -> Maybe PipeSourceParameters
sourceParameters :: Prelude.Maybe PipeSourceParameters,
    -- | The reason the pipe is in its current state.
    DescribePipeResponse -> Maybe Text
stateReason :: Prelude.Maybe Prelude.Text,
    -- | The list of key-value pairs to associate with the pipe.
    DescribePipeResponse -> Maybe (HashMap Text (Sensitive Text))
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text (Data.Sensitive Prelude.Text)),
    -- | The ARN of the target resource.
    DescribePipeResponse -> Maybe Text
target :: Prelude.Maybe Prelude.Text,
    -- | The parameters required to set up a target for your pipe.
    DescribePipeResponse -> Maybe PipeTargetParameters
targetParameters :: Prelude.Maybe PipeTargetParameters,
    -- | The response's http status code.
    DescribePipeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribePipeResponse -> DescribePipeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePipeResponse -> DescribePipeResponse -> Bool
$c/= :: DescribePipeResponse -> DescribePipeResponse -> Bool
== :: DescribePipeResponse -> DescribePipeResponse -> Bool
$c== :: DescribePipeResponse -> DescribePipeResponse -> Bool
Prelude.Eq, Int -> DescribePipeResponse -> ShowS
[DescribePipeResponse] -> ShowS
DescribePipeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePipeResponse] -> ShowS
$cshowList :: [DescribePipeResponse] -> ShowS
show :: DescribePipeResponse -> String
$cshow :: DescribePipeResponse -> String
showsPrec :: Int -> DescribePipeResponse -> ShowS
$cshowsPrec :: Int -> DescribePipeResponse -> ShowS
Prelude.Show, forall x. Rep DescribePipeResponse x -> DescribePipeResponse
forall x. DescribePipeResponse -> Rep DescribePipeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribePipeResponse x -> DescribePipeResponse
$cfrom :: forall x. DescribePipeResponse -> Rep DescribePipeResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribePipeResponse' 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:
--
-- 'arn', 'describePipeResponse_arn' - The ARN of the pipe.
--
-- 'creationTime', 'describePipeResponse_creationTime' - The time the pipe was created.
--
-- 'currentState', 'describePipeResponse_currentState' - The state the pipe is in.
--
-- 'description', 'describePipeResponse_description' - A description of the pipe.
--
-- 'desiredState', 'describePipeResponse_desiredState' - The state the pipe should be in.
--
-- 'enrichment', 'describePipeResponse_enrichment' - The ARN of the enrichment resource.
--
-- 'enrichmentParameters', 'describePipeResponse_enrichmentParameters' - The parameters required to set up enrichment on your pipe.
--
-- 'lastModifiedTime', 'describePipeResponse_lastModifiedTime' - When the pipe was last updated, in
-- <https://www.w3.org/TR/NOTE-datetime ISO-8601 format>
-- (YYYY-MM-DDThh:mm:ss.sTZD).
--
-- 'name', 'describePipeResponse_name' - The name of the pipe.
--
-- 'roleArn', 'describePipeResponse_roleArn' - The ARN of the role that allows the pipe to send data to the target.
--
-- 'source', 'describePipeResponse_source' - The ARN of the source resource.
--
-- 'sourceParameters', 'describePipeResponse_sourceParameters' - The parameters required to set up a source for your pipe.
--
-- 'stateReason', 'describePipeResponse_stateReason' - The reason the pipe is in its current state.
--
-- 'tags', 'describePipeResponse_tags' - The list of key-value pairs to associate with the pipe.
--
-- 'target', 'describePipeResponse_target' - The ARN of the target resource.
--
-- 'targetParameters', 'describePipeResponse_targetParameters' - The parameters required to set up a target for your pipe.
--
-- 'httpStatus', 'describePipeResponse_httpStatus' - The response's http status code.
newDescribePipeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribePipeResponse
newDescribePipeResponse :: Int -> DescribePipeResponse
newDescribePipeResponse Int
pHttpStatus_ =
  DescribePipeResponse'
    { $sel:arn:DescribePipeResponse' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:DescribePipeResponse' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:currentState:DescribePipeResponse' :: Maybe PipeState
currentState = forall a. Maybe a
Prelude.Nothing,
      $sel:description:DescribePipeResponse' :: Maybe (Sensitive Text)
description = forall a. Maybe a
Prelude.Nothing,
      $sel:desiredState:DescribePipeResponse' :: Maybe RequestedPipeStateDescribeResponse
desiredState = forall a. Maybe a
Prelude.Nothing,
      $sel:enrichment:DescribePipeResponse' :: Maybe Text
enrichment = forall a. Maybe a
Prelude.Nothing,
      $sel:enrichmentParameters:DescribePipeResponse' :: Maybe PipeEnrichmentParameters
enrichmentParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:lastModifiedTime:DescribePipeResponse' :: Maybe POSIX
lastModifiedTime = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DescribePipeResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:DescribePipeResponse' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:source:DescribePipeResponse' :: Maybe Text
source = forall a. Maybe a
Prelude.Nothing,
      $sel:sourceParameters:DescribePipeResponse' :: Maybe PipeSourceParameters
sourceParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:stateReason:DescribePipeResponse' :: Maybe Text
stateReason = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:DescribePipeResponse' :: Maybe (HashMap Text (Sensitive Text))
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:target:DescribePipeResponse' :: Maybe Text
target = forall a. Maybe a
Prelude.Nothing,
      $sel:targetParameters:DescribePipeResponse' :: Maybe PipeTargetParameters
targetParameters = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribePipeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the pipe.
describePipeResponse_arn :: Lens.Lens' DescribePipeResponse (Prelude.Maybe Prelude.Text)
describePipeResponse_arn :: Lens' DescribePipeResponse (Maybe Text)
describePipeResponse_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe Text
arn :: Maybe Text
$sel:arn:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
arn} -> Maybe Text
arn) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe Text
a -> DescribePipeResponse
s {$sel:arn:DescribePipeResponse' :: Maybe Text
arn = Maybe Text
a} :: DescribePipeResponse)

-- | The time the pipe was created.
describePipeResponse_creationTime :: Lens.Lens' DescribePipeResponse (Prelude.Maybe Prelude.UTCTime)
describePipeResponse_creationTime :: Lens' DescribePipeResponse (Maybe UTCTime)
describePipeResponse_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:DescribePipeResponse' :: DescribePipeResponse -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe POSIX
a -> DescribePipeResponse
s {$sel:creationTime:DescribePipeResponse' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: DescribePipeResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The state the pipe is in.
describePipeResponse_currentState :: Lens.Lens' DescribePipeResponse (Prelude.Maybe PipeState)
describePipeResponse_currentState :: Lens' DescribePipeResponse (Maybe PipeState)
describePipeResponse_currentState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe PipeState
currentState :: Maybe PipeState
$sel:currentState:DescribePipeResponse' :: DescribePipeResponse -> Maybe PipeState
currentState} -> Maybe PipeState
currentState) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe PipeState
a -> DescribePipeResponse
s {$sel:currentState:DescribePipeResponse' :: Maybe PipeState
currentState = Maybe PipeState
a} :: DescribePipeResponse)

-- | A description of the pipe.
describePipeResponse_description :: Lens.Lens' DescribePipeResponse (Prelude.Maybe Prelude.Text)
describePipeResponse_description :: Lens' DescribePipeResponse (Maybe Text)
describePipeResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe (Sensitive Text)
description :: Maybe (Sensitive Text)
$sel:description:DescribePipeResponse' :: DescribePipeResponse -> Maybe (Sensitive Text)
description} -> Maybe (Sensitive Text)
description) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe (Sensitive Text)
a -> DescribePipeResponse
s {$sel:description:DescribePipeResponse' :: Maybe (Sensitive Text)
description = Maybe (Sensitive Text)
a} :: DescribePipeResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The state the pipe should be in.
describePipeResponse_desiredState :: Lens.Lens' DescribePipeResponse (Prelude.Maybe RequestedPipeStateDescribeResponse)
describePipeResponse_desiredState :: Lens'
  DescribePipeResponse (Maybe RequestedPipeStateDescribeResponse)
describePipeResponse_desiredState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe RequestedPipeStateDescribeResponse
desiredState :: Maybe RequestedPipeStateDescribeResponse
$sel:desiredState:DescribePipeResponse' :: DescribePipeResponse -> Maybe RequestedPipeStateDescribeResponse
desiredState} -> Maybe RequestedPipeStateDescribeResponse
desiredState) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe RequestedPipeStateDescribeResponse
a -> DescribePipeResponse
s {$sel:desiredState:DescribePipeResponse' :: Maybe RequestedPipeStateDescribeResponse
desiredState = Maybe RequestedPipeStateDescribeResponse
a} :: DescribePipeResponse)

-- | The ARN of the enrichment resource.
describePipeResponse_enrichment :: Lens.Lens' DescribePipeResponse (Prelude.Maybe Prelude.Text)
describePipeResponse_enrichment :: Lens' DescribePipeResponse (Maybe Text)
describePipeResponse_enrichment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe Text
enrichment :: Maybe Text
$sel:enrichment:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
enrichment} -> Maybe Text
enrichment) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe Text
a -> DescribePipeResponse
s {$sel:enrichment:DescribePipeResponse' :: Maybe Text
enrichment = Maybe Text
a} :: DescribePipeResponse)

-- | The parameters required to set up enrichment on your pipe.
describePipeResponse_enrichmentParameters :: Lens.Lens' DescribePipeResponse (Prelude.Maybe PipeEnrichmentParameters)
describePipeResponse_enrichmentParameters :: Lens' DescribePipeResponse (Maybe PipeEnrichmentParameters)
describePipeResponse_enrichmentParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe PipeEnrichmentParameters
enrichmentParameters :: Maybe PipeEnrichmentParameters
$sel:enrichmentParameters:DescribePipeResponse' :: DescribePipeResponse -> Maybe PipeEnrichmentParameters
enrichmentParameters} -> Maybe PipeEnrichmentParameters
enrichmentParameters) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe PipeEnrichmentParameters
a -> DescribePipeResponse
s {$sel:enrichmentParameters:DescribePipeResponse' :: Maybe PipeEnrichmentParameters
enrichmentParameters = Maybe PipeEnrichmentParameters
a} :: DescribePipeResponse)

-- | When the pipe was last updated, in
-- <https://www.w3.org/TR/NOTE-datetime ISO-8601 format>
-- (YYYY-MM-DDThh:mm:ss.sTZD).
describePipeResponse_lastModifiedTime :: Lens.Lens' DescribePipeResponse (Prelude.Maybe Prelude.UTCTime)
describePipeResponse_lastModifiedTime :: Lens' DescribePipeResponse (Maybe UTCTime)
describePipeResponse_lastModifiedTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe POSIX
lastModifiedTime :: Maybe POSIX
$sel:lastModifiedTime:DescribePipeResponse' :: DescribePipeResponse -> Maybe POSIX
lastModifiedTime} -> Maybe POSIX
lastModifiedTime) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe POSIX
a -> DescribePipeResponse
s {$sel:lastModifiedTime:DescribePipeResponse' :: Maybe POSIX
lastModifiedTime = Maybe POSIX
a} :: DescribePipeResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The name of the pipe.
describePipeResponse_name :: Lens.Lens' DescribePipeResponse (Prelude.Maybe Prelude.Text)
describePipeResponse_name :: Lens' DescribePipeResponse (Maybe Text)
describePipeResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe Text
name :: Maybe Text
$sel:name:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe Text
a -> DescribePipeResponse
s {$sel:name:DescribePipeResponse' :: Maybe Text
name = Maybe Text
a} :: DescribePipeResponse)

-- | The ARN of the role that allows the pipe to send data to the target.
describePipeResponse_roleArn :: Lens.Lens' DescribePipeResponse (Prelude.Maybe Prelude.Text)
describePipeResponse_roleArn :: Lens' DescribePipeResponse (Maybe Text)
describePipeResponse_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe Text
a -> DescribePipeResponse
s {$sel:roleArn:DescribePipeResponse' :: Maybe Text
roleArn = Maybe Text
a} :: DescribePipeResponse)

-- | The ARN of the source resource.
describePipeResponse_source :: Lens.Lens' DescribePipeResponse (Prelude.Maybe Prelude.Text)
describePipeResponse_source :: Lens' DescribePipeResponse (Maybe Text)
describePipeResponse_source = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe Text
source :: Maybe Text
$sel:source:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
source} -> Maybe Text
source) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe Text
a -> DescribePipeResponse
s {$sel:source:DescribePipeResponse' :: Maybe Text
source = Maybe Text
a} :: DescribePipeResponse)

-- | The parameters required to set up a source for your pipe.
describePipeResponse_sourceParameters :: Lens.Lens' DescribePipeResponse (Prelude.Maybe PipeSourceParameters)
describePipeResponse_sourceParameters :: Lens' DescribePipeResponse (Maybe PipeSourceParameters)
describePipeResponse_sourceParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe PipeSourceParameters
sourceParameters :: Maybe PipeSourceParameters
$sel:sourceParameters:DescribePipeResponse' :: DescribePipeResponse -> Maybe PipeSourceParameters
sourceParameters} -> Maybe PipeSourceParameters
sourceParameters) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe PipeSourceParameters
a -> DescribePipeResponse
s {$sel:sourceParameters:DescribePipeResponse' :: Maybe PipeSourceParameters
sourceParameters = Maybe PipeSourceParameters
a} :: DescribePipeResponse)

-- | The reason the pipe is in its current state.
describePipeResponse_stateReason :: Lens.Lens' DescribePipeResponse (Prelude.Maybe Prelude.Text)
describePipeResponse_stateReason :: Lens' DescribePipeResponse (Maybe Text)
describePipeResponse_stateReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe Text
stateReason :: Maybe Text
$sel:stateReason:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
stateReason} -> Maybe Text
stateReason) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe Text
a -> DescribePipeResponse
s {$sel:stateReason:DescribePipeResponse' :: Maybe Text
stateReason = Maybe Text
a} :: DescribePipeResponse)

-- | The list of key-value pairs to associate with the pipe.
describePipeResponse_tags :: Lens.Lens' DescribePipeResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
describePipeResponse_tags :: Lens' DescribePipeResponse (Maybe (HashMap Text Text))
describePipeResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe (HashMap Text (Sensitive Text))
tags :: Maybe (HashMap Text (Sensitive Text))
$sel:tags:DescribePipeResponse' :: DescribePipeResponse -> Maybe (HashMap Text (Sensitive Text))
tags} -> Maybe (HashMap Text (Sensitive Text))
tags) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe (HashMap Text (Sensitive Text))
a -> DescribePipeResponse
s {$sel:tags:DescribePipeResponse' :: Maybe (HashMap Text (Sensitive Text))
tags = Maybe (HashMap Text (Sensitive Text))
a} :: DescribePipeResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The ARN of the target resource.
describePipeResponse_target :: Lens.Lens' DescribePipeResponse (Prelude.Maybe Prelude.Text)
describePipeResponse_target :: Lens' DescribePipeResponse (Maybe Text)
describePipeResponse_target = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe Text
target :: Maybe Text
$sel:target:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
target} -> Maybe Text
target) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe Text
a -> DescribePipeResponse
s {$sel:target:DescribePipeResponse' :: Maybe Text
target = Maybe Text
a} :: DescribePipeResponse)

-- | The parameters required to set up a target for your pipe.
describePipeResponse_targetParameters :: Lens.Lens' DescribePipeResponse (Prelude.Maybe PipeTargetParameters)
describePipeResponse_targetParameters :: Lens' DescribePipeResponse (Maybe PipeTargetParameters)
describePipeResponse_targetParameters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePipeResponse' {Maybe PipeTargetParameters
targetParameters :: Maybe PipeTargetParameters
$sel:targetParameters:DescribePipeResponse' :: DescribePipeResponse -> Maybe PipeTargetParameters
targetParameters} -> Maybe PipeTargetParameters
targetParameters) (\s :: DescribePipeResponse
s@DescribePipeResponse' {} Maybe PipeTargetParameters
a -> DescribePipeResponse
s {$sel:targetParameters:DescribePipeResponse' :: Maybe PipeTargetParameters
targetParameters = Maybe PipeTargetParameters
a} :: DescribePipeResponse)

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

instance Prelude.NFData DescribePipeResponse where
  rnf :: DescribePipeResponse -> ()
rnf DescribePipeResponse' {Int
Maybe Text
Maybe (HashMap Text (Sensitive Text))
Maybe (Sensitive Text)
Maybe POSIX
Maybe PipeEnrichmentParameters
Maybe PipeState
Maybe RequestedPipeStateDescribeResponse
Maybe PipeSourceParameters
Maybe PipeTargetParameters
httpStatus :: Int
targetParameters :: Maybe PipeTargetParameters
target :: Maybe Text
tags :: Maybe (HashMap Text (Sensitive Text))
stateReason :: Maybe Text
sourceParameters :: Maybe PipeSourceParameters
source :: Maybe Text
roleArn :: Maybe Text
name :: Maybe Text
lastModifiedTime :: Maybe POSIX
enrichmentParameters :: Maybe PipeEnrichmentParameters
enrichment :: Maybe Text
desiredState :: Maybe RequestedPipeStateDescribeResponse
description :: Maybe (Sensitive Text)
currentState :: Maybe PipeState
creationTime :: Maybe POSIX
arn :: Maybe Text
$sel:httpStatus:DescribePipeResponse' :: DescribePipeResponse -> Int
$sel:targetParameters:DescribePipeResponse' :: DescribePipeResponse -> Maybe PipeTargetParameters
$sel:target:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
$sel:tags:DescribePipeResponse' :: DescribePipeResponse -> Maybe (HashMap Text (Sensitive Text))
$sel:stateReason:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
$sel:sourceParameters:DescribePipeResponse' :: DescribePipeResponse -> Maybe PipeSourceParameters
$sel:source:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
$sel:roleArn:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
$sel:name:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
$sel:lastModifiedTime:DescribePipeResponse' :: DescribePipeResponse -> Maybe POSIX
$sel:enrichmentParameters:DescribePipeResponse' :: DescribePipeResponse -> Maybe PipeEnrichmentParameters
$sel:enrichment:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
$sel:desiredState:DescribePipeResponse' :: DescribePipeResponse -> Maybe RequestedPipeStateDescribeResponse
$sel:description:DescribePipeResponse' :: DescribePipeResponse -> Maybe (Sensitive Text)
$sel:currentState:DescribePipeResponse' :: DescribePipeResponse -> Maybe PipeState
$sel:creationTime:DescribePipeResponse' :: DescribePipeResponse -> Maybe POSIX
$sel:arn:DescribePipeResponse' :: DescribePipeResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PipeState
currentState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RequestedPipeStateDescribeResponse
desiredState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
enrichment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PipeEnrichmentParameters
enrichmentParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastModifiedTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
source
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PipeSourceParameters
sourceParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
stateReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text (Sensitive Text))
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
target
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PipeTargetParameters
targetParameters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus