{-# 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.Redshift.Types.LoggingStatus
-- 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.Redshift.Types.LoggingStatus where

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
import Amazonka.Redshift.Internal
import Amazonka.Redshift.Types.LogDestinationType

-- | Describes the status of logging for a cluster.
--
-- /See:/ 'newLoggingStatus' smart constructor.
data LoggingStatus = LoggingStatus'
  { -- | The name of the S3 bucket where the log files are stored.
    LoggingStatus -> Maybe Text
bucketName :: Prelude.Maybe Prelude.Text,
    -- | The message indicating that logs failed to be delivered.
    LoggingStatus -> Maybe Text
lastFailureMessage :: Prelude.Maybe Prelude.Text,
    -- | The last time when logs failed to be delivered.
    LoggingStatus -> Maybe ISO8601
lastFailureTime :: Prelude.Maybe Data.ISO8601,
    -- | The last time that logs were delivered.
    LoggingStatus -> Maybe ISO8601
lastSuccessfulDeliveryTime :: Prelude.Maybe Data.ISO8601,
    -- | The log destination type. An enum with possible values of @s3@ and
    -- @cloudwatch@.
    LoggingStatus -> Maybe LogDestinationType
logDestinationType :: Prelude.Maybe LogDestinationType,
    -- | The collection of exported log types. Log types include the connection
    -- log, user log and user activity log.
    LoggingStatus -> Maybe [Text]
logExports :: Prelude.Maybe [Prelude.Text],
    -- | @true@ if logging is on, @false@ if logging is off.
    LoggingStatus -> Maybe Bool
loggingEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The prefix applied to the log file names.
    LoggingStatus -> Maybe Text
s3KeyPrefix :: Prelude.Maybe Prelude.Text
  }
  deriving (LoggingStatus -> LoggingStatus -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LoggingStatus -> LoggingStatus -> Bool
$c/= :: LoggingStatus -> LoggingStatus -> Bool
== :: LoggingStatus -> LoggingStatus -> Bool
$c== :: LoggingStatus -> LoggingStatus -> Bool
Prelude.Eq, ReadPrec [LoggingStatus]
ReadPrec LoggingStatus
Int -> ReadS LoggingStatus
ReadS [LoggingStatus]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LoggingStatus]
$creadListPrec :: ReadPrec [LoggingStatus]
readPrec :: ReadPrec LoggingStatus
$creadPrec :: ReadPrec LoggingStatus
readList :: ReadS [LoggingStatus]
$creadList :: ReadS [LoggingStatus]
readsPrec :: Int -> ReadS LoggingStatus
$creadsPrec :: Int -> ReadS LoggingStatus
Prelude.Read, Int -> LoggingStatus -> ShowS
[LoggingStatus] -> ShowS
LoggingStatus -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LoggingStatus] -> ShowS
$cshowList :: [LoggingStatus] -> ShowS
show :: LoggingStatus -> String
$cshow :: LoggingStatus -> String
showsPrec :: Int -> LoggingStatus -> ShowS
$cshowsPrec :: Int -> LoggingStatus -> ShowS
Prelude.Show, forall x. Rep LoggingStatus x -> LoggingStatus
forall x. LoggingStatus -> Rep LoggingStatus x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LoggingStatus x -> LoggingStatus
$cfrom :: forall x. LoggingStatus -> Rep LoggingStatus x
Prelude.Generic)

-- |
-- Create a value of 'LoggingStatus' 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:
--
-- 'bucketName', 'loggingStatus_bucketName' - The name of the S3 bucket where the log files are stored.
--
-- 'lastFailureMessage', 'loggingStatus_lastFailureMessage' - The message indicating that logs failed to be delivered.
--
-- 'lastFailureTime', 'loggingStatus_lastFailureTime' - The last time when logs failed to be delivered.
--
-- 'lastSuccessfulDeliveryTime', 'loggingStatus_lastSuccessfulDeliveryTime' - The last time that logs were delivered.
--
-- 'logDestinationType', 'loggingStatus_logDestinationType' - The log destination type. An enum with possible values of @s3@ and
-- @cloudwatch@.
--
-- 'logExports', 'loggingStatus_logExports' - The collection of exported log types. Log types include the connection
-- log, user log and user activity log.
--
-- 'loggingEnabled', 'loggingStatus_loggingEnabled' - @true@ if logging is on, @false@ if logging is off.
--
-- 's3KeyPrefix', 'loggingStatus_s3KeyPrefix' - The prefix applied to the log file names.
newLoggingStatus ::
  LoggingStatus
newLoggingStatus :: LoggingStatus
newLoggingStatus =
  LoggingStatus'
    { $sel:bucketName:LoggingStatus' :: Maybe Text
bucketName = forall a. Maybe a
Prelude.Nothing,
      $sel:lastFailureMessage:LoggingStatus' :: Maybe Text
lastFailureMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:lastFailureTime:LoggingStatus' :: Maybe ISO8601
lastFailureTime = forall a. Maybe a
Prelude.Nothing,
      $sel:lastSuccessfulDeliveryTime:LoggingStatus' :: Maybe ISO8601
lastSuccessfulDeliveryTime = forall a. Maybe a
Prelude.Nothing,
      $sel:logDestinationType:LoggingStatus' :: Maybe LogDestinationType
logDestinationType = forall a. Maybe a
Prelude.Nothing,
      $sel:logExports:LoggingStatus' :: Maybe [Text]
logExports = forall a. Maybe a
Prelude.Nothing,
      $sel:loggingEnabled:LoggingStatus' :: Maybe Bool
loggingEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:s3KeyPrefix:LoggingStatus' :: Maybe Text
s3KeyPrefix = forall a. Maybe a
Prelude.Nothing
    }

-- | The name of the S3 bucket where the log files are stored.
loggingStatus_bucketName :: Lens.Lens' LoggingStatus (Prelude.Maybe Prelude.Text)
loggingStatus_bucketName :: Lens' LoggingStatus (Maybe Text)
loggingStatus_bucketName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoggingStatus' {Maybe Text
bucketName :: Maybe Text
$sel:bucketName:LoggingStatus' :: LoggingStatus -> Maybe Text
bucketName} -> Maybe Text
bucketName) (\s :: LoggingStatus
s@LoggingStatus' {} Maybe Text
a -> LoggingStatus
s {$sel:bucketName:LoggingStatus' :: Maybe Text
bucketName = Maybe Text
a} :: LoggingStatus)

-- | The message indicating that logs failed to be delivered.
loggingStatus_lastFailureMessage :: Lens.Lens' LoggingStatus (Prelude.Maybe Prelude.Text)
loggingStatus_lastFailureMessage :: Lens' LoggingStatus (Maybe Text)
loggingStatus_lastFailureMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoggingStatus' {Maybe Text
lastFailureMessage :: Maybe Text
$sel:lastFailureMessage:LoggingStatus' :: LoggingStatus -> Maybe Text
lastFailureMessage} -> Maybe Text
lastFailureMessage) (\s :: LoggingStatus
s@LoggingStatus' {} Maybe Text
a -> LoggingStatus
s {$sel:lastFailureMessage:LoggingStatus' :: Maybe Text
lastFailureMessage = Maybe Text
a} :: LoggingStatus)

-- | The last time when logs failed to be delivered.
loggingStatus_lastFailureTime :: Lens.Lens' LoggingStatus (Prelude.Maybe Prelude.UTCTime)
loggingStatus_lastFailureTime :: Lens' LoggingStatus (Maybe UTCTime)
loggingStatus_lastFailureTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoggingStatus' {Maybe ISO8601
lastFailureTime :: Maybe ISO8601
$sel:lastFailureTime:LoggingStatus' :: LoggingStatus -> Maybe ISO8601
lastFailureTime} -> Maybe ISO8601
lastFailureTime) (\s :: LoggingStatus
s@LoggingStatus' {} Maybe ISO8601
a -> LoggingStatus
s {$sel:lastFailureTime:LoggingStatus' :: Maybe ISO8601
lastFailureTime = Maybe ISO8601
a} :: LoggingStatus) 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 that logs were delivered.
loggingStatus_lastSuccessfulDeliveryTime :: Lens.Lens' LoggingStatus (Prelude.Maybe Prelude.UTCTime)
loggingStatus_lastSuccessfulDeliveryTime :: Lens' LoggingStatus (Maybe UTCTime)
loggingStatus_lastSuccessfulDeliveryTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoggingStatus' {Maybe ISO8601
lastSuccessfulDeliveryTime :: Maybe ISO8601
$sel:lastSuccessfulDeliveryTime:LoggingStatus' :: LoggingStatus -> Maybe ISO8601
lastSuccessfulDeliveryTime} -> Maybe ISO8601
lastSuccessfulDeliveryTime) (\s :: LoggingStatus
s@LoggingStatus' {} Maybe ISO8601
a -> LoggingStatus
s {$sel:lastSuccessfulDeliveryTime:LoggingStatus' :: Maybe ISO8601
lastSuccessfulDeliveryTime = Maybe ISO8601
a} :: LoggingStatus) 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 log destination type. An enum with possible values of @s3@ and
-- @cloudwatch@.
loggingStatus_logDestinationType :: Lens.Lens' LoggingStatus (Prelude.Maybe LogDestinationType)
loggingStatus_logDestinationType :: Lens' LoggingStatus (Maybe LogDestinationType)
loggingStatus_logDestinationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoggingStatus' {Maybe LogDestinationType
logDestinationType :: Maybe LogDestinationType
$sel:logDestinationType:LoggingStatus' :: LoggingStatus -> Maybe LogDestinationType
logDestinationType} -> Maybe LogDestinationType
logDestinationType) (\s :: LoggingStatus
s@LoggingStatus' {} Maybe LogDestinationType
a -> LoggingStatus
s {$sel:logDestinationType:LoggingStatus' :: Maybe LogDestinationType
logDestinationType = Maybe LogDestinationType
a} :: LoggingStatus)

-- | The collection of exported log types. Log types include the connection
-- log, user log and user activity log.
loggingStatus_logExports :: Lens.Lens' LoggingStatus (Prelude.Maybe [Prelude.Text])
loggingStatus_logExports :: Lens' LoggingStatus (Maybe [Text])
loggingStatus_logExports = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoggingStatus' {Maybe [Text]
logExports :: Maybe [Text]
$sel:logExports:LoggingStatus' :: LoggingStatus -> Maybe [Text]
logExports} -> Maybe [Text]
logExports) (\s :: LoggingStatus
s@LoggingStatus' {} Maybe [Text]
a -> LoggingStatus
s {$sel:logExports:LoggingStatus' :: Maybe [Text]
logExports = Maybe [Text]
a} :: LoggingStatus) 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

-- | @true@ if logging is on, @false@ if logging is off.
loggingStatus_loggingEnabled :: Lens.Lens' LoggingStatus (Prelude.Maybe Prelude.Bool)
loggingStatus_loggingEnabled :: Lens' LoggingStatus (Maybe Bool)
loggingStatus_loggingEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoggingStatus' {Maybe Bool
loggingEnabled :: Maybe Bool
$sel:loggingEnabled:LoggingStatus' :: LoggingStatus -> Maybe Bool
loggingEnabled} -> Maybe Bool
loggingEnabled) (\s :: LoggingStatus
s@LoggingStatus' {} Maybe Bool
a -> LoggingStatus
s {$sel:loggingEnabled:LoggingStatus' :: Maybe Bool
loggingEnabled = Maybe Bool
a} :: LoggingStatus)

-- | The prefix applied to the log file names.
loggingStatus_s3KeyPrefix :: Lens.Lens' LoggingStatus (Prelude.Maybe Prelude.Text)
loggingStatus_s3KeyPrefix :: Lens' LoggingStatus (Maybe Text)
loggingStatus_s3KeyPrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LoggingStatus' {Maybe Text
s3KeyPrefix :: Maybe Text
$sel:s3KeyPrefix:LoggingStatus' :: LoggingStatus -> Maybe Text
s3KeyPrefix} -> Maybe Text
s3KeyPrefix) (\s :: LoggingStatus
s@LoggingStatus' {} Maybe Text
a -> LoggingStatus
s {$sel:s3KeyPrefix:LoggingStatus' :: Maybe Text
s3KeyPrefix = Maybe Text
a} :: LoggingStatus)

instance Data.FromXML LoggingStatus where
  parseXML :: [Node] -> Either String LoggingStatus
parseXML [Node]
x =
    Maybe Text
-> Maybe Text
-> Maybe ISO8601
-> Maybe ISO8601
-> Maybe LogDestinationType
-> Maybe [Text]
-> Maybe Bool
-> Maybe Text
-> LoggingStatus
LoggingStatus'
      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
"BucketName")
      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
"LastFailureMessage")
      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
"LastFailureTime")
      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
"LastSuccessfulDeliveryTime")
      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
"LogDestinationType")
      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
"LogExports"
                      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
"LoggingEnabled")
      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
"S3KeyPrefix")

instance Prelude.Hashable LoggingStatus where
  hashWithSalt :: Int -> LoggingStatus -> Int
hashWithSalt Int
_salt LoggingStatus' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe ISO8601
Maybe LogDestinationType
s3KeyPrefix :: Maybe Text
loggingEnabled :: Maybe Bool
logExports :: Maybe [Text]
logDestinationType :: Maybe LogDestinationType
lastSuccessfulDeliveryTime :: Maybe ISO8601
lastFailureTime :: Maybe ISO8601
lastFailureMessage :: Maybe Text
bucketName :: Maybe Text
$sel:s3KeyPrefix:LoggingStatus' :: LoggingStatus -> Maybe Text
$sel:loggingEnabled:LoggingStatus' :: LoggingStatus -> Maybe Bool
$sel:logExports:LoggingStatus' :: LoggingStatus -> Maybe [Text]
$sel:logDestinationType:LoggingStatus' :: LoggingStatus -> Maybe LogDestinationType
$sel:lastSuccessfulDeliveryTime:LoggingStatus' :: LoggingStatus -> Maybe ISO8601
$sel:lastFailureTime:LoggingStatus' :: LoggingStatus -> Maybe ISO8601
$sel:lastFailureMessage:LoggingStatus' :: LoggingStatus -> Maybe Text
$sel:bucketName:LoggingStatus' :: LoggingStatus -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
bucketName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
lastFailureMessage
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
lastFailureTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
lastSuccessfulDeliveryTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LogDestinationType
logDestinationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
logExports
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
loggingEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
s3KeyPrefix

instance Prelude.NFData LoggingStatus where
  rnf :: LoggingStatus -> ()
rnf LoggingStatus' {Maybe Bool
Maybe [Text]
Maybe Text
Maybe ISO8601
Maybe LogDestinationType
s3KeyPrefix :: Maybe Text
loggingEnabled :: Maybe Bool
logExports :: Maybe [Text]
logDestinationType :: Maybe LogDestinationType
lastSuccessfulDeliveryTime :: Maybe ISO8601
lastFailureTime :: Maybe ISO8601
lastFailureMessage :: Maybe Text
bucketName :: Maybe Text
$sel:s3KeyPrefix:LoggingStatus' :: LoggingStatus -> Maybe Text
$sel:loggingEnabled:LoggingStatus' :: LoggingStatus -> Maybe Bool
$sel:logExports:LoggingStatus' :: LoggingStatus -> Maybe [Text]
$sel:logDestinationType:LoggingStatus' :: LoggingStatus -> Maybe LogDestinationType
$sel:lastSuccessfulDeliveryTime:LoggingStatus' :: LoggingStatus -> Maybe ISO8601
$sel:lastFailureTime:LoggingStatus' :: LoggingStatus -> Maybe ISO8601
$sel:lastFailureMessage:LoggingStatus' :: LoggingStatus -> Maybe Text
$sel:bucketName:LoggingStatus' :: LoggingStatus -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
bucketName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
lastFailureMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
lastFailureTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
lastSuccessfulDeliveryTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LogDestinationType
logDestinationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
logExports
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
loggingEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
s3KeyPrefix