{-# 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.AmplifyBackend.RemoveBackendConfig
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Removes the AWS resources required to access the Amplify Admin UI.
module Amazonka.AmplifyBackend.RemoveBackendConfig
  ( -- * Creating a Request
    RemoveBackendConfig (..),
    newRemoveBackendConfig,

    -- * Request Lenses
    removeBackendConfig_appId,

    -- * Destructuring the Response
    RemoveBackendConfigResponse (..),
    newRemoveBackendConfigResponse,

    -- * Response Lenses
    removeBackendConfigResponse_error,
    removeBackendConfigResponse_httpStatus,
  )
where

import Amazonka.AmplifyBackend.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:/ 'newRemoveBackendConfig' smart constructor.
data RemoveBackendConfig = RemoveBackendConfig'
  { -- | The app ID.
    RemoveBackendConfig -> Text
appId :: Prelude.Text
  }
  deriving (RemoveBackendConfig -> RemoveBackendConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RemoveBackendConfig -> RemoveBackendConfig -> Bool
$c/= :: RemoveBackendConfig -> RemoveBackendConfig -> Bool
== :: RemoveBackendConfig -> RemoveBackendConfig -> Bool
$c== :: RemoveBackendConfig -> RemoveBackendConfig -> Bool
Prelude.Eq, ReadPrec [RemoveBackendConfig]
ReadPrec RemoveBackendConfig
Int -> ReadS RemoveBackendConfig
ReadS [RemoveBackendConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RemoveBackendConfig]
$creadListPrec :: ReadPrec [RemoveBackendConfig]
readPrec :: ReadPrec RemoveBackendConfig
$creadPrec :: ReadPrec RemoveBackendConfig
readList :: ReadS [RemoveBackendConfig]
$creadList :: ReadS [RemoveBackendConfig]
readsPrec :: Int -> ReadS RemoveBackendConfig
$creadsPrec :: Int -> ReadS RemoveBackendConfig
Prelude.Read, Int -> RemoveBackendConfig -> ShowS
[RemoveBackendConfig] -> ShowS
RemoveBackendConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RemoveBackendConfig] -> ShowS
$cshowList :: [RemoveBackendConfig] -> ShowS
show :: RemoveBackendConfig -> String
$cshow :: RemoveBackendConfig -> String
showsPrec :: Int -> RemoveBackendConfig -> ShowS
$cshowsPrec :: Int -> RemoveBackendConfig -> ShowS
Prelude.Show, forall x. Rep RemoveBackendConfig x -> RemoveBackendConfig
forall x. RemoveBackendConfig -> Rep RemoveBackendConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RemoveBackendConfig x -> RemoveBackendConfig
$cfrom :: forall x. RemoveBackendConfig -> Rep RemoveBackendConfig x
Prelude.Generic)

-- |
-- Create a value of 'RemoveBackendConfig' 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:
--
-- 'appId', 'removeBackendConfig_appId' - The app ID.
newRemoveBackendConfig ::
  -- | 'appId'
  Prelude.Text ->
  RemoveBackendConfig
newRemoveBackendConfig :: Text -> RemoveBackendConfig
newRemoveBackendConfig Text
pAppId_ =
  RemoveBackendConfig' {$sel:appId:RemoveBackendConfig' :: Text
appId = Text
pAppId_}

-- | The app ID.
removeBackendConfig_appId :: Lens.Lens' RemoveBackendConfig Prelude.Text
removeBackendConfig_appId :: Lens' RemoveBackendConfig Text
removeBackendConfig_appId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveBackendConfig' {Text
appId :: Text
$sel:appId:RemoveBackendConfig' :: RemoveBackendConfig -> Text
appId} -> Text
appId) (\s :: RemoveBackendConfig
s@RemoveBackendConfig' {} Text
a -> RemoveBackendConfig
s {$sel:appId:RemoveBackendConfig' :: Text
appId = Text
a} :: RemoveBackendConfig)

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

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

instance Data.ToHeaders RemoveBackendConfig where
  toHeaders :: RemoveBackendConfig -> 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.ToJSON RemoveBackendConfig where
  toJSON :: RemoveBackendConfig -> Value
toJSON = forall a b. a -> b -> a
Prelude.const (Object -> Value
Data.Object forall a. Monoid a => a
Prelude.mempty)

instance Data.ToPath RemoveBackendConfig where
  toPath :: RemoveBackendConfig -> ByteString
toPath RemoveBackendConfig' {Text
appId :: Text
$sel:appId:RemoveBackendConfig' :: RemoveBackendConfig -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/backend/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
appId, ByteString
"/config/remove"]

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

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

-- |
-- Create a value of 'RemoveBackendConfigResponse' 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:
--
-- 'error', 'removeBackendConfigResponse_error' - If the request fails, this error is returned.
--
-- 'httpStatus', 'removeBackendConfigResponse_httpStatus' - The response's http status code.
newRemoveBackendConfigResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RemoveBackendConfigResponse
newRemoveBackendConfigResponse :: Int -> RemoveBackendConfigResponse
newRemoveBackendConfigResponse Int
pHttpStatus_ =
  RemoveBackendConfigResponse'
    { $sel:error:RemoveBackendConfigResponse' :: Maybe Text
error =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RemoveBackendConfigResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | If the request fails, this error is returned.
removeBackendConfigResponse_error :: Lens.Lens' RemoveBackendConfigResponse (Prelude.Maybe Prelude.Text)
removeBackendConfigResponse_error :: Lens' RemoveBackendConfigResponse (Maybe Text)
removeBackendConfigResponse_error = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RemoveBackendConfigResponse' {Maybe Text
error :: Maybe Text
$sel:error:RemoveBackendConfigResponse' :: RemoveBackendConfigResponse -> Maybe Text
error} -> Maybe Text
error) (\s :: RemoveBackendConfigResponse
s@RemoveBackendConfigResponse' {} Maybe Text
a -> RemoveBackendConfigResponse
s {$sel:error:RemoveBackendConfigResponse' :: Maybe Text
error = Maybe Text
a} :: RemoveBackendConfigResponse)

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

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