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

    -- * Request Lenses
    updateServiceAction_acceptLanguage,
    updateServiceAction_definition,
    updateServiceAction_description,
    updateServiceAction_name,
    updateServiceAction_id,

    -- * Destructuring the Response
    UpdateServiceActionResponse (..),
    newUpdateServiceActionResponse,

    -- * Response Lenses
    updateServiceActionResponse_serviceActionDetail,
    updateServiceActionResponse_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:/ 'newUpdateServiceAction' smart constructor.
data UpdateServiceAction = UpdateServiceAction'
  { -- | The language code.
    --
    -- -   @en@ - English (default)
    --
    -- -   @jp@ - Japanese
    --
    -- -   @zh@ - Chinese
    UpdateServiceAction -> Maybe Text
acceptLanguage :: Prelude.Maybe Prelude.Text,
    -- | A map that defines the self-service action.
    UpdateServiceAction
-> Maybe (HashMap ServiceActionDefinitionKey Text)
definition :: Prelude.Maybe (Prelude.HashMap ServiceActionDefinitionKey Prelude.Text),
    -- | The self-service action description.
    UpdateServiceAction -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The self-service action name.
    UpdateServiceAction -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The self-service action identifier.
    UpdateServiceAction -> Text
id :: Prelude.Text
  }
  deriving (UpdateServiceAction -> UpdateServiceAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateServiceAction -> UpdateServiceAction -> Bool
$c/= :: UpdateServiceAction -> UpdateServiceAction -> Bool
== :: UpdateServiceAction -> UpdateServiceAction -> Bool
$c== :: UpdateServiceAction -> UpdateServiceAction -> Bool
Prelude.Eq, ReadPrec [UpdateServiceAction]
ReadPrec UpdateServiceAction
Int -> ReadS UpdateServiceAction
ReadS [UpdateServiceAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateServiceAction]
$creadListPrec :: ReadPrec [UpdateServiceAction]
readPrec :: ReadPrec UpdateServiceAction
$creadPrec :: ReadPrec UpdateServiceAction
readList :: ReadS [UpdateServiceAction]
$creadList :: ReadS [UpdateServiceAction]
readsPrec :: Int -> ReadS UpdateServiceAction
$creadsPrec :: Int -> ReadS UpdateServiceAction
Prelude.Read, Int -> UpdateServiceAction -> ShowS
[UpdateServiceAction] -> ShowS
UpdateServiceAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateServiceAction] -> ShowS
$cshowList :: [UpdateServiceAction] -> ShowS
show :: UpdateServiceAction -> String
$cshow :: UpdateServiceAction -> String
showsPrec :: Int -> UpdateServiceAction -> ShowS
$cshowsPrec :: Int -> UpdateServiceAction -> ShowS
Prelude.Show, forall x. Rep UpdateServiceAction x -> UpdateServiceAction
forall x. UpdateServiceAction -> Rep UpdateServiceAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateServiceAction x -> UpdateServiceAction
$cfrom :: forall x. UpdateServiceAction -> Rep UpdateServiceAction x
Prelude.Generic)

-- |
-- Create a value of 'UpdateServiceAction' 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', 'updateServiceAction_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'definition', 'updateServiceAction_definition' - A map that defines the self-service action.
--
-- 'description', 'updateServiceAction_description' - The self-service action description.
--
-- 'name', 'updateServiceAction_name' - The self-service action name.
--
-- 'id', 'updateServiceAction_id' - The self-service action identifier.
newUpdateServiceAction ::
  -- | 'id'
  Prelude.Text ->
  UpdateServiceAction
newUpdateServiceAction :: Text -> UpdateServiceAction
newUpdateServiceAction Text
pId_ =
  UpdateServiceAction'
    { $sel:acceptLanguage:UpdateServiceAction' :: Maybe Text
acceptLanguage =
        forall a. Maybe a
Prelude.Nothing,
      $sel:definition:UpdateServiceAction' :: Maybe (HashMap ServiceActionDefinitionKey Text)
definition = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateServiceAction' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateServiceAction' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:id:UpdateServiceAction' :: Text
id = Text
pId_
    }

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

-- | A map that defines the self-service action.
updateServiceAction_definition :: Lens.Lens' UpdateServiceAction (Prelude.Maybe (Prelude.HashMap ServiceActionDefinitionKey Prelude.Text))
updateServiceAction_definition :: Lens'
  UpdateServiceAction
  (Maybe (HashMap ServiceActionDefinitionKey Text))
updateServiceAction_definition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceAction' {Maybe (HashMap ServiceActionDefinitionKey Text)
definition :: Maybe (HashMap ServiceActionDefinitionKey Text)
$sel:definition:UpdateServiceAction' :: UpdateServiceAction
-> Maybe (HashMap ServiceActionDefinitionKey Text)
definition} -> Maybe (HashMap ServiceActionDefinitionKey Text)
definition) (\s :: UpdateServiceAction
s@UpdateServiceAction' {} Maybe (HashMap ServiceActionDefinitionKey Text)
a -> UpdateServiceAction
s {$sel:definition:UpdateServiceAction' :: Maybe (HashMap ServiceActionDefinitionKey Text)
definition = Maybe (HashMap ServiceActionDefinitionKey Text)
a} :: UpdateServiceAction) 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 self-service action description.
updateServiceAction_description :: Lens.Lens' UpdateServiceAction (Prelude.Maybe Prelude.Text)
updateServiceAction_description :: Lens' UpdateServiceAction (Maybe Text)
updateServiceAction_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateServiceAction' {Maybe Text
description :: Maybe Text
$sel:description:UpdateServiceAction' :: UpdateServiceAction -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateServiceAction
s@UpdateServiceAction' {} Maybe Text
a -> UpdateServiceAction
s {$sel:description:UpdateServiceAction' :: Maybe Text
description = Maybe Text
a} :: UpdateServiceAction)

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

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

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

instance Prelude.NFData UpdateServiceAction where
  rnf :: UpdateServiceAction -> ()
rnf UpdateServiceAction' {Maybe Text
Maybe (HashMap ServiceActionDefinitionKey Text)
Text
id :: Text
name :: Maybe Text
description :: Maybe Text
definition :: Maybe (HashMap ServiceActionDefinitionKey Text)
acceptLanguage :: Maybe Text
$sel:id:UpdateServiceAction' :: UpdateServiceAction -> Text
$sel:name:UpdateServiceAction' :: UpdateServiceAction -> Maybe Text
$sel:description:UpdateServiceAction' :: UpdateServiceAction -> Maybe Text
$sel:definition:UpdateServiceAction' :: UpdateServiceAction
-> Maybe (HashMap ServiceActionDefinitionKey Text)
$sel:acceptLanguage:UpdateServiceAction' :: UpdateServiceAction -> 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 (HashMap ServiceActionDefinitionKey Text)
definition
      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 Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToHeaders UpdateServiceAction where
  toHeaders :: UpdateServiceAction -> 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.UpdateServiceAction" ::
                          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 UpdateServiceAction where
  toJSON :: UpdateServiceAction -> Value
toJSON UpdateServiceAction' {Maybe Text
Maybe (HashMap ServiceActionDefinitionKey Text)
Text
id :: Text
name :: Maybe Text
description :: Maybe Text
definition :: Maybe (HashMap ServiceActionDefinitionKey Text)
acceptLanguage :: Maybe Text
$sel:id:UpdateServiceAction' :: UpdateServiceAction -> Text
$sel:name:UpdateServiceAction' :: UpdateServiceAction -> Maybe Text
$sel:description:UpdateServiceAction' :: UpdateServiceAction -> Maybe Text
$sel:definition:UpdateServiceAction' :: UpdateServiceAction
-> Maybe (HashMap ServiceActionDefinitionKey Text)
$sel:acceptLanguage:UpdateServiceAction' :: UpdateServiceAction -> 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
"Definition" 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 (HashMap ServiceActionDefinitionKey Text)
definition,
            (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,
            (Key
"Name" 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
name,
            forall a. a -> Maybe a
Prelude.Just (Key
"Id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
id)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateServiceActionResponse' 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', 'updateServiceActionResponse_serviceActionDetail' - Detailed information about the self-service action.
--
-- 'httpStatus', 'updateServiceActionResponse_httpStatus' - The response's http status code.
newUpdateServiceActionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateServiceActionResponse
newUpdateServiceActionResponse :: Int -> UpdateServiceActionResponse
newUpdateServiceActionResponse Int
pHttpStatus_ =
  UpdateServiceActionResponse'
    { $sel:serviceActionDetail:UpdateServiceActionResponse' :: Maybe ServiceActionDetail
serviceActionDetail =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateServiceActionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance Prelude.NFData UpdateServiceActionResponse where
  rnf :: UpdateServiceActionResponse -> ()
rnf UpdateServiceActionResponse' {Int
Maybe ServiceActionDetail
httpStatus :: Int
serviceActionDetail :: Maybe ServiceActionDetail
$sel:httpStatus:UpdateServiceActionResponse' :: UpdateServiceActionResponse -> Int
$sel:serviceActionDetail:UpdateServiceActionResponse' :: UpdateServiceActionResponse -> 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