{-# 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.AppSync.DeleteDataSource
-- 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 @DataSource@ object.
module Amazonka.AppSync.DeleteDataSource
  ( -- * Creating a Request
    DeleteDataSource (..),
    newDeleteDataSource,

    -- * Request Lenses
    deleteDataSource_apiId,
    deleteDataSource_name,

    -- * Destructuring the Response
    DeleteDataSourceResponse (..),
    newDeleteDataSourceResponse,

    -- * Response Lenses
    deleteDataSourceResponse_httpStatus,
  )
where

import Amazonka.AppSync.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

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

-- |
-- Create a value of 'DeleteDataSource' 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:
--
-- 'apiId', 'deleteDataSource_apiId' - The API ID.
--
-- 'name', 'deleteDataSource_name' - The name of the data source.
newDeleteDataSource ::
  -- | 'apiId'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  DeleteDataSource
newDeleteDataSource :: Text -> Text -> DeleteDataSource
newDeleteDataSource Text
pApiId_ Text
pName_ =
  DeleteDataSource' {$sel:apiId:DeleteDataSource' :: Text
apiId = Text
pApiId_, $sel:name:DeleteDataSource' :: Text
name = Text
pName_}

-- | The API ID.
deleteDataSource_apiId :: Lens.Lens' DeleteDataSource Prelude.Text
deleteDataSource_apiId :: Lens' DeleteDataSource Text
deleteDataSource_apiId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDataSource' {Text
apiId :: Text
$sel:apiId:DeleteDataSource' :: DeleteDataSource -> Text
apiId} -> Text
apiId) (\s :: DeleteDataSource
s@DeleteDataSource' {} Text
a -> DeleteDataSource
s {$sel:apiId:DeleteDataSource' :: Text
apiId = Text
a} :: DeleteDataSource)

-- | The name of the data source.
deleteDataSource_name :: Lens.Lens' DeleteDataSource Prelude.Text
deleteDataSource_name :: Lens' DeleteDataSource Text
deleteDataSource_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteDataSource' {Text
name :: Text
$sel:name:DeleteDataSource' :: DeleteDataSource -> Text
name} -> Text
name) (\s :: DeleteDataSource
s@DeleteDataSource' {} Text
a -> DeleteDataSource
s {$sel:name:DeleteDataSource' :: Text
name = Text
a} :: DeleteDataSource)

instance Core.AWSRequest DeleteDataSource where
  type
    AWSResponse DeleteDataSource =
      DeleteDataSourceResponse
  request :: (Service -> Service)
-> DeleteDataSource -> Request DeleteDataSource
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 DeleteDataSource
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteDataSource)))
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 -> DeleteDataSourceResponse
DeleteDataSourceResponse'
            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 DeleteDataSource where
  hashWithSalt :: Int -> DeleteDataSource -> Int
hashWithSalt Int
_salt DeleteDataSource' {Text
name :: Text
apiId :: Text
$sel:name:DeleteDataSource' :: DeleteDataSource -> Text
$sel:apiId:DeleteDataSource' :: DeleteDataSource -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
apiId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData DeleteDataSource where
  rnf :: DeleteDataSource -> ()
rnf DeleteDataSource' {Text
name :: Text
apiId :: Text
$sel:name:DeleteDataSource' :: DeleteDataSource -> Text
$sel:apiId:DeleteDataSource' :: DeleteDataSource -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
apiId seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders DeleteDataSource where
  toHeaders :: DeleteDataSource -> 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 DeleteDataSource where
  toPath :: DeleteDataSource -> ByteString
toPath DeleteDataSource' {Text
name :: Text
apiId :: Text
$sel:name:DeleteDataSource' :: DeleteDataSource -> Text
$sel:apiId:DeleteDataSource' :: DeleteDataSource -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/apis/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
apiId,
        ByteString
"/datasources/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
name
      ]

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

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

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

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

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