{-# 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.Grant
-- 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.Grant 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.Grantee
import Amazonka.S3.Types.Permission

-- | Container for grant information.
--
-- /See:/ 'newGrant' smart constructor.
data Grant = Grant'
  { -- | The person being granted permissions.
    Grant -> Maybe Grantee
grantee :: Prelude.Maybe Grantee,
    -- | Specifies the permission given to the grantee.
    Grant -> Maybe Permission
permission :: Prelude.Maybe Permission
  }
  deriving (Grant -> Grant -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Grant -> Grant -> Bool
$c/= :: Grant -> Grant -> Bool
== :: Grant -> Grant -> Bool
$c== :: Grant -> Grant -> Bool
Prelude.Eq, ReadPrec [Grant]
ReadPrec Grant
Int -> ReadS Grant
ReadS [Grant]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Grant]
$creadListPrec :: ReadPrec [Grant]
readPrec :: ReadPrec Grant
$creadPrec :: ReadPrec Grant
readList :: ReadS [Grant]
$creadList :: ReadS [Grant]
readsPrec :: Int -> ReadS Grant
$creadsPrec :: Int -> ReadS Grant
Prelude.Read, Int -> Grant -> ShowS
[Grant] -> ShowS
Grant -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Grant] -> ShowS
$cshowList :: [Grant] -> ShowS
show :: Grant -> String
$cshow :: Grant -> String
showsPrec :: Int -> Grant -> ShowS
$cshowsPrec :: Int -> Grant -> ShowS
Prelude.Show, forall x. Rep Grant x -> Grant
forall x. Grant -> Rep Grant x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Grant x -> Grant
$cfrom :: forall x. Grant -> Rep Grant x
Prelude.Generic)

-- |
-- Create a value of 'Grant' 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', 'grant_grantee' - The person being granted permissions.
--
-- 'permission', 'grant_permission' - Specifies the permission given to the grantee.
newGrant ::
  Grant
newGrant :: Grant
newGrant =
  Grant'
    { $sel:grantee:Grant' :: Maybe Grantee
grantee = forall a. Maybe a
Prelude.Nothing,
      $sel:permission:Grant' :: Maybe Permission
permission = forall a. Maybe a
Prelude.Nothing
    }

-- | The person being granted permissions.
grant_grantee :: Lens.Lens' Grant (Prelude.Maybe Grantee)
grant_grantee :: Lens' Grant (Maybe Grantee)
grant_grantee = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Grant' {Maybe Grantee
grantee :: Maybe Grantee
$sel:grantee:Grant' :: Grant -> Maybe Grantee
grantee} -> Maybe Grantee
grantee) (\s :: Grant
s@Grant' {} Maybe Grantee
a -> Grant
s {$sel:grantee:Grant' :: Maybe Grantee
grantee = Maybe Grantee
a} :: Grant)

-- | Specifies the permission given to the grantee.
grant_permission :: Lens.Lens' Grant (Prelude.Maybe Permission)
grant_permission :: Lens' Grant (Maybe Permission)
grant_permission = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Grant' {Maybe Permission
permission :: Maybe Permission
$sel:permission:Grant' :: Grant -> Maybe Permission
permission} -> Maybe Permission
permission) (\s :: Grant
s@Grant' {} Maybe Permission
a -> Grant
s {$sel:permission:Grant' :: Maybe Permission
permission = Maybe Permission
a} :: Grant)

instance Data.FromXML Grant where
  parseXML :: [Node] -> Either String Grant
parseXML [Node]
x =
    Maybe Grantee -> Maybe Permission -> Grant
Grant'
      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 Grant where
  hashWithSalt :: Int -> Grant -> Int
hashWithSalt Int
_salt Grant' {Maybe Permission
Maybe Grantee
permission :: Maybe Permission
grantee :: Maybe Grantee
$sel:permission:Grant' :: Grant -> Maybe Permission
$sel:grantee:Grant' :: Grant -> 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 Permission
permission

instance Prelude.NFData Grant where
  rnf :: Grant -> ()
rnf Grant' {Maybe Permission
Maybe Grantee
permission :: Maybe Permission
grantee :: Maybe Grantee
$sel:permission:Grant' :: Grant -> Maybe Permission
$sel:grantee:Grant' :: Grant -> 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 Permission
permission

instance Data.ToXML Grant where
  toXML :: Grant -> XML
toXML Grant' {Maybe Permission
Maybe Grantee
permission :: Maybe Permission
grantee :: Maybe Grantee
$sel:permission:Grant' :: Grant -> Maybe Permission
$sel:grantee:Grant' :: Grant -> 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 Permission
permission
      ]