{-# 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.ResourceGroups.GetGroupConfiguration
-- 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 the service configuration associated with the specified resource
-- group. For details about the service configuration syntax, see
-- <https://docs.aws.amazon.com/ARG/latest/APIReference/about-slg.html Service configurations for resource groups>.
--
-- __Minimum permissions__
--
-- To run this command, you must have the following permissions:
--
-- -   @resource-groups:GetGroupConfiguration@
module Amazonka.ResourceGroups.GetGroupConfiguration
  ( -- * Creating a Request
    GetGroupConfiguration (..),
    newGetGroupConfiguration,

    -- * Request Lenses
    getGroupConfiguration_group,

    -- * Destructuring the Response
    GetGroupConfigurationResponse (..),
    newGetGroupConfigurationResponse,

    -- * Response Lenses
    getGroupConfigurationResponse_groupConfiguration,
    getGroupConfigurationResponse_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 Amazonka.ResourceGroups.Types
import qualified Amazonka.Response as Response

-- | /See:/ 'newGetGroupConfiguration' smart constructor.
data GetGroupConfiguration = GetGroupConfiguration'
  { -- | The name or the ARN of the resource group.
    GetGroupConfiguration -> Maybe Text
group' :: Prelude.Maybe Prelude.Text
  }
  deriving (GetGroupConfiguration -> GetGroupConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetGroupConfiguration -> GetGroupConfiguration -> Bool
$c/= :: GetGroupConfiguration -> GetGroupConfiguration -> Bool
== :: GetGroupConfiguration -> GetGroupConfiguration -> Bool
$c== :: GetGroupConfiguration -> GetGroupConfiguration -> Bool
Prelude.Eq, ReadPrec [GetGroupConfiguration]
ReadPrec GetGroupConfiguration
Int -> ReadS GetGroupConfiguration
ReadS [GetGroupConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetGroupConfiguration]
$creadListPrec :: ReadPrec [GetGroupConfiguration]
readPrec :: ReadPrec GetGroupConfiguration
$creadPrec :: ReadPrec GetGroupConfiguration
readList :: ReadS [GetGroupConfiguration]
$creadList :: ReadS [GetGroupConfiguration]
readsPrec :: Int -> ReadS GetGroupConfiguration
$creadsPrec :: Int -> ReadS GetGroupConfiguration
Prelude.Read, Int -> GetGroupConfiguration -> ShowS
[GetGroupConfiguration] -> ShowS
GetGroupConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetGroupConfiguration] -> ShowS
$cshowList :: [GetGroupConfiguration] -> ShowS
show :: GetGroupConfiguration -> String
$cshow :: GetGroupConfiguration -> String
showsPrec :: Int -> GetGroupConfiguration -> ShowS
$cshowsPrec :: Int -> GetGroupConfiguration -> ShowS
Prelude.Show, forall x. Rep GetGroupConfiguration x -> GetGroupConfiguration
forall x. GetGroupConfiguration -> Rep GetGroupConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetGroupConfiguration x -> GetGroupConfiguration
$cfrom :: forall x. GetGroupConfiguration -> Rep GetGroupConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'GetGroupConfiguration' 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:
--
-- 'group'', 'getGroupConfiguration_group' - The name or the ARN of the resource group.
newGetGroupConfiguration ::
  GetGroupConfiguration
newGetGroupConfiguration :: GetGroupConfiguration
newGetGroupConfiguration =
  GetGroupConfiguration' {$sel:group':GetGroupConfiguration' :: Maybe Text
group' = forall a. Maybe a
Prelude.Nothing}

-- | The name or the ARN of the resource group.
getGroupConfiguration_group :: Lens.Lens' GetGroupConfiguration (Prelude.Maybe Prelude.Text)
getGroupConfiguration_group :: Lens' GetGroupConfiguration (Maybe Text)
getGroupConfiguration_group = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGroupConfiguration' {Maybe Text
group' :: Maybe Text
$sel:group':GetGroupConfiguration' :: GetGroupConfiguration -> Maybe Text
group'} -> Maybe Text
group') (\s :: GetGroupConfiguration
s@GetGroupConfiguration' {} Maybe Text
a -> GetGroupConfiguration
s {$sel:group':GetGroupConfiguration' :: Maybe Text
group' = Maybe Text
a} :: GetGroupConfiguration)

instance Core.AWSRequest GetGroupConfiguration where
  type
    AWSResponse GetGroupConfiguration =
      GetGroupConfigurationResponse
  request :: (Service -> Service)
-> GetGroupConfiguration -> Request GetGroupConfiguration
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 GetGroupConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetGroupConfiguration)))
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 GroupConfiguration -> Int -> GetGroupConfigurationResponse
GetGroupConfigurationResponse'
            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
"GroupConfiguration")
            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 GetGroupConfiguration where
  hashWithSalt :: Int -> GetGroupConfiguration -> Int
hashWithSalt Int
_salt GetGroupConfiguration' {Maybe Text
group' :: Maybe Text
$sel:group':GetGroupConfiguration' :: GetGroupConfiguration -> Maybe Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
group'

instance Prelude.NFData GetGroupConfiguration where
  rnf :: GetGroupConfiguration -> ()
rnf GetGroupConfiguration' {Maybe Text
group' :: Maybe Text
$sel:group':GetGroupConfiguration' :: GetGroupConfiguration -> Maybe Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
group'

instance Data.ToHeaders GetGroupConfiguration where
  toHeaders :: GetGroupConfiguration -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON GetGroupConfiguration where
  toJSON :: GetGroupConfiguration -> Value
toJSON GetGroupConfiguration' {Maybe Text
group' :: Maybe Text
$sel:group':GetGroupConfiguration' :: GetGroupConfiguration -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [(Key
"Group" 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
group']
      )

instance Data.ToPath GetGroupConfiguration where
  toPath :: GetGroupConfiguration -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/get-group-configuration"

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

-- | /See:/ 'newGetGroupConfigurationResponse' smart constructor.
data GetGroupConfigurationResponse = GetGroupConfigurationResponse'
  { -- | The service configuration associated with the specified group. For
    -- details about the service configuration syntax, see
    -- <https://docs.aws.amazon.com/ARG/latest/APIReference/about-slg.html Service configurations for resource groups>.
    GetGroupConfigurationResponse -> Maybe GroupConfiguration
groupConfiguration :: Prelude.Maybe GroupConfiguration,
    -- | The response's http status code.
    GetGroupConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetGroupConfigurationResponse
-> GetGroupConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetGroupConfigurationResponse
-> GetGroupConfigurationResponse -> Bool
$c/= :: GetGroupConfigurationResponse
-> GetGroupConfigurationResponse -> Bool
== :: GetGroupConfigurationResponse
-> GetGroupConfigurationResponse -> Bool
$c== :: GetGroupConfigurationResponse
-> GetGroupConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [GetGroupConfigurationResponse]
ReadPrec GetGroupConfigurationResponse
Int -> ReadS GetGroupConfigurationResponse
ReadS [GetGroupConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetGroupConfigurationResponse]
$creadListPrec :: ReadPrec [GetGroupConfigurationResponse]
readPrec :: ReadPrec GetGroupConfigurationResponse
$creadPrec :: ReadPrec GetGroupConfigurationResponse
readList :: ReadS [GetGroupConfigurationResponse]
$creadList :: ReadS [GetGroupConfigurationResponse]
readsPrec :: Int -> ReadS GetGroupConfigurationResponse
$creadsPrec :: Int -> ReadS GetGroupConfigurationResponse
Prelude.Read, Int -> GetGroupConfigurationResponse -> ShowS
[GetGroupConfigurationResponse] -> ShowS
GetGroupConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetGroupConfigurationResponse] -> ShowS
$cshowList :: [GetGroupConfigurationResponse] -> ShowS
show :: GetGroupConfigurationResponse -> String
$cshow :: GetGroupConfigurationResponse -> String
showsPrec :: Int -> GetGroupConfigurationResponse -> ShowS
$cshowsPrec :: Int -> GetGroupConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep GetGroupConfigurationResponse x
-> GetGroupConfigurationResponse
forall x.
GetGroupConfigurationResponse
-> Rep GetGroupConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetGroupConfigurationResponse x
-> GetGroupConfigurationResponse
$cfrom :: forall x.
GetGroupConfigurationResponse
-> Rep GetGroupConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetGroupConfigurationResponse' 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:
--
-- 'groupConfiguration', 'getGroupConfigurationResponse_groupConfiguration' - The service configuration associated with the specified group. For
-- details about the service configuration syntax, see
-- <https://docs.aws.amazon.com/ARG/latest/APIReference/about-slg.html Service configurations for resource groups>.
--
-- 'httpStatus', 'getGroupConfigurationResponse_httpStatus' - The response's http status code.
newGetGroupConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetGroupConfigurationResponse
newGetGroupConfigurationResponse :: Int -> GetGroupConfigurationResponse
newGetGroupConfigurationResponse Int
pHttpStatus_ =
  GetGroupConfigurationResponse'
    { $sel:groupConfiguration:GetGroupConfigurationResponse' :: Maybe GroupConfiguration
groupConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetGroupConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The service configuration associated with the specified group. For
-- details about the service configuration syntax, see
-- <https://docs.aws.amazon.com/ARG/latest/APIReference/about-slg.html Service configurations for resource groups>.
getGroupConfigurationResponse_groupConfiguration :: Lens.Lens' GetGroupConfigurationResponse (Prelude.Maybe GroupConfiguration)
getGroupConfigurationResponse_groupConfiguration :: Lens' GetGroupConfigurationResponse (Maybe GroupConfiguration)
getGroupConfigurationResponse_groupConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGroupConfigurationResponse' {Maybe GroupConfiguration
groupConfiguration :: Maybe GroupConfiguration
$sel:groupConfiguration:GetGroupConfigurationResponse' :: GetGroupConfigurationResponse -> Maybe GroupConfiguration
groupConfiguration} -> Maybe GroupConfiguration
groupConfiguration) (\s :: GetGroupConfigurationResponse
s@GetGroupConfigurationResponse' {} Maybe GroupConfiguration
a -> GetGroupConfigurationResponse
s {$sel:groupConfiguration:GetGroupConfigurationResponse' :: Maybe GroupConfiguration
groupConfiguration = Maybe GroupConfiguration
a} :: GetGroupConfigurationResponse)

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

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