{-# 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.DescribeTrails
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves settings for one or more trails associated with the current
-- region for your account.
module Amazonka.CloudTrail.DescribeTrails
  ( -- * Creating a Request
    DescribeTrails (..),
    newDescribeTrails,

    -- * Request Lenses
    describeTrails_includeShadowTrails,
    describeTrails_trailNameList,

    -- * Destructuring the Response
    DescribeTrailsResponse (..),
    newDescribeTrailsResponse,

    -- * Response Lenses
    describeTrailsResponse_trailList,
    describeTrailsResponse_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

-- | Returns information about the trail.
--
-- /See:/ 'newDescribeTrails' smart constructor.
data DescribeTrails = DescribeTrails'
  { -- | Specifies whether to include shadow trails in the response. A shadow
    -- trail is the replication in a region of a trail that was created in a
    -- different region, or in the case of an organization trail, the
    -- replication of an organization trail in member accounts. If you do not
    -- include shadow trails, organization trails in a member account and
    -- region replication trails will not be returned. The default is true.
    DescribeTrails -> Maybe Bool
includeShadowTrails :: Prelude.Maybe Prelude.Bool,
    -- | Specifies a list of trail names, trail ARNs, or both, of the trails to
    -- describe. The format of a trail ARN is:
    --
    -- @arn:aws:cloudtrail:us-east-2:123456789012:trail\/MyTrail@
    --
    -- If an empty list is specified, information for the trail in the current
    -- region is returned.
    --
    -- -   If an empty list is specified and @IncludeShadowTrails@ is false,
    --     then information for all trails in the current region is returned.
    --
    -- -   If an empty list is specified and IncludeShadowTrails is null or
    --     true, then information for all trails in the current region and any
    --     associated shadow trails in other regions is returned.
    --
    -- If one or more trail names are specified, information is returned only
    -- if the names match the names of trails belonging only to the current
    -- region. To return information about a trail in another region, you must
    -- specify its trail ARN.
    DescribeTrails -> Maybe [Text]
trailNameList :: Prelude.Maybe [Prelude.Text]
  }
  deriving (DescribeTrails -> DescribeTrails -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeTrails -> DescribeTrails -> Bool
$c/= :: DescribeTrails -> DescribeTrails -> Bool
== :: DescribeTrails -> DescribeTrails -> Bool
$c== :: DescribeTrails -> DescribeTrails -> Bool
Prelude.Eq, ReadPrec [DescribeTrails]
ReadPrec DescribeTrails
Int -> ReadS DescribeTrails
ReadS [DescribeTrails]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeTrails]
$creadListPrec :: ReadPrec [DescribeTrails]
readPrec :: ReadPrec DescribeTrails
$creadPrec :: ReadPrec DescribeTrails
readList :: ReadS [DescribeTrails]
$creadList :: ReadS [DescribeTrails]
readsPrec :: Int -> ReadS DescribeTrails
$creadsPrec :: Int -> ReadS DescribeTrails
Prelude.Read, Int -> DescribeTrails -> ShowS
[DescribeTrails] -> ShowS
DescribeTrails -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeTrails] -> ShowS
$cshowList :: [DescribeTrails] -> ShowS
show :: DescribeTrails -> String
$cshow :: DescribeTrails -> String
showsPrec :: Int -> DescribeTrails -> ShowS
$cshowsPrec :: Int -> DescribeTrails -> ShowS
Prelude.Show, forall x. Rep DescribeTrails x -> DescribeTrails
forall x. DescribeTrails -> Rep DescribeTrails x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeTrails x -> DescribeTrails
$cfrom :: forall x. DescribeTrails -> Rep DescribeTrails x
Prelude.Generic)

-- |
-- Create a value of 'DescribeTrails' 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:
--
-- 'includeShadowTrails', 'describeTrails_includeShadowTrails' - Specifies whether to include shadow trails in the response. A shadow
-- trail is the replication in a region of a trail that was created in a
-- different region, or in the case of an organization trail, the
-- replication of an organization trail in member accounts. If you do not
-- include shadow trails, organization trails in a member account and
-- region replication trails will not be returned. The default is true.
--
-- 'trailNameList', 'describeTrails_trailNameList' - Specifies a list of trail names, trail ARNs, or both, of the trails to
-- describe. The format of a trail ARN is:
--
-- @arn:aws:cloudtrail:us-east-2:123456789012:trail\/MyTrail@
--
-- If an empty list is specified, information for the trail in the current
-- region is returned.
--
-- -   If an empty list is specified and @IncludeShadowTrails@ is false,
--     then information for all trails in the current region is returned.
--
-- -   If an empty list is specified and IncludeShadowTrails is null or
--     true, then information for all trails in the current region and any
--     associated shadow trails in other regions is returned.
--
-- If one or more trail names are specified, information is returned only
-- if the names match the names of trails belonging only to the current
-- region. To return information about a trail in another region, you must
-- specify its trail ARN.
newDescribeTrails ::
  DescribeTrails
newDescribeTrails :: DescribeTrails
newDescribeTrails =
  DescribeTrails'
    { $sel:includeShadowTrails:DescribeTrails' :: Maybe Bool
includeShadowTrails =
        forall a. Maybe a
Prelude.Nothing,
      $sel:trailNameList:DescribeTrails' :: Maybe [Text]
trailNameList = forall a. Maybe a
Prelude.Nothing
    }

-- | Specifies whether to include shadow trails in the response. A shadow
-- trail is the replication in a region of a trail that was created in a
-- different region, or in the case of an organization trail, the
-- replication of an organization trail in member accounts. If you do not
-- include shadow trails, organization trails in a member account and
-- region replication trails will not be returned. The default is true.
describeTrails_includeShadowTrails :: Lens.Lens' DescribeTrails (Prelude.Maybe Prelude.Bool)
describeTrails_includeShadowTrails :: Lens' DescribeTrails (Maybe Bool)
describeTrails_includeShadowTrails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTrails' {Maybe Bool
includeShadowTrails :: Maybe Bool
$sel:includeShadowTrails:DescribeTrails' :: DescribeTrails -> Maybe Bool
includeShadowTrails} -> Maybe Bool
includeShadowTrails) (\s :: DescribeTrails
s@DescribeTrails' {} Maybe Bool
a -> DescribeTrails
s {$sel:includeShadowTrails:DescribeTrails' :: Maybe Bool
includeShadowTrails = Maybe Bool
a} :: DescribeTrails)

-- | Specifies a list of trail names, trail ARNs, or both, of the trails to
-- describe. The format of a trail ARN is:
--
-- @arn:aws:cloudtrail:us-east-2:123456789012:trail\/MyTrail@
--
-- If an empty list is specified, information for the trail in the current
-- region is returned.
--
-- -   If an empty list is specified and @IncludeShadowTrails@ is false,
--     then information for all trails in the current region is returned.
--
-- -   If an empty list is specified and IncludeShadowTrails is null or
--     true, then information for all trails in the current region and any
--     associated shadow trails in other regions is returned.
--
-- If one or more trail names are specified, information is returned only
-- if the names match the names of trails belonging only to the current
-- region. To return information about a trail in another region, you must
-- specify its trail ARN.
describeTrails_trailNameList :: Lens.Lens' DescribeTrails (Prelude.Maybe [Prelude.Text])
describeTrails_trailNameList :: Lens' DescribeTrails (Maybe [Text])
describeTrails_trailNameList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTrails' {Maybe [Text]
trailNameList :: Maybe [Text]
$sel:trailNameList:DescribeTrails' :: DescribeTrails -> Maybe [Text]
trailNameList} -> Maybe [Text]
trailNameList) (\s :: DescribeTrails
s@DescribeTrails' {} Maybe [Text]
a -> DescribeTrails
s {$sel:trailNameList:DescribeTrails' :: Maybe [Text]
trailNameList = Maybe [Text]
a} :: DescribeTrails) 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

instance Core.AWSRequest DescribeTrails where
  type
    AWSResponse DescribeTrails =
      DescribeTrailsResponse
  request :: (Service -> Service) -> DescribeTrails -> Request DescribeTrails
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 DescribeTrails
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribeTrails)))
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 [Trail] -> Int -> DescribeTrailsResponse
DescribeTrailsResponse'
            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
"trailList" 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 DescribeTrails where
  hashWithSalt :: Int -> DescribeTrails -> Int
hashWithSalt Int
_salt DescribeTrails' {Maybe Bool
Maybe [Text]
trailNameList :: Maybe [Text]
includeShadowTrails :: Maybe Bool
$sel:trailNameList:DescribeTrails' :: DescribeTrails -> Maybe [Text]
$sel:includeShadowTrails:DescribeTrails' :: DescribeTrails -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
includeShadowTrails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
trailNameList

instance Prelude.NFData DescribeTrails where
  rnf :: DescribeTrails -> ()
rnf DescribeTrails' {Maybe Bool
Maybe [Text]
trailNameList :: Maybe [Text]
includeShadowTrails :: Maybe Bool
$sel:trailNameList:DescribeTrails' :: DescribeTrails -> Maybe [Text]
$sel:includeShadowTrails:DescribeTrails' :: DescribeTrails -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
includeShadowTrails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
trailNameList

instance Data.ToHeaders DescribeTrails where
  toHeaders :: DescribeTrails -> 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.DescribeTrails" ::
                          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 DescribeTrails where
  toJSON :: DescribeTrails -> Value
toJSON DescribeTrails' {Maybe Bool
Maybe [Text]
trailNameList :: Maybe [Text]
includeShadowTrails :: Maybe Bool
$sel:trailNameList:DescribeTrails' :: DescribeTrails -> Maybe [Text]
$sel:includeShadowTrails:DescribeTrails' :: DescribeTrails -> Maybe Bool
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"includeShadowTrails" 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 Bool
includeShadowTrails,
            (Key
"trailNameList" 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]
trailNameList
          ]
      )

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

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

-- | Returns the objects or data listed below if successful. Otherwise,
-- returns an error.
--
-- /See:/ 'newDescribeTrailsResponse' smart constructor.
data DescribeTrailsResponse = DescribeTrailsResponse'
  { -- | The list of trail objects. Trail objects with string values are only
    -- returned if values for the objects exist in a trail\'s configuration.
    -- For example, @SNSTopicName@ and @SNSTopicARN@ are only returned in
    -- results if a trail is configured to send SNS notifications. Similarly,
    -- @KMSKeyId@ only appears in results if a trail\'s log files are encrypted
    -- with KMS customer managed keys.
    DescribeTrailsResponse -> Maybe [Trail]
trailList :: Prelude.Maybe [Trail],
    -- | The response's http status code.
    DescribeTrailsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeTrailsResponse -> DescribeTrailsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeTrailsResponse -> DescribeTrailsResponse -> Bool
$c/= :: DescribeTrailsResponse -> DescribeTrailsResponse -> Bool
== :: DescribeTrailsResponse -> DescribeTrailsResponse -> Bool
$c== :: DescribeTrailsResponse -> DescribeTrailsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeTrailsResponse]
ReadPrec DescribeTrailsResponse
Int -> ReadS DescribeTrailsResponse
ReadS [DescribeTrailsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeTrailsResponse]
$creadListPrec :: ReadPrec [DescribeTrailsResponse]
readPrec :: ReadPrec DescribeTrailsResponse
$creadPrec :: ReadPrec DescribeTrailsResponse
readList :: ReadS [DescribeTrailsResponse]
$creadList :: ReadS [DescribeTrailsResponse]
readsPrec :: Int -> ReadS DescribeTrailsResponse
$creadsPrec :: Int -> ReadS DescribeTrailsResponse
Prelude.Read, Int -> DescribeTrailsResponse -> ShowS
[DescribeTrailsResponse] -> ShowS
DescribeTrailsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeTrailsResponse] -> ShowS
$cshowList :: [DescribeTrailsResponse] -> ShowS
show :: DescribeTrailsResponse -> String
$cshow :: DescribeTrailsResponse -> String
showsPrec :: Int -> DescribeTrailsResponse -> ShowS
$cshowsPrec :: Int -> DescribeTrailsResponse -> ShowS
Prelude.Show, forall x. Rep DescribeTrailsResponse x -> DescribeTrailsResponse
forall x. DescribeTrailsResponse -> Rep DescribeTrailsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeTrailsResponse x -> DescribeTrailsResponse
$cfrom :: forall x. DescribeTrailsResponse -> Rep DescribeTrailsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeTrailsResponse' 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:
--
-- 'trailList', 'describeTrailsResponse_trailList' - The list of trail objects. Trail objects with string values are only
-- returned if values for the objects exist in a trail\'s configuration.
-- For example, @SNSTopicName@ and @SNSTopicARN@ are only returned in
-- results if a trail is configured to send SNS notifications. Similarly,
-- @KMSKeyId@ only appears in results if a trail\'s log files are encrypted
-- with KMS customer managed keys.
--
-- 'httpStatus', 'describeTrailsResponse_httpStatus' - The response's http status code.
newDescribeTrailsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeTrailsResponse
newDescribeTrailsResponse :: Int -> DescribeTrailsResponse
newDescribeTrailsResponse Int
pHttpStatus_ =
  DescribeTrailsResponse'
    { $sel:trailList:DescribeTrailsResponse' :: Maybe [Trail]
trailList =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeTrailsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The list of trail objects. Trail objects with string values are only
-- returned if values for the objects exist in a trail\'s configuration.
-- For example, @SNSTopicName@ and @SNSTopicARN@ are only returned in
-- results if a trail is configured to send SNS notifications. Similarly,
-- @KMSKeyId@ only appears in results if a trail\'s log files are encrypted
-- with KMS customer managed keys.
describeTrailsResponse_trailList :: Lens.Lens' DescribeTrailsResponse (Prelude.Maybe [Trail])
describeTrailsResponse_trailList :: Lens' DescribeTrailsResponse (Maybe [Trail])
describeTrailsResponse_trailList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTrailsResponse' {Maybe [Trail]
trailList :: Maybe [Trail]
$sel:trailList:DescribeTrailsResponse' :: DescribeTrailsResponse -> Maybe [Trail]
trailList} -> Maybe [Trail]
trailList) (\s :: DescribeTrailsResponse
s@DescribeTrailsResponse' {} Maybe [Trail]
a -> DescribeTrailsResponse
s {$sel:trailList:DescribeTrailsResponse' :: Maybe [Trail]
trailList = Maybe [Trail]
a} :: DescribeTrailsResponse) 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.
describeTrailsResponse_httpStatus :: Lens.Lens' DescribeTrailsResponse Prelude.Int
describeTrailsResponse_httpStatus :: Lens' DescribeTrailsResponse Int
describeTrailsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeTrailsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeTrailsResponse' :: DescribeTrailsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeTrailsResponse
s@DescribeTrailsResponse' {} Int
a -> DescribeTrailsResponse
s {$sel:httpStatus:DescribeTrailsResponse' :: Int
httpStatus = Int
a} :: DescribeTrailsResponse)

instance Prelude.NFData DescribeTrailsResponse where
  rnf :: DescribeTrailsResponse -> ()
rnf DescribeTrailsResponse' {Int
Maybe [Trail]
httpStatus :: Int
trailList :: Maybe [Trail]
$sel:httpStatus:DescribeTrailsResponse' :: DescribeTrailsResponse -> Int
$sel:trailList:DescribeTrailsResponse' :: DescribeTrailsResponse -> Maybe [Trail]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Trail]
trailList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus