{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.IAM.Types.UserDetail
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.IAM.Types.UserDetail where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IAM.Types.AttachedPermissionsBoundary
import Amazonka.IAM.Types.AttachedPolicy
import Amazonka.IAM.Types.PolicyDetail
import Amazonka.IAM.Types.Tag
import qualified Amazonka.Prelude as Prelude

-- | Contains information about an IAM user, including all the user\'s
-- policies and all the IAM groups the user is in.
--
-- This data type is used as a response element in the
-- GetAccountAuthorizationDetails operation.
--
-- /See:/ 'newUserDetail' smart constructor.
data UserDetail = UserDetail'
  { UserDetail -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | A list of the managed policies attached to the user.
    UserDetail -> Maybe [AttachedPolicy]
attachedManagedPolicies :: Prelude.Maybe [AttachedPolicy],
    -- | The date and time, in
    -- <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the
    -- user was created.
    UserDetail -> Maybe ISO8601
createDate :: Prelude.Maybe Data.ISO8601,
    -- | A list of IAM groups that the user is in.
    UserDetail -> Maybe [Text]
groupList :: Prelude.Maybe [Prelude.Text],
    -- | The path to the user. For more information about paths, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
    -- in the /IAM User Guide/.
    UserDetail -> Maybe Text
path :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the policy used to set the permissions boundary for the user.
    --
    -- For more information about permissions boundaries, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_boundaries.html Permissions boundaries for IAM identities>
    -- in the /IAM User Guide/.
    UserDetail -> Maybe AttachedPermissionsBoundary
permissionsBoundary :: Prelude.Maybe AttachedPermissionsBoundary,
    -- | A list of tags that are associated with the user. For more information
    -- about tagging, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
    -- in the /IAM User Guide/.
    UserDetail -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The stable and unique string identifying the user. For more information
    -- about IDs, see
    -- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
    -- in the /IAM User Guide/.
    UserDetail -> Maybe Text
userId :: Prelude.Maybe Prelude.Text,
    -- | The friendly name identifying the user.
    UserDetail -> Maybe Text
userName :: Prelude.Maybe Prelude.Text,
    -- | A list of the inline policies embedded in the user.
    UserDetail -> Maybe [PolicyDetail]
userPolicyList :: Prelude.Maybe [PolicyDetail]
  }
  deriving (UserDetail -> UserDetail -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UserDetail -> UserDetail -> Bool
$c/= :: UserDetail -> UserDetail -> Bool
== :: UserDetail -> UserDetail -> Bool
$c== :: UserDetail -> UserDetail -> Bool
Prelude.Eq, ReadPrec [UserDetail]
ReadPrec UserDetail
Int -> ReadS UserDetail
ReadS [UserDetail]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UserDetail]
$creadListPrec :: ReadPrec [UserDetail]
readPrec :: ReadPrec UserDetail
$creadPrec :: ReadPrec UserDetail
readList :: ReadS [UserDetail]
$creadList :: ReadS [UserDetail]
readsPrec :: Int -> ReadS UserDetail
$creadsPrec :: Int -> ReadS UserDetail
Prelude.Read, Int -> UserDetail -> ShowS
[UserDetail] -> ShowS
UserDetail -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UserDetail] -> ShowS
$cshowList :: [UserDetail] -> ShowS
show :: UserDetail -> String
$cshow :: UserDetail -> String
showsPrec :: Int -> UserDetail -> ShowS
$cshowsPrec :: Int -> UserDetail -> ShowS
Prelude.Show, forall x. Rep UserDetail x -> UserDetail
forall x. UserDetail -> Rep UserDetail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UserDetail x -> UserDetail
$cfrom :: forall x. UserDetail -> Rep UserDetail x
Prelude.Generic)

-- |
-- Create a value of 'UserDetail' 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:
--
-- 'arn', 'userDetail_arn' - Undocumented member.
--
-- 'attachedManagedPolicies', 'userDetail_attachedManagedPolicies' - A list of the managed policies attached to the user.
--
-- 'createDate', 'userDetail_createDate' - The date and time, in
-- <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the
-- user was created.
--
-- 'groupList', 'userDetail_groupList' - A list of IAM groups that the user is in.
--
-- 'path', 'userDetail_path' - The path to the user. For more information about paths, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
--
-- 'permissionsBoundary', 'userDetail_permissionsBoundary' - The ARN of the policy used to set the permissions boundary for the user.
--
-- For more information about permissions boundaries, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_boundaries.html Permissions boundaries for IAM identities>
-- in the /IAM User Guide/.
--
-- 'tags', 'userDetail_tags' - A list of tags that are associated with the user. For more information
-- about tagging, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
-- in the /IAM User Guide/.
--
-- 'userId', 'userDetail_userId' - The stable and unique string identifying the user. For more information
-- about IDs, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
--
-- 'userName', 'userDetail_userName' - The friendly name identifying the user.
--
-- 'userPolicyList', 'userDetail_userPolicyList' - A list of the inline policies embedded in the user.
newUserDetail ::
  UserDetail
newUserDetail :: UserDetail
newUserDetail =
  UserDetail'
    { $sel:arn:UserDetail' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:attachedManagedPolicies:UserDetail' :: Maybe [AttachedPolicy]
attachedManagedPolicies = forall a. Maybe a
Prelude.Nothing,
      $sel:createDate:UserDetail' :: Maybe ISO8601
createDate = forall a. Maybe a
Prelude.Nothing,
      $sel:groupList:UserDetail' :: Maybe [Text]
groupList = forall a. Maybe a
Prelude.Nothing,
      $sel:path:UserDetail' :: Maybe Text
path = forall a. Maybe a
Prelude.Nothing,
      $sel:permissionsBoundary:UserDetail' :: Maybe AttachedPermissionsBoundary
permissionsBoundary = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:UserDetail' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:userId:UserDetail' :: Maybe Text
userId = forall a. Maybe a
Prelude.Nothing,
      $sel:userName:UserDetail' :: Maybe Text
userName = forall a. Maybe a
Prelude.Nothing,
      $sel:userPolicyList:UserDetail' :: Maybe [PolicyDetail]
userPolicyList = forall a. Maybe a
Prelude.Nothing
    }

-- | Undocumented member.
userDetail_arn :: Lens.Lens' UserDetail (Prelude.Maybe Prelude.Text)
userDetail_arn :: Lens' UserDetail (Maybe Text)
userDetail_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserDetail' {Maybe Text
arn :: Maybe Text
$sel:arn:UserDetail' :: UserDetail -> Maybe Text
arn} -> Maybe Text
arn) (\s :: UserDetail
s@UserDetail' {} Maybe Text
a -> UserDetail
s {$sel:arn:UserDetail' :: Maybe Text
arn = Maybe Text
a} :: UserDetail)

-- | A list of the managed policies attached to the user.
userDetail_attachedManagedPolicies :: Lens.Lens' UserDetail (Prelude.Maybe [AttachedPolicy])
userDetail_attachedManagedPolicies :: Lens' UserDetail (Maybe [AttachedPolicy])
userDetail_attachedManagedPolicies = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserDetail' {Maybe [AttachedPolicy]
attachedManagedPolicies :: Maybe [AttachedPolicy]
$sel:attachedManagedPolicies:UserDetail' :: UserDetail -> Maybe [AttachedPolicy]
attachedManagedPolicies} -> Maybe [AttachedPolicy]
attachedManagedPolicies) (\s :: UserDetail
s@UserDetail' {} Maybe [AttachedPolicy]
a -> UserDetail
s {$sel:attachedManagedPolicies:UserDetail' :: Maybe [AttachedPolicy]
attachedManagedPolicies = Maybe [AttachedPolicy]
a} :: UserDetail) 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 date and time, in
-- <http://www.iso.org/iso/iso8601 ISO 8601 date-time format>, when the
-- user was created.
userDetail_createDate :: Lens.Lens' UserDetail (Prelude.Maybe Prelude.UTCTime)
userDetail_createDate :: Lens' UserDetail (Maybe UTCTime)
userDetail_createDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserDetail' {Maybe ISO8601
createDate :: Maybe ISO8601
$sel:createDate:UserDetail' :: UserDetail -> Maybe ISO8601
createDate} -> Maybe ISO8601
createDate) (\s :: UserDetail
s@UserDetail' {} Maybe ISO8601
a -> UserDetail
s {$sel:createDate:UserDetail' :: Maybe ISO8601
createDate = Maybe ISO8601
a} :: UserDetail) 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

-- | A list of IAM groups that the user is in.
userDetail_groupList :: Lens.Lens' UserDetail (Prelude.Maybe [Prelude.Text])
userDetail_groupList :: Lens' UserDetail (Maybe [Text])
userDetail_groupList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserDetail' {Maybe [Text]
groupList :: Maybe [Text]
$sel:groupList:UserDetail' :: UserDetail -> Maybe [Text]
groupList} -> Maybe [Text]
groupList) (\s :: UserDetail
s@UserDetail' {} Maybe [Text]
a -> UserDetail
s {$sel:groupList:UserDetail' :: Maybe [Text]
groupList = Maybe [Text]
a} :: UserDetail) 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 path to the user. For more information about paths, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
userDetail_path :: Lens.Lens' UserDetail (Prelude.Maybe Prelude.Text)
userDetail_path :: Lens' UserDetail (Maybe Text)
userDetail_path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserDetail' {Maybe Text
path :: Maybe Text
$sel:path:UserDetail' :: UserDetail -> Maybe Text
path} -> Maybe Text
path) (\s :: UserDetail
s@UserDetail' {} Maybe Text
a -> UserDetail
s {$sel:path:UserDetail' :: Maybe Text
path = Maybe Text
a} :: UserDetail)

-- | The ARN of the policy used to set the permissions boundary for the user.
--
-- For more information about permissions boundaries, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/access_policies_boundaries.html Permissions boundaries for IAM identities>
-- in the /IAM User Guide/.
userDetail_permissionsBoundary :: Lens.Lens' UserDetail (Prelude.Maybe AttachedPermissionsBoundary)
userDetail_permissionsBoundary :: Lens' UserDetail (Maybe AttachedPermissionsBoundary)
userDetail_permissionsBoundary = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserDetail' {Maybe AttachedPermissionsBoundary
permissionsBoundary :: Maybe AttachedPermissionsBoundary
$sel:permissionsBoundary:UserDetail' :: UserDetail -> Maybe AttachedPermissionsBoundary
permissionsBoundary} -> Maybe AttachedPermissionsBoundary
permissionsBoundary) (\s :: UserDetail
s@UserDetail' {} Maybe AttachedPermissionsBoundary
a -> UserDetail
s {$sel:permissionsBoundary:UserDetail' :: Maybe AttachedPermissionsBoundary
permissionsBoundary = Maybe AttachedPermissionsBoundary
a} :: UserDetail)

-- | A list of tags that are associated with the user. For more information
-- about tagging, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/id_tags.html Tagging IAM resources>
-- in the /IAM User Guide/.
userDetail_tags :: Lens.Lens' UserDetail (Prelude.Maybe [Tag])
userDetail_tags :: Lens' UserDetail (Maybe [Tag])
userDetail_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserDetail' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:UserDetail' :: UserDetail -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: UserDetail
s@UserDetail' {} Maybe [Tag]
a -> UserDetail
s {$sel:tags:UserDetail' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: UserDetail) 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 stable and unique string identifying the user. For more information
-- about IDs, see
-- <https://docs.aws.amazon.com/IAM/latest/UserGuide/Using_Identifiers.html IAM identifiers>
-- in the /IAM User Guide/.
userDetail_userId :: Lens.Lens' UserDetail (Prelude.Maybe Prelude.Text)
userDetail_userId :: Lens' UserDetail (Maybe Text)
userDetail_userId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserDetail' {Maybe Text
userId :: Maybe Text
$sel:userId:UserDetail' :: UserDetail -> Maybe Text
userId} -> Maybe Text
userId) (\s :: UserDetail
s@UserDetail' {} Maybe Text
a -> UserDetail
s {$sel:userId:UserDetail' :: Maybe Text
userId = Maybe Text
a} :: UserDetail)

-- | The friendly name identifying the user.
userDetail_userName :: Lens.Lens' UserDetail (Prelude.Maybe Prelude.Text)
userDetail_userName :: Lens' UserDetail (Maybe Text)
userDetail_userName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserDetail' {Maybe Text
userName :: Maybe Text
$sel:userName:UserDetail' :: UserDetail -> Maybe Text
userName} -> Maybe Text
userName) (\s :: UserDetail
s@UserDetail' {} Maybe Text
a -> UserDetail
s {$sel:userName:UserDetail' :: Maybe Text
userName = Maybe Text
a} :: UserDetail)

-- | A list of the inline policies embedded in the user.
userDetail_userPolicyList :: Lens.Lens' UserDetail (Prelude.Maybe [PolicyDetail])
userDetail_userPolicyList :: Lens' UserDetail (Maybe [PolicyDetail])
userDetail_userPolicyList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UserDetail' {Maybe [PolicyDetail]
userPolicyList :: Maybe [PolicyDetail]
$sel:userPolicyList:UserDetail' :: UserDetail -> Maybe [PolicyDetail]
userPolicyList} -> Maybe [PolicyDetail]
userPolicyList) (\s :: UserDetail
s@UserDetail' {} Maybe [PolicyDetail]
a -> UserDetail
s {$sel:userPolicyList:UserDetail' :: Maybe [PolicyDetail]
userPolicyList = Maybe [PolicyDetail]
a} :: UserDetail) 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

instance Data.FromXML UserDetail where
  parseXML :: [Node] -> Either String UserDetail
parseXML [Node]
x =
    Maybe Text
-> Maybe [AttachedPolicy]
-> Maybe ISO8601
-> Maybe [Text]
-> Maybe Text
-> Maybe AttachedPermissionsBoundary
-> Maybe [Tag]
-> Maybe Text
-> Maybe Text
-> Maybe [PolicyDetail]
-> UserDetail
UserDetail'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Arn")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"AttachedManagedPolicies"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"CreateDate")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"GroupList"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Path")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"PermissionsBoundary")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Tags"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                  )
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"UserId")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"UserName")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"UserPolicyList"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"member")
                  )

instance Prelude.Hashable UserDetail where
  hashWithSalt :: Int -> UserDetail -> Int
hashWithSalt Int
_salt UserDetail' {Maybe [Text]
Maybe [AttachedPolicy]
Maybe [PolicyDetail]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe AttachedPermissionsBoundary
userPolicyList :: Maybe [PolicyDetail]
userName :: Maybe Text
userId :: Maybe Text
tags :: Maybe [Tag]
permissionsBoundary :: Maybe AttachedPermissionsBoundary
path :: Maybe Text
groupList :: Maybe [Text]
createDate :: Maybe ISO8601
attachedManagedPolicies :: Maybe [AttachedPolicy]
arn :: Maybe Text
$sel:userPolicyList:UserDetail' :: UserDetail -> Maybe [PolicyDetail]
$sel:userName:UserDetail' :: UserDetail -> Maybe Text
$sel:userId:UserDetail' :: UserDetail -> Maybe Text
$sel:tags:UserDetail' :: UserDetail -> Maybe [Tag]
$sel:permissionsBoundary:UserDetail' :: UserDetail -> Maybe AttachedPermissionsBoundary
$sel:path:UserDetail' :: UserDetail -> Maybe Text
$sel:groupList:UserDetail' :: UserDetail -> Maybe [Text]
$sel:createDate:UserDetail' :: UserDetail -> Maybe ISO8601
$sel:attachedManagedPolicies:UserDetail' :: UserDetail -> Maybe [AttachedPolicy]
$sel:arn:UserDetail' :: UserDetail -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AttachedPolicy]
attachedManagedPolicies
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
createDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
groupList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
path
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AttachedPermissionsBoundary
permissionsBoundary
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
userId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
userName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PolicyDetail]
userPolicyList

instance Prelude.NFData UserDetail where
  rnf :: UserDetail -> ()
rnf UserDetail' {Maybe [Text]
Maybe [AttachedPolicy]
Maybe [PolicyDetail]
Maybe [Tag]
Maybe Text
Maybe ISO8601
Maybe AttachedPermissionsBoundary
userPolicyList :: Maybe [PolicyDetail]
userName :: Maybe Text
userId :: Maybe Text
tags :: Maybe [Tag]
permissionsBoundary :: Maybe AttachedPermissionsBoundary
path :: Maybe Text
groupList :: Maybe [Text]
createDate :: Maybe ISO8601
attachedManagedPolicies :: Maybe [AttachedPolicy]
arn :: Maybe Text
$sel:userPolicyList:UserDetail' :: UserDetail -> Maybe [PolicyDetail]
$sel:userName:UserDetail' :: UserDetail -> Maybe Text
$sel:userId:UserDetail' :: UserDetail -> Maybe Text
$sel:tags:UserDetail' :: UserDetail -> Maybe [Tag]
$sel:permissionsBoundary:UserDetail' :: UserDetail -> Maybe AttachedPermissionsBoundary
$sel:path:UserDetail' :: UserDetail -> Maybe Text
$sel:groupList:UserDetail' :: UserDetail -> Maybe [Text]
$sel:createDate:UserDetail' :: UserDetail -> Maybe ISO8601
$sel:attachedManagedPolicies:UserDetail' :: UserDetail -> Maybe [AttachedPolicy]
$sel:arn:UserDetail' :: UserDetail -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [AttachedPolicy]
attachedManagedPolicies
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
createDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
groupList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
path
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AttachedPermissionsBoundary
permissionsBoundary
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
userName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PolicyDetail]
userPolicyList