{-# 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.MediaConnect.UpdateFlowOutput
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates an existing flow output.
module Amazonka.MediaConnect.UpdateFlowOutput
  ( -- * Creating a Request
    UpdateFlowOutput (..),
    newUpdateFlowOutput,

    -- * Request Lenses
    updateFlowOutput_cidrAllowList,
    updateFlowOutput_description,
    updateFlowOutput_destination,
    updateFlowOutput_encryption,
    updateFlowOutput_maxLatency,
    updateFlowOutput_mediaStreamOutputConfigurations,
    updateFlowOutput_minLatency,
    updateFlowOutput_port,
    updateFlowOutput_protocol,
    updateFlowOutput_remoteId,
    updateFlowOutput_senderControlPort,
    updateFlowOutput_senderIpAddress,
    updateFlowOutput_smoothingLatency,
    updateFlowOutput_streamId,
    updateFlowOutput_vpcInterfaceAttachment,
    updateFlowOutput_flowArn,
    updateFlowOutput_outputArn,

    -- * Destructuring the Response
    UpdateFlowOutputResponse (..),
    newUpdateFlowOutputResponse,

    -- * Response Lenses
    updateFlowOutputResponse_flowArn,
    updateFlowOutputResponse_output,
    updateFlowOutputResponse_httpStatus,
  )
where

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

-- | The fields that you want to update in the output.
--
-- /See:/ 'newUpdateFlowOutput' smart constructor.
data UpdateFlowOutput = UpdateFlowOutput'
  { -- | The range of IP addresses that should be allowed to initiate output
    -- requests to this flow. These IP addresses should be in the form of a
    -- Classless Inter-Domain Routing (CIDR) block; for example, 10.0.0.0\/16.
    UpdateFlowOutput -> Maybe [Text]
cidrAllowList :: Prelude.Maybe [Prelude.Text],
    -- | A description of the output. This description appears only on the AWS
    -- Elemental MediaConnect console and will not be seen by the end user.
    UpdateFlowOutput -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The IP address where you want to send the output.
    UpdateFlowOutput -> Maybe Text
destination :: Prelude.Maybe Prelude.Text,
    -- | The type of key used for the encryption. If no keyType is provided, the
    -- service will use the default setting (static-key).
    UpdateFlowOutput -> Maybe UpdateEncryption
encryption :: Prelude.Maybe UpdateEncryption,
    -- | The maximum latency in milliseconds. This parameter applies only to
    -- RIST-based, Zixi-based, and Fujitsu-based streams.
    UpdateFlowOutput -> Maybe Int
maxLatency :: Prelude.Maybe Prelude.Int,
    -- | The media streams that are associated with the output, and the
    -- parameters for those associations.
    UpdateFlowOutput -> Maybe [MediaStreamOutputConfigurationRequest]
mediaStreamOutputConfigurations :: Prelude.Maybe [MediaStreamOutputConfigurationRequest],
    -- | The minimum latency in milliseconds for SRT-based streams. In streams
    -- that use the SRT protocol, this value that you set on your MediaConnect
    -- source or output represents the minimal potential latency of that
    -- connection. The latency of the stream is set to the highest number
    -- between the sender’s minimum latency and the receiver’s minimum latency.
    UpdateFlowOutput -> Maybe Int
minLatency :: Prelude.Maybe Prelude.Int,
    -- | The port to use when content is distributed to this output.
    UpdateFlowOutput -> Maybe Int
port :: Prelude.Maybe Prelude.Int,
    -- | The protocol to use for the output.
    UpdateFlowOutput -> Maybe Protocol
protocol :: Prelude.Maybe Protocol,
    -- | The remote ID for the Zixi-pull stream.
    UpdateFlowOutput -> Maybe Text
remoteId :: Prelude.Maybe Prelude.Text,
    -- | The port that the flow uses to send outbound requests to initiate
    -- connection with the sender.
    UpdateFlowOutput -> Maybe Int
senderControlPort :: Prelude.Maybe Prelude.Int,
    -- | The IP address that the flow communicates with to initiate connection
    -- with the sender.
    UpdateFlowOutput -> Maybe Text
senderIpAddress :: Prelude.Maybe Prelude.Text,
    -- | The smoothing latency in milliseconds for RIST, RTP, and RTP-FEC
    -- streams.
    UpdateFlowOutput -> Maybe Int
smoothingLatency :: Prelude.Maybe Prelude.Int,
    -- | The stream ID that you want to use for this transport. This parameter
    -- applies only to Zixi-based streams.
    UpdateFlowOutput -> Maybe Text
streamId :: Prelude.Maybe Prelude.Text,
    -- | The name of the VPC interface attachment to use for this output.
    UpdateFlowOutput -> Maybe VpcInterfaceAttachment
vpcInterfaceAttachment :: Prelude.Maybe VpcInterfaceAttachment,
    -- | The flow that is associated with the output that you want to update.
    UpdateFlowOutput -> Text
flowArn :: Prelude.Text,
    -- | The ARN of the output that you want to update.
    UpdateFlowOutput -> Text
outputArn :: Prelude.Text
  }
  deriving (UpdateFlowOutput -> UpdateFlowOutput -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFlowOutput -> UpdateFlowOutput -> Bool
$c/= :: UpdateFlowOutput -> UpdateFlowOutput -> Bool
== :: UpdateFlowOutput -> UpdateFlowOutput -> Bool
$c== :: UpdateFlowOutput -> UpdateFlowOutput -> Bool
Prelude.Eq, ReadPrec [UpdateFlowOutput]
ReadPrec UpdateFlowOutput
Int -> ReadS UpdateFlowOutput
ReadS [UpdateFlowOutput]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFlowOutput]
$creadListPrec :: ReadPrec [UpdateFlowOutput]
readPrec :: ReadPrec UpdateFlowOutput
$creadPrec :: ReadPrec UpdateFlowOutput
readList :: ReadS [UpdateFlowOutput]
$creadList :: ReadS [UpdateFlowOutput]
readsPrec :: Int -> ReadS UpdateFlowOutput
$creadsPrec :: Int -> ReadS UpdateFlowOutput
Prelude.Read, Int -> UpdateFlowOutput -> ShowS
[UpdateFlowOutput] -> ShowS
UpdateFlowOutput -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFlowOutput] -> ShowS
$cshowList :: [UpdateFlowOutput] -> ShowS
show :: UpdateFlowOutput -> String
$cshow :: UpdateFlowOutput -> String
showsPrec :: Int -> UpdateFlowOutput -> ShowS
$cshowsPrec :: Int -> UpdateFlowOutput -> ShowS
Prelude.Show, forall x. Rep UpdateFlowOutput x -> UpdateFlowOutput
forall x. UpdateFlowOutput -> Rep UpdateFlowOutput x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateFlowOutput x -> UpdateFlowOutput
$cfrom :: forall x. UpdateFlowOutput -> Rep UpdateFlowOutput x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFlowOutput' 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:
--
-- 'cidrAllowList', 'updateFlowOutput_cidrAllowList' - The range of IP addresses that should be allowed to initiate output
-- requests to this flow. These IP addresses should be in the form of a
-- Classless Inter-Domain Routing (CIDR) block; for example, 10.0.0.0\/16.
--
-- 'description', 'updateFlowOutput_description' - A description of the output. This description appears only on the AWS
-- Elemental MediaConnect console and will not be seen by the end user.
--
-- 'destination', 'updateFlowOutput_destination' - The IP address where you want to send the output.
--
-- 'encryption', 'updateFlowOutput_encryption' - The type of key used for the encryption. If no keyType is provided, the
-- service will use the default setting (static-key).
--
-- 'maxLatency', 'updateFlowOutput_maxLatency' - The maximum latency in milliseconds. This parameter applies only to
-- RIST-based, Zixi-based, and Fujitsu-based streams.
--
-- 'mediaStreamOutputConfigurations', 'updateFlowOutput_mediaStreamOutputConfigurations' - The media streams that are associated with the output, and the
-- parameters for those associations.
--
-- 'minLatency', 'updateFlowOutput_minLatency' - The minimum latency in milliseconds for SRT-based streams. In streams
-- that use the SRT protocol, this value that you set on your MediaConnect
-- source or output represents the minimal potential latency of that
-- connection. The latency of the stream is set to the highest number
-- between the sender’s minimum latency and the receiver’s minimum latency.
--
-- 'port', 'updateFlowOutput_port' - The port to use when content is distributed to this output.
--
-- 'protocol', 'updateFlowOutput_protocol' - The protocol to use for the output.
--
-- 'remoteId', 'updateFlowOutput_remoteId' - The remote ID for the Zixi-pull stream.
--
-- 'senderControlPort', 'updateFlowOutput_senderControlPort' - The port that the flow uses to send outbound requests to initiate
-- connection with the sender.
--
-- 'senderIpAddress', 'updateFlowOutput_senderIpAddress' - The IP address that the flow communicates with to initiate connection
-- with the sender.
--
-- 'smoothingLatency', 'updateFlowOutput_smoothingLatency' - The smoothing latency in milliseconds for RIST, RTP, and RTP-FEC
-- streams.
--
-- 'streamId', 'updateFlowOutput_streamId' - The stream ID that you want to use for this transport. This parameter
-- applies only to Zixi-based streams.
--
-- 'vpcInterfaceAttachment', 'updateFlowOutput_vpcInterfaceAttachment' - The name of the VPC interface attachment to use for this output.
--
-- 'flowArn', 'updateFlowOutput_flowArn' - The flow that is associated with the output that you want to update.
--
-- 'outputArn', 'updateFlowOutput_outputArn' - The ARN of the output that you want to update.
newUpdateFlowOutput ::
  -- | 'flowArn'
  Prelude.Text ->
  -- | 'outputArn'
  Prelude.Text ->
  UpdateFlowOutput
newUpdateFlowOutput :: Text -> Text -> UpdateFlowOutput
newUpdateFlowOutput Text
pFlowArn_ Text
pOutputArn_ =
  UpdateFlowOutput'
    { $sel:cidrAllowList:UpdateFlowOutput' :: Maybe [Text]
cidrAllowList = forall a. Maybe a
Prelude.Nothing,
      $sel:description:UpdateFlowOutput' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:destination:UpdateFlowOutput' :: Maybe Text
destination = forall a. Maybe a
Prelude.Nothing,
      $sel:encryption:UpdateFlowOutput' :: Maybe UpdateEncryption
encryption = forall a. Maybe a
Prelude.Nothing,
      $sel:maxLatency:UpdateFlowOutput' :: Maybe Int
maxLatency = forall a. Maybe a
Prelude.Nothing,
      $sel:mediaStreamOutputConfigurations:UpdateFlowOutput' :: Maybe [MediaStreamOutputConfigurationRequest]
mediaStreamOutputConfigurations = forall a. Maybe a
Prelude.Nothing,
      $sel:minLatency:UpdateFlowOutput' :: Maybe Int
minLatency = forall a. Maybe a
Prelude.Nothing,
      $sel:port:UpdateFlowOutput' :: Maybe Int
port = forall a. Maybe a
Prelude.Nothing,
      $sel:protocol:UpdateFlowOutput' :: Maybe Protocol
protocol = forall a. Maybe a
Prelude.Nothing,
      $sel:remoteId:UpdateFlowOutput' :: Maybe Text
remoteId = forall a. Maybe a
Prelude.Nothing,
      $sel:senderControlPort:UpdateFlowOutput' :: Maybe Int
senderControlPort = forall a. Maybe a
Prelude.Nothing,
      $sel:senderIpAddress:UpdateFlowOutput' :: Maybe Text
senderIpAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:smoothingLatency:UpdateFlowOutput' :: Maybe Int
smoothingLatency = forall a. Maybe a
Prelude.Nothing,
      $sel:streamId:UpdateFlowOutput' :: Maybe Text
streamId = forall a. Maybe a
Prelude.Nothing,
      $sel:vpcInterfaceAttachment:UpdateFlowOutput' :: Maybe VpcInterfaceAttachment
vpcInterfaceAttachment = forall a. Maybe a
Prelude.Nothing,
      $sel:flowArn:UpdateFlowOutput' :: Text
flowArn = Text
pFlowArn_,
      $sel:outputArn:UpdateFlowOutput' :: Text
outputArn = Text
pOutputArn_
    }

-- | The range of IP addresses that should be allowed to initiate output
-- requests to this flow. These IP addresses should be in the form of a
-- Classless Inter-Domain Routing (CIDR) block; for example, 10.0.0.0\/16.
updateFlowOutput_cidrAllowList :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe [Prelude.Text])
updateFlowOutput_cidrAllowList :: Lens' UpdateFlowOutput (Maybe [Text])
updateFlowOutput_cidrAllowList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe [Text]
cidrAllowList :: Maybe [Text]
$sel:cidrAllowList:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe [Text]
cidrAllowList} -> Maybe [Text]
cidrAllowList) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe [Text]
a -> UpdateFlowOutput
s {$sel:cidrAllowList:UpdateFlowOutput' :: Maybe [Text]
cidrAllowList = Maybe [Text]
a} :: UpdateFlowOutput) 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

-- | A description of the output. This description appears only on the AWS
-- Elemental MediaConnect console and will not be seen by the end user.
updateFlowOutput_description :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe Prelude.Text)
updateFlowOutput_description :: Lens' UpdateFlowOutput (Maybe Text)
updateFlowOutput_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe Text
description :: Maybe Text
$sel:description:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe Text
a -> UpdateFlowOutput
s {$sel:description:UpdateFlowOutput' :: Maybe Text
description = Maybe Text
a} :: UpdateFlowOutput)

-- | The IP address where you want to send the output.
updateFlowOutput_destination :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe Prelude.Text)
updateFlowOutput_destination :: Lens' UpdateFlowOutput (Maybe Text)
updateFlowOutput_destination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe Text
destination :: Maybe Text
$sel:destination:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
destination} -> Maybe Text
destination) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe Text
a -> UpdateFlowOutput
s {$sel:destination:UpdateFlowOutput' :: Maybe Text
destination = Maybe Text
a} :: UpdateFlowOutput)

-- | The type of key used for the encryption. If no keyType is provided, the
-- service will use the default setting (static-key).
updateFlowOutput_encryption :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe UpdateEncryption)
updateFlowOutput_encryption :: Lens' UpdateFlowOutput (Maybe UpdateEncryption)
updateFlowOutput_encryption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe UpdateEncryption
encryption :: Maybe UpdateEncryption
$sel:encryption:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe UpdateEncryption
encryption} -> Maybe UpdateEncryption
encryption) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe UpdateEncryption
a -> UpdateFlowOutput
s {$sel:encryption:UpdateFlowOutput' :: Maybe UpdateEncryption
encryption = Maybe UpdateEncryption
a} :: UpdateFlowOutput)

-- | The maximum latency in milliseconds. This parameter applies only to
-- RIST-based, Zixi-based, and Fujitsu-based streams.
updateFlowOutput_maxLatency :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe Prelude.Int)
updateFlowOutput_maxLatency :: Lens' UpdateFlowOutput (Maybe Int)
updateFlowOutput_maxLatency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe Int
maxLatency :: Maybe Int
$sel:maxLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
maxLatency} -> Maybe Int
maxLatency) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe Int
a -> UpdateFlowOutput
s {$sel:maxLatency:UpdateFlowOutput' :: Maybe Int
maxLatency = Maybe Int
a} :: UpdateFlowOutput)

-- | The media streams that are associated with the output, and the
-- parameters for those associations.
updateFlowOutput_mediaStreamOutputConfigurations :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe [MediaStreamOutputConfigurationRequest])
updateFlowOutput_mediaStreamOutputConfigurations :: Lens'
  UpdateFlowOutput (Maybe [MediaStreamOutputConfigurationRequest])
updateFlowOutput_mediaStreamOutputConfigurations = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe [MediaStreamOutputConfigurationRequest]
mediaStreamOutputConfigurations :: Maybe [MediaStreamOutputConfigurationRequest]
$sel:mediaStreamOutputConfigurations:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe [MediaStreamOutputConfigurationRequest]
mediaStreamOutputConfigurations} -> Maybe [MediaStreamOutputConfigurationRequest]
mediaStreamOutputConfigurations) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe [MediaStreamOutputConfigurationRequest]
a -> UpdateFlowOutput
s {$sel:mediaStreamOutputConfigurations:UpdateFlowOutput' :: Maybe [MediaStreamOutputConfigurationRequest]
mediaStreamOutputConfigurations = Maybe [MediaStreamOutputConfigurationRequest]
a} :: UpdateFlowOutput) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (f :: * -> *) (g :: * -> *) s t a b.
(Functor f, Functor g) =>
AnIso s t a b -> Iso (f s) (g t) (f a) (g b)
Lens.mapping forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The minimum latency in milliseconds for SRT-based streams. In streams
-- that use the SRT protocol, this value that you set on your MediaConnect
-- source or output represents the minimal potential latency of that
-- connection. The latency of the stream is set to the highest number
-- between the sender’s minimum latency and the receiver’s minimum latency.
updateFlowOutput_minLatency :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe Prelude.Int)
updateFlowOutput_minLatency :: Lens' UpdateFlowOutput (Maybe Int)
updateFlowOutput_minLatency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe Int
minLatency :: Maybe Int
$sel:minLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
minLatency} -> Maybe Int
minLatency) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe Int
a -> UpdateFlowOutput
s {$sel:minLatency:UpdateFlowOutput' :: Maybe Int
minLatency = Maybe Int
a} :: UpdateFlowOutput)

-- | The port to use when content is distributed to this output.
updateFlowOutput_port :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe Prelude.Int)
updateFlowOutput_port :: Lens' UpdateFlowOutput (Maybe Int)
updateFlowOutput_port = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe Int
port :: Maybe Int
$sel:port:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
port} -> Maybe Int
port) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe Int
a -> UpdateFlowOutput
s {$sel:port:UpdateFlowOutput' :: Maybe Int
port = Maybe Int
a} :: UpdateFlowOutput)

-- | The protocol to use for the output.
updateFlowOutput_protocol :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe Protocol)
updateFlowOutput_protocol :: Lens' UpdateFlowOutput (Maybe Protocol)
updateFlowOutput_protocol = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe Protocol
protocol :: Maybe Protocol
$sel:protocol:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Protocol
protocol} -> Maybe Protocol
protocol) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe Protocol
a -> UpdateFlowOutput
s {$sel:protocol:UpdateFlowOutput' :: Maybe Protocol
protocol = Maybe Protocol
a} :: UpdateFlowOutput)

-- | The remote ID for the Zixi-pull stream.
updateFlowOutput_remoteId :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe Prelude.Text)
updateFlowOutput_remoteId :: Lens' UpdateFlowOutput (Maybe Text)
updateFlowOutput_remoteId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe Text
remoteId :: Maybe Text
$sel:remoteId:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
remoteId} -> Maybe Text
remoteId) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe Text
a -> UpdateFlowOutput
s {$sel:remoteId:UpdateFlowOutput' :: Maybe Text
remoteId = Maybe Text
a} :: UpdateFlowOutput)

-- | The port that the flow uses to send outbound requests to initiate
-- connection with the sender.
updateFlowOutput_senderControlPort :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe Prelude.Int)
updateFlowOutput_senderControlPort :: Lens' UpdateFlowOutput (Maybe Int)
updateFlowOutput_senderControlPort = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe Int
senderControlPort :: Maybe Int
$sel:senderControlPort:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
senderControlPort} -> Maybe Int
senderControlPort) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe Int
a -> UpdateFlowOutput
s {$sel:senderControlPort:UpdateFlowOutput' :: Maybe Int
senderControlPort = Maybe Int
a} :: UpdateFlowOutput)

-- | The IP address that the flow communicates with to initiate connection
-- with the sender.
updateFlowOutput_senderIpAddress :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe Prelude.Text)
updateFlowOutput_senderIpAddress :: Lens' UpdateFlowOutput (Maybe Text)
updateFlowOutput_senderIpAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe Text
senderIpAddress :: Maybe Text
$sel:senderIpAddress:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
senderIpAddress} -> Maybe Text
senderIpAddress) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe Text
a -> UpdateFlowOutput
s {$sel:senderIpAddress:UpdateFlowOutput' :: Maybe Text
senderIpAddress = Maybe Text
a} :: UpdateFlowOutput)

-- | The smoothing latency in milliseconds for RIST, RTP, and RTP-FEC
-- streams.
updateFlowOutput_smoothingLatency :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe Prelude.Int)
updateFlowOutput_smoothingLatency :: Lens' UpdateFlowOutput (Maybe Int)
updateFlowOutput_smoothingLatency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe Int
smoothingLatency :: Maybe Int
$sel:smoothingLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
smoothingLatency} -> Maybe Int
smoothingLatency) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe Int
a -> UpdateFlowOutput
s {$sel:smoothingLatency:UpdateFlowOutput' :: Maybe Int
smoothingLatency = Maybe Int
a} :: UpdateFlowOutput)

-- | The stream ID that you want to use for this transport. This parameter
-- applies only to Zixi-based streams.
updateFlowOutput_streamId :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe Prelude.Text)
updateFlowOutput_streamId :: Lens' UpdateFlowOutput (Maybe Text)
updateFlowOutput_streamId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe Text
streamId :: Maybe Text
$sel:streamId:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
streamId} -> Maybe Text
streamId) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe Text
a -> UpdateFlowOutput
s {$sel:streamId:UpdateFlowOutput' :: Maybe Text
streamId = Maybe Text
a} :: UpdateFlowOutput)

-- | The name of the VPC interface attachment to use for this output.
updateFlowOutput_vpcInterfaceAttachment :: Lens.Lens' UpdateFlowOutput (Prelude.Maybe VpcInterfaceAttachment)
updateFlowOutput_vpcInterfaceAttachment :: Lens' UpdateFlowOutput (Maybe VpcInterfaceAttachment)
updateFlowOutput_vpcInterfaceAttachment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Maybe VpcInterfaceAttachment
vpcInterfaceAttachment :: Maybe VpcInterfaceAttachment
$sel:vpcInterfaceAttachment:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe VpcInterfaceAttachment
vpcInterfaceAttachment} -> Maybe VpcInterfaceAttachment
vpcInterfaceAttachment) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Maybe VpcInterfaceAttachment
a -> UpdateFlowOutput
s {$sel:vpcInterfaceAttachment:UpdateFlowOutput' :: Maybe VpcInterfaceAttachment
vpcInterfaceAttachment = Maybe VpcInterfaceAttachment
a} :: UpdateFlowOutput)

-- | The flow that is associated with the output that you want to update.
updateFlowOutput_flowArn :: Lens.Lens' UpdateFlowOutput Prelude.Text
updateFlowOutput_flowArn :: Lens' UpdateFlowOutput Text
updateFlowOutput_flowArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Text
flowArn :: Text
$sel:flowArn:UpdateFlowOutput' :: UpdateFlowOutput -> Text
flowArn} -> Text
flowArn) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Text
a -> UpdateFlowOutput
s {$sel:flowArn:UpdateFlowOutput' :: Text
flowArn = Text
a} :: UpdateFlowOutput)

-- | The ARN of the output that you want to update.
updateFlowOutput_outputArn :: Lens.Lens' UpdateFlowOutput Prelude.Text
updateFlowOutput_outputArn :: Lens' UpdateFlowOutput Text
updateFlowOutput_outputArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutput' {Text
outputArn :: Text
$sel:outputArn:UpdateFlowOutput' :: UpdateFlowOutput -> Text
outputArn} -> Text
outputArn) (\s :: UpdateFlowOutput
s@UpdateFlowOutput' {} Text
a -> UpdateFlowOutput
s {$sel:outputArn:UpdateFlowOutput' :: Text
outputArn = Text
a} :: UpdateFlowOutput)

instance Core.AWSRequest UpdateFlowOutput where
  type
    AWSResponse UpdateFlowOutput =
      UpdateFlowOutputResponse
  request :: (Service -> Service)
-> UpdateFlowOutput -> Request UpdateFlowOutput
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateFlowOutput
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateFlowOutput)))
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 Text -> Maybe Output -> Int -> UpdateFlowOutputResponse
UpdateFlowOutputResponse'
            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
"flowArn")
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable UpdateFlowOutput where
  hashWithSalt :: Int -> UpdateFlowOutput -> Int
hashWithSalt Int
_salt UpdateFlowOutput' {Maybe Int
Maybe [Text]
Maybe [MediaStreamOutputConfigurationRequest]
Maybe Text
Maybe Protocol
Maybe UpdateEncryption
Maybe VpcInterfaceAttachment
Text
outputArn :: Text
flowArn :: Text
vpcInterfaceAttachment :: Maybe VpcInterfaceAttachment
streamId :: Maybe Text
smoothingLatency :: Maybe Int
senderIpAddress :: Maybe Text
senderControlPort :: Maybe Int
remoteId :: Maybe Text
protocol :: Maybe Protocol
port :: Maybe Int
minLatency :: Maybe Int
mediaStreamOutputConfigurations :: Maybe [MediaStreamOutputConfigurationRequest]
maxLatency :: Maybe Int
encryption :: Maybe UpdateEncryption
destination :: Maybe Text
description :: Maybe Text
cidrAllowList :: Maybe [Text]
$sel:outputArn:UpdateFlowOutput' :: UpdateFlowOutput -> Text
$sel:flowArn:UpdateFlowOutput' :: UpdateFlowOutput -> Text
$sel:vpcInterfaceAttachment:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe VpcInterfaceAttachment
$sel:streamId:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:smoothingLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:senderIpAddress:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:senderControlPort:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:remoteId:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:protocol:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Protocol
$sel:port:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:minLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:mediaStreamOutputConfigurations:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe [MediaStreamOutputConfigurationRequest]
$sel:maxLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:encryption:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe UpdateEncryption
$sel:destination:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:description:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:cidrAllowList:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
cidrAllowList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
destination
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UpdateEncryption
encryption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxLatency
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [MediaStreamOutputConfigurationRequest]
mediaStreamOutputConfigurations
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
minLatency
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
port
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Protocol
protocol
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
remoteId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
senderControlPort
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
senderIpAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
smoothingLatency
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
streamId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe VpcInterfaceAttachment
vpcInterfaceAttachment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
flowArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
outputArn

instance Prelude.NFData UpdateFlowOutput where
  rnf :: UpdateFlowOutput -> ()
rnf UpdateFlowOutput' {Maybe Int
Maybe [Text]
Maybe [MediaStreamOutputConfigurationRequest]
Maybe Text
Maybe Protocol
Maybe UpdateEncryption
Maybe VpcInterfaceAttachment
Text
outputArn :: Text
flowArn :: Text
vpcInterfaceAttachment :: Maybe VpcInterfaceAttachment
streamId :: Maybe Text
smoothingLatency :: Maybe Int
senderIpAddress :: Maybe Text
senderControlPort :: Maybe Int
remoteId :: Maybe Text
protocol :: Maybe Protocol
port :: Maybe Int
minLatency :: Maybe Int
mediaStreamOutputConfigurations :: Maybe [MediaStreamOutputConfigurationRequest]
maxLatency :: Maybe Int
encryption :: Maybe UpdateEncryption
destination :: Maybe Text
description :: Maybe Text
cidrAllowList :: Maybe [Text]
$sel:outputArn:UpdateFlowOutput' :: UpdateFlowOutput -> Text
$sel:flowArn:UpdateFlowOutput' :: UpdateFlowOutput -> Text
$sel:vpcInterfaceAttachment:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe VpcInterfaceAttachment
$sel:streamId:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:smoothingLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:senderIpAddress:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:senderControlPort:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:remoteId:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:protocol:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Protocol
$sel:port:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:minLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:mediaStreamOutputConfigurations:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe [MediaStreamOutputConfigurationRequest]
$sel:maxLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:encryption:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe UpdateEncryption
$sel:destination:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:description:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:cidrAllowList:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
cidrAllowList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
destination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe UpdateEncryption
encryption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxLatency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [MediaStreamOutputConfigurationRequest]
mediaStreamOutputConfigurations
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
minLatency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
port
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Protocol
protocol
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
remoteId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
senderControlPort
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
senderIpAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
smoothingLatency
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe VpcInterfaceAttachment
vpcInterfaceAttachment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
flowArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
outputArn

instance Data.ToHeaders UpdateFlowOutput where
  toHeaders :: UpdateFlowOutput -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON UpdateFlowOutput where
  toJSON :: UpdateFlowOutput -> Value
toJSON UpdateFlowOutput' {Maybe Int
Maybe [Text]
Maybe [MediaStreamOutputConfigurationRequest]
Maybe Text
Maybe Protocol
Maybe UpdateEncryption
Maybe VpcInterfaceAttachment
Text
outputArn :: Text
flowArn :: Text
vpcInterfaceAttachment :: Maybe VpcInterfaceAttachment
streamId :: Maybe Text
smoothingLatency :: Maybe Int
senderIpAddress :: Maybe Text
senderControlPort :: Maybe Int
remoteId :: Maybe Text
protocol :: Maybe Protocol
port :: Maybe Int
minLatency :: Maybe Int
mediaStreamOutputConfigurations :: Maybe [MediaStreamOutputConfigurationRequest]
maxLatency :: Maybe Int
encryption :: Maybe UpdateEncryption
destination :: Maybe Text
description :: Maybe Text
cidrAllowList :: Maybe [Text]
$sel:outputArn:UpdateFlowOutput' :: UpdateFlowOutput -> Text
$sel:flowArn:UpdateFlowOutput' :: UpdateFlowOutput -> Text
$sel:vpcInterfaceAttachment:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe VpcInterfaceAttachment
$sel:streamId:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:smoothingLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:senderIpAddress:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:senderControlPort:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:remoteId:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:protocol:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Protocol
$sel:port:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:minLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:mediaStreamOutputConfigurations:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe [MediaStreamOutputConfigurationRequest]
$sel:maxLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:encryption:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe UpdateEncryption
$sel:destination:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:description:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:cidrAllowList:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"cidrAllowList" 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 [Text]
cidrAllowList,
            (Key
"description" 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 Text
description,
            (Key
"destination" 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 Text
destination,
            (Key
"encryption" 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 UpdateEncryption
encryption,
            (Key
"maxLatency" 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 Int
maxLatency,
            (Key
"mediaStreamOutputConfigurations" 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 [MediaStreamOutputConfigurationRequest]
mediaStreamOutputConfigurations,
            (Key
"minLatency" 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 Int
minLatency,
            (Key
"port" 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 Int
port,
            (Key
"protocol" 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 Protocol
protocol,
            (Key
"remoteId" 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 Text
remoteId,
            (Key
"senderControlPort" 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 Int
senderControlPort,
            (Key
"senderIpAddress" 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 Text
senderIpAddress,
            (Key
"smoothingLatency" 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 Int
smoothingLatency,
            (Key
"streamId" 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 Text
streamId,
            (Key
"vpcInterfaceAttachment" 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 VpcInterfaceAttachment
vpcInterfaceAttachment
          ]
      )

instance Data.ToPath UpdateFlowOutput where
  toPath :: UpdateFlowOutput -> ByteString
toPath UpdateFlowOutput' {Maybe Int
Maybe [Text]
Maybe [MediaStreamOutputConfigurationRequest]
Maybe Text
Maybe Protocol
Maybe UpdateEncryption
Maybe VpcInterfaceAttachment
Text
outputArn :: Text
flowArn :: Text
vpcInterfaceAttachment :: Maybe VpcInterfaceAttachment
streamId :: Maybe Text
smoothingLatency :: Maybe Int
senderIpAddress :: Maybe Text
senderControlPort :: Maybe Int
remoteId :: Maybe Text
protocol :: Maybe Protocol
port :: Maybe Int
minLatency :: Maybe Int
mediaStreamOutputConfigurations :: Maybe [MediaStreamOutputConfigurationRequest]
maxLatency :: Maybe Int
encryption :: Maybe UpdateEncryption
destination :: Maybe Text
description :: Maybe Text
cidrAllowList :: Maybe [Text]
$sel:outputArn:UpdateFlowOutput' :: UpdateFlowOutput -> Text
$sel:flowArn:UpdateFlowOutput' :: UpdateFlowOutput -> Text
$sel:vpcInterfaceAttachment:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe VpcInterfaceAttachment
$sel:streamId:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:smoothingLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:senderIpAddress:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:senderControlPort:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:remoteId:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:protocol:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Protocol
$sel:port:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:minLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:mediaStreamOutputConfigurations:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe [MediaStreamOutputConfigurationRequest]
$sel:maxLatency:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Int
$sel:encryption:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe UpdateEncryption
$sel:destination:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:description:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe Text
$sel:cidrAllowList:UpdateFlowOutput' :: UpdateFlowOutput -> Maybe [Text]
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/v1/flows/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
flowArn,
        ByteString
"/outputs/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
outputArn
      ]

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

-- | /See:/ 'newUpdateFlowOutputResponse' smart constructor.
data UpdateFlowOutputResponse = UpdateFlowOutputResponse'
  { -- | The ARN of the flow that is associated with the updated output.
    UpdateFlowOutputResponse -> Maybe Text
flowArn :: Prelude.Maybe Prelude.Text,
    -- | The new settings of the output that you updated.
    UpdateFlowOutputResponse -> Maybe Output
output :: Prelude.Maybe Output,
    -- | The response's http status code.
    UpdateFlowOutputResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (UpdateFlowOutputResponse -> UpdateFlowOutputResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateFlowOutputResponse -> UpdateFlowOutputResponse -> Bool
$c/= :: UpdateFlowOutputResponse -> UpdateFlowOutputResponse -> Bool
== :: UpdateFlowOutputResponse -> UpdateFlowOutputResponse -> Bool
$c== :: UpdateFlowOutputResponse -> UpdateFlowOutputResponse -> Bool
Prelude.Eq, ReadPrec [UpdateFlowOutputResponse]
ReadPrec UpdateFlowOutputResponse
Int -> ReadS UpdateFlowOutputResponse
ReadS [UpdateFlowOutputResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateFlowOutputResponse]
$creadListPrec :: ReadPrec [UpdateFlowOutputResponse]
readPrec :: ReadPrec UpdateFlowOutputResponse
$creadPrec :: ReadPrec UpdateFlowOutputResponse
readList :: ReadS [UpdateFlowOutputResponse]
$creadList :: ReadS [UpdateFlowOutputResponse]
readsPrec :: Int -> ReadS UpdateFlowOutputResponse
$creadsPrec :: Int -> ReadS UpdateFlowOutputResponse
Prelude.Read, Int -> UpdateFlowOutputResponse -> ShowS
[UpdateFlowOutputResponse] -> ShowS
UpdateFlowOutputResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateFlowOutputResponse] -> ShowS
$cshowList :: [UpdateFlowOutputResponse] -> ShowS
show :: UpdateFlowOutputResponse -> String
$cshow :: UpdateFlowOutputResponse -> String
showsPrec :: Int -> UpdateFlowOutputResponse -> ShowS
$cshowsPrec :: Int -> UpdateFlowOutputResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateFlowOutputResponse x -> UpdateFlowOutputResponse
forall x.
UpdateFlowOutputResponse -> Rep UpdateFlowOutputResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateFlowOutputResponse x -> UpdateFlowOutputResponse
$cfrom :: forall x.
UpdateFlowOutputResponse -> Rep UpdateFlowOutputResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateFlowOutputResponse' 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:
--
-- 'flowArn', 'updateFlowOutputResponse_flowArn' - The ARN of the flow that is associated with the updated output.
--
-- 'output', 'updateFlowOutputResponse_output' - The new settings of the output that you updated.
--
-- 'httpStatus', 'updateFlowOutputResponse_httpStatus' - The response's http status code.
newUpdateFlowOutputResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateFlowOutputResponse
newUpdateFlowOutputResponse :: Int -> UpdateFlowOutputResponse
newUpdateFlowOutputResponse Int
pHttpStatus_ =
  UpdateFlowOutputResponse'
    { $sel:flowArn:UpdateFlowOutputResponse' :: Maybe Text
flowArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:output:UpdateFlowOutputResponse' :: Maybe Output
output = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateFlowOutputResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ARN of the flow that is associated with the updated output.
updateFlowOutputResponse_flowArn :: Lens.Lens' UpdateFlowOutputResponse (Prelude.Maybe Prelude.Text)
updateFlowOutputResponse_flowArn :: Lens' UpdateFlowOutputResponse (Maybe Text)
updateFlowOutputResponse_flowArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutputResponse' {Maybe Text
flowArn :: Maybe Text
$sel:flowArn:UpdateFlowOutputResponse' :: UpdateFlowOutputResponse -> Maybe Text
flowArn} -> Maybe Text
flowArn) (\s :: UpdateFlowOutputResponse
s@UpdateFlowOutputResponse' {} Maybe Text
a -> UpdateFlowOutputResponse
s {$sel:flowArn:UpdateFlowOutputResponse' :: Maybe Text
flowArn = Maybe Text
a} :: UpdateFlowOutputResponse)

-- | The new settings of the output that you updated.
updateFlowOutputResponse_output :: Lens.Lens' UpdateFlowOutputResponse (Prelude.Maybe Output)
updateFlowOutputResponse_output :: Lens' UpdateFlowOutputResponse (Maybe Output)
updateFlowOutputResponse_output = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateFlowOutputResponse' {Maybe Output
output :: Maybe Output
$sel:output:UpdateFlowOutputResponse' :: UpdateFlowOutputResponse -> Maybe Output
output} -> Maybe Output
output) (\s :: UpdateFlowOutputResponse
s@UpdateFlowOutputResponse' {} Maybe Output
a -> UpdateFlowOutputResponse
s {$sel:output:UpdateFlowOutputResponse' :: Maybe Output
output = Maybe Output
a} :: UpdateFlowOutputResponse)

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

instance Prelude.NFData UpdateFlowOutputResponse where
  rnf :: UpdateFlowOutputResponse -> ()
rnf UpdateFlowOutputResponse' {Int
Maybe Text
Maybe Output
httpStatus :: Int
output :: Maybe Output
flowArn :: Maybe Text
$sel:httpStatus:UpdateFlowOutputResponse' :: UpdateFlowOutputResponse -> Int
$sel:output:UpdateFlowOutputResponse' :: UpdateFlowOutputResponse -> Maybe Output
$sel:flowArn:UpdateFlowOutputResponse' :: UpdateFlowOutputResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
flowArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Output
output
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus