{-# 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.EC2.Types.AllowedPrincipal
-- 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.EC2.Types.AllowedPrincipal where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Internal
import Amazonka.EC2.Types.PrincipalType
import Amazonka.EC2.Types.Tag
import qualified Amazonka.Prelude as Prelude

-- | Describes a principal.
--
-- /See:/ 'newAllowedPrincipal' smart constructor.
data AllowedPrincipal = AllowedPrincipal'
  { -- | The Amazon Resource Name (ARN) of the principal.
    AllowedPrincipal -> Maybe Text
principal :: Prelude.Maybe Prelude.Text,
    -- | The type of principal.
    AllowedPrincipal -> Maybe PrincipalType
principalType :: Prelude.Maybe PrincipalType,
    -- | The ID of the service.
    AllowedPrincipal -> Maybe Text
serviceId :: Prelude.Maybe Prelude.Text,
    -- | The ID of the service permission.
    AllowedPrincipal -> Maybe Text
servicePermissionId :: Prelude.Maybe Prelude.Text,
    -- | The tags.
    AllowedPrincipal -> Maybe [Tag]
tags :: Prelude.Maybe [Tag]
  }
  deriving (AllowedPrincipal -> AllowedPrincipal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: AllowedPrincipal -> AllowedPrincipal -> Bool
$c/= :: AllowedPrincipal -> AllowedPrincipal -> Bool
== :: AllowedPrincipal -> AllowedPrincipal -> Bool
$c== :: AllowedPrincipal -> AllowedPrincipal -> Bool
Prelude.Eq, ReadPrec [AllowedPrincipal]
ReadPrec AllowedPrincipal
Int -> ReadS AllowedPrincipal
ReadS [AllowedPrincipal]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [AllowedPrincipal]
$creadListPrec :: ReadPrec [AllowedPrincipal]
readPrec :: ReadPrec AllowedPrincipal
$creadPrec :: ReadPrec AllowedPrincipal
readList :: ReadS [AllowedPrincipal]
$creadList :: ReadS [AllowedPrincipal]
readsPrec :: Int -> ReadS AllowedPrincipal
$creadsPrec :: Int -> ReadS AllowedPrincipal
Prelude.Read, Int -> AllowedPrincipal -> ShowS
[AllowedPrincipal] -> ShowS
AllowedPrincipal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [AllowedPrincipal] -> ShowS
$cshowList :: [AllowedPrincipal] -> ShowS
show :: AllowedPrincipal -> String
$cshow :: AllowedPrincipal -> String
showsPrec :: Int -> AllowedPrincipal -> ShowS
$cshowsPrec :: Int -> AllowedPrincipal -> ShowS
Prelude.Show, forall x. Rep AllowedPrincipal x -> AllowedPrincipal
forall x. AllowedPrincipal -> Rep AllowedPrincipal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep AllowedPrincipal x -> AllowedPrincipal
$cfrom :: forall x. AllowedPrincipal -> Rep AllowedPrincipal x
Prelude.Generic)

-- |
-- Create a value of 'AllowedPrincipal' 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:
--
-- 'principal', 'allowedPrincipal_principal' - The Amazon Resource Name (ARN) of the principal.
--
-- 'principalType', 'allowedPrincipal_principalType' - The type of principal.
--
-- 'serviceId', 'allowedPrincipal_serviceId' - The ID of the service.
--
-- 'servicePermissionId', 'allowedPrincipal_servicePermissionId' - The ID of the service permission.
--
-- 'tags', 'allowedPrincipal_tags' - The tags.
newAllowedPrincipal ::
  AllowedPrincipal
newAllowedPrincipal :: AllowedPrincipal
newAllowedPrincipal =
  AllowedPrincipal'
    { $sel:principal:AllowedPrincipal' :: Maybe Text
principal = forall a. Maybe a
Prelude.Nothing,
      $sel:principalType:AllowedPrincipal' :: Maybe PrincipalType
principalType = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceId:AllowedPrincipal' :: Maybe Text
serviceId = forall a. Maybe a
Prelude.Nothing,
      $sel:servicePermissionId:AllowedPrincipal' :: Maybe Text
servicePermissionId = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:AllowedPrincipal' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing
    }

-- | The Amazon Resource Name (ARN) of the principal.
allowedPrincipal_principal :: Lens.Lens' AllowedPrincipal (Prelude.Maybe Prelude.Text)
allowedPrincipal_principal :: Lens' AllowedPrincipal (Maybe Text)
allowedPrincipal_principal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllowedPrincipal' {Maybe Text
principal :: Maybe Text
$sel:principal:AllowedPrincipal' :: AllowedPrincipal -> Maybe Text
principal} -> Maybe Text
principal) (\s :: AllowedPrincipal
s@AllowedPrincipal' {} Maybe Text
a -> AllowedPrincipal
s {$sel:principal:AllowedPrincipal' :: Maybe Text
principal = Maybe Text
a} :: AllowedPrincipal)

-- | The type of principal.
allowedPrincipal_principalType :: Lens.Lens' AllowedPrincipal (Prelude.Maybe PrincipalType)
allowedPrincipal_principalType :: Lens' AllowedPrincipal (Maybe PrincipalType)
allowedPrincipal_principalType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllowedPrincipal' {Maybe PrincipalType
principalType :: Maybe PrincipalType
$sel:principalType:AllowedPrincipal' :: AllowedPrincipal -> Maybe PrincipalType
principalType} -> Maybe PrincipalType
principalType) (\s :: AllowedPrincipal
s@AllowedPrincipal' {} Maybe PrincipalType
a -> AllowedPrincipal
s {$sel:principalType:AllowedPrincipal' :: Maybe PrincipalType
principalType = Maybe PrincipalType
a} :: AllowedPrincipal)

-- | The ID of the service.
allowedPrincipal_serviceId :: Lens.Lens' AllowedPrincipal (Prelude.Maybe Prelude.Text)
allowedPrincipal_serviceId :: Lens' AllowedPrincipal (Maybe Text)
allowedPrincipal_serviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllowedPrincipal' {Maybe Text
serviceId :: Maybe Text
$sel:serviceId:AllowedPrincipal' :: AllowedPrincipal -> Maybe Text
serviceId} -> Maybe Text
serviceId) (\s :: AllowedPrincipal
s@AllowedPrincipal' {} Maybe Text
a -> AllowedPrincipal
s {$sel:serviceId:AllowedPrincipal' :: Maybe Text
serviceId = Maybe Text
a} :: AllowedPrincipal)

-- | The ID of the service permission.
allowedPrincipal_servicePermissionId :: Lens.Lens' AllowedPrincipal (Prelude.Maybe Prelude.Text)
allowedPrincipal_servicePermissionId :: Lens' AllowedPrincipal (Maybe Text)
allowedPrincipal_servicePermissionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllowedPrincipal' {Maybe Text
servicePermissionId :: Maybe Text
$sel:servicePermissionId:AllowedPrincipal' :: AllowedPrincipal -> Maybe Text
servicePermissionId} -> Maybe Text
servicePermissionId) (\s :: AllowedPrincipal
s@AllowedPrincipal' {} Maybe Text
a -> AllowedPrincipal
s {$sel:servicePermissionId:AllowedPrincipal' :: Maybe Text
servicePermissionId = Maybe Text
a} :: AllowedPrincipal)

-- | The tags.
allowedPrincipal_tags :: Lens.Lens' AllowedPrincipal (Prelude.Maybe [Tag])
allowedPrincipal_tags :: Lens' AllowedPrincipal (Maybe [Tag])
allowedPrincipal_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\AllowedPrincipal' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:AllowedPrincipal' :: AllowedPrincipal -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: AllowedPrincipal
s@AllowedPrincipal' {} Maybe [Tag]
a -> AllowedPrincipal
s {$sel:tags:AllowedPrincipal' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: AllowedPrincipal) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance Data.FromXML AllowedPrincipal where
  parseXML :: [Node] -> Either String AllowedPrincipal
parseXML [Node]
x =
    Maybe Text
-> Maybe PrincipalType
-> Maybe Text
-> Maybe Text
-> Maybe [Tag]
-> AllowedPrincipal
AllowedPrincipal'
      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
"principal")
      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
"principalType")
      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
"serviceId")
      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
"servicePermissionId")
      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
"tagSet"
                      forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                      forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                  )

instance Prelude.Hashable AllowedPrincipal where
  hashWithSalt :: Int -> AllowedPrincipal -> Int
hashWithSalt Int
_salt AllowedPrincipal' {Maybe [Tag]
Maybe Text
Maybe PrincipalType
tags :: Maybe [Tag]
servicePermissionId :: Maybe Text
serviceId :: Maybe Text
principalType :: Maybe PrincipalType
principal :: Maybe Text
$sel:tags:AllowedPrincipal' :: AllowedPrincipal -> Maybe [Tag]
$sel:servicePermissionId:AllowedPrincipal' :: AllowedPrincipal -> Maybe Text
$sel:serviceId:AllowedPrincipal' :: AllowedPrincipal -> Maybe Text
$sel:principalType:AllowedPrincipal' :: AllowedPrincipal -> Maybe PrincipalType
$sel:principal:AllowedPrincipal' :: AllowedPrincipal -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
principal
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PrincipalType
principalType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
servicePermissionId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags

instance Prelude.NFData AllowedPrincipal where
  rnf :: AllowedPrincipal -> ()
rnf AllowedPrincipal' {Maybe [Tag]
Maybe Text
Maybe PrincipalType
tags :: Maybe [Tag]
servicePermissionId :: Maybe Text
serviceId :: Maybe Text
principalType :: Maybe PrincipalType
principal :: Maybe Text
$sel:tags:AllowedPrincipal' :: AllowedPrincipal -> Maybe [Tag]
$sel:servicePermissionId:AllowedPrincipal' :: AllowedPrincipal -> Maybe Text
$sel:serviceId:AllowedPrincipal' :: AllowedPrincipal -> Maybe Text
$sel:principalType:AllowedPrincipal' :: AllowedPrincipal -> Maybe PrincipalType
$sel:principal:AllowedPrincipal' :: AllowedPrincipal -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
principal
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PrincipalType
principalType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
servicePermissionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags