{-# 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.ServiceCatalog.CreateServiceAction
-- 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 self-service action.
module Amazonka.ServiceCatalog.CreateServiceAction
  ( -- * Creating a Request
    CreateServiceAction (..),
    newCreateServiceAction,

    -- * Request Lenses
    createServiceAction_acceptLanguage,
    createServiceAction_description,
    createServiceAction_name,
    createServiceAction_definitionType,
    createServiceAction_definition,
    createServiceAction_idempotencyToken,

    -- * Destructuring the Response
    CreateServiceActionResponse (..),
    newCreateServiceActionResponse,

    -- * Response Lenses
    createServiceActionResponse_serviceActionDetail,
    createServiceActionResponse_httpStatus,
  )
where

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
import Amazonka.ServiceCatalog.Types

-- | /See:/ 'newCreateServiceAction' smart constructor.
data CreateServiceAction = CreateServiceAction'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    CreateServiceAction -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | The self-service action description.
    CreateServiceAction -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The self-service action name.
    CreateServiceAction -> Text
name :: Prelude.Text,
    -- | The service action definition type. For example, @SSM_AUTOMATION@.
    CreateServiceAction -> ServiceActionDefinitionType
definitionType :: ServiceActionDefinitionType,
    -- | The self-service action definition. Can be one of the following:
    --
    -- [Name]
    --     The name of the Amazon Web Services Systems Manager document (SSM
    --     document). For example, @AWS-RestartEC2Instance@.
    --
    --     If you are using a shared SSM document, you must provide the ARN
    --     instead of the name.
    --
    -- [Version]
    --     The Amazon Web Services Systems Manager automation document version.
    --     For example, @\"Version\": \"1\"@
    --
    -- [AssumeRole]
    --     The Amazon Resource Name (ARN) of the role that performs the
    --     self-service actions on your behalf. For example,
    --     @\"AssumeRole\": \"arn:aws:iam::12345678910:role\/ActionRole\"@.
    --
    --     To reuse the provisioned product launch role, set to
    --     @\"AssumeRole\": \"LAUNCH_ROLE\"@.
    --
    -- [Parameters]
    --     The list of parameters in JSON format.
    --
    --     For example:
    --     @[{\\\"Name\\\":\\\"InstanceId\\\",\\\"Type\\\":\\\"TARGET\\\"}]@ or
    --     @[{\\\"Name\\\":\\\"InstanceId\\\",\\\"Type\\\":\\\"TEXT_VALUE\\\"}]@.
    CreateServiceAction -> HashMap ServiceActionDefinitionKey Text
definition :: Prelude.HashMap ServiceActionDefinitionKey Prelude.Text,
    -- | A unique identifier that you provide to ensure idempotency. If multiple
    -- requests differ only by the idempotency token, the same response is
    -- returned for each repeated request.
    CreateServiceAction -> Text
idempotencyToken :: Prelude.Text
  }
  deriving (CreateServiceAction -> CreateServiceAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateServiceAction -> CreateServiceAction -> Bool
$c/= :: CreateServiceAction -> CreateServiceAction -> Bool
== :: CreateServiceAction -> CreateServiceAction -> Bool
$c== :: CreateServiceAction -> CreateServiceAction -> Bool
Prelude.Eq, ReadPrec [CreateServiceAction]
ReadPrec CreateServiceAction
Int -> ReadS CreateServiceAction
ReadS [CreateServiceAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateServiceAction]
$creadListPrec :: ReadPrec [CreateServiceAction]
readPrec :: ReadPrec CreateServiceAction
$creadPrec :: ReadPrec CreateServiceAction
readList :: ReadS [CreateServiceAction]
$creadList :: ReadS [CreateServiceAction]
readsPrec :: Int -> ReadS CreateServiceAction
$creadsPrec :: Int -> ReadS CreateServiceAction
Prelude.Read, Int -> CreateServiceAction -> ShowS
[CreateServiceAction] -> ShowS
CreateServiceAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateServiceAction] -> ShowS
$cshowList :: [CreateServiceAction] -> ShowS
show :: CreateServiceAction -> String
$cshow :: CreateServiceAction -> String
showsPrec :: Int -> CreateServiceAction -> ShowS
$cshowsPrec :: Int -> CreateServiceAction -> ShowS
Prelude.Show, forall x. Rep CreateServiceAction x -> CreateServiceAction
forall x. CreateServiceAction -> Rep CreateServiceAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateServiceAction x -> CreateServiceAction
$cfrom :: forall x. CreateServiceAction -> Rep CreateServiceAction x
Prelude.Generic)

-- |
-- Create a value of 'CreateServiceAction' 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:
--
-- 'acceptLanguage', 'createServiceAction_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'description', 'createServiceAction_description' - The self-service action description.
--
-- 'name', 'createServiceAction_name' - The self-service action name.
--
-- 'definitionType', 'createServiceAction_definitionType' - The service action definition type. For example, @SSM_AUTOMATION@.
--
-- 'definition', 'createServiceAction_definition' - The self-service action definition. Can be one of the following:
--
-- [Name]
--     The name of the Amazon Web Services Systems Manager document (SSM
--     document). For example, @AWS-RestartEC2Instance@.
--
--     If you are using a shared SSM document, you must provide the ARN
--     instead of the name.
--
-- [Version]
--     The Amazon Web Services Systems Manager automation document version.
--     For example, @\"Version\": \"1\"@
--
-- [AssumeRole]
--     The Amazon Resource Name (ARN) of the role that performs the
--     self-service actions on your behalf. For example,
--     @\"AssumeRole\": \"arn:aws:iam::12345678910:role\/ActionRole\"@.
--
--     To reuse the provisioned product launch role, set to
--     @\"AssumeRole\": \"LAUNCH_ROLE\"@.
--
-- [Parameters]
--     The list of parameters in JSON format.
--
--     For example:
--     @[{\\\"Name\\\":\\\"InstanceId\\\",\\\"Type\\\":\\\"TARGET\\\"}]@ or
--     @[{\\\"Name\\\":\\\"InstanceId\\\",\\\"Type\\\":\\\"TEXT_VALUE\\\"}]@.
--
-- 'idempotencyToken', 'createServiceAction_idempotencyToken' - A unique identifier that you provide to ensure idempotency. If multiple
-- requests differ only by the idempotency token, the same response is
-- returned for each repeated request.
newCreateServiceAction ::
  -- | 'name'
  Prelude.Text ->
  -- | 'definitionType'
  ServiceActionDefinitionType ->
  -- | 'idempotencyToken'
  Prelude.Text ->
  CreateServiceAction
newCreateServiceAction :: Text -> ServiceActionDefinitionType -> Text -> CreateServiceAction
newCreateServiceAction
  Text
pName_
  ServiceActionDefinitionType
pDefinitionType_
  Text
pIdempotencyToken_ =
    CreateServiceAction'
      { $sel:acceptLanguage:CreateServiceAction' :: Maybe Text
acceptLanguage =
          forall a. Maybe a
Prelude.Nothing,
        $sel:description:CreateServiceAction' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateServiceAction' :: Text
name = Text
pName_,
        $sel:definitionType:CreateServiceAction' :: ServiceActionDefinitionType
definitionType = ServiceActionDefinitionType
pDefinitionType_,
        $sel:definition:CreateServiceAction' :: HashMap ServiceActionDefinitionKey Text
definition = forall a. Monoid a => a
Prelude.mempty,
        $sel:idempotencyToken:CreateServiceAction' :: Text
idempotencyToken = Text
pIdempotencyToken_
      }

-- | The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
createServiceAction_acceptLanguage :: Lens.Lens' CreateServiceAction (Prelude.Maybe Prelude.Text)
createServiceAction_acceptLanguage :: Lens' CreateServiceAction (Maybe Text)
createServiceAction_acceptLanguage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateServiceAction' {Maybe Text
acceptLanguage :: Maybe Text
$sel:acceptLanguage:CreateServiceAction' :: CreateServiceAction -> Maybe Text
acceptLanguage} -> Maybe Text
acceptLanguage) (\s :: CreateServiceAction
s@CreateServiceAction' {} Maybe Text
a -> CreateServiceAction
s {$sel:acceptLanguage:CreateServiceAction' :: Maybe Text
acceptLanguage = Maybe Text
a} :: CreateServiceAction)

-- | The self-service action description.
createServiceAction_description :: Lens.Lens' CreateServiceAction (Prelude.Maybe Prelude.Text)
createServiceAction_description :: Lens' CreateServiceAction (Maybe Text)
createServiceAction_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateServiceAction' {Maybe Text
description :: Maybe Text
$sel:description:CreateServiceAction' :: CreateServiceAction -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateServiceAction
s@CreateServiceAction' {} Maybe Text
a -> CreateServiceAction
s {$sel:description:CreateServiceAction' :: Maybe Text
description = Maybe Text
a} :: CreateServiceAction)

-- | The self-service action name.
createServiceAction_name :: Lens.Lens' CreateServiceAction Prelude.Text
createServiceAction_name :: Lens' CreateServiceAction Text
createServiceAction_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateServiceAction' {Text
name :: Text
$sel:name:CreateServiceAction' :: CreateServiceAction -> Text
name} -> Text
name) (\s :: CreateServiceAction
s@CreateServiceAction' {} Text
a -> CreateServiceAction
s {$sel:name:CreateServiceAction' :: Text
name = Text
a} :: CreateServiceAction)

-- | The service action definition type. For example, @SSM_AUTOMATION@.
createServiceAction_definitionType :: Lens.Lens' CreateServiceAction ServiceActionDefinitionType
createServiceAction_definitionType :: Lens' CreateServiceAction ServiceActionDefinitionType
createServiceAction_definitionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateServiceAction' {ServiceActionDefinitionType
definitionType :: ServiceActionDefinitionType
$sel:definitionType:CreateServiceAction' :: CreateServiceAction -> ServiceActionDefinitionType
definitionType} -> ServiceActionDefinitionType
definitionType) (\s :: CreateServiceAction
s@CreateServiceAction' {} ServiceActionDefinitionType
a -> CreateServiceAction
s {$sel:definitionType:CreateServiceAction' :: ServiceActionDefinitionType
definitionType = ServiceActionDefinitionType
a} :: CreateServiceAction)

-- | The self-service action definition. Can be one of the following:
--
-- [Name]
--     The name of the Amazon Web Services Systems Manager document (SSM
--     document). For example, @AWS-RestartEC2Instance@.
--
--     If you are using a shared SSM document, you must provide the ARN
--     instead of the name.
--
-- [Version]
--     The Amazon Web Services Systems Manager automation document version.
--     For example, @\"Version\": \"1\"@
--
-- [AssumeRole]
--     The Amazon Resource Name (ARN) of the role that performs the
--     self-service actions on your behalf. For example,
--     @\"AssumeRole\": \"arn:aws:iam::12345678910:role\/ActionRole\"@.
--
--     To reuse the provisioned product launch role, set to
--     @\"AssumeRole\": \"LAUNCH_ROLE\"@.
--
-- [Parameters]
--     The list of parameters in JSON format.
--
--     For example:
--     @[{\\\"Name\\\":\\\"InstanceId\\\",\\\"Type\\\":\\\"TARGET\\\"}]@ or
--     @[{\\\"Name\\\":\\\"InstanceId\\\",\\\"Type\\\":\\\"TEXT_VALUE\\\"}]@.
createServiceAction_definition :: Lens.Lens' CreateServiceAction (Prelude.HashMap ServiceActionDefinitionKey Prelude.Text)
createServiceAction_definition :: Lens' CreateServiceAction (HashMap ServiceActionDefinitionKey Text)
createServiceAction_definition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateServiceAction' {HashMap ServiceActionDefinitionKey Text
definition :: HashMap ServiceActionDefinitionKey Text
$sel:definition:CreateServiceAction' :: CreateServiceAction -> HashMap ServiceActionDefinitionKey Text
definition} -> HashMap ServiceActionDefinitionKey Text
definition) (\s :: CreateServiceAction
s@CreateServiceAction' {} HashMap ServiceActionDefinitionKey Text
a -> CreateServiceAction
s {$sel:definition:CreateServiceAction' :: HashMap ServiceActionDefinitionKey Text
definition = HashMap ServiceActionDefinitionKey Text
a} :: CreateServiceAction) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A unique identifier that you provide to ensure idempotency. If multiple
-- requests differ only by the idempotency token, the same response is
-- returned for each repeated request.
createServiceAction_idempotencyToken :: Lens.Lens' CreateServiceAction Prelude.Text
createServiceAction_idempotencyToken :: Lens' CreateServiceAction Text
createServiceAction_idempotencyToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateServiceAction' {Text
idempotencyToken :: Text
$sel:idempotencyToken:CreateServiceAction' :: CreateServiceAction -> Text
idempotencyToken} -> Text
idempotencyToken) (\s :: CreateServiceAction
s@CreateServiceAction' {} Text
a -> CreateServiceAction
s {$sel:idempotencyToken:CreateServiceAction' :: Text
idempotencyToken = Text
a} :: CreateServiceAction)

