{-# 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.CreateCustomActionType
-- 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 custom action that can be used in all pipelines associated
-- with the AWS account. Only used for custom actions.
module Amazonka.CodePipeline.CreateCustomActionType
  ( -- * Creating a Request
    CreateCustomActionType (..),
    newCreateCustomActionType,

    -- * Request Lenses
    createCustomActionType_configurationProperties,
    createCustomActionType_settings,
    createCustomActionType_tags,
    createCustomActionType_category,
    createCustomActionType_provider,
    createCustomActionType_version,
    createCustomActionType_inputArtifactDetails,
    createCustomActionType_outputArtifactDetails,

    -- * Destructuring the Response
    CreateCustomActionTypeResponse (..),
    newCreateCustomActionTypeResponse,

    -- * Response Lenses
    createCustomActionTypeResponse_tags,
    createCustomActionTypeResponse_httpStatus,
    createCustomActionTypeResponse_actionType,
  )
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 CreateCustomActionType operation.
--
-- /See:/ 'newCreateCustomActionType' smart constructor.
data CreateCustomActionType = CreateCustomActionType'
  { -- | The configuration properties for the custom action.
    --
    -- You can refer to a name in the configuration properties of the custom
    -- action within the URL templates by following the format of
    -- {Config:name}, as long as the configuration property is both required
    -- and not secret. For more information, see
    -- <https://docs.aws.amazon.com/codepipeline/latest/userguide/how-to-create-custom-action.html Create a Custom Action for a Pipeline>.
    CreateCustomActionType -> Maybe [ActionConfigurationProperty]
configurationProperties :: Prelude.Maybe [ActionConfigurationProperty],
    -- | URLs that provide users information about this custom action.
    CreateCustomActionType -> Maybe ActionTypeSettings
settings :: Prelude.Maybe ActionTypeSettings,
    -- | The tags for the custom action.
    CreateCustomActionType -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The category of the custom action, such as a build action or a test
    -- action.
    CreateCustomActionType -> ActionCategory
category :: ActionCategory,
    -- | The provider of the service used in the custom action, such as AWS
    -- CodeDeploy.
    CreateCustomActionType -> Text
provider :: Prelude.Text,
    -- | The version identifier of the custom action.
    CreateCustomActionType -> Text
version :: Prelude.Text,
    -- | The details of the input artifact for the action, such as its commit ID.
    CreateCustomActionType -> ArtifactDetails
inputArtifactDetails :: ArtifactDetails,
    -- | The details of the output artifact of the action, such as its commit ID.
    CreateCustomActionType -> ArtifactDetails
outputArtifactDetails :: ArtifactDetails
  }
  deriving (CreateCustomActionType -> CreateCustomActionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCustomActionType -> CreateCustomActionType -> Bool
$c/= :: CreateCustomActionType -> CreateCustomActionType -> Bool
== :: CreateCustomActionType -> CreateCustomActionType -> Bool
$c== :: CreateCustomActionType -> CreateCustomActionType -> Bool
Prelude.Eq, ReadPrec [CreateCustomActionType]
ReadPrec CreateCustomActionType
Int -> ReadS CreateCustomActionType
ReadS [CreateCustomActionType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCustomActionType]
$creadListPrec :: ReadPrec [CreateCustomActionType]
readPrec :: ReadPrec CreateCustomActionType
$creadPrec :: ReadPrec CreateCustomActionType
readList :: ReadS [CreateCustomActionType]
$creadList :: ReadS [CreateCustomActionType]
readsPrec :: Int -> ReadS CreateCustomActionType
$creadsPrec :: Int -> ReadS CreateCustomActionType
Prelude.Read, Int -> CreateCustomActionType -> ShowS
[CreateCustomActionType] -> ShowS
CreateCustomActionType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCustomActionType] -> ShowS
$cshowList :: [CreateCustomActionType] -> ShowS
show :: CreateCustomActionType -> String
$cshow :: CreateCustomActionType -> String
showsPrec :: Int -> CreateCustomActionType -> ShowS
$cshowsPrec :: Int -> CreateCustomActionType -> ShowS
Prelude.Show, forall x. Rep CreateCustomActionType x -> CreateCustomActionType
forall x. CreateCustomActionType -> Rep CreateCustomActionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateCustomActionType x -> CreateCustomActionType
$cfrom :: forall x. CreateCustomActionType -> Rep CreateCustomActionType x
Prelude.Generic)

-- |
-- Create a value of 'CreateCustomActionType' 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:
--
-- 'configurationProperties', 'createCustomActionType_configurationProperties' - The configuration properties for the custom action.
--
-- You can refer to a name in the configuration properties of the custom
-- action within the URL templates by following the format of
-- {Config:name}, as long as the configuration property is both required
-- and not secret. For more information, see
-- <https://docs.aws.amazon.com/codepipeline/latest/userguide/how-to-create-custom-action.html Create a Custom Action for a Pipeline>.
--
-- 'settings', 'createCustomActionType_settings' - URLs that provide users information about this custom action.
--
-- 'tags', 'createCustomActionType_tags' - The tags for the custom action.
--
-- 'category', 'createCustomActionType_category' - The category of the custom action, such as a build action or a test
-- action.
--
-- 'provider', 'createCustomActionType_provider' - The provider of the service used in the custom action, such as AWS
-- CodeDeploy.
--
-- 'version', 'createCustomActionType_version' - The version identifier of the custom action.
--
-- 'inputArtifactDetails', 'createCustomActionType_inputArtifactDetails' - The details of the input artifact for the action, such as its commit ID.
--
-- 'outputArtifactDetails', 'createCustomActionType_outputArtifactDetails' - The details of the output artifact of the action, such as its commit ID.
newCreateCustomActionType ::
  -- | 'category'
  ActionCategory ->
  -- | 'provider'
  Prelude.Text ->
  -- | 'version'
  Prelude.Text ->
  -- | 'inputArtifactDetails'
  ArtifactDetails ->
  -- | 'outputArtifactDetails'
  ArtifactDetails ->
  CreateCustomActionType
newCreateCustomActionType :: ActionCategory
-> Text
-> Text
-> ArtifactDetails
-> ArtifactDetails
-> CreateCustomActionType
newCreateCustomActionType
  ActionCategory
pCategory_
  Text
pProvider_
  Text
pVersion_
  ArtifactDetails
pInputArtifactDetails_
  ArtifactDetails
pOutputArtifactDetails_ =
    CreateCustomActionType'
      { $sel:configurationProperties:CreateCustomActionType' :: Maybe [ActionConfigurationProperty]
configurationProperties =
          forall a. Maybe a
Prelude.Nothing,
        $sel:settings:CreateCustomActionType' :: Maybe ActionTypeSettings
settings = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreateCustomActionType' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:category:CreateCustomActionType' :: ActionCategory
category = ActionCategory
pCategory_,
        $sel:provider:CreateCustomActionType' :: Text
provider = Text
pProvider_,
        $sel:version:CreateCustomActionType' :: Text
version = Text
pVersion_,
        $sel:inputArtifactDetails:CreateCustomActionType' :: ArtifactDetails
inputArtifactDetails = ArtifactDetails
pInputArtifactDetails_,
        $sel:outputArtifactDetails:CreateCustomActionType' :: ArtifactDetails
outputArtifactDetails = ArtifactDetails
pOutputArtifactDetails_
      }

-- | The configuration properties for the custom action.
--
-- You can refer to a name in the configuration properties of the custom
-- action within the URL templates by following the format of
-- {Config:name}, as long as the configuration property is both required
-- and not secret. For more information, see
-- <https://docs.aws.amazon.com/codepipeline/latest/userguide/how-to-create-custom-action.html Create a Custom Action for a Pipeline>.
createCustomActionType_configurationProperties :: Lens.Lens' CreateCustomActionType (Prelude.Maybe [ActionConfigurationProperty])
createCustomActionType_configurationProperties :: Lens' CreateCustomActionType (Maybe [ActionConfigurationProperty])
createCustomActionType_configurationProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomActionType' {Maybe [ActionConfigurationProperty]
configurationProperties :: Maybe [ActionConfigurationProperty]
$sel:configurationProperties:CreateCustomActionType' :: CreateCustomActionType -> Maybe [ActionConfigurationProperty]
configurationProperties} -> Maybe [ActionConfigurationProperty]
configurationProperties) (\s :: CreateCustomActionType
s@CreateCustomActionType' {} Maybe [ActionConfigurationProperty]
a -> CreateCustomActionType
s {$sel:configurationProperties:CreateCustomActionType' :: Maybe [ActionConfigurationProperty]
configurationProperties = Maybe [ActionConfigurationProperty]
a} :: CreateCustomActionType) 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

-- | URLs that provide users information about this custom action.
createCustomActionType_settings :: Lens.Lens' CreateCustomActionType (Prelude.Maybe ActionTypeSettings)
createCustomActionType_settings :: Lens' CreateCustomActionType (Maybe ActionTypeSettings)
createCustomActionType_settings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomActionType' {Maybe ActionTypeSettings
settings :: Maybe ActionTypeSettings
$sel:settings:CreateCustomActionType' :: CreateCustomActionType -> Maybe ActionTypeSettings
settings} -> Maybe ActionTypeSettings
settings) (\s :: CreateCustomActionType
s@CreateCustomActionType' {} Maybe ActionTypeSettings
a -> CreateCustomActionType
s {$sel:settings:CreateCustomActionType' :: Maybe ActionTypeSettings
settings = Maybe ActionTypeSettings
a} :: CreateCustomActionType)

-- | The tags for the custom action.
createCustomActionType_tags :: Lens.Lens' CreateCustomActionType (Prelude.Maybe [Tag])
createCustomActionType_tags :: Lens' CreateCustomActionType (Maybe [Tag])
createCustomActionType_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomActionType' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateCustomActionType' :: CreateCustomActionType -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateCustomActionType
s@CreateCustomActionType' {} Maybe [Tag]
a -> CreateCustomActionType
s {$sel:tags:CreateCustomActionType' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateCustomActionType) 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 category of the custom action, such as a build action or a test
-- action.
createCustomActionType_category :: Lens.Lens' CreateCustomActionType ActionCategory
createCustomActionType_category :: Lens' CreateCustomActionType ActionCategory
createCustomActionType_category = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomActionType' {ActionCategory
category :: ActionCategory
$sel:category:CreateCustomActionType' :: CreateCustomActionType -> ActionCategory
category} -> ActionCategory
category) (\s :: CreateCustomActionType
s@CreateCustomActionType' {} ActionCategory
a -> CreateCustomActionType
s {$sel:category:CreateCustomActionType' :: ActionCategory
category = ActionCategory
a} :: CreateCustomActionType)

-- | The provider of the service used in the custom action, such as AWS
-- CodeDeploy.
createCustomActionType_provider :: Lens.Lens' CreateCustomActionType Prelude.Text
createCustomActionType_provider :: Lens' CreateCustomActionType Text
createCustomActionType_provider = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomActionType' {Text
provider :: Text
$sel:provider:CreateCustomActionType' :: CreateCustomActionType -> Text
provider} -> Text
provider) (\s :: CreateCustomActionType
s@CreateCustomActionType' {} Text
a -> CreateCustomActionType
s {$sel:provider:CreateCustomActionType' :: Text
provider = Text
a} :: CreateCustomActionType)

-- | The version identifier of the custom action.
createCustomActionType_version :: Lens.Lens' CreateCustomActionType Prelude.Text
createCustomActionType_version :: Lens' CreateCustomActionType Text
createCustomActionType_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomActionType' {Text
version :: Text
$sel:version:CreateCustomActionType' :: CreateCustomActionType -> Text
version} -> Text
version) (\s :: CreateCustomActionType
s@CreateCustomActionType' {} Text
a -> CreateCustomActionType
s {$sel:version:CreateCustomActionType' :: Text
version = Text
a} :: CreateCustomActionType)

-- | The details of the input artifact for the action, such as its commit ID.
createCustomActionType_inputArtifactDetails :: Lens.Lens' CreateCustomActionType ArtifactDetails
createCustomActionType_inputArtifactDetails :: Lens' CreateCustomActionType ArtifactDetails
createCustomActionType_inputArtifactDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomActionType' {ArtifactDetails
inputArtifactDetails :: ArtifactDetails
$sel:inputArtifactDetails:CreateCustomActionType' :: CreateCustomActionType -> ArtifactDetails
inputArtifactDetails} -> ArtifactDetails
inputArtifactDetails) (\s :: CreateCustomActionType
s@CreateCustomActionType' {} ArtifactDetails
a -> CreateCustomActionType
s {$sel:inputArtifactDetails:CreateCustomActionType' :: ArtifactDetails
inputArtifactDetails = ArtifactDetails
a} :: CreateCustomActionType)

-- | The details of the output artifact of the action, such as its commit ID.
createCustomActionType_outputArtifactDetails :: Lens.Lens' CreateCustomActionType ArtifactDetails
createCustomActionType_outputArtifactDetails :: Lens' CreateCustomActionType ArtifactDetails
createCustomActionType_outputArtifactDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomActionType' {ArtifactDetails
outputArtifactDetails :: ArtifactDetails
$sel:outputArtifactDetails:CreateCustomActionType' :: CreateCustomActionType -> ArtifactDetails
outputArtifactDetails} -> ArtifactDetails
outputArtifactDetails) (\s :: CreateCustomActionType
s@CreateCustomActionType' {} ArtifactDetails
a -> CreateCustomActionType
s {$sel:outputArtifactDetails:CreateCustomActionType' :: ArtifactDetails
outputArtifactDetails = ArtifactDetails
a} :: CreateCustomActionType)

instance Core.AWSRequest CreateCustomActionType where
  type
    AWSResponse CreateCustomActionType =
      CreateCustomActionTypeResponse
  request :: (Service -> Service)
-> CreateCustomActionType -> Request CreateCustomActionType
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 CreateCustomActionType
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateCustomActionType)))
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 [Tag] -> Int -> ActionType -> CreateCustomActionTypeResponse
CreateCustomActionTypeResponse'
            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
"tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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))
            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
"actionType")
      )

instance Prelude.Hashable CreateCustomActionType where
  hashWithSalt :: Int -> CreateCustomActionType -> Int
hashWithSalt Int
_salt CreateCustomActionType' {Maybe [ActionConfigurationProperty]
Maybe [Tag]
Maybe ActionTypeSettings
Text
ActionCategory
ArtifactDetails
outputArtifactDetails :: ArtifactDetails
inputArtifactDetails :: ArtifactDetails
version :: Text
provider :: Text
category :: ActionCategory
tags :: Maybe [Tag]
settings :: Maybe ActionTypeSettings
configurationProperties :: Maybe [ActionConfigurationProperty]
$sel:outputArtifactDetails:CreateCustomActionType' :: CreateCustomActionType -> ArtifactDetails
$sel:inputArtifactDetails:CreateCustomActionType' :: CreateCustomActionType -> ArtifactDetails
$sel:version:CreateCustomActionType' :: CreateCustomActionType -> Text
$sel:provider:CreateCustomActionType' :: CreateCustomActionType -> Text
$sel:category:CreateCustomActionType' :: CreateCustomActionType -> ActionCategory
$sel:tags:CreateCustomActionType' :: CreateCustomActionType -> Maybe [Tag]
$sel:settings:CreateCustomActionType' :: CreateCustomActionType -> Maybe ActionTypeSettings
$sel:configurationProperties:CreateCustomActionType' :: CreateCustomActionType -> Maybe [ActionConfigurationProperty]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ActionConfigurationProperty]
configurationProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ActionTypeSettings
settings
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ActionCategory
category
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
provider
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
version
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ArtifactDetails
inputArtifactDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ArtifactDetails
outputArtifactDetails

instance Prelude.NFData CreateCustomActionType where
  rnf :: CreateCustomActionType -> ()
rnf CreateCustomActionType' {Maybe [ActionConfigurationProperty]
Maybe [Tag]
Maybe ActionTypeSettings
Text
ActionCategory
ArtifactDetails
outputArtifactDetails :: ArtifactDetails
inputArtifactDetails :: ArtifactDetails
version :: Text
provider :: Text
category :: ActionCategory
tags :: Maybe [Tag]
settings :: Maybe ActionTypeSettings
configurationProperties :: Maybe [ActionConfigurationProperty]
$sel:outputArtifactDetails:CreateCustomActionType' :: CreateCustomActionType -> ArtifactDetails
$sel:inputArtifactDetails:CreateCustomActionType' :: CreateCustomActionType -> ArtifactDetails
$sel:version:CreateCustomActionType' :: CreateCustomActionType -> Text
$sel:provider:CreateCustomActionType' :: CreateCustomActionType -> Text
$sel:category:CreateCustomActionType' :: CreateCustomActionType -> ActionCategory
$sel:tags:CreateCustomActionType' :: CreateCustomActionType -> Maybe [Tag]
$sel:settings:CreateCustomActionType' :: CreateCustomActionType -> Maybe ActionTypeSettings
$sel:configurationProperties:CreateCustomActionType' :: CreateCustomActionType -> Maybe [ActionConfigurationProperty]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ActionConfigurationProperty]
configurationProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ActionTypeSettings
settings
      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 ActionCategory
category
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
provider
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
version
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ArtifactDetails
inputArtifactDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ArtifactDetails
outputArtifactDetails

instance Data.ToHeaders CreateCustomActionType where
  toHeaders :: CreateCustomActionType -> 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.CreateCustomActionType" ::
                          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 CreateCustomActionType where
  toJSON :: CreateCustomActionType -> Value
toJSON CreateCustomActionType' {Maybe [ActionConfigurationProperty]
Maybe [Tag]
Maybe ActionTypeSettings
Text
ActionCategory
ArtifactDetails
outputArtifactDetails :: ArtifactDetails
inputArtifactDetails :: ArtifactDetails
version :: Text
provider :: Text
category :: ActionCategory
tags :: Maybe [Tag]
settings :: Maybe ActionTypeSettings
configurationProperties :: Maybe [ActionConfigurationProperty]
$sel:outputArtifactDetails:CreateCustomActionType' :: CreateCustomActionType -> ArtifactDetails
$sel:inputArtifactDetails:CreateCustomActionType' :: CreateCustomActionType -> ArtifactDetails
$sel:version:CreateCustomActionType' :: CreateCustomActionType -> Text
$sel:provider:CreateCustomActionType' :: CreateCustomActionType -> Text
$sel:category:CreateCustomActionType' :: CreateCustomActionType -> ActionCategory
$sel:tags:CreateCustomActionType' :: CreateCustomActionType -> Maybe [Tag]
$sel:settings:CreateCustomActionType' :: CreateCustomActionType -> Maybe ActionTypeSettings
$sel:configurationProperties:CreateCustomActionType' :: CreateCustomActionType -> Maybe [ActionConfigurationProperty]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"configurationProperties" 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 [ActionConfigurationProperty]
configurationProperties,
            (Key
"settings" 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 ActionTypeSettings
settings,
            (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
"category" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ActionCategory
category),
            forall a. a -> Maybe a
Prelude.Just (Key
"provider" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
provider),
            forall a. a -> Maybe a
Prelude.Just (Key
"version" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
version),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"inputArtifactDetails"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ArtifactDetails
inputArtifactDetails
              ),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"outputArtifactDetails"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ArtifactDetails
outputArtifactDetails
              )
          ]
      )

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

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

-- | Represents the output of a @CreateCustomActionType@ operation.
--
-- /See:/ 'newCreateCustomActionTypeResponse' smart constructor.
data CreateCustomActionTypeResponse = CreateCustomActionTypeResponse'
  { -- | Specifies the tags applied to the custom action.
    CreateCustomActionTypeResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The response's http status code.
    CreateCustomActionTypeResponse -> Int
httpStatus :: Prelude.Int,
    -- | Returns information about the details of an action type.
    CreateCustomActionTypeResponse -> ActionType
actionType :: ActionType
  }
  deriving (CreateCustomActionTypeResponse
-> CreateCustomActionTypeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateCustomActionTypeResponse
-> CreateCustomActionTypeResponse -> Bool
$c/= :: CreateCustomActionTypeResponse
-> CreateCustomActionTypeResponse -> Bool
== :: CreateCustomActionTypeResponse
-> CreateCustomActionTypeResponse -> Bool
$c== :: CreateCustomActionTypeResponse
-> CreateCustomActionTypeResponse -> Bool
Prelude.Eq, ReadPrec [CreateCustomActionTypeResponse]
ReadPrec CreateCustomActionTypeResponse
Int -> ReadS CreateCustomActionTypeResponse
ReadS [CreateCustomActionTypeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateCustomActionTypeResponse]
$creadListPrec :: ReadPrec [CreateCustomActionTypeResponse]
readPrec :: ReadPrec CreateCustomActionTypeResponse
$creadPrec :: ReadPrec CreateCustomActionTypeResponse
readList :: ReadS [CreateCustomActionTypeResponse]
$creadList :: ReadS [CreateCustomActionTypeResponse]
readsPrec :: Int -> ReadS CreateCustomActionTypeResponse
$creadsPrec :: Int -> ReadS CreateCustomActionTypeResponse
Prelude.Read, Int -> CreateCustomActionTypeResponse -> ShowS
[CreateCustomActionTypeResponse] -> ShowS
CreateCustomActionTypeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateCustomActionTypeResponse] -> ShowS
$cshowList :: [CreateCustomActionTypeResponse] -> ShowS
show :: CreateCustomActionTypeResponse -> String
$cshow :: CreateCustomActionTypeResponse -> String
showsPrec :: Int -> CreateCustomActionTypeResponse -> ShowS
$cshowsPrec :: Int -> CreateCustomActionTypeResponse -> ShowS
Prelude.Show, forall x.
Rep CreateCustomActionTypeResponse x
-> CreateCustomActionTypeResponse
forall x.
CreateCustomActionTypeResponse
-> Rep CreateCustomActionTypeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateCustomActionTypeResponse x
-> CreateCustomActionTypeResponse
$cfrom :: forall x.
CreateCustomActionTypeResponse
-> Rep CreateCustomActionTypeResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateCustomActionTypeResponse' 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:
--
-- 'tags', 'createCustomActionTypeResponse_tags' - Specifies the tags applied to the custom action.
--
-- 'httpStatus', 'createCustomActionTypeResponse_httpStatus' - The response's http status code.
--
-- 'actionType', 'createCustomActionTypeResponse_actionType' - Returns information about the details of an action type.
newCreateCustomActionTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'actionType'
  ActionType ->
  CreateCustomActionTypeResponse
newCreateCustomActionTypeResponse :: Int -> ActionType -> CreateCustomActionTypeResponse
newCreateCustomActionTypeResponse
  Int
pHttpStatus_
  ActionType
pActionType_ =
    CreateCustomActionTypeResponse'
      { $sel:tags:CreateCustomActionTypeResponse' :: Maybe [Tag]
tags =
          forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:CreateCustomActionTypeResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:actionType:CreateCustomActionTypeResponse' :: ActionType
actionType = ActionType
pActionType_
      }

-- | Specifies the tags applied to the custom action.
createCustomActionTypeResponse_tags :: Lens.Lens' CreateCustomActionTypeResponse (Prelude.Maybe [Tag])
createCustomActionTypeResponse_tags :: Lens' CreateCustomActionTypeResponse (Maybe [Tag])
createCustomActionTypeResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomActionTypeResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:CreateCustomActionTypeResponse' :: CreateCustomActionTypeResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: CreateCustomActionTypeResponse
s@CreateCustomActionTypeResponse' {} Maybe [Tag]
a -> CreateCustomActionTypeResponse
s {$sel:tags:CreateCustomActionTypeResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: CreateCustomActionTypeResponse) 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 response's http status code.
createCustomActionTypeResponse_httpStatus :: Lens.Lens' CreateCustomActionTypeResponse Prelude.Int
createCustomActionTypeResponse_httpStatus :: Lens' CreateCustomActionTypeResponse Int
createCustomActionTypeResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomActionTypeResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateCustomActionTypeResponse' :: CreateCustomActionTypeResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateCustomActionTypeResponse
s@CreateCustomActionTypeResponse' {} Int
a -> CreateCustomActionTypeResponse
s {$sel:httpStatus:CreateCustomActionTypeResponse' :: Int
httpStatus = Int
a} :: CreateCustomActionTypeResponse)

-- | Returns information about the details of an action type.
createCustomActionTypeResponse_actionType :: Lens.Lens' CreateCustomActionTypeResponse ActionType
createCustomActionTypeResponse_actionType :: Lens' CreateCustomActionTypeResponse ActionType
createCustomActionTypeResponse_actionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateCustomActionTypeResponse' {ActionType
actionType :: ActionType
$sel:actionType:CreateCustomActionTypeResponse' :: CreateCustomActionTypeResponse -> ActionType
actionType} -> ActionType
actionType) (\s :: CreateCustomActionTypeResponse
s@CreateCustomActionTypeResponse' {} ActionType
a -> CreateCustomActionTypeResponse
s {$sel:actionType:CreateCustomActionTypeResponse' :: ActionType
actionType = ActionType
a} :: CreateCustomActionTypeResponse)

instance
  Prelude.NFData
    CreateCustomActionTypeResponse
  where
  rnf :: CreateCustomActionTypeResponse -> ()
rnf CreateCustomActionTypeResponse' {Int
Maybe [Tag]
ActionType
actionType :: ActionType
httpStatus :: Int
tags :: Maybe [Tag]
$sel:actionType:CreateCustomActionTypeResponse' :: CreateCustomActionTypeResponse -> ActionType
$sel:httpStatus:CreateCustomActionTypeResponse' :: CreateCustomActionTypeResponse -> Int
$sel:tags:CreateCustomActionTypeResponse' :: CreateCustomActionTypeResponse -> Maybe [Tag]
..} =
    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 Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ActionType
actionType