{-# 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.DescribeServiceAction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes a self-service action.
module Amazonka.ServiceCatalog.DescribeServiceAction
  ( -- * Creating a Request
    DescribeServiceAction (..),
    newDescribeServiceAction,

    -- * Request Lenses
    describeServiceAction_acceptLanguage,
    describeServiceAction_id,

    -- * Destructuring the Response
    DescribeServiceActionResponse (..),
    newDescribeServiceActionResponse,

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

-- |
-- Create a value of 'DescribeServiceAction' 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', 'describeServiceAction_acceptLanguage' - The language code.
--
-- -   @en@ - English (default)
--
-- -   @jp@ - Japanese
--
-- -   @zh@ - Chinese
--
-- 'id', 'describeServiceAction_id' - The self-service action identifier.
newDescribeServiceAction ::
  -- | 'id'
  Prelude.Text ->
  DescribeServiceAction
newDescribeServiceAction :: Text -> DescribeServiceAction
newDescribeServiceAction Text
pId_ =
  DescribeServiceAction'
    { $sel:acceptLanguage:DescribeServiceAction' :: Maybe Text
acceptLanguage =
        forall a. Maybe a
Prelude.Nothing,
      $sel:id:DescribeServiceAction' :: Text
id = Text
pId_
    }

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

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

instance Core.AWSRequest DescribeServiceAction where
  type
    AWSResponse DescribeServiceAction =
      DescribeServiceActionResponse
  request :: (Service -> Service)
-> DescribeServiceAction -> Request DescribeServiceAction
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 DescribeServiceAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeServiceAction)))
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 -> DescribeServiceActionResponse
DescribeServiceActionResponse'
            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 DescribeServiceAction where
  hashWithSalt :: Int -> DescribeServiceAction -> Int
hashWithSalt Int
_salt DescribeServiceAction' {Maybe Text
Text
id :: Text
acceptLanguage :: Maybe Text
$sel:id:DescribeServiceAction' :: DescribeServiceAction -> Text
$sel:acceptLanguage:DescribeServiceAction' :: DescribeServiceAction -> 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` Text
id

instance Prelude.NFData DescribeServiceAction where
  rnf :: DescribeServiceAction -> ()
rnf DescribeServiceAction' {Maybe Text
Text
id :: Text
acceptLanguage :: Maybe Text
$sel:id:DescribeServiceAction' :: DescribeServiceAction -> Text
$sel:acceptLanguage:DescribeServiceAction' :: DescribeServiceAction -> 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 Text
id

instance Data.ToHeaders DescribeServiceAction where
  toHeaders :: DescribeServiceAction -> 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.DescribeServiceAction" ::
                          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 DescribeServiceAction where
  toJSON :: DescribeServiceAction -> Value
toJSON DescribeServiceAction' {Maybe Text
Text
id :: Text
acceptLanguage :: Maybe Text
$sel:id:DescribeServiceAction' :: DescribeServiceAction -> Text
$sel:acceptLanguage:DescribeServiceAction' :: DescribeServiceAction -> 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,
            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 DescribeServiceAction where
  toPath :: DescribeServiceAction -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

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

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

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

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

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