{-# 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.GetTrail
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Returns settings information for a specified trail.
module Amazonka.CloudTrail.GetTrail
  ( -- * Creating a Request
    GetTrail (..),
    newGetTrail,

    -- * Request Lenses
    getTrail_name,

    -- * Destructuring the Response
    GetTrailResponse (..),
    newGetTrailResponse,

    -- * Response Lenses
    getTrailResponse_trail,
    getTrailResponse_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:/ 'newGetTrail' smart constructor.
data GetTrail = GetTrail'
  { -- | The name or the Amazon Resource Name (ARN) of the trail for which you
    -- want to retrieve settings information.
    GetTrail -> Text
name :: Prelude.Text
  }
  deriving (GetTrail -> GetTrail -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTrail -> GetTrail -> Bool
$c/= :: GetTrail -> GetTrail -> Bool
== :: GetTrail -> GetTrail -> Bool
$c== :: GetTrail -> GetTrail -> Bool
Prelude.Eq, ReadPrec [GetTrail]
ReadPrec GetTrail
Int -> ReadS GetTrail
ReadS [GetTrail]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTrail]
$creadListPrec :: ReadPrec [GetTrail]
readPrec :: ReadPrec GetTrail
$creadPrec :: ReadPrec GetTrail
readList :: ReadS [GetTrail]
$creadList :: ReadS [GetTrail]
readsPrec :: Int -> ReadS GetTrail
$creadsPrec :: Int -> ReadS GetTrail
Prelude.Read, Int -> GetTrail -> ShowS
[GetTrail] -> ShowS
GetTrail -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTrail] -> ShowS
$cshowList :: [GetTrail] -> ShowS
show :: GetTrail -> String
$cshow :: GetTrail -> String
showsPrec :: Int -> GetTrail -> ShowS
$cshowsPrec :: Int -> GetTrail -> ShowS
Prelude.Show, forall x. Rep GetTrail x -> GetTrail
forall x. GetTrail -> Rep GetTrail x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTrail x -> GetTrail
$cfrom :: forall x. GetTrail -> Rep GetTrail x
Prelude.Generic)

-- |
-- Create a value of 'GetTrail' 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:
--
-- 'name', 'getTrail_name' - The name or the Amazon Resource Name (ARN) of the trail for which you
-- want to retrieve settings information.
newGetTrail ::
  -- | 'name'
  Prelude.Text ->
  GetTrail
newGetTrail :: Text -> GetTrail
newGetTrail Text
pName_ = GetTrail' {$sel:name:GetTrail' :: Text
name = Text
pName_}

-- | The name or the Amazon Resource Name (ARN) of the trail for which you
-- want to retrieve settings information.
getTrail_name :: Lens.Lens' GetTrail Prelude.Text
getTrail_name :: Lens' GetTrail Text
getTrail_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrail' {Text
name :: Text
$sel:name:GetTrail' :: GetTrail -> Text
name} -> Text
name) (\s :: GetTrail
s@GetTrail' {} Text
a -> GetTrail
s {$sel:name:GetTrail' :: Text
name = Text
a} :: GetTrail)

instance Core.AWSRequest GetTrail where
  type AWSResponse GetTrail = GetTrailResponse
  request :: (Service -> Service) -> GetTrail -> Request GetTrail
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 GetTrail
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetTrail)))
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 -> GetTrailResponse
GetTrailResponse'
            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
"Trail")
            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 GetTrail where
  hashWithSalt :: Int -> GetTrail -> Int
hashWithSalt Int
_salt GetTrail' {Text
name :: Text
$sel:name:GetTrail' :: GetTrail -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name

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

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

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

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

-- | /See:/ 'newGetTrailResponse' smart constructor.
data GetTrailResponse = GetTrailResponse'
  { GetTrailResponse -> Maybe Trail
trail :: Prelude.Maybe Trail,
    -- | The response's http status code.
    GetTrailResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetTrailResponse -> GetTrailResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTrailResponse -> GetTrailResponse -> Bool
$c/= :: GetTrailResponse -> GetTrailResponse -> Bool
== :: GetTrailResponse -> GetTrailResponse -> Bool
$c== :: GetTrailResponse -> GetTrailResponse -> Bool
Prelude.Eq, ReadPrec [GetTrailResponse]
ReadPrec GetTrailResponse
Int -> ReadS GetTrailResponse
ReadS [GetTrailResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTrailResponse]
$creadListPrec :: ReadPrec [GetTrailResponse]
readPrec :: ReadPrec GetTrailResponse
$creadPrec :: ReadPrec GetTrailResponse
readList :: ReadS [GetTrailResponse]
$creadList :: ReadS [GetTrailResponse]
readsPrec :: Int -> ReadS GetTrailResponse
$creadsPrec :: Int -> ReadS GetTrailResponse
Prelude.Read, Int -> GetTrailResponse -> ShowS
[GetTrailResponse] -> ShowS
GetTrailResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTrailResponse] -> ShowS
$cshowList :: [GetTrailResponse] -> ShowS
show :: GetTrailResponse -> String
$cshow :: GetTrailResponse -> String
showsPrec :: Int -> GetTrailResponse -> ShowS
$cshowsPrec :: Int -> GetTrailResponse -> ShowS
Prelude.Show, forall x. Rep GetTrailResponse x -> GetTrailResponse
forall x. GetTrailResponse -> Rep GetTrailResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTrailResponse x -> GetTrailResponse
$cfrom :: forall x. GetTrailResponse -> Rep GetTrailResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetTrailResponse' 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:
--
-- 'trail', 'getTrailResponse_trail' - Undocumented member.
--
-- 'httpStatus', 'getTrailResponse_httpStatus' - The response's http status code.
newGetTrailResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetTrailResponse
newGetTrailResponse :: Int -> GetTrailResponse
newGetTrailResponse Int
pHttpStatus_ =
  GetTrailResponse'
    { $sel:trail:GetTrailResponse' :: Maybe Trail
trail = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetTrailResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
getTrailResponse_trail :: Lens.Lens' GetTrailResponse (Prelude.Maybe Trail)
getTrailResponse_trail :: Lens' GetTrailResponse (Maybe Trail)
getTrailResponse_trail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTrailResponse' {Maybe Trail
trail :: Maybe Trail
$sel:trail:GetTrailResponse' :: GetTrailResponse -> Maybe Trail
trail} -> Maybe Trail
trail) (\s :: GetTrailResponse
s@GetTrailResponse' {} Maybe Trail
a -> GetTrailResponse
s {$sel:trail:GetTrailResponse' :: Maybe Trail
trail = Maybe Trail
a} :: GetTrailResponse)

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

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