{-# 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.NetworkFirewall.Types.MatchAttributes
-- 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.NetworkFirewall.Types.MatchAttributes where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.NetworkFirewall.Types.Address
import Amazonka.NetworkFirewall.Types.PortRange
import Amazonka.NetworkFirewall.Types.TCPFlagField
import qualified Amazonka.Prelude as Prelude

-- | Criteria for Network Firewall to use to inspect an individual packet in
-- stateless rule inspection. Each match attributes set can include one or
-- more items such as IP address, CIDR range, port number, protocol, and
-- TCP flags.
--
-- /See:/ 'newMatchAttributes' smart constructor.
data MatchAttributes = MatchAttributes'
  { -- | The destination ports to inspect for. If not specified, this matches
    -- with any destination port. This setting is only used for protocols 6
    -- (TCP) and 17 (UDP).
    --
    -- You can specify individual ports, for example @1994@ and you can specify
    -- port ranges, for example @1990:1994@.
    MatchAttributes -> Maybe [PortRange]
destinationPorts :: Prelude.Maybe [PortRange],
    -- | The destination IP addresses and address ranges to inspect for, in CIDR
    -- notation. If not specified, this matches with any destination address.
    MatchAttributes -> Maybe [Address]
destinations :: Prelude.Maybe [Address],
    -- | The protocols to inspect for, specified using each protocol\'s assigned
    -- internet protocol number (IANA). If not specified, this matches with any
    -- protocol.
    MatchAttributes -> Maybe [Natural]
protocols :: Prelude.Maybe [Prelude.Natural],
    -- | The source ports to inspect for. If not specified, this matches with any
    -- source port. This setting is only used for protocols 6 (TCP) and 17
    -- (UDP).
    --
    -- You can specify individual ports, for example @1994@ and you can specify
    -- port ranges, for example @1990:1994@.
    MatchAttributes -> Maybe [PortRange]
sourcePorts :: Prelude.Maybe [PortRange],
    -- | The source IP addresses and address ranges to inspect for, in CIDR
    -- notation. If not specified, this matches with any source address.
    MatchAttributes -> Maybe [Address]
sources :: Prelude.Maybe [Address],
    -- | The TCP flags and masks to inspect for. If not specified, this matches
    -- with any settings. This setting is only used for protocol 6 (TCP).
    MatchAttributes -> Maybe [TCPFlagField]
tCPFlags :: Prelude.Maybe [TCPFlagField]
  }
  deriving (MatchAttributes -> MatchAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: MatchAttributes -> MatchAttributes -> Bool
$c/= :: MatchAttributes -> MatchAttributes -> Bool
== :: MatchAttributes -> MatchAttributes -> Bool
$c== :: MatchAttributes -> MatchAttributes -> Bool
Prelude.Eq, ReadPrec [MatchAttributes]
ReadPrec MatchAttributes
Int -> ReadS MatchAttributes
ReadS [MatchAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [MatchAttributes]
$creadListPrec :: ReadPrec [MatchAttributes]
readPrec :: ReadPrec MatchAttributes
$creadPrec :: ReadPrec MatchAttributes
readList :: ReadS [MatchAttributes]
$creadList :: ReadS [MatchAttributes]
readsPrec :: Int -> ReadS MatchAttributes
$creadsPrec :: Int -> ReadS MatchAttributes
Prelude.Read, Int -> MatchAttributes -> ShowS
[MatchAttributes] -> ShowS
MatchAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [MatchAttributes] -> ShowS
$cshowList :: [MatchAttributes] -> ShowS
show :: MatchAttributes -> String
$cshow :: MatchAttributes -> String
showsPrec :: Int -> MatchAttributes -> ShowS
$cshowsPrec :: Int -> MatchAttributes -> ShowS
Prelude.Show, forall x. Rep MatchAttributes x -> MatchAttributes
forall x. MatchAttributes -> Rep MatchAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep MatchAttributes x -> MatchAttributes
$cfrom :: forall x. MatchAttributes -> Rep MatchAttributes x
Prelude.Generic)

-- |
-- Create a value of 'MatchAttributes' 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:
--
-- 'destinationPorts', 'matchAttributes_destinationPorts' - The destination ports to inspect for. If not specified, this matches
-- with any destination port. This setting is only used for protocols 6
-- (TCP) and 17 (UDP).
--
-- You can specify individual ports, for example @1994@ and you can specify
-- port ranges, for example @1990:1994@.
--
-- 'destinations', 'matchAttributes_destinations' - The destination IP addresses and address ranges to inspect for, in CIDR
-- notation. If not specified, this matches with any destination address.
--
-- 'protocols', 'matchAttributes_protocols' - The protocols to inspect for, specified using each protocol\'s assigned
-- internet protocol number (IANA). If not specified, this matches with any
-- protocol.
--
-- 'sourcePorts', 'matchAttributes_sourcePorts' - The source ports to inspect for. If not specified, this matches with any
-- source port. This setting is only used for protocols 6 (TCP) and 17
-- (UDP).
--
-- You can specify individual ports, for example @1994@ and you can specify
-- port ranges, for example @1990:1994@.
--
-- 'sources', 'matchAttributes_sources' - The source IP addresses and address ranges to inspect for, in CIDR
-- notation. If not specified, this matches with any source address.
--
-- 'tCPFlags', 'matchAttributes_tCPFlags' - The TCP flags and masks to inspect for. If not specified, this matches
-- with any settings. This setting is only used for protocol 6 (TCP).
newMatchAttributes ::
  MatchAttributes
newMatchAttributes :: MatchAttributes
newMatchAttributes =
  MatchAttributes'
    { $sel:destinationPorts:MatchAttributes' :: Maybe [PortRange]
destinationPorts =
        forall a. Maybe a
Prelude.Nothing,
      $sel:destinations:MatchAttributes' :: Maybe [Address]
destinations = forall a. Maybe a
Prelude.Nothing,
      $sel:protocols:MatchAttributes' :: Maybe [Natural]
protocols = forall a. Maybe a
Prelude.Nothing,
      $sel:sourcePorts:MatchAttributes' :: Maybe [PortRange]
sourcePorts = forall a. Maybe a
Prelude.Nothing,
      $sel:sources:MatchAttributes' :: Maybe [Address]
sources = forall a. Maybe a
Prelude.Nothing,
      $sel:tCPFlags:MatchAttributes' :: Maybe [TCPFlagField]
tCPFlags = forall a. Maybe a
Prelude.Nothing
    }

-- | The destination ports to inspect for. If not specified, this matches
-- with any destination port. This setting is only used for protocols 6
-- (TCP) and 17 (UDP).
--
-- You can specify individual ports, for example @1994@ and you can specify
-- port ranges, for example @1990:1994@.
matchAttributes_destinationPorts :: Lens.Lens' MatchAttributes (Prelude.Maybe [PortRange])
matchAttributes_destinationPorts :: Lens' MatchAttributes (Maybe [PortRange])
matchAttributes_destinationPorts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MatchAttributes' {Maybe [PortRange]
destinationPorts :: Maybe [PortRange]
$sel:destinationPorts:MatchAttributes' :: MatchAttributes -> Maybe [PortRange]
destinationPorts} -> Maybe [PortRange]
destinationPorts) (\s :: MatchAttributes
s@MatchAttributes' {} Maybe [PortRange]
a -> MatchAttributes
s {$sel:destinationPorts:MatchAttributes' :: Maybe [PortRange]
destinationPorts = Maybe [PortRange]
a} :: MatchAttributes) 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 destination IP addresses and address ranges to inspect for, in CIDR
-- notation. If not specified, this matches with any destination address.
matchAttributes_destinations :: Lens.Lens' MatchAttributes (Prelude.Maybe [Address])
matchAttributes_destinations :: Lens' MatchAttributes (Maybe [Address])
matchAttributes_destinations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MatchAttributes' {Maybe [Address]
destinations :: Maybe [Address]
$sel:destinations:MatchAttributes' :: MatchAttributes -> Maybe [Address]
destinations} -> Maybe [Address]
destinations) (\s :: MatchAttributes
s@MatchAttributes' {} Maybe [Address]
a -> MatchAttributes
s {$sel:destinations:MatchAttributes' :: Maybe [Address]
destinations = Maybe [Address]
a} :: MatchAttributes) 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 protocols to inspect for, specified using each protocol\'s assigned
-- internet protocol number (IANA). If not specified, this matches with any
-- protocol.
matchAttributes_protocols :: Lens.Lens' MatchAttributes (Prelude.Maybe [Prelude.Natural])
matchAttributes_protocols :: Lens' MatchAttributes (Maybe [Natural])
matchAttributes_protocols = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MatchAttributes' {Maybe [Natural]
protocols :: Maybe [Natural]
$sel:protocols:MatchAttributes' :: MatchAttributes -> Maybe [Natural]
protocols} -> Maybe [Natural]
protocols) (\s :: MatchAttributes
s@MatchAttributes' {} Maybe [Natural]
a -> MatchAttributes
s {$sel:protocols:MatchAttributes' :: Maybe [Natural]
protocols = Maybe [Natural]
a} :: MatchAttributes) 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 source ports to inspect for. If not specified, this matches with any
-- source port. This setting is only used for protocols 6 (TCP) and 17
-- (UDP).
--
-- You can specify individual ports, for example @1994@ and you can specify
-- port ranges, for example @1990:1994@.
matchAttributes_sourcePorts :: Lens.Lens' MatchAttributes (Prelude.Maybe [PortRange])
matchAttributes_sourcePorts :: Lens' MatchAttributes (Maybe [PortRange])
matchAttributes_sourcePorts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MatchAttributes' {Maybe [PortRange]
sourcePorts :: Maybe [PortRange]
$sel:sourcePorts:MatchAttributes' :: MatchAttributes -> Maybe [PortRange]
sourcePorts} -> Maybe [PortRange]
sourcePorts) (\s :: MatchAttributes
s@MatchAttributes' {} Maybe [PortRange]
a -> MatchAttributes
s {$sel:sourcePorts:MatchAttributes' :: Maybe [PortRange]
sourcePorts = Maybe [PortRange]
a} :: MatchAttributes) 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 source IP addresses and address ranges to inspect for, in CIDR
-- notation. If not specified, this matches with any source address.
matchAttributes_sources :: Lens.Lens' MatchAttributes (Prelude.Maybe [Address])
matchAttributes_sources :: Lens' MatchAttributes (Maybe [Address])
matchAttributes_sources = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MatchAttributes' {Maybe [Address]
sources :: Maybe [Address]
$sel:sources:MatchAttributes' :: MatchAttributes -> Maybe [Address]
sources} -> Maybe [Address]
sources) (\s :: MatchAttributes
s@MatchAttributes' {} Maybe [Address]
a -> MatchAttributes
s {$sel:sources:MatchAttributes' :: Maybe [Address]
sources = Maybe [Address]
a} :: MatchAttributes) 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 TCP flags and masks to inspect for. If not specified, this matches
-- with any settings. This setting is only used for protocol 6 (TCP).
matchAttributes_tCPFlags :: Lens.Lens' MatchAttributes (Prelude.Maybe [TCPFlagField])
matchAttributes_tCPFlags :: Lens' MatchAttributes (Maybe [TCPFlagField])
matchAttributes_tCPFlags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\MatchAttributes' {Maybe [TCPFlagField]
tCPFlags :: Maybe [TCPFlagField]
$sel:tCPFlags:MatchAttributes' :: MatchAttributes -> Maybe [TCPFlagField]
tCPFlags} -> Maybe [TCPFlagField]
tCPFlags) (\s :: MatchAttributes
s@MatchAttributes' {} Maybe [TCPFlagField]
a -> MatchAttributes
s {$sel:tCPFlags:MatchAttributes' :: Maybe [TCPFlagField]
tCPFlags = Maybe [TCPFlagField]
a} :: MatchAttributes) 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.FromJSON MatchAttributes where
  parseJSON :: Value -> Parser MatchAttributes
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"MatchAttributes"
      ( \Object
x ->
          Maybe [PortRange]
-> Maybe [Address]
-> Maybe [Natural]
-> Maybe [PortRange]
-> Maybe [Address]
-> Maybe [TCPFlagField]
-> MatchAttributes
MatchAttributes'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"DestinationPorts"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Destinations" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Protocols" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"SourcePorts" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Sources" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"TCPFlags" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable MatchAttributes where
  hashWithSalt :: Int -> MatchAttributes -> Int
hashWithSalt Int
_salt MatchAttributes' {Maybe [Natural]
Maybe [Address]
Maybe [PortRange]
Maybe [TCPFlagField]
tCPFlags :: Maybe [TCPFlagField]
sources :: Maybe [Address]
sourcePorts :: Maybe [PortRange]
protocols :: Maybe [Natural]
destinations :: Maybe [Address]
destinationPorts :: Maybe [PortRange]
$sel:tCPFlags:MatchAttributes' :: MatchAttributes -> Maybe [TCPFlagField]
$sel:sources:MatchAttributes' :: MatchAttributes -> Maybe [Address]
$sel:sourcePorts:MatchAttributes' :: MatchAttributes -> Maybe [PortRange]
$sel:protocols:MatchAttributes' :: MatchAttributes -> Maybe [Natural]
$sel:destinations:MatchAttributes' :: MatchAttributes -> Maybe [Address]
$sel:destinationPorts:MatchAttributes' :: MatchAttributes -> Maybe [PortRange]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PortRange]
destinationPorts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Address]
destinations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Natural]
protocols
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PortRange]
sourcePorts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Address]
sources
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TCPFlagField]
tCPFlags

instance Prelude.NFData MatchAttributes where
  rnf :: MatchAttributes -> ()
rnf MatchAttributes' {Maybe [Natural]
Maybe [Address]
Maybe [PortRange]
Maybe [TCPFlagField]
tCPFlags :: Maybe [TCPFlagField]
sources :: Maybe [Address]
sourcePorts :: Maybe [PortRange]
protocols :: Maybe [Natural]
destinations :: Maybe [Address]
destinationPorts :: Maybe [PortRange]
$sel:tCPFlags:MatchAttributes' :: MatchAttributes -> Maybe [TCPFlagField]
$sel:sources:MatchAttributes' :: MatchAttributes -> Maybe [Address]
$sel:sourcePorts:MatchAttributes' :: MatchAttributes -> Maybe [PortRange]
$sel:protocols:MatchAttributes' :: MatchAttributes -> Maybe [Natural]
$sel:destinations:MatchAttributes' :: MatchAttributes -> Maybe [Address]
$sel:destinationPorts:MatchAttributes' :: MatchAttributes -> Maybe [PortRange]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [PortRange]
destinationPorts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Address]
destinations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Natural]
protocols
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [PortRange]
sourcePorts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Address]
sources
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TCPFlagField]
tCPFlags

instance Data.ToJSON MatchAttributes where
  toJSON :: MatchAttributes -> Value
toJSON MatchAttributes' {Maybe [Natural]
Maybe [Address]
Maybe [PortRange]
Maybe [TCPFlagField]
tCPFlags :: Maybe [TCPFlagField]
sources :: Maybe [Address]
sourcePorts :: Maybe [PortRange]
protocols :: Maybe [Natural]
destinations :: Maybe [Address]
destinationPorts :: Maybe [PortRange]
$sel:tCPFlags:MatchAttributes' :: MatchAttributes -> Maybe [TCPFlagField]
$sel:sources:MatchAttributes' :: MatchAttributes -> Maybe [Address]
$sel:sourcePorts:MatchAttributes' :: MatchAttributes -> Maybe [PortRange]
$sel:protocols:MatchAttributes' :: MatchAttributes -> Maybe [Natural]
$sel:destinations:MatchAttributes' :: MatchAttributes -> Maybe [Address]
$sel:destinationPorts:MatchAttributes' :: MatchAttributes -> Maybe [PortRange]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DestinationPorts" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [PortRange]
destinationPorts,
            (Key
"Destinations" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Address]
destinations,
            (Key
"Protocols" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Natural]
protocols,
            (Key
"SourcePorts" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [PortRange]
sourcePorts,
            (Key
"Sources" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Address]
sources,
            (Key
"TCPFlags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TCPFlagField]
tCPFlags
          ]
      )