{-# 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.RDS.Types.ConnectionPoolConfiguration
-- 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.RDS.Types.ConnectionPoolConfiguration 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

-- | Specifies the settings that control the size and behavior of the
-- connection pool associated with a @DBProxyTargetGroup@.
--
-- /See:/ 'newConnectionPoolConfiguration' smart constructor.
data ConnectionPoolConfiguration = ConnectionPoolConfiguration'
  { -- | The number of seconds for a proxy to wait for a connection to become
    -- available in the connection pool. Only applies when the proxy has opened
    -- its maximum number of connections and all connections are busy with
    -- client sessions.
    --
    -- Default: 120
    --
    -- Constraints: between 1 and 3600, or 0 representing unlimited
    ConnectionPoolConfiguration -> Maybe Int
connectionBorrowTimeout :: Prelude.Maybe Prelude.Int,
    -- | One or more SQL statements for the proxy to run when opening each new
    -- database connection. Typically used with @SET@ statements to make sure
    -- that each connection has identical settings such as time zone and
    -- character set. For multiple statements, use semicolons as the separator.
    -- You can also include multiple variables in a single @SET@ statement,
    -- such as @SET x=1, y=2@.
    --
    -- Default: no initialization query
    ConnectionPoolConfiguration -> Maybe Text
initQuery :: Prelude.Maybe Prelude.Text,
    -- | The maximum size of the connection pool for each target in a target
    -- group. The value is expressed as a percentage of the @max_connections@
    -- setting for the RDS DB instance or Aurora DB cluster used by the target
    -- group.
    --
    -- If you specify @MaxIdleConnectionsPercent@, then you must also include a
    -- value for this parameter.
    --
    -- Default: 10 for RDS for Microsoft SQL Server, and 100 for all other
    -- engines
    --
    -- Constraints: Must be between 1 and 100.
    ConnectionPoolConfiguration -> Maybe Int
maxConnectionsPercent :: Prelude.Maybe Prelude.Int,
    -- | Controls how actively the proxy closes idle database connections in the
    -- connection pool. The value is expressed as a percentage of the
    -- @max_connections@ setting for the RDS DB instance or Aurora DB cluster
    -- used by the target group. With a high value, the proxy leaves a high
    -- percentage of idle database connections open. A low value causes the
    -- proxy to close more idle connections and return them to the database.
    --
    -- If you specify this parameter, then you must also include a value for
    -- @MaxConnectionsPercent@.
    --
    -- Default: The default value is half of the value of
    -- @MaxConnectionsPercent@. For example, if @MaxConnectionsPercent@ is 80,
    -- then the default value of @MaxIdleConnectionsPercent@ is 40. If the
    -- value of @MaxConnectionsPercent@ isn\'t specified, then for SQL Server,
    -- @MaxIdleConnectionsPercent@ is 5, and for all other engines, the default
    -- is 50.
    --
    -- Constraints: Must be between 0 and the value of @MaxConnectionsPercent@.
    ConnectionPoolConfiguration -> Maybe Int
maxIdleConnectionsPercent :: Prelude.Maybe Prelude.Int,
    -- | Each item in the list represents a class of SQL operations that normally
    -- cause all later statements in a session using a proxy to be pinned to
    -- the same underlying database connection. Including an item in the list
    -- exempts that class of SQL operations from the pinning behavior.
    --
    -- Default: no session pinning filters
    ConnectionPoolConfiguration -> Maybe [Text]
sessionPinningFilters :: Prelude.Maybe [Prelude.Text]
  }
  deriving (ConnectionPoolConfiguration -> ConnectionPoolConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ConnectionPoolConfiguration -> ConnectionPoolConfiguration -> Bool
$c/= :: ConnectionPoolConfiguration -> ConnectionPoolConfiguration -> Bool
== :: ConnectionPoolConfiguration -> ConnectionPoolConfiguration -> Bool
$c== :: ConnectionPoolConfiguration -> ConnectionPoolConfiguration -> Bool
Prelude.Eq, ReadPrec [ConnectionPoolConfiguration]
ReadPrec ConnectionPoolConfiguration
Int -> ReadS ConnectionPoolConfiguration
ReadS [ConnectionPoolConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ConnectionPoolConfiguration]
$creadListPrec :: ReadPrec [ConnectionPoolConfiguration]
readPrec :: ReadPrec ConnectionPoolConfiguration
$creadPrec :: ReadPrec ConnectionPoolConfiguration
readList :: ReadS [ConnectionPoolConfiguration]
$creadList :: ReadS [ConnectionPoolConfiguration]
readsPrec :: Int -> ReadS ConnectionPoolConfiguration
$creadsPrec :: Int -> ReadS ConnectionPoolConfiguration
Prelude.Read, Int -> ConnectionPoolConfiguration -> ShowS
[ConnectionPoolConfiguration] -> ShowS
ConnectionPoolConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ConnectionPoolConfiguration] -> ShowS
$cshowList :: [ConnectionPoolConfiguration] -> ShowS
show :: ConnectionPoolConfiguration -> String
$cshow :: ConnectionPoolConfiguration -> String
showsPrec :: Int -> ConnectionPoolConfiguration -> ShowS
$cshowsPrec :: Int -> ConnectionPoolConfiguration -> ShowS
Prelude.Show, forall x.
Rep ConnectionPoolConfiguration x -> ConnectionPoolConfiguration
forall x.
ConnectionPoolConfiguration -> Rep ConnectionPoolConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ConnectionPoolConfiguration x -> ConnectionPoolConfiguration
$cfrom :: forall x.
ConnectionPoolConfiguration -> Rep ConnectionPoolConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'ConnectionPoolConfiguration' 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:
--
-- 'connectionBorrowTimeout', 'connectionPoolConfiguration_connectionBorrowTimeout' - The number of seconds for a proxy to wait for a connection to become
-- available in the connection pool. Only applies when the proxy has opened
-- its maximum number of connections and all connections are busy with
-- client sessions.
--
-- Default: 120
--
-- Constraints: between 1 and 3600, or 0 representing unlimited
--
-- 'initQuery', 'connectionPoolConfiguration_initQuery' - One or more SQL statements for the proxy to run when opening each new
-- database connection. Typically used with @SET@ statements to make sure
-- that each connection has identical settings such as time zone and
-- character set. For multiple statements, use semicolons as the separator.
-- You can also include multiple variables in a single @SET@ statement,
-- such as @SET x=1, y=2@.
--
-- Default: no initialization query
--
-- 'maxConnectionsPercent', 'connectionPoolConfiguration_maxConnectionsPercent' - The maximum size of the connection pool for each target in a target
-- group. The value is expressed as a percentage of the @max_connections@
-- setting for the RDS DB instance or Aurora DB cluster used by the target
-- group.
--
-- If you specify @MaxIdleConnectionsPercent@, then you must also include a
-- value for this parameter.
--
-- Default: 10 for RDS for Microsoft SQL Server, and 100 for all other
-- engines
--
-- Constraints: Must be between 1 and 100.
--
-- 'maxIdleConnectionsPercent', 'connectionPoolConfiguration_maxIdleConnectionsPercent' - Controls how actively the proxy closes idle database connections in the
-- connection pool. The value is expressed as a percentage of the
-- @max_connections@ setting for the RDS DB instance or Aurora DB cluster
-- used by the target group. With a high value, the proxy leaves a high
-- percentage of idle database connections open. A low value causes the
-- proxy to close more idle connections and return them to the database.
--
-- If you specify this parameter, then you must also include a value for
-- @MaxConnectionsPercent@.
--
-- Default: The default value is half of the value of
-- @MaxConnectionsPercent@. For example, if @MaxConnectionsPercent@ is 80,
-- then the default value of @MaxIdleConnectionsPercent@ is 40. If the
-- value of @MaxConnectionsPercent@ isn\'t specified, then for SQL Server,
-- @MaxIdleConnectionsPercent@ is 5, and for all other engines, the default
-- is 50.
--
-- Constraints: Must be between 0 and the value of @MaxConnectionsPercent@.
--
-- 'sessionPinningFilters', 'connectionPoolConfiguration_sessionPinningFilters' - Each item in the list represents a class of SQL operations that normally
-- cause all later statements in a session using a proxy to be pinned to
-- the same underlying database connection. Including an item in the list
-- exempts that class of SQL operations from the pinning behavior.
--
-- Default: no session pinning filters
newConnectionPoolConfiguration ::
  ConnectionPoolConfiguration
newConnectionPoolConfiguration :: ConnectionPoolConfiguration
newConnectionPoolConfiguration =
  ConnectionPoolConfiguration'
    { $sel:connectionBorrowTimeout:ConnectionPoolConfiguration' :: Maybe Int
connectionBorrowTimeout =
        forall a. Maybe a
Prelude.Nothing,
      $sel:initQuery:ConnectionPoolConfiguration' :: Maybe Text
initQuery = forall a. Maybe a
Prelude.Nothing,
      $sel:maxConnectionsPercent:ConnectionPoolConfiguration' :: Maybe Int
maxConnectionsPercent = forall a. Maybe a
Prelude.Nothing,
      $sel:maxIdleConnectionsPercent:ConnectionPoolConfiguration' :: Maybe Int
maxIdleConnectionsPercent = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionPinningFilters:ConnectionPoolConfiguration' :: Maybe [Text]
sessionPinningFilters = forall a. Maybe a
Prelude.Nothing
    }

-- | The number of seconds for a proxy to wait for a connection to become
-- available in the connection pool. Only applies when the proxy has opened
-- its maximum number of connections and all connections are busy with
-- client sessions.
--
-- Default: 120
--
-- Constraints: between 1 and 3600, or 0 representing unlimited
connectionPoolConfiguration_connectionBorrowTimeout :: Lens.Lens' ConnectionPoolConfiguration (Prelude.Maybe Prelude.Int)
connectionPoolConfiguration_connectionBorrowTimeout :: Lens' ConnectionPoolConfiguration (Maybe Int)
connectionPoolConfiguration_connectionBorrowTimeout = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectionPoolConfiguration' {Maybe Int
connectionBorrowTimeout :: Maybe Int
$sel:connectionBorrowTimeout:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Int
connectionBorrowTimeout} -> Maybe Int
connectionBorrowTimeout) (\s :: ConnectionPoolConfiguration
s@ConnectionPoolConfiguration' {} Maybe Int
a -> ConnectionPoolConfiguration
s {$sel:connectionBorrowTimeout:ConnectionPoolConfiguration' :: Maybe Int
connectionBorrowTimeout = Maybe Int
a} :: ConnectionPoolConfiguration)

-- | One or more SQL statements for the proxy to run when opening each new
-- database connection. Typically used with @SET@ statements to make sure
-- that each connection has identical settings such as time zone and
-- character set. For multiple statements, use semicolons as the separator.
-- You can also include multiple variables in a single @SET@ statement,
-- such as @SET x=1, y=2@.
--
-- Default: no initialization query
connectionPoolConfiguration_initQuery :: Lens.Lens' ConnectionPoolConfiguration (Prelude.Maybe Prelude.Text)
connectionPoolConfiguration_initQuery :: Lens' ConnectionPoolConfiguration (Maybe Text)
connectionPoolConfiguration_initQuery = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectionPoolConfiguration' {Maybe Text
initQuery :: Maybe Text
$sel:initQuery:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Text
initQuery} -> Maybe Text
initQuery) (\s :: ConnectionPoolConfiguration
s@ConnectionPoolConfiguration' {} Maybe Text
a -> ConnectionPoolConfiguration
s {$sel:initQuery:ConnectionPoolConfiguration' :: Maybe Text
initQuery = Maybe Text
a} :: ConnectionPoolConfiguration)

-- | The maximum size of the connection pool for each target in a target
-- group. The value is expressed as a percentage of the @max_connections@
-- setting for the RDS DB instance or Aurora DB cluster used by the target
-- group.
--
-- If you specify @MaxIdleConnectionsPercent@, then you must also include a
-- value for this parameter.
--
-- Default: 10 for RDS for Microsoft SQL Server, and 100 for all other
-- engines
--
-- Constraints: Must be between 1 and 100.
connectionPoolConfiguration_maxConnectionsPercent :: Lens.Lens' ConnectionPoolConfiguration (Prelude.Maybe Prelude.Int)
connectionPoolConfiguration_maxConnectionsPercent :: Lens' ConnectionPoolConfiguration (Maybe Int)
connectionPoolConfiguration_maxConnectionsPercent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectionPoolConfiguration' {Maybe Int
maxConnectionsPercent :: Maybe Int
$sel:maxConnectionsPercent:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Int
maxConnectionsPercent} -> Maybe Int
maxConnectionsPercent) (\s :: ConnectionPoolConfiguration
s@ConnectionPoolConfiguration' {} Maybe Int
a -> ConnectionPoolConfiguration
s {$sel:maxConnectionsPercent:ConnectionPoolConfiguration' :: Maybe Int
maxConnectionsPercent = Maybe Int
a} :: ConnectionPoolConfiguration)

-- | Controls how actively the proxy closes idle database connections in the
-- connection pool. The value is expressed as a percentage of the
-- @max_connections@ setting for the RDS DB instance or Aurora DB cluster
-- used by the target group. With a high value, the proxy leaves a high
-- percentage of idle database connections open. A low value causes the
-- proxy to close more idle connections and return them to the database.
--
-- If you specify this parameter, then you must also include a value for
-- @MaxConnectionsPercent@.
--
-- Default: The default value is half of the value of
-- @MaxConnectionsPercent@. For example, if @MaxConnectionsPercent@ is 80,
-- then the default value of @MaxIdleConnectionsPercent@ is 40. If the
-- value of @MaxConnectionsPercent@ isn\'t specified, then for SQL Server,
-- @MaxIdleConnectionsPercent@ is 5, and for all other engines, the default
-- is 50.
--
-- Constraints: Must be between 0 and the value of @MaxConnectionsPercent@.
connectionPoolConfiguration_maxIdleConnectionsPercent :: Lens.Lens' ConnectionPoolConfiguration (Prelude.Maybe Prelude.Int)
connectionPoolConfiguration_maxIdleConnectionsPercent :: Lens' ConnectionPoolConfiguration (Maybe Int)
connectionPoolConfiguration_maxIdleConnectionsPercent = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectionPoolConfiguration' {Maybe Int
maxIdleConnectionsPercent :: Maybe Int
$sel:maxIdleConnectionsPercent:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Int
maxIdleConnectionsPercent} -> Maybe Int
maxIdleConnectionsPercent) (\s :: ConnectionPoolConfiguration
s@ConnectionPoolConfiguration' {} Maybe Int
a -> ConnectionPoolConfiguration
s {$sel:maxIdleConnectionsPercent:ConnectionPoolConfiguration' :: Maybe Int
maxIdleConnectionsPercent = Maybe Int
a} :: ConnectionPoolConfiguration)

-- | Each item in the list represents a class of SQL operations that normally
-- cause all later statements in a session using a proxy to be pinned to
-- the same underlying database connection. Including an item in the list
-- exempts that class of SQL operations from the pinning behavior.
--
-- Default: no session pinning filters
connectionPoolConfiguration_sessionPinningFilters :: Lens.Lens' ConnectionPoolConfiguration (Prelude.Maybe [Prelude.Text])
connectionPoolConfiguration_sessionPinningFilters :: Lens' ConnectionPoolConfiguration (Maybe [Text])
connectionPoolConfiguration_sessionPinningFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ConnectionPoolConfiguration' {Maybe [Text]
sessionPinningFilters :: Maybe [Text]
$sel:sessionPinningFilters:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe [Text]
sessionPinningFilters} -> Maybe [Text]
sessionPinningFilters) (\s :: ConnectionPoolConfiguration
s@ConnectionPoolConfiguration' {} Maybe [Text]
a -> ConnectionPoolConfiguration
s {$sel:sessionPinningFilters:ConnectionPoolConfiguration' :: Maybe [Text]
sessionPinningFilters = Maybe [Text]
a} :: ConnectionPoolConfiguration) 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 Prelude.Hashable ConnectionPoolConfiguration where
  hashWithSalt :: Int -> ConnectionPoolConfiguration -> Int
hashWithSalt Int
_salt ConnectionPoolConfiguration' {Maybe Int
Maybe [Text]
Maybe Text
sessionPinningFilters :: Maybe [Text]
maxIdleConnectionsPercent :: Maybe Int
maxConnectionsPercent :: Maybe Int
initQuery :: Maybe Text
connectionBorrowTimeout :: Maybe Int
$sel:sessionPinningFilters:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe [Text]
$sel:maxIdleConnectionsPercent:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Int
$sel:maxConnectionsPercent:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Int
$sel:initQuery:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Text
$sel:connectionBorrowTimeout:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
connectionBorrowTimeout
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
initQuery
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxConnectionsPercent
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxIdleConnectionsPercent
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
sessionPinningFilters

instance Prelude.NFData ConnectionPoolConfiguration where
  rnf :: ConnectionPoolConfiguration -> ()
rnf ConnectionPoolConfiguration' {Maybe Int
Maybe [Text]
Maybe Text
sessionPinningFilters :: Maybe [Text]
maxIdleConnectionsPercent :: Maybe Int
maxConnectionsPercent :: Maybe Int
initQuery :: Maybe Text
connectionBorrowTimeout :: Maybe Int
$sel:sessionPinningFilters:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe [Text]
$sel:maxIdleConnectionsPercent:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Int
$sel:maxConnectionsPercent:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Int
$sel:initQuery:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Text
$sel:connectionBorrowTimeout:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
connectionBorrowTimeout
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
initQuery
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxConnectionsPercent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxIdleConnectionsPercent
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
sessionPinningFilters

instance Data.ToQuery ConnectionPoolConfiguration where
  toQuery :: ConnectionPoolConfiguration -> QueryString
toQuery ConnectionPoolConfiguration' {Maybe Int
Maybe [Text]
Maybe Text
sessionPinningFilters :: Maybe [Text]
maxIdleConnectionsPercent :: Maybe Int
maxConnectionsPercent :: Maybe Int
initQuery :: Maybe Text
connectionBorrowTimeout :: Maybe Int
$sel:sessionPinningFilters:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe [Text]
$sel:maxIdleConnectionsPercent:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Int
$sel:maxConnectionsPercent:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Int
$sel:initQuery:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Text
$sel:connectionBorrowTimeout:ConnectionPoolConfiguration' :: ConnectionPoolConfiguration -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"ConnectionBorrowTimeout"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
connectionBorrowTimeout,
        ByteString
"InitQuery" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
initQuery,
        ByteString
"MaxConnectionsPercent"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxConnectionsPercent,
        ByteString
"MaxIdleConnectionsPercent"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxIdleConnectionsPercent,
        ByteString
"SessionPinningFilters"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Text]
sessionPinningFilters
            )
      ]