{-# 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.EC2.CreateFlowLogs
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates one or more flow logs to capture information about IP traffic
-- for a specific network interface, subnet, or VPC.
--
-- Flow log data for a monitored network interface is recorded as flow log
-- records, which are log events consisting of fields that describe the
-- traffic flow. For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/flow-logs.html#flow-log-records Flow log records>
-- in the /Amazon Virtual Private Cloud User Guide/.
--
-- When publishing to CloudWatch Logs, flow log records are published to a
-- log group, and each network interface has a unique log stream in the log
-- group. When publishing to Amazon S3, flow log records for all of the
-- monitored network interfaces are published to a single log file object
-- that is stored in the specified bucket.
--
-- For more information, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/flow-logs.html VPC Flow Logs>
-- in the /Amazon Virtual Private Cloud User Guide/.
module Amazonka.EC2.CreateFlowLogs
  ( -- * Creating a Request
    CreateFlowLogs (..),
    newCreateFlowLogs,

    -- * Request Lenses
    createFlowLogs_clientToken,
    createFlowLogs_deliverCrossAccountRole,
    createFlowLogs_deliverLogsPermissionArn,
    createFlowLogs_destinationOptions,
    createFlowLogs_dryRun,
    createFlowLogs_logDestination,
    createFlowLogs_logDestinationType,
    createFlowLogs_logFormat,
    createFlowLogs_logGroupName,
    createFlowLogs_maxAggregationInterval,
    createFlowLogs_tagSpecifications,
    createFlowLogs_trafficType,
    createFlowLogs_resourceIds,
    createFlowLogs_resourceType,

    -- * Destructuring the Response
    CreateFlowLogsResponse (..),
    newCreateFlowLogsResponse,

    -- * Response Lenses
    createFlowLogsResponse_clientToken,
    createFlowLogsResponse_flowLogIds,
    createFlowLogsResponse_unsuccessful,
    createFlowLogsResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateFlowLogs' smart constructor.
data CreateFlowLogs = CreateFlowLogs'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. For more information, see
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Run_Instance_Idempotency.html How to ensure idempotency>.
    CreateFlowLogs -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the IAM role that allows Amazon EC2 to publish flow logs
    -- across accounts.
    CreateFlowLogs -> Maybe Text
deliverCrossAccountRole :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the IAM role that allows Amazon EC2 to publish flow logs to a
    -- CloudWatch Logs log group in your account.
    --
    -- This parameter is required if the destination type is @cloud-watch-logs@
    -- and unsupported otherwise.
    CreateFlowLogs -> Maybe Text
deliverLogsPermissionArn :: Prelude.Maybe Prelude.Text,
    -- | The destination options.
    CreateFlowLogs -> Maybe DestinationOptionsRequest
destinationOptions :: Prelude.Maybe DestinationOptionsRequest,
    -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    CreateFlowLogs -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The destination for the flow log data. The meaning of this parameter
    -- depends on the destination type.
    --
    -- -   If the destination type is @cloud-watch-logs@, specify the ARN of a
    --     CloudWatch Logs log group. For example:
    --
    --     arn:aws:logs:/region/:/account_id/:log-group:/my_group/
    --
    --     Alternatively, use the @LogGroupName@ parameter.
    --
    -- -   If the destination type is @s3@, specify the ARN of an S3 bucket.
    --     For example:
    --
    --     arn:aws:s3:::/my_bucket/\//my_subfolder/\/
    --
    --     The subfolder is optional. Note that you can\'t use @AWSLogs@ as a
    --     subfolder name.
    --
    -- -   If the destination type is @kinesis-data-firehose@, specify the ARN
    --     of a Kinesis Data Firehose delivery stream. For example:
    --
    --     arn:aws:firehose:/region/:/account_id/:deliverystream:/my_stream/
    CreateFlowLogs -> Maybe Text
logDestination :: Prelude.Maybe Prelude.Text,
    -- | The type of destination for the flow log data.
    --
    -- Default: @cloud-watch-logs@
    CreateFlowLogs -> Maybe LogDestinationType
logDestinationType :: Prelude.Maybe LogDestinationType,
    -- | The fields to include in the flow log record. List the fields in the
    -- order in which they should appear. If you omit this parameter, the flow
    -- log is created using the default format. If you specify this parameter,
    -- you must include at least one field. For more information about the
    -- available fields, see
    -- <https://docs.aws.amazon.com/vpc/latest/userguide/flow-logs.html#flow-log-records Flow log records>
    -- in the /Amazon VPC User Guide/ or
    -- <https://docs.aws.amazon.com/vpc/latest/tgw/tgw-flow-logs.html#flow-log-records Transit Gateway Flow Log records>
    -- in the /Amazon Web Services Transit Gateway Guide/.
    --
    -- Specify the fields using the @${field-id}@ format, separated by spaces.
    -- For the CLI, surround this parameter value with single quotes on Linux
    -- or double quotes on Windows.
    CreateFlowLogs -> Maybe Text
logFormat :: Prelude.Maybe Prelude.Text,
    -- | The name of a new or existing CloudWatch Logs log group where Amazon EC2
    -- publishes your flow logs.
    --
    -- This parameter is valid only if the destination type is
    -- @cloud-watch-logs@.
    CreateFlowLogs -> Maybe Text
logGroupName :: Prelude.Maybe Prelude.Text,
    -- | The maximum interval of time during which a flow of packets is captured
    -- and aggregated into a flow log record. The possible values are 60
    -- seconds (1 minute) or 600 seconds (10 minutes). This parameter must be
    -- 60 seconds for transit gateway resource types.
    --
    -- When a network interface is attached to a
    -- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Nitro-based instance>,
    -- the aggregation interval is always 60 seconds or less, regardless of the
    -- value that you specify.
    --
    -- Default: 600
    CreateFlowLogs -> Maybe Int
maxAggregationInterval :: Prelude.Maybe Prelude.Int,
    -- | The tags to apply to the flow logs.
    CreateFlowLogs -> Maybe [TagSpecification]
tagSpecifications :: Prelude.Maybe [TagSpecification],
    -- | The type of traffic to monitor (accepted traffic, rejected traffic, or
    -- all traffic). This parameter is not supported for transit gateway
    -- resource types. It is required for the other resource types.
    CreateFlowLogs -> Maybe TrafficType
trafficType :: Prelude.Maybe TrafficType,
    -- | The IDs of the resources to monitor. For example, if the resource type
    -- is @VPC@, specify the IDs of the VPCs.
    --
    -- Constraints: Maximum of 25 for transit gateway resource types. Maximum
    -- of 1000 for the other resource types.
    CreateFlowLogs -> [Text]
resourceIds :: [Prelude.Text],
    -- | The type of resource to monitor.
    CreateFlowLogs -> FlowLogsResourceType
resourceType :: FlowLogsResourceType
  }
  deriving (CreateFlowLogs -> CreateFlowLogs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFlowLogs -> CreateFlowLogs -> Bool
$c/= :: CreateFlowLogs -> CreateFlowLogs -> Bool
== :: CreateFlowLogs -> CreateFlowLogs -> Bool
$c== :: CreateFlowLogs -> CreateFlowLogs -> Bool
Prelude.Eq, ReadPrec [CreateFlowLogs]
ReadPrec CreateFlowLogs
Int -> ReadS CreateFlowLogs
ReadS [CreateFlowLogs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFlowLogs]
$creadListPrec :: ReadPrec [CreateFlowLogs]
readPrec :: ReadPrec CreateFlowLogs
$creadPrec :: ReadPrec CreateFlowLogs
readList :: ReadS [CreateFlowLogs]
$creadList :: ReadS [CreateFlowLogs]
readsPrec :: Int -> ReadS CreateFlowLogs
$creadsPrec :: Int -> ReadS CreateFlowLogs
Prelude.Read, Int -> CreateFlowLogs -> ShowS
[CreateFlowLogs] -> ShowS
CreateFlowLogs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFlowLogs] -> ShowS
$cshowList :: [CreateFlowLogs] -> ShowS
show :: CreateFlowLogs -> String
$cshow :: CreateFlowLogs -> String
showsPrec :: Int -> CreateFlowLogs -> ShowS
$cshowsPrec :: Int -> CreateFlowLogs -> ShowS
Prelude.Show, forall x. Rep CreateFlowLogs x -> CreateFlowLogs
forall x. CreateFlowLogs -> Rep CreateFlowLogs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFlowLogs x -> CreateFlowLogs
$cfrom :: forall x. CreateFlowLogs -> Rep CreateFlowLogs x
Prelude.Generic)

