{-# 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.Chime.CreateProxySession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a proxy session on the specified Amazon Chime Voice Connector
-- for the specified participant phone numbers.
module Amazonka.Chime.CreateProxySession
  ( -- * Creating a Request
    CreateProxySession (..),
    newCreateProxySession,

    -- * Request Lenses
    createProxySession_expiryMinutes,
    createProxySession_geoMatchLevel,
    createProxySession_geoMatchParams,
    createProxySession_name,
    createProxySession_numberSelectionBehavior,
    createProxySession_participantPhoneNumbers,
    createProxySession_capabilities,
    createProxySession_voiceConnectorId,

    -- * Destructuring the Response
    CreateProxySessionResponse (..),
    newCreateProxySessionResponse,

    -- * Response Lenses
    createProxySessionResponse_proxySession,
    createProxySessionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateProxySession' smart constructor.
data CreateProxySession = CreateProxySession'
  { -- | The number of minutes allowed for the proxy session.
    CreateProxySession -> Maybe Natural
expiryMinutes :: Prelude.Maybe Prelude.Natural,
    -- | The preference for matching the country or area code of the proxy phone
    -- number with that of the first participant.
    CreateProxySession -> Maybe GeoMatchLevel
geoMatchLevel :: Prelude.Maybe GeoMatchLevel,
    -- | The country and area code for the proxy phone number.
    CreateProxySession -> Maybe GeoMatchParams
geoMatchParams :: Prelude.Maybe GeoMatchParams,
    -- | The name of the proxy session.
    CreateProxySession -> Maybe (Sensitive Text)
name :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The preference for proxy phone number reuse, or stickiness, between the
    -- same participants across sessions.
    CreateProxySession -> Maybe NumberSelectionBehavior
numberSelectionBehavior :: Prelude.Maybe NumberSelectionBehavior,
    -- | The participant phone numbers.
    CreateProxySession -> NonEmpty (Sensitive Text)
participantPhoneNumbers :: Prelude.NonEmpty (Data.Sensitive Prelude.Text),
    -- | The proxy session capabilities.
    CreateProxySession -> [Capability]
capabilities :: [Capability],
    -- | The Amazon Chime voice connector ID.
    CreateProxySession -> Text
voiceConnectorId :: Prelude.Text
  }
  deriving (CreateProxySession -> CreateProxySession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateProxySession -> CreateProxySession -> Bool
$c/= :: CreateProxySession -> CreateProxySession -> Bool
== :: CreateProxySession -> CreateProxySession -> Bool
$c== :: CreateProxySession -> CreateProxySession -> Bool
Prelude.Eq, Int -> CreateProxySession -> ShowS
[CreateProxySession] -> ShowS
CreateProxySession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateProxySession] -> ShowS
$cshowList :: [CreateProxySession] -> ShowS
show :: CreateProxySession -> String
$cshow :: CreateProxySession -> String
showsPrec :: Int -> CreateProxySession -> ShowS
$cshowsPrec :: Int -> CreateProxySession -> ShowS
Prelude.Show, forall x. Rep CreateProxySession x -> CreateProxySession
forall x. CreateProxySession -> Rep CreateProxySession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateProxySession x -> CreateProxySession
$cfrom :: forall x. CreateProxySession -> Rep CreateProxySession x
Prelude.Generic)

-- |
-- Create a value of 'CreateProxySession' 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:
--
-- 'expiryMinutes', 'createProxySession_expiryMinutes' - The number of minutes allowed for the proxy session.
--
-- 'geoMatchLevel', 'createProxySession_geoMatchLevel' - The preference for matching the country or area code of the proxy phone
-- number with that of the first participant.
--
-- 'geoMatchParams', 'createProxySession_geoMatchParams' - The country and area code for the proxy phone number.
--
-- 'name', 'createProxySession_name' - The name of the proxy session.
--
-- 'numberSelectionBehavior', 'createProxySession_numberSelectionBehavior' - The preference for proxy phone number reuse, or stickiness, between the
-- same participants across sessions.
--
-- 'participantPhoneNumbers', 'createProxySession_participantPhoneNumbers' - The participant phone numbers.
--
-- 'capabilities', 'createProxySession_capabilities' - The proxy session capabilities.
--
-- 'voiceConnectorId', 'createProxySession_voiceConnectorId' - The Amazon Chime voice connector ID.
newCreateProxySession ::
  -- | 'participantPhoneNumbers'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'voiceConnectorId'
  Prelude.Text ->
  CreateProxySession
newCreateProxySession :: NonEmpty Text -> Text -> CreateProxySession
newCreateProxySession
  NonEmpty Text
pParticipantPhoneNumbers_
  Text
pVoiceConnectorId_ =
    CreateProxySession'
      { $sel:expiryMinutes:CreateProxySession' :: Maybe Natural
expiryMinutes =
          forall a. Maybe a
Prelude.Nothing,
        $sel:geoMatchLevel:CreateProxySession' :: Maybe GeoMatchLevel
geoMatchLevel = forall a. Maybe a
Prelude.Nothing,
        $sel:geoMatchParams:CreateProxySession' :: Maybe GeoMatchParams
geoMatchParams = forall a. Maybe a
Prelude.Nothing,
        $sel:name:CreateProxySession' :: Maybe (Sensitive Text)
name = forall a. Maybe a
Prelude.Nothing,
        $sel:numberSelectionBehavior:CreateProxySession' :: Maybe NumberSelectionBehavior
numberSelectionBehavior = forall a. Maybe a
Prelude.Nothing,
        $sel:participantPhoneNumbers:CreateProxySession' :: NonEmpty (Sensitive Text)
participantPhoneNumbers =
          forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pParticipantPhoneNumbers_,
        $sel:capabilities:CreateProxySession' :: [Capability]
capabilities = forall a. Monoid a => a
Prelude.mempty,
        $sel:voiceConnectorId:CreateProxySession' :: Text
voiceConnectorId = Text
pVoiceConnectorId_
      }

-- | The number of minutes allowed for the proxy session.
createProxySession_expiryMinutes :: Lens.Lens' CreateProxySession (Prelude.Maybe Prelude.Natural)
createProxySession_expiryMinutes :: Lens' CreateProxySession (Maybe Natural)
createProxySession_expiryMinutes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProxySession' {Maybe Natural
expiryMinutes :: Maybe Natural
$sel:expiryMinutes:CreateProxySession' :: CreateProxySession -> Maybe Natural
expiryMinutes} -> Maybe Natural
expiryMinutes) (\s :: CreateProxySession
s@CreateProxySession' {} Maybe Natural
a -> CreateProxySession
s {$sel:expiryMinutes:CreateProxySession' :: Maybe Natural
expiryMinutes = Maybe Natural
a} :: CreateProxySession)

-- | The preference for matching the country or area code of the proxy phone
-- number with that of the first participant.
createProxySession_geoMatchLevel :: Lens.Lens' CreateProxySession (Prelude.Maybe GeoMatchLevel)
createProxySession_geoMatchLevel :: Lens' CreateProxySession (Maybe GeoMatchLevel)
createProxySession_geoMatchLevel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProxySession' {Maybe GeoMatchLevel
geoMatchLevel :: Maybe GeoMatchLevel
$sel:geoMatchLevel:CreateProxySession' :: CreateProxySession -> Maybe GeoMatchLevel
geoMatchLevel} -> Maybe GeoMatchLevel
geoMatchLevel) (\s :: CreateProxySession
s@CreateProxySession' {} Maybe GeoMatchLevel
a -> CreateProxySession
s {$sel:geoMatchLevel:CreateProxySession' :: Maybe GeoMatchLevel
geoMatchLevel = Maybe GeoMatchLevel
a} :: CreateProxySession)

-- | The country and area code for the proxy phone number.
createProxySession_geoMatchParams :: Lens.Lens' CreateProxySession (Prelude.Maybe GeoMatchParams)
createProxySession_geoMatchParams :: Lens' CreateProxySession (Maybe GeoMatchParams)
createProxySession_geoMatchParams = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProxySession' {Maybe GeoMatchParams
geoMatchParams :: Maybe GeoMatchParams
$sel:geoMatchParams:CreateProxySession' :: CreateProxySession -> Maybe GeoMatchParams
geoMatchParams} -> Maybe GeoMatchParams
geoMatchParams) (\s :: CreateProxySession
s@CreateProxySession' {} Maybe GeoMatchParams
a -> CreateProxySession
s {$sel:geoMatchParams:CreateProxySession' :: Maybe GeoMatchParams
geoMatchParams = Maybe GeoMatchParams
a} :: CreateProxySession)

-- | The name of the proxy session.
createProxySession_name :: Lens.Lens' CreateProxySession (Prelude.Maybe Prelude.Text)
createProxySession_name :: Lens' CreateProxySession (Maybe Text)
createProxySession_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProxySession' {Maybe (Sensitive Text)
name :: Maybe (Sensitive Text)
$sel:name:CreateProxySession' :: CreateProxySession -> Maybe (Sensitive Text)
name} -> Maybe (Sensitive Text)
name) (\s :: CreateProxySession
s@CreateProxySession' {} Maybe (Sensitive Text)
a -> CreateProxySession
s {$sel:name:CreateProxySession' :: Maybe (Sensitive Text)
name = Maybe (Sensitive Text)
a} :: CreateProxySession) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | The preference for proxy phone number reuse, or stickiness, between the
-- same participants across sessions.
createProxySession_numberSelectionBehavior :: Lens.Lens' CreateProxySession (Prelude.Maybe NumberSelectionBehavior)
createProxySession_numberSelectionBehavior :: Lens' CreateProxySession (Maybe NumberSelectionBehavior)
createProxySession_numberSelectionBehavior = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProxySession' {Maybe NumberSelectionBehavior
numberSelectionBehavior :: Maybe NumberSelectionBehavior
$sel:numberSelectionBehavior:CreateProxySession' :: CreateProxySession -> Maybe NumberSelectionBehavior
numberSelectionBehavior} -> Maybe NumberSelectionBehavior
numberSelectionBehavior) (\s :: CreateProxySession
s@CreateProxySession' {} Maybe NumberSelectionBehavior
a -> CreateProxySession
s {$sel:numberSelectionBehavior:CreateProxySession' :: Maybe NumberSelectionBehavior
numberSelectionBehavior = Maybe NumberSelectionBehavior
a} :: CreateProxySession)

-- | The participant phone numbers.
createProxySession_participantPhoneNumbers :: Lens.Lens' CreateProxySession (Prelude.NonEmpty Prelude.Text)
createProxySession_participantPhoneNumbers :: Lens' CreateProxySession (NonEmpty Text)
createProxySession_participantPhoneNumbers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProxySession' {NonEmpty (Sensitive Text)
participantPhoneNumbers :: NonEmpty (Sensitive Text)
$sel:participantPhoneNumbers:CreateProxySession' :: CreateProxySession -> NonEmpty (Sensitive Text)
participantPhoneNumbers} -> NonEmpty (Sensitive Text)
participantPhoneNumbers) (\s :: CreateProxySession
s@CreateProxySession' {} NonEmpty (Sensitive Text)
a -> CreateProxySession
s {$sel:participantPhoneNumbers:CreateProxySession' :: NonEmpty (Sensitive Text)
participantPhoneNumbers = NonEmpty (Sensitive Text)
a} :: CreateProxySession) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The proxy session capabilities.
createProxySession_capabilities :: Lens.Lens' CreateProxySession [Capability]
createProxySession_capabilities :: Lens' CreateProxySession [Capability]
createProxySession_capabilities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProxySession' {[Capability]
capabilities :: [Capability]
$sel:capabilities:CreateProxySession' :: CreateProxySession -> [Capability]
capabilities} -> [Capability]
capabilities) (\s :: CreateProxySession
s@CreateProxySession' {} [Capability]
a -> CreateProxySession
s {$sel:capabilities:CreateProxySession' :: [Capability]
capabilities = [Capability]
a} :: CreateProxySession) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The Amazon Chime voice connector ID.
createProxySession_voiceConnectorId :: Lens.Lens' CreateProxySession Prelude.Text
createProxySession_voiceConnectorId :: Lens' CreateProxySession Text
createProxySession_voiceConnectorId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProxySession' {Text
voiceConnectorId :: Text
$sel:voiceConnectorId:CreateProxySession' :: CreateProxySession -> Text
voiceConnectorId} -> Text
voiceConnectorId) (\s :: CreateProxySession
s@CreateProxySession' {} Text
a -> CreateProxySession
s {$sel:voiceConnectorId:CreateProxySession' :: Text
voiceConnectorId = Text
a} :: CreateProxySession)

instance Core.AWSRequest CreateProxySession where
  type
    AWSResponse CreateProxySession =
      CreateProxySessionResponse
  request :: (Service -> Service)
-> CreateProxySession -> Request CreateProxySession
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateProxySession
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateProxySession)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe ProxySession -> Int -> CreateProxySessionResponse
CreateProxySessionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"ProxySession")
            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 CreateProxySession where
  hashWithSalt :: Int -> CreateProxySession -> Int
hashWithSalt Int
_salt CreateProxySession' {[Capability]
Maybe Natural
Maybe (Sensitive Text)
Maybe GeoMatchLevel
Maybe GeoMatchParams
Maybe NumberSelectionBehavior
NonEmpty (Sensitive Text)
Text
voiceConnectorId :: Text
capabilities :: [Capability]
participantPhoneNumbers :: NonEmpty (Sensitive Text)
numberSelectionBehavior :: Maybe NumberSelectionBehavior
name :: Maybe (Sensitive Text)
geoMatchParams :: Maybe GeoMatchParams
geoMatchLevel :: Maybe GeoMatchLevel
expiryMinutes :: Maybe Natural
$sel:voiceConnectorId:CreateProxySession' :: CreateProxySession -> Text
$sel:capabilities:CreateProxySession' :: CreateProxySession -> [Capability]
$sel:participantPhoneNumbers:CreateProxySession' :: CreateProxySession -> NonEmpty (Sensitive Text)
$sel:numberSelectionBehavior:CreateProxySession' :: CreateProxySession -> Maybe NumberSelectionBehavior
$sel:name:CreateProxySession' :: CreateProxySession -> Maybe (Sensitive Text)
$sel:geoMatchParams:CreateProxySession' :: CreateProxySession -> Maybe GeoMatchParams
$sel:geoMatchLevel:CreateProxySession' :: CreateProxySession -> Maybe GeoMatchLevel
$sel:expiryMinutes:CreateProxySession' :: CreateProxySession -> Maybe Natural
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
expiryMinutes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GeoMatchLevel
geoMatchLevel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe GeoMatchParams
geoMatchParams
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe NumberSelectionBehavior
numberSelectionBehavior
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty (Sensitive Text)
participantPhoneNumbers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Capability]
capabilities
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
voiceConnectorId

instance Prelude.NFData CreateProxySession where
  rnf :: CreateProxySession -> ()
rnf CreateProxySession' {[Capability]
Maybe Natural
Maybe (Sensitive Text)
Maybe GeoMatchLevel
Maybe GeoMatchParams
Maybe NumberSelectionBehavior
NonEmpty (Sensitive Text)
Text
voiceConnectorId :: Text
capabilities :: [Capability]
participantPhoneNumbers :: NonEmpty (Sensitive Text)
numberSelectionBehavior :: Maybe NumberSelectionBehavior
name :: Maybe (Sensitive Text)
geoMatchParams :: Maybe GeoMatchParams
geoMatchLevel :: Maybe GeoMatchLevel
expiryMinutes :: Maybe Natural
$sel:voiceConnectorId:CreateProxySession' :: CreateProxySession -> Text
$sel:capabilities:CreateProxySession' :: CreateProxySession -> [Capability]
$sel:participantPhoneNumbers:CreateProxySession' :: CreateProxySession -> NonEmpty (Sensitive Text)
$sel:numberSelectionBehavior:CreateProxySession' :: CreateProxySession -> Maybe NumberSelectionBehavior
$sel:name:CreateProxySession' :: CreateProxySession -> Maybe (Sensitive Text)
$sel:geoMatchParams:CreateProxySession' :: CreateProxySession -> Maybe GeoMatchParams
$sel:geoMatchLevel:CreateProxySession' :: CreateProxySession -> Maybe GeoMatchLevel
$sel:expiryMinutes:CreateProxySession' :: CreateProxySession -> Maybe Natural
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
expiryMinutes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GeoMatchLevel
geoMatchLevel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe GeoMatchParams
geoMatchParams
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe NumberSelectionBehavior
numberSelectionBehavior
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty (Sensitive Text)
participantPhoneNumbers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Capability]
capabilities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
voiceConnectorId

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

instance Data.ToJSON CreateProxySession where
  toJSON :: CreateProxySession -> Value
toJSON CreateProxySession' {[Capability]
Maybe Natural
Maybe (Sensitive Text)
Maybe GeoMatchLevel
Maybe GeoMatchParams
Maybe NumberSelectionBehavior
NonEmpty (Sensitive Text)
Text
voiceConnectorId :: Text
capabilities :: [Capability]
participantPhoneNumbers :: NonEmpty (Sensitive Text)
numberSelectionBehavior :: Maybe NumberSelectionBehavior
name :: Maybe (Sensitive Text)
geoMatchParams :: Maybe GeoMatchParams
geoMatchLevel :: Maybe GeoMatchLevel
expiryMinutes :: Maybe Natural
$sel:voiceConnectorId:CreateProxySession' :: CreateProxySession -> Text
$sel:capabilities:CreateProxySession' :: CreateProxySession -> [Capability]
$sel:participantPhoneNumbers:CreateProxySession' :: CreateProxySession -> NonEmpty (Sensitive Text)
$sel:numberSelectionBehavior:CreateProxySession' :: CreateProxySession -> Maybe NumberSelectionBehavior
$sel:name:CreateProxySession' :: CreateProxySession -> Maybe (Sensitive Text)
$sel:geoMatchParams:CreateProxySession' :: CreateProxySession -> Maybe GeoMatchParams
$sel:geoMatchLevel:CreateProxySession' :: CreateProxySession -> Maybe GeoMatchLevel
$sel:expiryMinutes:CreateProxySession' :: CreateProxySession -> Maybe Natural
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ExpiryMinutes" 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
expiryMinutes,
            (Key
"GeoMatchLevel" 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 GeoMatchLevel
geoMatchLevel,
            (Key
"GeoMatchParams" 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 GeoMatchParams
geoMatchParams,
            (Key
"Name" 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 (Sensitive Text)
name,
            (Key
"NumberSelectionBehavior" 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 NumberSelectionBehavior
numberSelectionBehavior,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"ParticipantPhoneNumbers"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty (Sensitive Text)
participantPhoneNumbers
              ),
            forall a. a -> Maybe a
Prelude.Just (Key
"Capabilities" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Capability]
capabilities)
          ]
      )

instance Data.ToPath CreateProxySession where
  toPath :: CreateProxySession -> ByteString
toPath CreateProxySession' {[Capability]
Maybe Natural
Maybe (Sensitive Text)
Maybe GeoMatchLevel
Maybe GeoMatchParams
Maybe NumberSelectionBehavior
NonEmpty (Sensitive Text)
Text
voiceConnectorId :: Text
capabilities :: [Capability]
participantPhoneNumbers :: NonEmpty (Sensitive Text)
numberSelectionBehavior :: Maybe NumberSelectionBehavior
name :: Maybe (Sensitive Text)
geoMatchParams :: Maybe GeoMatchParams
geoMatchLevel :: Maybe GeoMatchLevel
expiryMinutes :: Maybe Natural
$sel:voiceConnectorId:CreateProxySession' :: CreateProxySession -> Text
$sel:capabilities:CreateProxySession' :: CreateProxySession -> [Capability]
$sel:participantPhoneNumbers:CreateProxySession' :: CreateProxySession -> NonEmpty (Sensitive Text)
$sel:numberSelectionBehavior:CreateProxySession' :: CreateProxySession -> Maybe NumberSelectionBehavior
$sel:name:CreateProxySession' :: CreateProxySession -> Maybe (Sensitive Text)
$sel:geoMatchParams:CreateProxySession' :: CreateProxySession -> Maybe GeoMatchParams
$sel:geoMatchLevel:CreateProxySession' :: CreateProxySession -> Maybe GeoMatchLevel
$sel:expiryMinutes:CreateProxySession' :: CreateProxySession -> Maybe Natural
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/voice-connectors/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
voiceConnectorId,
        ByteString
"/proxy-sessions"
      ]

instance Data.ToQuery CreateProxySession where
  toQuery :: CreateProxySession -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | /See:/ 'newCreateProxySessionResponse' smart constructor.
data CreateProxySessionResponse = CreateProxySessionResponse'
  { -- | The proxy session details.
    CreateProxySessionResponse -> Maybe ProxySession
proxySession :: Prelude.Maybe ProxySession,
    -- | The response's http status code.
    CreateProxySessionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateProxySessionResponse -> CreateProxySessionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateProxySessionResponse -> CreateProxySessionResponse -> Bool
$c/= :: CreateProxySessionResponse -> CreateProxySessionResponse -> Bool
== :: CreateProxySessionResponse -> CreateProxySessionResponse -> Bool
$c== :: CreateProxySessionResponse -> CreateProxySessionResponse -> Bool
Prelude.Eq, Int -> CreateProxySessionResponse -> ShowS
[CreateProxySessionResponse] -> ShowS
CreateProxySessionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateProxySessionResponse] -> ShowS
$cshowList :: [CreateProxySessionResponse] -> ShowS
show :: CreateProxySessionResponse -> String
$cshow :: CreateProxySessionResponse -> String
showsPrec :: Int -> CreateProxySessionResponse -> ShowS
$cshowsPrec :: Int -> CreateProxySessionResponse -> ShowS
Prelude.Show, forall x.
Rep CreateProxySessionResponse x -> CreateProxySessionResponse
forall x.
CreateProxySessionResponse -> Rep CreateProxySessionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateProxySessionResponse x -> CreateProxySessionResponse
$cfrom :: forall x.
CreateProxySessionResponse -> Rep CreateProxySessionResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateProxySessionResponse' 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:
--
-- 'proxySession', 'createProxySessionResponse_proxySession' - The proxy session details.
--
-- 'httpStatus', 'createProxySessionResponse_httpStatus' - The response's http status code.
newCreateProxySessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateProxySessionResponse
newCreateProxySessionResponse :: Int -> CreateProxySessionResponse
newCreateProxySessionResponse Int
pHttpStatus_ =
  CreateProxySessionResponse'
    { $sel:proxySession:CreateProxySessionResponse' :: Maybe ProxySession
proxySession =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateProxySessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The proxy session details.
createProxySessionResponse_proxySession :: Lens.Lens' CreateProxySessionResponse (Prelude.Maybe ProxySession)
createProxySessionResponse_proxySession :: Lens' CreateProxySessionResponse (Maybe ProxySession)
createProxySessionResponse_proxySession = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProxySessionResponse' {Maybe ProxySession
proxySession :: Maybe ProxySession
$sel:proxySession:CreateProxySessionResponse' :: CreateProxySessionResponse -> Maybe ProxySession
proxySession} -> Maybe ProxySession
proxySession) (\s :: CreateProxySessionResponse
s@CreateProxySessionResponse' {} Maybe ProxySession
a -> CreateProxySessionResponse
s {$sel:proxySession:CreateProxySessionResponse' :: Maybe ProxySession
proxySession = Maybe ProxySession
a} :: CreateProxySessionResponse)

-- | The response's http status code.
createProxySessionResponse_httpStatus :: Lens.Lens' CreateProxySessionResponse Prelude.Int
createProxySessionResponse_httpStatus :: Lens' CreateProxySessionResponse Int
createProxySessionResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateProxySessionResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateProxySessionResponse' :: CreateProxySessionResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateProxySessionResponse
s@CreateProxySessionResponse' {} Int
a -> CreateProxySessionResponse
s {$sel:httpStatus:CreateProxySessionResponse' :: Int
httpStatus = Int
a} :: CreateProxySessionResponse)

instance Prelude.NFData CreateProxySessionResponse where
  rnf :: CreateProxySessionResponse -> ()
rnf CreateProxySessionResponse' {Int
Maybe ProxySession
httpStatus :: Int
proxySession :: Maybe ProxySession
$sel:httpStatus:CreateProxySessionResponse' :: CreateProxySessionResponse -> Int
$sel:proxySession:CreateProxySessionResponse' :: CreateProxySessionResponse -> Maybe ProxySession
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ProxySession
proxySession
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus