{-# 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.DeleteFlowLogs
-- 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 one or more flow logs.
module Amazonka.EC2.DeleteFlowLogs
  ( -- * Creating a Request
    DeleteFlowLogs (..),
    newDeleteFlowLogs,

    -- * Request Lenses
    deleteFlowLogs_dryRun,
    deleteFlowLogs_flowLogIds,

    -- * Destructuring the Response
    DeleteFlowLogsResponse (..),
    newDeleteFlowLogsResponse,

    -- * Response Lenses
    deleteFlowLogsResponse_unsuccessful,
    deleteFlowLogsResponse_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:/ 'newDeleteFlowLogs' smart constructor.
data DeleteFlowLogs = DeleteFlowLogs'
  { -- | 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@.
    DeleteFlowLogs -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | One or more flow log IDs.
    --
    -- Constraint: Maximum of 1000 flow log IDs.
    DeleteFlowLogs -> [Text]
flowLogIds :: [Prelude.Text]
  }
  deriving (DeleteFlowLogs -> DeleteFlowLogs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteFlowLogs -> DeleteFlowLogs -> Bool
$c/= :: DeleteFlowLogs -> DeleteFlowLogs -> Bool
== :: DeleteFlowLogs -> DeleteFlowLogs -> Bool
$c== :: DeleteFlowLogs -> DeleteFlowLogs -> Bool
Prelude.Eq, ReadPrec [DeleteFlowLogs]
ReadPrec DeleteFlowLogs
Int -> ReadS DeleteFlowLogs
ReadS [DeleteFlowLogs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteFlowLogs]
$creadListPrec :: ReadPrec [DeleteFlowLogs]
readPrec :: ReadPrec DeleteFlowLogs
$creadPrec :: ReadPrec DeleteFlowLogs
readList :: ReadS [DeleteFlowLogs]
$creadList :: ReadS [DeleteFlowLogs]
readsPrec :: Int -> ReadS DeleteFlowLogs
$creadsPrec :: Int -> ReadS DeleteFlowLogs
Prelude.Read, Int -> DeleteFlowLogs -> ShowS
[DeleteFlowLogs] -> ShowS
DeleteFlowLogs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteFlowLogs] -> ShowS
$cshowList :: [DeleteFlowLogs] -> ShowS
show :: DeleteFlowLogs -> String
$cshow :: DeleteFlowLogs -> String
showsPrec :: Int -> DeleteFlowLogs -> ShowS
$cshowsPrec :: Int -> DeleteFlowLogs -> ShowS
Prelude.Show, forall x. Rep DeleteFlowLogs x -> DeleteFlowLogs
forall x. DeleteFlowLogs -> Rep DeleteFlowLogs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteFlowLogs x -> DeleteFlowLogs
$cfrom :: forall x. DeleteFlowLogs -> Rep DeleteFlowLogs x
Prelude.Generic)

-- |
-- Create a value of 'DeleteFlowLogs' 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', 'deleteFlowLogs_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@.
--
-- 'flowLogIds', 'deleteFlowLogs_flowLogIds' - One or more flow log IDs.
--
-- Constraint: Maximum of 1000 flow log IDs.
newDeleteFlowLogs ::
  DeleteFlowLogs
newDeleteFlowLogs :: DeleteFlowLogs
newDeleteFlowLogs =
  DeleteFlowLogs'
    { $sel:dryRun:DeleteFlowLogs' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:flowLogIds:DeleteFlowLogs' :: [Text]
flowLogIds = forall a. Monoid a => a
Prelude.mempty
    }

-- | 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@.
deleteFlowLogs_dryRun :: Lens.Lens' DeleteFlowLogs (Prelude.Maybe Prelude.Bool)
deleteFlowLogs_dryRun :: Lens' DeleteFlowLogs (Maybe Bool)
deleteFlowLogs_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteFlowLogs' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DeleteFlowLogs' :: DeleteFlowLogs -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: DeleteFlowLogs
s@DeleteFlowLogs' {} Maybe Bool
a -> DeleteFlowLogs
s {$sel:dryRun:DeleteFlowLogs' :: Maybe Bool
dryRun = Maybe Bool
a} :: DeleteFlowLogs)

-- | One or more flow log IDs.
--
-- Constraint: Maximum of 1000 flow log IDs.
deleteFlowLogs_flowLogIds :: Lens.Lens' DeleteFlowLogs [Prelude.Text]
deleteFlowLogs_flowLogIds :: Lens' DeleteFlowLogs [Text]
deleteFlowLogs_flowLogIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteFlowLogs' {[Text]
flowLogIds :: [Text]
$sel:flowLogIds:DeleteFlowLogs' :: DeleteFlowLogs -> [Text]
flowLogIds} -> [Text]
flowLogIds) (\s :: DeleteFlowLogs
s@DeleteFlowLogs' {} [Text]
a -> DeleteFlowLogs
s {$sel:flowLogIds:DeleteFlowLogs' :: [Text]
flowLogIds = [Text]
a} :: DeleteFlowLogs) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest DeleteFlowLogs where
  type
    AWSResponse DeleteFlowLogs =
      DeleteFlowLogsResponse
  request :: (Service -> Service) -> DeleteFlowLogs -> Request DeleteFlowLogs
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 DeleteFlowLogs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteFlowLogs)))
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 [UnsuccessfulItem] -> Int -> DeleteFlowLogsResponse
DeleteFlowLogsResponse'
            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
"unsuccessful"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            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 DeleteFlowLogs where
  hashWithSalt :: Int -> DeleteFlowLogs -> Int
hashWithSalt Int
_salt DeleteFlowLogs' {[Text]
Maybe Bool
flowLogIds :: [Text]
dryRun :: Maybe Bool
$sel:flowLogIds:DeleteFlowLogs' :: DeleteFlowLogs -> [Text]
$sel:dryRun:DeleteFlowLogs' :: DeleteFlowLogs -> 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]
flowLogIds

instance Prelude.NFData DeleteFlowLogs where
  rnf :: DeleteFlowLogs -> ()
rnf DeleteFlowLogs' {[Text]
Maybe Bool
flowLogIds :: [Text]
dryRun :: Maybe Bool
$sel:flowLogIds:DeleteFlowLogs' :: DeleteFlowLogs -> [Text]
$sel:dryRun:DeleteFlowLogs' :: DeleteFlowLogs -> 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]
flowLogIds

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

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

instance Data.ToQuery DeleteFlowLogs where
  toQuery :: DeleteFlowLogs -> QueryString
toQuery DeleteFlowLogs' {[Text]
Maybe Bool
flowLogIds :: [Text]
dryRun :: Maybe Bool
$sel:flowLogIds:DeleteFlowLogs' :: DeleteFlowLogs -> [Text]
$sel:dryRun:DeleteFlowLogs' :: DeleteFlowLogs -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DeleteFlowLogs" :: 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,
        forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"FlowLogId" [Text]
flowLogIds
      ]

-- | /See:/ 'newDeleteFlowLogsResponse' smart constructor.
data DeleteFlowLogsResponse = DeleteFlowLogsResponse'
  { -- | Information about the flow logs that could not be deleted successfully.
    DeleteFlowLogsResponse -> Maybe [UnsuccessfulItem]
unsuccessful :: Prelude.Maybe [UnsuccessfulItem],
    -- | The response's http status code.
    DeleteFlowLogsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteFlowLogsResponse -> DeleteFlowLogsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteFlowLogsResponse -> DeleteFlowLogsResponse -> Bool
$c/= :: DeleteFlowLogsResponse -> DeleteFlowLogsResponse -> Bool
== :: DeleteFlowLogsResponse -> DeleteFlowLogsResponse -> Bool
$c== :: DeleteFlowLogsResponse -> DeleteFlowLogsResponse -> Bool
Prelude.Eq, ReadPrec [DeleteFlowLogsResponse]
ReadPrec DeleteFlowLogsResponse
Int -> ReadS DeleteFlowLogsResponse
ReadS [DeleteFlowLogsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteFlowLogsResponse]
$creadListPrec :: ReadPrec [DeleteFlowLogsResponse]
readPrec :: ReadPrec DeleteFlowLogsResponse
$creadPrec :: ReadPrec DeleteFlowLogsResponse
readList :: ReadS [DeleteFlowLogsResponse]
$creadList :: ReadS [DeleteFlowLogsResponse]
readsPrec :: Int -> ReadS DeleteFlowLogsResponse
$creadsPrec :: Int -> ReadS DeleteFlowLogsResponse
Prelude.Read, Int -> DeleteFlowLogsResponse -> ShowS
[DeleteFlowLogsResponse] -> ShowS
DeleteFlowLogsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteFlowLogsResponse] -> ShowS
$cshowList :: [DeleteFlowLogsResponse] -> ShowS
show :: DeleteFlowLogsResponse -> String
$cshow :: DeleteFlowLogsResponse -> String
showsPrec :: Int -> DeleteFlowLogsResponse -> ShowS
$cshowsPrec :: Int -> DeleteFlowLogsResponse -> ShowS
Prelude.Show, forall x. Rep DeleteFlowLogsResponse x -> DeleteFlowLogsResponse
forall x. DeleteFlowLogsResponse -> Rep DeleteFlowLogsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteFlowLogsResponse x -> DeleteFlowLogsResponse
$cfrom :: forall x. DeleteFlowLogsResponse -> Rep DeleteFlowLogsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteFlowLogsResponse' 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:
--
-- 'unsuccessful', 'deleteFlowLogsResponse_unsuccessful' - Information about the flow logs that could not be deleted successfully.
--
-- 'httpStatus', 'deleteFlowLogsResponse_httpStatus' - The response's http status code.
newDeleteFlowLogsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteFlowLogsResponse
newDeleteFlowLogsResponse :: Int -> DeleteFlowLogsResponse
newDeleteFlowLogsResponse Int
pHttpStatus_ =
  DeleteFlowLogsResponse'
    { $sel:unsuccessful:DeleteFlowLogsResponse' :: Maybe [UnsuccessfulItem]
unsuccessful =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteFlowLogsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Information about the flow logs that could not be deleted successfully.
deleteFlowLogsResponse_unsuccessful :: Lens.Lens' DeleteFlowLogsResponse (Prelude.Maybe [UnsuccessfulItem])
deleteFlowLogsResponse_unsuccessful :: Lens' DeleteFlowLogsResponse (Maybe [UnsuccessfulItem])
deleteFlowLogsResponse_unsuccessful = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteFlowLogsResponse' {Maybe [UnsuccessfulItem]
unsuccessful :: Maybe [UnsuccessfulItem]
$sel:unsuccessful:DeleteFlowLogsResponse' :: DeleteFlowLogsResponse -> Maybe [UnsuccessfulItem]
unsuccessful} -> Maybe [UnsuccessfulItem]
unsuccessful) (\s :: DeleteFlowLogsResponse
s@DeleteFlowLogsResponse' {} Maybe [UnsuccessfulItem]
a -> DeleteFlowLogsResponse
s {$sel:unsuccessful:DeleteFlowLogsResponse' :: Maybe [UnsuccessfulItem]
unsuccessful = Maybe [UnsuccessfulItem]
a} :: DeleteFlowLogsResponse) 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 response's http status code.
deleteFlowLogsResponse_httpStatus :: Lens.Lens' DeleteFlowLogsResponse Prelude.Int
deleteFlowLogsResponse_httpStatus :: Lens' DeleteFlowLogsResponse Int
deleteFlowLogsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteFlowLogsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DeleteFlowLogsResponse' :: DeleteFlowLogsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DeleteFlowLogsResponse
s@DeleteFlowLogsResponse' {} Int
a -> DeleteFlowLogsResponse
s {$sel:httpStatus:DeleteFlowLogsResponse' :: Int
httpStatus = Int
a} :: DeleteFlowLogsResponse)

instance Prelude.NFData DeleteFlowLogsResponse where
  rnf :: DeleteFlowLogsResponse -> ()
rnf DeleteFlowLogsResponse' {Int
Maybe [UnsuccessfulItem]
httpStatus :: Int
unsuccessful :: Maybe [UnsuccessfulItem]
$sel:httpStatus:DeleteFlowLogsResponse' :: DeleteFlowLogsResponse -> Int
$sel:unsuccessful:DeleteFlowLogsResponse' :: DeleteFlowLogsResponse -> Maybe [UnsuccessfulItem]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [UnsuccessfulItem]
unsuccessful
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus