{-# 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.Rekognition.DescribeStreamProcessor
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Provides information about a stream processor created by
-- CreateStreamProcessor. You can get information about the input and
-- output streams, the input parameters for the face recognition being
-- performed, and the current status of the stream processor.
module Amazonka.Rekognition.DescribeStreamProcessor
  ( -- * Creating a Request
    DescribeStreamProcessor (..),
    newDescribeStreamProcessor,

    -- * Request Lenses
    describeStreamProcessor_name,

    -- * Destructuring the Response
    DescribeStreamProcessorResponse (..),
    newDescribeStreamProcessorResponse,

    -- * Response Lenses
    describeStreamProcessorResponse_creationTimestamp,
    describeStreamProcessorResponse_dataSharingPreference,
    describeStreamProcessorResponse_input,
    describeStreamProcessorResponse_kmsKeyId,
    describeStreamProcessorResponse_lastUpdateTimestamp,
    describeStreamProcessorResponse_name,
    describeStreamProcessorResponse_notificationChannel,
    describeStreamProcessorResponse_output,
    describeStreamProcessorResponse_regionsOfInterest,
    describeStreamProcessorResponse_roleArn,
    describeStreamProcessorResponse_settings,
    describeStreamProcessorResponse_status,
    describeStreamProcessorResponse_statusMessage,
    describeStreamProcessorResponse_streamProcessorArn,
    describeStreamProcessorResponse_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 Amazonka.Rekognition.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | /See:/ 'newDescribeStreamProcessor' smart constructor.
data DescribeStreamProcessor = DescribeStreamProcessor'
  { -- | Name of the stream processor for which you want information.
    DescribeStreamProcessor -> Text
name :: Prelude.Text
  }
  deriving (DescribeStreamProcessor -> DescribeStreamProcessor -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeStreamProcessor -> DescribeStreamProcessor -> Bool
$c/= :: DescribeStreamProcessor -> DescribeStreamProcessor -> Bool
== :: DescribeStreamProcessor -> DescribeStreamProcessor -> Bool
$c== :: DescribeStreamProcessor -> DescribeStreamProcessor -> Bool
Prelude.Eq, ReadPrec [DescribeStreamProcessor]
ReadPrec DescribeStreamProcessor
Int -> ReadS DescribeStreamProcessor
ReadS [DescribeStreamProcessor]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeStreamProcessor]
$creadListPrec :: ReadPrec [DescribeStreamProcessor]
readPrec :: ReadPrec DescribeStreamProcessor
$creadPrec :: ReadPrec DescribeStreamProcessor
readList :: ReadS [DescribeStreamProcessor]
$creadList :: ReadS [DescribeStreamProcessor]
readsPrec :: Int -> ReadS DescribeStreamProcessor
$creadsPrec :: Int -> ReadS DescribeStreamProcessor
Prelude.Read, Int -> DescribeStreamProcessor -> ShowS
[DescribeStreamProcessor] -> ShowS
DescribeStreamProcessor -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeStreamProcessor] -> ShowS
$cshowList :: [DescribeStreamProcessor] -> ShowS
show :: DescribeStreamProcessor -> String
$cshow :: DescribeStreamProcessor -> String
showsPrec :: Int -> DescribeStreamProcessor -> ShowS
$cshowsPrec :: Int -> DescribeStreamProcessor -> ShowS
Prelude.Show, forall x. Rep DescribeStreamProcessor x -> DescribeStreamProcessor
forall x. DescribeStreamProcessor -> Rep DescribeStreamProcessor x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeStreamProcessor x -> DescribeStreamProcessor
$cfrom :: forall x. DescribeStreamProcessor -> Rep DescribeStreamProcessor x
Prelude.Generic)

-- |
-- Create a value of 'DescribeStreamProcessor' 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:
--
-- 'name', 'describeStreamProcessor_name' - Name of the stream processor for which you want information.
newDescribeStreamProcessor ::
  -- | 'name'
  Prelude.Text ->
  DescribeStreamProcessor
newDescribeStreamProcessor :: Text -> DescribeStreamProcessor
newDescribeStreamProcessor Text
pName_ =
  DescribeStreamProcessor' {$sel:name:DescribeStreamProcessor' :: Text
name = Text
pName_}

