{-# 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.ElasticSearch.GetUpgradeHistory
-- 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 the complete history of the last 10 upgrades that were
-- performed on the domain.
--
-- This operation returns paginated results.
module Amazonka.ElasticSearch.GetUpgradeHistory
  ( -- * Creating a Request
    GetUpgradeHistory (..),
    newGetUpgradeHistory,

    -- * Request Lenses
    getUpgradeHistory_maxResults,
    getUpgradeHistory_nextToken,
    getUpgradeHistory_domainName,

    -- * Destructuring the Response
    GetUpgradeHistoryResponse (..),
    newGetUpgradeHistoryResponse,

    -- * Response Lenses
    getUpgradeHistoryResponse_nextToken,
    getUpgradeHistoryResponse_upgradeHistories,
    getUpgradeHistoryResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.ElasticSearch.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Container for request parameters to @ @@GetUpgradeHistory@@ @ operation.
--
-- /See:/ 'newGetUpgradeHistory' smart constructor.
data GetUpgradeHistory = GetUpgradeHistory'
  { GetUpgradeHistory -> Maybe Int
maxResults :: Prelude.Maybe Prelude.Int,
    GetUpgradeHistory -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    GetUpgradeHistory -> Text
domainName :: Prelude.Text
  }
  deriving (GetUpgradeHistory -> GetUpgradeHistory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUpgradeHistory -> GetUpgradeHistory -> Bool
$c/= :: GetUpgradeHistory -> GetUpgradeHistory -> Bool
== :: GetUpgradeHistory -> GetUpgradeHistory -> Bool
$c== :: GetUpgradeHistory -> GetUpgradeHistory -> Bool
Prelude.Eq, ReadPrec [GetUpgradeHistory]
ReadPrec GetUpgradeHistory
Int -> ReadS GetUpgradeHistory
ReadS [GetUpgradeHistory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetUpgradeHistory]
$creadListPrec :: ReadPrec [GetUpgradeHistory]
readPrec :: ReadPrec GetUpgradeHistory
$creadPrec :: ReadPrec GetUpgradeHistory
readList :: ReadS [GetUpgradeHistory]
$creadList :: ReadS [GetUpgradeHistory]
readsPrec :: Int -> ReadS GetUpgradeHistory
$creadsPrec :: Int -> ReadS GetUpgradeHistory
Prelude.Read, Int -> GetUpgradeHistory -> ShowS
[GetUpgradeHistory] -> ShowS
GetUpgradeHistory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUpgradeHistory] -> ShowS
$cshowList :: [GetUpgradeHistory] -> ShowS
show :: GetUpgradeHistory -> String
$cshow :: GetUpgradeHistory -> String
showsPrec :: Int -> GetUpgradeHistory -> ShowS
$cshowsPrec :: Int -> GetUpgradeHistory -> ShowS
Prelude.Show, forall x. Rep GetUpgradeHistory x -> GetUpgradeHistory
forall x. GetUpgradeHistory -> Rep GetUpgradeHistory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetUpgradeHistory x -> GetUpgradeHistory
$cfrom :: forall x. GetUpgradeHistory -> Rep GetUpgradeHistory x
Prelude.Generic)

-- |
-- Create a value of 'GetUpgradeHistory' 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:
--
-- 'maxResults', 'getUpgradeHistory_maxResults' - Undocumented member.
--
-- 'nextToken', 'getUpgradeHistory_nextToken' - Undocumented member.
--
-- 'domainName', 'getUpgradeHistory_domainName' - Undocumented member.
newGetUpgradeHistory ::
  -- | 'domainName'
  Prelude.Text ->
  GetUpgradeHistory
newGetUpgradeHistory :: Text -> GetUpgradeHistory
newGetUpgradeHistory Text
pDomainName_ =
  GetUpgradeHistory'
    { $sel:maxResults:GetUpgradeHistory' :: Maybe Int
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetUpgradeHistory' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:domainName:GetUpgradeHistory' :: Text
domainName = Text
pDomainName_
    }

-- | Undocumented member.
getUpgradeHistory_maxResults :: Lens.Lens' GetUpgradeHistory (Prelude.Maybe Prelude.Int)
getUpgradeHistory_maxResults :: Lens' GetUpgradeHistory (Maybe Int)
getUpgradeHistory_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUpgradeHistory' {Maybe Int
maxResults :: Maybe Int
$sel:maxResults:GetUpgradeHistory' :: GetUpgradeHistory -> Maybe Int
maxResults} -> Maybe Int
maxResults) (\s :: GetUpgradeHistory
s@GetUpgradeHistory' {} Maybe Int
a -> GetUpgradeHistory
s {$sel:maxResults:GetUpgradeHistory' :: Maybe Int
maxResults = Maybe Int
a} :: GetUpgradeHistory)

-- | Undocumented member.
getUpgradeHistory_nextToken :: Lens.Lens' GetUpgradeHistory (Prelude.Maybe Prelude.Text)
getUpgradeHistory_nextToken :: Lens' GetUpgradeHistory (Maybe Text)
getUpgradeHistory_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUpgradeHistory' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetUpgradeHistory' :: GetUpgradeHistory -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetUpgradeHistory
s@GetUpgradeHistory' {} Maybe Text
a -> GetUpgradeHistory
s {$sel:nextToken:GetUpgradeHistory' :: Maybe Text
nextToken = Maybe Text
a} :: GetUpgradeHistory)

-- | Undocumented member.
getUpgradeHistory_domainName :: Lens.Lens' GetUpgradeHistory Prelude.Text
getUpgradeHistory_domainName :: Lens' GetUpgradeHistory Text
getUpgradeHistory_domainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUpgradeHistory' {Text
domainName :: Text
$sel:domainName:GetUpgradeHistory' :: GetUpgradeHistory -> Text
domainName} -> Text
domainName) (\s :: GetUpgradeHistory
s@GetUpgradeHistory' {} Text
a -> GetUpgradeHistory
s {$sel:domainName:GetUpgradeHistory' :: Text
domainName = Text
a} :: GetUpgradeHistory)

instance Core.AWSPager GetUpgradeHistory where
  page :: GetUpgradeHistory
-> AWSResponse GetUpgradeHistory -> Maybe GetUpgradeHistory
page GetUpgradeHistory
rq AWSResponse GetUpgradeHistory
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetUpgradeHistory
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetUpgradeHistoryResponse (Maybe Text)
getUpgradeHistoryResponse_nextToken
            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. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetUpgradeHistory
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetUpgradeHistoryResponse (Maybe [UpgradeHistory])
getUpgradeHistoryResponse_upgradeHistories
            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.$ GetUpgradeHistory
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetUpgradeHistory (Maybe Text)
getUpgradeHistory_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetUpgradeHistory
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetUpgradeHistoryResponse (Maybe Text)
getUpgradeHistoryResponse_nextToken
          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 GetUpgradeHistory where
  type
    AWSResponse GetUpgradeHistory =
      GetUpgradeHistoryResponse
  request :: (Service -> Service)
-> GetUpgradeHistory -> Request GetUpgradeHistory
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetUpgradeHistory
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetUpgradeHistory)))
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 Text
-> Maybe [UpgradeHistory] -> Int -> GetUpgradeHistoryResponse
GetUpgradeHistoryResponse'
            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
"NextToken")
            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
"UpgradeHistories"
                            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 GetUpgradeHistory where
  hashWithSalt :: Int -> GetUpgradeHistory -> Int
hashWithSalt Int
_salt GetUpgradeHistory' {Maybe Int
Maybe Text
Text
domainName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:domainName:GetUpgradeHistory' :: GetUpgradeHistory -> Text
$sel:nextToken:GetUpgradeHistory' :: GetUpgradeHistory -> Maybe Text
$sel:maxResults:GetUpgradeHistory' :: GetUpgradeHistory -> Maybe Int
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
domainName

instance Prelude.NFData GetUpgradeHistory where
  rnf :: GetUpgradeHistory -> ()
rnf GetUpgradeHistory' {Maybe Int
Maybe Text
Text
domainName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:domainName:GetUpgradeHistory' :: GetUpgradeHistory -> Text
$sel:nextToken:GetUpgradeHistory' :: GetUpgradeHistory -> Maybe Text
$sel:maxResults:GetUpgradeHistory' :: GetUpgradeHistory -> Maybe Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
domainName

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

instance Data.ToPath GetUpgradeHistory where
  toPath :: GetUpgradeHistory -> ByteString
toPath GetUpgradeHistory' {Maybe Int
Maybe Text
Text
domainName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:domainName:GetUpgradeHistory' :: GetUpgradeHistory -> Text
$sel:nextToken:GetUpgradeHistory' :: GetUpgradeHistory -> Maybe Text
$sel:maxResults:GetUpgradeHistory' :: GetUpgradeHistory -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/2015-01-01/es/upgradeDomain/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
domainName,
        ByteString
"/history"
      ]

instance Data.ToQuery GetUpgradeHistory where
  toQuery :: GetUpgradeHistory -> QueryString
toQuery GetUpgradeHistory' {Maybe Int
Maybe Text
Text
domainName :: Text
nextToken :: Maybe Text
maxResults :: Maybe Int
$sel:domainName:GetUpgradeHistory' :: GetUpgradeHistory -> Text
$sel:nextToken:GetUpgradeHistory' :: GetUpgradeHistory -> Maybe Text
$sel:maxResults:GetUpgradeHistory' :: GetUpgradeHistory -> Maybe Int
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Int
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken
      ]

-- | Container for response returned by @ @@GetUpgradeHistory@@ @ operation.
--
-- /See:/ 'newGetUpgradeHistoryResponse' smart constructor.
data GetUpgradeHistoryResponse = GetUpgradeHistoryResponse'
  { -- | Pagination token that needs to be supplied to the next call to get the
    -- next page of results
    GetUpgradeHistoryResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | A list of @ @@UpgradeHistory@@ @ objects corresponding to each Upgrade
    -- or Upgrade Eligibility Check performed on a domain returned as part of
    -- @ @@GetUpgradeHistoryResponse@@ @ object.
    GetUpgradeHistoryResponse -> Maybe [UpgradeHistory]
upgradeHistories :: Prelude.Maybe [UpgradeHistory],
    -- | The response's http status code.
    GetUpgradeHistoryResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetUpgradeHistoryResponse -> GetUpgradeHistoryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUpgradeHistoryResponse -> GetUpgradeHistoryResponse -> Bool
$c/= :: GetUpgradeHistoryResponse -> GetUpgradeHistoryResponse -> Bool
== :: GetUpgradeHistoryResponse -> GetUpgradeHistoryResponse -> Bool
$c== :: GetUpgradeHistoryResponse -> GetUpgradeHistoryResponse -> Bool
Prelude.Eq, ReadPrec [GetUpgradeHistoryResponse]
ReadPrec GetUpgradeHistoryResponse
Int -> ReadS GetUpgradeHistoryResponse
ReadS [GetUpgradeHistoryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetUpgradeHistoryResponse]
$creadListPrec :: ReadPrec [GetUpgradeHistoryResponse]
readPrec :: ReadPrec GetUpgradeHistoryResponse
$creadPrec :: ReadPrec GetUpgradeHistoryResponse
readList :: ReadS [GetUpgradeHistoryResponse]
$creadList :: ReadS [GetUpgradeHistoryResponse]
readsPrec :: Int -> ReadS GetUpgradeHistoryResponse
$creadsPrec :: Int -> ReadS GetUpgradeHistoryResponse
Prelude.Read, Int -> GetUpgradeHistoryResponse -> ShowS
[GetUpgradeHistoryResponse] -> ShowS
GetUpgradeHistoryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUpgradeHistoryResponse] -> ShowS
$cshowList :: [GetUpgradeHistoryResponse] -> ShowS
show :: GetUpgradeHistoryResponse -> String
$cshow :: GetUpgradeHistoryResponse -> String
showsPrec :: Int -> GetUpgradeHistoryResponse -> ShowS
$cshowsPrec :: Int -> GetUpgradeHistoryResponse -> ShowS
Prelude.Show, forall x.
Rep GetUpgradeHistoryResponse x -> GetUpgradeHistoryResponse
forall x.
GetUpgradeHistoryResponse -> Rep GetUpgradeHistoryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetUpgradeHistoryResponse x -> GetUpgradeHistoryResponse
$cfrom :: forall x.
GetUpgradeHistoryResponse -> Rep GetUpgradeHistoryResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetUpgradeHistoryResponse' 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:
--
-- 'nextToken', 'getUpgradeHistoryResponse_nextToken' - Pagination token that needs to be supplied to the next call to get the
-- next page of results
--
-- 'upgradeHistories', 'getUpgradeHistoryResponse_upgradeHistories' - A list of @ @@UpgradeHistory@@ @ objects corresponding to each Upgrade
-- or Upgrade Eligibility Check performed on a domain returned as part of
-- @ @@GetUpgradeHistoryResponse@@ @ object.
--
-- 'httpStatus', 'getUpgradeHistoryResponse_httpStatus' - The response's http status code.
newGetUpgradeHistoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetUpgradeHistoryResponse
newGetUpgradeHistoryResponse :: Int -> GetUpgradeHistoryResponse
newGetUpgradeHistoryResponse Int
pHttpStatus_ =
  GetUpgradeHistoryResponse'
    { $sel:nextToken:GetUpgradeHistoryResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:upgradeHistories:GetUpgradeHistoryResponse' :: Maybe [UpgradeHistory]
upgradeHistories = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetUpgradeHistoryResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Pagination token that needs to be supplied to the next call to get the
-- next page of results
getUpgradeHistoryResponse_nextToken :: Lens.Lens' GetUpgradeHistoryResponse (Prelude.Maybe Prelude.Text)
getUpgradeHistoryResponse_nextToken :: Lens' GetUpgradeHistoryResponse (Maybe Text)
getUpgradeHistoryResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUpgradeHistoryResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetUpgradeHistoryResponse' :: GetUpgradeHistoryResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetUpgradeHistoryResponse
s@GetUpgradeHistoryResponse' {} Maybe Text
a -> GetUpgradeHistoryResponse
s {$sel:nextToken:GetUpgradeHistoryResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetUpgradeHistoryResponse)

-- | A list of @ @@UpgradeHistory@@ @ objects corresponding to each Upgrade
-- or Upgrade Eligibility Check performed on a domain returned as part of
-- @ @@GetUpgradeHistoryResponse@@ @ object.
getUpgradeHistoryResponse_upgradeHistories :: Lens.Lens' GetUpgradeHistoryResponse (Prelude.Maybe [UpgradeHistory])
getUpgradeHistoryResponse_upgradeHistories :: Lens' GetUpgradeHistoryResponse (Maybe [UpgradeHistory])
getUpgradeHistoryResponse_upgradeHistories = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUpgradeHistoryResponse' {Maybe [UpgradeHistory]
upgradeHistories :: Maybe [UpgradeHistory]
$sel:upgradeHistories:GetUpgradeHistoryResponse' :: GetUpgradeHistoryResponse -> Maybe [UpgradeHistory]
upgradeHistories} -> Maybe [UpgradeHistory]
upgradeHistories) (\s :: GetUpgradeHistoryResponse
s@GetUpgradeHistoryResponse' {} Maybe [UpgradeHistory]
a -> GetUpgradeHistoryResponse
s {$sel:upgradeHistories:GetUpgradeHistoryResponse' :: Maybe [UpgradeHistory]
upgradeHistories = Maybe [UpgradeHistory]
a} :: GetUpgradeHistoryResponse) 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.
getUpgradeHistoryResponse_httpStatus :: Lens.Lens' GetUpgradeHistoryResponse Prelude.Int
getUpgradeHistoryResponse_httpStatus :: Lens' GetUpgradeHistoryResponse Int
getUpgradeHistoryResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUpgradeHistoryResponse' {Int
httpStatus :: Int
$sel:httpStatus:GetUpgradeHistoryResponse' :: GetUpgradeHistoryResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: GetUpgradeHistoryResponse
s@GetUpgradeHistoryResponse' {} Int
a -> GetUpgradeHistoryResponse
s {$sel:httpStatus:GetUpgradeHistoryResponse' :: Int
httpStatus = Int
a} :: GetUpgradeHistoryResponse)

instance Prelude.NFData GetUpgradeHistoryResponse where
  rnf :: GetUpgradeHistoryResponse -> ()
rnf GetUpgradeHistoryResponse' {Int
Maybe [UpgradeHistory]
Maybe Text
httpStatus :: Int
upgradeHistories :: Maybe [UpgradeHistory]
nextToken :: Maybe Text
$sel:httpStatus:GetUpgradeHistoryResponse' :: GetUpgradeHistoryResponse -> Int
$sel:upgradeHistories:GetUpgradeHistoryResponse' :: GetUpgradeHistoryResponse -> Maybe [UpgradeHistory]
$sel:nextToken:GetUpgradeHistoryResponse' :: GetUpgradeHistoryResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [UpgradeHistory]
upgradeHistories
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus