{-# 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.CloudTrail.UpdateEventDataStore
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an event data store. The required @EventDataStore@ value is an
-- ARN or the ID portion of the ARN. Other parameters are optional, but at
-- least one optional parameter must be specified, or CloudTrail throws an
-- error. @RetentionPeriod@ is in days, and valid values are integers
-- between 90 and 2557. By default, @TerminationProtection@ is enabled.
-- @AdvancedEventSelectors@ includes or excludes management and data events
-- in your event data store; for more information about
-- @AdvancedEventSelectors@, see
-- PutEventSelectorsRequest$AdvancedEventSelectors.
module Amazonka.CloudTrail.UpdateEventDataStore
  ( -- * Creating a Request
    UpdateEventDataStore (..),
    newUpdateEventDataStore,

    -- * Request Lenses
    updateEventDataStore_advancedEventSelectors,
    updateEventDataStore_kmsKeyId,
    updateEventDataStore_multiRegionEnabled,
    updateEventDataStore_name,
    updateEventDataStore_organizationEnabled,
    updateEventDataStore_retentionPeriod,
    updateEventDataStore_terminationProtectionEnabled,
    updateEventDataStore_eventDataStore,

    -- * Destructuring the Response
    UpdateEventDataStoreResponse (..),
    newUpdateEventDataStoreResponse,

    -- * Response Lenses
    updateEventDataStoreResponse_advancedEventSelectors,
    updateEventDataStoreResponse_createdTimestamp,
    updateEventDataStoreResponse_eventDataStoreArn,
    updateEventDataStoreResponse_kmsKeyId,
    updateEventDataStoreResponse_multiRegionEnabled,
    updateEventDataStoreResponse_name,
    updateEventDataStoreResponse_organizationEnabled,
    updateEventDataStoreResponse_retentionPeriod,
    updateEventDataStoreResponse_status,
    updateEventDataStoreResponse_terminationProtectionEnabled,
    updateEventDataStoreResponse_updatedTimestamp,
    updateEventDataStoreResponse_httpStatus,
  )
where

import Amazonka.CloudTrail.Types
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newUpdateEventDataStore' smart constructor.
data UpdateEventDataStore = UpdateEventDataStore'
  { -- | The advanced event selectors used to select events for the event data
    -- store. You can configure up to five advanced event selectors for each
    -- event data store.
    UpdateEventDataStore -> Maybe [AdvancedEventSelector]
advancedEventSelectors :: Prelude.Maybe [AdvancedEventSelector],
    -- | Specifies the KMS key ID to use to encrypt the events delivered by
    -- CloudTrail. The value can be an alias name prefixed by @alias\/@, a
    -- fully specified ARN to an alias, a fully specified ARN to a key, or a
    -- globally unique identifier.
    --
    -- Disabling or deleting the KMS key, or removing CloudTrail permissions on
    -- the key, prevents CloudTrail from logging events to the event data
    -- store, and prevents users from querying the data in the event data store
    -- that was encrypted with the key. After you associate an event data store
    -- with a KMS key, the KMS key cannot be removed or changed. Before you
    -- disable or delete a KMS key that you are using with an event data store,
    -- delete or back up your event data store.
    --
    -- CloudTrail also supports KMS multi-Region keys. For more information
    -- about multi-Region keys, see
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/multi-region-keys-overview.html Using multi-Region keys>
    -- in the /Key Management Service Developer Guide/.
    --
    -- Examples:
    --
    -- -   @alias\/MyAliasName@
    --
    -- -   @arn:aws:kms:us-east-2:123456789012:alias\/MyAliasName@
    --
    -- -   @arn:aws:kms:us-east-2:123456789012:key\/12345678-1234-1234-1234-123456789012@
    --
    -- -   @12345678-1234-1234-1234-123456789012@
    UpdateEventDataStore -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether an event data store collects events from all regions,
    -- or only from the region in which it was created.
    UpdateEventDataStore -> Maybe Bool
multiRegionEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The event data store name.
    UpdateEventDataStore -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Specifies whether an event data store collects events logged for an
    -- organization in Organizations.
    UpdateEventDataStore -> Maybe Bool
organizationEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The retention period, in days.
    UpdateEventDataStore -> Maybe Natural
retentionPeriod :: Prelude.Maybe Prelude.Natural,
    -- | Indicates that termination protection is enabled and the event data
    -- store cannot be automatically deleted.
    UpdateEventDataStore -> Maybe Bool
terminationProtectionEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The ARN (or the ID suffix of the ARN) of the event data store that you
    -- want to update.
    UpdateEventDataStore -> Text
eventDataStore :: Prelude.Text
  }
  deriving (UpdateEventDataStore -> UpdateEventDataStore -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateEventDataStore -> UpdateEventDataStore -> Bool
$c/= :: UpdateEventDataStore -> UpdateEventDataStore -> Bool
== :: UpdateEventDataStore -> UpdateEventDataStore -> Bool
$c== :: UpdateEventDataStore -> UpdateEventDataStore -> Bool
Prelude.Eq, ReadPrec [UpdateEventDataStore]
ReadPrec UpdateEventDataStore
Int -> ReadS UpdateEventDataStore
ReadS [UpdateEventDataStore]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateEventDataStore]
$creadListPrec :: ReadPrec [UpdateEventDataStore]
readPrec :: ReadPrec UpdateEventDataStore
$creadPrec :: ReadPrec UpdateEventDataStore
readList :: ReadS [UpdateEventDataStore]
$creadList :: ReadS [UpdateEventDataStore]
readsPrec :: Int -> ReadS UpdateEventDataStore
$creadsPrec :: Int -> ReadS UpdateEventDataStore
Prelude.Read, Int -> UpdateEventDataStore -> ShowS
[UpdateEventDataStore] -> ShowS
UpdateEventDataStore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateEventDataStore] -> ShowS
$cshowList :: [UpdateEventDataStore] -> ShowS
show :: UpdateEventDataStore -> String
$cshow :: UpdateEventDataStore -> String
showsPrec :: Int -> UpdateEventDataStore -> ShowS
$cshowsPrec :: Int -> UpdateEventDataStore -> ShowS
Prelude.Show, forall x. Rep UpdateEventDataStore x -> UpdateEventDataStore
forall x. UpdateEventDataStore -> Rep UpdateEventDataStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateEventDataStore x -> UpdateEventDataStore
$cfrom :: forall x. UpdateEventDataStore -> Rep UpdateEventDataStore x
Prelude.Generic)

-- |
-- Create a value of 'UpdateEventDataStore' 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:
--
-- 'advancedEventSelectors', 'updateEventDataStore_advancedEventSelectors' - The advanced event selectors used to select events for the event data
-- store. You can configure up to five advanced event selectors for each
-- event data store.
--
-- 'kmsKeyId', 'updateEventDataStore_kmsKeyId' - Specifies the KMS key ID to use to encrypt the events delivered by
-- CloudTrail. The value can be an alias name prefixed by @alias\/@, a
-- fully specified ARN to an alias, a fully specified ARN to a key, or a
-- globally unique identifier.
--
-- Disabling or deleting the KMS key, or removing CloudTrail permissions on
-- the key, prevents CloudTrail from logging events to the event data
-- store, and prevents users from querying the data in the event data store
-- that was encrypted with the key. After you associate an event data store
-- with a KMS key, the KMS key cannot be removed or changed. Before you
-- disable or delete a KMS key that you are using with an event data store,
-- delete or back up your event data store.
--
-- CloudTrail also supports KMS multi-Region keys. For more information
-- about multi-Region keys, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/multi-region-keys-overview.html Using multi-Region keys>
-- in the /Key Management Service Developer Guide/.
--
-- Examples:
--
-- -   @alias\/MyAliasName@
--
-- -   @arn:aws:kms:us-east-2:123456789012:alias\/MyAliasName@
--
-- -   @arn:aws:kms:us-east-2:123456789012:key\/12345678-1234-1234-1234-123456789012@
--
-- -   @12345678-1234-1234-1234-123456789012@
--
-- 'multiRegionEnabled', 'updateEventDataStore_multiRegionEnabled' - Specifies whether an event data store collects events from all regions,
-- or only from the region in which it was created.
--
-- 'name', 'updateEventDataStore_name' - The event data store name.
--
-- 'organizationEnabled', 'updateEventDataStore_organizationEnabled' - Specifies whether an event data store collects events logged for an
-- organization in Organizations.
--
-- 'retentionPeriod', 'updateEventDataStore_retentionPeriod' - The retention period, in days.
--
-- 'terminationProtectionEnabled', 'updateEventDataStore_terminationProtectionEnabled' - Indicates that termination protection is enabled and the event data
-- store cannot be automatically deleted.
--
-- 'eventDataStore', 'updateEventDataStore_eventDataStore' - The ARN (or the ID suffix of the ARN) of the event data store that you
-- want to update.
newUpdateEventDataStore ::
  -- | 'eventDataStore'
  Prelude.Text ->
  UpdateEventDataStore
newUpdateEventDataStore :: Text -> UpdateEventDataStore
newUpdateEventDataStore Text
pEventDataStore_ =
  UpdateEventDataStore'
    { $sel:advancedEventSelectors:UpdateEventDataStore' :: Maybe [AdvancedEventSelector]
advancedEventSelectors =
        forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:UpdateEventDataStore' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:multiRegionEnabled:UpdateEventDataStore' :: Maybe Bool
multiRegionEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateEventDataStore' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:organizationEnabled:UpdateEventDataStore' :: Maybe Bool
organizationEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:retentionPeriod:UpdateEventDataStore' :: Maybe Natural
retentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:terminationProtectionEnabled:UpdateEventDataStore' :: Maybe Bool
terminationProtectionEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:eventDataStore:UpdateEventDataStore' :: Text
eventDataStore = Text
pEventDataStore_
    }

-- | The advanced event selectors used to select events for the event data
-- store. You can configure up to five advanced event selectors for each
-- event data store.
updateEventDataStore_advancedEventSelectors :: Lens.Lens' UpdateEventDataStore (Prelude.Maybe [AdvancedEventSelector])
updateEventDataStore_advancedEventSelectors :: Lens' UpdateEventDataStore (Maybe [AdvancedEventSelector])
updateEventDataStore_advancedEventSelectors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStore' {Maybe [AdvancedEventSelector]
advancedEventSelectors :: Maybe [AdvancedEventSelector]
$sel:advancedEventSelectors:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe [AdvancedEventSelector]
advancedEventSelectors} -> Maybe [AdvancedEventSelector]
advancedEventSelectors) (\s :: UpdateEventDataStore
s@UpdateEventDataStore' {} Maybe [AdvancedEventSelector]
a -> UpdateEventDataStore
s {$sel:advancedEventSelectors:UpdateEventDataStore' :: Maybe [AdvancedEventSelector]
advancedEventSelectors = Maybe [AdvancedEventSelector]
a} :: UpdateEventDataStore) 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

-- | Specifies the KMS key ID to use to encrypt the events delivered by
-- CloudTrail. The value can be an alias name prefixed by @alias\/@, a
-- fully specified ARN to an alias, a fully specified ARN to a key, or a
-- globally unique identifier.
--
-- Disabling or deleting the KMS key, or removing CloudTrail permissions on
-- the key, prevents CloudTrail from logging events to the event data
-- store, and prevents users from querying the data in the event data store
-- that was encrypted with the key. After you associate an event data store
-- with a KMS key, the KMS key cannot be removed or changed. Before you
-- disable or delete a KMS key that you are using with an event data store,
-- delete or back up your event data store.
--
-- CloudTrail also supports KMS multi-Region keys. For more information
-- about multi-Region keys, see
-- <https://docs.aws.amazon.com/kms/latest/developerguide/multi-region-keys-overview.html Using multi-Region keys>
-- in the /Key Management Service Developer Guide/.
--
-- Examples:
--
-- -   @alias\/MyAliasName@
--
-- -   @arn:aws:kms:us-east-2:123456789012:alias\/MyAliasName@
--
-- -   @arn:aws:kms:us-east-2:123456789012:key\/12345678-1234-1234-1234-123456789012@
--
-- -   @12345678-1234-1234-1234-123456789012@
updateEventDataStore_kmsKeyId :: Lens.Lens' UpdateEventDataStore (Prelude.Maybe Prelude.Text)
updateEventDataStore_kmsKeyId :: Lens' UpdateEventDataStore (Maybe Text)
updateEventDataStore_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStore' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: UpdateEventDataStore
s@UpdateEventDataStore' {} Maybe Text
a -> UpdateEventDataStore
s {$sel:kmsKeyId:UpdateEventDataStore' :: Maybe Text
kmsKeyId = Maybe Text
a} :: UpdateEventDataStore)

-- | Specifies whether an event data store collects events from all regions,
-- or only from the region in which it was created.
updateEventDataStore_multiRegionEnabled :: Lens.Lens' UpdateEventDataStore (Prelude.Maybe Prelude.Bool)
updateEventDataStore_multiRegionEnabled :: Lens' UpdateEventDataStore (Maybe Bool)
updateEventDataStore_multiRegionEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStore' {Maybe Bool
multiRegionEnabled :: Maybe Bool
$sel:multiRegionEnabled:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Bool
multiRegionEnabled} -> Maybe Bool
multiRegionEnabled) (\s :: UpdateEventDataStore
s@UpdateEventDataStore' {} Maybe Bool
a -> UpdateEventDataStore
s {$sel:multiRegionEnabled:UpdateEventDataStore' :: Maybe Bool
multiRegionEnabled = Maybe Bool
a} :: UpdateEventDataStore)

-- | The event data store name.
updateEventDataStore_name :: Lens.Lens' UpdateEventDataStore (Prelude.Maybe Prelude.Text)
updateEventDataStore_name :: Lens' UpdateEventDataStore (Maybe Text)
updateEventDataStore_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStore' {Maybe Text
name :: Maybe Text
$sel:name:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateEventDataStore
s@UpdateEventDataStore' {} Maybe Text
a -> UpdateEventDataStore
s {$sel:name:UpdateEventDataStore' :: Maybe Text
name = Maybe Text
a} :: UpdateEventDataStore)

-- | Specifies whether an event data store collects events logged for an
-- organization in Organizations.
updateEventDataStore_organizationEnabled :: Lens.Lens' UpdateEventDataStore (Prelude.Maybe Prelude.Bool)
updateEventDataStore_organizationEnabled :: Lens' UpdateEventDataStore (Maybe Bool)
updateEventDataStore_organizationEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStore' {Maybe Bool
organizationEnabled :: Maybe Bool
$sel:organizationEnabled:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Bool
organizationEnabled} -> Maybe Bool
organizationEnabled) (\s :: UpdateEventDataStore
s@UpdateEventDataStore' {} Maybe Bool
a -> UpdateEventDataStore
s {$sel:organizationEnabled:UpdateEventDataStore' :: Maybe Bool
organizationEnabled = Maybe Bool
a} :: UpdateEventDataStore)

-- | The retention period, in days.
updateEventDataStore_retentionPeriod :: Lens.Lens' UpdateEventDataStore (Prelude.Maybe Prelude.Natural)
updateEventDataStore_retentionPeriod :: Lens' UpdateEventDataStore (Maybe Natural)
updateEventDataStore_retentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStore' {Maybe Natural
retentionPeriod :: Maybe Natural
$sel:retentionPeriod:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Natural
retentionPeriod} -> Maybe Natural
retentionPeriod) (\s :: UpdateEventDataStore
s@UpdateEventDataStore' {} Maybe Natural
a -> UpdateEventDataStore
s {$sel:retentionPeriod:UpdateEventDataStore' :: Maybe Natural
retentionPeriod = Maybe Natural
a} :: UpdateEventDataStore)

-- | Indicates that termination protection is enabled and the event data
-- store cannot be automatically deleted.
updateEventDataStore_terminationProtectionEnabled :: Lens.Lens' UpdateEventDataStore (Prelude.Maybe Prelude.Bool)
updateEventDataStore_terminationProtectionEnabled :: Lens' UpdateEventDataStore (Maybe Bool)
updateEventDataStore_terminationProtectionEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStore' {Maybe Bool
terminationProtectionEnabled :: Maybe Bool
$sel:terminationProtectionEnabled:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Bool
terminationProtectionEnabled} -> Maybe Bool
terminationProtectionEnabled) (\s :: UpdateEventDataStore
s@UpdateEventDataStore' {} Maybe Bool
a -> UpdateEventDataStore
s {$sel:terminationProtectionEnabled:UpdateEventDataStore' :: Maybe Bool
terminationProtectionEnabled = Maybe Bool
a} :: UpdateEventDataStore)

-- | The ARN (or the ID suffix of the ARN) of the event data store that you
-- want to update.
updateEventDataStore_eventDataStore :: Lens.Lens' UpdateEventDataStore Prelude.Text
updateEventDataStore_eventDataStore :: Lens' UpdateEventDataStore Text
updateEventDataStore_eventDataStore = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStore' {Text
eventDataStore :: Text
$sel:eventDataStore:UpdateEventDataStore' :: UpdateEventDataStore -> Text
eventDataStore} -> Text
eventDataStore) (\s :: UpdateEventDataStore
s@UpdateEventDataStore' {} Text
a -> UpdateEventDataStore
s {$sel:eventDataStore:UpdateEventDataStore' :: Text
eventDataStore = Text
a} :: UpdateEventDataStore)

instance Core.AWSRequest UpdateEventDataStore where
  type
    AWSResponse UpdateEventDataStore =
      UpdateEventDataStoreResponse
  request :: (Service -> Service)
-> UpdateEventDataStore -> Request UpdateEventDataStore
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateEventDataStore
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateEventDataStore)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe [AdvancedEventSelector]
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Bool
-> Maybe Natural
-> Maybe EventDataStoreStatus
-> Maybe Bool
-> Maybe POSIX
-> Int
-> UpdateEventDataStoreResponse
UpdateEventDataStoreResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"AdvancedEventSelectors"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (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 -> Either String (Maybe a)
Data..?> Key
"EventDataStoreArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"KmsKeyId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"MultiRegionEnabled")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (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 -> Either String (Maybe a)
Data..?> Key
"OrganizationEnabled")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (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 -> Either String (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 -> Either String (Maybe a)
Data..?> Key
"TerminationProtectionEnabled")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"UpdatedTimestamp")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateEventDataStore where
  hashWithSalt :: Int -> UpdateEventDataStore -> Int
hashWithSalt Int
_salt UpdateEventDataStore' {Maybe Bool
Maybe Natural
Maybe [AdvancedEventSelector]
Maybe Text
Text
eventDataStore :: Text
terminationProtectionEnabled :: Maybe Bool
retentionPeriod :: Maybe Natural
organizationEnabled :: Maybe Bool
name :: Maybe Text
multiRegionEnabled :: Maybe Bool
kmsKeyId :: Maybe Text
advancedEventSelectors :: Maybe [AdvancedEventSelector]
$sel:eventDataStore:UpdateEventDataStore' :: UpdateEventDataStore -> Text
$sel:terminationProtectionEnabled:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Bool
$sel:retentionPeriod:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Natural
$sel:organizationEnabled:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Bool
$sel:name:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Text
$sel:multiRegionEnabled:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Bool
$sel:kmsKeyId:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Text
$sel:advancedEventSelectors:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe [AdvancedEventSelector]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [AdvancedEventSelector]
advancedEventSelectors
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
kmsKeyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
multiRegionEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
organizationEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
retentionPeriod
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
terminationProtectionEnabled
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eventDataStore

instance Prelude.NFData UpdateEventDataStore where
  rnf :: UpdateEventDataStore -> ()
rnf UpdateEventDataStore' {Maybe Bool
Maybe Natural
Maybe [AdvancedEventSelector]
Maybe Text
Text
eventDataStore :: Text
terminationProtectionEnabled :: Maybe Bool
retentionPeriod :: Maybe Natural
organizationEnabled :: Maybe Bool
name :: Maybe Text
multiRegionEnabled :: Maybe Bool
kmsKeyId :: Maybe Text
advancedEventSelectors :: Maybe [AdvancedEventSelector]
$sel:eventDataStore:UpdateEventDataStore' :: UpdateEventDataStore -> Text
$sel:terminationProtectionEnabled:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Bool
$sel:retentionPeriod:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Natural
$sel:organizationEnabled:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Bool
$sel:name:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Text
$sel:multiRegionEnabled:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Bool
$sel:kmsKeyId:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Text
$sel:advancedEventSelectors:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe [AdvancedEventSelector]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AdvancedEventSelector]
advancedEventSelectors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
multiRegionEnabled
      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 Bool
organizationEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
retentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
terminationProtectionEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
eventDataStore

instance Data.ToHeaders UpdateEventDataStore where
  toHeaders :: UpdateEventDataStore -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"com.amazonaws.cloudtrail.v20131101.CloudTrail_20131101.UpdateEventDataStore" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateEventDataStore where
  toJSON :: UpdateEventDataStore -> Value
toJSON UpdateEventDataStore' {Maybe Bool
Maybe Natural
Maybe [AdvancedEventSelector]
Maybe Text
Text
eventDataStore :: Text
terminationProtectionEnabled :: Maybe Bool
retentionPeriod :: Maybe Natural
organizationEnabled :: Maybe Bool
name :: Maybe Text
multiRegionEnabled :: Maybe Bool
kmsKeyId :: Maybe Text
advancedEventSelectors :: Maybe [AdvancedEventSelector]
$sel:eventDataStore:UpdateEventDataStore' :: UpdateEventDataStore -> Text
$sel:terminationProtectionEnabled:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Bool
$sel:retentionPeriod:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Natural
$sel:organizationEnabled:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Bool
$sel:name:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Text
$sel:multiRegionEnabled:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Bool
$sel:kmsKeyId:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe Text
$sel:advancedEventSelectors:UpdateEventDataStore' :: UpdateEventDataStore -> Maybe [AdvancedEventSelector]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AdvancedEventSelectors" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [AdvancedEventSelector]
advancedEventSelectors,
            (Key
"KmsKeyId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
kmsKeyId,
            (Key
"MultiRegionEnabled" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
multiRegionEnabled,
            (Key
"Name" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
name,
            (Key
"OrganizationEnabled" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
organizationEnabled,
            (Key
"RetentionPeriod" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Natural
retentionPeriod,
            (Key
"TerminationProtectionEnabled" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Bool
terminationProtectionEnabled,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"EventDataStore" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
eventDataStore)
          ]
      )

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

instance Data.ToQuery UpdateEventDataStore where
  toQuery :: UpdateEventDataStore -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newUpdateEventDataStoreResponse' smart constructor.
data UpdateEventDataStoreResponse = UpdateEventDataStoreResponse'
  { -- | The advanced event selectors that are applied to the event data store.
    UpdateEventDataStoreResponse -> Maybe [AdvancedEventSelector]
advancedEventSelectors :: Prelude.Maybe [AdvancedEventSelector],
    -- | The timestamp that shows when an event data store was first created.
    UpdateEventDataStoreResponse -> Maybe POSIX
createdTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The ARN of the event data store.
    UpdateEventDataStoreResponse -> Maybe Text
eventDataStoreArn :: Prelude.Maybe Prelude.Text,
    -- | Specifies the KMS key ID that encrypts the events delivered by
    -- CloudTrail. The value is a fully specified ARN to a KMS key in the
    -- following format.
    --
    -- @arn:aws:kms:us-east-2:123456789012:key\/12345678-1234-1234-1234-123456789012@
    UpdateEventDataStoreResponse -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether the event data store includes events from all regions,
    -- or only from the region in which it was created.
    UpdateEventDataStoreResponse -> Maybe Bool
multiRegionEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The name of the event data store.
    UpdateEventDataStoreResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether an event data store is collecting logged events for an
    -- organization in Organizations.
    UpdateEventDataStoreResponse -> Maybe Bool
organizationEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The retention period, in days.
    UpdateEventDataStoreResponse -> Maybe Natural
retentionPeriod :: Prelude.Maybe Prelude.Natural,
    -- | The status of an event data store. Values can be @ENABLED@ and
    -- @PENDING_DELETION@.
    UpdateEventDataStoreResponse -> Maybe EventDataStoreStatus
status :: Prelude.Maybe EventDataStoreStatus,
    -- | Indicates whether termination protection is enabled for the event data
    -- store.
    UpdateEventDataStoreResponse -> Maybe Bool
terminationProtectionEnabled :: Prelude.Maybe Prelude.Bool,
    -- | The timestamp that shows when the event data store was last updated.
    -- @UpdatedTimestamp@ is always either the same or newer than the time
    -- shown in @CreatedTimestamp@.
    UpdateEventDataStoreResponse -> Maybe POSIX
updatedTimestamp :: Prelude.Maybe Data.POSIX,
    -- | The response's http status code.
    UpdateEventDataStoreResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateEventDataStoreResponse
-> UpdateEventDataStoreResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateEventDataStoreResponse
-> UpdateEventDataStoreResponse -> Bool
$c/= :: UpdateEventDataStoreResponse
-> UpdateEventDataStoreResponse -> Bool
== :: UpdateEventDataStoreResponse
-> UpdateEventDataStoreResponse -> Bool
$c== :: UpdateEventDataStoreResponse
-> UpdateEventDataStoreResponse -> Bool
Prelude.Eq, ReadPrec [UpdateEventDataStoreResponse]
ReadPrec UpdateEventDataStoreResponse
Int -> ReadS UpdateEventDataStoreResponse
ReadS [UpdateEventDataStoreResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateEventDataStoreResponse]
$creadListPrec :: ReadPrec [UpdateEventDataStoreResponse]
readPrec :: ReadPrec UpdateEventDataStoreResponse
$creadPrec :: ReadPrec UpdateEventDataStoreResponse
readList :: ReadS [UpdateEventDataStoreResponse]
$creadList :: ReadS [UpdateEventDataStoreResponse]
readsPrec :: Int -> ReadS UpdateEventDataStoreResponse
$creadsPrec :: Int -> ReadS UpdateEventDataStoreResponse
Prelude.Read, Int -> UpdateEventDataStoreResponse -> ShowS
[UpdateEventDataStoreResponse] -> ShowS
UpdateEventDataStoreResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateEventDataStoreResponse] -> ShowS
$cshowList :: [UpdateEventDataStoreResponse] -> ShowS
show :: UpdateEventDataStoreResponse -> String
$cshow :: UpdateEventDataStoreResponse -> String
showsPrec :: Int -> UpdateEventDataStoreResponse -> ShowS
$cshowsPrec :: Int -> UpdateEventDataStoreResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateEventDataStoreResponse x -> UpdateEventDataStoreResponse
forall x.
UpdateEventDataStoreResponse -> Rep UpdateEventDataStoreResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateEventDataStoreResponse x -> UpdateEventDataStoreResponse
$cfrom :: forall x.
UpdateEventDataStoreResponse -> Rep UpdateEventDataStoreResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateEventDataStoreResponse' 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:
--
-- 'advancedEventSelectors', 'updateEventDataStoreResponse_advancedEventSelectors' - The advanced event selectors that are applied to the event data store.
--
-- 'createdTimestamp', 'updateEventDataStoreResponse_createdTimestamp' - The timestamp that shows when an event data store was first created.
--
-- 'eventDataStoreArn', 'updateEventDataStoreResponse_eventDataStoreArn' - The ARN of the event data store.
--
-- 'kmsKeyId', 'updateEventDataStoreResponse_kmsKeyId' - Specifies the KMS key ID that encrypts the events delivered by
-- CloudTrail. The value is a fully specified ARN to a KMS key in the
-- following format.
--
-- @arn:aws:kms:us-east-2:123456789012:key\/12345678-1234-1234-1234-123456789012@
--
-- 'multiRegionEnabled', 'updateEventDataStoreResponse_multiRegionEnabled' - Indicates whether the event data store includes events from all regions,
-- or only from the region in which it was created.
--
-- 'name', 'updateEventDataStoreResponse_name' - The name of the event data store.
--
-- 'organizationEnabled', 'updateEventDataStoreResponse_organizationEnabled' - Indicates whether an event data store is collecting logged events for an
-- organization in Organizations.
--
-- 'retentionPeriod', 'updateEventDataStoreResponse_retentionPeriod' - The retention period, in days.
--
-- 'status', 'updateEventDataStoreResponse_status' - The status of an event data store. Values can be @ENABLED@ and
-- @PENDING_DELETION@.
--
-- 'terminationProtectionEnabled', 'updateEventDataStoreResponse_terminationProtectionEnabled' - Indicates whether termination protection is enabled for the event data
-- store.
--
-- 'updatedTimestamp', 'updateEventDataStoreResponse_updatedTimestamp' - The timestamp that shows when the event data store was last updated.
-- @UpdatedTimestamp@ is always either the same or newer than the time
-- shown in @CreatedTimestamp@.
--
-- 'httpStatus', 'updateEventDataStoreResponse_httpStatus' - The response's http status code.
newUpdateEventDataStoreResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateEventDataStoreResponse
newUpdateEventDataStoreResponse :: Int -> UpdateEventDataStoreResponse
newUpdateEventDataStoreResponse Int
pHttpStatus_ =
  UpdateEventDataStoreResponse'
    { $sel:advancedEventSelectors:UpdateEventDataStoreResponse' :: Maybe [AdvancedEventSelector]
advancedEventSelectors =
        forall a. Maybe a
Prelude.Nothing,
      $sel:createdTimestamp:UpdateEventDataStoreResponse' :: Maybe POSIX
createdTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:eventDataStoreArn:UpdateEventDataStoreResponse' :: Maybe Text
eventDataStoreArn = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:UpdateEventDataStoreResponse' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:multiRegionEnabled:UpdateEventDataStoreResponse' :: Maybe Bool
multiRegionEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:name:UpdateEventDataStoreResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:organizationEnabled:UpdateEventDataStoreResponse' :: Maybe Bool
organizationEnabled = forall a. Maybe a
Prelude.Nothing,
      $sel:retentionPeriod:UpdateEventDataStoreResponse' :: Maybe Natural
retentionPeriod = forall a. Maybe a
Prelude.Nothing,
      $sel:status:UpdateEventDataStoreResponse' :: Maybe EventDataStoreStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:terminationProtectionEnabled:UpdateEventDataStoreResponse' :: Maybe Bool
terminationProtectionEnabled =
        forall a. Maybe a
Prelude.Nothing,
      $sel:updatedTimestamp:UpdateEventDataStoreResponse' :: Maybe POSIX
updatedTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateEventDataStoreResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The advanced event selectors that are applied to the event data store.
updateEventDataStoreResponse_advancedEventSelectors :: Lens.Lens' UpdateEventDataStoreResponse (Prelude.Maybe [AdvancedEventSelector])
updateEventDataStoreResponse_advancedEventSelectors :: Lens' UpdateEventDataStoreResponse (Maybe [AdvancedEventSelector])
updateEventDataStoreResponse_advancedEventSelectors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStoreResponse' {Maybe [AdvancedEventSelector]
advancedEventSelectors :: Maybe [AdvancedEventSelector]
$sel:advancedEventSelectors:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe [AdvancedEventSelector]
advancedEventSelectors} -> Maybe [AdvancedEventSelector]
advancedEventSelectors) (\s :: UpdateEventDataStoreResponse
s@UpdateEventDataStoreResponse' {} Maybe [AdvancedEventSelector]
a -> UpdateEventDataStoreResponse
s {$sel:advancedEventSelectors:UpdateEventDataStoreResponse' :: Maybe [AdvancedEventSelector]
advancedEventSelectors = Maybe [AdvancedEventSelector]
a} :: UpdateEventDataStoreResponse) 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 timestamp that shows when an event data store was first created.
updateEventDataStoreResponse_createdTimestamp :: Lens.Lens' UpdateEventDataStoreResponse (Prelude.Maybe Prelude.UTCTime)
updateEventDataStoreResponse_createdTimestamp :: Lens' UpdateEventDataStoreResponse (Maybe UTCTime)
updateEventDataStoreResponse_createdTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStoreResponse' {Maybe POSIX
createdTimestamp :: Maybe POSIX
$sel:createdTimestamp:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe POSIX
createdTimestamp} -> Maybe POSIX
createdTimestamp) (\s :: UpdateEventDataStoreResponse
s@UpdateEventDataStoreResponse' {} Maybe POSIX
a -> UpdateEventDataStoreResponse
s {$sel:createdTimestamp:UpdateEventDataStoreResponse' :: Maybe POSIX
createdTimestamp = Maybe POSIX
a} :: UpdateEventDataStoreResponse) 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 ARN of the event data store.
updateEventDataStoreResponse_eventDataStoreArn :: Lens.Lens' UpdateEventDataStoreResponse (Prelude.Maybe Prelude.Text)
updateEventDataStoreResponse_eventDataStoreArn :: Lens' UpdateEventDataStoreResponse (Maybe Text)
updateEventDataStoreResponse_eventDataStoreArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStoreResponse' {Maybe Text
eventDataStoreArn :: Maybe Text
$sel:eventDataStoreArn:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Text
eventDataStoreArn} -> Maybe Text
eventDataStoreArn) (\s :: UpdateEventDataStoreResponse
s@UpdateEventDataStoreResponse' {} Maybe Text
a -> UpdateEventDataStoreResponse
s {$sel:eventDataStoreArn:UpdateEventDataStoreResponse' :: Maybe Text
eventDataStoreArn = Maybe Text
a} :: UpdateEventDataStoreResponse)

-- | Specifies the KMS key ID that encrypts the events delivered by
-- CloudTrail. The value is a fully specified ARN to a KMS key in the
-- following format.
--
-- @arn:aws:kms:us-east-2:123456789012:key\/12345678-1234-1234-1234-123456789012@
updateEventDataStoreResponse_kmsKeyId :: Lens.Lens' UpdateEventDataStoreResponse (Prelude.Maybe Prelude.Text)
updateEventDataStoreResponse_kmsKeyId :: Lens' UpdateEventDataStoreResponse (Maybe Text)
updateEventDataStoreResponse_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStoreResponse' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: UpdateEventDataStoreResponse
s@UpdateEventDataStoreResponse' {} Maybe Text
a -> UpdateEventDataStoreResponse
s {$sel:kmsKeyId:UpdateEventDataStoreResponse' :: Maybe Text
kmsKeyId = Maybe Text
a} :: UpdateEventDataStoreResponse)

-- | Indicates whether the event data store includes events from all regions,
-- or only from the region in which it was created.
updateEventDataStoreResponse_multiRegionEnabled :: Lens.Lens' UpdateEventDataStoreResponse (Prelude.Maybe Prelude.Bool)
updateEventDataStoreResponse_multiRegionEnabled :: Lens' UpdateEventDataStoreResponse (Maybe Bool)
updateEventDataStoreResponse_multiRegionEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStoreResponse' {Maybe Bool
multiRegionEnabled :: Maybe Bool
$sel:multiRegionEnabled:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Bool
multiRegionEnabled} -> Maybe Bool
multiRegionEnabled) (\s :: UpdateEventDataStoreResponse
s@UpdateEventDataStoreResponse' {} Maybe Bool
a -> UpdateEventDataStoreResponse
s {$sel:multiRegionEnabled:UpdateEventDataStoreResponse' :: Maybe Bool
multiRegionEnabled = Maybe Bool
a} :: UpdateEventDataStoreResponse)

-- | The name of the event data store.
updateEventDataStoreResponse_name :: Lens.Lens' UpdateEventDataStoreResponse (Prelude.Maybe Prelude.Text)
updateEventDataStoreResponse_name :: Lens' UpdateEventDataStoreResponse (Maybe Text)
updateEventDataStoreResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStoreResponse' {Maybe Text
name :: Maybe Text
$sel:name:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: UpdateEventDataStoreResponse
s@UpdateEventDataStoreResponse' {} Maybe Text
a -> UpdateEventDataStoreResponse
s {$sel:name:UpdateEventDataStoreResponse' :: Maybe Text
name = Maybe Text
a} :: UpdateEventDataStoreResponse)

-- | Indicates whether an event data store is collecting logged events for an
-- organization in Organizations.
updateEventDataStoreResponse_organizationEnabled :: Lens.Lens' UpdateEventDataStoreResponse (Prelude.Maybe Prelude.Bool)
updateEventDataStoreResponse_organizationEnabled :: Lens' UpdateEventDataStoreResponse (Maybe Bool)
updateEventDataStoreResponse_organizationEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStoreResponse' {Maybe Bool
organizationEnabled :: Maybe Bool
$sel:organizationEnabled:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Bool
organizationEnabled} -> Maybe Bool
organizationEnabled) (\s :: UpdateEventDataStoreResponse
s@UpdateEventDataStoreResponse' {} Maybe Bool
a -> UpdateEventDataStoreResponse
s {$sel:organizationEnabled:UpdateEventDataStoreResponse' :: Maybe Bool
organizationEnabled = Maybe Bool
a} :: UpdateEventDataStoreResponse)

-- | The retention period, in days.
updateEventDataStoreResponse_retentionPeriod :: Lens.Lens' UpdateEventDataStoreResponse (Prelude.Maybe Prelude.Natural)
updateEventDataStoreResponse_retentionPeriod :: Lens' UpdateEventDataStoreResponse (Maybe Natural)
updateEventDataStoreResponse_retentionPeriod = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStoreResponse' {Maybe Natural
retentionPeriod :: Maybe Natural
$sel:retentionPeriod:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Natural
retentionPeriod} -> Maybe Natural
retentionPeriod) (\s :: UpdateEventDataStoreResponse
s@UpdateEventDataStoreResponse' {} Maybe Natural
a -> UpdateEventDataStoreResponse
s {$sel:retentionPeriod:UpdateEventDataStoreResponse' :: Maybe Natural
retentionPeriod = Maybe Natural
a} :: UpdateEventDataStoreResponse)

-- | The status of an event data store. Values can be @ENABLED@ and
-- @PENDING_DELETION@.
updateEventDataStoreResponse_status :: Lens.Lens' UpdateEventDataStoreResponse (Prelude.Maybe EventDataStoreStatus)
updateEventDataStoreResponse_status :: Lens' UpdateEventDataStoreResponse (Maybe EventDataStoreStatus)
updateEventDataStoreResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStoreResponse' {Maybe EventDataStoreStatus
status :: Maybe EventDataStoreStatus
$sel:status:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe EventDataStoreStatus
status} -> Maybe EventDataStoreStatus
status) (\s :: UpdateEventDataStoreResponse
s@UpdateEventDataStoreResponse' {} Maybe EventDataStoreStatus
a -> UpdateEventDataStoreResponse
s {$sel:status:UpdateEventDataStoreResponse' :: Maybe EventDataStoreStatus
status = Maybe EventDataStoreStatus
a} :: UpdateEventDataStoreResponse)

-- | Indicates whether termination protection is enabled for the event data
-- store.
updateEventDataStoreResponse_terminationProtectionEnabled :: Lens.Lens' UpdateEventDataStoreResponse (Prelude.Maybe Prelude.Bool)
updateEventDataStoreResponse_terminationProtectionEnabled :: Lens' UpdateEventDataStoreResponse (Maybe Bool)
updateEventDataStoreResponse_terminationProtectionEnabled = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStoreResponse' {Maybe Bool
terminationProtectionEnabled :: Maybe Bool
$sel:terminationProtectionEnabled:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Bool
terminationProtectionEnabled} -> Maybe Bool
terminationProtectionEnabled) (\s :: UpdateEventDataStoreResponse
s@UpdateEventDataStoreResponse' {} Maybe Bool
a -> UpdateEventDataStoreResponse
s {$sel:terminationProtectionEnabled:UpdateEventDataStoreResponse' :: Maybe Bool
terminationProtectionEnabled = Maybe Bool
a} :: UpdateEventDataStoreResponse)

-- | The timestamp that shows when the event data store was last updated.
-- @UpdatedTimestamp@ is always either the same or newer than the time
-- shown in @CreatedTimestamp@.
updateEventDataStoreResponse_updatedTimestamp :: Lens.Lens' UpdateEventDataStoreResponse (Prelude.Maybe Prelude.UTCTime)
updateEventDataStoreResponse_updatedTimestamp :: Lens' UpdateEventDataStoreResponse (Maybe UTCTime)
updateEventDataStoreResponse_updatedTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStoreResponse' {Maybe POSIX
updatedTimestamp :: Maybe POSIX
$sel:updatedTimestamp:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe POSIX
updatedTimestamp} -> Maybe POSIX
updatedTimestamp) (\s :: UpdateEventDataStoreResponse
s@UpdateEventDataStoreResponse' {} Maybe POSIX
a -> UpdateEventDataStoreResponse
s {$sel:updatedTimestamp:UpdateEventDataStoreResponse' :: Maybe POSIX
updatedTimestamp = Maybe POSIX
a} :: UpdateEventDataStoreResponse) 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 response's http status code.
updateEventDataStoreResponse_httpStatus :: Lens.Lens' UpdateEventDataStoreResponse Prelude.Int
updateEventDataStoreResponse_httpStatus :: Lens' UpdateEventDataStoreResponse Int
updateEventDataStoreResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateEventDataStoreResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: UpdateEventDataStoreResponse
s@UpdateEventDataStoreResponse' {} Int
a -> UpdateEventDataStoreResponse
s {$sel:httpStatus:UpdateEventDataStoreResponse' :: Int
httpStatus = Int
a} :: UpdateEventDataStoreResponse)

instance Prelude.NFData UpdateEventDataStoreResponse where
  rnf :: UpdateEventDataStoreResponse -> ()
rnf UpdateEventDataStoreResponse' {Int
Maybe Bool
Maybe Natural
Maybe [AdvancedEventSelector]
Maybe Text
Maybe POSIX
Maybe EventDataStoreStatus
httpStatus :: Int
updatedTimestamp :: Maybe POSIX
terminationProtectionEnabled :: Maybe Bool
status :: Maybe EventDataStoreStatus
retentionPeriod :: Maybe Natural
organizationEnabled :: Maybe Bool
name :: Maybe Text
multiRegionEnabled :: Maybe Bool
kmsKeyId :: Maybe Text
eventDataStoreArn :: Maybe Text
createdTimestamp :: Maybe POSIX
advancedEventSelectors :: Maybe [AdvancedEventSelector]
$sel:httpStatus:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Int
$sel:updatedTimestamp:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe POSIX
$sel:terminationProtectionEnabled:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Bool
$sel:status:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe EventDataStoreStatus
$sel:retentionPeriod:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Natural
$sel:organizationEnabled:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Bool
$sel:name:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Text
$sel:multiRegionEnabled:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Bool
$sel:kmsKeyId:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Text
$sel:eventDataStoreArn:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe Text
$sel:createdTimestamp:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe POSIX
$sel:advancedEventSelectors:UpdateEventDataStoreResponse' :: UpdateEventDataStoreResponse -> Maybe [AdvancedEventSelector]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AdvancedEventSelector]
advancedEventSelectors
      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 Text
eventDataStoreArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
multiRegionEnabled
      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 Bool
organizationEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
retentionPeriod
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EventDataStoreStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
terminationProtectionEnabled
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
updatedTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus