{-# 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.APIGateway.DeleteRestApi
-- 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 API.
module Amazonka.APIGateway.DeleteRestApi
  ( -- * Creating a Request
    DeleteRestApi (..),
    newDeleteRestApi,

    -- * Request Lenses
    deleteRestApi_restApiId,

    -- * Destructuring the Response
    DeleteRestApiResponse (..),
    newDeleteRestApiResponse,
  )
where

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

-- | Request to delete the specified API from your collection.
--
-- /See:/ 'newDeleteRestApi' smart constructor.
data DeleteRestApi = DeleteRestApi'
  { -- | The string identifier of the associated RestApi.
    DeleteRestApi -> Text
restApiId :: Prelude.Text
  }
  deriving (DeleteRestApi -> DeleteRestApi -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteRestApi -> DeleteRestApi -> Bool
$c/= :: DeleteRestApi -> DeleteRestApi -> Bool
== :: DeleteRestApi -> DeleteRestApi -> Bool
$c== :: DeleteRestApi -> DeleteRestApi -> Bool
Prelude.Eq, ReadPrec [DeleteRestApi]
ReadPrec DeleteRestApi
Int -> ReadS DeleteRestApi
ReadS [DeleteRestApi]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteRestApi]
$creadListPrec :: ReadPrec [DeleteRestApi]
readPrec :: ReadPrec DeleteRestApi
$creadPrec :: ReadPrec DeleteRestApi
readList :: ReadS [DeleteRestApi]
$creadList :: ReadS [DeleteRestApi]
readsPrec :: Int -> ReadS DeleteRestApi
$creadsPrec :: Int -> ReadS DeleteRestApi
Prelude.Read, Int -> DeleteRestApi -> ShowS
[DeleteRestApi] -> ShowS
DeleteRestApi -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteRestApi] -> ShowS
$cshowList :: [DeleteRestApi] -> ShowS
show :: DeleteRestApi -> String
$cshow :: DeleteRestApi -> String
showsPrec :: Int -> DeleteRestApi -> ShowS
$cshowsPrec :: Int -> DeleteRestApi -> ShowS
Prelude.Show, forall x. Rep DeleteRestApi x -> DeleteRestApi
forall x. DeleteRestApi -> Rep DeleteRestApi x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteRestApi x -> DeleteRestApi
$cfrom :: forall x. DeleteRestApi -> Rep DeleteRestApi x
Prelude.Generic)

-- |
-- Create a value of 'DeleteRestApi' 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:
--
-- 'restApiId', 'deleteRestApi_restApiId' - The string identifier of the associated RestApi.
newDeleteRestApi ::
  -- | 'restApiId'
  Prelude.Text ->
  DeleteRestApi
newDeleteRestApi :: Text -> DeleteRestApi
newDeleteRestApi Text
pRestApiId_ =
  DeleteRestApi' {$sel:restApiId:DeleteRestApi' :: Text
restApiId = Text
pRestApiId_}

-- | The string identifier of the associated RestApi.
deleteRestApi_restApiId :: Lens.Lens' DeleteRestApi Prelude.Text
deleteRestApi_restApiId :: Lens' DeleteRestApi Text
deleteRestApi_restApiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteRestApi' {Text
restApiId :: Text
$sel:restApiId:DeleteRestApi' :: DeleteRestApi -> Text
restApiId} -> Text
restApiId) (\s :: DeleteRestApi
s@DeleteRestApi' {} Text
a -> DeleteRestApi
s {$sel:restApiId:DeleteRestApi' :: Text
restApiId = Text
a} :: DeleteRestApi)

instance Core.AWSRequest DeleteRestApi where
  type
    AWSResponse DeleteRestApi =
      DeleteRestApiResponse
  request :: (Service -> Service) -> DeleteRestApi -> Request DeleteRestApi
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 DeleteRestApi
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteRestApi)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteRestApiResponse
DeleteRestApiResponse'

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

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

instance Data.ToHeaders DeleteRestApi where
  toHeaders :: DeleteRestApi -> [Header]
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Accept"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# (ByteString
"application/json" :: Prelude.ByteString)
          ]
      )

instance Data.ToPath DeleteRestApi where
  toPath :: DeleteRestApi -> ByteString
toPath DeleteRestApi' {Text
restApiId :: Text
$sel:restApiId:DeleteRestApi' :: DeleteRestApi -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/restapis/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
restApiId]

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

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

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

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