{-# 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.MediaLive.DeleteInputSecurityGroup
-- 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 Input Security Group
module Amazonka.MediaLive.DeleteInputSecurityGroup
  ( -- * Creating a Request
    DeleteInputSecurityGroup (..),
    newDeleteInputSecurityGroup,

    -- * Request Lenses
    deleteInputSecurityGroup_inputSecurityGroupId,

    -- * Destructuring the Response
    DeleteInputSecurityGroupResponse (..),
    newDeleteInputSecurityGroupResponse,

    -- * Response Lenses
    deleteInputSecurityGroupResponse_httpStatus,
  )
where

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

-- | Placeholder documentation for DeleteInputSecurityGroupRequest
--
-- /See:/ 'newDeleteInputSecurityGroup' smart constructor.
data DeleteInputSecurityGroup = DeleteInputSecurityGroup'
  { -- | The Input Security Group to delete
    DeleteInputSecurityGroup -> Text
inputSecurityGroupId :: Prelude.Text
  }
  deriving (DeleteInputSecurityGroup -> DeleteInputSecurityGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteInputSecurityGroup -> DeleteInputSecurityGroup -> Bool
$c/= :: DeleteInputSecurityGroup -> DeleteInputSecurityGroup -> Bool
== :: DeleteInputSecurityGroup -> DeleteInputSecurityGroup -> Bool
$c== :: DeleteInputSecurityGroup -> DeleteInputSecurityGroup -> Bool
Prelude.Eq, ReadPrec [DeleteInputSecurityGroup]
ReadPrec DeleteInputSecurityGroup
Int -> ReadS DeleteInputSecurityGroup
ReadS [DeleteInputSecurityGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteInputSecurityGroup]
$creadListPrec :: ReadPrec [DeleteInputSecurityGroup]
readPrec :: ReadPrec DeleteInputSecurityGroup
$creadPrec :: ReadPrec DeleteInputSecurityGroup
readList :: ReadS [DeleteInputSecurityGroup]
$creadList :: ReadS [DeleteInputSecurityGroup]
readsPrec :: Int -> ReadS DeleteInputSecurityGroup
$creadsPrec :: Int -> ReadS DeleteInputSecurityGroup
Prelude.Read, Int -> DeleteInputSecurityGroup -> ShowS
[DeleteInputSecurityGroup] -> ShowS
DeleteInputSecurityGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteInputSecurityGroup] -> ShowS
$cshowList :: [DeleteInputSecurityGroup] -> ShowS
show :: DeleteInputSecurityGroup -> String
$cshow :: DeleteInputSecurityGroup -> String
showsPrec :: Int -> DeleteInputSecurityGroup -> ShowS
$cshowsPrec :: Int -> DeleteInputSecurityGroup -> ShowS
Prelude.Show, forall x.
Rep DeleteInputSecurityGroup x -> DeleteInputSecurityGroup
forall x.
DeleteInputSecurityGroup -> Rep DeleteInputSecurityGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteInputSecurityGroup x -> DeleteInputSecurityGroup
$cfrom :: forall x.
DeleteInputSecurityGroup -> Rep DeleteInputSecurityGroup x
Prelude.Generic)

-- |
-- Create a value of 'DeleteInputSecurityGroup' 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:
--
-- 'inputSecurityGroupId', 'deleteInputSecurityGroup_inputSecurityGroupId' - The Input Security Group to delete
newDeleteInputSecurityGroup ::
  -- | 'inputSecurityGroupId'
  Prelude.Text ->
  DeleteInputSecurityGroup
newDeleteInputSecurityGroup :: Text -> DeleteInputSecurityGroup
newDeleteInputSecurityGroup Text
pInputSecurityGroupId_ =
  DeleteInputSecurityGroup'
    { $sel:inputSecurityGroupId:DeleteInputSecurityGroup' :: Text
inputSecurityGroupId =
        Text
pInputSecurityGroupId_
    }

-- | The Input Security Group to delete
deleteInputSecurityGroup_inputSecurityGroupId :: Lens.Lens' DeleteInputSecurityGroup Prelude.Text
deleteInputSecurityGroup_inputSecurityGroupId :: Lens' DeleteInputSecurityGroup Text
deleteInputSecurityGroup_inputSecurityGroupId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteInputSecurityGroup' {Text
inputSecurityGroupId :: Text
$sel:inputSecurityGroupId:DeleteInputSecurityGroup' :: DeleteInputSecurityGroup -> Text
inputSecurityGroupId} -> Text
inputSecurityGroupId) (\s :: DeleteInputSecurityGroup
s@DeleteInputSecurityGroup' {} Text
a -> DeleteInputSecurityGroup
s {$sel:inputSecurityGroupId:DeleteInputSecurityGroup' :: Text
inputSecurityGroupId = Text
a} :: DeleteInputSecurityGroup)

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

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

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

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

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

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

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

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