{-# 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.DeleteEventDataStore
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disables the event data store specified by @EventDataStore@, which
-- accepts an event data store ARN. After you run @DeleteEventDataStore@,
-- the event data store enters a @PENDING_DELETION@ state, and is
-- automatically deleted after a wait period of seven days.
-- @TerminationProtectionEnabled@ must be set to @False@ on the event data
-- store; this operation cannot work if @TerminationProtectionEnabled@ is
-- @True@.
--
-- After you run @DeleteEventDataStore@ on an event data store, you cannot
-- run @ListQueries@, @DescribeQuery@, or @GetQueryResults@ on queries that
-- are using an event data store in a @PENDING_DELETION@ state. An event
-- data store in the @PENDING_DELETION@ state does not incur costs.
module Amazonka.CloudTrail.DeleteEventDataStore
  ( -- * Creating a Request
    DeleteEventDataStore (..),
    newDeleteEventDataStore,

    -- * Request Lenses
    deleteEventDataStore_eventDataStore,

    -- * Destructuring the Response
    DeleteEventDataStoreResponse (..),
    newDeleteEventDataStoreResponse,

    -- * Response Lenses
    deleteEventDataStoreResponse_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:/ 'newDeleteEventDataStore' smart constructor.
data DeleteEventDataStore = DeleteEventDataStore'
  { -- | The ARN (or the ID suffix of the ARN) of the event data store to delete.
    DeleteEventDataStore -> Text
eventDataStore :: Prelude.Text
  }
  deriving (DeleteEventDataStore -> DeleteEventDataStore -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteEventDataStore -> DeleteEventDataStore -> Bool
$c/= :: DeleteEventDataStore -> DeleteEventDataStore -> Bool
== :: DeleteEventDataStore -> DeleteEventDataStore -> Bool
$c== :: DeleteEventDataStore -> DeleteEventDataStore -> Bool
Prelude.Eq, ReadPrec [DeleteEventDataStore]
ReadPrec DeleteEventDataStore
Int -> ReadS DeleteEventDataStore
ReadS [DeleteEventDataStore]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteEventDataStore]
$creadListPrec :: ReadPrec [DeleteEventDataStore]
readPrec :: ReadPrec DeleteEventDataStore
$creadPrec :: ReadPrec DeleteEventDataStore
readList :: ReadS [DeleteEventDataStore]
$creadList :: ReadS [DeleteEventDataStore]
readsPrec :: Int -> ReadS DeleteEventDataStore
$creadsPrec :: Int -> ReadS DeleteEventDataStore
Prelude.Read, Int -> DeleteEventDataStore -> ShowS
[DeleteEventDataStore] -> ShowS
DeleteEventDataStore -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteEventDataStore] -> ShowS
$cshowList :: [DeleteEventDataStore] -> ShowS
show :: DeleteEventDataStore -> String
$cshow :: DeleteEventDataStore -> String
showsPrec :: Int -> DeleteEventDataStore -> ShowS
$cshowsPrec :: Int -> DeleteEventDataStore -> ShowS
Prelude.Show, forall x. Rep DeleteEventDataStore x -> DeleteEventDataStore
forall x. DeleteEventDataStore -> Rep DeleteEventDataStore x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteEventDataStore x -> DeleteEventDataStore
$cfrom :: forall x. DeleteEventDataStore -> Rep DeleteEventDataStore x
Prelude.Generic)

-- |
-- Create a value of 'DeleteEventDataStore' 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:
--
-- 'eventDataStore', 'deleteEventDataStore_eventDataStore' - The ARN (or the ID suffix of the ARN) of the event data store to delete.
newDeleteEventDataStore ::
  -- | 'eventDataStore'
  Prelude.Text ->
  DeleteEventDataStore
newDeleteEventDataStore :: Text -> DeleteEventDataStore
newDeleteEventDataStore Text
pEventDataStore_ =
  DeleteEventDataStore'
    { $sel:eventDataStore:DeleteEventDataStore' :: Text
eventDataStore =
        Text
pEventDataStore_
    }

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

instance Core.AWSRequest DeleteEventDataStore where
  type
    AWSResponse DeleteEventDataStore =
      DeleteEventDataStoreResponse
  request :: (Service -> Service)
-> DeleteEventDataStore -> Request DeleteEventDataStore
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 DeleteEventDataStore
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteEventDataStore)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> DeleteEventDataStoreResponse
DeleteEventDataStoreResponse'
            forall (f :: * -> *) a b. Functor 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 DeleteEventDataStore where
  hashWithSalt :: Int -> DeleteEventDataStore -> Int
hashWithSalt Int
_salt DeleteEventDataStore' {Text
eventDataStore :: Text
$sel:eventDataStore:DeleteEventDataStore' :: DeleteEventDataStore -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eventDataStore

instance Prelude.NFData DeleteEventDataStore where
  rnf :: DeleteEventDataStore -> ()
rnf DeleteEventDataStore' {Text
eventDataStore :: Text
$sel:eventDataStore:DeleteEventDataStore' :: DeleteEventDataStore -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
eventDataStore

instance Data.ToHeaders DeleteEventDataStore where
  toHeaders :: DeleteEventDataStore -> 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.DeleteEventDataStore" ::
                          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 DeleteEventDataStore where
  toJSON :: DeleteEventDataStore -> Value
toJSON DeleteEventDataStore' {Text
eventDataStore :: Text
$sel:eventDataStore:DeleteEventDataStore' :: DeleteEventDataStore -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ 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 DeleteEventDataStore where
  toPath :: DeleteEventDataStore -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newDeleteEventDataStoreResponse' smart constructor.
data DeleteEventDataStoreResponse = DeleteEventDataStoreResponse'
  { -- | The response's http status code.
    DeleteEventDataStoreResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteEventDataStoreResponse
-> DeleteEventDataStoreResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteEventDataStoreResponse
-> DeleteEventDataStoreResponse -> Bool
$c/= :: DeleteEventDataStoreResponse
-> DeleteEventDataStoreResponse -> Bool
== :: DeleteEventDataStoreResponse
-> DeleteEventDataStoreResponse -> Bool
$c== :: DeleteEventDataStoreResponse
-> DeleteEventDataStoreResponse -> Bool
Prelude.Eq, ReadPrec [DeleteEventDataStoreResponse]
ReadPrec DeleteEventDataStoreResponse
Int -> ReadS DeleteEventDataStoreResponse
ReadS [DeleteEventDataStoreResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteEventDataStoreResponse]
$creadListPrec :: ReadPrec [DeleteEventDataStoreResponse]
readPrec :: ReadPrec DeleteEventDataStoreResponse
$creadPrec :: ReadPrec DeleteEventDataStoreResponse
readList :: ReadS [DeleteEventDataStoreResponse]
$creadList :: ReadS [DeleteEventDataStoreResponse]
readsPrec :: Int -> ReadS DeleteEventDataStoreResponse
$creadsPrec :: Int -> ReadS DeleteEventDataStoreResponse
Prelude.Read, Int -> DeleteEventDataStoreResponse -> ShowS
[DeleteEventDataStoreResponse] -> ShowS
DeleteEventDataStoreResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteEventDataStoreResponse] -> ShowS
$cshowList :: [DeleteEventDataStoreResponse] -> ShowS
show :: DeleteEventDataStoreResponse -> String
$cshow :: DeleteEventDataStoreResponse -> String
showsPrec :: Int -> DeleteEventDataStoreResponse -> ShowS
$cshowsPrec :: Int -> DeleteEventDataStoreResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteEventDataStoreResponse x -> DeleteEventDataStoreResponse
forall x.
DeleteEventDataStoreResponse -> Rep DeleteEventDataStoreResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteEventDataStoreResponse x -> DeleteEventDataStoreResponse
$cfrom :: forall x.
DeleteEventDataStoreResponse -> Rep DeleteEventDataStoreResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteEventDataStoreResponse' 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:
--
-- 'httpStatus', 'deleteEventDataStoreResponse_httpStatus' - The response's http status code.
newDeleteEventDataStoreResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteEventDataStoreResponse
newDeleteEventDataStoreResponse :: Int -> DeleteEventDataStoreResponse
newDeleteEventDataStoreResponse Int
pHttpStatus_ =
  DeleteEventDataStoreResponse'
    { $sel:httpStatus:DeleteEventDataStoreResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

-- | The response's http status code.
deleteEventDataStoreResponse_httpStatus :: Lens.Lens' DeleteEventDataStoreResponse Prelude.Int
deleteEventDataStoreResponse_httpStatus :: Lens' DeleteEventDataStoreResponse Int
deleteEventDataStoreResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteEventDataStoreResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteEventDataStoreResponse' :: DeleteEventDataStoreResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DeleteEventDataStoreResponse
s@DeleteEventDataStoreResponse' {} Int
a -> DeleteEventDataStoreResponse
s {$sel:httpStatus:DeleteEventDataStoreResponse' :: Int
httpStatus = Int
a} :: DeleteEventDataStoreResponse)

instance Prelude.NFData DeleteEventDataStoreResponse where
  rnf :: DeleteEventDataStoreResponse -> ()
rnf DeleteEventDataStoreResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteEventDataStoreResponse' :: DeleteEventDataStoreResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus