{-# 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.StorageGateway.ListVolumeRecoveryPoints
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Lists the recovery points for a specified gateway. This operation is
-- only supported in the cached volume gateway type.
--
-- Each cache volume has one recovery point. A volume recovery point is a
-- point in time at which all data of the volume is consistent and from
-- which you can create a snapshot or clone a new cached volume from a
-- source volume. To create a snapshot from a volume recovery point use the
-- CreateSnapshotFromVolumeRecoveryPoint operation.
module Amazonka.StorageGateway.ListVolumeRecoveryPoints
  ( -- * Creating a Request
    ListVolumeRecoveryPoints (..),
    newListVolumeRecoveryPoints,

    -- * Request Lenses
    listVolumeRecoveryPoints_gatewayARN,

    -- * Destructuring the Response
    ListVolumeRecoveryPointsResponse (..),
    newListVolumeRecoveryPointsResponse,

    -- * Response Lenses
    listVolumeRecoveryPointsResponse_gatewayARN,
    listVolumeRecoveryPointsResponse_volumeRecoveryPointInfos,
    listVolumeRecoveryPointsResponse_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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.StorageGateway.Types

-- | /See:/ 'newListVolumeRecoveryPoints' smart constructor.
data ListVolumeRecoveryPoints = ListVolumeRecoveryPoints'
  { ListVolumeRecoveryPoints -> Text
gatewayARN :: Prelude.Text
  }
  deriving (ListVolumeRecoveryPoints -> ListVolumeRecoveryPoints -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ListVolumeRecoveryPoints -> ListVolumeRecoveryPoints -> Bool
$c/= :: ListVolumeRecoveryPoints -> ListVolumeRecoveryPoints -> Bool
== :: ListVolumeRecoveryPoints -> ListVolumeRecoveryPoints -> Bool
$c== :: ListVolumeRecoveryPoints -> ListVolumeRecoveryPoints -> Bool
Prelude.Eq, ReadPrec [ListVolumeRecoveryPoints]
ReadPrec ListVolumeRecoveryPoints
Int -> ReadS ListVolumeRecoveryPoints
ReadS [ListVolumeRecoveryPoints]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ListVolumeRecoveryPoints]
$creadListPrec :: ReadPrec [ListVolumeRecoveryPoints]
readPrec :: ReadPrec ListVolumeRecoveryPoints
$creadPrec :: ReadPrec ListVolumeRecoveryPoints
readList :: ReadS [ListVolumeRecoveryPoints]
$creadList :: ReadS [ListVolumeRecoveryPoints]
readsPrec :: Int -> ReadS ListVolumeRecoveryPoints
$creadsPrec :: Int -> ReadS ListVolumeRecoveryPoints
Prelude.Read, Int -> ListVolumeRecoveryPoints -> ShowS
[ListVolumeRecoveryPoints] -> ShowS
ListVolumeRecoveryPoints -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ListVolumeRecoveryPoints] -> ShowS
$cshowList :: [ListVolumeRecoveryPoints] -> ShowS
show :: ListVolumeRecoveryPoints -> String
$cshow :: ListVolumeRecoveryPoints -> String
showsPrec :: Int -> ListVolumeRecoveryPoints -> ShowS
$cshowsPrec :: Int -> ListVolumeRecoveryPoints -> ShowS
Prelude.Show, forall x.
Rep ListVolumeRecoveryPoints x -> ListVolumeRecoveryPoints
forall x.
ListVolumeRecoveryPoints -> Rep ListVolumeRecoveryPoints x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ListVolumeRecoveryPoints x -> ListVolumeRecoveryPoints
$cfrom :: forall x.
ListVolumeRecoveryPoints -> Rep ListVolumeRecoveryPoints x
Prelude.Generic)

-- |
-- Create a value of 'ListVolumeRecoveryPoints' 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:
--
-- 'gatewayARN', 'listVolumeRecoveryPoints_gatewayARN' - Undocumented member.
newListVolumeRecoveryPoints ::
  -- | 'gatewayARN'
  Prelude.Text ->
  ListVolumeRecoveryPoints
newListVolumeRecoveryPoints :: Text -> ListVolumeRecoveryPoints
newListVolumeRecoveryPoints Text
pGatewayARN_ =
  ListVolumeRecoveryPoints'
    { $sel:gatewayARN:ListVolumeRecoveryPoints' :: Text
gatewayARN =
        Text
pGatewayARN_
    }

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

instance Core.AWSRequest ListVolumeRecoveryPoints where
  type
    AWSResponse ListVolumeRecoveryPoints =
      ListVolumeRecoveryPointsResponse
  request :: (Service -> Service)
-> ListVolumeRecoveryPoints -> Request ListVolumeRecoveryPoints
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 ListVolumeRecoveryPoints
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ListVolumeRecoveryPoints)))
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 [VolumeRecoveryPointInfo]
-> Int
-> ListVolumeRecoveryPointsResponse
ListVolumeRecoveryPointsResponse'
            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
"GatewayARN")
            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
"VolumeRecoveryPointInfos"
                            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 ListVolumeRecoveryPoints where
  hashWithSalt :: Int -> ListVolumeRecoveryPoints -> Int
hashWithSalt Int
_salt ListVolumeRecoveryPoints' {Text
gatewayARN :: Text
$sel:gatewayARN:ListVolumeRecoveryPoints' :: ListVolumeRecoveryPoints -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
gatewayARN

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

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

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

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

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

-- |
-- Create a value of 'ListVolumeRecoveryPointsResponse' 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:
--
-- 'gatewayARN', 'listVolumeRecoveryPointsResponse_gatewayARN' - Undocumented member.
--
-- 'volumeRecoveryPointInfos', 'listVolumeRecoveryPointsResponse_volumeRecoveryPointInfos' - An array of VolumeRecoveryPointInfo objects.
--
-- 'httpStatus', 'listVolumeRecoveryPointsResponse_httpStatus' - The response's http status code.
newListVolumeRecoveryPointsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ListVolumeRecoveryPointsResponse
newListVolumeRecoveryPointsResponse :: Int -> ListVolumeRecoveryPointsResponse
newListVolumeRecoveryPointsResponse Int
pHttpStatus_ =
  ListVolumeRecoveryPointsResponse'
    { $sel:gatewayARN:ListVolumeRecoveryPointsResponse' :: Maybe Text
gatewayARN =
        forall a. Maybe a
Prelude.Nothing,
      $sel:volumeRecoveryPointInfos:ListVolumeRecoveryPointsResponse' :: Maybe [VolumeRecoveryPointInfo]
volumeRecoveryPointInfos =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ListVolumeRecoveryPointsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

-- | An array of VolumeRecoveryPointInfo objects.
listVolumeRecoveryPointsResponse_volumeRecoveryPointInfos :: Lens.Lens' ListVolumeRecoveryPointsResponse (Prelude.Maybe [VolumeRecoveryPointInfo])
listVolumeRecoveryPointsResponse_volumeRecoveryPointInfos :: Lens'
  ListVolumeRecoveryPointsResponse (Maybe [VolumeRecoveryPointInfo])
listVolumeRecoveryPointsResponse_volumeRecoveryPointInfos = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVolumeRecoveryPointsResponse' {Maybe [VolumeRecoveryPointInfo]
volumeRecoveryPointInfos :: Maybe [VolumeRecoveryPointInfo]
$sel:volumeRecoveryPointInfos:ListVolumeRecoveryPointsResponse' :: ListVolumeRecoveryPointsResponse -> Maybe [VolumeRecoveryPointInfo]
volumeRecoveryPointInfos} -> Maybe [VolumeRecoveryPointInfo]
volumeRecoveryPointInfos) (\s :: ListVolumeRecoveryPointsResponse
s@ListVolumeRecoveryPointsResponse' {} Maybe [VolumeRecoveryPointInfo]
a -> ListVolumeRecoveryPointsResponse
s {$sel:volumeRecoveryPointInfos:ListVolumeRecoveryPointsResponse' :: Maybe [VolumeRecoveryPointInfo]
volumeRecoveryPointInfos = Maybe [VolumeRecoveryPointInfo]
a} :: ListVolumeRecoveryPointsResponse) 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.
listVolumeRecoveryPointsResponse_httpStatus :: Lens.Lens' ListVolumeRecoveryPointsResponse Prelude.Int
listVolumeRecoveryPointsResponse_httpStatus :: Lens' ListVolumeRecoveryPointsResponse Int
listVolumeRecoveryPointsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ListVolumeRecoveryPointsResponse' {Int
httpStatus :: Int
$sel:httpStatus:ListVolumeRecoveryPointsResponse' :: ListVolumeRecoveryPointsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: ListVolumeRecoveryPointsResponse
s@ListVolumeRecoveryPointsResponse' {} Int
a -> ListVolumeRecoveryPointsResponse
s {$sel:httpStatus:ListVolumeRecoveryPointsResponse' :: Int
httpStatus = Int
a} :: ListVolumeRecoveryPointsResponse)

instance
  Prelude.NFData
    ListVolumeRecoveryPointsResponse
  where
  rnf :: ListVolumeRecoveryPointsResponse -> ()
rnf ListVolumeRecoveryPointsResponse' {Int
Maybe [VolumeRecoveryPointInfo]
Maybe Text
httpStatus :: Int
volumeRecoveryPointInfos :: Maybe [VolumeRecoveryPointInfo]
gatewayARN :: Maybe Text
$sel:httpStatus:ListVolumeRecoveryPointsResponse' :: ListVolumeRecoveryPointsResponse -> Int
$sel:volumeRecoveryPointInfos:ListVolumeRecoveryPointsResponse' :: ListVolumeRecoveryPointsResponse -> Maybe [VolumeRecoveryPointInfo]
$sel:gatewayARN:ListVolumeRecoveryPointsResponse' :: ListVolumeRecoveryPointsResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
gatewayARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [VolumeRecoveryPointInfo]
volumeRecoveryPointInfos
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus