{-# 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.Detective.DeleteGraph
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Disables the specified behavior graph and queues it to be deleted. This
-- operation removes the behavior graph from each member account\'s list of
-- behavior graphs.
--
-- @DeleteGraph@ can only be called by the administrator account for a
-- behavior graph.
module Amazonka.Detective.DeleteGraph
  ( -- * Creating a Request
    DeleteGraph (..),
    newDeleteGraph,

    -- * Request Lenses
    deleteGraph_graphArn,

    -- * Destructuring the Response
    DeleteGraphResponse (..),
    newDeleteGraphResponse,
  )
where

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

-- | /See:/ 'newDeleteGraph' smart constructor.
data DeleteGraph = DeleteGraph'
  { -- | The ARN of the behavior graph to disable.
    DeleteGraph -> Text
graphArn :: Prelude.Text
  }
  deriving (DeleteGraph -> DeleteGraph -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteGraph -> DeleteGraph -> Bool
$c/= :: DeleteGraph -> DeleteGraph -> Bool
== :: DeleteGraph -> DeleteGraph -> Bool
$c== :: DeleteGraph -> DeleteGraph -> Bool
Prelude.Eq, ReadPrec [DeleteGraph]
ReadPrec DeleteGraph
Int -> ReadS DeleteGraph
ReadS [DeleteGraph]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteGraph]
$creadListPrec :: ReadPrec [DeleteGraph]
readPrec :: ReadPrec DeleteGraph
$creadPrec :: ReadPrec DeleteGraph
readList :: ReadS [DeleteGraph]
$creadList :: ReadS [DeleteGraph]
readsPrec :: Int -> ReadS DeleteGraph
$creadsPrec :: Int -> ReadS DeleteGraph
Prelude.Read, Int -> DeleteGraph -> ShowS
[DeleteGraph] -> ShowS
DeleteGraph -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteGraph] -> ShowS
$cshowList :: [DeleteGraph] -> ShowS
show :: DeleteGraph -> String
$cshow :: DeleteGraph -> String
showsPrec :: Int -> DeleteGraph -> ShowS
$cshowsPrec :: Int -> DeleteGraph -> ShowS
Prelude.Show, forall x. Rep DeleteGraph x -> DeleteGraph
forall x. DeleteGraph -> Rep DeleteGraph x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DeleteGraph x -> DeleteGraph
$cfrom :: forall x. DeleteGraph -> Rep DeleteGraph x
Prelude.Generic)

-- |
-- Create a value of 'DeleteGraph' 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:
--
-- 'graphArn', 'deleteGraph_graphArn' - The ARN of the behavior graph to disable.
newDeleteGraph ::
  -- | 'graphArn'
  Prelude.Text ->
  DeleteGraph
newDeleteGraph :: Text -> DeleteGraph
newDeleteGraph Text
pGraphArn_ =
  DeleteGraph' {$sel:graphArn:DeleteGraph' :: Text
graphArn = Text
pGraphArn_}

-- | The ARN of the behavior graph to disable.
deleteGraph_graphArn :: Lens.Lens' DeleteGraph Prelude.Text
deleteGraph_graphArn :: Lens' DeleteGraph Text
deleteGraph_graphArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteGraph' {Text
graphArn :: Text
$sel:graphArn:DeleteGraph' :: DeleteGraph -> Text
graphArn} -> Text
graphArn) (\s :: DeleteGraph
s@DeleteGraph' {} Text
a -> DeleteGraph
s {$sel:graphArn:DeleteGraph' :: Text
graphArn = Text
a} :: DeleteGraph)

instance Core.AWSRequest DeleteGraph where
  type AWSResponse DeleteGraph = DeleteGraphResponse
  request :: (Service -> Service) -> DeleteGraph -> Request DeleteGraph
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteGraph
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteGraph)))
response = forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull DeleteGraphResponse
DeleteGraphResponse'

instance Prelude.Hashable DeleteGraph where
  hashWithSalt :: Int -> DeleteGraph -> Int
hashWithSalt Int
_salt DeleteGraph' {Text
graphArn :: Text
$sel:graphArn:DeleteGraph' :: DeleteGraph -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
graphArn

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

instance Data.ToHeaders DeleteGraph where
  toHeaders :: DeleteGraph -> [Header]
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 -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DeleteGraph where
  toJSON :: DeleteGraph -> Value
toJSON DeleteGraph' {Text
graphArn :: Text
$sel:graphArn:DeleteGraph' :: DeleteGraph -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"GraphArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
graphArn)]
      )

instance Data.ToPath DeleteGraph where
  toPath :: DeleteGraph -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/graph/removal"

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

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

-- |
-- Create a value of 'DeleteGraphResponse' 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.
newDeleteGraphResponse ::
  DeleteGraphResponse
newDeleteGraphResponse :: DeleteGraphResponse
newDeleteGraphResponse = DeleteGraphResponse
DeleteGraphResponse'

instance Prelude.NFData DeleteGraphResponse where
  rnf :: DeleteGraphResponse -> ()
rnf DeleteGraphResponse
_ = ()