{-# 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.IpPermission
-- 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.IpPermission 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.IpRange
import Amazonka.EC2.Types.Ipv6Range
import Amazonka.EC2.Types.PrefixListId
import Amazonka.EC2.Types.UserIdGroupPair
import qualified Amazonka.Prelude as Prelude

-- | Describes a set of permissions for a security group rule.
--
-- /See:/ 'newIpPermission' smart constructor.
data IpPermission = IpPermission'
  { -- | The start of port range for the TCP and UDP protocols, or an
    -- ICMP\/ICMPv6 type number. A value of @-1@ indicates all ICMP\/ICMPv6
    -- types. If you specify all ICMP\/ICMPv6 types, you must specify all
    -- codes.
    IpPermission -> Maybe Int
fromPort :: Prelude.Maybe Prelude.Int,
    -- | The IPv4 ranges.
    IpPermission -> Maybe [IpRange]
ipRanges :: Prelude.Maybe [IpRange],
    -- | [VPC only] The IPv6 ranges.
    IpPermission -> Maybe [Ipv6Range]
ipv6Ranges :: Prelude.Maybe [Ipv6Range],
    -- | [VPC only] The prefix list IDs.
    IpPermission -> Maybe [PrefixListId]
prefixListIds :: Prelude.Maybe [PrefixListId],
    -- | The end of port range for the TCP and UDP protocols, or an ICMP\/ICMPv6
    -- code. A value of @-1@ indicates all ICMP\/ICMPv6 codes. If you specify
    -- all ICMP\/ICMPv6 types, you must specify all codes.
    IpPermission -> Maybe Int
toPort :: Prelude.Maybe Prelude.Int,
    -- | The security group and Amazon Web Services account ID pairs.
    IpPermission -> Maybe [UserIdGroupPair]
userIdGroupPairs :: Prelude.Maybe [UserIdGroupPair],
    -- | The IP protocol name (@tcp@, @udp@, @icmp@, @icmpv6@) or number (see
    -- <http://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml Protocol Numbers>).
    --
    -- [VPC only] Use @-1@ to specify all protocols. When authorizing security
    -- group rules, specifying @-1@ or a protocol number other than @tcp@,
    -- @udp@, @icmp@, or @icmpv6@ allows traffic on all ports, regardless of
    -- any port range you specify. For @tcp@, @udp@, and @icmp@, you must
    -- specify a port range. For @icmpv6@, the port range is optional; if you
    -- omit the port range, traffic for all types and codes is allowed.
    IpPermission -> Text
ipProtocol :: Prelude.Text
  }
  deriving (IpPermission -> IpPermission -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: IpPermission -> IpPermission -> Bool
$c/= :: IpPermission -> IpPermission -> Bool
== :: IpPermission -> IpPermission -> Bool
$c== :: IpPermission -> IpPermission -> Bool
Prelude.Eq, ReadPrec [IpPermission]
ReadPrec IpPermission
Int -> ReadS IpPermission
ReadS [IpPermission]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [IpPermission]
$creadListPrec :: ReadPrec [IpPermission]
readPrec :: ReadPrec IpPermission
$creadPrec :: ReadPrec IpPermission
readList :: ReadS [IpPermission]
$creadList :: ReadS [IpPermission]
readsPrec :: Int -> ReadS IpPermission
$creadsPrec :: Int -> ReadS IpPermission
Prelude.Read, Int -> IpPermission -> ShowS
[IpPermission] -> ShowS
IpPermission -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [IpPermission] -> ShowS
$cshowList :: [IpPermission] -> ShowS
show :: IpPermission -> String
$cshow :: IpPermission -> String
showsPrec :: Int -> IpPermission -> ShowS
$cshowsPrec :: Int -> IpPermission -> ShowS
Prelude.Show, forall x. Rep IpPermission x -> IpPermission
forall x. IpPermission -> Rep IpPermission x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep IpPermission x -> IpPermission
$cfrom :: forall x. IpPermission -> Rep IpPermission x
Prelude.Generic)

-- |
-- Create a value of 'IpPermission' 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:
--
-- 'fromPort', 'ipPermission_fromPort' - The start of port range for the TCP and UDP protocols, or an
-- ICMP\/ICMPv6 type number. A value of @-1@ indicates all ICMP\/ICMPv6
-- types. If you specify all ICMP\/ICMPv6 types, you must specify all
-- codes.
--
-- 'ipRanges', 'ipPermission_ipRanges' - The IPv4 ranges.
--
-- 'ipv6Ranges', 'ipPermission_ipv6Ranges' - [VPC only] The IPv6 ranges.
--
-- 'prefixListIds', 'ipPermission_prefixListIds' - [VPC only] The prefix list IDs.
--
-- 'toPort', 'ipPermission_toPort' - The end of port range for the TCP and UDP protocols, or an ICMP\/ICMPv6
-- code. A value of @-1@ indicates all ICMP\/ICMPv6 codes. If you specify
-- all ICMP\/ICMPv6 types, you must specify all codes.
--
-- 'userIdGroupPairs', 'ipPermission_userIdGroupPairs' - The security group and Amazon Web Services account ID pairs.
--
-- 'ipProtocol', 'ipPermission_ipProtocol' - The IP protocol name (@tcp@, @udp@, @icmp@, @icmpv6@) or number (see
-- <http://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml Protocol Numbers>).
--
-- [VPC only] Use @-1@ to specify all protocols. When authorizing security
-- group rules, specifying @-1@ or a protocol number other than @tcp@,
-- @udp@, @icmp@, or @icmpv6@ allows traffic on all ports, regardless of
-- any port range you specify. For @tcp@, @udp@, and @icmp@, you must
-- specify a port range. For @icmpv6@, the port range is optional; if you
-- omit the port range, traffic for all types and codes is allowed.
newIpPermission ::
  -- | 'ipProtocol'
  Prelude.Text ->
  IpPermission
newIpPermission :: Text -> IpPermission
newIpPermission Text
pIpProtocol_ =
  IpPermission'
    { $sel:fromPort:IpPermission' :: Maybe Int
fromPort = forall a. Maybe a
Prelude.Nothing,
      $sel:ipRanges:IpPermission' :: Maybe [IpRange]
ipRanges = forall a. Maybe a
Prelude.Nothing,
      $sel:ipv6Ranges:IpPermission' :: Maybe [Ipv6Range]
ipv6Ranges = forall a. Maybe a
Prelude.Nothing,
      $sel:prefixListIds:IpPermission' :: Maybe [PrefixListId]
prefixListIds = forall a. Maybe a
Prelude.Nothing,
      $sel:toPort:IpPermission' :: Maybe Int
toPort = forall a. Maybe a
Prelude.Nothing,
      $sel:userIdGroupPairs:IpPermission' :: Maybe [UserIdGroupPair]
userIdGroupPairs = forall a. Maybe a
Prelude.Nothing,
      $sel:ipProtocol:IpPermission' :: Text
ipProtocol = Text
pIpProtocol_
    }

-- | The start of port range for the TCP and UDP protocols, or an
-- ICMP\/ICMPv6 type number. A value of @-1@ indicates all ICMP\/ICMPv6
-- types. If you specify all ICMP\/ICMPv6 types, you must specify all
-- codes.
ipPermission_fromPort :: Lens.Lens' IpPermission (Prelude.Maybe Prelude.Int)
ipPermission_fromPort :: Lens' IpPermission (Maybe Int)
ipPermission_fromPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IpPermission' {Maybe Int
fromPort :: Maybe Int
$sel:fromPort:IpPermission' :: IpPermission -> Maybe Int
fromPort} -> Maybe Int
fromPort) (\s :: IpPermission
s@IpPermission' {} Maybe Int
a -> IpPermission
s {$sel:fromPort:IpPermission' :: Maybe Int
fromPort = Maybe Int
a} :: IpPermission)

-- | The IPv4 ranges.
ipPermission_ipRanges :: Lens.Lens' IpPermission (Prelude.Maybe [IpRange])
ipPermission_ipRanges :: Lens' IpPermission (Maybe [IpRange])
ipPermission_ipRanges = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IpPermission' {Maybe [IpRange]
ipRanges :: Maybe [IpRange]
$sel:ipRanges:IpPermission' :: IpPermission -> Maybe [IpRange]
ipRanges} -> Maybe [IpRange]
ipRanges) (\s :: IpPermission
s@IpPermission' {} Maybe [IpRange]
a -> IpPermission
s {$sel:ipRanges:IpPermission' :: Maybe [IpRange]
ipRanges = Maybe [IpRange]
a} :: IpPermission) 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

