{-# 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.CloudTrail.GetInsightSelectors
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the settings for the Insights event selectors that you
-- configured for your trail. @GetInsightSelectors@ shows if CloudTrail
-- Insights event logging is enabled on the trail, and if it is, which
-- insight types are enabled. If you run @GetInsightSelectors@ on a trail
-- that does not have Insights events enabled, the operation throws the
-- exception @InsightNotEnabledException@
--
-- For more information, see
-- <https://docs.aws.amazon.com/awscloudtrail/latest/userguide/logging-insights-events-with-cloudtrail.html Logging CloudTrail Insights Events for Trails>
-- in the /CloudTrail User Guide/.
module Amazonka.CloudTrail.GetInsightSelectors
  ( -- * Creating a Request
    GetInsightSelectors (..),
    newGetInsightSelectors,

    -- * Request Lenses
    getInsightSelectors_trailName,

    -- * Destructuring the Response
    GetInsightSelectorsResponse (..),
    newGetInsightSelectorsResponse,

    -- * Response Lenses
    getInsightSelectorsResponse_insightSelectors,
    getInsightSelectorsResponse_trailARN,
    getInsightSelectorsResponse_httpStatus,
  )
where

import Amazonka.CloudTrail.Types
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

-- | /See:/ 'newGetInsightSelectors' smart constructor.
data GetInsightSelectors = GetInsightSelectors'
  { -- | Specifies the name of the trail or trail ARN. If you specify a trail
    -- name, the string must meet the following requirements:
    --
    -- -   Contain only ASCII letters (a-z, A-Z), numbers (0-9), periods (.),
    --     underscores (_), or dashes (-)
    --
    -- -   Start with a letter or number, and end with a letter or number
    --
    -- -   Be between 3 and 128 characters
    --
    -- -   Have no adjacent periods, underscores or dashes. Names like
    --     @my-_namespace@ and @my--namespace@ are not valid.
    --
    -- -   Not be in IP address format (for example, 192.168.5.4)
    --
    -- If you specify a trail ARN, it must be in the format:
    --
    -- @arn:aws:cloudtrail:us-east-2:123456789012:trail\/MyTrail@
    GetInsightSelectors -> Text
trailName :: Prelude.Text
  }
  deriving (GetInsightSelectors -> GetInsightSelectors -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetInsightSelectors -> GetInsightSelectors -> Bool
$c/= :: GetInsightSelectors -> GetInsightSelectors -> Bool
== :: GetInsightSelectors -> GetInsightSelectors -> Bool
$c== :: GetInsightSelectors -> GetInsightSelectors -> Bool
Prelude.Eq, ReadPrec [GetInsightSelectors]
ReadPrec GetInsightSelectors
Int -> ReadS GetInsightSelectors
ReadS [GetInsightSelectors]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetInsightSelectors]
$creadListPrec :: ReadPrec [GetInsightSelectors]
readPrec :: ReadPrec GetInsightSelectors
$creadPrec :: ReadPrec GetInsightSelectors
readList :: ReadS [GetInsightSelectors]
$creadList :: ReadS [GetInsightSelectors]
readsPrec :: Int -> ReadS GetInsightSelectors
$creadsPrec :: Int -> ReadS GetInsightSelectors
Prelude.Read, Int -> GetInsightSelectors -> ShowS
[GetInsightSelectors] -> ShowS
GetInsightSelectors -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetInsightSelectors] -> ShowS
$cshowList :: [GetInsightSelectors] -> ShowS
show :: GetInsightSelectors -> String
$cshow :: GetInsightSelectors -> String
showsPrec :: Int -> GetInsightSelectors -> ShowS
$cshowsPrec :: Int -> GetInsightSelectors -> ShowS
Prelude.Show, forall x. Rep GetInsightSelectors x -> GetInsightSelectors
forall x. GetInsightSelectors -> Rep GetInsightSelectors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetInsightSelectors x -> GetInsightSelectors
$cfrom :: forall x. GetInsightSelectors -> Rep GetInsightSelectors x
Prelude.Generic)

-- |
-- Create a value of 'GetInsightSelectors' 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:
--
-- 'trailName', 'getInsightSelectors_trailName' - Specifies the name of the trail or trail ARN. If you specify a trail
-- name, the string must meet the following requirements:
--
-- -   Contain only ASCII letters (a-z, A-Z), numbers (0-9), periods (.),
--     underscores (_), or dashes (-)
--
-- -   Start with a letter or number, and end with a letter or number
--
-- -   Be between 3 and 128 characters
--
-- -   Have no adjacent periods, underscores or dashes. Names like
--     @my-_namespace@ and @my--namespace@ are not valid.
--
-- -   Not be in IP address format (for example, 192.168.5.4)
--
-- If you specify a trail ARN, it must be in the format:
--
-- @arn:aws:cloudtrail:us-east-2:123456789012:trail\/MyTrail@
newGetInsightSelectors ::
  -- | 'trailName'
  Prelude.Text ->
  GetInsightSelectors
newGetInsightSelectors :: Text -> GetInsightSelectors
newGetInsightSelectors Text
pTrailName_ =
  GetInsightSelectors' {$sel:trailName:GetInsightSelectors' :: Text
trailName = Text
pTrailName_}

-- | Specifies the name of the trail or trail ARN. If you specify a trail
-- name, the string must meet the following requirements:
--
-- -   Contain only ASCII letters (a-z, A-Z), numbers (0-9), periods (.),
--     underscores (_), or dashes (-)
--
-- -   Start with a letter or number, and end with a letter or number
--
-- -   Be between 3 and 128 characters
--
-- -   Have no adjacent periods, underscores or dashes. Names like
--     @my-_namespace@ and @my--namespace@ are not valid.
--
-- -   Not be in IP address format (for example, 192.168.5.4)
--
-- If you specify a trail ARN, it must be in the format:
--
-- @arn:aws:cloudtrail:us-east-2:123456789012:trail\/MyTrail@
getInsightSelectors_trailName :: Lens.Lens' GetInsightSelectors Prelude.Text
getInsightSelectors_trailName :: Lens' GetInsightSelectors Text
getInsightSelectors_trailName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsightSelectors' {Text
trailName :: Text
$sel:trailName:GetInsightSelectors' :: GetInsightSelectors -> Text
trailName} -> Text
trailName) (\s :: GetInsightSelectors
s@GetInsightSelectors' {} Text
a -> GetInsightSelectors
s {$sel:trailName:GetInsightSelectors' :: Text
trailName = Text
a} :: GetInsightSelectors)

instance Core.AWSRequest GetInsightSelectors where
  type
    AWSResponse GetInsightSelectors =
      GetInsightSelectorsResponse
  request :: (Service -> Service)
-> GetInsightSelectors -> Request GetInsightSelectors
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 GetInsightSelectors
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetInsightSelectors)))
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 [InsightSelector]
-> Maybe Text -> Int -> GetInsightSelectorsResponse
GetInsightSelectorsResponse'
            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
"InsightSelectors"
                            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
"TrailARN")
            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 GetInsightSelectors where
  hashWithSalt :: Int -> GetInsightSelectors -> Int
hashWithSalt Int
_salt GetInsightSelectors' {Text
trailName :: Text
$sel:trailName:GetInsightSelectors' :: GetInsightSelectors -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
trailName

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

instance Data.ToHeaders GetInsightSelectors where
  toHeaders :: GetInsightSelectors -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"com.amazonaws.cloudtrail.v20131101.CloudTrail_20131101.GetInsightSelectors" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

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

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

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

-- | /See:/ 'newGetInsightSelectorsResponse' smart constructor.
data GetInsightSelectorsResponse = GetInsightSelectorsResponse'
  { -- | A JSON string that contains the insight types you want to log on a
    -- trail. In this release, @ApiErrorRateInsight@ and @ApiCallRateInsight@
    -- are supported as insight types.
    GetInsightSelectorsResponse -> Maybe [InsightSelector]
insightSelectors :: Prelude.Maybe [InsightSelector],
    -- | The Amazon Resource Name (ARN) of a trail for which you want to get
    -- Insights selectors.
    GetInsightSelectorsResponse -> Maybe Text
trailARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetInsightSelectorsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetInsightSelectorsResponse -> GetInsightSelectorsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetInsightSelectorsResponse -> GetInsightSelectorsResponse -> Bool
$c/= :: GetInsightSelectorsResponse -> GetInsightSelectorsResponse -> Bool
== :: GetInsightSelectorsResponse -> GetInsightSelectorsResponse -> Bool
$c== :: GetInsightSelectorsResponse -> GetInsightSelectorsResponse -> Bool
Prelude.Eq, ReadPrec [GetInsightSelectorsResponse]
ReadPrec GetInsightSelectorsResponse
Int -> ReadS GetInsightSelectorsResponse
ReadS [GetInsightSelectorsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetInsightSelectorsResponse]
$creadListPrec :: ReadPrec [GetInsightSelectorsResponse]
readPrec :: ReadPrec GetInsightSelectorsResponse
$creadPrec :: ReadPrec GetInsightSelectorsResponse
readList :: ReadS [GetInsightSelectorsResponse]
$creadList :: ReadS [GetInsightSelectorsResponse]
readsPrec :: Int -> ReadS GetInsightSelectorsResponse
$creadsPrec :: Int -> ReadS GetInsightSelectorsResponse
Prelude.Read, Int -> GetInsightSelectorsResponse -> ShowS
[GetInsightSelectorsResponse] -> ShowS
GetInsightSelectorsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetInsightSelectorsResponse] -> ShowS
$cshowList :: [GetInsightSelectorsResponse] -> ShowS
show :: GetInsightSelectorsResponse -> String
$cshow :: GetInsightSelectorsResponse -> String
showsPrec :: Int -> GetInsightSelectorsResponse -> ShowS
$cshowsPrec :: Int -> GetInsightSelectorsResponse -> ShowS
Prelude.Show, forall x.
Rep GetInsightSelectorsResponse x -> GetInsightSelectorsResponse
forall x.
GetInsightSelectorsResponse -> Rep GetInsightSelectorsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetInsightSelectorsResponse x -> GetInsightSelectorsResponse
$cfrom :: forall x.
GetInsightSelectorsResponse -> Rep GetInsightSelectorsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetInsightSelectorsResponse' 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:
--
-- 'insightSelectors', 'getInsightSelectorsResponse_insightSelectors' - A JSON string that contains the insight types you want to log on a
-- trail. In this release, @ApiErrorRateInsight@ and @ApiCallRateInsight@
-- are supported as insight types.
--
-- 'trailARN', 'getInsightSelectorsResponse_trailARN' - The Amazon Resource Name (ARN) of a trail for which you want to get
-- Insights selectors.
--
-- 'httpStatus', 'getInsightSelectorsResponse_httpStatus' - The response's http status code.
newGetInsightSelectorsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetInsightSelectorsResponse
newGetInsightSelectorsResponse :: Int -> GetInsightSelectorsResponse
newGetInsightSelectorsResponse Int
pHttpStatus_ =
  GetInsightSelectorsResponse'
    { $sel:insightSelectors:GetInsightSelectorsResponse' :: Maybe [InsightSelector]
insightSelectors =
        forall a. Maybe a
Prelude.Nothing,
      $sel:trailARN:GetInsightSelectorsResponse' :: Maybe Text
trailARN = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetInsightSelectorsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A JSON string that contains the insight types you want to log on a
-- trail. In this release, @ApiErrorRateInsight@ and @ApiCallRateInsight@
-- are supported as insight types.
getInsightSelectorsResponse_insightSelectors :: Lens.Lens' GetInsightSelectorsResponse (Prelude.Maybe [InsightSelector])
getInsightSelectorsResponse_insightSelectors :: Lens' GetInsightSelectorsResponse (Maybe [InsightSelector])
getInsightSelectorsResponse_insightSelectors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsightSelectorsResponse' {Maybe [InsightSelector]
insightSelectors :: Maybe [InsightSelector]
$sel:insightSelectors:GetInsightSelectorsResponse' :: GetInsightSelectorsResponse -> Maybe [InsightSelector]
insightSelectors} -> Maybe [InsightSelector]
insightSelectors) (\s :: GetInsightSelectorsResponse
s@GetInsightSelectorsResponse' {} Maybe [InsightSelector]
a -> GetInsightSelectorsResponse
s {$sel:insightSelectors:GetInsightSelectorsResponse' :: Maybe [InsightSelector]
insightSelectors = Maybe [InsightSelector]
a} :: GetInsightSelectorsResponse) 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 Amazon Resource Name (ARN) of a trail for which you want to get
-- Insights selectors.
getInsightSelectorsResponse_trailARN :: Lens.Lens' GetInsightSelectorsResponse (Prelude.Maybe Prelude.Text)
getInsightSelectorsResponse_trailARN :: Lens' GetInsightSelectorsResponse (Maybe Text)
getInsightSelectorsResponse_trailARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetInsightSelectorsResponse' {Maybe Text
trailARN :: Maybe Text
$sel:trailARN:GetInsightSelectorsResponse' :: GetInsightSelectorsResponse -> Maybe Text
trailARN} -> Maybe Text
trailARN) (\s :: GetInsightSelectorsResponse
s@GetInsightSelectorsResponse' {} Maybe Text
a -> GetInsightSelectorsResponse
s {$sel:trailARN:GetInsightSelectorsResponse' :: Maybe Text
trailARN = Maybe Text
a} :: GetInsightSelectorsResponse)

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

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