{-# 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.UpdateActionType
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an action type that was created with any supported integration
-- model, where the action type is to be used by customers of the action
-- type provider. Use a JSON file with the action definition and
-- @UpdateActionType@ to provide the full structure.
module Amazonka.CodePipeline.UpdateActionType
  ( -- * Creating a Request
    UpdateActionType (..),
    newUpdateActionType,

    -- * Request Lenses
    updateActionType_actionType,

    -- * Destructuring the Response
    UpdateActionTypeResponse (..),
    newUpdateActionTypeResponse,
  )
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

-- | /See:/ 'newUpdateActionType' smart constructor.
data UpdateActionType = UpdateActionType'
  { -- | The action type definition for the action type to be updated.
    UpdateActionType -> ActionTypeDeclaration
actionType :: ActionTypeDeclaration
  }
  deriving (UpdateActionType -> UpdateActionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateActionType -> UpdateActionType -> Bool
$c/= :: UpdateActionType -> UpdateActionType -> Bool
== :: UpdateActionType -> UpdateActionType -> Bool
$c== :: UpdateActionType -> UpdateActionType -> Bool
Prelude.Eq, ReadPrec [UpdateActionType]
ReadPrec UpdateActionType
Int -> ReadS UpdateActionType
ReadS [UpdateActionType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateActionType]
$creadListPrec :: ReadPrec [UpdateActionType]
readPrec :: ReadPrec UpdateActionType
$creadPrec :: ReadPrec UpdateActionType
readList :: ReadS [UpdateActionType]
$creadList :: ReadS [UpdateActionType]
readsPrec :: Int -> ReadS UpdateActionType
$creadsPrec :: Int -> ReadS UpdateActionType
Prelude.Read, Int -> UpdateActionType -> ShowS
[UpdateActionType] -> ShowS
UpdateActionType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateActionType] -> ShowS
$cshowList :: [UpdateActionType] -> ShowS
show :: UpdateActionType -> String
$cshow :: UpdateActionType -> String
showsPrec :: Int -> UpdateActionType -> ShowS
$cshowsPrec :: Int -> UpdateActionType -> ShowS
Prelude.Show, forall x. Rep UpdateActionType x -> UpdateActionType
forall x. UpdateActionType -> Rep UpdateActionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateActionType x -> UpdateActionType
$cfrom :: forall x. UpdateActionType -> Rep UpdateActionType x
Prelude.Generic)

-- |
-- Create a value of 'UpdateActionType' 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:
--
-- 'actionType', 'updateActionType_actionType' - The action type definition for the action type to be updated.
newUpdateActionType ::
  -- | 'actionType'
  ActionTypeDeclaration ->
  UpdateActionType
newUpdateActionType :: ActionTypeDeclaration -> UpdateActionType
newUpdateActionType ActionTypeDeclaration
pActionType_ =
  UpdateActionType' {$sel:actionType:UpdateActionType' :: ActionTypeDeclaration
actionType = ActionTypeDeclaration
pActionType_}

-- | The action type definition for the action type to be updated.
updateActionType_actionType :: Lens.Lens' UpdateActionType ActionTypeDeclaration
updateActionType_actionType :: Lens' UpdateActionType ActionTypeDeclaration
updateActionType_actionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateActionType' {ActionTypeDeclaration
actionType :: ActionTypeDeclaration
$sel:actionType:UpdateActionType' :: UpdateActionType -> ActionTypeDeclaration
actionType} -> ActionTypeDeclaration
actionType) (\s :: UpdateActionType
s@UpdateActionType' {} ActionTypeDeclaration
a -> UpdateActionType
s {$sel:actionType:UpdateActionType' :: ActionTypeDeclaration
actionType = ActionTypeDeclaration
a} :: UpdateActionType)

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

instance Prelude.Hashable UpdateActionType where
  hashWithSalt :: Int -> UpdateActionType -> Int
hashWithSalt Int
_salt UpdateActionType' {ActionTypeDeclaration
actionType :: ActionTypeDeclaration
$sel:actionType:UpdateActionType' :: UpdateActionType -> ActionTypeDeclaration
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ActionTypeDeclaration
actionType

instance Prelude.NFData UpdateActionType where
  rnf :: UpdateActionType -> ()
rnf UpdateActionType' {ActionTypeDeclaration
actionType :: ActionTypeDeclaration
$sel:actionType:UpdateActionType' :: UpdateActionType -> ActionTypeDeclaration
..} = forall a. NFData a => a -> ()
Prelude.rnf ActionTypeDeclaration
actionType

instance Data.ToHeaders UpdateActionType where
  toHeaders :: UpdateActionType -> [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.UpdateActionType" ::
                          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 UpdateActionType where
  toJSON :: UpdateActionType -> Value
toJSON UpdateActionType' {ActionTypeDeclaration
actionType :: ActionTypeDeclaration
$sel:actionType:UpdateActionType' :: UpdateActionType -> ActionTypeDeclaration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"actionType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ActionTypeDeclaration
actionType)]
      )

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

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

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

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

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