{-# 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.VoiceId.EvaluateSession
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Evaluates a specified session based on audio data accumulated during a
-- streaming Amazon Connect Voice ID call.
module Amazonka.VoiceId.EvaluateSession
  ( -- * Creating a Request
    EvaluateSession (..),
    newEvaluateSession,

    -- * Request Lenses
    evaluateSession_domainId,
    evaluateSession_sessionNameOrId,

    -- * Destructuring the Response
    EvaluateSessionResponse (..),
    newEvaluateSessionResponse,

    -- * Response Lenses
    evaluateSessionResponse_authenticationResult,
    evaluateSessionResponse_domainId,
    evaluateSessionResponse_fraudDetectionResult,
    evaluateSessionResponse_sessionId,
    evaluateSessionResponse_sessionName,
    evaluateSessionResponse_streamingStatus,
    evaluateSessionResponse_httpStatus,
  )
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
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.VoiceId.Types

-- | /See:/ 'newEvaluateSession' smart constructor.
data EvaluateSession = EvaluateSession'
  { -- | The identifier of the domain where the session started.
    EvaluateSession -> Text
domainId :: Prelude.Text,
    -- | The session identifier, or name of the session, that you want to
    -- evaluate. In Voice ID integration, this is the Contact-Id.
    EvaluateSession -> Text
sessionNameOrId :: Prelude.Text
  }
  deriving (EvaluateSession -> EvaluateSession -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluateSession -> EvaluateSession -> Bool
$c/= :: EvaluateSession -> EvaluateSession -> Bool
== :: EvaluateSession -> EvaluateSession -> Bool
$c== :: EvaluateSession -> EvaluateSession -> Bool
Prelude.Eq, ReadPrec [EvaluateSession]
ReadPrec EvaluateSession
Int -> ReadS EvaluateSession
ReadS [EvaluateSession]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [EvaluateSession]
$creadListPrec :: ReadPrec [EvaluateSession]
readPrec :: ReadPrec EvaluateSession
$creadPrec :: ReadPrec EvaluateSession
readList :: ReadS [EvaluateSession]
$creadList :: ReadS [EvaluateSession]
readsPrec :: Int -> ReadS EvaluateSession
$creadsPrec :: Int -> ReadS EvaluateSession
Prelude.Read, Int -> EvaluateSession -> ShowS
[EvaluateSession] -> ShowS
EvaluateSession -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluateSession] -> ShowS
$cshowList :: [EvaluateSession] -> ShowS
show :: EvaluateSession -> String
$cshow :: EvaluateSession -> String
showsPrec :: Int -> EvaluateSession -> ShowS
$cshowsPrec :: Int -> EvaluateSession -> ShowS
Prelude.Show, forall x. Rep EvaluateSession x -> EvaluateSession
forall x. EvaluateSession -> Rep EvaluateSession x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EvaluateSession x -> EvaluateSession
$cfrom :: forall x. EvaluateSession -> Rep EvaluateSession x
Prelude.Generic)

-- |
-- Create a value of 'EvaluateSession' 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:
--
-- 'domainId', 'evaluateSession_domainId' - The identifier of the domain where the session started.
--
-- 'sessionNameOrId', 'evaluateSession_sessionNameOrId' - The session identifier, or name of the session, that you want to
-- evaluate. In Voice ID integration, this is the Contact-Id.
newEvaluateSession ::
  -- | 'domainId'
  Prelude.Text ->
  -- | 'sessionNameOrId'
  Prelude.Text ->
  EvaluateSession
newEvaluateSession :: Text -> Text -> EvaluateSession
newEvaluateSession Text
pDomainId_ Text
pSessionNameOrId_ =
  EvaluateSession'
    { $sel:domainId:EvaluateSession' :: Text
domainId = Text
pDomainId_,
      $sel:sessionNameOrId:EvaluateSession' :: Text
sessionNameOrId = Text
pSessionNameOrId_
    }

-- | The identifier of the domain where the session started.
evaluateSession_domainId :: Lens.Lens' EvaluateSession Prelude.Text
evaluateSession_domainId :: Lens' EvaluateSession Text
evaluateSession_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateSession' {Text
domainId :: Text
$sel:domainId:EvaluateSession' :: EvaluateSession -> Text
domainId} -> Text
domainId) (\s :: EvaluateSession
s@EvaluateSession' {} Text
a -> EvaluateSession
s {$sel:domainId:EvaluateSession' :: Text
domainId = Text
a} :: EvaluateSession)

-- | The session identifier, or name of the session, that you want to
-- evaluate. In Voice ID integration, this is the Contact-Id.
evaluateSession_sessionNameOrId :: Lens.Lens' EvaluateSession Prelude.Text
evaluateSession_sessionNameOrId :: Lens' EvaluateSession Text
evaluateSession_sessionNameOrId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateSession' {Text
sessionNameOrId :: Text
$sel:sessionNameOrId:EvaluateSession' :: EvaluateSession -> Text
sessionNameOrId} -> Text
sessionNameOrId) (\s :: EvaluateSession
s@EvaluateSession' {} Text
a -> EvaluateSession
s {$sel:sessionNameOrId:EvaluateSession' :: Text
sessionNameOrId = Text
a} :: EvaluateSession)

instance Core.AWSRequest EvaluateSession where
  type
    AWSResponse EvaluateSession =
      EvaluateSessionResponse
  request :: (Service -> Service) -> EvaluateSession -> Request EvaluateSession
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 EvaluateSession
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse EvaluateSession)))
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 AuthenticationResult
-> Maybe Text
-> Maybe FraudDetectionResult
-> Maybe Text
-> Maybe Text
-> Maybe StreamingStatus
-> Int
-> EvaluateSessionResponse
EvaluateSessionResponse'
            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
"AuthenticationResult")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"DomainId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"FraudDetectionResult")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SessionId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"SessionName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"StreamingStatus")
            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 EvaluateSession where
  hashWithSalt :: Int -> EvaluateSession -> Int
hashWithSalt Int
_salt EvaluateSession' {Text
sessionNameOrId :: Text
domainId :: Text
$sel:sessionNameOrId:EvaluateSession' :: EvaluateSession -> Text
$sel:domainId:EvaluateSession' :: EvaluateSession -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
sessionNameOrId

instance Prelude.NFData EvaluateSession where
  rnf :: EvaluateSession -> ()
rnf EvaluateSession' {Text
sessionNameOrId :: Text
domainId :: Text
$sel:sessionNameOrId:EvaluateSession' :: EvaluateSession -> Text
$sel:domainId:EvaluateSession' :: EvaluateSession -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
sessionNameOrId

instance Data.ToHeaders EvaluateSession where
  toHeaders :: EvaluateSession -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# (ByteString
"VoiceID.EvaluateSession" :: Prelude.ByteString),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.0" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON EvaluateSession where
  toJSON :: EvaluateSession -> Value
toJSON EvaluateSession' {Text
sessionNameOrId :: Text
domainId :: Text
$sel:sessionNameOrId:EvaluateSession' :: EvaluateSession -> Text
$sel:domainId:EvaluateSession' :: EvaluateSession -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"DomainId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
domainId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"SessionNameOrId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
sessionNameOrId)
          ]
      )

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

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

-- | /See:/ 'newEvaluateSessionResponse' smart constructor.
data EvaluateSessionResponse = EvaluateSessionResponse'
  { -- | Details resulting from the authentication process, such as
    -- authentication decision and authentication score.
    EvaluateSessionResponse -> Maybe AuthenticationResult
authenticationResult :: Prelude.Maybe AuthenticationResult,
    -- | The identifier of the domain containing the session.
    EvaluateSessionResponse -> Maybe Text
domainId :: Prelude.Maybe Prelude.Text,
    -- | Details resulting from the fraud detection process, such as fraud
    -- detection decision and risk score.
    EvaluateSessionResponse -> Maybe FraudDetectionResult
fraudDetectionResult :: Prelude.Maybe FraudDetectionResult,
    -- | The service-generated identifier of the session.
    EvaluateSessionResponse -> Maybe Text
sessionId :: Prelude.Maybe Prelude.Text,
    -- | The client-provided name of the session.
    EvaluateSessionResponse -> Maybe Text
sessionName :: Prelude.Maybe Prelude.Text,
    -- | The current status of audio streaming for this session. This field is
    -- useful to infer next steps when the Authentication or Fraud Detection
    -- results are empty or the decision is @NOT_ENOUGH_SPEECH@. In this
    -- situation, if the @StreamingStatus@ is @ONGOING\/PENDING_CONFIGURATION@,
    -- it can mean that the client should call the API again later, after Voice
    -- ID has enough audio to produce a result. If the decision remains
    -- @NOT_ENOUGH_SPEECH@ even after @StreamingStatus@ is @ENDED@, it means
    -- that the previously streamed session did not have enough speech to
    -- perform evaluation, and a new streaming session is needed to try again.
    EvaluateSessionResponse -> Maybe StreamingStatus
streamingStatus :: Prelude.Maybe StreamingStatus,
    -- | The response's http status code.
    EvaluateSessionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (EvaluateSessionResponse -> EvaluateSessionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: EvaluateSessionResponse -> EvaluateSessionResponse -> Bool
$c/= :: EvaluateSessionResponse -> EvaluateSessionResponse -> Bool
== :: EvaluateSessionResponse -> EvaluateSessionResponse -> Bool
$c== :: EvaluateSessionResponse -> EvaluateSessionResponse -> Bool
Prelude.Eq, Int -> EvaluateSessionResponse -> ShowS
[EvaluateSessionResponse] -> ShowS
EvaluateSessionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [EvaluateSessionResponse] -> ShowS
$cshowList :: [EvaluateSessionResponse] -> ShowS
show :: EvaluateSessionResponse -> String
$cshow :: EvaluateSessionResponse -> String
showsPrec :: Int -> EvaluateSessionResponse -> ShowS
$cshowsPrec :: Int -> EvaluateSessionResponse -> ShowS
Prelude.Show, forall x. Rep EvaluateSessionResponse x -> EvaluateSessionResponse
forall x. EvaluateSessionResponse -> Rep EvaluateSessionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep EvaluateSessionResponse x -> EvaluateSessionResponse
$cfrom :: forall x. EvaluateSessionResponse -> Rep EvaluateSessionResponse x
Prelude.Generic)

-- |
-- Create a value of 'EvaluateSessionResponse' 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:
--
-- 'authenticationResult', 'evaluateSessionResponse_authenticationResult' - Details resulting from the authentication process, such as
-- authentication decision and authentication score.
--
-- 'domainId', 'evaluateSessionResponse_domainId' - The identifier of the domain containing the session.
--
-- 'fraudDetectionResult', 'evaluateSessionResponse_fraudDetectionResult' - Details resulting from the fraud detection process, such as fraud
-- detection decision and risk score.
--
-- 'sessionId', 'evaluateSessionResponse_sessionId' - The service-generated identifier of the session.
--
-- 'sessionName', 'evaluateSessionResponse_sessionName' - The client-provided name of the session.
--
-- 'streamingStatus', 'evaluateSessionResponse_streamingStatus' - The current status of audio streaming for this session. This field is
-- useful to infer next steps when the Authentication or Fraud Detection
-- results are empty or the decision is @NOT_ENOUGH_SPEECH@. In this
-- situation, if the @StreamingStatus@ is @ONGOING\/PENDING_CONFIGURATION@,
-- it can mean that the client should call the API again later, after Voice
-- ID has enough audio to produce a result. If the decision remains
-- @NOT_ENOUGH_SPEECH@ even after @StreamingStatus@ is @ENDED@, it means
-- that the previously streamed session did not have enough speech to
-- perform evaluation, and a new streaming session is needed to try again.
--
-- 'httpStatus', 'evaluateSessionResponse_httpStatus' - The response's http status code.
newEvaluateSessionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  EvaluateSessionResponse
newEvaluateSessionResponse :: Int -> EvaluateSessionResponse
newEvaluateSessionResponse Int
pHttpStatus_ =
  EvaluateSessionResponse'
    { $sel:authenticationResult:EvaluateSessionResponse' :: Maybe AuthenticationResult
authenticationResult =
        forall a. Maybe a
Prelude.Nothing,
      $sel:domainId:EvaluateSessionResponse' :: Maybe Text
domainId = forall a. Maybe a
Prelude.Nothing,
      $sel:fraudDetectionResult:EvaluateSessionResponse' :: Maybe FraudDetectionResult
fraudDetectionResult = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionId:EvaluateSessionResponse' :: Maybe Text
sessionId = forall a. Maybe a
Prelude.Nothing,
      $sel:sessionName:EvaluateSessionResponse' :: Maybe Text
sessionName = forall a. Maybe a
Prelude.Nothing,
      $sel:streamingStatus:EvaluateSessionResponse' :: Maybe StreamingStatus
streamingStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:EvaluateSessionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Details resulting from the authentication process, such as
-- authentication decision and authentication score.
evaluateSessionResponse_authenticationResult :: Lens.Lens' EvaluateSessionResponse (Prelude.Maybe AuthenticationResult)
evaluateSessionResponse_authenticationResult :: Lens' EvaluateSessionResponse (Maybe AuthenticationResult)
evaluateSessionResponse_authenticationResult = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateSessionResponse' {Maybe AuthenticationResult
authenticationResult :: Maybe AuthenticationResult
$sel:authenticationResult:EvaluateSessionResponse' :: EvaluateSessionResponse -> Maybe AuthenticationResult
authenticationResult} -> Maybe AuthenticationResult
authenticationResult) (\s :: EvaluateSessionResponse
s@EvaluateSessionResponse' {} Maybe AuthenticationResult
a -> EvaluateSessionResponse
s {$sel:authenticationResult:EvaluateSessionResponse' :: Maybe AuthenticationResult
authenticationResult = Maybe AuthenticationResult
a} :: EvaluateSessionResponse)

-- | The identifier of the domain containing the session.
evaluateSessionResponse_domainId :: Lens.Lens' EvaluateSessionResponse (Prelude.Maybe Prelude.Text)
evaluateSessionResponse_domainId :: Lens' EvaluateSessionResponse (Maybe Text)
evaluateSessionResponse_domainId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateSessionResponse' {Maybe Text
domainId :: Maybe Text
$sel:domainId:EvaluateSessionResponse' :: EvaluateSessionResponse -> Maybe Text
domainId} -> Maybe Text
domainId) (\s :: EvaluateSessionResponse
s@EvaluateSessionResponse' {} Maybe Text
a -> EvaluateSessionResponse
s {$sel:domainId:EvaluateSessionResponse' :: Maybe Text
domainId = Maybe Text
a} :: EvaluateSessionResponse)

-- | Details resulting from the fraud detection process, such as fraud
-- detection decision and risk score.
evaluateSessionResponse_fraudDetectionResult :: Lens.Lens' EvaluateSessionResponse (Prelude.Maybe FraudDetectionResult)
evaluateSessionResponse_fraudDetectionResult :: Lens' EvaluateSessionResponse (Maybe FraudDetectionResult)
evaluateSessionResponse_fraudDetectionResult = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateSessionResponse' {Maybe FraudDetectionResult
fraudDetectionResult :: Maybe FraudDetectionResult
$sel:fraudDetectionResult:EvaluateSessionResponse' :: EvaluateSessionResponse -> Maybe FraudDetectionResult
fraudDetectionResult} -> Maybe FraudDetectionResult
fraudDetectionResult) (\s :: EvaluateSessionResponse
s@EvaluateSessionResponse' {} Maybe FraudDetectionResult
a -> EvaluateSessionResponse
s {$sel:fraudDetectionResult:EvaluateSessionResponse' :: Maybe FraudDetectionResult
fraudDetectionResult = Maybe FraudDetectionResult
a} :: EvaluateSessionResponse)

-- | The service-generated identifier of the session.
evaluateSessionResponse_sessionId :: Lens.Lens' EvaluateSessionResponse (Prelude.Maybe Prelude.Text)
evaluateSessionResponse_sessionId :: Lens' EvaluateSessionResponse (Maybe Text)
evaluateSessionResponse_sessionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateSessionResponse' {Maybe Text
sessionId :: Maybe Text
$sel:sessionId:EvaluateSessionResponse' :: EvaluateSessionResponse -> Maybe Text
sessionId} -> Maybe Text
sessionId) (\s :: EvaluateSessionResponse
s@EvaluateSessionResponse' {} Maybe Text
a -> EvaluateSessionResponse
s {$sel:sessionId:EvaluateSessionResponse' :: Maybe Text
sessionId = Maybe Text
a} :: EvaluateSessionResponse)

-- | The client-provided name of the session.
evaluateSessionResponse_sessionName :: Lens.Lens' EvaluateSessionResponse (Prelude.Maybe Prelude.Text)
evaluateSessionResponse_sessionName :: Lens' EvaluateSessionResponse (Maybe Text)
evaluateSessionResponse_sessionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateSessionResponse' {Maybe Text
sessionName :: Maybe Text
$sel:sessionName:EvaluateSessionResponse' :: EvaluateSessionResponse -> Maybe Text
sessionName} -> Maybe Text
sessionName) (\s :: EvaluateSessionResponse
s@EvaluateSessionResponse' {} Maybe Text
a -> EvaluateSessionResponse
s {$sel:sessionName:EvaluateSessionResponse' :: Maybe Text
sessionName = Maybe Text
a} :: EvaluateSessionResponse)

-- | The current status of audio streaming for this session. This field is
-- useful to infer next steps when the Authentication or Fraud Detection
-- results are empty or the decision is @NOT_ENOUGH_SPEECH@. In this
-- situation, if the @StreamingStatus@ is @ONGOING\/PENDING_CONFIGURATION@,
-- it can mean that the client should call the API again later, after Voice
-- ID has enough audio to produce a result. If the decision remains
-- @NOT_ENOUGH_SPEECH@ even after @StreamingStatus@ is @ENDED@, it means
-- that the previously streamed session did not have enough speech to
-- perform evaluation, and a new streaming session is needed to try again.
evaluateSessionResponse_streamingStatus :: Lens.Lens' EvaluateSessionResponse (Prelude.Maybe StreamingStatus)
evaluateSessionResponse_streamingStatus :: Lens' EvaluateSessionResponse (Maybe StreamingStatus)
evaluateSessionResponse_streamingStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\EvaluateSessionResponse' {Maybe StreamingStatus
streamingStatus :: Maybe StreamingStatus
$sel:streamingStatus:EvaluateSessionResponse' :: EvaluateSessionResponse -> Maybe StreamingStatus
streamingStatus} -> Maybe StreamingStatus
streamingStatus) (\s :: EvaluateSessionResponse
s@EvaluateSessionResponse' {} Maybe StreamingStatus
a -> EvaluateSessionResponse
s {$sel:streamingStatus:EvaluateSessionResponse' :: Maybe StreamingStatus
streamingStatus = Maybe StreamingStatus
a} :: EvaluateSessionResponse)

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

instance Prelude.NFData EvaluateSessionResponse where
  rnf :: EvaluateSessionResponse -> ()
rnf EvaluateSessionResponse' {Int
Maybe Text
Maybe AuthenticationResult
Maybe StreamingStatus
Maybe FraudDetectionResult
httpStatus :: Int
streamingStatus :: Maybe StreamingStatus
sessionName :: Maybe Text
sessionId :: Maybe Text
fraudDetectionResult :: Maybe FraudDetectionResult
domainId :: Maybe Text
authenticationResult :: Maybe AuthenticationResult
$sel:httpStatus:EvaluateSessionResponse' :: EvaluateSessionResponse -> Int
$sel:streamingStatus:EvaluateSessionResponse' :: EvaluateSessionResponse -> Maybe StreamingStatus
$sel:sessionName:EvaluateSessionResponse' :: EvaluateSessionResponse -> Maybe Text
$sel:sessionId:EvaluateSessionResponse' :: EvaluateSessionResponse -> Maybe Text
$sel:fraudDetectionResult:EvaluateSessionResponse' :: EvaluateSessionResponse -> Maybe FraudDetectionResult
$sel:domainId:EvaluateSessionResponse' :: EvaluateSessionResponse -> Maybe Text
$sel:authenticationResult:EvaluateSessionResponse' :: EvaluateSessionResponse -> Maybe AuthenticationResult
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe AuthenticationResult
authenticationResult
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
domainId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe FraudDetectionResult
fraudDetectionResult
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sessionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sessionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamingStatus
streamingStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus