{-# 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.RDS.DownloadDBLogFilePortion
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Downloads all or a portion of the specified log file, up to 1 MB in
-- size.
--
-- This command doesn\'t apply to RDS Custom.
--
-- This operation returns paginated results.
module Amazonka.RDS.DownloadDBLogFilePortion
  ( -- * Creating a Request
    DownloadDBLogFilePortion (..),
    newDownloadDBLogFilePortion,

    -- * Request Lenses
    downloadDBLogFilePortion_marker,
    downloadDBLogFilePortion_numberOfLines,
    downloadDBLogFilePortion_dbInstanceIdentifier,
    downloadDBLogFilePortion_logFileName,

    -- * Destructuring the Response
    DownloadDBLogFilePortionResponse (..),
    newDownloadDBLogFilePortionResponse,

    -- * Response Lenses
    downloadDBLogFilePortionResponse_additionalDataPending,
    downloadDBLogFilePortionResponse_logFileData,
    downloadDBLogFilePortionResponse_marker,
    downloadDBLogFilePortionResponse_httpStatus,
  )
where

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 Amazonka.RDS.Types
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- |
--
-- /See:/ 'newDownloadDBLogFilePortion' smart constructor.
data DownloadDBLogFilePortion = DownloadDBLogFilePortion'
  { -- | The pagination token provided in the previous request or \"0\". If the
    -- Marker parameter is specified the response includes only records beyond
    -- the marker until the end of the file or up to NumberOfLines.
    DownloadDBLogFilePortion -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The number of lines to download. If the number of lines specified
    -- results in a file over 1 MB in size, the file is truncated at 1 MB in
    -- size.
    --
    -- If the NumberOfLines parameter is specified, then the block of lines
    -- returned can be from the beginning or the end of the log file, depending
    -- on the value of the Marker parameter.
    --
    -- -   If neither Marker or NumberOfLines are specified, the entire log
    --     file is returned up to a maximum of 10000 lines, starting with the
    --     most recent log entries first.
    --
    -- -   If NumberOfLines is specified and Marker isn\'t specified, then the
    --     most recent lines from the end of the log file are returned.
    --
    -- -   If Marker is specified as \"0\", then the specified number of lines
    --     from the beginning of the log file are returned.
    --
    -- -   You can download the log file in blocks of lines by specifying the
    --     size of the block using the NumberOfLines parameter, and by
    --     specifying a value of \"0\" for the Marker parameter in your first
    --     request. Include the Marker value returned in the response as the
    --     Marker value for the next request, continuing until the
    --     AdditionalDataPending response element returns false.
    DownloadDBLogFilePortion -> Maybe Int
numberOfLines :: Prelude.Maybe Prelude.Int,
    -- | The customer-assigned name of the DB instance that contains the log
    -- files you want to list.
    --
    -- Constraints:
    --
    -- -   Must match the identifier of an existing DBInstance.
    DownloadDBLogFilePortion -> Text
dbInstanceIdentifier :: Prelude.Text,
    -- | The name of the log file to be downloaded.
    DownloadDBLogFilePortion -> Text
logFileName :: Prelude.Text
  }
  deriving (DownloadDBLogFilePortion -> DownloadDBLogFilePortion -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DownloadDBLogFilePortion -> DownloadDBLogFilePortion -> Bool
$c/= :: DownloadDBLogFilePortion -> DownloadDBLogFilePortion -> Bool
== :: DownloadDBLogFilePortion -> DownloadDBLogFilePortion -> Bool
$c== :: DownloadDBLogFilePortion -> DownloadDBLogFilePortion -> Bool
Prelude.Eq, ReadPrec [DownloadDBLogFilePortion]
ReadPrec DownloadDBLogFilePortion
Int -> ReadS DownloadDBLogFilePortion
ReadS [DownloadDBLogFilePortion]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DownloadDBLogFilePortion]
$creadListPrec :: ReadPrec [DownloadDBLogFilePortion]
readPrec :: ReadPrec DownloadDBLogFilePortion
$creadPrec :: ReadPrec DownloadDBLogFilePortion
readList :: ReadS [DownloadDBLogFilePortion]
$creadList :: ReadS [DownloadDBLogFilePortion]
readsPrec :: Int -> ReadS DownloadDBLogFilePortion
$creadsPrec :: Int -> ReadS DownloadDBLogFilePortion
Prelude.Read, Int -> DownloadDBLogFilePortion -> ShowS
[DownloadDBLogFilePortion] -> ShowS
DownloadDBLogFilePortion -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DownloadDBLogFilePortion] -> ShowS
$cshowList :: [DownloadDBLogFilePortion] -> ShowS
show :: DownloadDBLogFilePortion -> String
$cshow :: DownloadDBLogFilePortion -> String
showsPrec :: Int -> DownloadDBLogFilePortion -> ShowS
$cshowsPrec :: Int -> DownloadDBLogFilePortion -> ShowS
Prelude.Show, forall x.
Rep DownloadDBLogFilePortion x -> DownloadDBLogFilePortion
forall x.
DownloadDBLogFilePortion -> Rep DownloadDBLogFilePortion x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DownloadDBLogFilePortion x -> DownloadDBLogFilePortion
$cfrom :: forall x.
DownloadDBLogFilePortion -> Rep DownloadDBLogFilePortion x
Prelude.Generic)

-- |
-- Create a value of 'DownloadDBLogFilePortion' 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:
--
-- 'marker', 'downloadDBLogFilePortion_marker' - The pagination token provided in the previous request or \"0\". If the
-- Marker parameter is specified the response includes only records beyond
-- the marker until the end of the file or up to NumberOfLines.
--
-- 'numberOfLines', 'downloadDBLogFilePortion_numberOfLines' - The number of lines to download. If the number of lines specified
-- results in a file over 1 MB in size, the file is truncated at 1 MB in
-- size.
--
-- If the NumberOfLines parameter is specified, then the block of lines
-- returned can be from the beginning or the end of the log file, depending
-- on the value of the Marker parameter.
--
-- -   If neither Marker or NumberOfLines are specified, the entire log
--     file is returned up to a maximum of 10000 lines, starting with the
--     most recent log entries first.
--
-- -   If NumberOfLines is specified and Marker isn\'t specified, then the
--     most recent lines from the end of the log file are returned.
--
-- -   If Marker is specified as \"0\", then the specified number of lines
--     from the beginning of the log file are returned.
--
-- -   You can download the log file in blocks of lines by specifying the
--     size of the block using the NumberOfLines parameter, and by
--     specifying a value of \"0\" for the Marker parameter in your first
--     request. Include the Marker value returned in the response as the
--     Marker value for the next request, continuing until the
--     AdditionalDataPending response element returns false.
--
-- 'dbInstanceIdentifier', 'downloadDBLogFilePortion_dbInstanceIdentifier' - The customer-assigned name of the DB instance that contains the log
-- files you want to list.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DBInstance.
--
-- 'logFileName', 'downloadDBLogFilePortion_logFileName' - The name of the log file to be downloaded.
newDownloadDBLogFilePortion ::
  -- | 'dbInstanceIdentifier'
  Prelude.Text ->
  -- | 'logFileName'
  Prelude.Text ->
  DownloadDBLogFilePortion
newDownloadDBLogFilePortion :: Text -> Text -> DownloadDBLogFilePortion
newDownloadDBLogFilePortion
  Text
pDBInstanceIdentifier_
  Text
pLogFileName_ =
    DownloadDBLogFilePortion'
      { $sel:marker:DownloadDBLogFilePortion' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
        $sel:numberOfLines:DownloadDBLogFilePortion' :: Maybe Int
numberOfLines = forall a. Maybe a
Prelude.Nothing,
        $sel:dbInstanceIdentifier:DownloadDBLogFilePortion' :: Text
dbInstanceIdentifier = Text
pDBInstanceIdentifier_,
        $sel:logFileName:DownloadDBLogFilePortion' :: Text
logFileName = Text
pLogFileName_
      }

-- | The pagination token provided in the previous request or \"0\". If the
-- Marker parameter is specified the response includes only records beyond
-- the marker until the end of the file or up to NumberOfLines.
downloadDBLogFilePortion_marker :: Lens.Lens' DownloadDBLogFilePortion (Prelude.Maybe Prelude.Text)
downloadDBLogFilePortion_marker :: Lens' DownloadDBLogFilePortion (Maybe Text)
downloadDBLogFilePortion_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DownloadDBLogFilePortion' {Maybe Text
marker :: Maybe Text
$sel:marker:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Maybe Text
marker} -> Maybe Text
marker) (\s :: DownloadDBLogFilePortion
s@DownloadDBLogFilePortion' {} Maybe Text
a -> DownloadDBLogFilePortion
s {$sel:marker:DownloadDBLogFilePortion' :: Maybe Text
marker = Maybe Text
a} :: DownloadDBLogFilePortion)

-- | The number of lines to download. If the number of lines specified
-- results in a file over 1 MB in size, the file is truncated at 1 MB in
-- size.
--
-- If the NumberOfLines parameter is specified, then the block of lines
-- returned can be from the beginning or the end of the log file, depending
-- on the value of the Marker parameter.
--
-- -   If neither Marker or NumberOfLines are specified, the entire log
--     file is returned up to a maximum of 10000 lines, starting with the
--     most recent log entries first.
--
-- -   If NumberOfLines is specified and Marker isn\'t specified, then the
--     most recent lines from the end of the log file are returned.
--
-- -   If Marker is specified as \"0\", then the specified number of lines
--     from the beginning of the log file are returned.
--
-- -   You can download the log file in blocks of lines by specifying the
--     size of the block using the NumberOfLines parameter, and by
--     specifying a value of \"0\" for the Marker parameter in your first
--     request. Include the Marker value returned in the response as the
--     Marker value for the next request, continuing until the
--     AdditionalDataPending response element returns false.
downloadDBLogFilePortion_numberOfLines :: Lens.Lens' DownloadDBLogFilePortion (Prelude.Maybe Prelude.Int)
downloadDBLogFilePortion_numberOfLines :: Lens' DownloadDBLogFilePortion (Maybe Int)
downloadDBLogFilePortion_numberOfLines = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DownloadDBLogFilePortion' {Maybe Int
numberOfLines :: Maybe Int
$sel:numberOfLines:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Maybe Int
numberOfLines} -> Maybe Int
numberOfLines) (\s :: DownloadDBLogFilePortion
s@DownloadDBLogFilePortion' {} Maybe Int
a -> DownloadDBLogFilePortion
s {$sel:numberOfLines:DownloadDBLogFilePortion' :: Maybe Int
numberOfLines = Maybe Int
a} :: DownloadDBLogFilePortion)

-- | The customer-assigned name of the DB instance that contains the log
-- files you want to list.
--
-- Constraints:
--
-- -   Must match the identifier of an existing DBInstance.
downloadDBLogFilePortion_dbInstanceIdentifier :: Lens.Lens' DownloadDBLogFilePortion Prelude.Text
downloadDBLogFilePortion_dbInstanceIdentifier :: Lens' DownloadDBLogFilePortion Text
downloadDBLogFilePortion_dbInstanceIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DownloadDBLogFilePortion' {Text
dbInstanceIdentifier :: Text
$sel:dbInstanceIdentifier:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Text
dbInstanceIdentifier} -> Text
dbInstanceIdentifier) (\s :: DownloadDBLogFilePortion
s@DownloadDBLogFilePortion' {} Text
a -> DownloadDBLogFilePortion
s {$sel:dbInstanceIdentifier:DownloadDBLogFilePortion' :: Text
dbInstanceIdentifier = Text
a} :: DownloadDBLogFilePortion)

-- | The name of the log file to be downloaded.
downloadDBLogFilePortion_logFileName :: Lens.Lens' DownloadDBLogFilePortion Prelude.Text
downloadDBLogFilePortion_logFileName :: Lens' DownloadDBLogFilePortion Text
downloadDBLogFilePortion_logFileName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DownloadDBLogFilePortion' {Text
logFileName :: Text
$sel:logFileName:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Text
logFileName} -> Text
logFileName) (\s :: DownloadDBLogFilePortion
s@DownloadDBLogFilePortion' {} Text
a -> DownloadDBLogFilePortion
s {$sel:logFileName:DownloadDBLogFilePortion' :: Text
logFileName = Text
a} :: DownloadDBLogFilePortion)

instance Core.AWSPager DownloadDBLogFilePortion where
  page :: DownloadDBLogFilePortion
-> AWSResponse DownloadDBLogFilePortion
-> Maybe DownloadDBLogFilePortion
page DownloadDBLogFilePortion
rq AWSResponse DownloadDBLogFilePortion
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse DownloadDBLogFilePortion
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DownloadDBLogFilePortionResponse (Maybe Bool)
downloadDBLogFilePortionResponse_additionalDataPending
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. Maybe a -> Bool
Prelude.isNothing
        ( AWSResponse DownloadDBLogFilePortion
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DownloadDBLogFilePortionResponse (Maybe Text)
downloadDBLogFilePortionResponse_marker
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ DownloadDBLogFilePortion
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' DownloadDBLogFilePortion (Maybe Text)
downloadDBLogFilePortion_marker
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse DownloadDBLogFilePortion
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' DownloadDBLogFilePortionResponse (Maybe Text)
downloadDBLogFilePortionResponse_marker
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest DownloadDBLogFilePortion where
  type
    AWSResponse DownloadDBLogFilePortion =
      DownloadDBLogFilePortionResponse
  request :: (Service -> Service)
-> DownloadDBLogFilePortion -> Request DownloadDBLogFilePortion
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.postQuery (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DownloadDBLogFilePortion
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DownloadDBLogFilePortion)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
Text
-> (Int
    -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXMLWrapper
      Text
"DownloadDBLogFilePortionResult"
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Bool
-> Maybe Text
-> Maybe Text
-> Int
-> DownloadDBLogFilePortionResponse
DownloadDBLogFilePortionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"AdditionalDataPending")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"LogFileData")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Marker")
            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 DownloadDBLogFilePortion where
  hashWithSalt :: Int -> DownloadDBLogFilePortion -> Int
hashWithSalt Int
_salt DownloadDBLogFilePortion' {Maybe Int
Maybe Text
Text
logFileName :: Text
dbInstanceIdentifier :: Text
numberOfLines :: Maybe Int
marker :: Maybe Text
$sel:logFileName:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Text
$sel:dbInstanceIdentifier:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Text
$sel:numberOfLines:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Maybe Int
$sel:marker:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
marker
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
numberOfLines
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dbInstanceIdentifier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
logFileName

instance Prelude.NFData DownloadDBLogFilePortion where
  rnf :: DownloadDBLogFilePortion -> ()
rnf DownloadDBLogFilePortion' {Maybe Int
Maybe Text
Text
logFileName :: Text
dbInstanceIdentifier :: Text
numberOfLines :: Maybe Int
marker :: Maybe Text
$sel:logFileName:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Text
$sel:dbInstanceIdentifier:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Text
$sel:numberOfLines:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Maybe Int
$sel:marker:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
numberOfLines
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
dbInstanceIdentifier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
logFileName

instance Data.ToHeaders DownloadDBLogFilePortion where
  toHeaders :: DownloadDBLogFilePortion -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

instance Data.ToQuery DownloadDBLogFilePortion where
  toQuery :: DownloadDBLogFilePortion -> QueryString
toQuery DownloadDBLogFilePortion' {Maybe Int
Maybe Text
Text
logFileName :: Text
dbInstanceIdentifier :: Text
numberOfLines :: Maybe Int
marker :: Maybe Text
$sel:logFileName:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Text
$sel:dbInstanceIdentifier:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Text
$sel:numberOfLines:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Maybe Int
$sel:marker:DownloadDBLogFilePortion' :: DownloadDBLogFilePortion -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"DownloadDBLogFilePortion" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2014-10-31" :: Prelude.ByteString),
        ByteString
"Marker" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
marker,
        ByteString
"NumberOfLines" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
numberOfLines,
        ByteString
"DBInstanceIdentifier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
dbInstanceIdentifier,
        ByteString
"LogFileName" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
logFileName
      ]

-- | This data type is used as a response element to
-- @DownloadDBLogFilePortion@.
--
-- /See:/ 'newDownloadDBLogFilePortionResponse' smart constructor.
data DownloadDBLogFilePortionResponse = DownloadDBLogFilePortionResponse'
  { -- | Boolean value that if true, indicates there is more data to be
    -- downloaded.
    DownloadDBLogFilePortionResponse -> Maybe Bool
additionalDataPending :: Prelude.Maybe Prelude.Bool,
    -- | Entries from the specified log file.
    DownloadDBLogFilePortionResponse -> Maybe Text
logFileData :: Prelude.Maybe Prelude.Text,
    -- | A pagination token that can be used in a later
    -- @DownloadDBLogFilePortion@ request.
    DownloadDBLogFilePortionResponse -> Maybe Text
marker :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DownloadDBLogFilePortionResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DownloadDBLogFilePortionResponse
-> DownloadDBLogFilePortionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DownloadDBLogFilePortionResponse
-> DownloadDBLogFilePortionResponse -> Bool
$c/= :: DownloadDBLogFilePortionResponse
-> DownloadDBLogFilePortionResponse -> Bool
== :: DownloadDBLogFilePortionResponse
-> DownloadDBLogFilePortionResponse -> Bool
$c== :: DownloadDBLogFilePortionResponse
-> DownloadDBLogFilePortionResponse -> Bool
Prelude.Eq, ReadPrec [DownloadDBLogFilePortionResponse]
ReadPrec DownloadDBLogFilePortionResponse
Int -> ReadS DownloadDBLogFilePortionResponse
ReadS [DownloadDBLogFilePortionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DownloadDBLogFilePortionResponse]
$creadListPrec :: ReadPrec [DownloadDBLogFilePortionResponse]
readPrec :: ReadPrec DownloadDBLogFilePortionResponse
$creadPrec :: ReadPrec DownloadDBLogFilePortionResponse
readList :: ReadS [DownloadDBLogFilePortionResponse]
$creadList :: ReadS [DownloadDBLogFilePortionResponse]
readsPrec :: Int -> ReadS DownloadDBLogFilePortionResponse
$creadsPrec :: Int -> ReadS DownloadDBLogFilePortionResponse
Prelude.Read, Int -> DownloadDBLogFilePortionResponse -> ShowS
[DownloadDBLogFilePortionResponse] -> ShowS
DownloadDBLogFilePortionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DownloadDBLogFilePortionResponse] -> ShowS
$cshowList :: [DownloadDBLogFilePortionResponse] -> ShowS
show :: DownloadDBLogFilePortionResponse -> String
$cshow :: DownloadDBLogFilePortionResponse -> String
showsPrec :: Int -> DownloadDBLogFilePortionResponse -> ShowS
$cshowsPrec :: Int -> DownloadDBLogFilePortionResponse -> ShowS
Prelude.Show, forall x.
Rep DownloadDBLogFilePortionResponse x
-> DownloadDBLogFilePortionResponse
forall x.
DownloadDBLogFilePortionResponse
-> Rep DownloadDBLogFilePortionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DownloadDBLogFilePortionResponse x
-> DownloadDBLogFilePortionResponse
$cfrom :: forall x.
DownloadDBLogFilePortionResponse
-> Rep DownloadDBLogFilePortionResponse x
Prelude.Generic)

-- |
-- Create a value of 'DownloadDBLogFilePortionResponse' 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:
--
-- 'additionalDataPending', 'downloadDBLogFilePortionResponse_additionalDataPending' - Boolean value that if true, indicates there is more data to be
-- downloaded.
--
-- 'logFileData', 'downloadDBLogFilePortionResponse_logFileData' - Entries from the specified log file.
--
-- 'marker', 'downloadDBLogFilePortionResponse_marker' - A pagination token that can be used in a later
-- @DownloadDBLogFilePortion@ request.
--
-- 'httpStatus', 'downloadDBLogFilePortionResponse_httpStatus' - The response's http status code.
newDownloadDBLogFilePortionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DownloadDBLogFilePortionResponse
newDownloadDBLogFilePortionResponse :: Int -> DownloadDBLogFilePortionResponse
newDownloadDBLogFilePortionResponse Int
pHttpStatus_ =
  DownloadDBLogFilePortionResponse'
    { $sel:additionalDataPending:DownloadDBLogFilePortionResponse' :: Maybe Bool
additionalDataPending =
        forall a. Maybe a
Prelude.Nothing,
      $sel:logFileData:DownloadDBLogFilePortionResponse' :: Maybe Text
logFileData = forall a. Maybe a
Prelude.Nothing,
      $sel:marker:DownloadDBLogFilePortionResponse' :: Maybe Text
marker = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DownloadDBLogFilePortionResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Boolean value that if true, indicates there is more data to be
-- downloaded.
downloadDBLogFilePortionResponse_additionalDataPending :: Lens.Lens' DownloadDBLogFilePortionResponse (Prelude.Maybe Prelude.Bool)
downloadDBLogFilePortionResponse_additionalDataPending :: Lens' DownloadDBLogFilePortionResponse (Maybe Bool)
downloadDBLogFilePortionResponse_additionalDataPending = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DownloadDBLogFilePortionResponse' {Maybe Bool
additionalDataPending :: Maybe Bool
$sel:additionalDataPending:DownloadDBLogFilePortionResponse' :: DownloadDBLogFilePortionResponse -> Maybe Bool
additionalDataPending} -> Maybe Bool
additionalDataPending) (\s :: DownloadDBLogFilePortionResponse
s@DownloadDBLogFilePortionResponse' {} Maybe Bool
a -> DownloadDBLogFilePortionResponse
s {$sel:additionalDataPending:DownloadDBLogFilePortionResponse' :: Maybe Bool
additionalDataPending = Maybe Bool
a} :: DownloadDBLogFilePortionResponse)

-- | Entries from the specified log file.
downloadDBLogFilePortionResponse_logFileData :: Lens.Lens' DownloadDBLogFilePortionResponse (Prelude.Maybe Prelude.Text)
downloadDBLogFilePortionResponse_logFileData :: Lens' DownloadDBLogFilePortionResponse (Maybe Text)
downloadDBLogFilePortionResponse_logFileData = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DownloadDBLogFilePortionResponse' {Maybe Text
logFileData :: Maybe Text
$sel:logFileData:DownloadDBLogFilePortionResponse' :: DownloadDBLogFilePortionResponse -> Maybe Text
logFileData} -> Maybe Text
logFileData) (\s :: DownloadDBLogFilePortionResponse
s@DownloadDBLogFilePortionResponse' {} Maybe Text
a -> DownloadDBLogFilePortionResponse
s {$sel:logFileData:DownloadDBLogFilePortionResponse' :: Maybe Text
logFileData = Maybe Text
a} :: DownloadDBLogFilePortionResponse)

-- | A pagination token that can be used in a later
-- @DownloadDBLogFilePortion@ request.
downloadDBLogFilePortionResponse_marker :: Lens.Lens' DownloadDBLogFilePortionResponse (Prelude.Maybe Prelude.Text)
downloadDBLogFilePortionResponse_marker :: Lens' DownloadDBLogFilePortionResponse (Maybe Text)
downloadDBLogFilePortionResponse_marker = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DownloadDBLogFilePortionResponse' {Maybe Text
marker :: Maybe Text
$sel:marker:DownloadDBLogFilePortionResponse' :: DownloadDBLogFilePortionResponse -> Maybe Text
marker} -> Maybe Text
marker) (\s :: DownloadDBLogFilePortionResponse
s@DownloadDBLogFilePortionResponse' {} Maybe Text
a -> DownloadDBLogFilePortionResponse
s {$sel:marker:DownloadDBLogFilePortionResponse' :: Maybe Text
marker = Maybe Text
a} :: DownloadDBLogFilePortionResponse)

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

instance
  Prelude.NFData
    DownloadDBLogFilePortionResponse
  where
  rnf :: DownloadDBLogFilePortionResponse -> ()
rnf DownloadDBLogFilePortionResponse' {Int
Maybe Bool
Maybe Text
httpStatus :: Int
marker :: Maybe Text
logFileData :: Maybe Text
additionalDataPending :: Maybe Bool
$sel:httpStatus:DownloadDBLogFilePortionResponse' :: DownloadDBLogFilePortionResponse -> Int
$sel:marker:DownloadDBLogFilePortionResponse' :: DownloadDBLogFilePortionResponse -> Maybe Text
$sel:logFileData:DownloadDBLogFilePortionResponse' :: DownloadDBLogFilePortionResponse -> Maybe Text
$sel:additionalDataPending:DownloadDBLogFilePortionResponse' :: DownloadDBLogFilePortionResponse -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
additionalDataPending
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
logFileData
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
marker
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus