{-# 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.Connect.Types.Instance
-- 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.Connect.Types.Instance where

import Amazonka.Connect.Types.DirectoryType
import Amazonka.Connect.Types.InstanceStatus
import Amazonka.Connect.Types.InstanceStatusReason
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 Connect instance.
--
-- /See:/ 'newInstance' smart constructor.
data Instance = Instance'
  { -- | The Amazon Resource Name (ARN) of the instance.
    Instance -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | When the instance was created.
    Instance -> Maybe POSIX
createdTime :: Prelude.Maybe Data.POSIX,
    -- | The identifier of the Amazon Connect instance. You can find the
    -- instanceId in the ARN of the instance.
    Instance -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The identity management type.
    Instance -> Maybe DirectoryType
identityManagementType :: Prelude.Maybe DirectoryType,
    -- | Whether inbound calls are enabled.
    Instance -> Maybe Bool
inboundCallsEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The alias of instance.
    Instance -> Maybe (Sensitive Text)
instanceAlias :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The state of the instance.
    Instance -> Maybe InstanceStatus
instanceStatus :: Prelude.Maybe InstanceStatus,
    -- | Whether outbound calls are enabled.
    Instance -> Maybe Bool
outboundCallsEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The service role of the instance.
    Instance -> Maybe Text
serviceRole :: Prelude.Maybe Prelude.Text,
    -- | Relevant details why the instance was not successfully created.
    Instance -> Maybe InstanceStatusReason
statusReason :: Prelude.Maybe InstanceStatusReason
  }
  deriving (Instance -> Instance -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Instance -> Instance -> Bool
$c/= :: Instance -> Instance -> Bool
== :: Instance -> Instance -> Bool
$c== :: Instance -> Instance -> Bool
Prelude.Eq, Int -> Instance -> ShowS
[Instance] -> ShowS
Instance -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Instance] -> ShowS
$cshowList :: [Instance] -> ShowS
show :: Instance -> String
$cshow :: Instance -> String
showsPrec :: Int -> Instance -> ShowS
$cshowsPrec :: Int -> Instance -> ShowS
Prelude.Show, forall x. Rep Instance x -> Instance
forall x. Instance -> Rep Instance x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Instance x -> Instance
$cfrom :: forall x. Instance -> Rep Instance x
Prelude.Generic)

-- |
-- Create a value of 'Instance' 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', 'instance_arn' - The Amazon Resource Name (ARN) of the instance.
--
-- 'createdTime', 'instance_createdTime' - When the instance was created.
--
-- 'id', 'instance_id' - The identifier of the Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
--
-- 'identityManagementType', 'instance_identityManagementType' - The identity management type.
--
-- 'inboundCallsEnabled', 'instance_inboundCallsEnabled' - Whether inbound calls are enabled.
--
-- 'instanceAlias', 'instance_instanceAlias' - The alias of instance.
--
-- 'instanceStatus', 'instance_instanceStatus' - The state of the instance.
--
-- 'outboundCallsEnabled', 'instance_outboundCallsEnabled' - Whether outbound calls are enabled.
--
-- 'serviceRole', 'instance_serviceRole' - The service role of the instance.
--
-- 'statusReason', 'instance_statusReason' - Relevant details why the instance was not successfully created.
newInstance ::
  Instance
newInstance :: Instance
newInstance =
  Instance'
    { $sel:arn:Instance' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:createdTime:Instance' :: Maybe POSIX
createdTime = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Instance' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:identityManagementType:Instance' :: Maybe DirectoryType
identityManagementType = forall a. Maybe a
Prelude.Nothing,
      $sel:inboundCallsEnabled:Instance' :: Maybe Bool
inboundCallsEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceAlias:Instance' :: Maybe (Sensitive Text)
instanceAlias = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceStatus:Instance' :: Maybe InstanceStatus
instanceStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:outboundCallsEnabled:Instance' :: Maybe Bool
outboundCallsEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceRole:Instance' :: Maybe Text
serviceRole = forall a. Maybe a
Prelude.Nothing,
      $sel:statusReason:Instance' :: Maybe InstanceStatusReason
statusReason = forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon Resource Name (ARN) of the instance.
instance_arn :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_arn :: Lens' Instance (Maybe Text)
instance_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
arn :: Maybe Text
$sel:arn:Instance' :: Instance -> Maybe Text
arn} -> Maybe Text
arn) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:arn:Instance' :: Maybe Text
arn = Maybe Text
a} :: Instance)

-- | When the instance was created.
instance_createdTime :: Lens.Lens' Instance (Prelude.Maybe Prelude.UTCTime)
instance_createdTime :: Lens' Instance (Maybe UTCTime)
instance_createdTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe POSIX
createdTime :: Maybe POSIX
$sel:createdTime:Instance' :: Instance -> Maybe POSIX
createdTime} -> Maybe POSIX
createdTime) (\s :: Instance
s@Instance' {} Maybe POSIX
a -> Instance
s {$sel:createdTime:Instance' :: Maybe POSIX
createdTime = Maybe POSIX
a} :: Instance) 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 Amazon Connect instance. You can find the
-- instanceId in the ARN of the instance.
instance_id :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_id :: Lens' Instance (Maybe Text)
instance_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
id :: Maybe Text
$sel:id:Instance' :: Instance -> Maybe Text
id} -> Maybe Text
id) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:id:Instance' :: Maybe Text
id = Maybe Text
a} :: Instance)

-- | The identity management type.
instance_identityManagementType :: Lens.Lens' Instance (Prelude.Maybe DirectoryType)
instance_identityManagementType :: Lens' Instance (Maybe DirectoryType)
instance_identityManagementType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe DirectoryType
identityManagementType :: Maybe DirectoryType
$sel:identityManagementType:Instance' :: Instance -> Maybe DirectoryType
identityManagementType} -> Maybe DirectoryType
identityManagementType) (\s :: Instance
s@Instance' {} Maybe DirectoryType
a -> Instance
s {$sel:identityManagementType:Instance' :: Maybe DirectoryType
identityManagementType = Maybe DirectoryType
a} :: Instance)

-- | Whether inbound calls are enabled.
instance_inboundCallsEnabled :: Lens.Lens' Instance (Prelude.Maybe Prelude.Bool)
instance_inboundCallsEnabled :: Lens' Instance (Maybe Bool)
instance_inboundCallsEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Bool
inboundCallsEnabled :: Maybe Bool
$sel:inboundCallsEnabled:Instance' :: Instance -> Maybe Bool
inboundCallsEnabled} -> Maybe Bool
inboundCallsEnabled) (\s :: Instance
s@Instance' {} Maybe Bool
a -> Instance
s {$sel:inboundCallsEnabled:Instance' :: Maybe Bool
inboundCallsEnabled = Maybe Bool
a} :: Instance)

-- | The alias of instance.
instance_instanceAlias :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_instanceAlias :: Lens' Instance (Maybe Text)
instance_instanceAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe (Sensitive Text)
instanceAlias :: Maybe (Sensitive Text)
$sel:instanceAlias:Instance' :: Instance -> Maybe (Sensitive Text)
instanceAlias} -> Maybe (Sensitive Text)
instanceAlias) (\s :: Instance
s@Instance' {} Maybe (Sensitive Text)
a -> Instance
s {$sel:instanceAlias:Instance' :: Maybe (Sensitive Text)
instanceAlias = Maybe (Sensitive Text)
a} :: Instance) 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. Iso' (Sensitive a) a
Data._Sensitive

-- | The state of the instance.
instance_instanceStatus :: Lens.Lens' Instance (Prelude.Maybe InstanceStatus)
instance_instanceStatus :: Lens' Instance (Maybe InstanceStatus)
instance_instanceStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe InstanceStatus
instanceStatus :: Maybe InstanceStatus
$sel:instanceStatus:Instance' :: Instance -> Maybe InstanceStatus
instanceStatus} -> Maybe InstanceStatus
instanceStatus) (\s :: Instance
s@Instance' {} Maybe InstanceStatus
a -> Instance
s {$sel:instanceStatus:Instance' :: Maybe InstanceStatus
instanceStatus = Maybe InstanceStatus
a} :: Instance)

-- | Whether outbound calls are enabled.
instance_outboundCallsEnabled :: Lens.Lens' Instance (Prelude.Maybe Prelude.Bool)
instance_outboundCallsEnabled :: Lens' Instance (Maybe Bool)
instance_outboundCallsEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Bool
outboundCallsEnabled :: Maybe Bool
$sel:outboundCallsEnabled:Instance' :: Instance -> Maybe Bool
outboundCallsEnabled} -> Maybe Bool
outboundCallsEnabled) (\s :: Instance
s@Instance' {} Maybe Bool
a -> Instance
s {$sel:outboundCallsEnabled:Instance' :: Maybe Bool
outboundCallsEnabled = Maybe Bool
a} :: Instance)

-- | The service role of the instance.
instance_serviceRole :: Lens.Lens' Instance (Prelude.Maybe Prelude.Text)
instance_serviceRole :: Lens' Instance (Maybe Text)
instance_serviceRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe Text
serviceRole :: Maybe Text
$sel:serviceRole:Instance' :: Instance -> Maybe Text
serviceRole} -> Maybe Text
serviceRole) (\s :: Instance
s@Instance' {} Maybe Text
a -> Instance
s {$sel:serviceRole:Instance' :: Maybe Text
serviceRole = Maybe Text
a} :: Instance)

-- | Relevant details why the instance was not successfully created.
instance_statusReason :: Lens.Lens' Instance (Prelude.Maybe InstanceStatusReason)
instance_statusReason :: Lens' Instance (Maybe InstanceStatusReason)
instance_statusReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Instance' {Maybe InstanceStatusReason
statusReason :: Maybe InstanceStatusReason
$sel:statusReason:Instance' :: Instance -> Maybe InstanceStatusReason
statusReason} -> Maybe InstanceStatusReason
statusReason) (\s :: Instance
s@Instance' {} Maybe InstanceStatusReason
a -> Instance
s {$sel:statusReason:Instance' :: Maybe InstanceStatusReason
statusReason = Maybe InstanceStatusReason
a} :: Instance)

instance Data.FromJSON Instance where
  parseJSON :: Value -> Parser Instance
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Instance"
      ( \Object
x ->
          Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe DirectoryType
-> Maybe Bool
-> Maybe (Sensitive Text)
-> Maybe InstanceStatus
-> Maybe Bool
-> Maybe Text
-> Maybe InstanceStatusReason
-> Instance
Instance'
            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
"Arn")
            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
"CreatedTime")
            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
"Id")
            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
"IdentityManagementType")
            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
"InboundCallsEnabled")
            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
"InstanceAlias")
            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
"InstanceStatus")
            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
"OutboundCallsEnabled")
            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
"ServiceRole")
            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
"StatusReason")
      )

instance Prelude.Hashable Instance where
  hashWithSalt :: Int -> Instance -> Int
hashWithSalt Int
_salt Instance' {Maybe Bool
Maybe Text
Maybe (Sensitive Text)
Maybe POSIX
Maybe DirectoryType
Maybe InstanceStatus
Maybe InstanceStatusReason
statusReason :: Maybe InstanceStatusReason
serviceRole :: Maybe Text
outboundCallsEnabled :: Maybe Bool
instanceStatus :: Maybe InstanceStatus
instanceAlias :: Maybe (Sensitive Text)
inboundCallsEnabled :: Maybe Bool
identityManagementType :: Maybe DirectoryType
id :: Maybe Text
createdTime :: Maybe POSIX
arn :: Maybe Text
$sel:statusReason:Instance' :: Instance -> Maybe InstanceStatusReason
$sel:serviceRole:Instance' :: Instance -> Maybe Text
$sel:outboundCallsEnabled:Instance' :: Instance -> Maybe Bool
$sel:instanceStatus:Instance' :: Instance -> Maybe InstanceStatus
$sel:instanceAlias:Instance' :: Instance -> Maybe (Sensitive Text)
$sel:inboundCallsEnabled:Instance' :: Instance -> Maybe Bool
$sel:identityManagementType:Instance' :: Instance -> Maybe DirectoryType
$sel:id:Instance' :: Instance -> Maybe Text
$sel:createdTime:Instance' :: Instance -> Maybe POSIX
$sel:arn:Instance' :: Instance -> 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 POSIX
createdTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DirectoryType
identityManagementType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
inboundCallsEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
instanceAlias
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceStatus
instanceStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
outboundCallsEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe InstanceStatusReason
statusReason

instance Prelude.NFData Instance where
  rnf :: Instance -> ()
rnf Instance' {Maybe Bool
Maybe Text
Maybe (Sensitive Text)
Maybe POSIX
Maybe DirectoryType
Maybe InstanceStatus
Maybe InstanceStatusReason
statusReason :: Maybe InstanceStatusReason
serviceRole :: Maybe Text
outboundCallsEnabled :: Maybe Bool
instanceStatus :: Maybe InstanceStatus
instanceAlias :: Maybe (Sensitive Text)
inboundCallsEnabled :: Maybe Bool
identityManagementType :: Maybe DirectoryType
id :: Maybe Text
createdTime :: Maybe POSIX
arn :: Maybe Text
$sel:statusReason:Instance' :: Instance -> Maybe InstanceStatusReason
$sel:serviceRole:Instance' :: Instance -> Maybe Text
$sel:outboundCallsEnabled:Instance' :: Instance -> Maybe Bool
$sel:instanceStatus:Instance' :: Instance -> Maybe InstanceStatus
$sel:instanceAlias:Instance' :: Instance -> Maybe (Sensitive Text)
$sel:inboundCallsEnabled:Instance' :: Instance -> Maybe Bool
$sel:identityManagementType:Instance' :: Instance -> Maybe DirectoryType
$sel:id:Instance' :: Instance -> Maybe Text
$sel:createdTime:Instance' :: Instance -> Maybe POSIX
$sel:arn:Instance' :: Instance -> 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 POSIX
createdTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DirectoryType
identityManagementType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
inboundCallsEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
instanceAlias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceStatus
instanceStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
outboundCallsEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe InstanceStatusReason
statusReason