{-# 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.CreateGrant
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a grant for the specified license. A grant shares the use of
-- license entitlements with specific Amazon Web Services accounts.
module Amazonka.LicenseManager.CreateGrant
  ( -- * Creating a Request
    CreateGrant (..),
    newCreateGrant,

    -- * Request Lenses
    createGrant_clientToken,
    createGrant_grantName,
    createGrant_licenseArn,
    createGrant_principals,
    createGrant_homeRegion,
    createGrant_allowedOperations,

    -- * Destructuring the Response
    CreateGrantResponse (..),
    newCreateGrantResponse,

    -- * Response Lenses
    createGrantResponse_grantArn,
    createGrantResponse_status,
    createGrantResponse_version,
    createGrantResponse_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:/ 'newCreateGrant' smart constructor.
data CreateGrant = CreateGrant'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateGrant -> Text
clientToken :: Prelude.Text,
    -- | Grant name.
    CreateGrant -> Text
grantName :: Prelude.Text,
    -- | Amazon Resource Name (ARN) of the license.
    CreateGrant -> Text
licenseArn :: Prelude.Text,
    -- | The grant principals. This value should be specified as an Amazon
    -- Resource Name (ARN).
    CreateGrant -> NonEmpty Text
principals :: Prelude.NonEmpty Prelude.Text,
    -- | Home Region of the grant.
    CreateGrant -> Text
homeRegion :: Prelude.Text,
    -- | Allowed operations for the grant.
    CreateGrant -> NonEmpty AllowedOperation
allowedOperations :: Prelude.NonEmpty AllowedOperation
  }
  deriving (CreateGrant -> CreateGrant -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGrant -> CreateGrant -> Bool
$c/= :: CreateGrant -> CreateGrant -> Bool
== :: CreateGrant -> CreateGrant -> Bool
$c== :: CreateGrant -> CreateGrant -> Bool
Prelude.Eq, ReadPrec [CreateGrant]
ReadPrec CreateGrant
Int -> ReadS CreateGrant
ReadS [CreateGrant]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGrant]
$creadListPrec :: ReadPrec [CreateGrant]
readPrec :: ReadPrec CreateGrant
$creadPrec :: ReadPrec CreateGrant
readList :: ReadS [CreateGrant]
$creadList :: ReadS [CreateGrant]
readsPrec :: Int -> ReadS CreateGrant
$creadsPrec :: Int -> ReadS CreateGrant
Prelude.Read, Int -> CreateGrant -> ShowS
[CreateGrant] -> ShowS
CreateGrant -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGrant] -> ShowS
$cshowList :: [CreateGrant] -> ShowS
show :: CreateGrant -> String
$cshow :: CreateGrant -> String
showsPrec :: Int -> CreateGrant -> ShowS
$cshowsPrec :: Int -> CreateGrant -> ShowS
Prelude.Show, forall x. Rep CreateGrant x -> CreateGrant
forall x. CreateGrant -> Rep CreateGrant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateGrant x -> CreateGrant
$cfrom :: forall x. CreateGrant -> Rep CreateGrant x
Prelude.Generic)

-- |
-- Create a value of 'CreateGrant' 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:
--
-- 'clientToken', 'createGrant_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'grantName', 'createGrant_grantName' - Grant name.
--
-- 'licenseArn', 'createGrant_licenseArn' - Amazon Resource Name (ARN) of the license.
--
-- 'principals', 'createGrant_principals' - The grant principals. This value should be specified as an Amazon
-- Resource Name (ARN).
--
-- 'homeRegion', 'createGrant_homeRegion' - Home Region of the grant.
--
-- 'allowedOperations', 'createGrant_allowedOperations' - Allowed operations for the grant.
newCreateGrant ::
  -- | 'clientToken'
  Prelude.Text ->
  -- | 'grantName'
  Prelude.Text ->
  -- | 'licenseArn'
  Prelude.Text ->
  -- | 'principals'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'homeRegion'
  Prelude.Text ->
  -- | 'allowedOperations'
  Prelude.NonEmpty AllowedOperation ->
  CreateGrant
newCreateGrant :: Text
-> Text
-> Text
-> NonEmpty Text
-> Text
-> NonEmpty AllowedOperation
-> CreateGrant
newCreateGrant
  Text
pClientToken_
  Text
pGrantName_
  Text
pLicenseArn_
  NonEmpty Text
pPrincipals_
  Text
pHomeRegion_
  NonEmpty AllowedOperation
pAllowedOperations_ =
    CreateGrant'
      { $sel:clientToken:CreateGrant' :: Text
clientToken = Text
pClientToken_,
        $sel:grantName:CreateGrant' :: Text
grantName = Text
pGrantName_,
        $sel:licenseArn:CreateGrant' :: Text
licenseArn = Text
pLicenseArn_,
        $sel:principals:CreateGrant' :: NonEmpty Text
principals = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pPrincipals_,
        $sel:homeRegion:CreateGrant' :: Text
homeRegion = Text
pHomeRegion_,
        $sel:allowedOperations:CreateGrant' :: NonEmpty AllowedOperation
allowedOperations =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty AllowedOperation
pAllowedOperations_
      }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
createGrant_clientToken :: Lens.Lens' CreateGrant Prelude.Text
createGrant_clientToken :: Lens' CreateGrant Text
createGrant_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGrant' {Text
clientToken :: Text
$sel:clientToken:CreateGrant' :: CreateGrant -> Text
clientToken} -> Text
clientToken) (\s :: CreateGrant
s@CreateGrant' {} Text
a -> CreateGrant
s {$sel:clientToken:CreateGrant' :: Text
clientToken = Text
a} :: CreateGrant)

-- | Grant name.
createGrant_grantName :: Lens.Lens' CreateGrant Prelude.Text
createGrant_grantName :: Lens' CreateGrant Text
createGrant_grantName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGrant' {Text
grantName :: Text
$sel:grantName:CreateGrant' :: CreateGrant -> Text
grantName} -> Text
grantName) (\s :: CreateGrant
s@CreateGrant' {} Text
a -> CreateGrant
s {$sel:grantName:CreateGrant' :: Text
grantName = Text
a} :: CreateGrant)

-- | Amazon Resource Name (ARN) of the license.
createGrant_licenseArn :: Lens.Lens' CreateGrant Prelude.Text
createGrant_licenseArn :: Lens' CreateGrant Text
createGrant_licenseArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGrant' {Text
licenseArn :: Text
$sel:licenseArn:CreateGrant' :: CreateGrant -> Text
licenseArn} -> Text
licenseArn) (\s :: CreateGrant
s@CreateGrant' {} Text
a -> CreateGrant
s {$sel:licenseArn:CreateGrant' :: Text
licenseArn = Text
a} :: CreateGrant)

-- | The grant principals. This value should be specified as an Amazon
-- Resource Name (ARN).
createGrant_principals :: Lens.Lens' CreateGrant (Prelude.NonEmpty Prelude.Text)
createGrant_principals :: Lens' CreateGrant (NonEmpty Text)
createGrant_principals = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGrant' {NonEmpty Text
principals :: NonEmpty Text
$sel:principals:CreateGrant' :: CreateGrant -> NonEmpty Text
principals} -> NonEmpty Text
principals) (\s :: CreateGrant
s@CreateGrant' {} NonEmpty Text
a -> CreateGrant
s {$sel:principals:CreateGrant' :: NonEmpty Text
principals = NonEmpty Text
a} :: CreateGrant) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Home Region of the grant.
createGrant_homeRegion :: Lens.Lens' CreateGrant Prelude.Text
createGrant_homeRegion :: Lens' CreateGrant Text
createGrant_homeRegion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGrant' {Text
homeRegion :: Text
$sel:homeRegion:CreateGrant' :: CreateGrant -> Text
homeRegion} -> Text
homeRegion) (\s :: CreateGrant
s@CreateGrant' {} Text
a -> CreateGrant
s {$sel:homeRegion:CreateGrant' :: Text
homeRegion = Text
a} :: CreateGrant)

-- | Allowed operations for the grant.
createGrant_allowedOperations :: Lens.Lens' CreateGrant (Prelude.NonEmpty AllowedOperation)
createGrant_allowedOperations :: Lens' CreateGrant (NonEmpty AllowedOperation)
createGrant_allowedOperations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGrant' {NonEmpty AllowedOperation
allowedOperations :: NonEmpty AllowedOperation
$sel:allowedOperations:CreateGrant' :: CreateGrant -> NonEmpty AllowedOperation
allowedOperations} -> NonEmpty AllowedOperation
allowedOperations) (\s :: CreateGrant
s@CreateGrant' {} NonEmpty AllowedOperation
a -> CreateGrant
s {$sel:allowedOperations:CreateGrant' :: NonEmpty AllowedOperation
allowedOperations = NonEmpty AllowedOperation
a} :: CreateGrant) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Core.AWSRequest CreateGrant where
  type AWSResponse CreateGrant = CreateGrantResponse
  request :: (Service -> Service) -> CreateGrant -> Request CreateGrant
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 CreateGrant
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateGrant)))
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 -> CreateGrantResponse
CreateGrantResponse'
            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 CreateGrant where
  hashWithSalt :: Int -> CreateGrant -> Int
hashWithSalt Int
_salt CreateGrant' {NonEmpty Text
NonEmpty AllowedOperation
Text
allowedOperations :: NonEmpty AllowedOperation
homeRegion :: Text
principals :: NonEmpty Text
licenseArn :: Text
grantName :: Text
clientToken :: Text
$sel:allowedOperations:CreateGrant' :: CreateGrant -> NonEmpty AllowedOperation
$sel:homeRegion:CreateGrant' :: CreateGrant -> Text
$sel:principals:CreateGrant' :: CreateGrant -> NonEmpty Text
$sel:licenseArn:CreateGrant' :: CreateGrant -> Text
$sel:grantName:CreateGrant' :: CreateGrant -> Text
$sel:clientToken:CreateGrant' :: CreateGrant -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
grantName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
licenseArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
principals
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
homeRegion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty AllowedOperation
allowedOperations

instance Prelude.NFData CreateGrant where
  rnf :: CreateGrant -> ()
rnf CreateGrant' {NonEmpty Text
NonEmpty AllowedOperation
Text
allowedOperations :: NonEmpty AllowedOperation
homeRegion :: Text
principals :: NonEmpty Text
licenseArn :: Text
grantName :: Text
clientToken :: Text
$sel:allowedOperations:CreateGrant' :: CreateGrant -> NonEmpty AllowedOperation
$sel:homeRegion:CreateGrant' :: CreateGrant -> Text
$sel:principals:CreateGrant' :: CreateGrant -> NonEmpty Text
$sel:licenseArn:CreateGrant' :: CreateGrant -> Text
$sel:grantName:CreateGrant' :: CreateGrant -> Text
$sel:clientToken:CreateGrant' :: CreateGrant -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
grantName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
licenseArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
principals
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
homeRegion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty AllowedOperation
allowedOperations

instance Data.ToHeaders CreateGrant where
  toHeaders :: CreateGrant -> 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.CreateGrant" ::
                          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 CreateGrant where
  toJSON :: CreateGrant -> Value
toJSON CreateGrant' {NonEmpty Text
NonEmpty AllowedOperation
Text
allowedOperations :: NonEmpty AllowedOperation
homeRegion :: Text
principals :: NonEmpty Text
licenseArn :: Text
grantName :: Text
clientToken :: Text
$sel:allowedOperations:CreateGrant' :: CreateGrant -> NonEmpty AllowedOperation
$sel:homeRegion:CreateGrant' :: CreateGrant -> Text
$sel:principals:CreateGrant' :: CreateGrant -> NonEmpty Text
$sel:licenseArn:CreateGrant' :: CreateGrant -> Text
$sel:grantName:CreateGrant' :: CreateGrant -> Text
$sel:clientToken:CreateGrant' :: CreateGrant -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"ClientToken" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
clientToken),
            forall a. a -> Maybe a
Prelude.Just (Key
"GrantName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
grantName),
            forall a. a -> Maybe a
Prelude.Just (Key
"LicenseArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
licenseArn),
            forall a. a -> Maybe a
Prelude.Just (Key
"Principals" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty Text
principals),
            forall a. a -> Maybe a
Prelude.Just (Key
"HomeRegion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
homeRegion),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"AllowedOperations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty AllowedOperation
allowedOperations)
          ]
      )

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

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

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

-- |
-- Create a value of 'CreateGrantResponse' 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', 'createGrantResponse_grantArn' - Grant ARN.
--
-- 'status', 'createGrantResponse_status' - Grant status.
--
-- 'version', 'createGrantResponse_version' - Grant version.
--
-- 'httpStatus', 'createGrantResponse_httpStatus' - The response's http status code.
newCreateGrantResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateGrantResponse
newCreateGrantResponse :: Int -> CreateGrantResponse
newCreateGrantResponse Int
pHttpStatus_ =
  CreateGrantResponse'
    { $sel:grantArn:CreateGrantResponse' :: Maybe Text
grantArn = forall a. Maybe a
Prelude.Nothing,
      $sel:status:CreateGrantResponse' :: Maybe GrantStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:version:CreateGrantResponse' :: Maybe Text
version = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateGrantResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

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

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

instance Prelude.NFData CreateGrantResponse where
  rnf :: CreateGrantResponse -> ()
rnf CreateGrantResponse' {Int
Maybe Text
Maybe GrantStatus
httpStatus :: Int
version :: Maybe Text
status :: Maybe GrantStatus
grantArn :: Maybe Text
$sel:httpStatus:CreateGrantResponse' :: CreateGrantResponse -> Int
$sel:version:CreateGrantResponse' :: CreateGrantResponse -> Maybe Text
$sel:status:CreateGrantResponse' :: CreateGrantResponse -> Maybe GrantStatus
$sel:grantArn:CreateGrantResponse' :: CreateGrantResponse -> 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