{-# 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.EC2.DescribeSecurityGroups
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the specified security groups or all of your security groups.
--
-- A security group is for use with instances either in the EC2-Classic
-- platform or in a specific VPC. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/using-network-security.html Amazon EC2 security groups>
-- in the /Amazon Elastic Compute Cloud User Guide/ and
-- <https://docs.aws.amazon.com/AmazonVPC/latest/UserGuide/VPC_SecurityGroups.html Security groups for your VPC>
-- in the /Amazon Virtual Private Cloud User Guide/.
--
-- We are retiring EC2-Classic. We recommend that you migrate from
-- EC2-Classic to a VPC. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/vpc-migrate.html Migrate from EC2-Classic to a VPC>
-- in the /Amazon Elastic Compute Cloud User Guide/.
--
-- This operation returns paginated results.
module Amazonka.EC2.DescribeSecurityGroups
  ( -- * Creating a Request
    DescribeSecurityGroups (..),
    newDescribeSecurityGroups,

    -- * Request Lenses
    describeSecurityGroups_dryRun,
    describeSecurityGroups_filters,
    describeSecurityGroups_groupIds,
    describeSecurityGroups_groupNames,
    describeSecurityGroups_maxResults,
    describeSecurityGroups_nextToken,

    -- * Destructuring the Response
    DescribeSecurityGroupsResponse (..),
    newDescribeSecurityGroupsResponse,

    -- * Response Lenses
    describeSecurityGroupsResponse_nextToken,
    describeSecurityGroupsResponse_securityGroups,
    describeSecurityGroupsResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.EC2.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDescribeSecurityGroups' smart constructor.
data DescribeSecurityGroups = DescribeSecurityGroups'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    DescribeSecurityGroups -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The filters. If using multiple filters for rules, the results include
    -- security groups for which any combination of rules - not necessarily a
    -- single rule - match all filters.
    --
    -- -   @description@ - The description of the security group.
    --
    -- -   @egress.ip-permission.cidr@ - An IPv4 CIDR block for an outbound
    --     security group rule.
    --
    -- -   @egress.ip-permission.from-port@ - For an outbound rule, the start
    --     of port range for the TCP and UDP protocols, or an ICMP type number.
    --
    -- -   @egress.ip-permission.group-id@ - The ID of a security group that
    --     has been referenced in an outbound security group rule.
    --
    -- -   @egress.ip-permission.group-name@ - The name of a security group
    --     that is referenced in an outbound security group rule.
    --
    -- -   @egress.ip-permission.ipv6-cidr@ - An IPv6 CIDR block for an
    --     outbound security group rule.
    --
    -- -   @egress.ip-permission.prefix-list-id@ - The ID of a prefix list to
    --     which a security group rule allows outbound access.
    --
    -- -   @egress.ip-permission.protocol@ - The IP protocol for an outbound
    --     security group rule (@tcp@ | @udp@ | @icmp@, a protocol number, or
    --     -1 for all protocols).
    --
    -- -   @egress.ip-permission.to-port@ - For an outbound rule, the end of
    --     port range for the TCP and UDP protocols, or an ICMP code.
    --
    -- -   @egress.ip-permission.user-id@ - The ID of an Amazon Web Services
    --     account that has been referenced in an outbound security group rule.
    --
    -- -   @group-id@ - The ID of the security group.
    --
    -- -   @group-name@ - The name of the security group.
    --
    -- -   @ip-permission.cidr@ - An IPv4 CIDR block for an inbound security
    --     group rule.
    --
    -- -   @ip-permission.from-port@ - For an inbound rule, the start of port
    --     range for the TCP and UDP protocols, or an ICMP type number.
    --
    -- -   @ip-permission.group-id@ - The ID of a security group that has been
    --     referenced in an inbound security group rule.
    --
    -- -   @ip-permission.group-name@ - The name of a security group that is
    --     referenced in an inbound security group rule.
    --
    -- -   @ip-permission.ipv6-cidr@ - An IPv6 CIDR block for an inbound
    --     security group rule.
    --
    -- -   @ip-permission.prefix-list-id@ - The ID of a prefix list from which
    --     a security group rule allows inbound access.
    --
    -- -   @ip-permission.protocol@ - The IP protocol for an inbound security
    --     group rule (@tcp@ | @udp@ | @icmp@, a protocol number, or -1 for all
    --     protocols).
    --
    -- -   @ip-permission.to-port@ - For an inbound rule, the end of port range
    --     for the TCP and UDP protocols, or an ICMP code.
    --
    -- -   @ip-permission.user-id@ - The ID of an Amazon Web Services account
    --     that has been referenced in an inbound security group rule.
    --
    -- -   @owner-id@ - The Amazon Web Services account ID of the owner of the
    --     security group.
    --
    -- -   @tag@:\<key> - The key\/value combination of a tag assigned to the
    --     resource. Use the tag key in the filter name and the tag value as
    --     the filter value. For example, to find all resources that have a tag
    --     with the key @Owner@ and the value @TeamA@, specify @tag:Owner@ for
    --     the filter name and @TeamA@ for the filter value.
    --
    -- -   @tag-key@ - The key of a tag assigned to the resource. Use this
    --     filter to find all resources assigned a tag with a specific key,
    --     regardless of the tag value.
    --
    -- -   @vpc-id@ - The ID of the VPC specified when the security group was
    --     created.
    DescribeSecurityGroups -> Maybe [Filter]
filters :: Prelude.Maybe [Filter],
    -- | The IDs of the security groups. Required for security groups in a
    -- nondefault VPC.
    --
    -- Default: Describes all of your security groups.
    DescribeSecurityGroups -> Maybe [Text]
groupIds :: Prelude.Maybe [Prelude.Text],
    -- | [EC2-Classic and default VPC only] The names of the security groups. You
    -- can specify either the security group name or the security group ID. For
    -- security groups in a nondefault VPC, use the @group-name@ filter to
    -- describe security groups by name.
    --
    -- Default: Describes all of your security groups.
    DescribeSecurityGroups -> Maybe [Text]
groupNames :: Prelude.Maybe [Prelude.Text],
    -- | The maximum number of results to return in a single call. To retrieve
    -- the remaining results, make another request with the returned
    -- @NextToken@ value. This value can be between 5 and 1000. If this
    -- parameter is not specified, then all results are returned.
    DescribeSecurityGroups -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token to request the next page of results.
    DescribeSecurityGroups -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text
  }
  deriving (DescribeSecurityGroups -> DescribeSecurityGroups -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeSecurityGroups -> DescribeSecurityGroups -> Bool
$c/= :: DescribeSecurityGroups -> DescribeSecurityGroups -> Bool
== :: DescribeSecurityGroups -> DescribeSecurityGroups -> Bool
$c== :: DescribeSecurityGroups -> DescribeSecurityGroups -> Bool
Prelude.Eq, ReadPrec [DescribeSecurityGroups]
ReadPrec DescribeSecurityGroups
Int -> ReadS DescribeSecurityGroups
ReadS [DescribeSecurityGroups]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeSecurityGroups]
$creadListPrec :: ReadPrec [DescribeSecurityGroups]
readPrec :: ReadPrec DescribeSecurityGroups
$creadPrec :: ReadPrec DescribeSecurityGroups
readList :: ReadS [DescribeSecurityGroups]
$creadList :: ReadS [DescribeSecurityGroups]
readsPrec :: Int -> ReadS DescribeSecurityGroups
$creadsPrec :: Int -> ReadS DescribeSecurityGroups
Prelude.Read, Int -> DescribeSecurityGroups -> ShowS
[DescribeSecurityGroups] -> ShowS
DescribeSecurityGroups -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeSecurityGroups] -> ShowS
$cshowList :: [DescribeSecurityGroups] -> ShowS
show :: DescribeSecurityGroups -> String
$cshow :: DescribeSecurityGroups -> String
showsPrec :: Int -> DescribeSecurityGroups -> ShowS
$cshowsPrec :: Int -> DescribeSecurityGroups -> ShowS
Prelude.Show, forall x. Rep DescribeSecurityGroups x -> DescribeSecurityGroups
forall x. DescribeSecurityGroups -> Rep DescribeSecurityGroups x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeSecurityGroups x -> DescribeSecurityGroups
$cfrom :: forall x. DescribeSecurityGroups -> Rep DescribeSecurityGroups x
Prelude.Generic)

-- |
-- Create a value of 'DescribeSecurityGroups' 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:
--
-- 'dryRun', 'describeSecurityGroups_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'filters', 'describeSecurityGroups_filters' - The filters. If using multiple filters for rules, the results include
-- security groups for which any combination of rules - not necessarily a
-- single rule - match all filters.
--
-- -   @description@ - The description of the security group.
--
-- -   @egress.ip-permission.cidr@ - An IPv4 CIDR block for an outbound
--     security group rule.
--
-- -   @egress.ip-permission.from-port@ - For an outbound rule, the start
--     of port range for the TCP and UDP protocols, or an ICMP type number.
--
-- -   @egress.ip-permission.group-id@ - The ID of a security group that
--     has been referenced in an outbound security group rule.
--
-- -   @egress.ip-permission.group-name@ - The name of a security group
--     that is referenced in an outbound security group rule.
--
-- -   @egress.ip-permission.ipv6-cidr@ - An IPv6 CIDR block for an
--     outbound security group rule.
--
-- -   @egress.ip-permission.prefix-list-id@ - The ID of a prefix list to
--     which a security group rule allows outbound access.
--
-- -   @egress.ip-permission.protocol@ - The IP protocol for an outbound
--     security group rule (@tcp@ | @udp@ | @icmp@, a protocol number, or
--     -1 for all protocols).
--
-- -   @egress.ip-permission.to-port@ - For an outbound rule, the end of
--     port range for the TCP and UDP protocols, or an ICMP code.
--
-- -   @egress.ip-permission.user-id@ - The ID of an Amazon Web Services
--     account that has been referenced in an outbound security group rule.
--
-- -   @group-id@ - The ID of the security group.
--
-- -   @group-name@ - The name of the security group.
--
-- -   @ip-permission.cidr@ - An IPv4 CIDR block for an inbound security
--     group rule.
--
-- -   @ip-permission.from-port@ - For an inbound rule, the start of port
--     range for the TCP and UDP protocols, or an ICMP type number.
--
-- -   @ip-permission.group-id@ - The ID of a security group that has been
--     referenced in an inbound security group rule.
--
-- -   @ip-permission.group-name@ - The name of a security group that is
--     referenced in an inbound security group rule.
--
-- -   @ip-permission.ipv6-cidr@ - An IPv6 CIDR block for an inbound
--     security group rule.
--
-- -   @ip-permission.prefix-list-id@ - The ID of a prefix list from which
--     a security group rule allows inbound access.
--
-- -   @ip-permission.protocol@ - The IP protocol for an inbound security
--     group rule (@tcp@ | @udp@ | @icmp@, a protocol number, or -1 for all
--     protocols).
--
-- -   @ip-permission.to-port@ - For an inbound rule, the end of port range
--     for the TCP and UDP protocols, or an ICMP code.
--
-- -   @ip-permission.user-id@ - The ID of an Amazon Web Services account
--     that has been referenced in an inbound security group rule.
--
-- -   @owner-id@ - The Amazon Web Services account ID of the owner of the
--     security group.
--
-- -   @tag@:\<key> - The key\/value combination of a tag assigned to the
--     resource. Use the tag key in the filter name and the tag value as
--     the filter value. For example, to find all resources that have a tag
--     with the key @Owner@ and the value @TeamA@, specify @tag:Owner@ for
--     the filter name and @TeamA@ for the filter value.
--
-- -   @tag-key@ - The key of a tag assigned to the resource. Use this
--     filter to find all resources assigned a tag with a specific key,
--     regardless of the tag value.
--
-- -   @vpc-id@ - The ID of the VPC specified when the security group was
--     created.
--
-- 'groupIds', 'describeSecurityGroups_groupIds' - The IDs of the security groups. Required for security groups in a
-- nondefault VPC.
--
-- Default: Describes all of your security groups.
--
-- 'groupNames', 'describeSecurityGroups_groupNames' - [EC2-Classic and default VPC only] The names of the security groups. You
-- can specify either the security group name or the security group ID. For
-- security groups in a nondefault VPC, use the @group-name@ filter to
-- describe security groups by name.
--
-- Default: Describes all of your security groups.
--
-- 'maxResults', 'describeSecurityGroups_maxResults' - The maximum number of results to return in a single call. To retrieve
-- the remaining results, make another request with the returned
-- @NextToken@ value. This value can be between 5 and 1000. If this
-- parameter is not specified, then all results are returned.
--
-- 'nextToken', 'describeSecurityGroups_nextToken' - The token to request the next page of results.
newDescribeSecurityGroups ::
  DescribeSecurityGroups
newDescribeSecurityGroups :: DescribeSecurityGroups
newDescribeSecurityGroups =
  DescribeSecurityGroups'
    { $sel:dryRun:DescribeSecurityGroups' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:filters:DescribeSecurityGroups' :: Maybe [Filter]
filters = forall a. Maybe a
Prelude.Nothing,
      $sel:groupIds:DescribeSecurityGroups' :: Maybe [Text]
groupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:groupNames:DescribeSecurityGroups' :: Maybe [Text]
groupNames = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:DescribeSecurityGroups' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:DescribeSecurityGroups' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
describeSecurityGroups_dryRun :: Lens.Lens' DescribeSecurityGroups (Prelude.Maybe Prelude.Bool)
describeSecurityGroups_dryRun :: Lens' DescribeSecurityGroups (Maybe Bool)
describeSecurityGroups_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecurityGroups' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: DescribeSecurityGroups
s@DescribeSecurityGroups' {} Maybe Bool
a -> DescribeSecurityGroups
s {$sel:dryRun:DescribeSecurityGroups' :: Maybe Bool
dryRun = Maybe Bool
a} :: DescribeSecurityGroups)

-- | The filters. If using multiple filters for rules, the results include
-- security groups for which any combination of rules - not necessarily a
-- single rule - match all filters.
--
-- -   @description@ - The description of the security group.
--
-- -   @egress.ip-permission.cidr@ - An IPv4 CIDR block for an outbound
--     security group rule.
--
-- -   @egress.ip-permission.from-port@ - For an outbound rule, the start
--     of port range for the TCP and UDP protocols, or an ICMP type number.
--
-- -   @egress.ip-permission.group-id@ - The ID of a security group that
--     has been referenced in an outbound security group rule.
--
-- -   @egress.ip-permission.group-name@ - The name of a security group
--     that is referenced in an outbound security group rule.
--
-- -   @egress.ip-permission.ipv6-cidr@ - An IPv6 CIDR block for an
--     outbound security group rule.
--
-- -   @egress.ip-permission.prefix-list-id@ - The ID of a prefix list to
--     which a security group rule allows outbound access.
--
-- -   @egress.ip-permission.protocol@ - The IP protocol for an outbound
--     security group rule (@tcp@ | @udp@ | @icmp@, a protocol number, or
--     -1 for all protocols).
--
-- -   @egress.ip-permission.to-port@ - For an outbound rule, the end of
--     port range for the TCP and UDP protocols, or an ICMP code.
--
-- -   @egress.ip-permission.user-id@ - The ID of an Amazon Web Services
--     account that has been referenced in an outbound security group rule.
--
-- -   @group-id@ - The ID of the security group.
--
-- -   @group-name@ - The name of the security group.
--
-- -   @ip-permission.cidr@ - An IPv4 CIDR block for an inbound security
--     group rule.
--
-- -   @ip-permission.from-port@ - For an inbound rule, the start of port
--     range for the TCP and UDP protocols, or an ICMP type number.
--
-- -   @ip-permission.group-id@ - The ID of a security group that has been
--     referenced in an inbound security group rule.
--
-- -   @ip-permission.group-name@ - The name of a security group that is
--     referenced in an inbound security group rule.
--
-- -   @ip-permission.ipv6-cidr@ - An IPv6 CIDR block for an inbound
--     security group rule.
--
-- -   @ip-permission.prefix-list-id@ - The ID of a prefix list from which
--     a security group rule allows inbound access.
--
-- -   @ip-permission.protocol@ - The IP protocol for an inbound security
--     group rule (@tcp@ | @udp@ | @icmp@, a protocol number, or -1 for all
--     protocols).
--
-- -   @ip-permission.to-port@ - For an inbound rule, the end of port range
--     for the TCP and UDP protocols, or an ICMP code.
--
-- -   @ip-permission.user-id@ - The ID of an Amazon Web Services account
--     that has been referenced in an inbound security group rule.
--
-- -   @owner-id@ - The Amazon Web Services account ID of the owner of the
--     security group.
--
-- -   @tag@:\<key> - The key\/value combination of a tag assigned to the
--     resource. Use the tag key in the filter name and the tag value as
--     the filter value. For example, to find all resources that have a tag
--     with the key @Owner@ and the value @TeamA@, specify @tag:Owner@ for
--     the filter name and @TeamA@ for the filter value.
--
-- -   @tag-key@ - The key of a tag assigned to the resource. Use this
--     filter to find all resources assigned a tag with a specific key,
--     regardless of the tag value.
--
-- -   @vpc-id@ - The ID of the VPC specified when the security group was
--     created.
describeSecurityGroups_filters :: Lens.Lens' DescribeSecurityGroups (Prelude.Maybe [Filter])
describeSecurityGroups_filters :: Lens' DescribeSecurityGroups (Maybe [Filter])
describeSecurityGroups_filters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecurityGroups' {Maybe [Filter]
filters :: Maybe [Filter]
$sel:filters:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe [Filter]
filters} -> Maybe [Filter]
filters) (\s :: DescribeSecurityGroups
s@DescribeSecurityGroups' {} Maybe [Filter]
a -> DescribeSecurityGroups
s {$sel:filters:DescribeSecurityGroups' :: Maybe [Filter]
filters = Maybe [Filter]
a} :: DescribeSecurityGroups) 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 IDs of the security groups. Required for security groups in a
-- nondefault VPC.
--
-- Default: Describes all of your security groups.
describeSecurityGroups_groupIds :: Lens.Lens' DescribeSecurityGroups (Prelude.Maybe [Prelude.Text])
describeSecurityGroups_groupIds :: Lens' DescribeSecurityGroups (Maybe [Text])
describeSecurityGroups_groupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecurityGroups' {Maybe [Text]
groupIds :: Maybe [Text]
$sel:groupIds:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe [Text]
groupIds} -> Maybe [Text]
groupIds) (\s :: DescribeSecurityGroups
s@DescribeSecurityGroups' {} Maybe [Text]
a -> DescribeSecurityGroups
s {$sel:groupIds:DescribeSecurityGroups' :: Maybe [Text]
groupIds = Maybe [Text]
a} :: DescribeSecurityGroups) 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

-- | [EC2-Classic and default VPC only] The names of the security groups. You
-- can specify either the security group name or the security group ID. For
-- security groups in a nondefault VPC, use the @group-name@ filter to
-- describe security groups by name.
--
-- Default: Describes all of your security groups.
describeSecurityGroups_groupNames :: Lens.Lens' DescribeSecurityGroups (Prelude.Maybe [Prelude.Text])
describeSecurityGroups_groupNames :: Lens' DescribeSecurityGroups (Maybe [Text])
describeSecurityGroups_groupNames = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecurityGroups' {Maybe [Text]
groupNames :: Maybe [Text]
$sel:groupNames:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe [Text]
groupNames} -> Maybe [Text]
groupNames) (\s :: DescribeSecurityGroups
s@DescribeSecurityGroups' {} Maybe [Text]
a -> DescribeSecurityGroups
s {$sel:groupNames:DescribeSecurityGroups' :: Maybe [Text]
groupNames = Maybe [Text]
a} :: DescribeSecurityGroups) 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 maximum number of results to return in a single call. To retrieve
-- the remaining results, make another request with the returned
-- @NextToken@ value. This value can be between 5 and 1000. If this
-- parameter is not specified, then all results are returned.
describeSecurityGroups_maxResults :: Lens.Lens' DescribeSecurityGroups (Prelude.Maybe Prelude.Natural)
describeSecurityGroups_maxResults :: Lens' DescribeSecurityGroups (Maybe Natural)
describeSecurityGroups_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecurityGroups' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: DescribeSecurityGroups
s@DescribeSecurityGroups' {} Maybe Natural
a -> DescribeSecurityGroups
s {$sel:maxResults:DescribeSecurityGroups' :: Maybe Natural
maxResults = Maybe Natural
a} :: DescribeSecurityGroups)

-- | The token to request the next page of results.
describeSecurityGroups_nextToken :: Lens.Lens' DescribeSecurityGroups (Prelude.Maybe Prelude.Text)
describeSecurityGroups_nextToken :: Lens' DescribeSecurityGroups (Maybe Text)
describeSecurityGroups_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecurityGroups' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeSecurityGroups
s@DescribeSecurityGroups' {} Maybe Text
a -> DescribeSecurityGroups
s {$sel:nextToken:DescribeSecurityGroups' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeSecurityGroups)

instance Core.AWSPager DescribeSecurityGroups where
  page :: DescribeSecurityGroups
-> AWSResponse DescribeSecurityGroups
-> Maybe DescribeSecurityGroups
page DescribeSecurityGroups
rq AWSResponse DescribeSecurityGroups
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeSecurityGroups
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeSecurityGroupsResponse (Maybe Text)
describeSecurityGroupsResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DescribeSecurityGroups
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeSecurityGroupsResponse (Maybe [SecurityGroup])
describeSecurityGroupsResponse_securityGroups
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ DescribeSecurityGroups
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DescribeSecurityGroups (Maybe Text)
describeSecurityGroups_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DescribeSecurityGroups
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DescribeSecurityGroupsResponse (Maybe Text)
describeSecurityGroupsResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest DescribeSecurityGroups where
  type
    AWSResponse DescribeSecurityGroups =
      DescribeSecurityGroupsResponse
  request :: (Service -> Service)
-> DescribeSecurityGroups -> Request DescribeSecurityGroups
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DescribeSecurityGroups
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeSecurityGroups)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe [SecurityGroup] -> Int -> DescribeSecurityGroupsResponse
DescribeSecurityGroupsResponse'
            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
"nextToken")
            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
"securityGroupInfo"
                            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")
                        )
            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 DescribeSecurityGroups where
  hashWithSalt :: Int -> DescribeSecurityGroups -> Int
hashWithSalt Int
_salt DescribeSecurityGroups' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe [Filter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
groupNames :: Maybe [Text]
groupIds :: Maybe [Text]
filters :: Maybe [Filter]
dryRun :: Maybe Bool
$sel:nextToken:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe Text
$sel:maxResults:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe Natural
$sel:groupNames:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe [Text]
$sel:groupIds:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe [Text]
$sel:filters:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe [Filter]
$sel:dryRun:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Filter]
filters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
groupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
groupNames
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken

instance Prelude.NFData DescribeSecurityGroups where
  rnf :: DescribeSecurityGroups -> ()
rnf DescribeSecurityGroups' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe [Filter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
groupNames :: Maybe [Text]
groupIds :: Maybe [Text]
filters :: Maybe [Filter]
dryRun :: Maybe Bool
$sel:nextToken:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe Text
$sel:maxResults:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe Natural
$sel:groupNames:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe [Text]
$sel:groupIds:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe [Text]
$sel:filters:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe [Filter]
$sel:dryRun:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Filter]
filters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
groupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
groupNames
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken

instance Data.ToHeaders DescribeSecurityGroups where
  toHeaders :: DescribeSecurityGroups -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DescribeSecurityGroups where
  toQuery :: DescribeSecurityGroups -> QueryString
toQuery DescribeSecurityGroups' {Maybe Bool
Maybe Natural
Maybe [Text]
Maybe [Filter]
Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
groupNames :: Maybe [Text]
groupIds :: Maybe [Text]
filters :: Maybe [Filter]
dryRun :: Maybe Bool
$sel:nextToken:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe Text
$sel:maxResults:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe Natural
$sel:groupNames:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe [Text]
$sel:groupIds:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe [Text]
$sel:filters:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe [Filter]
$sel:dryRun:DescribeSecurityGroups' :: DescribeSecurityGroups -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DescribeSecurityGroups" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Filter" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Filter]
filters),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"GroupId" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
groupIds),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"GroupName"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
groupNames
          ),
        ByteString
"MaxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"NextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | /See:/ 'newDescribeSecurityGroupsResponse' smart constructor.
data DescribeSecurityGroupsResponse = DescribeSecurityGroupsResponse'
  { -- | The token to use to retrieve the next page of results. This value is
    -- @null@ when there are no more results to return.
    DescribeSecurityGroupsResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Information about the security groups.
    DescribeSecurityGroupsResponse -> Maybe [SecurityGroup]
securityGroups :: Prelude.Maybe [SecurityGroup],
    -- | The response's http status code.
    DescribeSecurityGroupsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeSecurityGroupsResponse
-> DescribeSecurityGroupsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeSecurityGroupsResponse
-> DescribeSecurityGroupsResponse -> Bool
$c/= :: DescribeSecurityGroupsResponse
-> DescribeSecurityGroupsResponse -> Bool
== :: DescribeSecurityGroupsResponse
-> DescribeSecurityGroupsResponse -> Bool
$c== :: DescribeSecurityGroupsResponse
-> DescribeSecurityGroupsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeSecurityGroupsResponse]
ReadPrec DescribeSecurityGroupsResponse
Int -> ReadS DescribeSecurityGroupsResponse
ReadS [DescribeSecurityGroupsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeSecurityGroupsResponse]
$creadListPrec :: ReadPrec [DescribeSecurityGroupsResponse]
readPrec :: ReadPrec DescribeSecurityGroupsResponse
$creadPrec :: ReadPrec DescribeSecurityGroupsResponse
readList :: ReadS [DescribeSecurityGroupsResponse]
$creadList :: ReadS [DescribeSecurityGroupsResponse]
readsPrec :: Int -> ReadS DescribeSecurityGroupsResponse
$creadsPrec :: Int -> ReadS DescribeSecurityGroupsResponse
Prelude.Read, Int -> DescribeSecurityGroupsResponse -> ShowS
[DescribeSecurityGroupsResponse] -> ShowS
DescribeSecurityGroupsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeSecurityGroupsResponse] -> ShowS
$cshowList :: [DescribeSecurityGroupsResponse] -> ShowS
show :: DescribeSecurityGroupsResponse -> String
$cshow :: DescribeSecurityGroupsResponse -> String
showsPrec :: Int -> DescribeSecurityGroupsResponse -> ShowS
$cshowsPrec :: Int -> DescribeSecurityGroupsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeSecurityGroupsResponse x
-> DescribeSecurityGroupsResponse
forall x.
DescribeSecurityGroupsResponse
-> Rep DescribeSecurityGroupsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeSecurityGroupsResponse x
-> DescribeSecurityGroupsResponse
$cfrom :: forall x.
DescribeSecurityGroupsResponse
-> Rep DescribeSecurityGroupsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeSecurityGroupsResponse' 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:
--
-- 'nextToken', 'describeSecurityGroupsResponse_nextToken' - The token to use to retrieve the next page of results. This value is
-- @null@ when there are no more results to return.
--
-- 'securityGroups', 'describeSecurityGroupsResponse_securityGroups' - Information about the security groups.
--
-- 'httpStatus', 'describeSecurityGroupsResponse_httpStatus' - The response's http status code.
newDescribeSecurityGroupsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeSecurityGroupsResponse
newDescribeSecurityGroupsResponse :: Int -> DescribeSecurityGroupsResponse
newDescribeSecurityGroupsResponse Int
pHttpStatus_ =
  DescribeSecurityGroupsResponse'
    { $sel:nextToken:DescribeSecurityGroupsResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroups:DescribeSecurityGroupsResponse' :: Maybe [SecurityGroup]
securityGroups = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeSecurityGroupsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The token to use to retrieve the next page of results. This value is
-- @null@ when there are no more results to return.
describeSecurityGroupsResponse_nextToken :: Lens.Lens' DescribeSecurityGroupsResponse (Prelude.Maybe Prelude.Text)
describeSecurityGroupsResponse_nextToken :: Lens' DescribeSecurityGroupsResponse (Maybe Text)
describeSecurityGroupsResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecurityGroupsResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:DescribeSecurityGroupsResponse' :: DescribeSecurityGroupsResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: DescribeSecurityGroupsResponse
s@DescribeSecurityGroupsResponse' {} Maybe Text
a -> DescribeSecurityGroupsResponse
s {$sel:nextToken:DescribeSecurityGroupsResponse' :: Maybe Text
nextToken = Maybe Text
a} :: DescribeSecurityGroupsResponse)

-- | Information about the security groups.
describeSecurityGroupsResponse_securityGroups :: Lens.Lens' DescribeSecurityGroupsResponse (Prelude.Maybe [SecurityGroup])
describeSecurityGroupsResponse_securityGroups :: Lens' DescribeSecurityGroupsResponse (Maybe [SecurityGroup])
describeSecurityGroupsResponse_securityGroups = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecurityGroupsResponse' {Maybe [SecurityGroup]
securityGroups :: Maybe [SecurityGroup]
$sel:securityGroups:DescribeSecurityGroupsResponse' :: DescribeSecurityGroupsResponse -> Maybe [SecurityGroup]
securityGroups} -> Maybe [SecurityGroup]
securityGroups) (\s :: DescribeSecurityGroupsResponse
s@DescribeSecurityGroupsResponse' {} Maybe [SecurityGroup]
a -> DescribeSecurityGroupsResponse
s {$sel:securityGroups:DescribeSecurityGroupsResponse' :: Maybe [SecurityGroup]
securityGroups = Maybe [SecurityGroup]
a} :: DescribeSecurityGroupsResponse) 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 response's http status code.
describeSecurityGroupsResponse_httpStatus :: Lens.Lens' DescribeSecurityGroupsResponse Prelude.Int
describeSecurityGroupsResponse_httpStatus :: Lens' DescribeSecurityGroupsResponse Int
describeSecurityGroupsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSecurityGroupsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeSecurityGroupsResponse' :: DescribeSecurityGroupsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeSecurityGroupsResponse
s@DescribeSecurityGroupsResponse' {} Int
a -> DescribeSecurityGroupsResponse
s {$sel:httpStatus:DescribeSecurityGroupsResponse' :: Int
httpStatus = Int
a} :: DescribeSecurityGroupsResponse)

instance
  Prelude.NFData
    DescribeSecurityGroupsResponse
  where
  rnf :: DescribeSecurityGroupsResponse -> ()
rnf DescribeSecurityGroupsResponse' {Int
Maybe [SecurityGroup]
Maybe Text
httpStatus :: Int
securityGroups :: Maybe [SecurityGroup]
nextToken :: Maybe Text
$sel:httpStatus:DescribeSecurityGroupsResponse' :: DescribeSecurityGroupsResponse -> Int
$sel:securityGroups:DescribeSecurityGroupsResponse' :: DescribeSecurityGroupsResponse -> Maybe [SecurityGroup]
$sel:nextToken:DescribeSecurityGroupsResponse' :: DescribeSecurityGroupsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [SecurityGroup]
securityGroups
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus