{-# 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.Channel
-- 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.Channel where

import Amazonka.Chime.Types.ChannelMode
import Amazonka.Chime.Types.ChannelPrivacy
import Amazonka.Chime.Types.Identity
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 details of a channel.
--
-- /See:/ 'newChannel' smart constructor.
data Channel = Channel'
  { -- | The ARN of the channel.
    Channel -> Maybe Text
channelArn :: Prelude.Maybe Prelude.Text,
    -- | The @AppInstanceUser@ who created the channel.
    Channel -> Maybe Identity
createdBy :: Prelude.Maybe Identity,
    -- | The time at which the @AppInstanceUser@ created the channel.
    Channel -> Maybe POSIX
createdTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The time at which a member sent the last message in the channel.
    Channel -> Maybe POSIX
lastMessageTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The time at which a channel was last updated.
    Channel -> Maybe POSIX
lastUpdatedTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The channel\'s metadata.
    Channel -> Maybe (Sensitive Text)
metadata :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The mode of the channel.
    Channel -> Maybe ChannelMode
mode :: Prelude.Maybe ChannelMode,
    -- | The name of the channel.
    Channel -> Maybe (Sensitive Text)
name :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The channel\'s privacy setting.
    Channel -> Maybe ChannelPrivacy
privacy :: Prelude.Maybe ChannelPrivacy
  }
  deriving (Channel -> Channel -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Channel -> Channel -> Bool
$c/= :: Channel -> Channel -> Bool
== :: Channel -> Channel -> Bool
$c== :: Channel -> Channel -> Bool
Prelude.Eq, Int -> Channel -> ShowS
[Channel] -> ShowS
Channel -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Channel] -> ShowS
$cshowList :: [Channel] -> ShowS
show :: Channel -> String
$cshow :: Channel -> String
showsPrec :: Int -> Channel -> ShowS
$cshowsPrec :: Int -> Channel -> ShowS
Prelude.Show, forall x. Rep Channel x -> Channel
forall x. Channel -> Rep Channel x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Channel x -> Channel
$cfrom :: forall x. Channel -> Rep Channel x
Prelude.Generic)

-- |
-- Create a value of 'Channel' 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:
--
-- 'channelArn', 'channel_channelArn' - The ARN of the channel.
--
-- 'createdBy', 'channel_createdBy' - The @AppInstanceUser@ who created the channel.
--
-- 'createdTimestamp', 'channel_createdTimestamp' - The time at which the @AppInstanceUser@ created the channel.
--
-- 'lastMessageTimestamp', 'channel_lastMessageTimestamp' - The time at which a member sent the last message in the channel.
--
-- 'lastUpdatedTimestamp', 'channel_lastUpdatedTimestamp' - The time at which a channel was last updated.
--
-- 'metadata', 'channel_metadata' - The channel\'s metadata.
--
-- 'mode', 'channel_mode' - The mode of the channel.
--
-- 'name', 'channel_name' - The name of the channel.
--
-- 'privacy', 'channel_privacy' - The channel\'s privacy setting.
newChannel ::
  Channel
newChannel :: Channel
newChannel =
  Channel'
    { $sel:channelArn:Channel' :: Maybe Text
channelArn = forall a. Maybe a
Prelude.Nothing,
      $sel:createdBy:Channel' :: Maybe Identity
createdBy = forall a. Maybe a
Prelude.Nothing,
      $sel:createdTimestamp:Channel' :: Maybe POSIX
createdTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:lastMessageTimestamp:Channel' :: Maybe POSIX
lastMessageTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdatedTimestamp:Channel' :: Maybe POSIX
lastUpdatedTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:metadata:Channel' :: Maybe (Sensitive Text)
metadata = forall a. Maybe a
Prelude.Nothing,
      $sel:mode:Channel' :: Maybe ChannelMode
mode = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Channel' :: Maybe (Sensitive Text)
name = forall a. Maybe a
Prelude.Nothing,
      $sel:privacy:Channel' :: Maybe ChannelPrivacy
privacy = forall a. Maybe a
Prelude.Nothing
    }

-- | The ARN of the channel.
channel_channelArn :: Lens.Lens' Channel (Prelude.Maybe Prelude.Text)
channel_channelArn :: Lens' Channel (Maybe Text)
channel_channelArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe Text
channelArn :: Maybe Text
$sel:channelArn:Channel' :: Channel -> Maybe Text
channelArn} -> Maybe Text
channelArn) (\s :: Channel
s@Channel' {} Maybe Text
a -> Channel
s {$sel:channelArn:Channel' :: Maybe Text
channelArn = Maybe Text
a} :: Channel)

-- | The @AppInstanceUser@ who created the channel.
channel_createdBy :: Lens.Lens' Channel (Prelude.Maybe Identity)
channel_createdBy :: Lens' Channel (Maybe Identity)
channel_createdBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe Identity
createdBy :: Maybe Identity
$sel:createdBy:Channel' :: Channel -> Maybe Identity
createdBy} -> Maybe Identity
createdBy) (\s :: Channel
s@Channel' {} Maybe Identity
a -> Channel
s {$sel:createdBy:Channel' :: Maybe Identity
createdBy = Maybe Identity
a} :: Channel)

-- | The time at which the @AppInstanceUser@ created the channel.
channel_createdTimestamp :: Lens.Lens' Channel (Prelude.Maybe Prelude.UTCTime)
channel_createdTimestamp :: Lens' Channel (Maybe UTCTime)
channel_createdTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe POSIX
createdTimestamp :: Maybe POSIX
$sel:createdTimestamp:Channel' :: Channel -> Maybe POSIX
createdTimestamp} -> Maybe POSIX
createdTimestamp) (\s :: Channel
s@Channel' {} Maybe POSIX
a -> Channel
s {$sel:createdTimestamp:Channel' :: Maybe POSIX
createdTimestamp = Maybe POSIX
a} :: Channel) 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 time at which a member sent the last message in the channel.
channel_lastMessageTimestamp :: Lens.Lens' Channel (Prelude.Maybe Prelude.UTCTime)
channel_lastMessageTimestamp :: Lens' Channel (Maybe UTCTime)
channel_lastMessageTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe POSIX
lastMessageTimestamp :: Maybe POSIX
$sel:lastMessageTimestamp:Channel' :: Channel -> Maybe POSIX
lastMessageTimestamp} -> Maybe POSIX
lastMessageTimestamp) (\s :: Channel
s@Channel' {} Maybe POSIX
a -> Channel
s {$sel:lastMessageTimestamp:Channel' :: Maybe POSIX
lastMessageTimestamp = Maybe POSIX
a} :: Channel) 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 time at which a channel was last updated.
channel_lastUpdatedTimestamp :: Lens.Lens' Channel (Prelude.Maybe Prelude.UTCTime)
channel_lastUpdatedTimestamp :: Lens' Channel (Maybe UTCTime)
channel_lastUpdatedTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe POSIX
lastUpdatedTimestamp :: Maybe POSIX
$sel:lastUpdatedTimestamp:Channel' :: Channel -> Maybe POSIX
lastUpdatedTimestamp} -> Maybe POSIX
lastUpdatedTimestamp) (\s :: Channel
s@Channel' {} Maybe POSIX
a -> Channel
s {$sel:lastUpdatedTimestamp:Channel' :: Maybe POSIX
lastUpdatedTimestamp = Maybe POSIX
a} :: Channel) 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 channel\'s metadata.
channel_metadata :: Lens.Lens' Channel (Prelude.Maybe Prelude.Text)
channel_metadata :: Lens' Channel (Maybe Text)
channel_metadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe (Sensitive Text)
metadata :: Maybe (Sensitive Text)
$sel:metadata:Channel' :: Channel -> Maybe (Sensitive Text)
metadata} -> Maybe (Sensitive Text)
metadata) (\s :: Channel
s@Channel' {} Maybe (Sensitive Text)
a -> Channel
s {$sel:metadata:Channel' :: Maybe (Sensitive Text)
metadata = Maybe (Sensitive Text)
a} :: Channel) 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 mode of the channel.
channel_mode :: Lens.Lens' Channel (Prelude.Maybe ChannelMode)
channel_mode :: Lens' Channel (Maybe ChannelMode)
channel_mode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe ChannelMode
mode :: Maybe ChannelMode
$sel:mode:Channel' :: Channel -> Maybe ChannelMode
mode} -> Maybe ChannelMode
mode) (\s :: Channel
s@Channel' {} Maybe ChannelMode
a -> Channel
s {$sel:mode:Channel' :: Maybe ChannelMode
mode = Maybe ChannelMode
a} :: Channel)

-- | The name of the channel.
channel_name :: Lens.Lens' Channel (Prelude.Maybe Prelude.Text)
channel_name :: Lens' Channel (Maybe Text)
channel_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe (Sensitive Text)
name :: Maybe (Sensitive Text)
$sel:name:Channel' :: Channel -> Maybe (Sensitive Text)
name} -> Maybe (Sensitive Text)
name) (\s :: Channel
s@Channel' {} Maybe (Sensitive Text)
a -> Channel
s {$sel:name:Channel' :: Maybe (Sensitive Text)
name = Maybe (Sensitive Text)
a} :: Channel) 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 channel\'s privacy setting.
channel_privacy :: Lens.Lens' Channel (Prelude.Maybe ChannelPrivacy)
channel_privacy :: Lens' Channel (Maybe ChannelPrivacy)
channel_privacy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe ChannelPrivacy
privacy :: Maybe ChannelPrivacy
$sel:privacy:Channel' :: Channel -> Maybe ChannelPrivacy
privacy} -> Maybe ChannelPrivacy
privacy) (\s :: Channel
s@Channel' {} Maybe ChannelPrivacy
a -> Channel
s {$sel:privacy:Channel' :: Maybe ChannelPrivacy
privacy = Maybe ChannelPrivacy
a} :: Channel)

instance Data.FromJSON Channel where
  parseJSON :: Value -> Parser Channel
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Channel"
      ( \Object
x ->
          Maybe Text
-> Maybe Identity
-> Maybe POSIX
-> Maybe POSIX
-> Maybe POSIX
-> Maybe (Sensitive Text)
-> Maybe ChannelMode
-> Maybe (Sensitive Text)
-> Maybe ChannelPrivacy
-> Channel
Channel'
            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
"ChannelArn")
            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
"CreatedBy")
            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
"LastMessageTimestamp")
            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
"LastUpdatedTimestamp")
            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
"Metadata")
            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
"Mode")
            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
"Name")
            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
"Privacy")
      )

instance Prelude.Hashable Channel where
  hashWithSalt :: Int -> Channel -> Int
hashWithSalt Int
_salt Channel' {Maybe Text
Maybe (Sensitive Text)
Maybe POSIX
Maybe ChannelMode
Maybe ChannelPrivacy
Maybe Identity
privacy :: Maybe ChannelPrivacy
name :: Maybe (Sensitive Text)
mode :: Maybe ChannelMode
metadata :: Maybe (Sensitive Text)
lastUpdatedTimestamp :: Maybe POSIX
lastMessageTimestamp :: Maybe POSIX
createdTimestamp :: Maybe POSIX
createdBy :: Maybe Identity
channelArn :: Maybe Text
$sel:privacy:Channel' :: Channel -> Maybe ChannelPrivacy
$sel:name:Channel' :: Channel -> Maybe (Sensitive Text)
$sel:mode:Channel' :: Channel -> Maybe ChannelMode
$sel:metadata:Channel' :: Channel -> Maybe (Sensitive Text)
$sel:lastUpdatedTimestamp:Channel' :: Channel -> Maybe POSIX
$sel:lastMessageTimestamp:Channel' :: Channel -> Maybe POSIX
$sel:createdTimestamp:Channel' :: Channel -> Maybe POSIX
$sel:createdBy:Channel' :: Channel -> Maybe Identity
$sel:channelArn:Channel' :: Channel -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
channelArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Identity
createdBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
createdTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastMessageTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastUpdatedTimestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
metadata
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChannelMode
mode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChannelPrivacy
privacy

instance Prelude.NFData Channel where
  rnf :: Channel -> ()
rnf Channel' {Maybe Text
Maybe (Sensitive Text)
Maybe POSIX
Maybe ChannelMode
Maybe ChannelPrivacy
Maybe Identity
privacy :: Maybe ChannelPrivacy
name :: Maybe (Sensitive Text)
mode :: Maybe ChannelMode
metadata :: Maybe (Sensitive Text)
lastUpdatedTimestamp :: Maybe POSIX
lastMessageTimestamp :: Maybe POSIX
createdTimestamp :: Maybe POSIX
createdBy :: Maybe Identity
channelArn :: Maybe Text
$sel:privacy:Channel' :: Channel -> Maybe ChannelPrivacy
$sel:name:Channel' :: Channel -> Maybe (Sensitive Text)
$sel:mode:Channel' :: Channel -> Maybe ChannelMode
$sel:metadata:Channel' :: Channel -> Maybe (Sensitive Text)
$sel:lastUpdatedTimestamp:Channel' :: Channel -> Maybe POSIX
$sel:lastMessageTimestamp:Channel' :: Channel -> Maybe POSIX
$sel:createdTimestamp:Channel' :: Channel -> Maybe POSIX
$sel:createdBy:Channel' :: Channel -> Maybe Identity
$sel:channelArn:Channel' :: Channel -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
channelArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Identity
createdBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastMessageTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdatedTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
metadata
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChannelMode
mode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChannelPrivacy
privacy