{-# 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.PutActionRevision
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides information to AWS CodePipeline about new revisions to a
-- source.
module Amazonka.CodePipeline.PutActionRevision
  ( -- * Creating a Request
    PutActionRevision (..),
    newPutActionRevision,

    -- * Request Lenses
    putActionRevision_pipelineName,
    putActionRevision_stageName,
    putActionRevision_actionName,
    putActionRevision_actionRevision,

    -- * Destructuring the Response
    PutActionRevisionResponse (..),
    newPutActionRevisionResponse,

    -- * Response Lenses
    putActionRevisionResponse_newRevision,
    putActionRevisionResponse_pipelineExecutionId,
    putActionRevisionResponse_httpStatus,
  )
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 a @PutActionRevision@ action.
--
-- /See:/ 'newPutActionRevision' smart constructor.
data PutActionRevision = PutActionRevision'
  { -- | The name of the pipeline that starts processing the revision to the
    -- source.
    PutActionRevision -> Text
pipelineName :: Prelude.Text,
    -- | The name of the stage that contains the action that acts on the
    -- revision.
    PutActionRevision -> Text
stageName :: Prelude.Text,
    -- | The name of the action that processes the revision.
    PutActionRevision -> Text
actionName :: Prelude.Text,
    -- | Represents information about the version (or revision) of an action.
    PutActionRevision -> ActionRevision
actionRevision :: ActionRevision
  }
  deriving (PutActionRevision -> PutActionRevision -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutActionRevision -> PutActionRevision -> Bool
$c/= :: PutActionRevision -> PutActionRevision -> Bool
== :: PutActionRevision -> PutActionRevision -> Bool
$c== :: PutActionRevision -> PutActionRevision -> Bool
Prelude.Eq, ReadPrec [PutActionRevision]
ReadPrec PutActionRevision
Int -> ReadS PutActionRevision
ReadS [PutActionRevision]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutActionRevision]
$creadListPrec :: ReadPrec [PutActionRevision]
readPrec :: ReadPrec PutActionRevision
$creadPrec :: ReadPrec PutActionRevision
readList :: ReadS [PutActionRevision]
$creadList :: ReadS [PutActionRevision]
readsPrec :: Int -> ReadS PutActionRevision
$creadsPrec :: Int -> ReadS PutActionRevision
Prelude.Read, Int -> PutActionRevision -> ShowS
[PutActionRevision] -> ShowS
PutActionRevision -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutActionRevision] -> ShowS
$cshowList :: [PutActionRevision] -> ShowS
show :: PutActionRevision -> String
$cshow :: PutActionRevision -> String
showsPrec :: Int -> PutActionRevision -> ShowS
$cshowsPrec :: Int -> PutActionRevision -> ShowS
Prelude.Show, forall x. Rep PutActionRevision x -> PutActionRevision
forall x. PutActionRevision -> Rep PutActionRevision x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutActionRevision x -> PutActionRevision
$cfrom :: forall x. PutActionRevision -> Rep PutActionRevision x
Prelude.Generic)

-- |
-- Create a value of 'PutActionRevision' 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', 'putActionRevision_pipelineName' - The name of the pipeline that starts processing the revision to the
-- source.
--
-- 'stageName', 'putActionRevision_stageName' - The name of the stage that contains the action that acts on the
-- revision.
--
-- 'actionName', 'putActionRevision_actionName' - The name of the action that processes the revision.
--
-- 'actionRevision', 'putActionRevision_actionRevision' - Represents information about the version (or revision) of an action.
newPutActionRevision ::
  -- | 'pipelineName'
  Prelude.Text ->
  -- | 'stageName'
  Prelude.Text ->
  -- | 'actionName'
  Prelude.Text ->
  -- | 'actionRevision'
  ActionRevision ->
  PutActionRevision
newPutActionRevision :: Text -> Text -> Text -> ActionRevision -> PutActionRevision
newPutActionRevision
  Text
pPipelineName_
  Text
pStageName_
  Text
pActionName_
  ActionRevision
pActionRevision_ =
    PutActionRevision'
      { $sel:pipelineName:PutActionRevision' :: Text
pipelineName = Text
pPipelineName_,
        $sel:stageName:PutActionRevision' :: Text
stageName = Text
pStageName_,
        $sel:actionName:PutActionRevision' :: Text
actionName = Text
pActionName_,
        $sel:actionRevision:PutActionRevision' :: ActionRevision
actionRevision = ActionRevision
pActionRevision_
      }

-- | The name of the pipeline that starts processing the revision to the
-- source.
putActionRevision_pipelineName :: Lens.Lens' PutActionRevision Prelude.Text
putActionRevision_pipelineName :: Lens' PutActionRevision Text
putActionRevision_pipelineName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutActionRevision' {Text
pipelineName :: Text
$sel:pipelineName:PutActionRevision' :: PutActionRevision -> Text
pipelineName} -> Text
pipelineName) (\s :: PutActionRevision
s@PutActionRevision' {} Text
a -> PutActionRevision
s {$sel:pipelineName:PutActionRevision' :: Text
pipelineName = Text
a} :: PutActionRevision)

-- | The name of the stage that contains the action that acts on the
-- revision.
putActionRevision_stageName :: Lens.Lens' PutActionRevision Prelude.Text
putActionRevision_stageName :: Lens' PutActionRevision Text
putActionRevision_stageName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutActionRevision' {Text
stageName :: Text
$sel:stageName:PutActionRevision' :: PutActionRevision -> Text
stageName} -> Text
stageName) (\s :: PutActionRevision
s@PutActionRevision' {} Text
a -> PutActionRevision
s {$sel:stageName:PutActionRevision' :: Text
stageName = Text
a} :: PutActionRevision)

-- | The name of the action that processes the revision.
putActionRevision_actionName :: Lens.Lens' PutActionRevision Prelude.Text
putActionRevision_actionName :: Lens' PutActionRevision Text
putActionRevision_actionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutActionRevision' {Text
actionName :: Text
$sel:actionName:PutActionRevision' :: PutActionRevision -> Text
actionName} -> Text
actionName) (\s :: PutActionRevision
s@PutActionRevision' {} Text
a -> PutActionRevision
s {$sel:actionName:PutActionRevision' :: Text
actionName = Text
a} :: PutActionRevision)

-- | Represents information about the version (or revision) of an action.
putActionRevision_actionRevision :: Lens.Lens' PutActionRevision ActionRevision
putActionRevision_actionRevision :: Lens' PutActionRevision ActionRevision
putActionRevision_actionRevision = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutActionRevision' {ActionRevision
actionRevision :: ActionRevision
$sel:actionRevision:PutActionRevision' :: PutActionRevision -> ActionRevision
actionRevision} -> ActionRevision
actionRevision) (\s :: PutActionRevision
s@PutActionRevision' {} ActionRevision
a -> PutActionRevision
s {$sel:actionRevision:PutActionRevision' :: ActionRevision
actionRevision = ActionRevision
a} :: PutActionRevision)

instance Core.AWSRequest PutActionRevision where
  type
    AWSResponse PutActionRevision =
      PutActionRevisionResponse
  request :: (Service -> Service)
-> PutActionRevision -> Request PutActionRevision
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 PutActionRevision
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutActionRevision)))
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 Bool -> Maybe Text -> Int -> PutActionRevisionResponse
PutActionRevisionResponse'
            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
"newRevision")
            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
"pipelineExecutionId")
            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 PutActionRevision where
  hashWithSalt :: Int -> PutActionRevision -> Int
hashWithSalt Int
_salt PutActionRevision' {Text
ActionRevision
actionRevision :: ActionRevision
actionName :: Text
stageName :: Text
pipelineName :: Text
$sel:actionRevision:PutActionRevision' :: PutActionRevision -> ActionRevision
$sel:actionName:PutActionRevision' :: PutActionRevision -> Text
$sel:stageName:PutActionRevision' :: PutActionRevision -> Text
$sel:pipelineName:PutActionRevision' :: PutActionRevision -> 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` Text
actionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ActionRevision
actionRevision

instance Prelude.NFData PutActionRevision where
  rnf :: PutActionRevision -> ()
rnf PutActionRevision' {Text
ActionRevision
actionRevision :: ActionRevision
actionName :: Text
stageName :: Text
pipelineName :: Text
$sel:actionRevision:PutActionRevision' :: PutActionRevision -> ActionRevision
$sel:actionName:PutActionRevision' :: PutActionRevision -> Text
$sel:stageName:PutActionRevision' :: PutActionRevision -> Text
$sel:pipelineName:PutActionRevision' :: PutActionRevision -> 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 Text
actionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ActionRevision
actionRevision

instance Data.ToHeaders PutActionRevision where
  toHeaders :: PutActionRevision -> 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
"CodePipeline_20150709.PutActionRevision" ::
                          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 PutActionRevision where
  toJSON :: PutActionRevision -> Value
toJSON PutActionRevision' {Text
ActionRevision
actionRevision :: ActionRevision
actionName :: Text
stageName :: Text
pipelineName :: Text
$sel:actionRevision:PutActionRevision' :: PutActionRevision -> ActionRevision
$sel:actionName:PutActionRevision' :: PutActionRevision -> Text
$sel:stageName:PutActionRevision' :: PutActionRevision -> Text
$sel:pipelineName:PutActionRevision' :: PutActionRevision -> 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
"actionName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
actionName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"actionRevision" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ActionRevision
actionRevision)
          ]
      )

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

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

-- | Represents the output of a @PutActionRevision@ action.
--
-- /See:/ 'newPutActionRevisionResponse' smart constructor.
data PutActionRevisionResponse = PutActionRevisionResponse'
  { -- | Indicates whether the artifact revision was previously used in an
    -- execution of the specified pipeline.
    PutActionRevisionResponse -> Maybe Bool
newRevision' :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the current workflow state of the pipeline.
    PutActionRevisionResponse -> Maybe Text
pipelineExecutionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    PutActionRevisionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutActionRevisionResponse -> PutActionRevisionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutActionRevisionResponse -> PutActionRevisionResponse -> Bool
$c/= :: PutActionRevisionResponse -> PutActionRevisionResponse -> Bool
== :: PutActionRevisionResponse -> PutActionRevisionResponse -> Bool
$c== :: PutActionRevisionResponse -> PutActionRevisionResponse -> Bool
Prelude.Eq, ReadPrec [PutActionRevisionResponse]
ReadPrec PutActionRevisionResponse
Int -> ReadS PutActionRevisionResponse
ReadS [PutActionRevisionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutActionRevisionResponse]
$creadListPrec :: ReadPrec [PutActionRevisionResponse]
readPrec :: ReadPrec PutActionRevisionResponse
$creadPrec :: ReadPrec PutActionRevisionResponse
readList :: ReadS [PutActionRevisionResponse]
$creadList :: ReadS [PutActionRevisionResponse]
readsPrec :: Int -> ReadS PutActionRevisionResponse
$creadsPrec :: Int -> ReadS PutActionRevisionResponse
Prelude.Read, Int -> PutActionRevisionResponse -> ShowS
[PutActionRevisionResponse] -> ShowS
PutActionRevisionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutActionRevisionResponse] -> ShowS
$cshowList :: [PutActionRevisionResponse] -> ShowS
show :: PutActionRevisionResponse -> String
$cshow :: PutActionRevisionResponse -> String
showsPrec :: Int -> PutActionRevisionResponse -> ShowS
$cshowsPrec :: Int -> PutActionRevisionResponse -> ShowS
Prelude.Show, forall x.
Rep PutActionRevisionResponse x -> PutActionRevisionResponse
forall x.
PutActionRevisionResponse -> Rep PutActionRevisionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutActionRevisionResponse x -> PutActionRevisionResponse
$cfrom :: forall x.
PutActionRevisionResponse -> Rep PutActionRevisionResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutActionRevisionResponse' 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:
--
-- 'newRevision'', 'putActionRevisionResponse_newRevision' - Indicates whether the artifact revision was previously used in an
-- execution of the specified pipeline.
--
-- 'pipelineExecutionId', 'putActionRevisionResponse_pipelineExecutionId' - The ID of the current workflow state of the pipeline.
--
-- 'httpStatus', 'putActionRevisionResponse_httpStatus' - The response's http status code.
newPutActionRevisionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutActionRevisionResponse
newPutActionRevisionResponse :: Int -> PutActionRevisionResponse
newPutActionRevisionResponse Int
pHttpStatus_ =
  PutActionRevisionResponse'
    { $sel:newRevision':PutActionRevisionResponse' :: Maybe Bool
newRevision' =
        forall a. Maybe a
Prelude.Nothing,
      $sel:pipelineExecutionId:PutActionRevisionResponse' :: Maybe Text
pipelineExecutionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutActionRevisionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Indicates whether the artifact revision was previously used in an
-- execution of the specified pipeline.
putActionRevisionResponse_newRevision :: Lens.Lens' PutActionRevisionResponse (Prelude.Maybe Prelude.Bool)
putActionRevisionResponse_newRevision :: Lens' PutActionRevisionResponse (Maybe Bool)
putActionRevisionResponse_newRevision = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutActionRevisionResponse' {Maybe Bool
newRevision' :: Maybe Bool
$sel:newRevision':PutActionRevisionResponse' :: PutActionRevisionResponse -> Maybe Bool
newRevision'} -> Maybe Bool
newRevision') (\s :: PutActionRevisionResponse
s@PutActionRevisionResponse' {} Maybe Bool
a -> PutActionRevisionResponse
s {$sel:newRevision':PutActionRevisionResponse' :: Maybe Bool
newRevision' = Maybe Bool
a} :: PutActionRevisionResponse)

-- | The ID of the current workflow state of the pipeline.
putActionRevisionResponse_pipelineExecutionId :: Lens.Lens' PutActionRevisionResponse (Prelude.Maybe Prelude.Text)
putActionRevisionResponse_pipelineExecutionId :: Lens' PutActionRevisionResponse (Maybe Text)
putActionRevisionResponse_pipelineExecutionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutActionRevisionResponse' {Maybe Text
pipelineExecutionId :: Maybe Text
$sel:pipelineExecutionId:PutActionRevisionResponse' :: PutActionRevisionResponse -> Maybe Text
pipelineExecutionId} -> Maybe Text
pipelineExecutionId) (\s :: PutActionRevisionResponse
s@PutActionRevisionResponse' {} Maybe Text
a -> PutActionRevisionResponse
s {$sel:pipelineExecutionId:PutActionRevisionResponse' :: Maybe Text
pipelineExecutionId = Maybe Text
a} :: PutActionRevisionResponse)

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

instance Prelude.NFData PutActionRevisionResponse where
  rnf :: PutActionRevisionResponse -> ()
rnf PutActionRevisionResponse' {Int
Maybe Bool
Maybe Text
httpStatus :: Int
pipelineExecutionId :: Maybe Text
newRevision' :: Maybe Bool
$sel:httpStatus:PutActionRevisionResponse' :: PutActionRevisionResponse -> Int
$sel:pipelineExecutionId:PutActionRevisionResponse' :: PutActionRevisionResponse -> Maybe Text
$sel:newRevision':PutActionRevisionResponse' :: PutActionRevisionResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
newRevision'
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pipelineExecutionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus