{-# 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.ImageBuilder.DeleteInfrastructureConfiguration
-- 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 an infrastructure configuration.
module Amazonka.ImageBuilder.DeleteInfrastructureConfiguration
  ( -- * Creating a Request
    DeleteInfrastructureConfiguration (..),
    newDeleteInfrastructureConfiguration,

    -- * Request Lenses
    deleteInfrastructureConfiguration_infrastructureConfigurationArn,

    -- * Destructuring the Response
    DeleteInfrastructureConfigurationResponse (..),
    newDeleteInfrastructureConfigurationResponse,

    -- * Response Lenses
    deleteInfrastructureConfigurationResponse_infrastructureConfigurationArn,
    deleteInfrastructureConfigurationResponse_requestId,
    deleteInfrastructureConfigurationResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeleteInfrastructureConfiguration' smart constructor.
data DeleteInfrastructureConfiguration = DeleteInfrastructureConfiguration'
  { -- | The Amazon Resource Name (ARN) of the infrastructure configuration to
    -- delete.
    DeleteInfrastructureConfiguration -> Text
infrastructureConfigurationArn :: Prelude.Text
  }
  deriving (DeleteInfrastructureConfiguration
-> DeleteInfrastructureConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteInfrastructureConfiguration
-> DeleteInfrastructureConfiguration -> Bool
$c/= :: DeleteInfrastructureConfiguration
-> DeleteInfrastructureConfiguration -> Bool
== :: DeleteInfrastructureConfiguration
-> DeleteInfrastructureConfiguration -> Bool
$c== :: DeleteInfrastructureConfiguration
-> DeleteInfrastructureConfiguration -> Bool
Prelude.Eq, ReadPrec [DeleteInfrastructureConfiguration]
ReadPrec DeleteInfrastructureConfiguration
Int -> ReadS DeleteInfrastructureConfiguration
ReadS [DeleteInfrastructureConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteInfrastructureConfiguration]
$creadListPrec :: ReadPrec [DeleteInfrastructureConfiguration]
readPrec :: ReadPrec DeleteInfrastructureConfiguration
$creadPrec :: ReadPrec DeleteInfrastructureConfiguration
readList :: ReadS [DeleteInfrastructureConfiguration]
$creadList :: ReadS [DeleteInfrastructureConfiguration]
readsPrec :: Int -> ReadS DeleteInfrastructureConfiguration
$creadsPrec :: Int -> ReadS DeleteInfrastructureConfiguration
Prelude.Read, Int -> DeleteInfrastructureConfiguration -> ShowS
[DeleteInfrastructureConfiguration] -> ShowS
DeleteInfrastructureConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteInfrastructureConfiguration] -> ShowS
$cshowList :: [DeleteInfrastructureConfiguration] -> ShowS
show :: DeleteInfrastructureConfiguration -> String
$cshow :: DeleteInfrastructureConfiguration -> String
showsPrec :: Int -> DeleteInfrastructureConfiguration -> ShowS
$cshowsPrec :: Int -> DeleteInfrastructureConfiguration -> ShowS
Prelude.Show, forall x.
Rep DeleteInfrastructureConfiguration x
-> DeleteInfrastructureConfiguration
forall x.
DeleteInfrastructureConfiguration
-> Rep DeleteInfrastructureConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteInfrastructureConfiguration x
-> DeleteInfrastructureConfiguration
$cfrom :: forall x.
DeleteInfrastructureConfiguration
-> Rep DeleteInfrastructureConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'DeleteInfrastructureConfiguration' 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:
--
-- 'infrastructureConfigurationArn', 'deleteInfrastructureConfiguration_infrastructureConfigurationArn' - The Amazon Resource Name (ARN) of the infrastructure configuration to
-- delete.
newDeleteInfrastructureConfiguration ::
  -- | 'infrastructureConfigurationArn'
  Prelude.Text ->
  DeleteInfrastructureConfiguration
newDeleteInfrastructureConfiguration :: Text -> DeleteInfrastructureConfiguration
newDeleteInfrastructureConfiguration
  Text
pInfrastructureConfigurationArn_ =
    DeleteInfrastructureConfiguration'
      { $sel:infrastructureConfigurationArn:DeleteInfrastructureConfiguration' :: Text
infrastructureConfigurationArn =
          Text
pInfrastructureConfigurationArn_
      }

-- | The Amazon Resource Name (ARN) of the infrastructure configuration to
-- delete.
deleteInfrastructureConfiguration_infrastructureConfigurationArn :: Lens.Lens' DeleteInfrastructureConfiguration Prelude.Text
deleteInfrastructureConfiguration_infrastructureConfigurationArn :: Lens' DeleteInfrastructureConfiguration Text
deleteInfrastructureConfiguration_infrastructureConfigurationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteInfrastructureConfiguration' {Text
infrastructureConfigurationArn :: Text
$sel:infrastructureConfigurationArn:DeleteInfrastructureConfiguration' :: DeleteInfrastructureConfiguration -> Text
infrastructureConfigurationArn} -> Text
infrastructureConfigurationArn) (\s :: DeleteInfrastructureConfiguration
s@DeleteInfrastructureConfiguration' {} Text
a -> DeleteInfrastructureConfiguration
s {$sel:infrastructureConfigurationArn:DeleteInfrastructureConfiguration' :: Text
infrastructureConfigurationArn = Text
a} :: DeleteInfrastructureConfiguration)

instance
  Core.AWSRequest
    DeleteInfrastructureConfiguration
  where
  type
    AWSResponse DeleteInfrastructureConfiguration =
      DeleteInfrastructureConfigurationResponse
  request :: (Service -> Service)
-> DeleteInfrastructureConfiguration
-> Request DeleteInfrastructureConfiguration
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 DeleteInfrastructureConfiguration
-> ClientResponse ClientBody
-> m (Either
        Error
        (ClientResponse (AWSResponse DeleteInfrastructureConfiguration)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe Text -> Int -> DeleteInfrastructureConfigurationResponse
DeleteInfrastructureConfigurationResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"infrastructureConfigurationArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"requestId")
            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
    DeleteInfrastructureConfiguration
  where
  hashWithSalt :: Int -> DeleteInfrastructureConfiguration -> Int
hashWithSalt
    Int
_salt
    DeleteInfrastructureConfiguration' {Text
infrastructureConfigurationArn :: Text
$sel:infrastructureConfigurationArn:DeleteInfrastructureConfiguration' :: DeleteInfrastructureConfiguration -> Text
..} =
      Int
_salt
        forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
infrastructureConfigurationArn

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

instance
  Data.ToHeaders
    DeleteInfrastructureConfiguration
  where
  toHeaders :: DeleteInfrastructureConfiguration -> ResponseHeaders
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 -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

instance
  Data.ToQuery
    DeleteInfrastructureConfiguration
  where
  toQuery :: DeleteInfrastructureConfiguration -> QueryString
toQuery DeleteInfrastructureConfiguration' {Text
infrastructureConfigurationArn :: Text
$sel:infrastructureConfigurationArn:DeleteInfrastructureConfiguration' :: DeleteInfrastructureConfiguration -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"infrastructureConfigurationArn"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
infrastructureConfigurationArn
      ]

-- | /See:/ 'newDeleteInfrastructureConfigurationResponse' smart constructor.
data DeleteInfrastructureConfigurationResponse = DeleteInfrastructureConfigurationResponse'
  { -- | The Amazon Resource Name (ARN) of the infrastructure configuration that
    -- was deleted.
    DeleteInfrastructureConfigurationResponse -> Maybe Text
infrastructureConfigurationArn :: Prelude.Maybe Prelude.Text,
    -- | The request ID that uniquely identifies this request.
    DeleteInfrastructureConfigurationResponse -> Maybe Text
requestId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DeleteInfrastructureConfigurationResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteInfrastructureConfigurationResponse
-> DeleteInfrastructureConfigurationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteInfrastructureConfigurationResponse
-> DeleteInfrastructureConfigurationResponse -> Bool
$c/= :: DeleteInfrastructureConfigurationResponse
-> DeleteInfrastructureConfigurationResponse -> Bool
== :: DeleteInfrastructureConfigurationResponse
-> DeleteInfrastructureConfigurationResponse -> Bool
$c== :: DeleteInfrastructureConfigurationResponse
-> DeleteInfrastructureConfigurationResponse -> Bool
Prelude.Eq, ReadPrec [DeleteInfrastructureConfigurationResponse]
ReadPrec DeleteInfrastructureConfigurationResponse
Int -> ReadS DeleteInfrastructureConfigurationResponse
ReadS [DeleteInfrastructureConfigurationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteInfrastructureConfigurationResponse]
$creadListPrec :: ReadPrec [DeleteInfrastructureConfigurationResponse]
readPrec :: ReadPrec DeleteInfrastructureConfigurationResponse
$creadPrec :: ReadPrec DeleteInfrastructureConfigurationResponse
readList :: ReadS [DeleteInfrastructureConfigurationResponse]
$creadList :: ReadS [DeleteInfrastructureConfigurationResponse]
readsPrec :: Int -> ReadS DeleteInfrastructureConfigurationResponse
$creadsPrec :: Int -> ReadS DeleteInfrastructureConfigurationResponse
Prelude.Read, Int -> DeleteInfrastructureConfigurationResponse -> ShowS
[DeleteInfrastructureConfigurationResponse] -> ShowS
DeleteInfrastructureConfigurationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteInfrastructureConfigurationResponse] -> ShowS
$cshowList :: [DeleteInfrastructureConfigurationResponse] -> ShowS
show :: DeleteInfrastructureConfigurationResponse -> String
$cshow :: DeleteInfrastructureConfigurationResponse -> String
showsPrec :: Int -> DeleteInfrastructureConfigurationResponse -> ShowS
$cshowsPrec :: Int -> DeleteInfrastructureConfigurationResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteInfrastructureConfigurationResponse x
-> DeleteInfrastructureConfigurationResponse
forall x.
DeleteInfrastructureConfigurationResponse
-> Rep DeleteInfrastructureConfigurationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteInfrastructureConfigurationResponse x
-> DeleteInfrastructureConfigurationResponse
$cfrom :: forall x.
DeleteInfrastructureConfigurationResponse
-> Rep DeleteInfrastructureConfigurationResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteInfrastructureConfigurationResponse' 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:
--
-- 'infrastructureConfigurationArn', 'deleteInfrastructureConfigurationResponse_infrastructureConfigurationArn' - The Amazon Resource Name (ARN) of the infrastructure configuration that
-- was deleted.
--
-- 'requestId', 'deleteInfrastructureConfigurationResponse_requestId' - The request ID that uniquely identifies this request.
--
-- 'httpStatus', 'deleteInfrastructureConfigurationResponse_httpStatus' - The response's http status code.
newDeleteInfrastructureConfigurationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteInfrastructureConfigurationResponse
newDeleteInfrastructureConfigurationResponse :: Int -> DeleteInfrastructureConfigurationResponse
newDeleteInfrastructureConfigurationResponse
  Int
pHttpStatus_ =
    DeleteInfrastructureConfigurationResponse'
      { $sel:infrastructureConfigurationArn:DeleteInfrastructureConfigurationResponse' :: Maybe Text
infrastructureConfigurationArn =
          forall a. Maybe a
Prelude.Nothing,
        $sel:requestId:DeleteInfrastructureConfigurationResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DeleteInfrastructureConfigurationResponse' :: Int
httpStatus = Int
pHttpStatus_
      }

-- | The Amazon Resource Name (ARN) of the infrastructure configuration that
-- was deleted.
deleteInfrastructureConfigurationResponse_infrastructureConfigurationArn :: Lens.Lens' DeleteInfrastructureConfigurationResponse (Prelude.Maybe Prelude.Text)
deleteInfrastructureConfigurationResponse_infrastructureConfigurationArn :: Lens' DeleteInfrastructureConfigurationResponse (Maybe Text)
deleteInfrastructureConfigurationResponse_infrastructureConfigurationArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteInfrastructureConfigurationResponse' {Maybe Text
infrastructureConfigurationArn :: Maybe Text
$sel:infrastructureConfigurationArn:DeleteInfrastructureConfigurationResponse' :: DeleteInfrastructureConfigurationResponse -> Maybe Text
infrastructureConfigurationArn} -> Maybe Text
infrastructureConfigurationArn) (\s :: DeleteInfrastructureConfigurationResponse
s@DeleteInfrastructureConfigurationResponse' {} Maybe Text
a -> DeleteInfrastructureConfigurationResponse
s {$sel:infrastructureConfigurationArn:DeleteInfrastructureConfigurationResponse' :: Maybe Text
infrastructureConfigurationArn = Maybe Text
a} :: DeleteInfrastructureConfigurationResponse)

-- | The request ID that uniquely identifies this request.
deleteInfrastructureConfigurationResponse_requestId :: Lens.Lens' DeleteInfrastructureConfigurationResponse (Prelude.Maybe Prelude.Text)
deleteInfrastructureConfigurationResponse_requestId :: Lens' DeleteInfrastructureConfigurationResponse (Maybe Text)
deleteInfrastructureConfigurationResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteInfrastructureConfigurationResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:DeleteInfrastructureConfigurationResponse' :: DeleteInfrastructureConfigurationResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: DeleteInfrastructureConfigurationResponse
s@DeleteInfrastructureConfigurationResponse' {} Maybe Text
a -> DeleteInfrastructureConfigurationResponse
s {$sel:requestId:DeleteInfrastructureConfigurationResponse' :: Maybe Text
requestId = Maybe Text
a} :: DeleteInfrastructureConfigurationResponse)

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

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