-- |
-- Create a value of 'CreateFlowLogs' 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:
--
-- 'clientToken', 'createFlowLogs_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Run_Instance_Idempotency.html How to ensure idempotency>.
--
-- 'deliverCrossAccountRole', 'createFlowLogs_deliverCrossAccountRole' - The ARN of the IAM role that allows Amazon EC2 to publish flow logs
-- across accounts.
--
-- 'deliverLogsPermissionArn', 'createFlowLogs_deliverLogsPermissionArn' - The ARN of the IAM role that allows Amazon EC2 to publish flow logs to a
-- CloudWatch Logs log group in your account.
--
-- This parameter is required if the destination type is @cloud-watch-logs@
-- and unsupported otherwise.
--
-- 'destinationOptions', 'createFlowLogs_destinationOptions' - The destination options.
--
-- 'dryRun', 'createFlowLogs_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'logDestination', 'createFlowLogs_logDestination' - The destination for the flow log data. The meaning of this parameter
-- depends on the destination type.
--
-- -   If the destination type is @cloud-watch-logs@, specify the ARN of a
--     CloudWatch Logs log group. For example:
--
--     arn:aws:logs:/region/:/account_id/:log-group:/my_group/
--
--     Alternatively, use the @LogGroupName@ parameter.
--
-- -   If the destination type is @s3@, specify the ARN of an S3 bucket.
--     For example:
--
--     arn:aws:s3:::/my_bucket/\//my_subfolder/\/
--
--     The subfolder is optional. Note that you can\'t use @AWSLogs@ as a
--     subfolder name.
--
-- -   If the destination type is @kinesis-data-firehose@, specify the ARN
--     of a Kinesis Data Firehose delivery stream. For example:
--
--     arn:aws:firehose:/region/:/account_id/:deliverystream:/my_stream/
--
-- 'logDestinationType', 'createFlowLogs_logDestinationType' - The type of destination for the flow log data.
--
-- Default: @cloud-watch-logs@
--
-- 'logFormat', 'createFlowLogs_logFormat' - The fields to include in the flow log record. List the fields in the
-- order in which they should appear. If you omit this parameter, the flow
-- log is created using the default format. If you specify this parameter,
-- you must include at least one field. For more information about the
-- available fields, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/flow-logs.html#flow-log-records Flow log records>
-- in the /Amazon VPC User Guide/ or
-- <https://docs.aws.amazon.com/vpc/latest/tgw/tgw-flow-logs.html#flow-log-records Transit Gateway Flow Log records>
-- in the /Amazon Web Services Transit Gateway Guide/.
--
-- Specify the fields using the @${field-id}@ format, separated by spaces.
-- For the CLI, surround this parameter value with single quotes on Linux
-- or double quotes on Windows.
--
-- 'logGroupName', 'createFlowLogs_logGroupName' - The name of a new or existing CloudWatch Logs log group where Amazon EC2
-- publishes your flow logs.
--
-- This parameter is valid only if the destination type is
-- @cloud-watch-logs@.
--
-- 'maxAggregationInterval', 'createFlowLogs_maxAggregationInterval' - The maximum interval of time during which a flow of packets is captured
-- and aggregated into a flow log record. The possible values are 60
-- seconds (1 minute) or 600 seconds (10 minutes). This parameter must be
-- 60 seconds for transit gateway resource types.
--
-- When a network interface is attached to a
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Nitro-based instance>,
-- the aggregation interval is always 60 seconds or less, regardless of the
-- value that you specify.
--
-- Default: 600
--
-- 'tagSpecifications', 'createFlowLogs_tagSpecifications' - The tags to apply to the flow logs.
--
-- 'trafficType', 'createFlowLogs_trafficType' - The type of traffic to monitor (accepted traffic, rejected traffic, or
-- all traffic). This parameter is not supported for transit gateway
-- resource types. It is required for the other resource types.
--
-- 'resourceIds', 'createFlowLogs_resourceIds' - The IDs of the resources to monitor. For example, if the resource type
-- is @VPC@, specify the IDs of the VPCs.
--
-- Constraints: Maximum of 25 for transit gateway resource types. Maximum
-- of 1000 for the other resource types.
--
-- 'resourceType', 'createFlowLogs_resourceType' - The type of resource to monitor.
newCreateFlowLogs ::
  -- | 'resourceType'
  FlowLogsResourceType ->
  CreateFlowLogs
newCreateFlowLogs :: FlowLogsResourceType -> CreateFlowLogs
newCreateFlowLogs FlowLogsResourceType
pResourceType_ =
  CreateFlowLogs'
    { $sel:clientToken:CreateFlowLogs' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:deliverCrossAccountRole:CreateFlowLogs' :: Maybe Text
deliverCrossAccountRole = forall a. Maybe a
Prelude.Nothing,
      $sel:deliverLogsPermissionArn:CreateFlowLogs' :: Maybe Text
deliverLogsPermissionArn = forall a. Maybe a
Prelude.Nothing,
      $sel:destinationOptions:CreateFlowLogs' :: Maybe DestinationOptionsRequest
destinationOptions = forall a. Maybe a
Prelude.Nothing,
      $sel:dryRun:CreateFlowLogs' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:logDestination:CreateFlowLogs' :: Maybe Text
logDestination = forall a. Maybe a
Prelude.Nothing,
      $sel:logDestinationType:CreateFlowLogs' :: Maybe LogDestinationType
logDestinationType = forall a. Maybe a
Prelude.Nothing,
      $sel:logFormat:CreateFlowLogs' :: Maybe Text
logFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:logGroupName:CreateFlowLogs' :: Maybe Text
logGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:maxAggregationInterval:CreateFlowLogs' :: Maybe Int
maxAggregationInterval = forall a. Maybe a
Prelude.Nothing,
      $sel:tagSpecifications:CreateFlowLogs' :: Maybe [TagSpecification]
tagSpecifications = forall a. Maybe a
Prelude.Nothing,
      $sel:trafficType:CreateFlowLogs' :: Maybe TrafficType
trafficType = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceIds:CreateFlowLogs' :: [Text]
resourceIds = forall a. Monoid a => a
Prelude.mempty,
      $sel:resourceType:CreateFlowLogs' :: FlowLogsResourceType
resourceType = FlowLogsResourceType
pResourceType_
    }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. For more information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/Run_Instance_Idempotency.html How to ensure idempotency>.
createFlowLogs_clientToken :: Lens.Lens' CreateFlowLogs (Prelude.Maybe Prelude.Text)
createFlowLogs_clientToken :: Lens' CreateFlowLogs (Maybe Text)
createFlowLogs_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} Maybe Text
a -> CreateFlowLogs
s {$sel:clientToken:CreateFlowLogs' :: Maybe Text
clientToken = Maybe Text
a} :: CreateFlowLogs)

-- | The ARN of the IAM role that allows Amazon EC2 to publish flow logs
-- across accounts.
createFlowLogs_deliverCrossAccountRole :: Lens.Lens' CreateFlowLogs (Prelude.Maybe Prelude.Text)
createFlowLogs_deliverCrossAccountRole :: Lens' CreateFlowLogs (Maybe Text)
createFlowLogs_deliverCrossAccountRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {Maybe Text
deliverCrossAccountRole :: Maybe Text
$sel:deliverCrossAccountRole:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
deliverCrossAccountRole} -> Maybe Text
deliverCrossAccountRole) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} Maybe Text
a -> CreateFlowLogs
s {$sel:deliverCrossAccountRole:CreateFlowLogs' :: Maybe Text
deliverCrossAccountRole = Maybe Text
a} :: CreateFlowLogs)

-- | The ARN of the IAM role that allows Amazon EC2 to publish flow logs to a
-- CloudWatch Logs log group in your account.
--
-- This parameter is required if the destination type is @cloud-watch-logs@
-- and unsupported otherwise.
createFlowLogs_deliverLogsPermissionArn :: Lens.Lens' CreateFlowLogs (Prelude.Maybe Prelude.Text)
createFlowLogs_deliverLogsPermissionArn :: Lens' CreateFlowLogs (Maybe Text)
createFlowLogs_deliverLogsPermissionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {Maybe Text
deliverLogsPermissionArn :: Maybe Text
$sel:deliverLogsPermissionArn:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
deliverLogsPermissionArn} -> Maybe Text
deliverLogsPermissionArn) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} Maybe Text
a -> CreateFlowLogs
s {$sel:deliverLogsPermissionArn:CreateFlowLogs' :: Maybe Text
deliverLogsPermissionArn = Maybe Text
a} :: CreateFlowLogs)

-- | The destination options.
createFlowLogs_destinationOptions :: Lens.Lens' CreateFlowLogs (Prelude.Maybe DestinationOptionsRequest)
createFlowLogs_destinationOptions :: Lens' CreateFlowLogs (Maybe DestinationOptionsRequest)
createFlowLogs_destinationOptions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {Maybe DestinationOptionsRequest
destinationOptions :: Maybe DestinationOptionsRequest
$sel:destinationOptions:CreateFlowLogs' :: CreateFlowLogs -> Maybe DestinationOptionsRequest
destinationOptions} -> Maybe DestinationOptionsRequest
destinationOptions) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} Maybe DestinationOptionsRequest
a -> CreateFlowLogs
s {$sel:destinationOptions:CreateFlowLogs' :: Maybe DestinationOptionsRequest
destinationOptions = Maybe DestinationOptionsRequest
a} :: CreateFlowLogs)

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
createFlowLogs_dryRun :: Lens.Lens' CreateFlowLogs (Prelude.Maybe Prelude.Bool)
createFlowLogs_dryRun :: Lens' CreateFlowLogs (Maybe Bool)
createFlowLogs_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:CreateFlowLogs' :: CreateFlowLogs -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} Maybe Bool
a -> CreateFlowLogs
s {$sel:dryRun:CreateFlowLogs' :: Maybe Bool
dryRun = Maybe Bool
a} :: CreateFlowLogs)

-- | The destination for the flow log data. The meaning of this parameter
-- depends on the destination type.
--
-- -   If the destination type is @cloud-watch-logs@, specify the ARN of a
--     CloudWatch Logs log group. For example:
--
--     arn:aws:logs:/region/:/account_id/:log-group:/my_group/
--
--     Alternatively, use the @LogGroupName@ parameter.
--
-- -   If the destination type is @s3@, specify the ARN of an S3 bucket.
--     For example:
--
--     arn:aws:s3:::/my_bucket/\//my_subfolder/\/
--
--     The subfolder is optional. Note that you can\'t use @AWSLogs@ as a
--     subfolder name.
--
-- -   If the destination type is @kinesis-data-firehose@, specify the ARN
--     of a Kinesis Data Firehose delivery stream. For example:
--
--     arn:aws:firehose:/region/:/account_id/:deliverystream:/my_stream/
createFlowLogs_logDestination :: Lens.Lens' CreateFlowLogs (Prelude.Maybe Prelude.Text)
createFlowLogs_logDestination :: Lens' CreateFlowLogs (Maybe Text)
createFlowLogs_logDestination = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {Maybe Text
logDestination :: Maybe Text
$sel:logDestination:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
logDestination} -> Maybe Text
logDestination) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} Maybe Text
a -> CreateFlowLogs
s {$sel:logDestination:CreateFlowLogs' :: Maybe Text
logDestination = Maybe Text
a} :: CreateFlowLogs)

-- | The type of destination for the flow log data.
--
-- Default: @cloud-watch-logs@
createFlowLogs_logDestinationType :: Lens.Lens' CreateFlowLogs (Prelude.Maybe LogDestinationType)
createFlowLogs_logDestinationType :: Lens' CreateFlowLogs (Maybe LogDestinationType)
createFlowLogs_logDestinationType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {Maybe LogDestinationType
logDestinationType :: Maybe LogDestinationType
$sel:logDestinationType:CreateFlowLogs' :: CreateFlowLogs -> Maybe LogDestinationType
logDestinationType} -> Maybe LogDestinationType
logDestinationType) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} Maybe LogDestinationType
a -> CreateFlowLogs
s {$sel:logDestinationType:CreateFlowLogs' :: Maybe LogDestinationType
logDestinationType = Maybe LogDestinationType
a} :: CreateFlowLogs)

-- | The fields to include in the flow log record. List the fields in the
-- order in which they should appear. If you omit this parameter, the flow
-- log is created using the default format. If you specify this parameter,
-- you must include at least one field. For more information about the
-- available fields, see
-- <https://docs.aws.amazon.com/vpc/latest/userguide/flow-logs.html#flow-log-records Flow log records>
-- in the /Amazon VPC User Guide/ or
-- <https://docs.aws.amazon.com/vpc/latest/tgw/tgw-flow-logs.html#flow-log-records Transit Gateway Flow Log records>
-- in the /Amazon Web Services Transit Gateway Guide/.
--
-- Specify the fields using the @${field-id}@ format, separated by spaces.
-- For the CLI, surround this parameter value with single quotes on Linux
-- or double quotes on Windows.
createFlowLogs_logFormat :: Lens.Lens' CreateFlowLogs (Prelude.Maybe Prelude.Text)
createFlowLogs_logFormat :: Lens' CreateFlowLogs (Maybe Text)
createFlowLogs_logFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {Maybe Text
logFormat :: Maybe Text
$sel:logFormat:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
logFormat} -> Maybe Text
logFormat) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} Maybe Text
a -> CreateFlowLogs
s {$sel:logFormat:CreateFlowLogs' :: Maybe Text
logFormat = Maybe Text
a} :: CreateFlowLogs)

-- | The name of a new or existing CloudWatch Logs log group where Amazon EC2
-- publishes your flow logs.
--
-- This parameter is valid only if the destination type is
-- @cloud-watch-logs@.
createFlowLogs_logGroupName :: Lens.Lens' CreateFlowLogs (Prelude.Maybe Prelude.Text)
createFlowLogs_logGroupName :: Lens' CreateFlowLogs (Maybe Text)
createFlowLogs_logGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {Maybe Text
logGroupName :: Maybe Text
$sel:logGroupName:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
logGroupName} -> Maybe Text
logGroupName) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} Maybe Text
a -> CreateFlowLogs
s {$sel:logGroupName:CreateFlowLogs' :: Maybe Text
logGroupName = Maybe Text
a} :: CreateFlowLogs)

-- | The maximum interval of time during which a flow of packets is captured
-- and aggregated into a flow log record. The possible values are 60
-- seconds (1 minute) or 600 seconds (10 minutes). This parameter must be
-- 60 seconds for transit gateway resource types.
--
-- When a network interface is attached to a
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/instance-types.html#ec2-nitro-instances Nitro-based instance>,
-- the aggregation interval is always 60 seconds or less, regardless of the
-- value that you specify.
--
-- Default: 600
createFlowLogs_maxAggregationInterval :: Lens.Lens' CreateFlowLogs (Prelude.Maybe Prelude.Int)
createFlowLogs_maxAggregationInterval :: Lens' CreateFlowLogs (Maybe Int)
createFlowLogs_maxAggregationInterval = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {Maybe Int
maxAggregationInterval :: Maybe Int
$sel:maxAggregationInterval:CreateFlowLogs' :: CreateFlowLogs -> Maybe Int
maxAggregationInterval} -> Maybe Int
maxAggregationInterval) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} Maybe Int
a -> CreateFlowLogs
s {$sel:maxAggregationInterval:CreateFlowLogs' :: Maybe Int
maxAggregationInterval = Maybe Int
a} :: CreateFlowLogs)

-- | The tags to apply to the flow logs.
createFlowLogs_tagSpecifications :: Lens.Lens' CreateFlowLogs (Prelude.Maybe [TagSpecification])
createFlowLogs_tagSpecifications :: Lens' CreateFlowLogs (Maybe [TagSpecification])
createFlowLogs_tagSpecifications = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {Maybe [TagSpecification]
tagSpecifications :: Maybe [TagSpecification]
$sel:tagSpecifications:CreateFlowLogs' :: CreateFlowLogs -> Maybe [TagSpecification]
tagSpecifications} -> Maybe [TagSpecification]
tagSpecifications) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} Maybe [TagSpecification]
a -> CreateFlowLogs
s {$sel:tagSpecifications:CreateFlowLogs' :: Maybe [TagSpecification]
tagSpecifications = Maybe [TagSpecification]
a} :: CreateFlowLogs) 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 type of traffic to monitor (accepted traffic, rejected traffic, or
-- all traffic). This parameter is not supported for transit gateway
-- resource types. It is required for the other resource types.
createFlowLogs_trafficType :: Lens.Lens' CreateFlowLogs (Prelude.Maybe TrafficType)
createFlowLogs_trafficType :: Lens' CreateFlowLogs (Maybe TrafficType)
createFlowLogs_trafficType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {Maybe TrafficType
trafficType :: Maybe TrafficType
$sel:trafficType:CreateFlowLogs' :: CreateFlowLogs -> Maybe TrafficType
trafficType} -> Maybe TrafficType
trafficType) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} Maybe TrafficType
a -> CreateFlowLogs
s {$sel:trafficType:CreateFlowLogs' :: Maybe TrafficType
trafficType = Maybe TrafficType
a} :: CreateFlowLogs)

-- | The IDs of the resources to monitor. For example, if the resource type
-- is @VPC@, specify the IDs of the VPCs.
--
-- Constraints: Maximum of 25 for transit gateway resource types. Maximum
-- of 1000 for the other resource types.
createFlowLogs_resourceIds :: Lens.Lens' CreateFlowLogs [Prelude.Text]
createFlowLogs_resourceIds :: Lens' CreateFlowLogs [Text]
createFlowLogs_resourceIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {[Text]
resourceIds :: [Text]
$sel:resourceIds:CreateFlowLogs' :: CreateFlowLogs -> [Text]
resourceIds} -> [Text]
resourceIds) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} [Text]
a -> CreateFlowLogs
s {$sel:resourceIds:CreateFlowLogs' :: [Text]
resourceIds = [Text]
a} :: CreateFlowLogs) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The type of resource to monitor.
createFlowLogs_resourceType :: Lens.Lens' CreateFlowLogs FlowLogsResourceType
createFlowLogs_resourceType :: Lens' CreateFlowLogs FlowLogsResourceType
createFlowLogs_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogs' {FlowLogsResourceType
resourceType :: FlowLogsResourceType
$sel:resourceType:CreateFlowLogs' :: CreateFlowLogs -> FlowLogsResourceType
resourceType} -> FlowLogsResourceType
resourceType) (\s :: CreateFlowLogs
s@CreateFlowLogs' {} FlowLogsResourceType
a -> CreateFlowLogs
s {$sel:resourceType:CreateFlowLogs' :: FlowLogsResourceType
resourceType = FlowLogsResourceType
a} :: CreateFlowLogs)

instance Core.AWSRequest CreateFlowLogs where
  type
    AWSResponse CreateFlowLogs =
      CreateFlowLogsResponse
  request :: (Service -> Service) -> CreateFlowLogs -> Request CreateFlowLogs
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateFlowLogs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateFlowLogs)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text
-> Maybe [Text]
-> Maybe [UnsuccessfulItem]
-> Int
-> CreateFlowLogsResponse
CreateFlowLogsResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"clientToken")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"flowLogIdSet"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ( [Node]
x
                            forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"unsuccessful"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                            forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
Prelude.>>= forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"item")
                        )
            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 CreateFlowLogs where
  hashWithSalt :: Int -> CreateFlowLogs -> Int
hashWithSalt Int
_salt CreateFlowLogs' {[Text]
Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe DestinationOptionsRequest
Maybe LogDestinationType
Maybe TrafficType
FlowLogsResourceType
resourceType :: FlowLogsResourceType
resourceIds :: [Text]
trafficType :: Maybe TrafficType
tagSpecifications :: Maybe [TagSpecification]
maxAggregationInterval :: Maybe Int
logGroupName :: Maybe Text
logFormat :: Maybe Text
logDestinationType :: Maybe LogDestinationType
logDestination :: Maybe Text
dryRun :: Maybe Bool
destinationOptions :: Maybe DestinationOptionsRequest
deliverLogsPermissionArn :: Maybe Text
deliverCrossAccountRole :: Maybe Text
clientToken :: Maybe Text
$sel:resourceType:CreateFlowLogs' :: CreateFlowLogs -> FlowLogsResourceType
$sel:resourceIds:CreateFlowLogs' :: CreateFlowLogs -> [Text]
$sel:trafficType:CreateFlowLogs' :: CreateFlowLogs -> Maybe TrafficType
$sel:tagSpecifications:CreateFlowLogs' :: CreateFlowLogs -> Maybe [TagSpecification]
$sel:maxAggregationInterval:CreateFlowLogs' :: CreateFlowLogs -> Maybe Int
$sel:logGroupName:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:logFormat:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:logDestinationType:CreateFlowLogs' :: CreateFlowLogs -> Maybe LogDestinationType
$sel:logDestination:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:dryRun:CreateFlowLogs' :: CreateFlowLogs -> Maybe Bool
$sel:destinationOptions:CreateFlowLogs' :: CreateFlowLogs -> Maybe DestinationOptionsRequest
$sel:deliverLogsPermissionArn:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:deliverCrossAccountRole:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:clientToken:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deliverCrossAccountRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
deliverLogsPermissionArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DestinationOptionsRequest
destinationOptions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
logDestination
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LogDestinationType
logDestinationType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
logFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
logGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxAggregationInterval
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [TagSpecification]
tagSpecifications
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TrafficType
trafficType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Text]
resourceIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FlowLogsResourceType
resourceType

instance Prelude.NFData CreateFlowLogs where
  rnf :: CreateFlowLogs -> ()
rnf CreateFlowLogs' {[Text]
Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe DestinationOptionsRequest
Maybe LogDestinationType
Maybe TrafficType
FlowLogsResourceType
resourceType :: FlowLogsResourceType
resourceIds :: [Text]
trafficType :: Maybe TrafficType
tagSpecifications :: Maybe [TagSpecification]
maxAggregationInterval :: Maybe Int
logGroupName :: Maybe Text
logFormat :: Maybe Text
logDestinationType :: Maybe LogDestinationType
logDestination :: Maybe Text
dryRun :: Maybe Bool
destinationOptions :: Maybe DestinationOptionsRequest
deliverLogsPermissionArn :: Maybe Text
deliverCrossAccountRole :: Maybe Text
clientToken :: Maybe Text
$sel:resourceType:CreateFlowLogs' :: CreateFlowLogs -> FlowLogsResourceType
$sel:resourceIds:CreateFlowLogs' :: CreateFlowLogs -> [Text]
$sel:trafficType:CreateFlowLogs' :: CreateFlowLogs -> Maybe TrafficType
$sel:tagSpecifications:CreateFlowLogs' :: CreateFlowLogs -> Maybe [TagSpecification]
$sel:maxAggregationInterval:CreateFlowLogs' :: CreateFlowLogs -> Maybe Int
$sel:logGroupName:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:logFormat:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:logDestinationType:CreateFlowLogs' :: CreateFlowLogs -> Maybe LogDestinationType
$sel:logDestination:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:dryRun:CreateFlowLogs' :: CreateFlowLogs -> Maybe Bool
$sel:destinationOptions:CreateFlowLogs' :: CreateFlowLogs -> Maybe DestinationOptionsRequest
$sel:deliverLogsPermissionArn:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:deliverCrossAccountRole:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:clientToken:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deliverCrossAccountRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
deliverLogsPermissionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DestinationOptionsRequest
destinationOptions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logDestination
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LogDestinationType
logDestinationType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxAggregationInterval
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [TagSpecification]
tagSpecifications
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TrafficType
trafficType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Text]
resourceIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FlowLogsResourceType
resourceType

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

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

instance Data.ToQuery CreateFlowLogs where
  toQuery :: CreateFlowLogs -> QueryString
toQuery CreateFlowLogs' {[Text]
Maybe Bool
Maybe Int
Maybe [TagSpecification]
Maybe Text
Maybe DestinationOptionsRequest
Maybe LogDestinationType
Maybe TrafficType
FlowLogsResourceType
resourceType :: FlowLogsResourceType
resourceIds :: [Text]
trafficType :: Maybe TrafficType
tagSpecifications :: Maybe [TagSpecification]
maxAggregationInterval :: Maybe Int
logGroupName :: Maybe Text
logFormat :: Maybe Text
logDestinationType :: Maybe LogDestinationType
logDestination :: Maybe Text
dryRun :: Maybe Bool
destinationOptions :: Maybe DestinationOptionsRequest
deliverLogsPermissionArn :: Maybe Text
deliverCrossAccountRole :: Maybe Text
clientToken :: Maybe Text
$sel:resourceType:CreateFlowLogs' :: CreateFlowLogs -> FlowLogsResourceType
$sel:resourceIds:CreateFlowLogs' :: CreateFlowLogs -> [Text]
$sel:trafficType:CreateFlowLogs' :: CreateFlowLogs -> Maybe TrafficType
$sel:tagSpecifications:CreateFlowLogs' :: CreateFlowLogs -> Maybe [TagSpecification]
$sel:maxAggregationInterval:CreateFlowLogs' :: CreateFlowLogs -> Maybe Int
$sel:logGroupName:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:logFormat:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:logDestinationType:CreateFlowLogs' :: CreateFlowLogs -> Maybe LogDestinationType
$sel:logDestination:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:dryRun:CreateFlowLogs' :: CreateFlowLogs -> Maybe Bool
$sel:destinationOptions:CreateFlowLogs' :: CreateFlowLogs -> Maybe DestinationOptionsRequest
$sel:deliverLogsPermissionArn:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:deliverCrossAccountRole:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
$sel:clientToken:CreateFlowLogs' :: CreateFlowLogs -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"CreateFlowLogs" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"ClientToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
clientToken,
        ByteString
"DeliverCrossAccountRole"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
deliverCrossAccountRole,
        ByteString
"DeliverLogsPermissionArn"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
deliverLogsPermissionArn,
        ByteString
"DestinationOptions" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe DestinationOptionsRequest
destinationOptions,
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"LogDestination" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
logDestination,
        ByteString
"LogDestinationType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe LogDestinationType
logDestinationType,
        ByteString
"LogFormat" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
logFormat,
        ByteString
"LogGroupName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
logGroupName,
        ByteString
"MaxAggregationInterval"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxAggregationInterval,
        forall a. ToQuery a => a -> QueryString
Data.toQuery
          ( forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"TagSpecification"
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [TagSpecification]
tagSpecifications
          ),
        ByteString
"TrafficType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TrafficType
trafficType,
        forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"ResourceId" [Text]
resourceIds,
        ByteString
"ResourceType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: FlowLogsResourceType
resourceType
      ]

-- | /See:/ 'newCreateFlowLogsResponse' smart constructor.
data CreateFlowLogsResponse = CreateFlowLogsResponse'
  { -- | Unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request.
    CreateFlowLogsResponse -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The IDs of the flow logs.
    CreateFlowLogsResponse -> Maybe [Text]
flowLogIds :: Prelude.Maybe [Prelude.Text],
    -- | Information about the flow logs that could not be created successfully.
    CreateFlowLogsResponse -> Maybe [UnsuccessfulItem]
unsuccessful :: Prelude.Maybe [UnsuccessfulItem],
    -- | The response's http status code.
    CreateFlowLogsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateFlowLogsResponse -> CreateFlowLogsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateFlowLogsResponse -> CreateFlowLogsResponse -> Bool
$c/= :: CreateFlowLogsResponse -> CreateFlowLogsResponse -> Bool
== :: CreateFlowLogsResponse -> CreateFlowLogsResponse -> Bool
$c== :: CreateFlowLogsResponse -> CreateFlowLogsResponse -> Bool
Prelude.Eq, ReadPrec [CreateFlowLogsResponse]
ReadPrec CreateFlowLogsResponse
Int -> ReadS CreateFlowLogsResponse
ReadS [CreateFlowLogsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateFlowLogsResponse]
$creadListPrec :: ReadPrec [CreateFlowLogsResponse]
readPrec :: ReadPrec CreateFlowLogsResponse
$creadPrec :: ReadPrec CreateFlowLogsResponse
readList :: ReadS [CreateFlowLogsResponse]
$creadList :: ReadS [CreateFlowLogsResponse]
readsPrec :: Int -> ReadS CreateFlowLogsResponse
$creadsPrec :: Int -> ReadS CreateFlowLogsResponse
Prelude.Read, Int -> CreateFlowLogsResponse -> ShowS
[CreateFlowLogsResponse] -> ShowS
CreateFlowLogsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateFlowLogsResponse] -> ShowS
$cshowList :: [CreateFlowLogsResponse] -> ShowS
show :: CreateFlowLogsResponse -> String
$cshow :: CreateFlowLogsResponse -> String
showsPrec :: Int -> CreateFlowLogsResponse -> ShowS
$cshowsPrec :: Int -> CreateFlowLogsResponse -> ShowS
Prelude.Show, forall x. Rep CreateFlowLogsResponse x -> CreateFlowLogsResponse
forall x. CreateFlowLogsResponse -> Rep CreateFlowLogsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateFlowLogsResponse x -> CreateFlowLogsResponse
$cfrom :: forall x. CreateFlowLogsResponse -> Rep CreateFlowLogsResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateFlowLogsResponse' 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:
--
-- 'clientToken', 'createFlowLogsResponse_clientToken' - Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
--
-- 'flowLogIds', 'createFlowLogsResponse_flowLogIds' - The IDs of the flow logs.
--
-- 'unsuccessful', 'createFlowLogsResponse_unsuccessful' - Information about the flow logs that could not be created successfully.
--
-- 'httpStatus', 'createFlowLogsResponse_httpStatus' - The response's http status code.
newCreateFlowLogsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateFlowLogsResponse
newCreateFlowLogsResponse :: Int -> CreateFlowLogsResponse
newCreateFlowLogsResponse Int
pHttpStatus_ =
  CreateFlowLogsResponse'
    { $sel:clientToken:CreateFlowLogsResponse' :: Maybe Text
clientToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:flowLogIds:CreateFlowLogsResponse' :: Maybe [Text]
flowLogIds = forall a. Maybe a
Prelude.Nothing,
      $sel:unsuccessful:CreateFlowLogsResponse' :: Maybe [UnsuccessfulItem]
unsuccessful = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateFlowLogsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request.
createFlowLogsResponse_clientToken :: Lens.Lens' CreateFlowLogsResponse (Prelude.Maybe Prelude.Text)
createFlowLogsResponse_clientToken :: Lens' CreateFlowLogsResponse (Maybe Text)
createFlowLogsResponse_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogsResponse' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreateFlowLogsResponse' :: CreateFlowLogsResponse -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreateFlowLogsResponse
s@CreateFlowLogsResponse' {} Maybe Text
a -> CreateFlowLogsResponse
s {$sel:clientToken:CreateFlowLogsResponse' :: Maybe Text
clientToken = Maybe Text
a} :: CreateFlowLogsResponse)

-- | The IDs of the flow logs.
createFlowLogsResponse_flowLogIds :: Lens.Lens' CreateFlowLogsResponse (Prelude.Maybe [Prelude.Text])
createFlowLogsResponse_flowLogIds :: Lens' CreateFlowLogsResponse (Maybe [Text])
createFlowLogsResponse_flowLogIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogsResponse' {Maybe [Text]
flowLogIds :: Maybe [Text]
$sel:flowLogIds:CreateFlowLogsResponse' :: CreateFlowLogsResponse -> Maybe [Text]
flowLogIds} -> Maybe [Text]
flowLogIds) (\s :: CreateFlowLogsResponse
s@CreateFlowLogsResponse' {} Maybe [Text]
a -> CreateFlowLogsResponse
s {$sel:flowLogIds:CreateFlowLogsResponse' :: Maybe [Text]
flowLogIds = Maybe [Text]
a} :: CreateFlowLogsResponse) 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

-- | Information about the flow logs that could not be created successfully.
createFlowLogsResponse_unsuccessful :: Lens.Lens' CreateFlowLogsResponse (Prelude.Maybe [UnsuccessfulItem])
createFlowLogsResponse_unsuccessful :: Lens' CreateFlowLogsResponse (Maybe [UnsuccessfulItem])
createFlowLogsResponse_unsuccessful = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogsResponse' {Maybe [UnsuccessfulItem]
unsuccessful :: Maybe [UnsuccessfulItem]
$sel:unsuccessful:CreateFlowLogsResponse' :: CreateFlowLogsResponse -> Maybe [UnsuccessfulItem]
unsuccessful} -> Maybe [UnsuccessfulItem]
unsuccessful) (\s :: CreateFlowLogsResponse
s@CreateFlowLogsResponse' {} Maybe [UnsuccessfulItem]
a -> CreateFlowLogsResponse
s {$sel:unsuccessful:CreateFlowLogsResponse' :: Maybe [UnsuccessfulItem]
unsuccessful = Maybe [UnsuccessfulItem]
a} :: CreateFlowLogsResponse) 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 response's http status code.
createFlowLogsResponse_httpStatus :: Lens.Lens' CreateFlowLogsResponse Prelude.Int
createFlowLogsResponse_httpStatus :: Lens' CreateFlowLogsResponse Int
createFlowLogsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateFlowLogsResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateFlowLogsResponse' :: CreateFlowLogsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateFlowLogsResponse
s@CreateFlowLogsResponse' {} Int
a -> CreateFlowLogsResponse
s {$sel:httpStatus:CreateFlowLogsResponse' :: Int
httpStatus = Int
a} :: CreateFlowLogsResponse)

instance Prelude.NFData CreateFlowLogsResponse where
  rnf :: CreateFlowLogsResponse -> ()
rnf CreateFlowLogsResponse' {Int
Maybe [Text]
Maybe [UnsuccessfulItem]
Maybe Text
httpStatus :: Int
unsuccessful :: Maybe [UnsuccessfulItem]
flowLogIds :: Maybe [Text]
clientToken :: Maybe Text
$sel:httpStatus:CreateFlowLogsResponse' :: CreateFlowLogsResponse -> Int
$sel:unsuccessful:CreateFlowLogsResponse' :: CreateFlowLogsResponse -> Maybe [UnsuccessfulItem]
$sel:flowLogIds:CreateFlowLogsResponse' :: CreateFlowLogsResponse -> Maybe [Text]
$sel:clientToken:CreateFlowLogsResponse' :: CreateFlowLogsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
flowLogIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UnsuccessfulItem]
unsuccessful
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus