{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.S3.Types.TargetGrant
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.S3.Types.TargetGrant where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.S3.Internal
import Amazonka.S3.Types.BucketLogsPermission
import Amazonka.S3.Types.Grantee

-- | Container for granting information.
--
-- Buckets that use the bucket owner enforced setting for Object Ownership
-- don\'t support target grants. For more information, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/userguide/enable-server-access-logging.html#grant-log-delivery-permissions-general Permissions server access log delivery>
-- in the /Amazon S3 User Guide/.
--
-- /See:/ 'newTargetGrant' smart constructor.
data TargetGrant = TargetGrant'
  { -- | Container for the person being granted permissions.
    TargetGrant -> Maybe Grantee
grantee :: Prelude.Maybe Grantee,
    -- | Logging permissions assigned to the grantee for the bucket.
    TargetGrant -> Maybe BucketLogsPermission
permission :: Prelude.Maybe BucketLogsPermission
  }
  deriving (TargetGrant -> TargetGrant -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: TargetGrant -> TargetGrant -> Bool
$c/= :: TargetGrant -> TargetGrant -> Bool
== :: TargetGrant -> TargetGrant -> Bool
$c== :: TargetGrant -> TargetGrant -> Bool
Prelude.Eq, ReadPrec [TargetGrant]
ReadPrec TargetGrant
Int -> ReadS TargetGrant
ReadS [TargetGrant]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [TargetGrant]
$creadListPrec :: ReadPrec [TargetGrant]
readPrec :: ReadPrec TargetGrant
$creadPrec :: ReadPrec TargetGrant
readList :: ReadS [TargetGrant]
$creadList :: ReadS [TargetGrant]
readsPrec :: Int -> ReadS TargetGrant
$creadsPrec :: Int -> ReadS TargetGrant
Prelude.Read, Int -> TargetGrant -> ShowS
[TargetGrant] -> ShowS
TargetGrant -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [TargetGrant] -> ShowS
$cshowList :: [TargetGrant] -> ShowS
show :: TargetGrant -> String
$cshow :: TargetGrant -> String
showsPrec :: Int -> TargetGrant -> ShowS
$cshowsPrec :: Int -> TargetGrant -> ShowS
Prelude.Show, forall x. Rep TargetGrant x -> TargetGrant
forall x. TargetGrant -> Rep TargetGrant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep TargetGrant x -> TargetGrant
$cfrom :: forall x. TargetGrant -> Rep TargetGrant x
Prelude.Generic)

-- |
-- Create a value of 'TargetGrant' 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:
--
-- 'grantee', 'targetGrant_grantee' - Container for the person being granted permissions.
--
-- 'permission', 'targetGrant_permission' - Logging permissions assigned to the grantee for the bucket.
newTargetGrant ::
  TargetGrant
newTargetGrant :: TargetGrant
newTargetGrant =
  TargetGrant'
    { $sel:grantee:TargetGrant' :: Maybe Grantee
grantee = forall a. Maybe a
Prelude.Nothing,
      $sel:permission:TargetGrant' :: Maybe BucketLogsPermission
permission = forall a. Maybe a
Prelude.Nothing
    }

-- | Container for the person being granted permissions.
targetGrant_grantee :: Lens.Lens' TargetGrant (Prelude.Maybe Grantee)
targetGrant_grantee :: Lens' TargetGrant (Maybe Grantee)
targetGrant_grantee = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGrant' {Maybe Grantee
grantee :: Maybe Grantee
$sel:grantee:TargetGrant' :: TargetGrant -> Maybe Grantee
grantee} -> Maybe Grantee
grantee) (\s :: TargetGrant
s@TargetGrant' {} Maybe Grantee
a -> TargetGrant
s {$sel:grantee:TargetGrant' :: Maybe Grantee
grantee = Maybe Grantee
a} :: TargetGrant)

-- | Logging permissions assigned to the grantee for the bucket.
targetGrant_permission :: Lens.Lens' TargetGrant (Prelude.Maybe BucketLogsPermission)
targetGrant_permission :: Lens' TargetGrant (Maybe BucketLogsPermission)
targetGrant_permission = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\TargetGrant' {Maybe BucketLogsPermission
permission :: Maybe BucketLogsPermission
$sel:permission:TargetGrant' :: TargetGrant -> Maybe BucketLogsPermission
permission} -> Maybe BucketLogsPermission
permission) (\s :: TargetGrant
s@TargetGrant' {} Maybe BucketLogsPermission
a -> TargetGrant
s {$sel:permission:TargetGrant' :: Maybe BucketLogsPermission
permission = Maybe BucketLogsPermission
a} :: TargetGrant)

instance Data.FromXML TargetGrant where
  parseXML :: [Node] -> Either String TargetGrant
parseXML [Node]
x =
    Maybe Grantee -> Maybe BucketLogsPermission -> TargetGrant
TargetGrant'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Grantee")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Permission")

instance Prelude.Hashable TargetGrant where
  hashWithSalt :: Int -> TargetGrant -> Int
hashWithSalt Int
_salt TargetGrant' {Maybe BucketLogsPermission
Maybe Grantee
permission :: Maybe BucketLogsPermission
grantee :: Maybe Grantee
$sel:permission:TargetGrant' :: TargetGrant -> Maybe BucketLogsPermission
$sel:grantee:TargetGrant' :: TargetGrant -> Maybe Grantee
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Grantee
grantee
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BucketLogsPermission
permission

instance Prelude.NFData TargetGrant where
  rnf :: TargetGrant -> ()
rnf TargetGrant' {Maybe BucketLogsPermission
Maybe Grantee
permission :: Maybe BucketLogsPermission
grantee :: Maybe Grantee
$sel:permission:TargetGrant' :: TargetGrant -> Maybe BucketLogsPermission
$sel:grantee:TargetGrant' :: TargetGrant -> Maybe Grantee
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Grantee
grantee
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BucketLogsPermission
permission

instance Data.ToXML TargetGrant where
  toXML :: TargetGrant -> XML
toXML TargetGrant' {Maybe BucketLogsPermission
Maybe Grantee
permission :: Maybe BucketLogsPermission
grantee :: Maybe Grantee
$sel:permission:TargetGrant' :: TargetGrant -> Maybe BucketLogsPermission
$sel:grantee:TargetGrant' :: TargetGrant -> Maybe Grantee
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"Grantee" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Grantee
grantee,
        Name
"Permission" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe BucketLogsPermission
permission
      ]