{-# 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.RejectInvitation
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Rejects an invitation to contribute the account data to a behavior
-- graph. This operation must be called by an invited member account that
-- has the @INVITED@ status.
--
-- @RejectInvitation@ cannot be called by an organization account in the
-- organization behavior graph. In the organization behavior graph,
-- organization accounts do not receive an invitation.
module Amazonka.Detective.RejectInvitation
  ( -- * Creating a Request
    RejectInvitation (..),
    newRejectInvitation,

    -- * Request Lenses
    rejectInvitation_graphArn,

    -- * Destructuring the Response
    RejectInvitationResponse (..),
    newRejectInvitationResponse,
  )
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:/ 'newRejectInvitation' smart constructor.
data RejectInvitation = RejectInvitation'
  { -- | The ARN of the behavior graph to reject the invitation to.
    --
    -- The member account\'s current member status in the behavior graph must
    -- be @INVITED@.
    RejectInvitation -> Text
graphArn :: Prelude.Text
  }
  deriving (RejectInvitation -> RejectInvitation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RejectInvitation -> RejectInvitation -> Bool
$c/= :: RejectInvitation -> RejectInvitation -> Bool
== :: RejectInvitation -> RejectInvitation -> Bool
$c== :: RejectInvitation -> RejectInvitation -> Bool
Prelude.Eq, ReadPrec [RejectInvitation]
ReadPrec RejectInvitation
Int -> ReadS RejectInvitation
ReadS [RejectInvitation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RejectInvitation]
$creadListPrec :: ReadPrec [RejectInvitation]
readPrec :: ReadPrec RejectInvitation
$creadPrec :: ReadPrec RejectInvitation
readList :: ReadS [RejectInvitation]
$creadList :: ReadS [RejectInvitation]
readsPrec :: Int -> ReadS RejectInvitation
$creadsPrec :: Int -> ReadS RejectInvitation
Prelude.Read, Int -> RejectInvitation -> ShowS
[RejectInvitation] -> ShowS
RejectInvitation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RejectInvitation] -> ShowS
$cshowList :: [RejectInvitation] -> ShowS
show :: RejectInvitation -> String
$cshow :: RejectInvitation -> String
showsPrec :: Int -> RejectInvitation -> ShowS
$cshowsPrec :: Int -> RejectInvitation -> ShowS
Prelude.Show, forall x. Rep RejectInvitation x -> RejectInvitation
forall x. RejectInvitation -> Rep RejectInvitation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RejectInvitation x -> RejectInvitation
$cfrom :: forall x. RejectInvitation -> Rep RejectInvitation x
Prelude.Generic)

-- |
-- Create a value of 'RejectInvitation' 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', 'rejectInvitation_graphArn' - The ARN of the behavior graph to reject the invitation to.
--
-- The member account\'s current member status in the behavior graph must
-- be @INVITED@.
newRejectInvitation ::
  -- | 'graphArn'
  Prelude.Text ->
  RejectInvitation
newRejectInvitation :: Text -> RejectInvitation
newRejectInvitation Text
pGraphArn_ =
  RejectInvitation' {$sel:graphArn:RejectInvitation' :: Text
graphArn = Text
pGraphArn_}

-- | The ARN of the behavior graph to reject the invitation to.
--
-- The member account\'s current member status in the behavior graph must
-- be @INVITED@.
rejectInvitation_graphArn :: Lens.Lens' RejectInvitation Prelude.Text
rejectInvitation_graphArn :: Lens' RejectInvitation Text
rejectInvitation_graphArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RejectInvitation' {Text
graphArn :: Text
$sel:graphArn:RejectInvitation' :: RejectInvitation -> Text
graphArn} -> Text
graphArn) (\s :: RejectInvitation
s@RejectInvitation' {} Text
a -> RejectInvitation
s {$sel:graphArn:RejectInvitation' :: Text
graphArn = Text
a} :: RejectInvitation)

instance Core.AWSRequest RejectInvitation where
  type
    AWSResponse RejectInvitation =
      RejectInvitationResponse
  request :: (Service -> Service)
-> RejectInvitation -> Request RejectInvitation
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 RejectInvitation
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RejectInvitation)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull RejectInvitationResponse
RejectInvitationResponse'

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

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

instance Data.ToHeaders RejectInvitation where
  toHeaders :: RejectInvitation -> [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 RejectInvitation where
  toJSON :: RejectInvitation -> Value
toJSON RejectInvitation' {Text
graphArn :: Text
$sel:graphArn:RejectInvitation' :: RejectInvitation -> 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 RejectInvitation where
  toPath :: RejectInvitation -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/invitation/removal"

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

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

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

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