{-# 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.CodePipeline.EnableStageTransition
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Enables artifacts in a pipeline to transition to a stage in a pipeline.
module Amazonka.CodePipeline.EnableStageTransition
  ( -- * Creating a Request
    EnableStageTransition (..),
    newEnableStageTransition,

    -- * Request Lenses
    enableStageTransition_pipelineName,
    enableStageTransition_stageName,
    enableStageTransition_transitionType,

    -- * Destructuring the Response
    EnableStageTransitionResponse (..),
    newEnableStageTransitionResponse,
  )
where

import Amazonka.CodePipeline.Types
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Represents the input of an @EnableStageTransition@ action.
--
-- /See:/ 'newEnableStageTransition' smart constructor.
data EnableStageTransition = EnableStageTransition'
  { -- | The name of the pipeline in which you want to enable the flow of
    -- artifacts from one stage to another.
    EnableStageTransition -> Text
pipelineName :: Prelude.Text,
    -- | The name of the stage where you want to enable the transition of
    -- artifacts, either into the stage (inbound) or from that stage to the
    -- next stage (outbound).
    EnableStageTransition -> Text
stageName :: Prelude.Text,
    -- | Specifies whether artifacts are allowed to enter the stage and be
    -- processed by the actions in that stage (inbound) or whether already
    -- processed artifacts are allowed to transition to the next stage
    -- (outbound).
    EnableStageTransition -> StageTransitionType
transitionType :: StageTransitionType
  }
  deriving (EnableStageTransition -> EnableStageTransition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnableStageTransition -> EnableStageTransition -> Bool
$c/= :: EnableStageTransition -> EnableStageTransition -> Bool
== :: EnableStageTransition -> EnableStageTransition -> Bool
$c== :: EnableStageTransition -> EnableStageTransition -> Bool
Prelude.Eq, ReadPrec [EnableStageTransition]
ReadPrec EnableStageTransition
Int -> ReadS EnableStageTransition
ReadS [EnableStageTransition]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnableStageTransition]
$creadListPrec :: ReadPrec [EnableStageTransition]
readPrec :: ReadPrec EnableStageTransition
$creadPrec :: ReadPrec EnableStageTransition
readList :: ReadS [EnableStageTransition]
$creadList :: ReadS [EnableStageTransition]
readsPrec :: Int -> ReadS EnableStageTransition
$creadsPrec :: Int -> ReadS EnableStageTransition
Prelude.Read, Int -> EnableStageTransition -> ShowS
[EnableStageTransition] -> ShowS
EnableStageTransition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnableStageTransition] -> ShowS
$cshowList :: [EnableStageTransition] -> ShowS
show :: EnableStageTransition -> String
$cshow :: EnableStageTransition -> String
showsPrec :: Int -> EnableStageTransition -> ShowS
$cshowsPrec :: Int -> EnableStageTransition -> ShowS
Prelude.Show, forall x. Rep EnableStageTransition x -> EnableStageTransition
forall x. EnableStageTransition -> Rep EnableStageTransition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EnableStageTransition x -> EnableStageTransition
$cfrom :: forall x. EnableStageTransition -> Rep EnableStageTransition x
Prelude.Generic)

-- |
-- Create a value of 'EnableStageTransition' 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', 'enableStageTransition_pipelineName' - The name of the pipeline in which you want to enable the flow of
-- artifacts from one stage to another.
--
-- 'stageName', 'enableStageTransition_stageName' - The name of the stage where you want to enable the transition of
-- artifacts, either into the stage (inbound) or from that stage to the
-- next stage (outbound).
--
-- 'transitionType', 'enableStageTransition_transitionType' - Specifies whether artifacts are allowed to enter the stage and be
-- processed by the actions in that stage (inbound) or whether already
-- processed artifacts are allowed to transition to the next stage
-- (outbound).
newEnableStageTransition ::
  -- | 'pipelineName'
  Prelude.Text ->
  -- | 'stageName'
  Prelude.Text ->
  -- | 'transitionType'
  StageTransitionType ->
  EnableStageTransition
newEnableStageTransition :: Text -> Text -> StageTransitionType -> EnableStageTransition
newEnableStageTransition
  Text
pPipelineName_
  Text
pStageName_
  StageTransitionType
pTransitionType_ =
    EnableStageTransition'
      { $sel:pipelineName:EnableStageTransition' :: Text
pipelineName =
          Text
pPipelineName_,
        $sel:stageName:EnableStageTransition' :: Text
stageName = Text
pStageName_,
        $sel:transitionType:EnableStageTransition' :: StageTransitionType
transitionType = StageTransitionType
pTransitionType_
      }

-- | The name of the pipeline in which you want to enable the flow of
-- artifacts from one stage to another.
enableStageTransition_pipelineName :: Lens.Lens' EnableStageTransition Prelude.Text
enableStageTransition_pipelineName :: Lens' EnableStageTransition Text
enableStageTransition_pipelineName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableStageTransition' {Text
pipelineName :: Text
$sel:pipelineName:EnableStageTransition' :: EnableStageTransition -> Text
pipelineName} -> Text
pipelineName) (\s :: EnableStageTransition
s@EnableStageTransition' {} Text
a -> EnableStageTransition
s {$sel:pipelineName:EnableStageTransition' :: Text
pipelineName = Text
a} :: EnableStageTransition)

-- | The name of the stage where you want to enable the transition of
-- artifacts, either into the stage (inbound) or from that stage to the
-- next stage (outbound).
enableStageTransition_stageName :: Lens.Lens' EnableStageTransition Prelude.Text
enableStageTransition_stageName :: Lens' EnableStageTransition Text
enableStageTransition_stageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableStageTransition' {Text
stageName :: Text
$sel:stageName:EnableStageTransition' :: EnableStageTransition -> Text
stageName} -> Text
stageName) (\s :: EnableStageTransition
s@EnableStageTransition' {} Text
a -> EnableStageTransition
s {$sel:stageName:EnableStageTransition' :: Text
stageName = Text
a} :: EnableStageTransition)

-- | Specifies whether artifacts are allowed to enter the stage and be
-- processed by the actions in that stage (inbound) or whether already
-- processed artifacts are allowed to transition to the next stage
-- (outbound).
enableStageTransition_transitionType :: Lens.Lens' EnableStageTransition StageTransitionType
enableStageTransition_transitionType :: Lens' EnableStageTransition StageTransitionType
enableStageTransition_transitionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableStageTransition' {StageTransitionType
transitionType :: StageTransitionType
$sel:transitionType:EnableStageTransition' :: EnableStageTransition -> StageTransitionType
transitionType} -> StageTransitionType
transitionType) (\s :: EnableStageTransition
s@EnableStageTransition' {} StageTransitionType
a -> EnableStageTransition
s {$sel:transitionType:EnableStageTransition' :: StageTransitionType
transitionType = StageTransitionType
a} :: EnableStageTransition)

instance Core.AWSRequest EnableStageTransition where
  type
    AWSResponse EnableStageTransition =
      EnableStageTransitionResponse
  request :: (Service -> Service)
-> EnableStageTransition -> Request EnableStageTransition
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 EnableStageTransition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse EnableStageTransition)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull EnableStageTransitionResponse
EnableStageTransitionResponse'

instance Prelude.Hashable EnableStageTransition where
  hashWithSalt :: Int -> EnableStageTransition -> Int
hashWithSalt Int
_salt EnableStageTransition' {Text
StageTransitionType
transitionType :: StageTransitionType
stageName :: Text
pipelineName :: Text
$sel:transitionType:EnableStageTransition' :: EnableStageTransition -> StageTransitionType
$sel:stageName:EnableStageTransition' :: EnableStageTransition -> Text
$sel:pipelineName:EnableStageTransition' :: EnableStageTransition -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
pipelineName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
stageName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` StageTransitionType
transitionType

instance Prelude.NFData EnableStageTransition where
  rnf :: EnableStageTransition -> ()
rnf EnableStageTransition' {Text
StageTransitionType
transitionType :: StageTransitionType
stageName :: Text
pipelineName :: Text
$sel:transitionType:EnableStageTransition' :: EnableStageTransition -> StageTransitionType
$sel:stageName:EnableStageTransition' :: EnableStageTransition -> Text
$sel:pipelineName:EnableStageTransition' :: EnableStageTransition -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
pipelineName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
stageName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf StageTransitionType
transitionType

instance Data.ToHeaders EnableStageTransition where
  toHeaders :: EnableStageTransition -> [Header]
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 -> [Header]
Data.=# ( ByteString
"CodePipeline_20150709.EnableStageTransition" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON EnableStageTransition where
  toJSON :: EnableStageTransition -> Value
toJSON EnableStageTransition' {Text
StageTransitionType
transitionType :: StageTransitionType
stageName :: Text
pipelineName :: Text
$sel:transitionType:EnableStageTransition' :: EnableStageTransition -> StageTransitionType
$sel:stageName:EnableStageTransition' :: EnableStageTransition -> Text
$sel:pipelineName:EnableStageTransition' :: EnableStageTransition -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"pipelineName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
pipelineName),
            forall a. a -> Maybe a
Prelude.Just (Key
"stageName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
stageName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"transitionType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= StageTransitionType
transitionType)
          ]
      )

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

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

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

-- |
-- Create a value of 'EnableStageTransitionResponse' 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.
newEnableStageTransitionResponse ::
  EnableStageTransitionResponse
newEnableStageTransitionResponse :: EnableStageTransitionResponse
newEnableStageTransitionResponse =
  EnableStageTransitionResponse
EnableStageTransitionResponse'

instance Prelude.NFData EnableStageTransitionResponse where
  rnf :: EnableStageTransitionResponse -> ()
rnf EnableStageTransitionResponse
_ = ()