{-# 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.GroundStation.DeleteConfig
-- 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 @Config@.
module Amazonka.GroundStation.DeleteConfig
  ( -- * Creating a Request
    DeleteConfig (..),
    newDeleteConfig,

    -- * Request Lenses
    deleteConfig_configId,
    deleteConfig_configType,

    -- * Destructuring the Response
    ConfigIdResponse (..),
    newConfigIdResponse,

    -- * Response Lenses
    configIdResponse_configArn,
    configIdResponse_configId,
    configIdResponse_configType,
  )
where

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

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

-- |
-- Create a value of 'DeleteConfig' 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:
--
-- 'configId', 'deleteConfig_configId' - UUID of a @Config@.
--
-- 'configType', 'deleteConfig_configType' - Type of a @Config@.
newDeleteConfig ::
  -- | 'configId'
  Prelude.Text ->
  -- | 'configType'
  ConfigCapabilityType ->
  DeleteConfig
newDeleteConfig :: Text -> ConfigCapabilityType -> DeleteConfig
newDeleteConfig Text
pConfigId_ ConfigCapabilityType
pConfigType_ =
  DeleteConfig'
    { $sel:configId:DeleteConfig' :: Text
configId = Text
pConfigId_,
      $sel:configType:DeleteConfig' :: ConfigCapabilityType
configType = ConfigCapabilityType
pConfigType_
    }

-- | UUID of a @Config@.
deleteConfig_configId :: Lens.Lens' DeleteConfig Prelude.Text
deleteConfig_configId :: Lens' DeleteConfig Text
deleteConfig_configId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteConfig' {Text
configId :: Text
$sel:configId:DeleteConfig' :: DeleteConfig -> Text
configId} -> Text
configId) (\s :: DeleteConfig
s@DeleteConfig' {} Text
a -> DeleteConfig
s {$sel:configId:DeleteConfig' :: Text
configId = Text
a} :: DeleteConfig)

-- | Type of a @Config@.
deleteConfig_configType :: Lens.Lens' DeleteConfig ConfigCapabilityType
deleteConfig_configType :: Lens' DeleteConfig ConfigCapabilityType
deleteConfig_configType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteConfig' {ConfigCapabilityType
configType :: ConfigCapabilityType
$sel:configType:DeleteConfig' :: DeleteConfig -> ConfigCapabilityType
configType} -> ConfigCapabilityType
configType) (\s :: DeleteConfig
s@DeleteConfig' {} ConfigCapabilityType
a -> DeleteConfig
s {$sel:configType:DeleteConfig' :: ConfigCapabilityType
configType = ConfigCapabilityType
a} :: DeleteConfig)

instance Core.AWSRequest DeleteConfig where
  type AWSResponse DeleteConfig = ConfigIdResponse
  request :: (Service -> Service) -> DeleteConfig -> Request DeleteConfig
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 DeleteConfig
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteConfig)))
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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable DeleteConfig where
  hashWithSalt :: Int -> DeleteConfig -> Int
hashWithSalt Int
_salt DeleteConfig' {Text
ConfigCapabilityType
configType :: ConfigCapabilityType
configId :: Text
$sel:configType:DeleteConfig' :: DeleteConfig -> ConfigCapabilityType
$sel:configId:DeleteConfig' :: DeleteConfig -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
configId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ConfigCapabilityType
configType

instance Prelude.NFData DeleteConfig where
  rnf :: DeleteConfig -> ()
rnf DeleteConfig' {Text
ConfigCapabilityType
configType :: ConfigCapabilityType
configId :: Text
$sel:configType:DeleteConfig' :: DeleteConfig -> ConfigCapabilityType
$sel:configId:DeleteConfig' :: DeleteConfig -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
configId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ConfigCapabilityType
configType

instance Data.ToHeaders DeleteConfig where
  toHeaders :: DeleteConfig -> 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 DeleteConfig where
  toPath :: DeleteConfig -> ByteString
toPath DeleteConfig' {Text
ConfigCapabilityType
configType :: ConfigCapabilityType
configId :: Text
$sel:configType:DeleteConfig' :: DeleteConfig -> ConfigCapabilityType
$sel:configId:DeleteConfig' :: DeleteConfig -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/config/",
        forall a. ToByteString a => a -> ByteString
Data.toBS ConfigCapabilityType
configType,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
configId
      ]

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