-- | [VPC only] The IPv6 ranges.
ipPermission_ipv6Ranges :: Lens.Lens' IpPermission (Prelude.Maybe [Ipv6Range])
ipPermission_ipv6Ranges :: Lens' IpPermission (Maybe [Ipv6Range])
ipPermission_ipv6Ranges = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IpPermission' {Maybe [Ipv6Range]
ipv6Ranges :: Maybe [Ipv6Range]
$sel:ipv6Ranges:IpPermission' :: IpPermission -> Maybe [Ipv6Range]
ipv6Ranges} -> Maybe [Ipv6Range]
ipv6Ranges) (\s :: IpPermission
s@IpPermission' {} Maybe [Ipv6Range]
a -> IpPermission
s {$sel:ipv6Ranges:IpPermission' :: Maybe [Ipv6Range]
ipv6Ranges = Maybe [Ipv6Range]
a} :: IpPermission) 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

-- | [VPC only] The prefix list IDs.
ipPermission_prefixListIds :: Lens.Lens' IpPermission (Prelude.Maybe [PrefixListId])
ipPermission_prefixListIds :: Lens' IpPermission (Maybe [PrefixListId])
ipPermission_prefixListIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IpPermission' {Maybe [PrefixListId]
prefixListIds :: Maybe [PrefixListId]
$sel:prefixListIds:IpPermission' :: IpPermission -> Maybe [PrefixListId]
prefixListIds} -> Maybe [PrefixListId]
prefixListIds) (\s :: IpPermission
s@IpPermission' {} Maybe [PrefixListId]
a -> IpPermission
s {$sel:prefixListIds:IpPermission' :: Maybe [PrefixListId]
prefixListIds = Maybe [PrefixListId]
a} :: IpPermission) 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 end of port range for the TCP and UDP protocols, or an ICMP\/ICMPv6
-- code. A value of @-1@ indicates all ICMP\/ICMPv6 codes. If you specify
-- all ICMP\/ICMPv6 types, you must specify all codes.
ipPermission_toPort :: Lens.Lens' IpPermission (Prelude.Maybe Prelude.Int)
ipPermission_toPort :: Lens' IpPermission (Maybe Int)
ipPermission_toPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IpPermission' {Maybe Int
toPort :: Maybe Int
$sel:toPort:IpPermission' :: IpPermission -> Maybe Int
toPort} -> Maybe Int
toPort) (\s :: IpPermission
s@IpPermission' {} Maybe Int
a -> IpPermission
s {$sel:toPort:IpPermission' :: Maybe Int
toPort = Maybe Int
a} :: IpPermission)

-- | The security group and Amazon Web Services account ID pairs.
ipPermission_userIdGroupPairs :: Lens.Lens' IpPermission (Prelude.Maybe [UserIdGroupPair])
ipPermission_userIdGroupPairs :: Lens' IpPermission (Maybe [UserIdGroupPair])
ipPermission_userIdGroupPairs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IpPermission' {Maybe [UserIdGroupPair]
userIdGroupPairs :: Maybe [UserIdGroupPair]
$sel:userIdGroupPairs:IpPermission' :: IpPermission -> Maybe [UserIdGroupPair]
userIdGroupPairs} -> Maybe [UserIdGroupPair]
userIdGroupPairs) (\s :: IpPermission
s@IpPermission' {} Maybe [UserIdGroupPair]
a -> IpPermission
s {$sel:userIdGroupPairs:IpPermission' :: Maybe [UserIdGroupPair]
userIdGroupPairs = Maybe [UserIdGroupPair]
a} :: IpPermission) 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 IP protocol name (@tcp@, @udp@, @icmp@, @icmpv6@) or number (see
-- <http://www.iana.org/assignments/protocol-numbers/protocol-numbers.xhtml Protocol Numbers>).
--
-- [VPC only] Use @-1@ to specify all protocols. When authorizing security
-- group rules, specifying @-1@ or a protocol number other than @tcp@,
-- @udp@, @icmp@, or @icmpv6@ allows traffic on all ports, regardless of
-- any port range you specify. For @tcp@, @udp@, and @icmp@, you must
-- specify a port range. For @icmpv6@, the port range is optional; if you
-- omit the port range, traffic for all types and codes is allowed.
ipPermission_ipProtocol :: Lens.Lens' IpPermission Prelude.Text
ipPermission_ipProtocol :: Lens' IpPermission Text
ipPermission_ipProtocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\IpPermission' {Text
ipProtocol :: Text
$sel:ipProtocol:IpPermission' :: IpPermission -> Text
ipProtocol} -> Text
ipProtocol) (\s :: IpPermission
s@IpPermission' {} Text
a -> IpPermission
s {$sel:ipProtocol:IpPermission' :: Text
ipProtocol = Text
a} :: IpPermission)

instance Data.FromXML IpPermission where
  parseXML :: [Node] -> Either String IpPermission
parseXML [Node]
x =
    Maybe Int
-> Maybe [IpRange]
-> Maybe [Ipv6Range]
-> Maybe [PrefixListId]
-> Maybe Int
-> Maybe [UserIdGroupPair]
-> Text
-> IpPermission
IpPermission'
      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
"fromPort")
      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
"item")
                  )
      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
"ipv6Ranges"
                      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.<*> ( [Node]
x
                      forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"prefixListIds"
                      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.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"toPort")
      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
"groups"
                      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.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"ipProtocol")

instance Prelude.Hashable IpPermission where
  hashWithSalt :: Int -> IpPermission -> Int
hashWithSalt Int
_salt IpPermission' {Maybe Int
Maybe [IpRange]
Maybe [Ipv6Range]
Maybe [PrefixListId]
Maybe [UserIdGroupPair]
Text
ipProtocol :: Text
userIdGroupPairs :: Maybe [UserIdGroupPair]
toPort :: Maybe Int
prefixListIds :: Maybe [PrefixListId]
ipv6Ranges :: Maybe [Ipv6Range]
ipRanges :: Maybe [IpRange]
fromPort :: Maybe Int
$sel:ipProtocol:IpPermission' :: IpPermission -> Text
$sel:userIdGroupPairs:IpPermission' :: IpPermission -> Maybe [UserIdGroupPair]
$sel:toPort:IpPermission' :: IpPermission -> Maybe Int
$sel:prefixListIds:IpPermission' :: IpPermission -> Maybe [PrefixListId]
$sel:ipv6Ranges:IpPermission' :: IpPermission -> Maybe [Ipv6Range]
$sel:ipRanges:IpPermission' :: IpPermission -> Maybe [IpRange]
$sel:fromPort:IpPermission' :: IpPermission -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
fromPort
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [IpRange]
ipRanges
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Ipv6Range]
ipv6Ranges
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PrefixListId]
prefixListIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
toPort
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [UserIdGroupPair]
userIdGroupPairs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
ipProtocol

instance Prelude.NFData IpPermission where
  rnf :: IpPermission -> ()
rnf IpPermission' {Maybe Int
Maybe [IpRange]
Maybe [Ipv6Range]
Maybe [PrefixListId]
Maybe [UserIdGroupPair]
Text
ipProtocol :: Text
userIdGroupPairs :: Maybe [UserIdGroupPair]
toPort :: Maybe Int
prefixListIds :: Maybe [PrefixListId]
ipv6Ranges :: Maybe [Ipv6Range]
ipRanges :: Maybe [IpRange]
fromPort :: Maybe Int
$sel:ipProtocol:IpPermission' :: IpPermission -> Text
$sel:userIdGroupPairs:IpPermission' :: IpPermission -> Maybe [UserIdGroupPair]
$sel:toPort:IpPermission' :: IpPermission -> Maybe Int
$sel:prefixListIds:IpPermission' :: IpPermission -> Maybe [PrefixListId]
$sel:ipv6Ranges:IpPermission' :: IpPermission -> Maybe [Ipv6Range]
$sel:ipRanges:IpPermission' :: IpPermission -> Maybe [IpRange]
$sel:fromPort:IpPermission' :: IpPermission -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
fromPort
      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 [Ipv6Range]
ipv6Ranges
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PrefixListId]
prefixListIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
toPort
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UserIdGroupPair]
userIdGroupPairs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ipProtocol

instance Data.ToQuery IpPermission where
  toQuery :: IpPermission -> QueryString
toQuery IpPermission' {Maybe Int
Maybe [IpRange]
Maybe [Ipv6Range]
Maybe [PrefixListId]
Maybe [UserIdGroupPair]
Text
ipProtocol :: Text
userIdGroupPairs :: Maybe [UserIdGroupPair]
toPort :: Maybe Int
prefixListIds :: Maybe [PrefixListId]
ipv6Ranges :: Maybe [Ipv6Range]
ipRanges :: Maybe [IpRange]
fromPort :: Maybe Int
$sel:ipProtocol:IpPermission' :: IpPermission -> Text
$sel:userIdGroupPairs:IpPermission' :: IpPermission -> Maybe [UserIdGroupPair]
$sel:toPort:IpPermission' :: IpPermission -> Maybe Int
$sel:prefixListIds:IpPermission' :: IpPermission -> Maybe [PrefixListId]
$sel:ipv6Ranges:IpPermission' :: IpPermission -> Maybe [Ipv6Range]
$sel:ipRanges:IpPermission' :: IpPermission -> Maybe [IpRange]
$sel:fromPort:IpPermission' :: IpPermission -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"FromPort" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
fromPort,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"IpRanges" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [IpRange]
ipRanges),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Ipv6Ranges"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Ipv6Range]
ipv6Ranges
          ),
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"PrefixListIds"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [PrefixListId]
prefixListIds
          ),
        ByteString
"ToPort" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
toPort,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"Groups"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [UserIdGroupPair]
userIdGroupPairs
          ),
        ByteString
"IpProtocol" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
ipProtocol
      ]