{-# 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.LicenseManager.RejectGrant
-- 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 the specified grant.
module Amazonka.LicenseManager.RejectGrant
  ( -- * Creating a Request
    RejectGrant (..),
    newRejectGrant,

    -- * Request Lenses
    rejectGrant_grantArn,

    -- * Destructuring the Response
    RejectGrantResponse (..),
    newRejectGrantResponse,

    -- * Response Lenses
    rejectGrantResponse_grantArn,
    rejectGrantResponse_status,
    rejectGrantResponse_version,
    rejectGrantResponse_httpStatus,
  )
where

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

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

-- |
-- Create a value of 'RejectGrant' 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:
--
-- 'grantArn', 'rejectGrant_grantArn' - Amazon Resource Name (ARN) of the grant.
newRejectGrant ::
  -- | 'grantArn'
  Prelude.Text ->
  RejectGrant
newRejectGrant :: Text -> RejectGrant
newRejectGrant Text
pGrantArn_ =
  RejectGrant' {$sel:grantArn:RejectGrant' :: Text
grantArn = Text
pGrantArn_}

-- | Amazon Resource Name (ARN) of the grant.
rejectGrant_grantArn :: Lens.Lens' RejectGrant Prelude.Text
rejectGrant_grantArn :: Lens' RejectGrant Text
rejectGrant_grantArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RejectGrant' {Text
grantArn :: Text
$sel:grantArn:RejectGrant' :: RejectGrant -> Text
grantArn} -> Text
grantArn) (\s :: RejectGrant
s@RejectGrant' {} Text
a -> RejectGrant
s {$sel:grantArn:RejectGrant' :: Text
grantArn = Text
a} :: RejectGrant)

instance Core.AWSRequest RejectGrant where
  type AWSResponse RejectGrant = RejectGrantResponse
  request :: (Service -> Service) -> RejectGrant -> Request RejectGrant
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 RejectGrant
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse RejectGrant)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe GrantStatus -> Maybe Text -> Int -> RejectGrantResponse
RejectGrantResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"GrantArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Status")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Version")
            forall (f :: * -> *) a b. Applicative f => 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 RejectGrant where
  hashWithSalt :: Int -> RejectGrant -> Int
hashWithSalt Int
_salt RejectGrant' {Text
grantArn :: Text
$sel:grantArn:RejectGrant' :: RejectGrant -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
grantArn

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

instance Data.ToHeaders RejectGrant where
  toHeaders :: RejectGrant -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"AWSLicenseManager.RejectGrant" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

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

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

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

-- |
-- Create a value of 'RejectGrantResponse' 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:
--
-- 'grantArn', 'rejectGrantResponse_grantArn' - Grant ARN.
--
-- 'status', 'rejectGrantResponse_status' - Grant status.
--
-- 'version', 'rejectGrantResponse_version' - Grant version.
--
-- 'httpStatus', 'rejectGrantResponse_httpStatus' - The response's http status code.
newRejectGrantResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  RejectGrantResponse
newRejectGrantResponse :: Int -> RejectGrantResponse
newRejectGrantResponse Int
pHttpStatus_ =
  RejectGrantResponse'
    { $sel:grantArn:RejectGrantResponse' :: Maybe Text
grantArn = forall a. Maybe a
Prelude.Nothing,
      $sel:status:RejectGrantResponse' :: Maybe GrantStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:version:RejectGrantResponse' :: Maybe Text
version = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:RejectGrantResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Grant ARN.
rejectGrantResponse_grantArn :: Lens.Lens' RejectGrantResponse (Prelude.Maybe Prelude.Text)
rejectGrantResponse_grantArn :: Lens' RejectGrantResponse (Maybe Text)
rejectGrantResponse_grantArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RejectGrantResponse' {Maybe Text
grantArn :: Maybe Text
$sel:grantArn:RejectGrantResponse' :: RejectGrantResponse -> Maybe Text
grantArn} -> Maybe Text
grantArn) (\s :: RejectGrantResponse
s@RejectGrantResponse' {} Maybe Text
a -> RejectGrantResponse
s {$sel:grantArn:RejectGrantResponse' :: Maybe Text
grantArn = Maybe Text
a} :: RejectGrantResponse)

-- | Grant status.
rejectGrantResponse_status :: Lens.Lens' RejectGrantResponse (Prelude.Maybe GrantStatus)
rejectGrantResponse_status :: Lens' RejectGrantResponse (Maybe GrantStatus)
rejectGrantResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RejectGrantResponse' {Maybe GrantStatus
status :: Maybe GrantStatus
$sel:status:RejectGrantResponse' :: RejectGrantResponse -> Maybe GrantStatus
status} -> Maybe GrantStatus
status) (\s :: RejectGrantResponse
s@RejectGrantResponse' {} Maybe GrantStatus
a -> RejectGrantResponse
s {$sel:status:RejectGrantResponse' :: Maybe GrantStatus
status = Maybe GrantStatus
a} :: RejectGrantResponse)

-- | Grant version.
rejectGrantResponse_version :: Lens.Lens' RejectGrantResponse (Prelude.Maybe Prelude.Text)
rejectGrantResponse_version :: Lens' RejectGrantResponse (Maybe Text)
rejectGrantResponse_version = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RejectGrantResponse' {Maybe Text
version :: Maybe Text
$sel:version:RejectGrantResponse' :: RejectGrantResponse -> Maybe Text
version} -> Maybe Text
version) (\s :: RejectGrantResponse
s@RejectGrantResponse' {} Maybe Text
a -> RejectGrantResponse
s {$sel:version:RejectGrantResponse' :: Maybe Text
version = Maybe Text
a} :: RejectGrantResponse)

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

instance Prelude.NFData RejectGrantResponse where
  rnf :: RejectGrantResponse -> ()
rnf RejectGrantResponse' {Int
Maybe Text
Maybe GrantStatus
httpStatus :: Int
version :: Maybe Text
status :: Maybe GrantStatus
grantArn :: Maybe Text
$sel:httpStatus:RejectGrantResponse' :: RejectGrantResponse -> Int
$sel:version:RejectGrantResponse' :: RejectGrantResponse -> Maybe Text
$sel:status:RejectGrantResponse' :: RejectGrantResponse -> Maybe GrantStatus
$sel:grantArn:RejectGrantResponse' :: RejectGrantResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
grantArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GrantStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
version
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus