{-# 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.GetEventSelectors
-- 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 event selectors that you configured for
-- your trail. The information returned for your event selectors includes
-- the following:
--
-- -   If your event selector includes read-only events, write-only events,
--     or all events. This applies to both management events and data
--     events.
--
-- -   If your event selector includes management events.
--
-- -   If your event selector includes data events, the resources on which
--     you are logging data events.
--
-- For more information about logging management and data events, see the
-- following topics in the /CloudTrail User Guide/:
--
-- -   <https://docs.aws.amazon.com/awscloudtrail/latest/userguide/logging-management-events-with-cloudtrail.html Logging management events for trails>
--
-- -   <https://docs.aws.amazon.com/awscloudtrail/latest/userguide/logging-data-events-with-cloudtrail.html Logging data events for trails>
module Amazonka.CloudTrail.GetEventSelectors
  ( -- * Creating a Request
    GetEventSelectors (..),
    newGetEventSelectors,

    -- * Request Lenses
    getEventSelectors_trailName,

    -- * Destructuring the Response
    GetEventSelectorsResponse (..),
    newGetEventSelectorsResponse,

    -- * Response Lenses
    getEventSelectorsResponse_advancedEventSelectors,
    getEventSelectorsResponse_eventSelectors,
    getEventSelectorsResponse_trailARN,
    getEventSelectorsResponse_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:/ 'newGetEventSelectors' smart constructor.
data GetEventSelectors = GetEventSelectors'
  { -- | 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@
    GetEventSelectors -> Text
trailName :: Prelude.Text
  }
  deriving (GetEventSelectors -> GetEventSelectors -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetEventSelectors -> GetEventSelectors -> Bool
$c/= :: GetEventSelectors -> GetEventSelectors -> Bool
== :: GetEventSelectors -> GetEventSelectors -> Bool
$c== :: GetEventSelectors -> GetEventSelectors -> Bool
Prelude.Eq, ReadPrec [GetEventSelectors]
ReadPrec GetEventSelectors
Int -> ReadS GetEventSelectors
ReadS [GetEventSelectors]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetEventSelectors]
$creadListPrec :: ReadPrec [GetEventSelectors]
readPrec :: ReadPrec GetEventSelectors
$creadPrec :: ReadPrec GetEventSelectors
readList :: ReadS [GetEventSelectors]
$creadList :: ReadS [GetEventSelectors]
readsPrec :: Int -> ReadS GetEventSelectors
$creadsPrec :: Int -> ReadS GetEventSelectors
Prelude.Read, Int -> GetEventSelectors -> ShowS
[GetEventSelectors] -> ShowS
GetEventSelectors -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetEventSelectors] -> ShowS
$cshowList :: [GetEventSelectors] -> ShowS
show :: GetEventSelectors -> String
$cshow :: GetEventSelectors -> String
showsPrec :: Int -> GetEventSelectors -> ShowS
$cshowsPrec :: Int -> GetEventSelectors -> ShowS
Prelude.Show, forall x. Rep GetEventSelectors x -> GetEventSelectors
forall x. GetEventSelectors -> Rep GetEventSelectors x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetEventSelectors x -> GetEventSelectors
$cfrom :: forall x. GetEventSelectors -> Rep GetEventSelectors x
Prelude.Generic)

-- |
-- Create a value of 'GetEventSelectors' 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', 'getEventSelectors_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@
newGetEventSelectors ::
  -- | 'trailName'
  Prelude.Text ->
  GetEventSelectors
newGetEventSelectors :: Text -> GetEventSelectors
newGetEventSelectors Text
pTrailName_ =
  GetEventSelectors' {$sel:trailName:GetEventSelectors' :: 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@
getEventSelectors_trailName :: Lens.Lens' GetEventSelectors Prelude.Text
getEventSelectors_trailName :: Lens' GetEventSelectors Text
getEventSelectors_trailName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEventSelectors' {Text
trailName :: Text
$sel:trailName:GetEventSelectors' :: GetEventSelectors -> Text
trailName} -> Text
trailName) (\s :: GetEventSelectors
s@GetEventSelectors' {} Text
a -> GetEventSelectors
s {$sel:trailName:GetEventSelectors' :: Text
trailName = Text
a} :: GetEventSelectors)

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

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

instance Data.ToHeaders GetEventSelectors where
  toHeaders :: GetEventSelectors -> 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.GetEventSelectors" ::
                          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 GetEventSelectors where
  toJSON :: GetEventSelectors -> Value
toJSON GetEventSelectors' {Text
trailName :: Text
$sel:trailName:GetEventSelectors' :: GetEventSelectors -> 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 GetEventSelectors where
  toPath :: GetEventSelectors -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

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

-- | /See:/ 'newGetEventSelectorsResponse' smart constructor.
data GetEventSelectorsResponse = GetEventSelectorsResponse'
  { -- | The advanced event selectors that are configured for the trail.
    GetEventSelectorsResponse -> Maybe [AdvancedEventSelector]
advancedEventSelectors :: Prelude.Maybe [AdvancedEventSelector],
    -- | The event selectors that are configured for the trail.
    GetEventSelectorsResponse -> Maybe [EventSelector]
eventSelectors :: Prelude.Maybe [EventSelector],
    -- | The specified trail ARN that has the event selectors.
    GetEventSelectorsResponse -> Maybe Text
trailARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetEventSelectorsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetEventSelectorsResponse -> GetEventSelectorsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetEventSelectorsResponse -> GetEventSelectorsResponse -> Bool
$c/= :: GetEventSelectorsResponse -> GetEventSelectorsResponse -> Bool
== :: GetEventSelectorsResponse -> GetEventSelectorsResponse -> Bool
$c== :: GetEventSelectorsResponse -> GetEventSelectorsResponse -> Bool
Prelude.Eq, ReadPrec [GetEventSelectorsResponse]
ReadPrec GetEventSelectorsResponse
Int -> ReadS GetEventSelectorsResponse
ReadS [GetEventSelectorsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetEventSelectorsResponse]
$creadListPrec :: ReadPrec [GetEventSelectorsResponse]
readPrec :: ReadPrec GetEventSelectorsResponse
$creadPrec :: ReadPrec GetEventSelectorsResponse
readList :: ReadS [GetEventSelectorsResponse]
$creadList :: ReadS [GetEventSelectorsResponse]
readsPrec :: Int -> ReadS GetEventSelectorsResponse
$creadsPrec :: Int -> ReadS GetEventSelectorsResponse
Prelude.Read, Int -> GetEventSelectorsResponse -> ShowS
[GetEventSelectorsResponse] -> ShowS
GetEventSelectorsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetEventSelectorsResponse] -> ShowS
$cshowList :: [GetEventSelectorsResponse] -> ShowS
show :: GetEventSelectorsResponse -> String
$cshow :: GetEventSelectorsResponse -> String
showsPrec :: Int -> GetEventSelectorsResponse -> ShowS
$cshowsPrec :: Int -> GetEventSelectorsResponse -> ShowS
Prelude.Show, forall x.
Rep GetEventSelectorsResponse x -> GetEventSelectorsResponse
forall x.
GetEventSelectorsResponse -> Rep GetEventSelectorsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetEventSelectorsResponse x -> GetEventSelectorsResponse
$cfrom :: forall x.
GetEventSelectorsResponse -> Rep GetEventSelectorsResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetEventSelectorsResponse' 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:
--
-- 'advancedEventSelectors', 'getEventSelectorsResponse_advancedEventSelectors' - The advanced event selectors that are configured for the trail.
--
-- 'eventSelectors', 'getEventSelectorsResponse_eventSelectors' - The event selectors that are configured for the trail.
--
-- 'trailARN', 'getEventSelectorsResponse_trailARN' - The specified trail ARN that has the event selectors.
--
-- 'httpStatus', 'getEventSelectorsResponse_httpStatus' - The response's http status code.
newGetEventSelectorsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetEventSelectorsResponse
newGetEventSelectorsResponse :: Int -> GetEventSelectorsResponse
newGetEventSelectorsResponse Int
pHttpStatus_ =
  GetEventSelectorsResponse'
    { $sel:advancedEventSelectors:GetEventSelectorsResponse' :: Maybe [AdvancedEventSelector]
advancedEventSelectors =
        forall a. Maybe a
Prelude.Nothing,
      $sel:eventSelectors:GetEventSelectorsResponse' :: Maybe [EventSelector]
eventSelectors = forall a. Maybe a
Prelude.Nothing,
      $sel:trailARN:GetEventSelectorsResponse' :: Maybe Text
trailARN = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetEventSelectorsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The advanced event selectors that are configured for the trail.
getEventSelectorsResponse_advancedEventSelectors :: Lens.Lens' GetEventSelectorsResponse (Prelude.Maybe [AdvancedEventSelector])
getEventSelectorsResponse_advancedEventSelectors :: Lens' GetEventSelectorsResponse (Maybe [AdvancedEventSelector])
getEventSelectorsResponse_advancedEventSelectors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEventSelectorsResponse' {Maybe [AdvancedEventSelector]
advancedEventSelectors :: Maybe [AdvancedEventSelector]
$sel:advancedEventSelectors:GetEventSelectorsResponse' :: GetEventSelectorsResponse -> Maybe [AdvancedEventSelector]
advancedEventSelectors} -> Maybe [AdvancedEventSelector]
advancedEventSelectors) (\s :: GetEventSelectorsResponse
s@GetEventSelectorsResponse' {} Maybe [AdvancedEventSelector]
a -> GetEventSelectorsResponse
s {$sel:advancedEventSelectors:GetEventSelectorsResponse' :: Maybe [AdvancedEventSelector]
advancedEventSelectors = Maybe [AdvancedEventSelector]
a} :: GetEventSelectorsResponse) 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 event selectors that are configured for the trail.
getEventSelectorsResponse_eventSelectors :: Lens.Lens' GetEventSelectorsResponse (Prelude.Maybe [EventSelector])
getEventSelectorsResponse_eventSelectors :: Lens' GetEventSelectorsResponse (Maybe [EventSelector])
getEventSelectorsResponse_eventSelectors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEventSelectorsResponse' {Maybe [EventSelector]
eventSelectors :: Maybe [EventSelector]
$sel:eventSelectors:GetEventSelectorsResponse' :: GetEventSelectorsResponse -> Maybe [EventSelector]
eventSelectors} -> Maybe [EventSelector]
eventSelectors) (\s :: GetEventSelectorsResponse
s@GetEventSelectorsResponse' {} Maybe [EventSelector]
a -> GetEventSelectorsResponse
s {$sel:eventSelectors:GetEventSelectorsResponse' :: Maybe [EventSelector]
eventSelectors = Maybe [EventSelector]
a} :: GetEventSelectorsResponse) 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 specified trail ARN that has the event selectors.
getEventSelectorsResponse_trailARN :: Lens.Lens' GetEventSelectorsResponse (Prelude.Maybe Prelude.Text)
getEventSelectorsResponse_trailARN :: Lens' GetEventSelectorsResponse (Maybe Text)
getEventSelectorsResponse_trailARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetEventSelectorsResponse' {Maybe Text
trailARN :: Maybe Text
$sel:trailARN:GetEventSelectorsResponse' :: GetEventSelectorsResponse -> Maybe Text
trailARN} -> Maybe Text
trailARN) (\s :: GetEventSelectorsResponse
s@GetEventSelectorsResponse' {} Maybe Text
a -> GetEventSelectorsResponse
s {$sel:trailARN:GetEventSelectorsResponse' :: Maybe Text
trailARN = Maybe Text
a} :: GetEventSelectorsResponse)

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

instance Prelude.NFData GetEventSelectorsResponse where
  rnf :: GetEventSelectorsResponse -> ()
rnf GetEventSelectorsResponse' {Int
Maybe [AdvancedEventSelector]
Maybe [EventSelector]
Maybe Text
httpStatus :: Int
trailARN :: Maybe Text
eventSelectors :: Maybe [EventSelector]
advancedEventSelectors :: Maybe [AdvancedEventSelector]
$sel:httpStatus:GetEventSelectorsResponse' :: GetEventSelectorsResponse -> Int
$sel:trailARN:GetEventSelectorsResponse' :: GetEventSelectorsResponse -> Maybe Text
$sel:eventSelectors:GetEventSelectorsResponse' :: GetEventSelectorsResponse -> Maybe [EventSelector]
$sel:advancedEventSelectors:GetEventSelectorsResponse' :: GetEventSelectorsResponse -> Maybe [AdvancedEventSelector]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [AdvancedEventSelector]
advancedEventSelectors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [EventSelector]
eventSelectors
      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