{-# 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.Redshift.Types.ClusterSecurityGroup
-- 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.Redshift.Types.ClusterSecurityGroup 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.Redshift.Internal
import Amazonka.Redshift.Types.EC2SecurityGroup
import Amazonka.Redshift.Types.IPRange
import Amazonka.Redshift.Types.Tag

-- | Describes a security group.
--
-- /See:/ 'newClusterSecurityGroup' smart constructor.
data ClusterSecurityGroup = ClusterSecurityGroup'
  { -- | The name of the cluster security group to which the operation was
    -- applied.
    ClusterSecurityGroup -> Maybe Text
clusterSecurityGroupName :: Prelude.Maybe Prelude.Text,
    -- | A description of the security group.
    ClusterSecurityGroup -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A list of EC2 security groups that are permitted to access clusters
    -- associated with this cluster security group.
    ClusterSecurityGroup -> Maybe [EC2SecurityGroup]
eC2SecurityGroups :: Prelude.Maybe [EC2SecurityGroup],
    -- | A list of IP ranges (CIDR blocks) that are permitted to access clusters
    -- associated with this cluster security group.
    ClusterSecurityGroup -> Maybe [IPRange]
iPRanges :: Prelude.Maybe [IPRange],
    -- | The list of tags for the cluster security group.
    ClusterSecurityGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag]
  }
  deriving (ClusterSecurityGroup -> ClusterSecurityGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ClusterSecurityGroup -> ClusterSecurityGroup -> Bool
$c/= :: ClusterSecurityGroup -> ClusterSecurityGroup -> Bool
== :: ClusterSecurityGroup -> ClusterSecurityGroup -> Bool
$c== :: ClusterSecurityGroup -> ClusterSecurityGroup -> Bool
Prelude.Eq, ReadPrec [ClusterSecurityGroup]
ReadPrec ClusterSecurityGroup
Int -> ReadS ClusterSecurityGroup
ReadS [ClusterSecurityGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ClusterSecurityGroup]
$creadListPrec :: ReadPrec [ClusterSecurityGroup]
readPrec :: ReadPrec ClusterSecurityGroup
$creadPrec :: ReadPrec ClusterSecurityGroup
readList :: ReadS [ClusterSecurityGroup]
$creadList :: ReadS [ClusterSecurityGroup]
readsPrec :: Int -> ReadS ClusterSecurityGroup
$creadsPrec :: Int -> ReadS ClusterSecurityGroup
Prelude.Read, Int -> ClusterSecurityGroup -> ShowS
[ClusterSecurityGroup] -> ShowS
ClusterSecurityGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ClusterSecurityGroup] -> ShowS
$cshowList :: [ClusterSecurityGroup] -> ShowS
show :: ClusterSecurityGroup -> String
$cshow :: ClusterSecurityGroup -> String
showsPrec :: Int -> ClusterSecurityGroup -> ShowS
$cshowsPrec :: Int -> ClusterSecurityGroup -> ShowS
Prelude.Show, forall x. Rep ClusterSecurityGroup x -> ClusterSecurityGroup
forall x. ClusterSecurityGroup -> Rep ClusterSecurityGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ClusterSecurityGroup x -> ClusterSecurityGroup
$cfrom :: forall x. ClusterSecurityGroup -> Rep ClusterSecurityGroup x
Prelude.Generic)

-- |
-- Create a value of 'ClusterSecurityGroup' 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:
--
-- 'clusterSecurityGroupName', 'clusterSecurityGroup_clusterSecurityGroupName' - The name of the cluster security group to which the operation was
-- applied.
--
-- 'description', 'clusterSecurityGroup_description' - A description of the security group.
--
-- 'eC2SecurityGroups', 'clusterSecurityGroup_eC2SecurityGroups' - A list of EC2 security groups that are permitted to access clusters
-- associated with this cluster security group.
--
-- 'iPRanges', 'clusterSecurityGroup_iPRanges' - A list of IP ranges (CIDR blocks) that are permitted to access clusters
-- associated with this cluster security group.
--
-- 'tags', 'clusterSecurityGroup_tags' - The list of tags for the cluster security group.
newClusterSecurityGroup ::
  ClusterSecurityGroup
newClusterSecurityGroup :: ClusterSecurityGroup
newClusterSecurityGroup =
  ClusterSecurityGroup'
    { $sel:clusterSecurityGroupName:ClusterSecurityGroup' :: Maybe Text
clusterSecurityGroupName =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:ClusterSecurityGroup' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:eC2SecurityGroups:ClusterSecurityGroup' :: Maybe [EC2SecurityGroup]
eC2SecurityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:iPRanges:ClusterSecurityGroup' :: Maybe [IPRange]
iPRanges = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ClusterSecurityGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing
    }

-- | The name of the cluster security group to which the operation was
-- applied.
clusterSecurityGroup_clusterSecurityGroupName :: Lens.Lens' ClusterSecurityGroup (Prelude.Maybe Prelude.Text)
clusterSecurityGroup_clusterSecurityGroupName :: Lens' ClusterSecurityGroup (Maybe Text)
clusterSecurityGroup_clusterSecurityGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterSecurityGroup' {Maybe Text
clusterSecurityGroupName :: Maybe Text
$sel:clusterSecurityGroupName:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe Text
clusterSecurityGroupName} -> Maybe Text
clusterSecurityGroupName) (\s :: ClusterSecurityGroup
s@ClusterSecurityGroup' {} Maybe Text
a -> ClusterSecurityGroup
s {$sel:clusterSecurityGroupName:ClusterSecurityGroup' :: Maybe Text
clusterSecurityGroupName = Maybe Text
a} :: ClusterSecurityGroup)

-- | A description of the security group.
clusterSecurityGroup_description :: Lens.Lens' ClusterSecurityGroup (Prelude.Maybe Prelude.Text)
clusterSecurityGroup_description :: Lens' ClusterSecurityGroup (Maybe Text)
clusterSecurityGroup_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterSecurityGroup' {Maybe Text
description :: Maybe Text
$sel:description:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe Text
description} -> Maybe Text
description) (\s :: ClusterSecurityGroup
s@ClusterSecurityGroup' {} Maybe Text
a -> ClusterSecurityGroup
s {$sel:description:ClusterSecurityGroup' :: Maybe Text
description = Maybe Text
a} :: ClusterSecurityGroup)

-- | A list of EC2 security groups that are permitted to access clusters
-- associated with this cluster security group.
clusterSecurityGroup_eC2SecurityGroups :: Lens.Lens' ClusterSecurityGroup (Prelude.Maybe [EC2SecurityGroup])
clusterSecurityGroup_eC2SecurityGroups :: Lens' ClusterSecurityGroup (Maybe [EC2SecurityGroup])
clusterSecurityGroup_eC2SecurityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterSecurityGroup' {Maybe [EC2SecurityGroup]
eC2SecurityGroups :: Maybe [EC2SecurityGroup]
$sel:eC2SecurityGroups:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe [EC2SecurityGroup]
eC2SecurityGroups} -> Maybe [EC2SecurityGroup]
eC2SecurityGroups) (\s :: ClusterSecurityGroup
s@ClusterSecurityGroup' {} Maybe [EC2SecurityGroup]
a -> ClusterSecurityGroup
s {$sel:eC2SecurityGroups:ClusterSecurityGroup' :: Maybe [EC2SecurityGroup]
eC2SecurityGroups = Maybe [EC2SecurityGroup]
a} :: ClusterSecurityGroup) 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

-- | A list of IP ranges (CIDR blocks) that are permitted to access clusters
-- associated with this cluster security group.
clusterSecurityGroup_iPRanges :: Lens.Lens' ClusterSecurityGroup (Prelude.Maybe [IPRange])
clusterSecurityGroup_iPRanges :: Lens' ClusterSecurityGroup (Maybe [IPRange])
clusterSecurityGroup_iPRanges = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterSecurityGroup' {Maybe [IPRange]
iPRanges :: Maybe [IPRange]
$sel:iPRanges:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe [IPRange]
iPRanges} -> Maybe [IPRange]
iPRanges) (\s :: ClusterSecurityGroup
s@ClusterSecurityGroup' {} Maybe [IPRange]
a -> ClusterSecurityGroup
s {$sel:iPRanges:ClusterSecurityGroup' :: Maybe [IPRange]
iPRanges = Maybe [IPRange]
a} :: ClusterSecurityGroup) 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

-- | The list of tags for the cluster security group.
clusterSecurityGroup_tags :: Lens.Lens' ClusterSecurityGroup (Prelude.Maybe [Tag])
clusterSecurityGroup_tags :: Lens' ClusterSecurityGroup (Maybe [Tag])
clusterSecurityGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ClusterSecurityGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: ClusterSecurityGroup
s@ClusterSecurityGroup' {} Maybe [Tag]
a -> ClusterSecurityGroup
s {$sel:tags:ClusterSecurityGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: ClusterSecurityGroup) 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 ClusterSecurityGroup where
  parseXML :: [Node] -> Either String ClusterSecurityGroup
parseXML [Node]
x =
    Maybe Text
-> Maybe Text
-> Maybe [EC2SecurityGroup]
-> Maybe [IPRange]
-> Maybe [Tag]
-> ClusterSecurityGroup
ClusterSecurityGroup'
      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
"ClusterSecurityGroupName")
      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
"Description")
      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
"EC2SecurityGroups"
                      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
"EC2SecurityGroup")
                  )
      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
"IPRanges"
                      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
"IPRange")
                  )
      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
"Tags"
                      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
"Tag")
                  )

instance Prelude.Hashable ClusterSecurityGroup where
  hashWithSalt :: Int -> ClusterSecurityGroup -> Int
hashWithSalt Int
_salt ClusterSecurityGroup' {Maybe [Tag]
Maybe [IPRange]
Maybe [EC2SecurityGroup]
Maybe Text
tags :: Maybe [Tag]
iPRanges :: Maybe [IPRange]
eC2SecurityGroups :: Maybe [EC2SecurityGroup]
description :: Maybe Text
clusterSecurityGroupName :: Maybe Text
$sel:tags:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe [Tag]
$sel:iPRanges:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe [IPRange]
$sel:eC2SecurityGroups:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe [EC2SecurityGroup]
$sel:description:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe Text
$sel:clusterSecurityGroupName:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clusterSecurityGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [EC2SecurityGroup]
eC2SecurityGroups
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [IPRange]
iPRanges
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags

instance Prelude.NFData ClusterSecurityGroup where
  rnf :: ClusterSecurityGroup -> ()
rnf ClusterSecurityGroup' {Maybe [Tag]
Maybe [IPRange]
Maybe [EC2SecurityGroup]
Maybe Text
tags :: Maybe [Tag]
iPRanges :: Maybe [IPRange]
eC2SecurityGroups :: Maybe [EC2SecurityGroup]
description :: Maybe Text
clusterSecurityGroupName :: Maybe Text
$sel:tags:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe [Tag]
$sel:iPRanges:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe [IPRange]
$sel:eC2SecurityGroups:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe [EC2SecurityGroup]
$sel:description:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe Text
$sel:clusterSecurityGroupName:ClusterSecurityGroup' :: ClusterSecurityGroup -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clusterSecurityGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [EC2SecurityGroup]
eC2SecurityGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [IPRange]
iPRanges
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags