{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# 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.EnableLogging
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Starts logging information, such as queries and connection attempts, for
-- the specified Amazon Redshift cluster.
module Amazonka.Redshift.EnableLogging
  ( -- * Creating a Request
    EnableLogging (..),
    newEnableLogging,

    -- * Request Lenses
    enableLogging_bucketName,
    enableLogging_logDestinationType,
    enableLogging_logExports,
    enableLogging_s3KeyPrefix,
    enableLogging_clusterIdentifier,

    -- * Destructuring the Response
    LoggingStatus (..),
    newLoggingStatus,

    -- * Response Lenses
    loggingStatus_bucketName,
    loggingStatus_lastFailureMessage,
    loggingStatus_lastFailureTime,
    loggingStatus_lastSuccessfulDeliveryTime,
    loggingStatus_logDestinationType,
    loggingStatus_logExports,
    loggingStatus_loggingEnabled,
    loggingStatus_s3KeyPrefix,
  )
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.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newEnableLogging' smart constructor.
data EnableLogging = EnableLogging'
  { -- | The name of an existing S3 bucket where the log files are to be stored.
    --
    -- Constraints:
    --
    -- -   Must be in the same region as the cluster
    --
    -- -   The cluster must have read bucket and put object permissions
    EnableLogging -> Maybe Text
bucketName :: Prelude.Maybe Prelude.Text,
    -- | The log destination type. An enum with possible values of @s3@ and
    -- @cloudwatch@.
    EnableLogging -> Maybe LogDestinationType
logDestinationType :: Prelude.Maybe LogDestinationType,
    -- | The collection of exported log types. Log types include the connection
    -- log, user log and user activity log.
    EnableLogging -> Maybe [Text]
logExports :: Prelude.Maybe [Prelude.Text],
    -- | The prefix applied to the log file names.
    --
    -- Constraints:
    --
    -- -   Cannot exceed 512 characters
    --
    -- -   Cannot contain spaces( ), double quotes (\"), single quotes (\'), a
    --     backslash (\\), or control characters. The hexadecimal codes for
    --     invalid characters are:
    --
    --     -   x00 to x20
    --
    --     -   x22
    --
    --     -   x27
    --
    --     -   x5c
    --
    --     -   x7f or larger
    EnableLogging -> Maybe Text
s3KeyPrefix :: Prelude.Maybe Prelude.Text,
    -- | The identifier of the cluster on which logging is to be started.
    --
    -- Example: @examplecluster@
    EnableLogging -> Text
clusterIdentifier :: Prelude.Text
  }
  deriving (EnableLogging -> EnableLogging -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EnableLogging -> EnableLogging -> Bool
$c/= :: EnableLogging -> EnableLogging -> Bool
== :: EnableLogging -> EnableLogging -> Bool
$c== :: EnableLogging -> EnableLogging -> Bool
Prelude.Eq, ReadPrec [EnableLogging]
ReadPrec EnableLogging
Int -> ReadS EnableLogging
ReadS [EnableLogging]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EnableLogging]
$creadListPrec :: ReadPrec [EnableLogging]
readPrec :: ReadPrec EnableLogging
$creadPrec :: ReadPrec EnableLogging
readList :: ReadS [EnableLogging]
$creadList :: ReadS [EnableLogging]
readsPrec :: Int -> ReadS EnableLogging
$creadsPrec :: Int -> ReadS EnableLogging
Prelude.Read, Int -> EnableLogging -> ShowS
[EnableLogging] -> ShowS
EnableLogging -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EnableLogging] -> ShowS
$cshowList :: [EnableLogging] -> ShowS
show :: EnableLogging -> String
$cshow :: EnableLogging -> String
showsPrec :: Int -> EnableLogging -> ShowS
$cshowsPrec :: Int -> EnableLogging -> ShowS
Prelude.Show, forall x. Rep EnableLogging x -> EnableLogging
forall x. EnableLogging -> Rep EnableLogging x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EnableLogging x -> EnableLogging
$cfrom :: forall x. EnableLogging -> Rep EnableLogging x
Prelude.Generic)

-- |
-- Create a value of 'EnableLogging' 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', 'enableLogging_bucketName' - The name of an existing S3 bucket where the log files are to be stored.
--
-- Constraints:
--
-- -   Must be in the same region as the cluster
--
-- -   The cluster must have read bucket and put object permissions
--
-- 'logDestinationType', 'enableLogging_logDestinationType' - The log destination type. An enum with possible values of @s3@ and
-- @cloudwatch@.
--
-- 'logExports', 'enableLogging_logExports' - The collection of exported log types. Log types include the connection
-- log, user log and user activity log.
--
-- 's3KeyPrefix', 'enableLogging_s3KeyPrefix' - The prefix applied to the log file names.
--
-- Constraints:
--
-- -   Cannot exceed 512 characters
--
-- -   Cannot contain spaces( ), double quotes (\"), single quotes (\'), a
--     backslash (\\), or control characters. The hexadecimal codes for
--     invalid characters are:
--
--     -   x00 to x20
--
--     -   x22
--
--     -   x27
--
--     -   x5c
--
--     -   x7f or larger
--
-- 'clusterIdentifier', 'enableLogging_clusterIdentifier' - The identifier of the cluster on which logging is to be started.
--
-- Example: @examplecluster@
newEnableLogging ::
  -- | 'clusterIdentifier'
  Prelude.Text ->
  EnableLogging
newEnableLogging :: Text -> EnableLogging
newEnableLogging Text
pClusterIdentifier_ =
  EnableLogging'
    { $sel:bucketName:EnableLogging' :: Maybe Text
bucketName = forall a. Maybe a
Prelude.Nothing,
      $sel:logDestinationType:EnableLogging' :: Maybe LogDestinationType
logDestinationType = forall a. Maybe a
Prelude.Nothing,
      $sel:logExports:EnableLogging' :: Maybe [Text]
logExports = forall a. Maybe a
Prelude.Nothing,
      $sel:s3KeyPrefix:EnableLogging' :: Maybe Text
s3KeyPrefix = forall a. Maybe a
Prelude.Nothing,
      $sel:clusterIdentifier:EnableLogging' :: Text
clusterIdentifier = Text
pClusterIdentifier_
    }

-- | The name of an existing S3 bucket where the log files are to be stored.
--
-- Constraints:
--
-- -   Must be in the same region as the cluster
--
-- -   The cluster must have read bucket and put object permissions
enableLogging_bucketName :: Lens.Lens' EnableLogging (Prelude.Maybe Prelude.Text)
enableLogging_bucketName :: Lens' EnableLogging (Maybe Text)
enableLogging_bucketName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableLogging' {Maybe Text
bucketName :: Maybe Text
$sel:bucketName:EnableLogging' :: EnableLogging -> Maybe Text
bucketName} -> Maybe Text
bucketName) (\s :: EnableLogging
s@EnableLogging' {} Maybe Text
a -> EnableLogging
s {$sel:bucketName:EnableLogging' :: Maybe Text
bucketName = Maybe Text
a} :: EnableLogging)

-- | The log destination type. An enum with possible values of @s3@ and
-- @cloudwatch@.
enableLogging_logDestinationType :: Lens.Lens' EnableLogging (Prelude.Maybe LogDestinationType)
enableLogging_logDestinationType :: Lens' EnableLogging (Maybe LogDestinationType)
enableLogging_logDestinationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableLogging' {Maybe LogDestinationType
logDestinationType :: Maybe LogDestinationType
$sel:logDestinationType:EnableLogging' :: EnableLogging -> Maybe LogDestinationType
logDestinationType} -> Maybe LogDestinationType
logDestinationType) (\s :: EnableLogging
s@EnableLogging' {} Maybe LogDestinationType
a -> EnableLogging
s {$sel:logDestinationType:EnableLogging' :: Maybe LogDestinationType
logDestinationType = Maybe LogDestinationType
a} :: EnableLogging)

-- | The collection of exported log types. Log types include the connection
-- log, user log and user activity log.
enableLogging_logExports :: Lens.Lens' EnableLogging (Prelude.Maybe [Prelude.Text])
enableLogging_logExports :: Lens' EnableLogging (Maybe [Text])
enableLogging_logExports = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableLogging' {Maybe [Text]
logExports :: Maybe [Text]
$sel:logExports:EnableLogging' :: EnableLogging -> Maybe [Text]
logExports} -> Maybe [Text]
logExports) (\s :: EnableLogging
s@EnableLogging' {} Maybe [Text]
a -> EnableLogging
s {$sel:logExports:EnableLogging' :: Maybe [Text]
logExports = Maybe [Text]
a} :: EnableLogging) 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 prefix applied to the log file names.
--
-- Constraints:
--
-- -   Cannot exceed 512 characters
--
-- -   Cannot contain spaces( ), double quotes (\"), single quotes (\'), a
--     backslash (\\), or control characters. The hexadecimal codes for
--     invalid characters are:
--
--     -   x00 to x20
--
--     -   x22
--
--     -   x27
--
--     -   x5c
--
--     -   x7f or larger
enableLogging_s3KeyPrefix :: Lens.Lens' EnableLogging (Prelude.Maybe Prelude.Text)
enableLogging_s3KeyPrefix :: Lens' EnableLogging (Maybe Text)
enableLogging_s3KeyPrefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableLogging' {Maybe Text
s3KeyPrefix :: Maybe Text
$sel:s3KeyPrefix:EnableLogging' :: EnableLogging -> Maybe Text
s3KeyPrefix} -> Maybe Text
s3KeyPrefix) (\s :: EnableLogging
s@EnableLogging' {} Maybe Text
a -> EnableLogging
s {$sel:s3KeyPrefix:EnableLogging' :: Maybe Text
s3KeyPrefix = Maybe Text
a} :: EnableLogging)

-- | The identifier of the cluster on which logging is to be started.
--
-- Example: @examplecluster@
enableLogging_clusterIdentifier :: Lens.Lens' EnableLogging Prelude.Text
enableLogging_clusterIdentifier :: Lens' EnableLogging Text
enableLogging_clusterIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EnableLogging' {Text
clusterIdentifier :: Text
$sel:clusterIdentifier:EnableLogging' :: EnableLogging -> Text
clusterIdentifier} -> Text
clusterIdentifier) (\s :: EnableLogging
s@EnableLogging' {} Text
a -> EnableLogging
s {$sel:clusterIdentifier:EnableLogging' :: Text
clusterIdentifier = Text
a} :: EnableLogging)

instance Core.AWSRequest EnableLogging where
  type AWSResponse EnableLogging = LoggingStatus
  request :: (Service -> Service) -> EnableLogging -> Request EnableLogging
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy EnableLogging
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse EnableLogging)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"EnableLoggingResult"
      (\Int
s ResponseHeaders
h [Node]
x -> forall a. FromXML a => [Node] -> Either String a
Data.parseXML [Node]
x)

instance Prelude.Hashable EnableLogging where
  hashWithSalt :: Int -> EnableLogging -> Int
hashWithSalt Int
_salt EnableLogging' {Maybe [Text]
Maybe Text
Maybe LogDestinationType
Text
clusterIdentifier :: Text
s3KeyPrefix :: Maybe Text
logExports :: Maybe [Text]
logDestinationType :: Maybe LogDestinationType
bucketName :: Maybe Text
$sel:clusterIdentifier:EnableLogging' :: EnableLogging -> Text
$sel:s3KeyPrefix:EnableLogging' :: EnableLogging -> Maybe Text
$sel:logExports:EnableLogging' :: EnableLogging -> Maybe [Text]
$sel:logDestinationType:EnableLogging' :: EnableLogging -> Maybe LogDestinationType
$sel:bucketName:EnableLogging' :: EnableLogging -> 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 LogDestinationType
logDestinationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
logExports
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
s3KeyPrefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clusterIdentifier

instance Prelude.NFData EnableLogging where
  rnf :: EnableLogging -> ()
rnf EnableLogging' {Maybe [Text]
Maybe Text
Maybe LogDestinationType
Text
clusterIdentifier :: Text
s3KeyPrefix :: Maybe Text
logExports :: Maybe [Text]
logDestinationType :: Maybe LogDestinationType
bucketName :: Maybe Text
$sel:clusterIdentifier:EnableLogging' :: EnableLogging -> Text
$sel:s3KeyPrefix:EnableLogging' :: EnableLogging -> Maybe Text
$sel:logExports:EnableLogging' :: EnableLogging -> Maybe [Text]
$sel:logDestinationType:EnableLogging' :: EnableLogging -> Maybe LogDestinationType
$sel:bucketName:EnableLogging' :: EnableLogging -> 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 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 Text
s3KeyPrefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
clusterIdentifier

instance Data.ToHeaders EnableLogging where
  toHeaders :: EnableLogging -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToPath EnableLogging where
  toPath :: EnableLogging -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery EnableLogging where
  toQuery :: EnableLogging -> QueryString
toQuery EnableLogging' {Maybe [Text]
Maybe Text
Maybe LogDestinationType
Text
clusterIdentifier :: Text
s3KeyPrefix :: Maybe Text
logExports :: Maybe [Text]
logDestinationType :: Maybe LogDestinationType
bucketName :: Maybe Text
$sel:clusterIdentifier:EnableLogging' :: EnableLogging -> Text
$sel:s3KeyPrefix:EnableLogging' :: EnableLogging -> Maybe Text
$sel:logExports:EnableLogging' :: EnableLogging -> Maybe [Text]
$sel:logDestinationType:EnableLogging' :: EnableLogging -> Maybe LogDestinationType
$sel:bucketName:EnableLogging' :: EnableLogging -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"EnableLogging" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2012-12-01" :: Prelude.ByteString),
        ByteString
"BucketName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
bucketName,
        ByteString
"LogDestinationType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe LogDestinationType
logDestinationType,
        ByteString
"LogExports"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
logExports),
        ByteString
"S3KeyPrefix" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
s3KeyPrefix,
        ByteString
"ClusterIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
clusterIdentifier
      ]