{-# 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.Evidently.DeleteLaunch
-- 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 an Evidently launch. The feature used for the launch is not
-- deleted.
--
-- To stop a launch without deleting it, use
-- <https://docs.aws.amazon.com/cloudwatchevidently/latest/APIReference/API_StopLaunch.html StopLaunch>.
module Amazonka.Evidently.DeleteLaunch
  ( -- * Creating a Request
    DeleteLaunch (..),
    newDeleteLaunch,

    -- * Request Lenses
    deleteLaunch_launch,
    deleteLaunch_project,

    -- * Destructuring the Response
    DeleteLaunchResponse (..),
    newDeleteLaunchResponse,

    -- * Response Lenses
    deleteLaunchResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeleteLaunch' smart constructor.
data DeleteLaunch = DeleteLaunch'
  { -- | The name of the launch to delete.
    DeleteLaunch -> Text
launch :: Prelude.Text,
    -- | The name or ARN of the project that contains the launch to delete.
    DeleteLaunch -> Text
project :: Prelude.Text
  }
  deriving (DeleteLaunch -> DeleteLaunch -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteLaunch -> DeleteLaunch -> Bool
$c/= :: DeleteLaunch -> DeleteLaunch -> Bool
== :: DeleteLaunch -> DeleteLaunch -> Bool
$c== :: DeleteLaunch -> DeleteLaunch -> Bool
Prelude.Eq, ReadPrec [DeleteLaunch]
ReadPrec DeleteLaunch
Int -> ReadS DeleteLaunch
ReadS [DeleteLaunch]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteLaunch]
$creadListPrec :: ReadPrec [DeleteLaunch]
readPrec :: ReadPrec DeleteLaunch
$creadPrec :: ReadPrec DeleteLaunch
readList :: ReadS [DeleteLaunch]
$creadList :: ReadS [DeleteLaunch]
readsPrec :: Int -> ReadS DeleteLaunch
$creadsPrec :: Int -> ReadS DeleteLaunch
Prelude.Read, Int -> DeleteLaunch -> ShowS
[DeleteLaunch] -> ShowS
DeleteLaunch -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteLaunch] -> ShowS
$cshowList :: [DeleteLaunch] -> ShowS
show :: DeleteLaunch -> String
$cshow :: DeleteLaunch -> String
showsPrec :: Int -> DeleteLaunch -> ShowS
$cshowsPrec :: Int -> DeleteLaunch -> ShowS
Prelude.Show, forall x. Rep DeleteLaunch x -> DeleteLaunch
forall x. DeleteLaunch -> Rep DeleteLaunch x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteLaunch x -> DeleteLaunch
$cfrom :: forall x. DeleteLaunch -> Rep DeleteLaunch x
Prelude.Generic)

-- |
-- Create a value of 'DeleteLaunch' 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:
--
-- 'launch', 'deleteLaunch_launch' - The name of the launch to delete.
--
-- 'project', 'deleteLaunch_project' - The name or ARN of the project that contains the launch to delete.
newDeleteLaunch ::
  -- | 'launch'
  Prelude.Text ->
  -- | 'project'
  Prelude.Text ->
  DeleteLaunch
newDeleteLaunch :: Text -> Text -> DeleteLaunch
newDeleteLaunch Text
pLaunch_ Text
pProject_ =
  DeleteLaunch'
    { $sel:launch:DeleteLaunch' :: Text
launch = Text
pLaunch_,
      $sel:project:DeleteLaunch' :: Text
project = Text
pProject_
    }

-- | The name of the launch to delete.
deleteLaunch_launch :: Lens.Lens' DeleteLaunch Prelude.Text
deleteLaunch_launch :: Lens' DeleteLaunch Text
deleteLaunch_launch = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteLaunch' {Text
launch :: Text
$sel:launch:DeleteLaunch' :: DeleteLaunch -> Text
launch} -> Text
launch) (\s :: DeleteLaunch
s@DeleteLaunch' {} Text
a -> DeleteLaunch
s {$sel:launch:DeleteLaunch' :: Text
launch = Text
a} :: DeleteLaunch)

-- | The name or ARN of the project that contains the launch to delete.
deleteLaunch_project :: Lens.Lens' DeleteLaunch Prelude.Text
deleteLaunch_project :: Lens' DeleteLaunch Text
deleteLaunch_project = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteLaunch' {Text
project :: Text
$sel:project:DeleteLaunch' :: DeleteLaunch -> Text
project} -> Text
project) (\s :: DeleteLaunch
s@DeleteLaunch' {} Text
a -> DeleteLaunch
s {$sel:project:DeleteLaunch' :: Text
project = Text
a} :: DeleteLaunch)

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

instance Prelude.NFData DeleteLaunch where
  rnf :: DeleteLaunch -> ()
rnf DeleteLaunch' {Text
project :: Text
launch :: Text
$sel:project:DeleteLaunch' :: DeleteLaunch -> Text
$sel:launch:DeleteLaunch' :: DeleteLaunch -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
launch
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
project

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

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

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

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

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

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