{-# 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.SecurityLake.CreateAwsLogSource
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Adds a natively supported Amazon Web Service as an Amazon Security Lake
-- source. Enables source types for member accounts in required Amazon Web
-- Services Regions, based on the parameters you specify. You can choose
-- any source type in any Region for either accounts that are part of a
-- trusted organization or standalone accounts. At least one of the three
-- dimensions is a mandatory input to this API. However, you can supply any
-- combination of the three dimensions to this API.
--
-- By default, a dimension refers to the entire set. When you don\'t
-- provide a dimension, Security Lake assumes that the missing dimension
-- refers to the entire set. This is overridden when you supply any one of
-- the inputs. For instance, when you do not specify members, the API
-- enables all Security Lake member accounts for all sources. Similarly,
-- when you do not specify Regions, Security Lake is enabled for all the
-- Regions where Security Lake is available as a service.
--
-- You can use this API only to enable natively supported Amazon Web
-- Services as a source. Use @CreateCustomLogSource@ to enable data
-- collection from a custom source.
module Amazonka.SecurityLake.CreateAwsLogSource
  ( -- * Creating a Request
    CreateAwsLogSource (..),
    newCreateAwsLogSource,

    -- * Request Lenses
    createAwsLogSource_enableAllDimensions,
    createAwsLogSource_enableSingleDimension,
    createAwsLogSource_enableTwoDimensions,
    createAwsLogSource_inputOrder,

    -- * Destructuring the Response
    CreateAwsLogSourceResponse (..),
    newCreateAwsLogSourceResponse,

    -- * Response Lenses
    createAwsLogSourceResponse_failed,
    createAwsLogSourceResponse_processing,
    createAwsLogSourceResponse_httpStatus,
  )
where

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

-- | /See:/ 'newCreateAwsLogSource' smart constructor.
data CreateAwsLogSource = CreateAwsLogSource'
  { -- | Enables data collection from specific Amazon Web Services sources in all
    -- specific accounts and specific Regions.
    CreateAwsLogSource -> Maybe (HashMap Text (HashMap Text [Text]))
enableAllDimensions :: Prelude.Maybe (Prelude.HashMap Prelude.Text (Prelude.HashMap Prelude.Text [Prelude.Text])),
    -- | Enables data collection from all Amazon Web Services sources in specific
    -- accounts or Regions.
    CreateAwsLogSource -> Maybe [Text]
enableSingleDimension :: Prelude.Maybe [Prelude.Text],
    -- | Enables data collection from specific Amazon Web Services sources in
    -- specific accounts or Regions.
    CreateAwsLogSource -> Maybe (HashMap Text [Text])
enableTwoDimensions :: Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]),
    -- | Specifies the input order to enable dimensions in Security Lake, namely
    -- Region, source type, and member account.
    CreateAwsLogSource -> [Dimension]
inputOrder :: [Dimension]
  }
  deriving (CreateAwsLogSource -> CreateAwsLogSource -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAwsLogSource -> CreateAwsLogSource -> Bool
$c/= :: CreateAwsLogSource -> CreateAwsLogSource -> Bool
== :: CreateAwsLogSource -> CreateAwsLogSource -> Bool
$c== :: CreateAwsLogSource -> CreateAwsLogSource -> Bool
Prelude.Eq, ReadPrec [CreateAwsLogSource]
ReadPrec CreateAwsLogSource
Int -> ReadS CreateAwsLogSource
ReadS [CreateAwsLogSource]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAwsLogSource]
$creadListPrec :: ReadPrec [CreateAwsLogSource]
readPrec :: ReadPrec CreateAwsLogSource
$creadPrec :: ReadPrec CreateAwsLogSource
readList :: ReadS [CreateAwsLogSource]
$creadList :: ReadS [CreateAwsLogSource]
readsPrec :: Int -> ReadS CreateAwsLogSource
$creadsPrec :: Int -> ReadS CreateAwsLogSource
Prelude.Read, Int -> CreateAwsLogSource -> ShowS
[CreateAwsLogSource] -> ShowS
CreateAwsLogSource -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAwsLogSource] -> ShowS
$cshowList :: [CreateAwsLogSource] -> ShowS
show :: CreateAwsLogSource -> String
$cshow :: CreateAwsLogSource -> String
showsPrec :: Int -> CreateAwsLogSource -> ShowS
$cshowsPrec :: Int -> CreateAwsLogSource -> ShowS
Prelude.Show, forall x. Rep CreateAwsLogSource x -> CreateAwsLogSource
forall x. CreateAwsLogSource -> Rep CreateAwsLogSource x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateAwsLogSource x -> CreateAwsLogSource
$cfrom :: forall x. CreateAwsLogSource -> Rep CreateAwsLogSource x
Prelude.Generic)

-- |
-- Create a value of 'CreateAwsLogSource' 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:
--
-- 'enableAllDimensions', 'createAwsLogSource_enableAllDimensions' - Enables data collection from specific Amazon Web Services sources in all
-- specific accounts and specific Regions.
--
-- 'enableSingleDimension', 'createAwsLogSource_enableSingleDimension' - Enables data collection from all Amazon Web Services sources in specific
-- accounts or Regions.
--
-- 'enableTwoDimensions', 'createAwsLogSource_enableTwoDimensions' - Enables data collection from specific Amazon Web Services sources in
-- specific accounts or Regions.
--
-- 'inputOrder', 'createAwsLogSource_inputOrder' - Specifies the input order to enable dimensions in Security Lake, namely
-- Region, source type, and member account.
newCreateAwsLogSource ::
  CreateAwsLogSource
newCreateAwsLogSource :: CreateAwsLogSource
newCreateAwsLogSource =
  CreateAwsLogSource'
    { $sel:enableAllDimensions:CreateAwsLogSource' :: Maybe (HashMap Text (HashMap Text [Text]))
enableAllDimensions =
        forall a. Maybe a
Prelude.Nothing,
      $sel:enableSingleDimension:CreateAwsLogSource' :: Maybe [Text]
enableSingleDimension = forall a. Maybe a
Prelude.Nothing,
      $sel:enableTwoDimensions:CreateAwsLogSource' :: Maybe (HashMap Text [Text])
enableTwoDimensions = forall a. Maybe a
Prelude.Nothing,
      $sel:inputOrder:CreateAwsLogSource' :: [Dimension]
inputOrder = forall a. Monoid a => a
Prelude.mempty
    }

-- | Enables data collection from specific Amazon Web Services sources in all
-- specific accounts and specific Regions.
createAwsLogSource_enableAllDimensions :: Lens.Lens' CreateAwsLogSource (Prelude.Maybe (Prelude.HashMap Prelude.Text (Prelude.HashMap Prelude.Text [Prelude.Text])))
createAwsLogSource_enableAllDimensions :: Lens'
  CreateAwsLogSource (Maybe (HashMap Text (HashMap Text [Text])))
createAwsLogSource_enableAllDimensions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAwsLogSource' {Maybe (HashMap Text (HashMap Text [Text]))
enableAllDimensions :: Maybe (HashMap Text (HashMap Text [Text]))
$sel:enableAllDimensions:CreateAwsLogSource' :: CreateAwsLogSource -> Maybe (HashMap Text (HashMap Text [Text]))
enableAllDimensions} -> Maybe (HashMap Text (HashMap Text [Text]))
enableAllDimensions) (\s :: CreateAwsLogSource
s@CreateAwsLogSource' {} Maybe (HashMap Text (HashMap Text [Text]))
a -> CreateAwsLogSource
s {$sel:enableAllDimensions:CreateAwsLogSource' :: Maybe (HashMap Text (HashMap Text [Text]))
enableAllDimensions = Maybe (HashMap Text (HashMap Text [Text]))
a} :: CreateAwsLogSource) 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

-- | Enables data collection from all Amazon Web Services sources in specific
-- accounts or Regions.
createAwsLogSource_enableSingleDimension :: Lens.Lens' CreateAwsLogSource (Prelude.Maybe [Prelude.Text])
createAwsLogSource_enableSingleDimension :: Lens' CreateAwsLogSource (Maybe [Text])
createAwsLogSource_enableSingleDimension = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAwsLogSource' {Maybe [Text]
enableSingleDimension :: Maybe [Text]
$sel:enableSingleDimension:CreateAwsLogSource' :: CreateAwsLogSource -> Maybe [Text]
enableSingleDimension} -> Maybe [Text]
enableSingleDimension) (\s :: CreateAwsLogSource
s@CreateAwsLogSource' {} Maybe [Text]
a -> CreateAwsLogSource
s {$sel:enableSingleDimension:CreateAwsLogSource' :: Maybe [Text]
enableSingleDimension = Maybe [Text]
a} :: CreateAwsLogSource) 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

-- | Enables data collection from specific Amazon Web Services sources in
-- specific accounts or Regions.
createAwsLogSource_enableTwoDimensions :: Lens.Lens' CreateAwsLogSource (Prelude.Maybe (Prelude.HashMap Prelude.Text [Prelude.Text]))
createAwsLogSource_enableTwoDimensions :: Lens' CreateAwsLogSource (Maybe (HashMap Text [Text]))
createAwsLogSource_enableTwoDimensions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAwsLogSource' {Maybe (HashMap Text [Text])
enableTwoDimensions :: Maybe (HashMap Text [Text])
$sel:enableTwoDimensions:CreateAwsLogSource' :: CreateAwsLogSource -> Maybe (HashMap Text [Text])
enableTwoDimensions} -> Maybe (HashMap Text [Text])
enableTwoDimensions) (\s :: CreateAwsLogSource
s@CreateAwsLogSource' {} Maybe (HashMap Text [Text])
a -> CreateAwsLogSource
s {$sel:enableTwoDimensions:CreateAwsLogSource' :: Maybe (HashMap Text [Text])
enableTwoDimensions = Maybe (HashMap Text [Text])
a} :: CreateAwsLogSource) 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

-- | Specifies the input order to enable dimensions in Security Lake, namely
-- Region, source type, and member account.
createAwsLogSource_inputOrder :: Lens.Lens' CreateAwsLogSource [Dimension]
createAwsLogSource_inputOrder :: Lens' CreateAwsLogSource [Dimension]
createAwsLogSource_inputOrder = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAwsLogSource' {[Dimension]
inputOrder :: [Dimension]
$sel:inputOrder:CreateAwsLogSource' :: CreateAwsLogSource -> [Dimension]
inputOrder} -> [Dimension]
inputOrder) (\s :: CreateAwsLogSource
s@CreateAwsLogSource' {} [Dimension]
a -> CreateAwsLogSource
s {$sel:inputOrder:CreateAwsLogSource' :: [Dimension]
inputOrder = [Dimension]
a} :: CreateAwsLogSource) 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

instance Core.AWSRequest CreateAwsLogSource where
  type
    AWSResponse CreateAwsLogSource =
      CreateAwsLogSourceResponse
  request :: (Service -> Service)
-> CreateAwsLogSource -> Request CreateAwsLogSource
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateAwsLogSource
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateAwsLogSource)))
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 [Text] -> Int -> CreateAwsLogSourceResponse
CreateAwsLogSourceResponse'
            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
"failed" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"processing" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateAwsLogSource where
  hashWithSalt :: Int -> CreateAwsLogSource -> Int
hashWithSalt Int
_salt CreateAwsLogSource' {[Dimension]
Maybe [Text]
Maybe (HashMap Text [Text])
Maybe (HashMap Text (HashMap Text [Text]))
inputOrder :: [Dimension]
enableTwoDimensions :: Maybe (HashMap Text [Text])
enableSingleDimension :: Maybe [Text]
enableAllDimensions :: Maybe (HashMap Text (HashMap Text [Text]))
$sel:inputOrder:CreateAwsLogSource' :: CreateAwsLogSource -> [Dimension]
$sel:enableTwoDimensions:CreateAwsLogSource' :: CreateAwsLogSource -> Maybe (HashMap Text [Text])
$sel:enableSingleDimension:CreateAwsLogSource' :: CreateAwsLogSource -> Maybe [Text]
$sel:enableAllDimensions:CreateAwsLogSource' :: CreateAwsLogSource -> Maybe (HashMap Text (HashMap Text [Text]))
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text (HashMap Text [Text]))
enableAllDimensions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
enableSingleDimension
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text [Text])
enableTwoDimensions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [Dimension]
inputOrder

instance Prelude.NFData CreateAwsLogSource where
  rnf :: CreateAwsLogSource -> ()
rnf CreateAwsLogSource' {[Dimension]
Maybe [Text]
Maybe (HashMap Text [Text])
Maybe (HashMap Text (HashMap Text [Text]))
inputOrder :: [Dimension]
enableTwoDimensions :: Maybe (HashMap Text [Text])
enableSingleDimension :: Maybe [Text]
enableAllDimensions :: Maybe (HashMap Text (HashMap Text [Text]))
$sel:inputOrder:CreateAwsLogSource' :: CreateAwsLogSource -> [Dimension]
$sel:enableTwoDimensions:CreateAwsLogSource' :: CreateAwsLogSource -> Maybe (HashMap Text [Text])
$sel:enableSingleDimension:CreateAwsLogSource' :: CreateAwsLogSource -> Maybe [Text]
$sel:enableAllDimensions:CreateAwsLogSource' :: CreateAwsLogSource -> Maybe (HashMap Text (HashMap Text [Text]))
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text (HashMap Text [Text]))
enableAllDimensions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
enableSingleDimension
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text [Text])
enableTwoDimensions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [Dimension]
inputOrder

instance Data.ToHeaders CreateAwsLogSource where
  toHeaders :: CreateAwsLogSource -> 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 CreateAwsLogSource where
  toJSON :: CreateAwsLogSource -> Value
toJSON CreateAwsLogSource' {[Dimension]
Maybe [Text]
Maybe (HashMap Text [Text])
Maybe (HashMap Text (HashMap Text [Text]))
inputOrder :: [Dimension]
enableTwoDimensions :: Maybe (HashMap Text [Text])
enableSingleDimension :: Maybe [Text]
enableAllDimensions :: Maybe (HashMap Text (HashMap Text [Text]))
$sel:inputOrder:CreateAwsLogSource' :: CreateAwsLogSource -> [Dimension]
$sel:enableTwoDimensions:CreateAwsLogSource' :: CreateAwsLogSource -> Maybe (HashMap Text [Text])
$sel:enableSingleDimension:CreateAwsLogSource' :: CreateAwsLogSource -> Maybe [Text]
$sel:enableAllDimensions:CreateAwsLogSource' :: CreateAwsLogSource -> Maybe (HashMap Text (HashMap Text [Text]))
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"enableAllDimensions" 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 (HashMap Text (HashMap Text [Text]))
enableAllDimensions,
            (Key
"enableSingleDimension" 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]
enableSingleDimension,
            (Key
"enableTwoDimensions" 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 (HashMap Text [Text])
enableTwoDimensions,
            forall a. a -> Maybe a
Prelude.Just (Key
"inputOrder" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [Dimension]
inputOrder)
          ]
      )

instance Data.ToPath CreateAwsLogSource where
  toPath :: CreateAwsLogSource -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/v1/logsources/aws"

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

-- | /See:/ 'newCreateAwsLogSourceResponse' smart constructor.
data CreateAwsLogSourceResponse = CreateAwsLogSourceResponse'
  { -- | Lists all accounts in which enabling a natively supported Amazon Web
    -- Service as a Security Lake source failed. The failure occurred as these
    -- accounts are not part of an organization.
    CreateAwsLogSourceResponse -> Maybe [Text]
failed :: Prelude.Maybe [Prelude.Text],
    -- | Lists the accounts that are in the process of enabling a natively
    -- supported Amazon Web Service as a Security Lake source.
    CreateAwsLogSourceResponse -> Maybe [Text]
processing :: Prelude.Maybe [Prelude.Text],
    -- | The response's http status code.
    CreateAwsLogSourceResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateAwsLogSourceResponse -> CreateAwsLogSourceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateAwsLogSourceResponse -> CreateAwsLogSourceResponse -> Bool
$c/= :: CreateAwsLogSourceResponse -> CreateAwsLogSourceResponse -> Bool
== :: CreateAwsLogSourceResponse -> CreateAwsLogSourceResponse -> Bool
$c== :: CreateAwsLogSourceResponse -> CreateAwsLogSourceResponse -> Bool
Prelude.Eq, ReadPrec [CreateAwsLogSourceResponse]
ReadPrec CreateAwsLogSourceResponse
Int -> ReadS CreateAwsLogSourceResponse
ReadS [CreateAwsLogSourceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateAwsLogSourceResponse]
$creadListPrec :: ReadPrec [CreateAwsLogSourceResponse]
readPrec :: ReadPrec CreateAwsLogSourceResponse
$creadPrec :: ReadPrec CreateAwsLogSourceResponse
readList :: ReadS [CreateAwsLogSourceResponse]
$creadList :: ReadS [CreateAwsLogSourceResponse]
readsPrec :: Int -> ReadS CreateAwsLogSourceResponse
$creadsPrec :: Int -> ReadS CreateAwsLogSourceResponse
Prelude.Read, Int -> CreateAwsLogSourceResponse -> ShowS
[CreateAwsLogSourceResponse] -> ShowS
CreateAwsLogSourceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateAwsLogSourceResponse] -> ShowS
$cshowList :: [CreateAwsLogSourceResponse] -> ShowS
show :: CreateAwsLogSourceResponse -> String
$cshow :: CreateAwsLogSourceResponse -> String
showsPrec :: Int -> CreateAwsLogSourceResponse -> ShowS
$cshowsPrec :: Int -> CreateAwsLogSourceResponse -> ShowS
Prelude.Show, forall x.
Rep CreateAwsLogSourceResponse x -> CreateAwsLogSourceResponse
forall x.
CreateAwsLogSourceResponse -> Rep CreateAwsLogSourceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateAwsLogSourceResponse x -> CreateAwsLogSourceResponse
$cfrom :: forall x.
CreateAwsLogSourceResponse -> Rep CreateAwsLogSourceResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateAwsLogSourceResponse' 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:
--
-- 'failed', 'createAwsLogSourceResponse_failed' - Lists all accounts in which enabling a natively supported Amazon Web
-- Service as a Security Lake source failed. The failure occurred as these
-- accounts are not part of an organization.
--
-- 'processing', 'createAwsLogSourceResponse_processing' - Lists the accounts that are in the process of enabling a natively
-- supported Amazon Web Service as a Security Lake source.
--
-- 'httpStatus', 'createAwsLogSourceResponse_httpStatus' - The response's http status code.
newCreateAwsLogSourceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateAwsLogSourceResponse
newCreateAwsLogSourceResponse :: Int -> CreateAwsLogSourceResponse
newCreateAwsLogSourceResponse Int
pHttpStatus_ =
  CreateAwsLogSourceResponse'
    { $sel:failed:CreateAwsLogSourceResponse' :: Maybe [Text]
failed =
        forall a. Maybe a
Prelude.Nothing,
      $sel:processing:CreateAwsLogSourceResponse' :: Maybe [Text]
processing = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateAwsLogSourceResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Lists all accounts in which enabling a natively supported Amazon Web
-- Service as a Security Lake source failed. The failure occurred as these
-- accounts are not part of an organization.
createAwsLogSourceResponse_failed :: Lens.Lens' CreateAwsLogSourceResponse (Prelude.Maybe [Prelude.Text])
createAwsLogSourceResponse_failed :: Lens' CreateAwsLogSourceResponse (Maybe [Text])
createAwsLogSourceResponse_failed = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAwsLogSourceResponse' {Maybe [Text]
failed :: Maybe [Text]
$sel:failed:CreateAwsLogSourceResponse' :: CreateAwsLogSourceResponse -> Maybe [Text]
failed} -> Maybe [Text]
failed) (\s :: CreateAwsLogSourceResponse
s@CreateAwsLogSourceResponse' {} Maybe [Text]
a -> CreateAwsLogSourceResponse
s {$sel:failed:CreateAwsLogSourceResponse' :: Maybe [Text]
failed = Maybe [Text]
a} :: CreateAwsLogSourceResponse) 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

-- | Lists the accounts that are in the process of enabling a natively
-- supported Amazon Web Service as a Security Lake source.
createAwsLogSourceResponse_processing :: Lens.Lens' CreateAwsLogSourceResponse (Prelude.Maybe [Prelude.Text])
createAwsLogSourceResponse_processing :: Lens' CreateAwsLogSourceResponse (Maybe [Text])
createAwsLogSourceResponse_processing = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAwsLogSourceResponse' {Maybe [Text]
processing :: Maybe [Text]
$sel:processing:CreateAwsLogSourceResponse' :: CreateAwsLogSourceResponse -> Maybe [Text]
processing} -> Maybe [Text]
processing) (\s :: CreateAwsLogSourceResponse
s@CreateAwsLogSourceResponse' {} Maybe [Text]
a -> CreateAwsLogSourceResponse
s {$sel:processing:CreateAwsLogSourceResponse' :: Maybe [Text]
processing = Maybe [Text]
a} :: CreateAwsLogSourceResponse) 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.
createAwsLogSourceResponse_httpStatus :: Lens.Lens' CreateAwsLogSourceResponse Prelude.Int
createAwsLogSourceResponse_httpStatus :: Lens' CreateAwsLogSourceResponse Int
createAwsLogSourceResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateAwsLogSourceResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateAwsLogSourceResponse' :: CreateAwsLogSourceResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateAwsLogSourceResponse
s@CreateAwsLogSourceResponse' {} Int
a -> CreateAwsLogSourceResponse
s {$sel:httpStatus:CreateAwsLogSourceResponse' :: Int
httpStatus = Int
a} :: CreateAwsLogSourceResponse)

instance Prelude.NFData CreateAwsLogSourceResponse where
  rnf :: CreateAwsLogSourceResponse -> ()
rnf CreateAwsLogSourceResponse' {Int
Maybe [Text]
httpStatus :: Int
processing :: Maybe [Text]
failed :: Maybe [Text]
$sel:httpStatus:CreateAwsLogSourceResponse' :: CreateAwsLogSourceResponse -> Int
$sel:processing:CreateAwsLogSourceResponse' :: CreateAwsLogSourceResponse -> Maybe [Text]
$sel:failed:CreateAwsLogSourceResponse' :: CreateAwsLogSourceResponse -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
failed
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
processing
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus