{-# 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.DeleteMissionProfile
-- 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 mission profile.
module Amazonka.GroundStation.DeleteMissionProfile
  ( -- * Creating a Request
    DeleteMissionProfile (..),
    newDeleteMissionProfile,

    -- * Request Lenses
    deleteMissionProfile_missionProfileId,

    -- * Destructuring the Response
    MissionProfileIdResponse (..),
    newMissionProfileIdResponse,

    -- * Response Lenses
    missionProfileIdResponse_missionProfileId,
  )
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:/ 'newDeleteMissionProfile' smart constructor.
data DeleteMissionProfile = DeleteMissionProfile'
  { -- | UUID of a mission profile.
    DeleteMissionProfile -> Text
missionProfileId :: Prelude.Text
  }
  deriving (DeleteMissionProfile -> DeleteMissionProfile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteMissionProfile -> DeleteMissionProfile -> Bool
$c/= :: DeleteMissionProfile -> DeleteMissionProfile -> Bool
== :: DeleteMissionProfile -> DeleteMissionProfile -> Bool
$c== :: DeleteMissionProfile -> DeleteMissionProfile -> Bool
Prelude.Eq, ReadPrec [DeleteMissionProfile]
ReadPrec DeleteMissionProfile
Int -> ReadS DeleteMissionProfile
ReadS [DeleteMissionProfile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteMissionProfile]
$creadListPrec :: ReadPrec [DeleteMissionProfile]
readPrec :: ReadPrec DeleteMissionProfile
$creadPrec :: ReadPrec DeleteMissionProfile
readList :: ReadS [DeleteMissionProfile]
$creadList :: ReadS [DeleteMissionProfile]
readsPrec :: Int -> ReadS DeleteMissionProfile
$creadsPrec :: Int -> ReadS DeleteMissionProfile
Prelude.Read, Int -> DeleteMissionProfile -> ShowS
[DeleteMissionProfile] -> ShowS
DeleteMissionProfile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteMissionProfile] -> ShowS
$cshowList :: [DeleteMissionProfile] -> ShowS
show :: DeleteMissionProfile -> String
$cshow :: DeleteMissionProfile -> String
showsPrec :: Int -> DeleteMissionProfile -> ShowS
$cshowsPrec :: Int -> DeleteMissionProfile -> ShowS
Prelude.Show, forall x. Rep DeleteMissionProfile x -> DeleteMissionProfile
forall x. DeleteMissionProfile -> Rep DeleteMissionProfile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteMissionProfile x -> DeleteMissionProfile
$cfrom :: forall x. DeleteMissionProfile -> Rep DeleteMissionProfile x
Prelude.Generic)

-- |
-- Create a value of 'DeleteMissionProfile' 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:
--
-- 'missionProfileId', 'deleteMissionProfile_missionProfileId' - UUID of a mission profile.
newDeleteMissionProfile ::
  -- | 'missionProfileId'
  Prelude.Text ->
  DeleteMissionProfile
newDeleteMissionProfile :: Text -> DeleteMissionProfile
newDeleteMissionProfile Text
pMissionProfileId_ =
  DeleteMissionProfile'
    { $sel:missionProfileId:DeleteMissionProfile' :: Text
missionProfileId =
        Text
pMissionProfileId_
    }

-- | UUID of a mission profile.
deleteMissionProfile_missionProfileId :: Lens.Lens' DeleteMissionProfile Prelude.Text
deleteMissionProfile_missionProfileId :: Lens' DeleteMissionProfile Text
deleteMissionProfile_missionProfileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteMissionProfile' {Text
missionProfileId :: Text
$sel:missionProfileId:DeleteMissionProfile' :: DeleteMissionProfile -> Text
missionProfileId} -> Text
missionProfileId) (\s :: DeleteMissionProfile
s@DeleteMissionProfile' {} Text
a -> DeleteMissionProfile
s {$sel:missionProfileId:DeleteMissionProfile' :: Text
missionProfileId = Text
a} :: DeleteMissionProfile)

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

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

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

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