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

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.IoTAnalytics.Types.ChannelStatus
import Amazonka.IoTAnalytics.Types.ChannelStorage
import Amazonka.IoTAnalytics.Types.RetentionPeriod
import qualified Amazonka.Prelude as Prelude

-- | A collection of data from an MQTT topic. Channels archive the raw,
-- unprocessed messages before publishing the data to a pipeline.
--
-- /See:/ 'newChannel' smart constructor.
data Channel = Channel'
  { -- | The ARN of the channel.
    Channel -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | When the channel was created.
    Channel -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The last time when a new message arrived in the channel.
    --
    -- IoT Analytics updates this value at most once per minute for one
    -- channel. Hence, the @lastMessageArrivalTime@ value is an approximation.
    --
    -- This feature only applies to messages that arrived in the data store
    -- after October 23, 2020.
    Channel -> Maybe POSIX
lastMessageArrivalTime :: Prelude.Maybe Data.POSIX,
    -- | When the channel was last updated.
    Channel -> Maybe POSIX
lastUpdateTime :: Prelude.Maybe Data.POSIX,
    -- | The name of the channel.
    Channel -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | How long, in days, message data is kept for the channel.
    Channel -> Maybe RetentionPeriod
retentionPeriod :: Prelude.Maybe RetentionPeriod,
    -- | The status of the channel.
    Channel -> Maybe ChannelStatus
status :: Prelude.Maybe ChannelStatus,
    -- | Where channel data is stored. You can choose one of @serviceManagedS3@
    -- or @customerManagedS3@ storage. If not specified, the default is
    -- @serviceManagedS3@. You can\'t change this storage option after the
    -- channel is created.
    Channel -> Maybe ChannelStorage
storage :: Prelude.Maybe ChannelStorage
  }
  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, ReadPrec [Channel]
ReadPrec Channel
Int -> ReadS Channel
ReadS [Channel]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Channel]
$creadListPrec :: ReadPrec [Channel]
readPrec :: ReadPrec Channel
$creadPrec :: ReadPrec Channel
readList :: ReadS [Channel]
$creadList :: ReadS [Channel]
readsPrec :: Int -> ReadS Channel
$creadsPrec :: Int -> ReadS Channel
Prelude.Read, 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:
--
-- 'arn', 'channel_arn' - The ARN of the channel.
--
-- 'creationTime', 'channel_creationTime' - When the channel was created.
--
-- 'lastMessageArrivalTime', 'channel_lastMessageArrivalTime' - The last time when a new message arrived in the channel.
--
-- IoT Analytics updates this value at most once per minute for one
-- channel. Hence, the @lastMessageArrivalTime@ value is an approximation.
--
-- This feature only applies to messages that arrived in the data store
-- after October 23, 2020.
--
-- 'lastUpdateTime', 'channel_lastUpdateTime' - When the channel was last updated.
--
-- 'name', 'channel_name' - The name of the channel.
--
-- 'retentionPeriod', 'channel_retentionPeriod' - How long, in days, message data is kept for the channel.
--
-- 'status', 'channel_status' - The status of the channel.
--
-- 'storage', 'channel_storage' - Where channel data is stored. You can choose one of @serviceManagedS3@
-- or @customerManagedS3@ storage. If not specified, the default is
-- @serviceManagedS3@. You can\'t change this storage option after the
-- channel is created.
newChannel ::
  Channel
newChannel :: Channel
newChannel =
  Channel'
    { $sel:arn:Channel' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:Channel' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lastMessageArrivalTime:Channel' :: Maybe POSIX
lastMessageArrivalTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdateTime:Channel' :: Maybe POSIX
lastUpdateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Channel' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:retentionPeriod:Channel' :: Maybe RetentionPeriod
retentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Channel' :: Maybe ChannelStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:storage:Channel' :: Maybe ChannelStorage
storage = forall a. Maybe a
Prelude.Nothing
    }

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

-- | When the channel was created.
channel_creationTime :: Lens.Lens' Channel (Prelude.Maybe Prelude.UTCTime)
channel_creationTime :: Lens' Channel (Maybe UTCTime)
channel_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:Channel' :: Channel -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: Channel
s@Channel' {} Maybe POSIX
a -> Channel
s {$sel:creationTime:Channel' :: Maybe POSIX
creationTime = 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 last time when a new message arrived in the channel.
--
-- IoT Analytics updates this value at most once per minute for one
-- channel. Hence, the @lastMessageArrivalTime@ value is an approximation.
--
-- This feature only applies to messages that arrived in the data store
-- after October 23, 2020.
channel_lastMessageArrivalTime :: Lens.Lens' Channel (Prelude.Maybe Prelude.UTCTime)
channel_lastMessageArrivalTime :: Lens' Channel (Maybe UTCTime)
channel_lastMessageArrivalTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe POSIX
lastMessageArrivalTime :: Maybe POSIX
$sel:lastMessageArrivalTime:Channel' :: Channel -> Maybe POSIX
lastMessageArrivalTime} -> Maybe POSIX
lastMessageArrivalTime) (\s :: Channel
s@Channel' {} Maybe POSIX
a -> Channel
s {$sel:lastMessageArrivalTime:Channel' :: Maybe POSIX
lastMessageArrivalTime = 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

-- | When the channel was last updated.
channel_lastUpdateTime :: Lens.Lens' Channel (Prelude.Maybe Prelude.UTCTime)
channel_lastUpdateTime :: Lens' Channel (Maybe UTCTime)
channel_lastUpdateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe POSIX
lastUpdateTime :: Maybe POSIX
$sel:lastUpdateTime:Channel' :: Channel -> Maybe POSIX
lastUpdateTime} -> Maybe POSIX
lastUpdateTime) (\s :: Channel
s@Channel' {} Maybe POSIX
a -> Channel
s {$sel:lastUpdateTime:Channel' :: Maybe POSIX
lastUpdateTime = 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 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 Text
name :: Maybe Text
$sel:name:Channel' :: Channel -> Maybe Text
name} -> Maybe Text
name) (\s :: Channel
s@Channel' {} Maybe Text
a -> Channel
s {$sel:name:Channel' :: Maybe Text
name = Maybe Text
a} :: Channel)

-- | How long, in days, message data is kept for the channel.
channel_retentionPeriod :: Lens.Lens' Channel (Prelude.Maybe RetentionPeriod)
channel_retentionPeriod :: Lens' Channel (Maybe RetentionPeriod)
channel_retentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe RetentionPeriod
retentionPeriod :: Maybe RetentionPeriod
$sel:retentionPeriod:Channel' :: Channel -> Maybe RetentionPeriod
retentionPeriod} -> Maybe RetentionPeriod
retentionPeriod) (\s :: Channel
s@Channel' {} Maybe RetentionPeriod
a -> Channel
s {$sel:retentionPeriod:Channel' :: Maybe RetentionPeriod
retentionPeriod = Maybe RetentionPeriod
a} :: Channel)

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

-- | Where channel data is stored. You can choose one of @serviceManagedS3@
-- or @customerManagedS3@ storage. If not specified, the default is
-- @serviceManagedS3@. You can\'t change this storage option after the
-- channel is created.
channel_storage :: Lens.Lens' Channel (Prelude.Maybe ChannelStorage)
channel_storage :: Lens' Channel (Maybe ChannelStorage)
channel_storage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Channel' {Maybe ChannelStorage
storage :: Maybe ChannelStorage
$sel:storage:Channel' :: Channel -> Maybe ChannelStorage
storage} -> Maybe ChannelStorage
storage) (\s :: Channel
s@Channel' {} Maybe ChannelStorage
a -> Channel
s {$sel:storage:Channel' :: Maybe ChannelStorage
storage = Maybe ChannelStorage
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 POSIX
-> Maybe POSIX
-> Maybe POSIX
-> Maybe Text
-> Maybe RetentionPeriod
-> Maybe ChannelStatus
-> Maybe ChannelStorage
-> 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
"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
"creationTime")
            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
"lastMessageArrivalTime")
            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
"lastUpdateTime")
            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
"retentionPeriod")
            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
"status")
            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
"storage")
      )

instance Prelude.Hashable Channel where
  hashWithSalt :: Int -> Channel -> Int
hashWithSalt Int
_salt Channel' {Maybe Text
Maybe POSIX
Maybe ChannelStatus
Maybe RetentionPeriod
Maybe ChannelStorage
storage :: Maybe ChannelStorage
status :: Maybe ChannelStatus
retentionPeriod :: Maybe RetentionPeriod
name :: Maybe Text
lastUpdateTime :: Maybe POSIX
lastMessageArrivalTime :: Maybe POSIX
creationTime :: Maybe POSIX
arn :: Maybe Text
$sel:storage:Channel' :: Channel -> Maybe ChannelStorage
$sel:status:Channel' :: Channel -> Maybe ChannelStatus
$sel:retentionPeriod:Channel' :: Channel -> Maybe RetentionPeriod
$sel:name:Channel' :: Channel -> Maybe Text
$sel:lastUpdateTime:Channel' :: Channel -> Maybe POSIX
$sel:lastMessageArrivalTime:Channel' :: Channel -> Maybe POSIX
$sel:creationTime:Channel' :: Channel -> Maybe POSIX
$sel:arn:Channel' :: Channel -> 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
creationTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastMessageArrivalTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastUpdateTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RetentionPeriod
retentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChannelStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ChannelStorage
storage

instance Prelude.NFData Channel where
  rnf :: Channel -> ()
rnf Channel' {Maybe Text
Maybe POSIX
Maybe ChannelStatus
Maybe RetentionPeriod
Maybe ChannelStorage
storage :: Maybe ChannelStorage
status :: Maybe ChannelStatus
retentionPeriod :: Maybe RetentionPeriod
name :: Maybe Text
lastUpdateTime :: Maybe POSIX
lastMessageArrivalTime :: Maybe POSIX
creationTime :: Maybe POSIX
arn :: Maybe Text
$sel:storage:Channel' :: Channel -> Maybe ChannelStorage
$sel:status:Channel' :: Channel -> Maybe ChannelStatus
$sel:retentionPeriod:Channel' :: Channel -> Maybe RetentionPeriod
$sel:name:Channel' :: Channel -> Maybe Text
$sel:lastUpdateTime:Channel' :: Channel -> Maybe POSIX
$sel:lastMessageArrivalTime:Channel' :: Channel -> Maybe POSIX
$sel:creationTime:Channel' :: Channel -> Maybe POSIX
$sel:arn:Channel' :: Channel -> 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
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastMessageArrivalTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdateTime
      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 RetentionPeriod
retentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChannelStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ChannelStorage
storage