{-# 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.CloudWatchLogs.GetLogRecord
-- 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 all of the fields and values of a single log event. All fields
-- are retrieved, even if the original query that produced the
-- @logRecordPointer@ retrieved only a subset of fields. Fields are
-- returned as field name\/field value pairs.
--
-- The full unparsed log event is returned within @\@message@.
module Amazonka.CloudWatchLogs.GetLogRecord
  ( -- * Creating a Request
    GetLogRecord (..),
    newGetLogRecord,

    -- * Request Lenses
    getLogRecord_unmask,
    getLogRecord_logRecordPointer,

    -- * Destructuring the Response
    GetLogRecordResponse (..),
    newGetLogRecordResponse,

    -- * Response Lenses
    getLogRecordResponse_logRecord,
    getLogRecordResponse_httpStatus,
  )
where

import Amazonka.CloudWatchLogs.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:/ 'newGetLogRecord' smart constructor.
data GetLogRecord = GetLogRecord'
  { -- | Specify @true@ to display the log event fields with all sensitive data
    -- unmasked and visible. The default is @false@.
    --
    -- To use this operation with this parameter, you must be signed into an
    -- account with the @logs:Unmask@ permission.
    GetLogRecord -> Maybe Bool
unmask :: Prelude.Maybe Prelude.Bool,
    -- | The pointer corresponding to the log event record you want to retrieve.
    -- You get this from the response of a @GetQueryResults@ operation. In that
    -- response, the value of the @\@ptr@ field for a log event is the value to
    -- use as @logRecordPointer@ to retrieve that complete log event record.
    GetLogRecord -> Text
logRecordPointer :: Prelude.Text
  }
  deriving (GetLogRecord -> GetLogRecord -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetLogRecord -> GetLogRecord -> Bool
$c/= :: GetLogRecord -> GetLogRecord -> Bool
== :: GetLogRecord -> GetLogRecord -> Bool
$c== :: GetLogRecord -> GetLogRecord -> Bool
Prelude.Eq, ReadPrec [GetLogRecord]
ReadPrec GetLogRecord
Int -> ReadS GetLogRecord
ReadS [GetLogRecord]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetLogRecord]
$creadListPrec :: ReadPrec [GetLogRecord]
readPrec :: ReadPrec GetLogRecord
$creadPrec :: ReadPrec GetLogRecord
readList :: ReadS [GetLogRecord]
$creadList :: ReadS [GetLogRecord]
readsPrec :: Int -> ReadS GetLogRecord
$creadsPrec :: Int -> ReadS GetLogRecord
Prelude.Read, Int -> GetLogRecord -> ShowS
[GetLogRecord] -> ShowS
GetLogRecord -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetLogRecord] -> ShowS
$cshowList :: [GetLogRecord] -> ShowS
show :: GetLogRecord -> String
$cshow :: GetLogRecord -> String
showsPrec :: Int -> GetLogRecord -> ShowS
$cshowsPrec :: Int -> GetLogRecord -> ShowS
Prelude.Show, forall x. Rep GetLogRecord x -> GetLogRecord
forall x. GetLogRecord -> Rep GetLogRecord x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetLogRecord x -> GetLogRecord
$cfrom :: forall x. GetLogRecord -> Rep GetLogRecord x
Prelude.Generic)

-- |
-- Create a value of 'GetLogRecord' 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:
--
-- 'unmask', 'getLogRecord_unmask' - Specify @true@ to display the log event fields with all sensitive data
-- unmasked and visible. The default is @false@.
--
-- To use this operation with this parameter, you must be signed into an
-- account with the @logs:Unmask@ permission.
--
-- 'logRecordPointer', 'getLogRecord_logRecordPointer' - The pointer corresponding to the log event record you want to retrieve.
-- You get this from the response of a @GetQueryResults@ operation. In that
-- response, the value of the @\@ptr@ field for a log event is the value to
-- use as @logRecordPointer@ to retrieve that complete log event record.
newGetLogRecord ::
  -- | 'logRecordPointer'
  Prelude.Text ->
  GetLogRecord
newGetLogRecord :: Text -> GetLogRecord
newGetLogRecord Text
pLogRecordPointer_ =
  GetLogRecord'
    { $sel:unmask:GetLogRecord' :: Maybe Bool
unmask = forall a. Maybe a
Prelude.Nothing,
      $sel:logRecordPointer:GetLogRecord' :: Text
logRecordPointer = Text
pLogRecordPointer_
    }

-- | Specify @true@ to display the log event fields with all sensitive data
-- unmasked and visible. The default is @false@.
--
-- To use this operation with this parameter, you must be signed into an
-- account with the @logs:Unmask@ permission.
getLogRecord_unmask :: Lens.Lens' GetLogRecord (Prelude.Maybe Prelude.Bool)
getLogRecord_unmask :: Lens' GetLogRecord (Maybe Bool)
getLogRecord_unmask = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogRecord' {Maybe Bool
unmask :: Maybe Bool
$sel:unmask:GetLogRecord' :: GetLogRecord -> Maybe Bool
unmask} -> Maybe Bool
unmask) (\s :: GetLogRecord
s@GetLogRecord' {} Maybe Bool
a -> GetLogRecord
s {$sel:unmask:GetLogRecord' :: Maybe Bool
unmask = Maybe Bool
a} :: GetLogRecord)

-- | The pointer corresponding to the log event record you want to retrieve.
-- You get this from the response of a @GetQueryResults@ operation. In that
-- response, the value of the @\@ptr@ field for a log event is the value to
-- use as @logRecordPointer@ to retrieve that complete log event record.
getLogRecord_logRecordPointer :: Lens.Lens' GetLogRecord Prelude.Text
getLogRecord_logRecordPointer :: Lens' GetLogRecord Text
getLogRecord_logRecordPointer = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogRecord' {Text
logRecordPointer :: Text
$sel:logRecordPointer:GetLogRecord' :: GetLogRecord -> Text
logRecordPointer} -> Text
logRecordPointer) (\s :: GetLogRecord
s@GetLogRecord' {} Text
a -> GetLogRecord
s {$sel:logRecordPointer:GetLogRecord' :: Text
logRecordPointer = Text
a} :: GetLogRecord)

instance Core.AWSRequest GetLogRecord where
  type AWSResponse GetLogRecord = GetLogRecordResponse
  request :: (Service -> Service) -> GetLogRecord -> Request GetLogRecord
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 GetLogRecord
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetLogRecord)))
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 (HashMap Text Text) -> Int -> GetLogRecordResponse
GetLogRecordResponse'
            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
"logRecord" 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 GetLogRecord where
  hashWithSalt :: Int -> GetLogRecord -> Int
hashWithSalt Int
_salt GetLogRecord' {Maybe Bool
Text
logRecordPointer :: Text
unmask :: Maybe Bool
$sel:logRecordPointer:GetLogRecord' :: GetLogRecord -> Text
$sel:unmask:GetLogRecord' :: GetLogRecord -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
unmask
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
logRecordPointer

instance Prelude.NFData GetLogRecord where
  rnf :: GetLogRecord -> ()
rnf GetLogRecord' {Maybe Bool
Text
logRecordPointer :: Text
unmask :: Maybe Bool
$sel:logRecordPointer:GetLogRecord' :: GetLogRecord -> Text
$sel:unmask:GetLogRecord' :: GetLogRecord -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
unmask
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
logRecordPointer

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

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

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

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

-- |
-- Create a value of 'GetLogRecordResponse' 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:
--
-- 'logRecord', 'getLogRecordResponse_logRecord' - The requested log event, as a JSON string.
--
-- 'httpStatus', 'getLogRecordResponse_httpStatus' - The response's http status code.
newGetLogRecordResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetLogRecordResponse
newGetLogRecordResponse :: Int -> GetLogRecordResponse
newGetLogRecordResponse Int
pHttpStatus_ =
  GetLogRecordResponse'
    { $sel:logRecord:GetLogRecordResponse' :: Maybe (HashMap Text Text)
logRecord = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetLogRecordResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The requested log event, as a JSON string.
getLogRecordResponse_logRecord :: Lens.Lens' GetLogRecordResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
getLogRecordResponse_logRecord :: Lens' GetLogRecordResponse (Maybe (HashMap Text Text))
getLogRecordResponse_logRecord = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogRecordResponse' {Maybe (HashMap Text Text)
logRecord :: Maybe (HashMap Text Text)
$sel:logRecord:GetLogRecordResponse' :: GetLogRecordResponse -> Maybe (HashMap Text Text)
logRecord} -> Maybe (HashMap Text Text)
logRecord) (\s :: GetLogRecordResponse
s@GetLogRecordResponse' {} Maybe (HashMap Text Text)
a -> GetLogRecordResponse
s {$sel:logRecord:GetLogRecordResponse' :: Maybe (HashMap Text Text)
logRecord = Maybe (HashMap Text Text)
a} :: GetLogRecordResponse) 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.
getLogRecordResponse_httpStatus :: Lens.Lens' GetLogRecordResponse Prelude.Int
getLogRecordResponse_httpStatus :: Lens' GetLogRecordResponse Int
getLogRecordResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetLogRecordResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetLogRecordResponse' :: GetLogRecordResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetLogRecordResponse
s@GetLogRecordResponse' {} Int
a -> GetLogRecordResponse
s {$sel:httpStatus:GetLogRecordResponse' :: Int
httpStatus = Int
a} :: GetLogRecordResponse)

instance Prelude.NFData GetLogRecordResponse where
  rnf :: GetLogRecordResponse -> ()
rnf GetLogRecordResponse' {Int
Maybe (HashMap Text Text)
httpStatus :: Int
logRecord :: Maybe (HashMap Text Text)
$sel:httpStatus:GetLogRecordResponse' :: GetLogRecordResponse -> Int
$sel:logRecord:GetLogRecordResponse' :: GetLogRecordResponse -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
logRecord
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus