{-# 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.DataPipeline.CreatePipeline
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a new, empty pipeline. Use PutPipelineDefinition to populate the
-- pipeline.
module Amazonka.DataPipeline.CreatePipeline
  ( -- * Creating a Request
    CreatePipeline (..),
    newCreatePipeline,

    -- * Request Lenses
    createPipeline_description,
    createPipeline_tags,
    createPipeline_name,
    createPipeline_uniqueId,

    -- * Destructuring the Response
    CreatePipelineResponse (..),
    newCreatePipelineResponse,

    -- * Response Lenses
    createPipelineResponse_httpStatus,
    createPipelineResponse_pipelineId,
  )
where

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

-- | Contains the parameters for CreatePipeline.
--
-- /See:/ 'newCreatePipeline' smart constructor.
data CreatePipeline = CreatePipeline'
  { -- | The description for the pipeline.
    CreatePipeline -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A list of tags to associate with the pipeline at creation. Tags let you
    -- control access to pipelines. For more information, see
    -- <http://docs.aws.amazon.com/datapipeline/latest/DeveloperGuide/dp-control-access.html Controlling User Access to Pipelines>
    -- in the /AWS Data Pipeline Developer Guide/.
    CreatePipeline -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The name for the pipeline. You can use the same name for multiple
    -- pipelines associated with your AWS account, because AWS Data Pipeline
    -- assigns each pipeline a unique pipeline identifier.
    CreatePipeline -> Text
name :: Prelude.Text,
    -- | A unique identifier. This identifier is not the same as the pipeline
    -- identifier assigned by AWS Data Pipeline. You are responsible for
    -- defining the format and ensuring the uniqueness of this identifier. You
    -- use this parameter to ensure idempotency during repeated calls to
    -- @CreatePipeline@. For example, if the first call to @CreatePipeline@
    -- does not succeed, you can pass in the same unique identifier and
    -- pipeline name combination on a subsequent call to @CreatePipeline@.
    -- @CreatePipeline@ ensures that if a pipeline already exists with the same
    -- name and unique identifier, a new pipeline is not created. Instead,
    -- you\'ll receive the pipeline identifier from the previous attempt. The
    -- uniqueness of the name and unique identifier combination is scoped to
    -- the AWS account or IAM user credentials.
    CreatePipeline -> Text
uniqueId :: Prelude.Text
  }
  deriving (CreatePipeline -> CreatePipeline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePipeline -> CreatePipeline -> Bool
$c/= :: CreatePipeline -> CreatePipeline -> Bool
== :: CreatePipeline -> CreatePipeline -> Bool
$c== :: CreatePipeline -> CreatePipeline -> Bool
Prelude.Eq, ReadPrec [CreatePipeline]
ReadPrec CreatePipeline
Int -> ReadS CreatePipeline
ReadS [CreatePipeline]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePipeline]
$creadListPrec :: ReadPrec [CreatePipeline]
readPrec :: ReadPrec CreatePipeline
$creadPrec :: ReadPrec CreatePipeline
readList :: ReadS [CreatePipeline]
$creadList :: ReadS [CreatePipeline]
readsPrec :: Int -> ReadS CreatePipeline
$creadsPrec :: Int -> ReadS CreatePipeline
Prelude.Read, Int -> CreatePipeline -> ShowS
[CreatePipeline] -> ShowS
CreatePipeline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePipeline] -> ShowS
$cshowList :: [CreatePipeline] -> ShowS
show :: CreatePipeline -> String
$cshow :: CreatePipeline -> String
showsPrec :: Int -> CreatePipeline -> ShowS
$cshowsPrec :: Int -> CreatePipeline -> ShowS
Prelude.Show, forall x. Rep CreatePipeline x -> CreatePipeline
forall x. CreatePipeline -> Rep CreatePipeline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePipeline x -> CreatePipeline
$cfrom :: forall x. CreatePipeline -> Rep CreatePipeline x
Prelude.Generic)

-- |
-- Create a value of 'CreatePipeline' 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:
--
-- 'description', 'createPipeline_description' - The description for the pipeline.
--
-- 'tags', 'createPipeline_tags' - A list of tags to associate with the pipeline at creation. Tags let you
-- control access to pipelines. For more information, see
-- <http://docs.aws.amazon.com/datapipeline/latest/DeveloperGuide/dp-control-access.html Controlling User Access to Pipelines>
-- in the /AWS Data Pipeline Developer Guide/.
--
-- 'name', 'createPipeline_name' - The name for the pipeline. You can use the same name for multiple
-- pipelines associated with your AWS account, because AWS Data Pipeline
-- assigns each pipeline a unique pipeline identifier.
--
-- 'uniqueId', 'createPipeline_uniqueId' - A unique identifier. This identifier is not the same as the pipeline
-- identifier assigned by AWS Data Pipeline. You are responsible for
-- defining the format and ensuring the uniqueness of this identifier. You
-- use this parameter to ensure idempotency during repeated calls to
-- @CreatePipeline@. For example, if the first call to @CreatePipeline@
-- does not succeed, you can pass in the same unique identifier and
-- pipeline name combination on a subsequent call to @CreatePipeline@.
-- @CreatePipeline@ ensures that if a pipeline already exists with the same
-- name and unique identifier, a new pipeline is not created. Instead,
-- you\'ll receive the pipeline identifier from the previous attempt. The
-- uniqueness of the name and unique identifier combination is scoped to
-- the AWS account or IAM user credentials.
newCreatePipeline ::
  -- | 'name'
  Prelude.Text ->
  -- | 'uniqueId'
  Prelude.Text ->
  CreatePipeline
newCreatePipeline :: Text -> Text -> CreatePipeline
newCreatePipeline Text
pName_ Text
pUniqueId_ =
  CreatePipeline'
    { $sel:description:CreatePipeline' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreatePipeline' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:name:CreatePipeline' :: Text
name = Text
pName_,
      $sel:uniqueId:CreatePipeline' :: Text
uniqueId = Text
pUniqueId_
    }

-- | The description for the pipeline.
createPipeline_description :: Lens.Lens' CreatePipeline (Prelude.Maybe Prelude.Text)
createPipeline_description :: Lens' CreatePipeline (Maybe Text)
createPipeline_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePipeline' {Maybe Text
description :: Maybe Text
$sel:description:CreatePipeline' :: CreatePipeline -> Maybe Text
description} -> Maybe Text
description) (\s :: CreatePipeline
s@CreatePipeline' {} Maybe Text
a -> CreatePipeline
s {$sel:description:CreatePipeline' :: Maybe Text
description = Maybe Text
a} :: CreatePipeline)

-- | A list of tags to associate with the pipeline at creation. Tags let you
-- control access to pipelines. For more information, see
-- <http://docs.aws.amazon.com/datapipeline/latest/DeveloperGuide/dp-control-access.html Controlling User Access to Pipelines>
-- in the /AWS Data Pipeline Developer Guide/.
createPipeline_tags :: Lens.Lens' CreatePipeline (Prelude.Maybe [Tag])
createPipeline_tags :: Lens' CreatePipeline (Maybe [Tag])
createPipeline_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePipeline' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreatePipeline' :: CreatePipeline -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreatePipeline
s@CreatePipeline' {} Maybe [Tag]
a -> CreatePipeline
s {$sel:tags:CreatePipeline' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreatePipeline) 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 name for the pipeline. You can use the same name for multiple
-- pipelines associated with your AWS account, because AWS Data Pipeline
-- assigns each pipeline a unique pipeline identifier.
createPipeline_name :: Lens.Lens' CreatePipeline Prelude.Text
createPipeline_name :: Lens' CreatePipeline Text
createPipeline_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePipeline' {Text
name :: Text
$sel:name:CreatePipeline' :: CreatePipeline -> Text
name} -> Text
name) (\s :: CreatePipeline
s@CreatePipeline' {} Text
a -> CreatePipeline
s {$sel:name:CreatePipeline' :: Text
name = Text
a} :: CreatePipeline)

-- | A unique identifier. This identifier is not the same as the pipeline
-- identifier assigned by AWS Data Pipeline. You are responsible for
-- defining the format and ensuring the uniqueness of this identifier. You
-- use this parameter to ensure idempotency during repeated calls to
-- @CreatePipeline@. For example, if the first call to @CreatePipeline@
-- does not succeed, you can pass in the same unique identifier and
-- pipeline name combination on a subsequent call to @CreatePipeline@.
-- @CreatePipeline@ ensures that if a pipeline already exists with the same
-- name and unique identifier, a new pipeline is not created. Instead,
-- you\'ll receive the pipeline identifier from the previous attempt. The
-- uniqueness of the name and unique identifier combination is scoped to
-- the AWS account or IAM user credentials.
createPipeline_uniqueId :: Lens.Lens' CreatePipeline Prelude.Text
createPipeline_uniqueId :: Lens' CreatePipeline Text
createPipeline_uniqueId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePipeline' {Text
uniqueId :: Text
$sel:uniqueId:CreatePipeline' :: CreatePipeline -> Text
uniqueId} -> Text
uniqueId) (\s :: CreatePipeline
s@CreatePipeline' {} Text
a -> CreatePipeline
s {$sel:uniqueId:CreatePipeline' :: Text
uniqueId = Text
a} :: CreatePipeline)

instance Core.AWSRequest CreatePipeline where
  type
    AWSResponse CreatePipeline =
      CreatePipelineResponse
  request :: (Service -> Service) -> CreatePipeline -> Request CreatePipeline
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 CreatePipeline
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreatePipeline)))
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 ->
          Int -> Text -> CreatePipelineResponse
CreatePipelineResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"pipelineId")
      )

instance Prelude.Hashable CreatePipeline where
  hashWithSalt :: Int -> CreatePipeline -> Int
hashWithSalt Int
_salt CreatePipeline' {Maybe [Tag]
Maybe Text
Text
uniqueId :: Text
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:uniqueId:CreatePipeline' :: CreatePipeline -> Text
$sel:name:CreatePipeline' :: CreatePipeline -> Text
$sel:tags:CreatePipeline' :: CreatePipeline -> Maybe [Tag]
$sel:description:CreatePipeline' :: CreatePipeline -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
uniqueId

instance Prelude.NFData CreatePipeline where
  rnf :: CreatePipeline -> ()
rnf CreatePipeline' {Maybe [Tag]
Maybe Text
Text
uniqueId :: Text
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:uniqueId:CreatePipeline' :: CreatePipeline -> Text
$sel:name:CreatePipeline' :: CreatePipeline -> Text
$sel:tags:CreatePipeline' :: CreatePipeline -> Maybe [Tag]
$sel:description:CreatePipeline' :: CreatePipeline -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
uniqueId

instance Data.ToHeaders CreatePipeline where
  toHeaders :: CreatePipeline -> 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
"DataPipeline.CreatePipeline" ::
                          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 CreatePipeline where
  toJSON :: CreatePipeline -> Value
toJSON CreatePipeline' {Maybe [Tag]
Maybe Text
Text
uniqueId :: Text
name :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:uniqueId:CreatePipeline' :: CreatePipeline -> Text
$sel:name:CreatePipeline' :: CreatePipeline -> Text
$sel:tags:CreatePipeline' :: CreatePipeline -> Maybe [Tag]
$sel:description:CreatePipeline' :: CreatePipeline -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just (Key
"uniqueId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
uniqueId)
          ]
      )

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

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

-- | Contains the output of CreatePipeline.
--
-- /See:/ 'newCreatePipelineResponse' smart constructor.
data CreatePipelineResponse = CreatePipelineResponse'
  { -- | The response's http status code.
    CreatePipelineResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ID that AWS Data Pipeline assigns the newly created pipeline. For
    -- example, @df-06372391ZG65EXAMPLE@.
    CreatePipelineResponse -> Text
pipelineId :: Prelude.Text
  }
  deriving (CreatePipelineResponse -> CreatePipelineResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePipelineResponse -> CreatePipelineResponse -> Bool
$c/= :: CreatePipelineResponse -> CreatePipelineResponse -> Bool
== :: CreatePipelineResponse -> CreatePipelineResponse -> Bool
$c== :: CreatePipelineResponse -> CreatePipelineResponse -> Bool
Prelude.Eq, ReadPrec [CreatePipelineResponse]
ReadPrec CreatePipelineResponse
Int -> ReadS CreatePipelineResponse
ReadS [CreatePipelineResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePipelineResponse]
$creadListPrec :: ReadPrec [CreatePipelineResponse]
readPrec :: ReadPrec CreatePipelineResponse
$creadPrec :: ReadPrec CreatePipelineResponse
readList :: ReadS [CreatePipelineResponse]
$creadList :: ReadS [CreatePipelineResponse]
readsPrec :: Int -> ReadS CreatePipelineResponse
$creadsPrec :: Int -> ReadS CreatePipelineResponse
Prelude.Read, Int -> CreatePipelineResponse -> ShowS
[CreatePipelineResponse] -> ShowS
CreatePipelineResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePipelineResponse] -> ShowS
$cshowList :: [CreatePipelineResponse] -> ShowS
show :: CreatePipelineResponse -> String
$cshow :: CreatePipelineResponse -> String
showsPrec :: Int -> CreatePipelineResponse -> ShowS
$cshowsPrec :: Int -> CreatePipelineResponse -> ShowS
Prelude.Show, forall x. Rep CreatePipelineResponse x -> CreatePipelineResponse
forall x. CreatePipelineResponse -> Rep CreatePipelineResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePipelineResponse x -> CreatePipelineResponse
$cfrom :: forall x. CreatePipelineResponse -> Rep CreatePipelineResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreatePipelineResponse' 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:
--
-- 'httpStatus', 'createPipelineResponse_httpStatus' - The response's http status code.
--
-- 'pipelineId', 'createPipelineResponse_pipelineId' - The ID that AWS Data Pipeline assigns the newly created pipeline. For
-- example, @df-06372391ZG65EXAMPLE@.
newCreatePipelineResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'pipelineId'
  Prelude.Text ->
  CreatePipelineResponse
newCreatePipelineResponse :: Int -> Text -> CreatePipelineResponse
newCreatePipelineResponse Int
pHttpStatus_ Text
pPipelineId_ =
  CreatePipelineResponse'
    { $sel:httpStatus:CreatePipelineResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:pipelineId:CreatePipelineResponse' :: Text
pipelineId = Text
pPipelineId_
    }

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

-- | The ID that AWS Data Pipeline assigns the newly created pipeline. For
-- example, @df-06372391ZG65EXAMPLE@.
createPipelineResponse_pipelineId :: Lens.Lens' CreatePipelineResponse Prelude.Text
createPipelineResponse_pipelineId :: Lens' CreatePipelineResponse Text
createPipelineResponse_pipelineId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePipelineResponse' {Text
pipelineId :: Text
$sel:pipelineId:CreatePipelineResponse' :: CreatePipelineResponse -> Text
pipelineId} -> Text
pipelineId) (\s :: CreatePipelineResponse
s@CreatePipelineResponse' {} Text
a -> CreatePipelineResponse
s {$sel:pipelineId:CreatePipelineResponse' :: Text
pipelineId = Text
a} :: CreatePipelineResponse)

instance Prelude.NFData CreatePipelineResponse where
  rnf :: CreatePipelineResponse -> ()
rnf CreatePipelineResponse' {Int
Text
pipelineId :: Text
httpStatus :: Int
$sel:pipelineId:CreatePipelineResponse' :: CreatePipelineResponse -> Text
$sel:httpStatus:CreatePipelineResponse' :: CreatePipelineResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
pipelineId