{-# 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 #-}
module Amazonka.ResourceGroups.GetGroupConfiguration
(
GetGroupConfiguration (..),
newGetGroupConfiguration,
getGroupConfiguration_group,
GetGroupConfigurationResponse (..),
newGetGroupConfigurationResponse,
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
data GetGroupConfiguration = GetGroupConfiguration'
{
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)
newGetGroupConfiguration ::
GetGroupConfiguration
newGetGroupConfiguration :: GetGroupConfiguration
newGetGroupConfiguration =
GetGroupConfiguration' {$sel:group':GetGroupConfiguration' :: Maybe Text
group' = forall a. Maybe a
Prelude.Nothing}
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
data GetGroupConfigurationResponse = GetGroupConfigurationResponse'
{
GetGroupConfigurationResponse -> Maybe GroupConfiguration
groupConfiguration :: Prelude.Maybe GroupConfiguration,
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)
newGetGroupConfigurationResponse ::
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_
}
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)
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