-- | Name of the stream processor for which you want information.
describeStreamProcessor_name :: Lens.Lens' DescribeStreamProcessor Prelude.Text
describeStreamProcessor_name :: Lens' DescribeStreamProcessor Text
describeStreamProcessor_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessor' {Text
name :: Text
$sel:name:DescribeStreamProcessor' :: DescribeStreamProcessor -> Text
name} -> Text
name) (\s :: DescribeStreamProcessor
s@DescribeStreamProcessor' {} Text
a -> DescribeStreamProcessor
s {$sel:name:DescribeStreamProcessor' :: Text
name = Text
a} :: DescribeStreamProcessor)

instance Core.AWSRequest DescribeStreamProcessor where
  type
    AWSResponse DescribeStreamProcessor =
      DescribeStreamProcessorResponse
  request :: (Service -> Service)
-> DescribeStreamProcessor -> Request DescribeStreamProcessor
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 DescribeStreamProcessor
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeStreamProcessor)))
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 POSIX
-> Maybe StreamProcessorDataSharingPreference
-> Maybe StreamProcessorInput
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe StreamProcessorNotificationChannel
-> Maybe StreamProcessorOutput
-> Maybe [RegionOfInterest]
-> Maybe Text
-> Maybe StreamProcessorSettings
-> Maybe StreamProcessorStatus
-> Maybe Text
-> Maybe Text
-> Int
-> DescribeStreamProcessorResponse
DescribeStreamProcessorResponse'
            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
"CreationTimestamp")
            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
"DataSharingPreference")
            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
"Input")
            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
"KmsKeyId")
            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
"LastUpdateTimestamp")
            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
"Name")
            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
"NotificationChannel")
            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
"Output")
            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
"RegionsOfInterest"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ 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 -> Either String (Maybe a)
Data..?> Key
"RoleArn")
            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
"Settings")
            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
"Status")
            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
"StatusMessage")
            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
"StreamProcessorArn")
            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 DescribeStreamProcessor where
  hashWithSalt :: Int -> DescribeStreamProcessor -> Int
hashWithSalt Int
_salt DescribeStreamProcessor' {Text
name :: Text
$sel:name:DescribeStreamProcessor' :: DescribeStreamProcessor -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

instance Prelude.NFData DescribeStreamProcessor where
  rnf :: DescribeStreamProcessor -> ()
rnf DescribeStreamProcessor' {Text
name :: Text
$sel:name:DescribeStreamProcessor' :: DescribeStreamProcessor -> Text
..} = forall a. NFData a => a -> ()
Prelude.rnf Text
name

instance Data.ToHeaders DescribeStreamProcessor where
  toHeaders :: DescribeStreamProcessor -> 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
"RekognitionService.DescribeStreamProcessor" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

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

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

-- | /See:/ 'newDescribeStreamProcessorResponse' smart constructor.
data DescribeStreamProcessorResponse = DescribeStreamProcessorResponse'
  { -- | Date and time the stream processor was created
    DescribeStreamProcessorResponse -> Maybe POSIX
creationTimestamp :: Prelude.Maybe Data.POSIX,
    -- | Shows whether you are sharing data with Rekognition to improve model
    -- performance. You can choose this option at the account level or on a
    -- per-stream basis. Note that if you opt out at the account level this
    -- setting is ignored on individual streams.
    DescribeStreamProcessorResponse
-> Maybe StreamProcessorDataSharingPreference
dataSharingPreference :: Prelude.Maybe StreamProcessorDataSharingPreference,
    -- | Kinesis video stream that provides the source streaming video.
    DescribeStreamProcessorResponse -> Maybe StreamProcessorInput
input :: Prelude.Maybe StreamProcessorInput,
    -- | The identifier for your AWS Key Management Service key (AWS KMS key).
    -- This is an optional parameter for label detection stream processors.
    DescribeStreamProcessorResponse -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | The time, in Unix format, the stream processor was last updated. For
    -- example, when the stream processor moves from a running state to a
    -- failed state, or when the user starts or stops the stream processor.
    DescribeStreamProcessorResponse -> Maybe POSIX
lastUpdateTimestamp :: Prelude.Maybe Data.POSIX,
    -- | Name of the stream processor.
    DescribeStreamProcessorResponse -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    DescribeStreamProcessorResponse
-> Maybe StreamProcessorNotificationChannel
notificationChannel :: Prelude.Maybe StreamProcessorNotificationChannel,
    -- | Kinesis data stream to which Amazon Rekognition Video puts the analysis
    -- results.
    DescribeStreamProcessorResponse -> Maybe StreamProcessorOutput
output :: Prelude.Maybe StreamProcessorOutput,
    -- | Specifies locations in the frames where Amazon Rekognition checks for
    -- objects or people. This is an optional parameter for label detection
    -- stream processors.
    DescribeStreamProcessorResponse -> Maybe [RegionOfInterest]
regionsOfInterest :: Prelude.Maybe [RegionOfInterest],
    -- | ARN of the IAM role that allows access to the stream processor.
    DescribeStreamProcessorResponse -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | Input parameters used in a streaming video analyzed by a stream
    -- processor. You can use @FaceSearch@ to recognize faces in a streaming
    -- video, or you can use @ConnectedHome@ to detect labels.
    DescribeStreamProcessorResponse -> Maybe StreamProcessorSettings
settings :: Prelude.Maybe StreamProcessorSettings,
    -- | Current status of the stream processor.
    DescribeStreamProcessorResponse -> Maybe StreamProcessorStatus
status :: Prelude.Maybe StreamProcessorStatus,
    -- | Detailed status message about the stream processor.
    DescribeStreamProcessorResponse -> Maybe Text
statusMessage :: Prelude.Maybe Prelude.Text,
    -- | ARN of the stream processor.
    DescribeStreamProcessorResponse -> Maybe Text
streamProcessorArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeStreamProcessorResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeStreamProcessorResponse
-> DescribeStreamProcessorResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeStreamProcessorResponse
-> DescribeStreamProcessorResponse -> Bool
$c/= :: DescribeStreamProcessorResponse
-> DescribeStreamProcessorResponse -> Bool
== :: DescribeStreamProcessorResponse
-> DescribeStreamProcessorResponse -> Bool
$c== :: DescribeStreamProcessorResponse
-> DescribeStreamProcessorResponse -> Bool
Prelude.Eq, ReadPrec [DescribeStreamProcessorResponse]
ReadPrec DescribeStreamProcessorResponse
Int -> ReadS DescribeStreamProcessorResponse
ReadS [DescribeStreamProcessorResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeStreamProcessorResponse]
$creadListPrec :: ReadPrec [DescribeStreamProcessorResponse]
readPrec :: ReadPrec DescribeStreamProcessorResponse
$creadPrec :: ReadPrec DescribeStreamProcessorResponse
readList :: ReadS [DescribeStreamProcessorResponse]
$creadList :: ReadS [DescribeStreamProcessorResponse]
readsPrec :: Int -> ReadS DescribeStreamProcessorResponse
$creadsPrec :: Int -> ReadS DescribeStreamProcessorResponse
Prelude.Read, Int -> DescribeStreamProcessorResponse -> ShowS
[DescribeStreamProcessorResponse] -> ShowS
DescribeStreamProcessorResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeStreamProcessorResponse] -> ShowS
$cshowList :: [DescribeStreamProcessorResponse] -> ShowS
show :: DescribeStreamProcessorResponse -> String
$cshow :: DescribeStreamProcessorResponse -> String
showsPrec :: Int -> DescribeStreamProcessorResponse -> ShowS
$cshowsPrec :: Int -> DescribeStreamProcessorResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeStreamProcessorResponse x
-> DescribeStreamProcessorResponse
forall x.
DescribeStreamProcessorResponse
-> Rep DescribeStreamProcessorResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeStreamProcessorResponse x
-> DescribeStreamProcessorResponse
$cfrom :: forall x.
DescribeStreamProcessorResponse
-> Rep DescribeStreamProcessorResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeStreamProcessorResponse' 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:
--
-- 'creationTimestamp', 'describeStreamProcessorResponse_creationTimestamp' - Date and time the stream processor was created
--
-- 'dataSharingPreference', 'describeStreamProcessorResponse_dataSharingPreference' - Shows whether you are sharing data with Rekognition to improve model
-- performance. You can choose this option at the account level or on a
-- per-stream basis. Note that if you opt out at the account level this
-- setting is ignored on individual streams.
--
-- 'input', 'describeStreamProcessorResponse_input' - Kinesis video stream that provides the source streaming video.
--
-- 'kmsKeyId', 'describeStreamProcessorResponse_kmsKeyId' - The identifier for your AWS Key Management Service key (AWS KMS key).
-- This is an optional parameter for label detection stream processors.
--
-- 'lastUpdateTimestamp', 'describeStreamProcessorResponse_lastUpdateTimestamp' - The time, in Unix format, the stream processor was last updated. For
-- example, when the stream processor moves from a running state to a
-- failed state, or when the user starts or stops the stream processor.
--
-- 'name', 'describeStreamProcessorResponse_name' - Name of the stream processor.
--
-- 'notificationChannel', 'describeStreamProcessorResponse_notificationChannel' - Undocumented member.
--
-- 'output', 'describeStreamProcessorResponse_output' - Kinesis data stream to which Amazon Rekognition Video puts the analysis
-- results.
--
-- 'regionsOfInterest', 'describeStreamProcessorResponse_regionsOfInterest' - Specifies locations in the frames where Amazon Rekognition checks for
-- objects or people. This is an optional parameter for label detection
-- stream processors.
--
-- 'roleArn', 'describeStreamProcessorResponse_roleArn' - ARN of the IAM role that allows access to the stream processor.
--
-- 'settings', 'describeStreamProcessorResponse_settings' - Input parameters used in a streaming video analyzed by a stream
-- processor. You can use @FaceSearch@ to recognize faces in a streaming
-- video, or you can use @ConnectedHome@ to detect labels.
--
-- 'status', 'describeStreamProcessorResponse_status' - Current status of the stream processor.
--
-- 'statusMessage', 'describeStreamProcessorResponse_statusMessage' - Detailed status message about the stream processor.
--
-- 'streamProcessorArn', 'describeStreamProcessorResponse_streamProcessorArn' - ARN of the stream processor.
--
-- 'httpStatus', 'describeStreamProcessorResponse_httpStatus' - The response's http status code.
newDescribeStreamProcessorResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeStreamProcessorResponse
newDescribeStreamProcessorResponse :: Int -> DescribeStreamProcessorResponse
newDescribeStreamProcessorResponse Int
pHttpStatus_ =
  DescribeStreamProcessorResponse'
    { $sel:creationTimestamp:DescribeStreamProcessorResponse' :: Maybe POSIX
creationTimestamp =
        forall a. Maybe a
Prelude.Nothing,
      $sel:dataSharingPreference:DescribeStreamProcessorResponse' :: Maybe StreamProcessorDataSharingPreference
dataSharingPreference = forall a. Maybe a
Prelude.Nothing,
      $sel:input:DescribeStreamProcessorResponse' :: Maybe StreamProcessorInput
input = forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:DescribeStreamProcessorResponse' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdateTimestamp:DescribeStreamProcessorResponse' :: Maybe POSIX
lastUpdateTimestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:name:DescribeStreamProcessorResponse' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:notificationChannel:DescribeStreamProcessorResponse' :: Maybe StreamProcessorNotificationChannel
notificationChannel = forall a. Maybe a
Prelude.Nothing,
      $sel:output:DescribeStreamProcessorResponse' :: Maybe StreamProcessorOutput
output = forall a. Maybe a
Prelude.Nothing,
      $sel:regionsOfInterest:DescribeStreamProcessorResponse' :: Maybe [RegionOfInterest]
regionsOfInterest = forall a. Maybe a
Prelude.Nothing,
      $sel:roleArn:DescribeStreamProcessorResponse' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:settings:DescribeStreamProcessorResponse' :: Maybe StreamProcessorSettings
settings = forall a. Maybe a
Prelude.Nothing,
      $sel:status:DescribeStreamProcessorResponse' :: Maybe StreamProcessorStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusMessage:DescribeStreamProcessorResponse' :: Maybe Text
statusMessage = forall a. Maybe a
Prelude.Nothing,
      $sel:streamProcessorArn:DescribeStreamProcessorResponse' :: Maybe Text
streamProcessorArn = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeStreamProcessorResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Date and time the stream processor was created
describeStreamProcessorResponse_creationTimestamp :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe Prelude.UTCTime)
describeStreamProcessorResponse_creationTimestamp :: Lens' DescribeStreamProcessorResponse (Maybe UTCTime)
describeStreamProcessorResponse_creationTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe POSIX
creationTimestamp :: Maybe POSIX
$sel:creationTimestamp:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe POSIX
creationTimestamp} -> Maybe POSIX
creationTimestamp) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe POSIX
a -> DescribeStreamProcessorResponse
s {$sel:creationTimestamp:DescribeStreamProcessorResponse' :: Maybe POSIX
creationTimestamp = Maybe POSIX
a} :: DescribeStreamProcessorResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Shows whether you are sharing data with Rekognition to improve model
-- performance. You can choose this option at the account level or on a
-- per-stream basis. Note that if you opt out at the account level this
-- setting is ignored on individual streams.
describeStreamProcessorResponse_dataSharingPreference :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe StreamProcessorDataSharingPreference)
describeStreamProcessorResponse_dataSharingPreference :: Lens'
  DescribeStreamProcessorResponse
  (Maybe StreamProcessorDataSharingPreference)
describeStreamProcessorResponse_dataSharingPreference = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe StreamProcessorDataSharingPreference
dataSharingPreference :: Maybe StreamProcessorDataSharingPreference
$sel:dataSharingPreference:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse
-> Maybe StreamProcessorDataSharingPreference
dataSharingPreference} -> Maybe StreamProcessorDataSharingPreference
dataSharingPreference) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe StreamProcessorDataSharingPreference
a -> DescribeStreamProcessorResponse
s {$sel:dataSharingPreference:DescribeStreamProcessorResponse' :: Maybe StreamProcessorDataSharingPreference
dataSharingPreference = Maybe StreamProcessorDataSharingPreference
a} :: DescribeStreamProcessorResponse)

-- | Kinesis video stream that provides the source streaming video.
describeStreamProcessorResponse_input :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe StreamProcessorInput)
describeStreamProcessorResponse_input :: Lens' DescribeStreamProcessorResponse (Maybe StreamProcessorInput)
describeStreamProcessorResponse_input = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe StreamProcessorInput
input :: Maybe StreamProcessorInput
$sel:input:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe StreamProcessorInput
input} -> Maybe StreamProcessorInput
input) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe StreamProcessorInput
a -> DescribeStreamProcessorResponse
s {$sel:input:DescribeStreamProcessorResponse' :: Maybe StreamProcessorInput
input = Maybe StreamProcessorInput
a} :: DescribeStreamProcessorResponse)

-- | The identifier for your AWS Key Management Service key (AWS KMS key).
-- This is an optional parameter for label detection stream processors.
describeStreamProcessorResponse_kmsKeyId :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe Prelude.Text)
describeStreamProcessorResponse_kmsKeyId :: Lens' DescribeStreamProcessorResponse (Maybe Text)
describeStreamProcessorResponse_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe Text
a -> DescribeStreamProcessorResponse
s {$sel:kmsKeyId:DescribeStreamProcessorResponse' :: Maybe Text
kmsKeyId = Maybe Text
a} :: DescribeStreamProcessorResponse)

-- | The time, in Unix format, the stream processor was last updated. For
-- example, when the stream processor moves from a running state to a
-- failed state, or when the user starts or stops the stream processor.
describeStreamProcessorResponse_lastUpdateTimestamp :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe Prelude.UTCTime)
describeStreamProcessorResponse_lastUpdateTimestamp :: Lens' DescribeStreamProcessorResponse (Maybe UTCTime)
describeStreamProcessorResponse_lastUpdateTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe POSIX
lastUpdateTimestamp :: Maybe POSIX
$sel:lastUpdateTimestamp:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe POSIX
lastUpdateTimestamp} -> Maybe POSIX
lastUpdateTimestamp) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe POSIX
a -> DescribeStreamProcessorResponse
s {$sel:lastUpdateTimestamp:DescribeStreamProcessorResponse' :: Maybe POSIX
lastUpdateTimestamp = Maybe POSIX
a} :: DescribeStreamProcessorResponse) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Name of the stream processor.
describeStreamProcessorResponse_name :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe Prelude.Text)
describeStreamProcessorResponse_name :: Lens' DescribeStreamProcessorResponse (Maybe Text)
describeStreamProcessorResponse_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe Text
name :: Maybe Text
$sel:name:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe Text
name} -> Maybe Text
name) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe Text
a -> DescribeStreamProcessorResponse
s {$sel:name:DescribeStreamProcessorResponse' :: Maybe Text
name = Maybe Text
a} :: DescribeStreamProcessorResponse)

-- | Undocumented member.
describeStreamProcessorResponse_notificationChannel :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe StreamProcessorNotificationChannel)
describeStreamProcessorResponse_notificationChannel :: Lens'
  DescribeStreamProcessorResponse
  (Maybe StreamProcessorNotificationChannel)
describeStreamProcessorResponse_notificationChannel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe StreamProcessorNotificationChannel
notificationChannel :: Maybe StreamProcessorNotificationChannel
$sel:notificationChannel:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse
-> Maybe StreamProcessorNotificationChannel
notificationChannel} -> Maybe StreamProcessorNotificationChannel
notificationChannel) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe StreamProcessorNotificationChannel
a -> DescribeStreamProcessorResponse
s {$sel:notificationChannel:DescribeStreamProcessorResponse' :: Maybe StreamProcessorNotificationChannel
notificationChannel = Maybe StreamProcessorNotificationChannel
a} :: DescribeStreamProcessorResponse)

-- | Kinesis data stream to which Amazon Rekognition Video puts the analysis
-- results.
describeStreamProcessorResponse_output :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe StreamProcessorOutput)
describeStreamProcessorResponse_output :: Lens' DescribeStreamProcessorResponse (Maybe StreamProcessorOutput)
describeStreamProcessorResponse_output = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe StreamProcessorOutput
output :: Maybe StreamProcessorOutput
$sel:output:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe StreamProcessorOutput
output} -> Maybe StreamProcessorOutput
output) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe StreamProcessorOutput
a -> DescribeStreamProcessorResponse
s {$sel:output:DescribeStreamProcessorResponse' :: Maybe StreamProcessorOutput
output = Maybe StreamProcessorOutput
a} :: DescribeStreamProcessorResponse)

-- | Specifies locations in the frames where Amazon Rekognition checks for
-- objects or people. This is an optional parameter for label detection
-- stream processors.
describeStreamProcessorResponse_regionsOfInterest :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe [RegionOfInterest])
describeStreamProcessorResponse_regionsOfInterest :: Lens' DescribeStreamProcessorResponse (Maybe [RegionOfInterest])
describeStreamProcessorResponse_regionsOfInterest = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe [RegionOfInterest]
regionsOfInterest :: Maybe [RegionOfInterest]
$sel:regionsOfInterest:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe [RegionOfInterest]
regionsOfInterest} -> Maybe [RegionOfInterest]
regionsOfInterest) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe [RegionOfInterest]
a -> DescribeStreamProcessorResponse
s {$sel:regionsOfInterest:DescribeStreamProcessorResponse' :: Maybe [RegionOfInterest]
regionsOfInterest = Maybe [RegionOfInterest]
a} :: DescribeStreamProcessorResponse) 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

-- | ARN of the IAM role that allows access to the stream processor.
describeStreamProcessorResponse_roleArn :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe Prelude.Text)
describeStreamProcessorResponse_roleArn :: Lens' DescribeStreamProcessorResponse (Maybe Text)
describeStreamProcessorResponse_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe Text
a -> DescribeStreamProcessorResponse
s {$sel:roleArn:DescribeStreamProcessorResponse' :: Maybe Text
roleArn = Maybe Text
a} :: DescribeStreamProcessorResponse)

-- | Input parameters used in a streaming video analyzed by a stream
-- processor. You can use @FaceSearch@ to recognize faces in a streaming
-- video, or you can use @ConnectedHome@ to detect labels.
describeStreamProcessorResponse_settings :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe StreamProcessorSettings)
describeStreamProcessorResponse_settings :: Lens'
  DescribeStreamProcessorResponse (Maybe StreamProcessorSettings)
describeStreamProcessorResponse_settings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe StreamProcessorSettings
settings :: Maybe StreamProcessorSettings
$sel:settings:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe StreamProcessorSettings
settings} -> Maybe StreamProcessorSettings
settings) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe StreamProcessorSettings
a -> DescribeStreamProcessorResponse
s {$sel:settings:DescribeStreamProcessorResponse' :: Maybe StreamProcessorSettings
settings = Maybe StreamProcessorSettings
a} :: DescribeStreamProcessorResponse)

-- | Current status of the stream processor.
describeStreamProcessorResponse_status :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe StreamProcessorStatus)
describeStreamProcessorResponse_status :: Lens' DescribeStreamProcessorResponse (Maybe StreamProcessorStatus)
describeStreamProcessorResponse_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe StreamProcessorStatus
status :: Maybe StreamProcessorStatus
$sel:status:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe StreamProcessorStatus
status} -> Maybe StreamProcessorStatus
status) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe StreamProcessorStatus
a -> DescribeStreamProcessorResponse
s {$sel:status:DescribeStreamProcessorResponse' :: Maybe StreamProcessorStatus
status = Maybe StreamProcessorStatus
a} :: DescribeStreamProcessorResponse)

-- | Detailed status message about the stream processor.
describeStreamProcessorResponse_statusMessage :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe Prelude.Text)
describeStreamProcessorResponse_statusMessage :: Lens' DescribeStreamProcessorResponse (Maybe Text)
describeStreamProcessorResponse_statusMessage = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe Text
statusMessage :: Maybe Text
$sel:statusMessage:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe Text
statusMessage} -> Maybe Text
statusMessage) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe Text
a -> DescribeStreamProcessorResponse
s {$sel:statusMessage:DescribeStreamProcessorResponse' :: Maybe Text
statusMessage = Maybe Text
a} :: DescribeStreamProcessorResponse)

-- | ARN of the stream processor.
describeStreamProcessorResponse_streamProcessorArn :: Lens.Lens' DescribeStreamProcessorResponse (Prelude.Maybe Prelude.Text)
describeStreamProcessorResponse_streamProcessorArn :: Lens' DescribeStreamProcessorResponse (Maybe Text)
describeStreamProcessorResponse_streamProcessorArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeStreamProcessorResponse' {Maybe Text
streamProcessorArn :: Maybe Text
$sel:streamProcessorArn:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe Text
streamProcessorArn} -> Maybe Text
streamProcessorArn) (\s :: DescribeStreamProcessorResponse
s@DescribeStreamProcessorResponse' {} Maybe Text
a -> DescribeStreamProcessorResponse
s {$sel:streamProcessorArn:DescribeStreamProcessorResponse' :: Maybe Text
streamProcessorArn = Maybe Text
a} :: DescribeStreamProcessorResponse)

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

instance
  Prelude.NFData
    DescribeStreamProcessorResponse
  where
  rnf :: DescribeStreamProcessorResponse -> ()
rnf DescribeStreamProcessorResponse' {Int
Maybe [RegionOfInterest]
Maybe Text
Maybe POSIX
Maybe StreamProcessorDataSharingPreference
Maybe StreamProcessorInput
Maybe StreamProcessorNotificationChannel
Maybe StreamProcessorOutput
Maybe StreamProcessorSettings
Maybe StreamProcessorStatus
httpStatus :: Int
streamProcessorArn :: Maybe Text
statusMessage :: Maybe Text
status :: Maybe StreamProcessorStatus
settings :: Maybe StreamProcessorSettings
roleArn :: Maybe Text
regionsOfInterest :: Maybe [RegionOfInterest]
output :: Maybe StreamProcessorOutput
notificationChannel :: Maybe StreamProcessorNotificationChannel
name :: Maybe Text
lastUpdateTimestamp :: Maybe POSIX
kmsKeyId :: Maybe Text
input :: Maybe StreamProcessorInput
dataSharingPreference :: Maybe StreamProcessorDataSharingPreference
creationTimestamp :: Maybe POSIX
$sel:httpStatus:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Int
$sel:streamProcessorArn:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe Text
$sel:statusMessage:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe Text
$sel:status:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe StreamProcessorStatus
$sel:settings:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe StreamProcessorSettings
$sel:roleArn:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe Text
$sel:regionsOfInterest:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe [RegionOfInterest]
$sel:output:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe StreamProcessorOutput
$sel:notificationChannel:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse
-> Maybe StreamProcessorNotificationChannel
$sel:name:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe Text
$sel:lastUpdateTimestamp:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe POSIX
$sel:kmsKeyId:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe Text
$sel:input:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe StreamProcessorInput
$sel:dataSharingPreference:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse
-> Maybe StreamProcessorDataSharingPreference
$sel:creationTimestamp:DescribeStreamProcessorResponse' :: DescribeStreamProcessorResponse -> Maybe POSIX
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamProcessorDataSharingPreference
dataSharingPreference
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamProcessorInput
input
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdateTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamProcessorNotificationChannel
notificationChannel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamProcessorOutput
output
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [RegionOfInterest]
regionsOfInterest
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamProcessorSettings
settings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StreamProcessorStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusMessage
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamProcessorArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus