{-# 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.Proton.UpdateServicePipeline
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Update the service pipeline.
--
-- There are four modes for updating a service pipeline. The
-- @deploymentType@ field defines the mode.
--
-- []
--     @NONE@
--
--     In this mode, a deployment /doesn\'t/ occur. Only the requested
--     metadata parameters are updated.
--
-- []
--     @CURRENT_VERSION@
--
--     In this mode, the service pipeline is deployed and updated with the
--     new spec that you provide. Only requested parameters are updated.
--     /Don’t/ include major or minor version parameters when you use this
--     @deployment-type@.
--
-- []
--     @MINOR_VERSION@
--
--     In this mode, the service pipeline is deployed and updated with the
--     published, recommended (latest) minor version of the current major
--     version in use, by default. You can specify a different minor
--     version of the current major version in use.
--
-- []
--     @MAJOR_VERSION@
--
--     In this mode, the service pipeline is deployed and updated with the
--     published, recommended (latest) major and minor version of the
--     current template by default. You can specify a different major
--     version that\'s higher than the major version in use and a minor
--     version.
module Amazonka.Proton.UpdateServicePipeline
  ( -- * Creating a Request
    UpdateServicePipeline (..),
    newUpdateServicePipeline,

    -- * Request Lenses
    updateServicePipeline_templateMajorVersion,
    updateServicePipeline_templateMinorVersion,
    updateServicePipeline_deploymentType,
    updateServicePipeline_serviceName,
    updateServicePipeline_spec,

    -- * Destructuring the Response
    UpdateServicePipelineResponse (..),
    newUpdateServicePipelineResponse,

    -- * Response Lenses
    updateServicePipelineResponse_httpStatus,
    updateServicePipelineResponse_pipeline,
  )
where

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

-- | /See:/ 'newUpdateServicePipeline' smart constructor.
data UpdateServicePipeline = UpdateServicePipeline'
  { -- | The major version of the service template that was used to create the
    -- service that the pipeline is associated with.
    UpdateServicePipeline -> Maybe Text
templateMajorVersion :: Prelude.Maybe Prelude.Text,
    -- | The minor version of the service template that was used to create the
    -- service that the pipeline is associated with.
    UpdateServicePipeline -> Maybe Text
templateMinorVersion :: Prelude.Maybe Prelude.Text,
    -- | The deployment type.
    --
    -- There are four modes for updating a service pipeline. The
    -- @deploymentType@ field defines the mode.
    --
    -- []
    --     @NONE@
    --
    --     In this mode, a deployment /doesn\'t/ occur. Only the requested
    --     metadata parameters are updated.
    --
    -- []
    --     @CURRENT_VERSION@
    --
    --     In this mode, the service pipeline is deployed and updated with the
    --     new spec that you provide. Only requested parameters are updated.
    --     /Don’t/ include major or minor version parameters when you use this
    --     @deployment-type@.
    --
    -- []
    --     @MINOR_VERSION@
    --
    --     In this mode, the service pipeline is deployed and updated with the
    --     published, recommended (latest) minor version of the current major
    --     version in use, by default. You can specify a different minor
    --     version of the current major version in use.
    --
    -- []
    --     @MAJOR_VERSION@
    --
    --     In this mode, the service pipeline is deployed and updated with the
    --     published, recommended (latest) major and minor version of the
    --     current template, by default. You can specify a different major
    --     version that\'s higher than the major version in use and a minor
    --     version.
    UpdateServicePipeline -> DeploymentUpdateType
deploymentType :: DeploymentUpdateType,
    -- | The name of the service to that the pipeline is associated with.
    UpdateServicePipeline -> Text
serviceName :: Prelude.Text,
    -- | The spec for the service pipeline to update.
    UpdateServicePipeline -> Sensitive Text
spec :: Data.Sensitive Prelude.Text
  }
  deriving (UpdateServicePipeline -> UpdateServicePipeline -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateServicePipeline -> UpdateServicePipeline -> Bool
$c/= :: UpdateServicePipeline -> UpdateServicePipeline -> Bool
== :: UpdateServicePipeline -> UpdateServicePipeline -> Bool
$c== :: UpdateServicePipeline -> UpdateServicePipeline -> Bool
Prelude.Eq, Int -> UpdateServicePipeline -> ShowS
[UpdateServicePipeline] -> ShowS
UpdateServicePipeline -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateServicePipeline] -> ShowS
$cshowList :: [UpdateServicePipeline] -> ShowS
show :: UpdateServicePipeline -> String
$cshow :: UpdateServicePipeline -> String
showsPrec :: Int -> UpdateServicePipeline -> ShowS
$cshowsPrec :: Int -> UpdateServicePipeline -> ShowS
Prelude.Show, forall x. Rep UpdateServicePipeline x -> UpdateServicePipeline
forall x. UpdateServicePipeline -> Rep UpdateServicePipeline x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateServicePipeline x -> UpdateServicePipeline
$cfrom :: forall x. UpdateServicePipeline -> Rep UpdateServicePipeline x
Prelude.Generic)

-- |
-- Create a value of 'UpdateServicePipeline' 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:
--
-- 'templateMajorVersion', 'updateServicePipeline_templateMajorVersion' - The major version of the service template that was used to create the
-- service that the pipeline is associated with.
--
-- 'templateMinorVersion', 'updateServicePipeline_templateMinorVersion' - The minor version of the service template that was used to create the
-- service that the pipeline is associated with.
--
-- 'deploymentType', 'updateServicePipeline_deploymentType' - The deployment type.
--
-- There are four modes for updating a service pipeline. The
-- @deploymentType@ field defines the mode.
--
-- []
--     @NONE@
--
--     In this mode, a deployment /doesn\'t/ occur. Only the requested
--     metadata parameters are updated.
--
-- []
--     @CURRENT_VERSION@
--
--     In this mode, the service pipeline is deployed and updated with the
--     new spec that you provide. Only requested parameters are updated.
--     /Don’t/ include major or minor version parameters when you use this
--     @deployment-type@.
--
-- []
--     @MINOR_VERSION@
--
--     In this mode, the service pipeline is deployed and updated with the
--     published, recommended (latest) minor version of the current major
--     version in use, by default. You can specify a different minor
--     version of the current major version in use.
--
-- []
--     @MAJOR_VERSION@
--
--     In this mode, the service pipeline is deployed and updated with the
--     published, recommended (latest) major and minor version of the
--     current template, by default. You can specify a different major
--     version that\'s higher than the major version in use and a minor
--     version.
--
-- 'serviceName', 'updateServicePipeline_serviceName' - The name of the service to that the pipeline is associated with.
--
-- 'spec', 'updateServicePipeline_spec' - The spec for the service pipeline to update.
newUpdateServicePipeline ::
  -- | 'deploymentType'
  DeploymentUpdateType ->
  -- | 'serviceName'
  Prelude.Text ->
  -- | 'spec'
  Prelude.Text ->
  UpdateServicePipeline
newUpdateServicePipeline :: DeploymentUpdateType -> Text -> Text -> UpdateServicePipeline
newUpdateServicePipeline
  DeploymentUpdateType
pDeploymentType_
  Text
pServiceName_
  Text
pSpec_ =
    UpdateServicePipeline'
      { $sel:templateMajorVersion:UpdateServicePipeline' :: Maybe Text
templateMajorVersion =
          forall a. Maybe a
Prelude.Nothing,
        $sel:templateMinorVersion:UpdateServicePipeline' :: Maybe Text
templateMinorVersion = forall a. Maybe a
Prelude.Nothing,
        $sel:deploymentType:UpdateServicePipeline' :: DeploymentUpdateType
deploymentType = DeploymentUpdateType
pDeploymentType_,
        $sel:serviceName:UpdateServicePipeline' :: Text
serviceName = Text
pServiceName_,
        $sel:spec:UpdateServicePipeline' :: Sensitive Text
spec = forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pSpec_
      }

-- | The major version of the service template that was used to create the
-- service that the pipeline is associated with.
updateServicePipeline_templateMajorVersion :: Lens.Lens' UpdateServicePipeline (Prelude.Maybe Prelude.Text)
updateServicePipeline_templateMajorVersion :: Lens' UpdateServicePipeline (Maybe Text)
updateServicePipeline_templateMajorVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServicePipeline' {Maybe Text
templateMajorVersion :: Maybe Text
$sel:templateMajorVersion:UpdateServicePipeline' :: UpdateServicePipeline -> Maybe Text
templateMajorVersion} -> Maybe Text
templateMajorVersion) (\s :: UpdateServicePipeline
s@UpdateServicePipeline' {} Maybe Text
a -> UpdateServicePipeline
s {$sel:templateMajorVersion:UpdateServicePipeline' :: Maybe Text
templateMajorVersion = Maybe Text
a} :: UpdateServicePipeline)

-- | The minor version of the service template that was used to create the
-- service that the pipeline is associated with.
updateServicePipeline_templateMinorVersion :: Lens.Lens' UpdateServicePipeline (Prelude.Maybe Prelude.Text)
updateServicePipeline_templateMinorVersion :: Lens' UpdateServicePipeline (Maybe Text)
updateServicePipeline_templateMinorVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServicePipeline' {Maybe Text
templateMinorVersion :: Maybe Text
$sel:templateMinorVersion:UpdateServicePipeline' :: UpdateServicePipeline -> Maybe Text
templateMinorVersion} -> Maybe Text
templateMinorVersion) (\s :: UpdateServicePipeline
s@UpdateServicePipeline' {} Maybe Text
a -> UpdateServicePipeline
s {$sel:templateMinorVersion:UpdateServicePipeline' :: Maybe Text
templateMinorVersion = Maybe Text
a} :: UpdateServicePipeline)

-- | The deployment type.
--
-- There are four modes for updating a service pipeline. The
-- @deploymentType@ field defines the mode.
--
-- []
--     @NONE@
--
--     In this mode, a deployment /doesn\'t/ occur. Only the requested
--     metadata parameters are updated.
--
-- []
--     @CURRENT_VERSION@
--
--     In this mode, the service pipeline is deployed and updated with the
--     new spec that you provide. Only requested parameters are updated.
--     /Don’t/ include major or minor version parameters when you use this
--     @deployment-type@.
--
-- []
--     @MINOR_VERSION@
--
--     In this mode, the service pipeline is deployed and updated with the
--     published, recommended (latest) minor version of the current major
--     version in use, by default. You can specify a different minor
--     version of the current major version in use.
--
-- []
--     @MAJOR_VERSION@
--
--     In this mode, the service pipeline is deployed and updated with the
--     published, recommended (latest) major and minor version of the
--     current template, by default. You can specify a different major
--     version that\'s higher than the major version in use and a minor
--     version.
updateServicePipeline_deploymentType :: Lens.Lens' UpdateServicePipeline DeploymentUpdateType
updateServicePipeline_deploymentType :: Lens' UpdateServicePipeline DeploymentUpdateType
updateServicePipeline_deploymentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServicePipeline' {DeploymentUpdateType
deploymentType :: DeploymentUpdateType
$sel:deploymentType:UpdateServicePipeline' :: UpdateServicePipeline -> DeploymentUpdateType
deploymentType} -> DeploymentUpdateType
deploymentType) (\s :: UpdateServicePipeline
s@UpdateServicePipeline' {} DeploymentUpdateType
a -> UpdateServicePipeline
s {$sel:deploymentType:UpdateServicePipeline' :: DeploymentUpdateType
deploymentType = DeploymentUpdateType
a} :: UpdateServicePipeline)

-- | The name of the service to that the pipeline is associated with.
updateServicePipeline_serviceName :: Lens.Lens' UpdateServicePipeline Prelude.Text
updateServicePipeline_serviceName :: Lens' UpdateServicePipeline Text
updateServicePipeline_serviceName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServicePipeline' {Text
serviceName :: Text
$sel:serviceName:UpdateServicePipeline' :: UpdateServicePipeline -> Text
serviceName} -> Text
serviceName) (\s :: UpdateServicePipeline
s@UpdateServicePipeline' {} Text
a -> UpdateServicePipeline
s {$sel:serviceName:UpdateServicePipeline' :: Text
serviceName = Text
a} :: UpdateServicePipeline)

-- | The spec for the service pipeline to update.
updateServicePipeline_spec :: Lens.Lens' UpdateServicePipeline Prelude.Text
updateServicePipeline_spec :: Lens' UpdateServicePipeline Text
updateServicePipeline_spec = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServicePipeline' {Sensitive Text
spec :: Sensitive Text
$sel:spec:UpdateServicePipeline' :: UpdateServicePipeline -> Sensitive Text
spec} -> Sensitive Text
spec) (\s :: UpdateServicePipeline
s@UpdateServicePipeline' {} Sensitive Text
a -> UpdateServicePipeline
s {$sel:spec:UpdateServicePipeline' :: Sensitive Text
spec = Sensitive Text
a} :: UpdateServicePipeline) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

instance Core.AWSRequest UpdateServicePipeline where
  type
    AWSResponse UpdateServicePipeline =
      UpdateServicePipelineResponse
  request :: (Service -> Service)
-> UpdateServicePipeline -> Request UpdateServicePipeline
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 UpdateServicePipeline
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateServicePipeline)))
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 -> ServicePipeline -> UpdateServicePipelineResponse
UpdateServicePipelineResponse'
            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
"pipeline")
      )

instance Prelude.Hashable UpdateServicePipeline where
  hashWithSalt :: Int -> UpdateServicePipeline -> Int
hashWithSalt Int
_salt UpdateServicePipeline' {Maybe Text
Text
Sensitive Text
DeploymentUpdateType
spec :: Sensitive Text
serviceName :: Text
deploymentType :: DeploymentUpdateType
templateMinorVersion :: Maybe Text
templateMajorVersion :: Maybe Text
$sel:spec:UpdateServicePipeline' :: UpdateServicePipeline -> Sensitive Text
$sel:serviceName:UpdateServicePipeline' :: UpdateServicePipeline -> Text
$sel:deploymentType:UpdateServicePipeline' :: UpdateServicePipeline -> DeploymentUpdateType
$sel:templateMinorVersion:UpdateServicePipeline' :: UpdateServicePipeline -> Maybe Text
$sel:templateMajorVersion:UpdateServicePipeline' :: UpdateServicePipeline -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateMajorVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
templateMinorVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` DeploymentUpdateType
deploymentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
serviceName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
spec

instance Prelude.NFData UpdateServicePipeline where
  rnf :: UpdateServicePipeline -> ()
rnf UpdateServicePipeline' {Maybe Text
Text
Sensitive Text
DeploymentUpdateType
spec :: Sensitive Text
serviceName :: Text
deploymentType :: DeploymentUpdateType
templateMinorVersion :: Maybe Text
templateMajorVersion :: Maybe Text
$sel:spec:UpdateServicePipeline' :: UpdateServicePipeline -> Sensitive Text
$sel:serviceName:UpdateServicePipeline' :: UpdateServicePipeline -> Text
$sel:deploymentType:UpdateServicePipeline' :: UpdateServicePipeline -> DeploymentUpdateType
$sel:templateMinorVersion:UpdateServicePipeline' :: UpdateServicePipeline -> Maybe Text
$sel:templateMajorVersion:UpdateServicePipeline' :: UpdateServicePipeline -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateMajorVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
templateMinorVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf DeploymentUpdateType
deploymentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
serviceName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
spec

instance Data.ToHeaders UpdateServicePipeline where
  toHeaders :: UpdateServicePipeline -> 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
"AwsProton20200720.UpdateServicePipeline" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateServicePipeline where
  toJSON :: UpdateServicePipeline -> Value
toJSON UpdateServicePipeline' {Maybe Text
Text
Sensitive Text
DeploymentUpdateType
spec :: Sensitive Text
serviceName :: Text
deploymentType :: DeploymentUpdateType
templateMinorVersion :: Maybe Text
templateMajorVersion :: Maybe Text
$sel:spec:UpdateServicePipeline' :: UpdateServicePipeline -> Sensitive Text
$sel:serviceName:UpdateServicePipeline' :: UpdateServicePipeline -> Text
$sel:deploymentType:UpdateServicePipeline' :: UpdateServicePipeline -> DeploymentUpdateType
$sel:templateMinorVersion:UpdateServicePipeline' :: UpdateServicePipeline -> Maybe Text
$sel:templateMajorVersion:UpdateServicePipeline' :: UpdateServicePipeline -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"templateMajorVersion" 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
templateMajorVersion,
            (Key
"templateMinorVersion" 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
templateMinorVersion,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"deploymentType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= DeploymentUpdateType
deploymentType),
            forall a. a -> Maybe a
Prelude.Just (Key
"serviceName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
serviceName),
            forall a. a -> Maybe a
Prelude.Just (Key
"spec" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
spec)
          ]
      )

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

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

-- | /See:/ 'newUpdateServicePipelineResponse' smart constructor.
data UpdateServicePipelineResponse = UpdateServicePipelineResponse'
  { -- | The response's http status code.
    UpdateServicePipelineResponse -> Int
httpStatus :: Prelude.Int,
    -- | The pipeline details that are returned by Proton.
    UpdateServicePipelineResponse -> ServicePipeline
pipeline :: ServicePipeline
  }
  deriving (UpdateServicePipelineResponse
-> UpdateServicePipelineResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateServicePipelineResponse
-> UpdateServicePipelineResponse -> Bool
$c/= :: UpdateServicePipelineResponse
-> UpdateServicePipelineResponse -> Bool
== :: UpdateServicePipelineResponse
-> UpdateServicePipelineResponse -> Bool
$c== :: UpdateServicePipelineResponse
-> UpdateServicePipelineResponse -> Bool
Prelude.Eq, Int -> UpdateServicePipelineResponse -> ShowS
[UpdateServicePipelineResponse] -> ShowS
UpdateServicePipelineResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateServicePipelineResponse] -> ShowS
$cshowList :: [UpdateServicePipelineResponse] -> ShowS
show :: UpdateServicePipelineResponse -> String
$cshow :: UpdateServicePipelineResponse -> String
showsPrec :: Int -> UpdateServicePipelineResponse -> ShowS
$cshowsPrec :: Int -> UpdateServicePipelineResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateServicePipelineResponse x
-> UpdateServicePipelineResponse
forall x.
UpdateServicePipelineResponse
-> Rep UpdateServicePipelineResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateServicePipelineResponse x
-> UpdateServicePipelineResponse
$cfrom :: forall x.
UpdateServicePipelineResponse
-> Rep UpdateServicePipelineResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateServicePipelineResponse' 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', 'updateServicePipelineResponse_httpStatus' - The response's http status code.
--
-- 'pipeline', 'updateServicePipelineResponse_pipeline' - The pipeline details that are returned by Proton.
newUpdateServicePipelineResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'pipeline'
  ServicePipeline ->
  UpdateServicePipelineResponse
newUpdateServicePipelineResponse :: Int -> ServicePipeline -> UpdateServicePipelineResponse
newUpdateServicePipelineResponse
  Int
pHttpStatus_
  ServicePipeline
pPipeline_ =
    UpdateServicePipelineResponse'
      { $sel:httpStatus:UpdateServicePipelineResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:pipeline:UpdateServicePipelineResponse' :: ServicePipeline
pipeline = ServicePipeline
pPipeline_
      }

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

-- | The pipeline details that are returned by Proton.
updateServicePipelineResponse_pipeline :: Lens.Lens' UpdateServicePipelineResponse ServicePipeline
updateServicePipelineResponse_pipeline :: Lens' UpdateServicePipelineResponse ServicePipeline
updateServicePipelineResponse_pipeline = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServicePipelineResponse' {ServicePipeline
pipeline :: ServicePipeline
$sel:pipeline:UpdateServicePipelineResponse' :: UpdateServicePipelineResponse -> ServicePipeline
pipeline} -> ServicePipeline
pipeline) (\s :: UpdateServicePipelineResponse
s@UpdateServicePipelineResponse' {} ServicePipeline
a -> UpdateServicePipelineResponse
s {$sel:pipeline:UpdateServicePipelineResponse' :: ServicePipeline
pipeline = ServicePipeline
a} :: UpdateServicePipelineResponse)

instance Prelude.NFData UpdateServicePipelineResponse where
  rnf :: UpdateServicePipelineResponse -> ()
rnf UpdateServicePipelineResponse' {Int
ServicePipeline
pipeline :: ServicePipeline
httpStatus :: Int
$sel:pipeline:UpdateServicePipelineResponse' :: UpdateServicePipelineResponse -> ServicePipeline
$sel:httpStatus:UpdateServicePipelineResponse' :: UpdateServicePipelineResponse -> 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 ServicePipeline
pipeline