{-# 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.GetActionType
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns information about an action type created for an external
-- provider, where the action is to be used by customers of the external
-- provider. The action can be created with any supported integration
-- model.
module Amazonka.CodePipeline.GetActionType
  ( -- * Creating a Request
    GetActionType (..),
    newGetActionType,

    -- * Request Lenses
    getActionType_category,
    getActionType_owner,
    getActionType_provider,
    getActionType_version,

    -- * Destructuring the Response
    GetActionTypeResponse (..),
    newGetActionTypeResponse,

    -- * Response Lenses
    getActionTypeResponse_actionType,
    getActionTypeResponse_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

-- | /See:/ 'newGetActionType' smart constructor.
data GetActionType = GetActionType'
  { -- | Defines what kind of action can be taken in the stage. The following are
    -- the valid values:
    --
    -- -   @Source@
    --
    -- -   @Build@
    --
    -- -   @Test@
    --
    -- -   @Deploy@
    --
    -- -   @Approval@
    --
    -- -   @Invoke@
    GetActionType -> ActionCategory
category :: ActionCategory,
    -- | The creator of an action type that was created with any supported
    -- integration model. There are two valid values: @AWS@ and @ThirdParty@.
    GetActionType -> Text
owner :: Prelude.Text,
    -- | The provider of the action type being called. The provider name is
    -- specified when the action type is created.
    GetActionType -> Text
provider :: Prelude.Text,
    -- | A string that describes the action type version.
    GetActionType -> Text
version :: Prelude.Text
  }
  deriving (GetActionType -> GetActionType -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetActionType -> GetActionType -> Bool
$c/= :: GetActionType -> GetActionType -> Bool
== :: GetActionType -> GetActionType -> Bool
$c== :: GetActionType -> GetActionType -> Bool
Prelude.Eq, ReadPrec [GetActionType]
ReadPrec GetActionType
Int -> ReadS GetActionType
ReadS [GetActionType]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetActionType]
$creadListPrec :: ReadPrec [GetActionType]
readPrec :: ReadPrec GetActionType
$creadPrec :: ReadPrec GetActionType
readList :: ReadS [GetActionType]
$creadList :: ReadS [GetActionType]
readsPrec :: Int -> ReadS GetActionType
$creadsPrec :: Int -> ReadS GetActionType
Prelude.Read, Int -> GetActionType -> ShowS
[GetActionType] -> ShowS
GetActionType -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetActionType] -> ShowS
$cshowList :: [GetActionType] -> ShowS
show :: GetActionType -> String
$cshow :: GetActionType -> String
showsPrec :: Int -> GetActionType -> ShowS
$cshowsPrec :: Int -> GetActionType -> ShowS
Prelude.Show, forall x. Rep GetActionType x -> GetActionType
forall x. GetActionType -> Rep GetActionType x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetActionType x -> GetActionType
$cfrom :: forall x. GetActionType -> Rep GetActionType x
Prelude.Generic)

-- |
-- Create a value of 'GetActionType' 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:
--
-- 'category', 'getActionType_category' - Defines what kind of action can be taken in the stage. The following are
-- the valid values:
--
-- -   @Source@
--
-- -   @Build@
--
-- -   @Test@
--
-- -   @Deploy@
--
-- -   @Approval@
--
-- -   @Invoke@
--
-- 'owner', 'getActionType_owner' - The creator of an action type that was created with any supported
-- integration model. There are two valid values: @AWS@ and @ThirdParty@.
--
-- 'provider', 'getActionType_provider' - The provider of the action type being called. The provider name is
-- specified when the action type is created.
--
-- 'version', 'getActionType_version' - A string that describes the action type version.
newGetActionType ::
  -- | 'category'
  ActionCategory ->
  -- | 'owner'
  Prelude.Text ->
  -- | 'provider'
  Prelude.Text ->
  -- | 'version'
  Prelude.Text ->
  GetActionType
newGetActionType :: ActionCategory -> Text -> Text -> Text -> GetActionType
newGetActionType
  ActionCategory
pCategory_
  Text
pOwner_
  Text
pProvider_
  Text
pVersion_ =
    GetActionType'
      { $sel:category:GetActionType' :: ActionCategory
category = ActionCategory
pCategory_,
        $sel:owner:GetActionType' :: Text
owner = Text
pOwner_,
        $sel:provider:GetActionType' :: Text
provider = Text
pProvider_,
        $sel:version:GetActionType' :: Text
version = Text
pVersion_
      }

-- | Defines what kind of action can be taken in the stage. The following are
-- the valid values:
--
-- -   @Source@
--
-- -   @Build@
--
-- -   @Test@
--
-- -   @Deploy@
--
-- -   @Approval@
--
-- -   @Invoke@
getActionType_category :: Lens.Lens' GetActionType ActionCategory
getActionType_category :: Lens' GetActionType ActionCategory
getActionType_category = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetActionType' {ActionCategory
category :: ActionCategory
$sel:category:GetActionType' :: GetActionType -> ActionCategory
category} -> ActionCategory
category) (\s :: GetActionType
s@GetActionType' {} ActionCategory
a -> GetActionType
s {$sel:category:GetActionType' :: ActionCategory
category = ActionCategory
a} :: GetActionType)

-- | The creator of an action type that was created with any supported
-- integration model. There are two valid values: @AWS@ and @ThirdParty@.
getActionType_owner :: Lens.Lens' GetActionType Prelude.Text
getActionType_owner :: Lens' GetActionType Text
getActionType_owner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetActionType' {Text
owner :: Text
$sel:owner:GetActionType' :: GetActionType -> Text
owner} -> Text
owner) (\s :: GetActionType
s@GetActionType' {} Text
a -> GetActionType
s {$sel:owner:GetActionType' :: Text
owner = Text
a} :: GetActionType)

-- | The provider of the action type being called. The provider name is
-- specified when the action type is created.
getActionType_provider :: Lens.Lens' GetActionType Prelude.Text
getActionType_provider :: Lens' GetActionType Text
getActionType_provider = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetActionType' {Text
provider :: Text
$sel:provider:GetActionType' :: GetActionType -> Text
provider} -> Text
provider) (\s :: GetActionType
s@GetActionType' {} Text
a -> GetActionType
s {$sel:provider:GetActionType' :: Text
provider = Text
a} :: GetActionType)

-- | A string that describes the action type version.
getActionType_version :: Lens.Lens' GetActionType Prelude.Text
getActionType_version :: Lens' GetActionType Text
getActionType_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetActionType' {Text
version :: Text
$sel:version:GetActionType' :: GetActionType -> Text
version} -> Text
version) (\s :: GetActionType
s@GetActionType' {} Text
a -> GetActionType
s {$sel:version:GetActionType' :: Text
version = Text
a} :: GetActionType)

instance Core.AWSRequest GetActionType where
  type
    AWSResponse GetActionType =
      GetActionTypeResponse
  request :: (Service -> Service) -> GetActionType -> Request GetActionType
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 GetActionType
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetActionType)))
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 ActionTypeDeclaration -> Int -> GetActionTypeResponse
GetActionTypeResponse'
            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
"actionType")
            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 GetActionType where
  hashWithSalt :: Int -> GetActionType -> Int
hashWithSalt Int
_salt GetActionType' {Text
ActionCategory
version :: Text
provider :: Text
owner :: Text
category :: ActionCategory
$sel:version:GetActionType' :: GetActionType -> Text
$sel:provider:GetActionType' :: GetActionType -> Text
$sel:owner:GetActionType' :: GetActionType -> Text
$sel:category:GetActionType' :: GetActionType -> ActionCategory
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ActionCategory
category
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
owner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
provider
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
version

instance Prelude.NFData GetActionType where
  rnf :: GetActionType -> ()
rnf GetActionType' {Text
ActionCategory
version :: Text
provider :: Text
owner :: Text
category :: ActionCategory
$sel:version:GetActionType' :: GetActionType -> Text
$sel:provider:GetActionType' :: GetActionType -> Text
$sel:owner:GetActionType' :: GetActionType -> Text
$sel:category:GetActionType' :: GetActionType -> ActionCategory
..} =
    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
owner
      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

instance Data.ToHeaders GetActionType where
  toHeaders :: GetActionType -> 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.GetActionType" ::
                          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 GetActionType where
  toJSON :: GetActionType -> Value
toJSON GetActionType' {Text
ActionCategory
version :: Text
provider :: Text
owner :: Text
category :: ActionCategory
$sel:version:GetActionType' :: GetActionType -> Text
$sel:provider:GetActionType' :: GetActionType -> Text
$sel:owner:GetActionType' :: GetActionType -> Text
$sel:category:GetActionType' :: GetActionType -> ActionCategory
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ 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
"owner" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
owner),
            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)
          ]
      )

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

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

-- | /See:/ 'newGetActionTypeResponse' smart constructor.
data GetActionTypeResponse = GetActionTypeResponse'
  { -- | The action type information for the requested action type, such as the
    -- action type ID.
    GetActionTypeResponse -> Maybe ActionTypeDeclaration
actionType :: Prelude.Maybe ActionTypeDeclaration,
    -- | The response's http status code.
    GetActionTypeResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetActionTypeResponse -> GetActionTypeResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetActionTypeResponse -> GetActionTypeResponse -> Bool
$c/= :: GetActionTypeResponse -> GetActionTypeResponse -> Bool
== :: GetActionTypeResponse -> GetActionTypeResponse -> Bool
$c== :: GetActionTypeResponse -> GetActionTypeResponse -> Bool
Prelude.Eq, ReadPrec [GetActionTypeResponse]
ReadPrec GetActionTypeResponse
Int -> ReadS GetActionTypeResponse
ReadS [GetActionTypeResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetActionTypeResponse]
$creadListPrec :: ReadPrec [GetActionTypeResponse]
readPrec :: ReadPrec GetActionTypeResponse
$creadPrec :: ReadPrec GetActionTypeResponse
readList :: ReadS [GetActionTypeResponse]
$creadList :: ReadS [GetActionTypeResponse]
readsPrec :: Int -> ReadS GetActionTypeResponse
$creadsPrec :: Int -> ReadS GetActionTypeResponse
Prelude.Read, Int -> GetActionTypeResponse -> ShowS
[GetActionTypeResponse] -> ShowS
GetActionTypeResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetActionTypeResponse] -> ShowS
$cshowList :: [GetActionTypeResponse] -> ShowS
show :: GetActionTypeResponse -> String
$cshow :: GetActionTypeResponse -> String
showsPrec :: Int -> GetActionTypeResponse -> ShowS
$cshowsPrec :: Int -> GetActionTypeResponse -> ShowS
Prelude.Show, forall x. Rep GetActionTypeResponse x -> GetActionTypeResponse
forall x. GetActionTypeResponse -> Rep GetActionTypeResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetActionTypeResponse x -> GetActionTypeResponse
$cfrom :: forall x. GetActionTypeResponse -> Rep GetActionTypeResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetActionTypeResponse' 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', 'getActionTypeResponse_actionType' - The action type information for the requested action type, such as the
-- action type ID.
--
-- 'httpStatus', 'getActionTypeResponse_httpStatus' - The response's http status code.
newGetActionTypeResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetActionTypeResponse
newGetActionTypeResponse :: Int -> GetActionTypeResponse
newGetActionTypeResponse Int
pHttpStatus_ =
  GetActionTypeResponse'
    { $sel:actionType:GetActionTypeResponse' :: Maybe ActionTypeDeclaration
actionType =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetActionTypeResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The action type information for the requested action type, such as the
-- action type ID.
getActionTypeResponse_actionType :: Lens.Lens' GetActionTypeResponse (Prelude.Maybe ActionTypeDeclaration)
getActionTypeResponse_actionType :: Lens' GetActionTypeResponse (Maybe ActionTypeDeclaration)
getActionTypeResponse_actionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetActionTypeResponse' {Maybe ActionTypeDeclaration
actionType :: Maybe ActionTypeDeclaration
$sel:actionType:GetActionTypeResponse' :: GetActionTypeResponse -> Maybe ActionTypeDeclaration
actionType} -> Maybe ActionTypeDeclaration
actionType) (\s :: GetActionTypeResponse
s@GetActionTypeResponse' {} Maybe ActionTypeDeclaration
a -> GetActionTypeResponse
s {$sel:actionType:GetActionTypeResponse' :: Maybe ActionTypeDeclaration
actionType = Maybe ActionTypeDeclaration
a} :: GetActionTypeResponse)

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

instance Prelude.NFData GetActionTypeResponse where
  rnf :: GetActionTypeResponse -> ()
rnf GetActionTypeResponse' {Int
Maybe ActionTypeDeclaration
httpStatus :: Int
actionType :: Maybe ActionTypeDeclaration
$sel:httpStatus:GetActionTypeResponse' :: GetActionTypeResponse -> Int
$sel:actionType:GetActionTypeResponse' :: GetActionTypeResponse -> Maybe ActionTypeDeclaration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ActionTypeDeclaration
actionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus