{-# 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.Chime.Types.Account
-- 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.Chime.Types.Account where

import Amazonka.Chime.Types.AccountStatus
import Amazonka.Chime.Types.AccountType
import Amazonka.Chime.Types.License
import Amazonka.Chime.Types.SigninDelegateGroup
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

-- | The Amazon Chime account details. An AWS account can have multiple
-- Amazon Chime accounts.
--
-- /See:/ 'newAccount' smart constructor.
data Account = Account'
  { -- | The status of the account.
    Account -> Maybe AccountStatus
accountStatus :: Prelude.Maybe AccountStatus,
    -- | The Amazon Chime account type. For more information about different
    -- account types, see
    -- <https://docs.aws.amazon.com/chime/latest/ag/manage-chime-account.html Managing Your Amazon Chime Accounts>
    -- in the /Amazon Chime Administration Guide/.
    Account -> Maybe AccountType
accountType :: Prelude.Maybe AccountType,
    -- | The Amazon Chime account creation timestamp, in ISO 8601 format.
    Account -> Maybe ISO8601
createdTimestamp :: Prelude.Maybe Data.ISO8601,
    -- | The default license for the Amazon Chime account.
    Account -> Maybe License
defaultLicense :: Prelude.Maybe License,
    -- | The sign-in delegate groups associated with the account.
    Account -> Maybe [SigninDelegateGroup]
signinDelegateGroups :: Prelude.Maybe [SigninDelegateGroup],
    -- | Supported licenses for the Amazon Chime account.
    Account -> Maybe [License]
supportedLicenses :: Prelude.Maybe [License],
    -- | The AWS account ID.
    Account -> Text
awsAccountId :: Prelude.Text,
    -- | The Amazon Chime account ID.
    Account -> Text
accountId :: Prelude.Text,
    -- | The Amazon Chime account name.
    Account -> Text
name :: Prelude.Text
  }
  deriving (Account -> Account -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Account -> Account -> Bool
$c/= :: Account -> Account -> Bool
== :: Account -> Account -> Bool
$c== :: Account -> Account -> Bool
Prelude.Eq, ReadPrec [Account]
ReadPrec Account
Int -> ReadS Account
ReadS [Account]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Account]
$creadListPrec :: ReadPrec [Account]
readPrec :: ReadPrec Account
$creadPrec :: ReadPrec Account
readList :: ReadS [Account]
$creadList :: ReadS [Account]
readsPrec :: Int -> ReadS Account
$creadsPrec :: Int -> ReadS Account
Prelude.Read, Int -> Account -> ShowS
[Account] -> ShowS
Account -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Account] -> ShowS
$cshowList :: [Account] -> ShowS
show :: Account -> String
$cshow :: Account -> String
showsPrec :: Int -> Account -> ShowS
$cshowsPrec :: Int -> Account -> ShowS
Prelude.Show, forall x. Rep Account x -> Account
forall x. Account -> Rep Account x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Account x -> Account
$cfrom :: forall x. Account -> Rep Account x
Prelude.Generic)

-- |
-- Create a value of 'Account' 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:
--
-- 'accountStatus', 'account_accountStatus' - The status of the account.
--
-- 'accountType', 'account_accountType' - The Amazon Chime account type. For more information about different
-- account types, see
-- <https://docs.aws.amazon.com/chime/latest/ag/manage-chime-account.html Managing Your Amazon Chime Accounts>
-- in the /Amazon Chime Administration Guide/.
--
-- 'createdTimestamp', 'account_createdTimestamp' - The Amazon Chime account creation timestamp, in ISO 8601 format.
--
-- 'defaultLicense', 'account_defaultLicense' - The default license for the Amazon Chime account.
--
-- 'signinDelegateGroups', 'account_signinDelegateGroups' - The sign-in delegate groups associated with the account.
--
-- 'supportedLicenses', 'account_supportedLicenses' - Supported licenses for the Amazon Chime account.
--
-- 'awsAccountId', 'account_awsAccountId' - The AWS account ID.
--
-- 'accountId', 'account_accountId' - The Amazon Chime account ID.
--
-- 'name', 'account_name' - The Amazon Chime account name.
newAccount ::
  -- | 'awsAccountId'
  Prelude.Text ->
  -- | 'accountId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  Account
newAccount :: Text -> Text -> Text -> Account
newAccount Text
pAwsAccountId_ Text
pAccountId_ Text
pName_ =
  Account'
    { $sel:accountStatus:Account' :: Maybe AccountStatus
accountStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:accountType:Account' :: Maybe AccountType
accountType = forall a. Maybe a
Prelude.Nothing,
      $sel:createdTimestamp:Account' :: Maybe ISO8601
createdTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:defaultLicense:Account' :: Maybe License
defaultLicense = forall a. Maybe a
Prelude.Nothing,
      $sel:signinDelegateGroups:Account' :: Maybe [SigninDelegateGroup]
signinDelegateGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:supportedLicenses:Account' :: Maybe [License]
supportedLicenses = forall a. Maybe a
Prelude.Nothing,
      $sel:awsAccountId:Account' :: Text
awsAccountId = Text
pAwsAccountId_,
      $sel:accountId:Account' :: Text
accountId = Text
pAccountId_,
      $sel:name:Account' :: Text
name = Text
pName_
    }

-- | The status of the account.
account_accountStatus :: Lens.Lens' Account (Prelude.Maybe AccountStatus)
account_accountStatus :: Lens' Account (Maybe AccountStatus)
account_accountStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Account' {Maybe AccountStatus
accountStatus :: Maybe AccountStatus
$sel:accountStatus:Account' :: Account -> Maybe AccountStatus
accountStatus} -> Maybe AccountStatus
accountStatus) (\s :: Account
s@Account' {} Maybe AccountStatus
a -> Account
s {$sel:accountStatus:Account' :: Maybe AccountStatus
accountStatus = Maybe AccountStatus
a} :: Account)

-- | The Amazon Chime account type. For more information about different
-- account types, see
-- <https://docs.aws.amazon.com/chime/latest/ag/manage-chime-account.html Managing Your Amazon Chime Accounts>
-- in the /Amazon Chime Administration Guide/.
account_accountType :: Lens.Lens' Account (Prelude.Maybe AccountType)
account_accountType :: Lens' Account (Maybe AccountType)
account_accountType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Account' {Maybe AccountType
accountType :: Maybe AccountType
$sel:accountType:Account' :: Account -> Maybe AccountType
accountType} -> Maybe AccountType
accountType) (\s :: Account
s@Account' {} Maybe AccountType
a -> Account
s {$sel:accountType:Account' :: Maybe AccountType
accountType = Maybe AccountType
a} :: Account)

-- | The Amazon Chime account creation timestamp, in ISO 8601 format.
account_createdTimestamp :: Lens.Lens' Account (Prelude.Maybe Prelude.UTCTime)
account_createdTimestamp :: Lens' Account (Maybe UTCTime)
account_createdTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Account' {Maybe ISO8601
createdTimestamp :: Maybe ISO8601
$sel:createdTimestamp:Account' :: Account -> Maybe ISO8601
createdTimestamp} -> Maybe ISO8601
createdTimestamp) (\s :: Account
s@Account' {} Maybe ISO8601
a -> Account
s {$sel:createdTimestamp:Account' :: Maybe ISO8601
createdTimestamp = Maybe ISO8601
a} :: Account) 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 default license for the Amazon Chime account.
account_defaultLicense :: Lens.Lens' Account (Prelude.Maybe License)
account_defaultLicense :: Lens' Account (Maybe License)
account_defaultLicense = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Account' {Maybe License
defaultLicense :: Maybe License
$sel:defaultLicense:Account' :: Account -> Maybe License
defaultLicense} -> Maybe License
defaultLicense) (\s :: Account
s@Account' {} Maybe License
a -> Account
s {$sel:defaultLicense:Account' :: Maybe License
defaultLicense = Maybe License
a} :: Account)

-- | The sign-in delegate groups associated with the account.
account_signinDelegateGroups :: Lens.Lens' Account (Prelude.Maybe [SigninDelegateGroup])
account_signinDelegateGroups :: Lens' Account (Maybe [SigninDelegateGroup])
account_signinDelegateGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Account' {Maybe [SigninDelegateGroup]
signinDelegateGroups :: Maybe [SigninDelegateGroup]
$sel:signinDelegateGroups:Account' :: Account -> Maybe [SigninDelegateGroup]
signinDelegateGroups} -> Maybe [SigninDelegateGroup]
signinDelegateGroups) (\s :: Account
s@Account' {} Maybe [SigninDelegateGroup]
a -> Account
s {$sel:signinDelegateGroups:Account' :: Maybe [SigninDelegateGroup]
signinDelegateGroups = Maybe [SigninDelegateGroup]
a} :: Account) 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

-- | Supported licenses for the Amazon Chime account.
account_supportedLicenses :: Lens.Lens' Account (Prelude.Maybe [License])
account_supportedLicenses :: Lens' Account (Maybe [License])
account_supportedLicenses = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Account' {Maybe [License]
supportedLicenses :: Maybe [License]
$sel:supportedLicenses:Account' :: Account -> Maybe [License]
supportedLicenses} -> Maybe [License]
supportedLicenses) (\s :: Account
s@Account' {} Maybe [License]
a -> Account
s {$sel:supportedLicenses:Account' :: Maybe [License]
supportedLicenses = Maybe [License]
a} :: Account) 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 AWS account ID.
account_awsAccountId :: Lens.Lens' Account Prelude.Text
account_awsAccountId :: Lens' Account Text
account_awsAccountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Account' {Text
awsAccountId :: Text
$sel:awsAccountId:Account' :: Account -> Text
awsAccountId} -> Text
awsAccountId) (\s :: Account
s@Account' {} Text
a -> Account
s {$sel:awsAccountId:Account' :: Text
awsAccountId = Text
a} :: Account)

-- | The Amazon Chime account ID.
account_accountId :: Lens.Lens' Account Prelude.Text
account_accountId :: Lens' Account Text
account_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Account' {Text
accountId :: Text
$sel:accountId:Account' :: Account -> Text
accountId} -> Text
accountId) (\s :: Account
s@Account' {} Text
a -> Account
s {$sel:accountId:Account' :: Text
accountId = Text
a} :: Account)

-- | The Amazon Chime account name.
account_name :: Lens.Lens' Account Prelude.Text
account_name :: Lens' Account Text
account_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Account' {Text
name :: Text
$sel:name:Account' :: Account -> Text
name} -> Text
name) (\s :: Account
s@Account' {} Text
a -> Account
s {$sel:name:Account' :: Text
name = Text
a} :: Account)

instance Data.FromJSON Account where
  parseJSON :: Value -> Parser Account
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Account"
      ( \Object
x ->
          Maybe AccountStatus
-> Maybe AccountType
-> Maybe ISO8601
-> Maybe License
-> Maybe [SigninDelegateGroup]
-> Maybe [License]
-> Text
-> Text
-> Text
-> Account
Account'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AccountStatus")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AccountType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"CreatedTimestamp")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"DefaultLicense")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SigninDelegateGroups"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SupportedLicenses"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"AwsAccountId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"AccountId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"Name")
      )

instance Prelude.Hashable Account where
  hashWithSalt :: Int -> Account -> Int
hashWithSalt Int
_salt Account' {Maybe [License]
Maybe [SigninDelegateGroup]
Maybe ISO8601
Maybe AccountStatus
Maybe AccountType
Maybe License
Text
name :: Text
accountId :: Text
awsAccountId :: Text
supportedLicenses :: Maybe [License]
signinDelegateGroups :: Maybe [SigninDelegateGroup]
defaultLicense :: Maybe License
createdTimestamp :: Maybe ISO8601
accountType :: Maybe AccountType
accountStatus :: Maybe AccountStatus
$sel:name:Account' :: Account -> Text
$sel:accountId:Account' :: Account -> Text
$sel:awsAccountId:Account' :: Account -> Text
$sel:supportedLicenses:Account' :: Account -> Maybe [License]
$sel:signinDelegateGroups:Account' :: Account -> Maybe [SigninDelegateGroup]
$sel:defaultLicense:Account' :: Account -> Maybe License
$sel:createdTimestamp:Account' :: Account -> Maybe ISO8601
$sel:accountType:Account' :: Account -> Maybe AccountType
$sel:accountStatus:Account' :: Account -> Maybe AccountStatus
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AccountStatus
accountStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AccountType
accountType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
createdTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe License
defaultLicense
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [SigninDelegateGroup]
signinDelegateGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [License]
supportedLicenses
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
awsAccountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData Account where
  rnf :: Account -> ()
rnf Account' {Maybe [License]
Maybe [SigninDelegateGroup]
Maybe ISO8601
Maybe AccountStatus
Maybe AccountType
Maybe License
Text
name :: Text
accountId :: Text
awsAccountId :: Text
supportedLicenses :: Maybe [License]
signinDelegateGroups :: Maybe [SigninDelegateGroup]
defaultLicense :: Maybe License
createdTimestamp :: Maybe ISO8601
accountType :: Maybe AccountType
accountStatus :: Maybe AccountStatus
$sel:name:Account' :: Account -> Text
$sel:accountId:Account' :: Account -> Text
$sel:awsAccountId:Account' :: Account -> Text
$sel:supportedLicenses:Account' :: Account -> Maybe [License]
$sel:signinDelegateGroups:Account' :: Account -> Maybe [SigninDelegateGroup]
$sel:defaultLicense:Account' :: Account -> Maybe License
$sel:createdTimestamp:Account' :: Account -> Maybe ISO8601
$sel:accountType:Account' :: Account -> Maybe AccountType
$sel:accountStatus:Account' :: Account -> Maybe AccountStatus
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AccountStatus
accountStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AccountType
accountType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
createdTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe License
defaultLicense
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SigninDelegateGroup]
signinDelegateGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [License]
supportedLicenses
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
awsAccountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name