{-# 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.WorkMail.DescribeGroup
-- 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 data available for the group.
module Amazonka.WorkMail.DescribeGroup
  ( -- * Creating a Request
    DescribeGroup (..),
    newDescribeGroup,

    -- * Request Lenses
    describeGroup_organizationId,
    describeGroup_groupId,

    -- * Destructuring the Response
    DescribeGroupResponse (..),
    newDescribeGroupResponse,

    -- * Response Lenses
    describeGroupResponse_disabledDate,
    describeGroupResponse_email,
    describeGroupResponse_enabledDate,
    describeGroupResponse_groupId,
    describeGroupResponse_name,
    describeGroupResponse_state,
    describeGroupResponse_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.WorkMail.Types

-- | /See:/ 'newDescribeGroup' smart constructor.
data DescribeGroup = DescribeGroup'
  { -- | The identifier for the organization under which the group exists.
    DescribeGroup -> Text
organizationId :: Prelude.Text,
    -- | The identifier for the group to be described.
    DescribeGroup -> Text
groupId :: Prelude.Text
  }
  deriving (DescribeGroup -> DescribeGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeGroup -> DescribeGroup -> Bool
$c/= :: DescribeGroup -> DescribeGroup -> Bool
== :: DescribeGroup -> DescribeGroup -> Bool
$c== :: DescribeGroup -> DescribeGroup -> Bool
Prelude.Eq, ReadPrec [DescribeGroup]
ReadPrec DescribeGroup
Int -> ReadS DescribeGroup
ReadS [DescribeGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeGroup]
$creadListPrec :: ReadPrec [DescribeGroup]
readPrec :: ReadPrec DescribeGroup
$creadPrec :: ReadPrec DescribeGroup
readList :: ReadS [DescribeGroup]
$creadList :: ReadS [DescribeGroup]
readsPrec :: Int -> ReadS DescribeGroup
$creadsPrec :: Int -> ReadS DescribeGroup
Prelude.Read, Int -> DescribeGroup -> ShowS
[DescribeGroup] -> ShowS
DescribeGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeGroup] -> ShowS
$cshowList :: [DescribeGroup] -> ShowS
show :: DescribeGroup -> String
$cshow :: DescribeGroup -> String
showsPrec :: Int -> DescribeGroup -> ShowS
$cshowsPrec :: Int -> DescribeGroup -> ShowS
Prelude.Show, forall x. Rep DescribeGroup x -> DescribeGroup
forall x. DescribeGroup -> Rep DescribeGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeGroup x -> DescribeGroup
$cfrom :: forall x. DescribeGroup -> Rep DescribeGroup x
Prelude.Generic)

-- |
-- Create a value of 'DescribeGroup' 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:
--
-- 'organizationId', 'describeGroup_organizationId' - The identifier for the organization under which the group exists.
--
-- 'groupId', 'describeGroup_groupId' - The identifier for the group to be described.
newDescribeGroup ::
  -- | 'organizationId'
  Prelude.Text ->
  -- | 'groupId'
  Prelude.Text ->
  DescribeGroup
newDescribeGroup :: Text -> Text -> DescribeGroup
newDescribeGroup Text
pOrganizationId_ Text
pGroupId_ =
  DescribeGroup'
    { $sel:organizationId:DescribeGroup' :: Text
organizationId = Text
pOrganizationId_,
      $sel:groupId:DescribeGroup' :: Text
groupId = Text
pGroupId_
    }

-- | The identifier for the organization under which the group exists.
describeGroup_organizationId :: Lens.Lens' DescribeGroup Prelude.Text
describeGroup_organizationId :: Lens' DescribeGroup Text
describeGroup_organizationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGroup' {Text
organizationId :: Text
$sel:organizationId:DescribeGroup' :: DescribeGroup -> Text
organizationId} -> Text
organizationId) (\s :: DescribeGroup
s@DescribeGroup' {} Text
a -> DescribeGroup
s {$sel:organizationId:DescribeGroup' :: Text
organizationId = Text
a} :: DescribeGroup)

-- | The identifier for the group to be described.
describeGroup_groupId :: Lens.Lens' DescribeGroup Prelude.Text
describeGroup_groupId :: Lens' DescribeGroup Text
describeGroup_groupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGroup' {Text
groupId :: Text
$sel:groupId:DescribeGroup' :: DescribeGroup -> Text
groupId} -> Text
groupId) (\s :: DescribeGroup
s@DescribeGroup' {} Text
a -> DescribeGroup
s {$sel:groupId:DescribeGroup' :: Text
groupId = Text
a} :: DescribeGroup)

instance Core.AWSRequest DescribeGroup where
  type
    AWSResponse DescribeGroup =
      DescribeGroupResponse
  request :: (Service -> Service) -> DescribeGroup -> Request DescribeGroup
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 DescribeGroup
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeGroup)))
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 POSIX
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe EntityState
-> Int
-> DescribeGroupResponse
DescribeGroupResponse'
            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
"DisabledDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Email")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"EnabledDate")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"GroupId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Name")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"State")
            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 DescribeGroup where
  hashWithSalt :: Int -> DescribeGroup -> Int
hashWithSalt Int
_salt DescribeGroup' {Text
groupId :: Text
organizationId :: Text
$sel:groupId:DescribeGroup' :: DescribeGroup -> Text
$sel:organizationId:DescribeGroup' :: DescribeGroup -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
organizationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
groupId

instance Prelude.NFData DescribeGroup where
  rnf :: DescribeGroup -> ()
rnf DescribeGroup' {Text
groupId :: Text
organizationId :: Text
$sel:groupId:DescribeGroup' :: DescribeGroup -> Text
$sel:organizationId:DescribeGroup' :: DescribeGroup -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
organizationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
groupId

instance Data.ToHeaders DescribeGroup where
  toHeaders :: DescribeGroup -> 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
"WorkMailService.DescribeGroup" ::
                          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 DescribeGroup where
  toJSON :: DescribeGroup -> Value
toJSON DescribeGroup' {Text
groupId :: Text
organizationId :: Text
$sel:groupId:DescribeGroup' :: DescribeGroup -> Text
$sel:organizationId:DescribeGroup' :: DescribeGroup -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"OrganizationId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
organizationId),
            forall a. a -> Maybe a
Prelude.Just (Key
"GroupId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
groupId)
          ]
      )

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

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

-- | /See:/ 'newDescribeGroupResponse' smart constructor.
data DescribeGroupResponse = DescribeGroupResponse'
  { -- | The date and time when a user was deregistered from WorkMail, in UNIX
    -- epoch time format.
    DescribeGroupResponse -> Maybe POSIX
disabledDate :: Prelude.Maybe Data.POSIX,
    -- | The email of the described group.
    DescribeGroupResponse -> Maybe Text
email :: Prelude.Maybe Prelude.Text,
    -- | The date and time when a user was registered to WorkMail, in UNIX epoch
    -- time format.
    DescribeGroupResponse -> Maybe POSIX
enabledDate :: Prelude.Maybe Data.POSIX,
    -- | The identifier of the described group.
    DescribeGroupResponse -> Maybe Text
groupId :: Prelude.Maybe Prelude.Text,
    -- | The name of the described group.
    DescribeGroupResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | The state of the user: enabled (registered to WorkMail) or disabled
    -- (deregistered or never registered to WorkMail).
    DescribeGroupResponse -> Maybe EntityState
state :: Prelude.Maybe EntityState,
    -- | The response's http status code.
    DescribeGroupResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeGroupResponse -> DescribeGroupResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeGroupResponse -> DescribeGroupResponse -> Bool
$c/= :: DescribeGroupResponse -> DescribeGroupResponse -> Bool
== :: DescribeGroupResponse -> DescribeGroupResponse -> Bool
$c== :: DescribeGroupResponse -> DescribeGroupResponse -> Bool
Prelude.Eq, ReadPrec [DescribeGroupResponse]
ReadPrec DescribeGroupResponse
Int -> ReadS DescribeGroupResponse
ReadS [DescribeGroupResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeGroupResponse]
$creadListPrec :: ReadPrec [DescribeGroupResponse]
readPrec :: ReadPrec DescribeGroupResponse
$creadPrec :: ReadPrec DescribeGroupResponse
readList :: ReadS [DescribeGroupResponse]
$creadList :: ReadS [DescribeGroupResponse]
readsPrec :: Int -> ReadS DescribeGroupResponse
$creadsPrec :: Int -> ReadS DescribeGroupResponse
Prelude.Read, Int -> DescribeGroupResponse -> ShowS
[DescribeGroupResponse] -> ShowS
DescribeGroupResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeGroupResponse] -> ShowS
$cshowList :: [DescribeGroupResponse] -> ShowS
show :: DescribeGroupResponse -> String
$cshow :: DescribeGroupResponse -> String
showsPrec :: Int -> DescribeGroupResponse -> ShowS
$cshowsPrec :: Int -> DescribeGroupResponse -> ShowS
Prelude.Show, forall x. Rep DescribeGroupResponse x -> DescribeGroupResponse
forall x. DescribeGroupResponse -> Rep DescribeGroupResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeGroupResponse x -> DescribeGroupResponse
$cfrom :: forall x. DescribeGroupResponse -> Rep DescribeGroupResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeGroupResponse' 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:
--
-- 'disabledDate', 'describeGroupResponse_disabledDate' - The date and time when a user was deregistered from WorkMail, in UNIX
-- epoch time format.
--
-- 'email', 'describeGroupResponse_email' - The email of the described group.
--
-- 'enabledDate', 'describeGroupResponse_enabledDate' - The date and time when a user was registered to WorkMail, in UNIX epoch
-- time format.
--
-- 'groupId', 'describeGroupResponse_groupId' - The identifier of the described group.
--
-- 'name', 'describeGroupResponse_name' - The name of the described group.
--
-- 'state', 'describeGroupResponse_state' - The state of the user: enabled (registered to WorkMail) or disabled
-- (deregistered or never registered to WorkMail).
--
-- 'httpStatus', 'describeGroupResponse_httpStatus' - The response's http status code.
newDescribeGroupResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeGroupResponse
newDescribeGroupResponse :: Int -> DescribeGroupResponse
newDescribeGroupResponse Int
pHttpStatus_ =
  DescribeGroupResponse'
    { $sel:disabledDate:DescribeGroupResponse' :: Maybe POSIX
disabledDate =
        forall a. Maybe a
Prelude.Nothing,
      $sel:email:DescribeGroupResponse' :: Maybe Text
email = forall a. Maybe a
Prelude.Nothing,
      $sel:enabledDate:DescribeGroupResponse' :: Maybe POSIX
enabledDate = forall a. Maybe a
Prelude.Nothing,
      $sel:groupId:DescribeGroupResponse' :: Maybe Text
groupId = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DescribeGroupResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:state:DescribeGroupResponse' :: Maybe EntityState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeGroupResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The date and time when a user was deregistered from WorkMail, in UNIX
-- epoch time format.
describeGroupResponse_disabledDate :: Lens.Lens' DescribeGroupResponse (Prelude.Maybe Prelude.UTCTime)
describeGroupResponse_disabledDate :: Lens' DescribeGroupResponse (Maybe UTCTime)
describeGroupResponse_disabledDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGroupResponse' {Maybe POSIX
disabledDate :: Maybe POSIX
$sel:disabledDate:DescribeGroupResponse' :: DescribeGroupResponse -> Maybe POSIX
disabledDate} -> Maybe POSIX
disabledDate) (\s :: DescribeGroupResponse
s@DescribeGroupResponse' {} Maybe POSIX
a -> DescribeGroupResponse
s {$sel:disabledDate:DescribeGroupResponse' :: Maybe POSIX
disabledDate = Maybe POSIX
a} :: DescribeGroupResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The email of the described group.
describeGroupResponse_email :: Lens.Lens' DescribeGroupResponse (Prelude.Maybe Prelude.Text)
describeGroupResponse_email :: Lens' DescribeGroupResponse (Maybe Text)
describeGroupResponse_email = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGroupResponse' {Maybe Text
email :: Maybe Text
$sel:email:DescribeGroupResponse' :: DescribeGroupResponse -> Maybe Text
email} -> Maybe Text
email) (\s :: DescribeGroupResponse
s@DescribeGroupResponse' {} Maybe Text
a -> DescribeGroupResponse
s {$sel:email:DescribeGroupResponse' :: Maybe Text
email = Maybe Text
a} :: DescribeGroupResponse)

-- | The date and time when a user was registered to WorkMail, in UNIX epoch
-- time format.
describeGroupResponse_enabledDate :: Lens.Lens' DescribeGroupResponse (Prelude.Maybe Prelude.UTCTime)
describeGroupResponse_enabledDate :: Lens' DescribeGroupResponse (Maybe UTCTime)
describeGroupResponse_enabledDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGroupResponse' {Maybe POSIX
enabledDate :: Maybe POSIX
$sel:enabledDate:DescribeGroupResponse' :: DescribeGroupResponse -> Maybe POSIX
enabledDate} -> Maybe POSIX
enabledDate) (\s :: DescribeGroupResponse
s@DescribeGroupResponse' {} Maybe POSIX
a -> DescribeGroupResponse
s {$sel:enabledDate:DescribeGroupResponse' :: Maybe POSIX
enabledDate = Maybe POSIX
a} :: DescribeGroupResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The identifier of the described group.
describeGroupResponse_groupId :: Lens.Lens' DescribeGroupResponse (Prelude.Maybe Prelude.Text)
describeGroupResponse_groupId :: Lens' DescribeGroupResponse (Maybe Text)
describeGroupResponse_groupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGroupResponse' {Maybe Text
groupId :: Maybe Text
$sel:groupId:DescribeGroupResponse' :: DescribeGroupResponse -> Maybe Text
groupId} -> Maybe Text
groupId) (\s :: DescribeGroupResponse
s@DescribeGroupResponse' {} Maybe Text
a -> DescribeGroupResponse
s {$sel:groupId:DescribeGroupResponse' :: Maybe Text
groupId = Maybe Text
a} :: DescribeGroupResponse)

-- | The name of the described group.
describeGroupResponse_name :: Lens.Lens' DescribeGroupResponse (Prelude.Maybe Prelude.Text)
describeGroupResponse_name :: Lens' DescribeGroupResponse (Maybe Text)
describeGroupResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGroupResponse' {Maybe Text
name :: Maybe Text
$sel:name:DescribeGroupResponse' :: DescribeGroupResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: DescribeGroupResponse
s@DescribeGroupResponse' {} Maybe Text
a -> DescribeGroupResponse
s {$sel:name:DescribeGroupResponse' :: Maybe Text
name = Maybe Text
a} :: DescribeGroupResponse)

-- | The state of the user: enabled (registered to WorkMail) or disabled
-- (deregistered or never registered to WorkMail).
describeGroupResponse_state :: Lens.Lens' DescribeGroupResponse (Prelude.Maybe EntityState)
describeGroupResponse_state :: Lens' DescribeGroupResponse (Maybe EntityState)
describeGroupResponse_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGroupResponse' {Maybe EntityState
state :: Maybe EntityState
$sel:state:DescribeGroupResponse' :: DescribeGroupResponse -> Maybe EntityState
state} -> Maybe EntityState
state) (\s :: DescribeGroupResponse
s@DescribeGroupResponse' {} Maybe EntityState
a -> DescribeGroupResponse
s {$sel:state:DescribeGroupResponse' :: Maybe EntityState
state = Maybe EntityState
a} :: DescribeGroupResponse)

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

instance Prelude.NFData DescribeGroupResponse where
  rnf :: DescribeGroupResponse -> ()
rnf DescribeGroupResponse' {Int
Maybe Text
Maybe POSIX
Maybe EntityState
httpStatus :: Int
state :: Maybe EntityState
name :: Maybe Text
groupId :: Maybe Text
enabledDate :: Maybe POSIX
email :: Maybe Text
disabledDate :: Maybe POSIX
$sel:httpStatus:DescribeGroupResponse' :: DescribeGroupResponse -> Int
$sel:state:DescribeGroupResponse' :: DescribeGroupResponse -> Maybe EntityState
$sel:name:DescribeGroupResponse' :: DescribeGroupResponse -> Maybe Text
$sel:groupId:DescribeGroupResponse' :: DescribeGroupResponse -> Maybe Text
$sel:enabledDate:DescribeGroupResponse' :: DescribeGroupResponse -> Maybe POSIX
$sel:email:DescribeGroupResponse' :: DescribeGroupResponse -> Maybe Text
$sel:disabledDate:DescribeGroupResponse' :: DescribeGroupResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
disabledDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
email
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
enabledDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
groupId
      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 Maybe EntityState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus