{-# 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.MediaPackageVOD.DeletePackagingGroup
-- 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 MediaPackage VOD PackagingGroup resource.
module Amazonka.MediaPackageVOD.DeletePackagingGroup
  ( -- * Creating a Request
    DeletePackagingGroup (..),
    newDeletePackagingGroup,

    -- * Request Lenses
    deletePackagingGroup_id,

    -- * Destructuring the Response
    DeletePackagingGroupResponse (..),
    newDeletePackagingGroupResponse,

    -- * Response Lenses
    deletePackagingGroupResponse_httpStatus,
  )
where

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

-- | /See:/ 'newDeletePackagingGroup' smart constructor.
data DeletePackagingGroup = DeletePackagingGroup'
  { -- | The ID of the MediaPackage VOD PackagingGroup resource to delete.
    DeletePackagingGroup -> Text
id :: Prelude.Text
  }
  deriving (DeletePackagingGroup -> DeletePackagingGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeletePackagingGroup -> DeletePackagingGroup -> Bool
$c/= :: DeletePackagingGroup -> DeletePackagingGroup -> Bool
== :: DeletePackagingGroup -> DeletePackagingGroup -> Bool
$c== :: DeletePackagingGroup -> DeletePackagingGroup -> Bool
Prelude.Eq, ReadPrec [DeletePackagingGroup]
ReadPrec DeletePackagingGroup
Int -> ReadS DeletePackagingGroup
ReadS [DeletePackagingGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeletePackagingGroup]
$creadListPrec :: ReadPrec [DeletePackagingGroup]
readPrec :: ReadPrec DeletePackagingGroup
$creadPrec :: ReadPrec DeletePackagingGroup
readList :: ReadS [DeletePackagingGroup]
$creadList :: ReadS [DeletePackagingGroup]
readsPrec :: Int -> ReadS DeletePackagingGroup
$creadsPrec :: Int -> ReadS DeletePackagingGroup
Prelude.Read, Int -> DeletePackagingGroup -> ShowS
[DeletePackagingGroup] -> ShowS
DeletePackagingGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeletePackagingGroup] -> ShowS
$cshowList :: [DeletePackagingGroup] -> ShowS
show :: DeletePackagingGroup -> String
$cshow :: DeletePackagingGroup -> String
showsPrec :: Int -> DeletePackagingGroup -> ShowS
$cshowsPrec :: Int -> DeletePackagingGroup -> ShowS
Prelude.Show, forall x. Rep DeletePackagingGroup x -> DeletePackagingGroup
forall x. DeletePackagingGroup -> Rep DeletePackagingGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeletePackagingGroup x -> DeletePackagingGroup
$cfrom :: forall x. DeletePackagingGroup -> Rep DeletePackagingGroup x
Prelude.Generic)

-- |
-- Create a value of 'DeletePackagingGroup' 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:
--
-- 'id', 'deletePackagingGroup_id' - The ID of the MediaPackage VOD PackagingGroup resource to delete.
newDeletePackagingGroup ::
  -- | 'id'
  Prelude.Text ->
  DeletePackagingGroup
newDeletePackagingGroup :: Text -> DeletePackagingGroup
newDeletePackagingGroup Text
pId_ =
  DeletePackagingGroup' {$sel:id:DeletePackagingGroup' :: Text
id = Text
pId_}

-- | The ID of the MediaPackage VOD PackagingGroup resource to delete.
deletePackagingGroup_id :: Lens.Lens' DeletePackagingGroup Prelude.Text
deletePackagingGroup_id :: Lens' DeletePackagingGroup Text
deletePackagingGroup_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeletePackagingGroup' {Text
id :: Text
$sel:id:DeletePackagingGroup' :: DeletePackagingGroup -> Text
id} -> Text
id) (\s :: DeletePackagingGroup
s@DeletePackagingGroup' {} Text
a -> DeletePackagingGroup
s {$sel:id:DeletePackagingGroup' :: Text
id = Text
a} :: DeletePackagingGroup)

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

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

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

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

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

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

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

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