{-# 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.Discovery.DeleteApplications
-- 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 a list of applications and their associations with configuration
-- items.
module Amazonka.Discovery.DeleteApplications
  ( -- * Creating a Request
    DeleteApplications (..),
    newDeleteApplications,

    -- * Request Lenses
    deleteApplications_configurationIds,

    -- * Destructuring the Response
    DeleteApplicationsResponse (..),
    newDeleteApplicationsResponse,

    -- * Response Lenses
    deleteApplicationsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeleteApplications' smart constructor.
data DeleteApplications = DeleteApplications'
  { -- | Configuration ID of an application to be deleted.
    DeleteApplications -> [Text]
configurationIds :: [Prelude.Text]
  }
  deriving (DeleteApplications -> DeleteApplications -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteApplications -> DeleteApplications -> Bool
$c/= :: DeleteApplications -> DeleteApplications -> Bool
== :: DeleteApplications -> DeleteApplications -> Bool
$c== :: DeleteApplications -> DeleteApplications -> Bool
Prelude.Eq, ReadPrec [DeleteApplications]
ReadPrec DeleteApplications
Int -> ReadS DeleteApplications
ReadS [DeleteApplications]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteApplications]
$creadListPrec :: ReadPrec [DeleteApplications]
readPrec :: ReadPrec DeleteApplications
$creadPrec :: ReadPrec DeleteApplications
readList :: ReadS [DeleteApplications]
$creadList :: ReadS [DeleteApplications]
readsPrec :: Int -> ReadS DeleteApplications
$creadsPrec :: Int -> ReadS DeleteApplications
Prelude.Read, Int -> DeleteApplications -> ShowS
[DeleteApplications] -> ShowS
DeleteApplications -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteApplications] -> ShowS
$cshowList :: [DeleteApplications] -> ShowS
show :: DeleteApplications -> String
$cshow :: DeleteApplications -> String
showsPrec :: Int -> DeleteApplications -> ShowS
$cshowsPrec :: Int -> DeleteApplications -> ShowS
Prelude.Show, forall x. Rep DeleteApplications x -> DeleteApplications
forall x. DeleteApplications -> Rep DeleteApplications x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteApplications x -> DeleteApplications
$cfrom :: forall x. DeleteApplications -> Rep DeleteApplications x
Prelude.Generic)

-- |
-- Create a value of 'DeleteApplications' 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:
--
-- 'configurationIds', 'deleteApplications_configurationIds' - Configuration ID of an application to be deleted.
newDeleteApplications ::
  DeleteApplications
newDeleteApplications :: DeleteApplications
newDeleteApplications =
  DeleteApplications'
    { $sel:configurationIds:DeleteApplications' :: [Text]
configurationIds =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | Configuration ID of an application to be deleted.
deleteApplications_configurationIds :: Lens.Lens' DeleteApplications [Prelude.Text]
deleteApplications_configurationIds :: Lens' DeleteApplications [Text]
deleteApplications_configurationIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteApplications' {[Text]
configurationIds :: [Text]
$sel:configurationIds:DeleteApplications' :: DeleteApplications -> [Text]
configurationIds} -> [Text]
configurationIds) (\s :: DeleteApplications
s@DeleteApplications' {} [Text]
a -> DeleteApplications
s {$sel:configurationIds:DeleteApplications' :: [Text]
configurationIds = [Text]
a} :: DeleteApplications) 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 DeleteApplications where
  type
    AWSResponse DeleteApplications =
      DeleteApplicationsResponse
  request :: (Service -> Service)
-> DeleteApplications -> Request DeleteApplications
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 DeleteApplications
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DeleteApplications)))
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 -> DeleteApplicationsResponse
DeleteApplicationsResponse'
            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 DeleteApplications where
  hashWithSalt :: Int -> DeleteApplications -> Int
hashWithSalt Int
_salt DeleteApplications' {[Text]
configurationIds :: [Text]
$sel:configurationIds:DeleteApplications' :: DeleteApplications -> [Text]
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
configurationIds

instance Prelude.NFData DeleteApplications where
  rnf :: DeleteApplications -> ()
rnf DeleteApplications' {[Text]
configurationIds :: [Text]
$sel:configurationIds:DeleteApplications' :: DeleteApplications -> [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf [Text]
configurationIds

instance Data.ToHeaders DeleteApplications where
  toHeaders :: DeleteApplications -> 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
"AWSPoseidonService_V2015_11_01.DeleteApplications" ::
                          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 DeleteApplications where
  toJSON :: DeleteApplications -> Value
toJSON DeleteApplications' {[Text]
configurationIds :: [Text]
$sel:configurationIds:DeleteApplications' :: DeleteApplications -> [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"configurationIds" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Text]
configurationIds)
          ]
      )

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

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

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

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

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

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