instance Core.AWSRequest CreateServiceAction where
  type
    AWSResponse CreateServiceAction =
      CreateServiceActionResponse
  request :: (Service -> Service)
-> CreateServiceAction -> Request CreateServiceAction
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 CreateServiceAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateServiceAction)))
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 ServiceActionDetail -> Int -> CreateServiceActionResponse
CreateServiceActionResponse'
            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
"ServiceActionDetail")
            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 CreateServiceAction where
  hashWithSalt :: Int -> CreateServiceAction -> Int
hashWithSalt Int
_salt CreateServiceAction' {Maybe Text
Text
HashMap ServiceActionDefinitionKey Text
ServiceActionDefinitionType
idempotencyToken :: Text
definition :: HashMap ServiceActionDefinitionKey Text
definitionType :: ServiceActionDefinitionType
name :: Text
description :: Maybe Text
acceptLanguage :: Maybe Text
$sel:idempotencyToken:CreateServiceAction' :: CreateServiceAction -> Text
$sel:definition:CreateServiceAction' :: CreateServiceAction -> HashMap ServiceActionDefinitionKey Text
$sel:definitionType:CreateServiceAction' :: CreateServiceAction -> ServiceActionDefinitionType
$sel:name:CreateServiceAction' :: CreateServiceAction -> Text
$sel:description:CreateServiceAction' :: CreateServiceAction -> Maybe Text
$sel:acceptLanguage:CreateServiceAction' :: CreateServiceAction -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
acceptLanguage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ServiceActionDefinitionType
definitionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` HashMap ServiceActionDefinitionKey Text
definition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
idempotencyToken

instance Prelude.NFData CreateServiceAction where
  rnf :: CreateServiceAction -> ()
rnf CreateServiceAction' {Maybe Text
Text
HashMap ServiceActionDefinitionKey Text
ServiceActionDefinitionType
idempotencyToken :: Text
definition :: HashMap ServiceActionDefinitionKey Text
definitionType :: ServiceActionDefinitionType
name :: Text
description :: Maybe Text
acceptLanguage :: Maybe Text
$sel:idempotencyToken:CreateServiceAction' :: CreateServiceAction -> Text
$sel:definition:CreateServiceAction' :: CreateServiceAction -> HashMap ServiceActionDefinitionKey Text
$sel:definitionType:CreateServiceAction' :: CreateServiceAction -> ServiceActionDefinitionType
$sel:name:CreateServiceAction' :: CreateServiceAction -> Text
$sel:description:CreateServiceAction' :: CreateServiceAction -> Maybe Text
$sel:acceptLanguage:CreateServiceAction' :: CreateServiceAction -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
acceptLanguage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ServiceActionDefinitionType
definitionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf HashMap ServiceActionDefinitionKey Text
definition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
idempotencyToken

instance Data.ToHeaders CreateServiceAction where
  toHeaders :: CreateServiceAction -> 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
"AWS242ServiceCatalogService.CreateServiceAction" ::
                          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 CreateServiceAction where
  toJSON :: CreateServiceAction -> Value
toJSON CreateServiceAction' {Maybe Text
Text
HashMap ServiceActionDefinitionKey Text
ServiceActionDefinitionType
idempotencyToken :: Text
definition :: HashMap ServiceActionDefinitionKey Text
definitionType :: ServiceActionDefinitionType
name :: Text
description :: Maybe Text
acceptLanguage :: Maybe Text
$sel:idempotencyToken:CreateServiceAction' :: CreateServiceAction -> Text
$sel:definition:CreateServiceAction' :: CreateServiceAction -> HashMap ServiceActionDefinitionKey Text
$sel:definitionType:CreateServiceAction' :: CreateServiceAction -> ServiceActionDefinitionType
$sel:name:CreateServiceAction' :: CreateServiceAction -> Text
$sel:description:CreateServiceAction' :: CreateServiceAction -> Maybe Text
$sel:acceptLanguage:CreateServiceAction' :: CreateServiceAction -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AcceptLanguage" 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 Text
acceptLanguage,
            (Key
"Description" 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 Text
description,
            forall a. a -> Maybe a
Prelude.Just (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
name),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"DefinitionType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= ServiceActionDefinitionType
definitionType),
            forall a. a -> Maybe a
Prelude.Just (Key
"Definition" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= HashMap ServiceActionDefinitionKey Text
definition),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"IdempotencyToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
idempotencyToken)
          ]
      )

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

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

-- | /See:/ 'newCreateServiceActionResponse' smart constructor.
data CreateServiceActionResponse = CreateServiceActionResponse'
  { -- | An object containing information about the self-service action.
    CreateServiceActionResponse -> Maybe ServiceActionDetail
serviceActionDetail :: Prelude.Maybe ServiceActionDetail,
    -- | The response's http status code.
    CreateServiceActionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateServiceActionResponse -> CreateServiceActionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateServiceActionResponse -> CreateServiceActionResponse -> Bool
$c/= :: CreateServiceActionResponse -> CreateServiceActionResponse -> Bool
== :: CreateServiceActionResponse -> CreateServiceActionResponse -> Bool
$c== :: CreateServiceActionResponse -> CreateServiceActionResponse -> Bool
Prelude.Eq, ReadPrec [CreateServiceActionResponse]
ReadPrec CreateServiceActionResponse
Int -> ReadS CreateServiceActionResponse
ReadS [CreateServiceActionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateServiceActionResponse]
$creadListPrec :: ReadPrec [CreateServiceActionResponse]
readPrec :: ReadPrec CreateServiceActionResponse
$creadPrec :: ReadPrec CreateServiceActionResponse
readList :: ReadS [CreateServiceActionResponse]
$creadList :: ReadS [CreateServiceActionResponse]
readsPrec :: Int -> ReadS CreateServiceActionResponse
$creadsPrec :: Int -> ReadS CreateServiceActionResponse
Prelude.Read, Int -> CreateServiceActionResponse -> ShowS
[CreateServiceActionResponse] -> ShowS
CreateServiceActionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateServiceActionResponse] -> ShowS
$cshowList :: [CreateServiceActionResponse] -> ShowS
show :: CreateServiceActionResponse -> String
$cshow :: CreateServiceActionResponse -> String
showsPrec :: Int -> CreateServiceActionResponse -> ShowS
$cshowsPrec :: Int -> CreateServiceActionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateServiceActionResponse x -> CreateServiceActionResponse
forall x.
CreateServiceActionResponse -> Rep CreateServiceActionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateServiceActionResponse x -> CreateServiceActionResponse
$cfrom :: forall x.
CreateServiceActionResponse -> Rep CreateServiceActionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateServiceActionResponse' 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:
--
-- 'serviceActionDetail', 'createServiceActionResponse_serviceActionDetail' - An object containing information about the self-service action.
--
-- 'httpStatus', 'createServiceActionResponse_httpStatus' - The response's http status code.
newCreateServiceActionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateServiceActionResponse
newCreateServiceActionResponse :: Int -> CreateServiceActionResponse
newCreateServiceActionResponse Int
pHttpStatus_ =
  CreateServiceActionResponse'
    { $sel:serviceActionDetail:CreateServiceActionResponse' :: Maybe ServiceActionDetail
serviceActionDetail =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateServiceActionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An object containing information about the self-service action.
createServiceActionResponse_serviceActionDetail :: Lens.Lens' CreateServiceActionResponse (Prelude.Maybe ServiceActionDetail)
createServiceActionResponse_serviceActionDetail :: Lens' CreateServiceActionResponse (Maybe ServiceActionDetail)
createServiceActionResponse_serviceActionDetail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateServiceActionResponse' {Maybe ServiceActionDetail
serviceActionDetail :: Maybe ServiceActionDetail
$sel:serviceActionDetail:CreateServiceActionResponse' :: CreateServiceActionResponse -> Maybe ServiceActionDetail
serviceActionDetail} -> Maybe ServiceActionDetail
serviceActionDetail) (\s :: CreateServiceActionResponse
s@CreateServiceActionResponse' {} Maybe ServiceActionDetail
a -> CreateServiceActionResponse
s {$sel:serviceActionDetail:CreateServiceActionResponse' :: Maybe ServiceActionDetail
serviceActionDetail = Maybe ServiceActionDetail
a} :: CreateServiceActionResponse)

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

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