{-# 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.DataExchange.DeleteEventAction
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- This operation deletes the event action.
module Amazonka.DataExchange.DeleteEventAction
  ( -- * Creating a Request
    DeleteEventAction (..),
    newDeleteEventAction,

    -- * Request Lenses
    deleteEventAction_eventActionId,

    -- * Destructuring the Response
    DeleteEventActionResponse (..),
    newDeleteEventActionResponse,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DataExchange.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDeleteEventAction' smart constructor.
data DeleteEventAction = DeleteEventAction'
  { -- | The unique identifier for the event action.
    DeleteEventAction -> Text
eventActionId :: Prelude.Text
  }
  deriving (DeleteEventAction -> DeleteEventAction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteEventAction -> DeleteEventAction -> Bool
$c/= :: DeleteEventAction -> DeleteEventAction -> Bool
== :: DeleteEventAction -> DeleteEventAction -> Bool
$c== :: DeleteEventAction -> DeleteEventAction -> Bool
Prelude.Eq, ReadPrec [DeleteEventAction]
ReadPrec DeleteEventAction
Int -> ReadS DeleteEventAction
ReadS [DeleteEventAction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteEventAction]
$creadListPrec :: ReadPrec [DeleteEventAction]
readPrec :: ReadPrec DeleteEventAction
$creadPrec :: ReadPrec DeleteEventAction
readList :: ReadS [DeleteEventAction]
$creadList :: ReadS [DeleteEventAction]
readsPrec :: Int -> ReadS DeleteEventAction
$creadsPrec :: Int -> ReadS DeleteEventAction
Prelude.Read, Int -> DeleteEventAction -> ShowS
[DeleteEventAction] -> ShowS
DeleteEventAction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteEventAction] -> ShowS
$cshowList :: [DeleteEventAction] -> ShowS
show :: DeleteEventAction -> String
$cshow :: DeleteEventAction -> String
showsPrec :: Int -> DeleteEventAction -> ShowS
$cshowsPrec :: Int -> DeleteEventAction -> ShowS
Prelude.Show, forall x. Rep DeleteEventAction x -> DeleteEventAction
forall x. DeleteEventAction -> Rep DeleteEventAction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteEventAction x -> DeleteEventAction
$cfrom :: forall x. DeleteEventAction -> Rep DeleteEventAction x
Prelude.Generic)

-- |
-- Create a value of 'DeleteEventAction' 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:
--
-- 'eventActionId', 'deleteEventAction_eventActionId' - The unique identifier for the event action.
newDeleteEventAction ::
  -- | 'eventActionId'
  Prelude.Text ->
  DeleteEventAction
newDeleteEventAction :: Text -> DeleteEventAction
newDeleteEventAction Text
pEventActionId_ =
  DeleteEventAction' {$sel:eventActionId:DeleteEventAction' :: Text
eventActionId = Text
pEventActionId_}

-- | The unique identifier for the event action.
deleteEventAction_eventActionId :: Lens.Lens' DeleteEventAction Prelude.Text
deleteEventAction_eventActionId :: Lens' DeleteEventAction Text
deleteEventAction_eventActionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteEventAction' {Text
eventActionId :: Text
$sel:eventActionId:DeleteEventAction' :: DeleteEventAction -> Text
eventActionId} -> Text
eventActionId) (\s :: DeleteEventAction
s@DeleteEventAction' {} Text
a -> DeleteEventAction
s {$sel:eventActionId:DeleteEventAction' :: Text
eventActionId = Text
a} :: DeleteEventAction)

instance Core.AWSRequest DeleteEventAction where
  type
    AWSResponse DeleteEventAction =
      DeleteEventActionResponse
  request :: (Service -> Service)
-> DeleteEventAction -> Request DeleteEventAction
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteEventAction
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteEventAction)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteEventActionResponse
DeleteEventActionResponse'

instance Prelude.Hashable DeleteEventAction where
  hashWithSalt :: Int -> DeleteEventAction -> Int
hashWithSalt Int
_salt DeleteEventAction' {Text
eventActionId :: Text
$sel:eventActionId:DeleteEventAction' :: DeleteEventAction -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
eventActionId

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

instance Data.ToHeaders DeleteEventAction where
  toHeaders :: DeleteEventAction -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DeleteEventAction where
  toPath :: DeleteEventAction -> ByteString
toPath DeleteEventAction' {Text
eventActionId :: Text
$sel:eventActionId:DeleteEventAction' :: DeleteEventAction -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/v1/event-actions/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
eventActionId]

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

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

-- |
-- Create a value of 'DeleteEventActionResponse' 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.
newDeleteEventActionResponse ::
  DeleteEventActionResponse
newDeleteEventActionResponse :: DeleteEventActionResponse
newDeleteEventActionResponse =
  DeleteEventActionResponse
DeleteEventActionResponse'

instance Prelude.NFData DeleteEventActionResponse where
  rnf :: DeleteEventActionResponse -> ()
rnf DeleteEventActionResponse
_ = ()