{-# 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.EC2.DeleteTrafficMirrorSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes the specified Traffic Mirror session.
module Amazonka.EC2.DeleteTrafficMirrorSession
  ( -- * Creating a Request
    DeleteTrafficMirrorSession (..),
    newDeleteTrafficMirrorSession,

    -- * Request Lenses
    deleteTrafficMirrorSession_dryRun,
    deleteTrafficMirrorSession_trafficMirrorSessionId,

    -- * Destructuring the Response
    DeleteTrafficMirrorSessionResponse (..),
    newDeleteTrafficMirrorSessionResponse,

    -- * Response Lenses
    deleteTrafficMirrorSessionResponse_trafficMirrorSessionId,
    deleteTrafficMirrorSessionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeleteTrafficMirrorSession' smart constructor.
data DeleteTrafficMirrorSession = DeleteTrafficMirrorSession'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    DeleteTrafficMirrorSession -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The ID of the Traffic Mirror session.
    DeleteTrafficMirrorSession -> Text
trafficMirrorSessionId :: Prelude.Text
  }
  deriving (DeleteTrafficMirrorSession -> DeleteTrafficMirrorSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteTrafficMirrorSession -> DeleteTrafficMirrorSession -> Bool
$c/= :: DeleteTrafficMirrorSession -> DeleteTrafficMirrorSession -> Bool
== :: DeleteTrafficMirrorSession -> DeleteTrafficMirrorSession -> Bool
$c== :: DeleteTrafficMirrorSession -> DeleteTrafficMirrorSession -> Bool
Prelude.Eq, ReadPrec [DeleteTrafficMirrorSession]
ReadPrec DeleteTrafficMirrorSession
Int -> ReadS DeleteTrafficMirrorSession
ReadS [DeleteTrafficMirrorSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteTrafficMirrorSession]
$creadListPrec :: ReadPrec [DeleteTrafficMirrorSession]
readPrec :: ReadPrec DeleteTrafficMirrorSession
$creadPrec :: ReadPrec DeleteTrafficMirrorSession
readList :: ReadS [DeleteTrafficMirrorSession]
$creadList :: ReadS [DeleteTrafficMirrorSession]
readsPrec :: Int -> ReadS DeleteTrafficMirrorSession
$creadsPrec :: Int -> ReadS DeleteTrafficMirrorSession
Prelude.Read, Int -> DeleteTrafficMirrorSession -> ShowS
[DeleteTrafficMirrorSession] -> ShowS
DeleteTrafficMirrorSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteTrafficMirrorSession] -> ShowS
$cshowList :: [DeleteTrafficMirrorSession] -> ShowS
show :: DeleteTrafficMirrorSession -> String
$cshow :: DeleteTrafficMirrorSession -> String
showsPrec :: Int -> DeleteTrafficMirrorSession -> ShowS
$cshowsPrec :: Int -> DeleteTrafficMirrorSession -> ShowS
Prelude.Show, forall x.
Rep DeleteTrafficMirrorSession x -> DeleteTrafficMirrorSession
forall x.
DeleteTrafficMirrorSession -> Rep DeleteTrafficMirrorSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteTrafficMirrorSession x -> DeleteTrafficMirrorSession
$cfrom :: forall x.
DeleteTrafficMirrorSession -> Rep DeleteTrafficMirrorSession x
Prelude.Generic)

-- |
-- Create a value of 'DeleteTrafficMirrorSession' 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:
--
-- 'dryRun', 'deleteTrafficMirrorSession_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'trafficMirrorSessionId', 'deleteTrafficMirrorSession_trafficMirrorSessionId' - The ID of the Traffic Mirror session.
newDeleteTrafficMirrorSession ::
  -- | 'trafficMirrorSessionId'
  Prelude.Text ->
  DeleteTrafficMirrorSession
newDeleteTrafficMirrorSession :: Text -> DeleteTrafficMirrorSession
newDeleteTrafficMirrorSession
  Text
pTrafficMirrorSessionId_ =
    DeleteTrafficMirrorSession'
      { $sel:dryRun:DeleteTrafficMirrorSession' :: Maybe Bool
dryRun =
          forall a. Maybe a
Prelude.Nothing,
        $sel:trafficMirrorSessionId:DeleteTrafficMirrorSession' :: Text
trafficMirrorSessionId =
          Text
pTrafficMirrorSessionId_
      }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
deleteTrafficMirrorSession_dryRun :: Lens.Lens' DeleteTrafficMirrorSession (Prelude.Maybe Prelude.Bool)
deleteTrafficMirrorSession_dryRun :: Lens' DeleteTrafficMirrorSession (Maybe Bool)
deleteTrafficMirrorSession_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteTrafficMirrorSession' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DeleteTrafficMirrorSession' :: DeleteTrafficMirrorSession -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: DeleteTrafficMirrorSession
s@DeleteTrafficMirrorSession' {} Maybe Bool
a -> DeleteTrafficMirrorSession
s {$sel:dryRun:DeleteTrafficMirrorSession' :: Maybe Bool
dryRun = Maybe Bool
a} :: DeleteTrafficMirrorSession)

-- | The ID of the Traffic Mirror session.
deleteTrafficMirrorSession_trafficMirrorSessionId :: Lens.Lens' DeleteTrafficMirrorSession Prelude.Text
deleteTrafficMirrorSession_trafficMirrorSessionId :: Lens' DeleteTrafficMirrorSession Text
deleteTrafficMirrorSession_trafficMirrorSessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteTrafficMirrorSession' {Text
trafficMirrorSessionId :: Text
$sel:trafficMirrorSessionId:DeleteTrafficMirrorSession' :: DeleteTrafficMirrorSession -> Text
trafficMirrorSessionId} -> Text
trafficMirrorSessionId) (\s :: DeleteTrafficMirrorSession
s@DeleteTrafficMirrorSession' {} Text
a -> DeleteTrafficMirrorSession
s {$sel:trafficMirrorSessionId:DeleteTrafficMirrorSession' :: Text
trafficMirrorSessionId = Text
a} :: DeleteTrafficMirrorSession)

instance Core.AWSRequest DeleteTrafficMirrorSession where
  type
    AWSResponse DeleteTrafficMirrorSession =
      DeleteTrafficMirrorSessionResponse
  request :: (Service -> Service)
-> DeleteTrafficMirrorSession -> Request DeleteTrafficMirrorSession
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 DeleteTrafficMirrorSession
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteTrafficMirrorSession)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Int -> DeleteTrafficMirrorSessionResponse
DeleteTrafficMirrorSessionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"trafficMirrorSessionId")
            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 DeleteTrafficMirrorSession where
  hashWithSalt :: Int -> DeleteTrafficMirrorSession -> Int
hashWithSalt Int
_salt DeleteTrafficMirrorSession' {Maybe Bool
Text
trafficMirrorSessionId :: Text
dryRun :: Maybe Bool
$sel:trafficMirrorSessionId:DeleteTrafficMirrorSession' :: DeleteTrafficMirrorSession -> Text
$sel:dryRun:DeleteTrafficMirrorSession' :: DeleteTrafficMirrorSession -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
trafficMirrorSessionId

instance Prelude.NFData DeleteTrafficMirrorSession where
  rnf :: DeleteTrafficMirrorSession -> ()
rnf DeleteTrafficMirrorSession' {Maybe Bool
Text
trafficMirrorSessionId :: Text
dryRun :: Maybe Bool
$sel:trafficMirrorSessionId:DeleteTrafficMirrorSession' :: DeleteTrafficMirrorSession -> Text
$sel:dryRun:DeleteTrafficMirrorSession' :: DeleteTrafficMirrorSession -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
trafficMirrorSessionId

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

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

instance Data.ToQuery DeleteTrafficMirrorSession where
  toQuery :: DeleteTrafficMirrorSession -> QueryString
toQuery DeleteTrafficMirrorSession' {Maybe Bool
Text
trafficMirrorSessionId :: Text
dryRun :: Maybe Bool
$sel:trafficMirrorSessionId:DeleteTrafficMirrorSession' :: DeleteTrafficMirrorSession -> Text
$sel:dryRun:DeleteTrafficMirrorSession' :: DeleteTrafficMirrorSession -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteTrafficMirrorSession" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"TrafficMirrorSessionId"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
trafficMirrorSessionId
      ]

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

-- |
-- Create a value of 'DeleteTrafficMirrorSessionResponse' 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:
--
-- 'trafficMirrorSessionId', 'deleteTrafficMirrorSessionResponse_trafficMirrorSessionId' - The ID of the deleted Traffic Mirror session.
--
-- 'httpStatus', 'deleteTrafficMirrorSessionResponse_httpStatus' - The response's http status code.
newDeleteTrafficMirrorSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteTrafficMirrorSessionResponse
newDeleteTrafficMirrorSessionResponse :: Int -> DeleteTrafficMirrorSessionResponse
newDeleteTrafficMirrorSessionResponse Int
pHttpStatus_ =
  DeleteTrafficMirrorSessionResponse'
    { $sel:trafficMirrorSessionId:DeleteTrafficMirrorSessionResponse' :: Maybe Text
trafficMirrorSessionId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteTrafficMirrorSessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the deleted Traffic Mirror session.
deleteTrafficMirrorSessionResponse_trafficMirrorSessionId :: Lens.Lens' DeleteTrafficMirrorSessionResponse (Prelude.Maybe Prelude.Text)
deleteTrafficMirrorSessionResponse_trafficMirrorSessionId :: Lens' DeleteTrafficMirrorSessionResponse (Maybe Text)
deleteTrafficMirrorSessionResponse_trafficMirrorSessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteTrafficMirrorSessionResponse' {Maybe Text
trafficMirrorSessionId :: Maybe Text
$sel:trafficMirrorSessionId:DeleteTrafficMirrorSessionResponse' :: DeleteTrafficMirrorSessionResponse -> Maybe Text
trafficMirrorSessionId} -> Maybe Text
trafficMirrorSessionId) (\s :: DeleteTrafficMirrorSessionResponse
s@DeleteTrafficMirrorSessionResponse' {} Maybe Text
a -> DeleteTrafficMirrorSessionResponse
s {$sel:trafficMirrorSessionId:DeleteTrafficMirrorSessionResponse' :: Maybe Text
trafficMirrorSessionId = Maybe Text
a} :: DeleteTrafficMirrorSessionResponse)

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

instance
  Prelude.NFData
    DeleteTrafficMirrorSessionResponse
  where
  rnf :: DeleteTrafficMirrorSessionResponse -> ()
rnf DeleteTrafficMirrorSessionResponse' {Int
Maybe Text
httpStatus :: Int
trafficMirrorSessionId :: Maybe Text
$sel:httpStatus:DeleteTrafficMirrorSessionResponse' :: DeleteTrafficMirrorSessionResponse -> Int
$sel:trafficMirrorSessionId:DeleteTrafficMirrorSessionResponse' :: DeleteTrafficMirrorSessionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
trafficMirrorSessionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus