{-# 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.DescribeSnapshotSchedule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes the snapshot schedule for the specified gateway volume. The
-- snapshot schedule information includes intervals at which snapshots are
-- automatically initiated on the volume. This operation is only supported
-- in the cached volume and stored volume types.
module Amazonka.StorageGateway.DescribeSnapshotSchedule
  ( -- * Creating a Request
    DescribeSnapshotSchedule (..),
    newDescribeSnapshotSchedule,

    -- * Request Lenses
    describeSnapshotSchedule_volumeARN,

    -- * Destructuring the Response
    DescribeSnapshotScheduleResponse (..),
    newDescribeSnapshotScheduleResponse,

    -- * Response Lenses
    describeSnapshotScheduleResponse_description,
    describeSnapshotScheduleResponse_recurrenceInHours,
    describeSnapshotScheduleResponse_startAt,
    describeSnapshotScheduleResponse_tags,
    describeSnapshotScheduleResponse_timezone,
    describeSnapshotScheduleResponse_volumeARN,
    describeSnapshotScheduleResponse_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

-- | A JSON object containing the DescribeSnapshotScheduleInput$VolumeARN of
-- the volume.
--
-- /See:/ 'newDescribeSnapshotSchedule' smart constructor.
data DescribeSnapshotSchedule = DescribeSnapshotSchedule'
  { -- | The Amazon Resource Name (ARN) of the volume. Use the ListVolumes
    -- operation to return a list of gateway volumes.
    DescribeSnapshotSchedule -> Text
volumeARN :: Prelude.Text
  }
  deriving (DescribeSnapshotSchedule -> DescribeSnapshotSchedule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeSnapshotSchedule -> DescribeSnapshotSchedule -> Bool
$c/= :: DescribeSnapshotSchedule -> DescribeSnapshotSchedule -> Bool
== :: DescribeSnapshotSchedule -> DescribeSnapshotSchedule -> Bool
$c== :: DescribeSnapshotSchedule -> DescribeSnapshotSchedule -> Bool
Prelude.Eq, ReadPrec [DescribeSnapshotSchedule]
ReadPrec DescribeSnapshotSchedule
Int -> ReadS DescribeSnapshotSchedule
ReadS [DescribeSnapshotSchedule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeSnapshotSchedule]
$creadListPrec :: ReadPrec [DescribeSnapshotSchedule]
readPrec :: ReadPrec DescribeSnapshotSchedule
$creadPrec :: ReadPrec DescribeSnapshotSchedule
readList :: ReadS [DescribeSnapshotSchedule]
$creadList :: ReadS [DescribeSnapshotSchedule]
readsPrec :: Int -> ReadS DescribeSnapshotSchedule
$creadsPrec :: Int -> ReadS DescribeSnapshotSchedule
Prelude.Read, Int -> DescribeSnapshotSchedule -> ShowS
[DescribeSnapshotSchedule] -> ShowS
DescribeSnapshotSchedule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeSnapshotSchedule] -> ShowS
$cshowList :: [DescribeSnapshotSchedule] -> ShowS
show :: DescribeSnapshotSchedule -> String
$cshow :: DescribeSnapshotSchedule -> String
showsPrec :: Int -> DescribeSnapshotSchedule -> ShowS
$cshowsPrec :: Int -> DescribeSnapshotSchedule -> ShowS
Prelude.Show, forall x.
Rep DescribeSnapshotSchedule x -> DescribeSnapshotSchedule
forall x.
DescribeSnapshotSchedule -> Rep DescribeSnapshotSchedule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeSnapshotSchedule x -> DescribeSnapshotSchedule
$cfrom :: forall x.
DescribeSnapshotSchedule -> Rep DescribeSnapshotSchedule x
Prelude.Generic)

-- |
-- Create a value of 'DescribeSnapshotSchedule' 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:
--
-- 'volumeARN', 'describeSnapshotSchedule_volumeARN' - The Amazon Resource Name (ARN) of the volume. Use the ListVolumes
-- operation to return a list of gateway volumes.
newDescribeSnapshotSchedule ::
  -- | 'volumeARN'
  Prelude.Text ->
  DescribeSnapshotSchedule
newDescribeSnapshotSchedule :: Text -> DescribeSnapshotSchedule
newDescribeSnapshotSchedule Text
pVolumeARN_ =
  DescribeSnapshotSchedule' {$sel:volumeARN:DescribeSnapshotSchedule' :: Text
volumeARN = Text
pVolumeARN_}

-- | The Amazon Resource Name (ARN) of the volume. Use the ListVolumes
-- operation to return a list of gateway volumes.
describeSnapshotSchedule_volumeARN :: Lens.Lens' DescribeSnapshotSchedule Prelude.Text
describeSnapshotSchedule_volumeARN :: Lens' DescribeSnapshotSchedule Text
describeSnapshotSchedule_volumeARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSnapshotSchedule' {Text
volumeARN :: Text
$sel:volumeARN:DescribeSnapshotSchedule' :: DescribeSnapshotSchedule -> Text
volumeARN} -> Text
volumeARN) (\s :: DescribeSnapshotSchedule
s@DescribeSnapshotSchedule' {} Text
a -> DescribeSnapshotSchedule
s {$sel:volumeARN:DescribeSnapshotSchedule' :: Text
volumeARN = Text
a} :: DescribeSnapshotSchedule)

instance Core.AWSRequest DescribeSnapshotSchedule where
  type
    AWSResponse DescribeSnapshotSchedule =
      DescribeSnapshotScheduleResponse
  request :: (Service -> Service)
-> DescribeSnapshotSchedule -> Request DescribeSnapshotSchedule
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 DescribeSnapshotSchedule
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeSnapshotSchedule)))
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 Natural
-> Maybe Natural
-> Maybe [Tag]
-> Maybe Text
-> Maybe Text
-> Int
-> DescribeSnapshotScheduleResponse
DescribeSnapshotScheduleResponse'
            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
"Description")
            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
"RecurrenceInHours")
            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
"StartAt")
            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
"Tags" 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.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Timezone")
            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
"VolumeARN")
            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 DescribeSnapshotSchedule where
  hashWithSalt :: Int -> DescribeSnapshotSchedule -> Int
hashWithSalt Int
_salt DescribeSnapshotSchedule' {Text
volumeARN :: Text
$sel:volumeARN:DescribeSnapshotSchedule' :: DescribeSnapshotSchedule -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
volumeARN

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

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

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

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

-- | /See:/ 'newDescribeSnapshotScheduleResponse' smart constructor.
data DescribeSnapshotScheduleResponse = DescribeSnapshotScheduleResponse'
  { -- | The snapshot description.
    DescribeSnapshotScheduleResponse -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The number of hours between snapshots.
    DescribeSnapshotScheduleResponse -> Maybe Natural
recurrenceInHours :: Prelude.Maybe Prelude.Natural,
    -- | The hour of the day at which the snapshot schedule begins represented as
    -- /hh/, where /hh/ is the hour (0 to 23). The hour of the day is in the
    -- time zone of the gateway.
    DescribeSnapshotScheduleResponse -> Maybe Natural
startAt :: Prelude.Maybe Prelude.Natural,
    -- | A list of up to 50 tags assigned to the snapshot schedule, sorted
    -- alphabetically by key name. Each tag is a key-value pair. For a gateway
    -- with more than 10 tags assigned, you can view all tags using the
    -- @ListTagsForResource@ API operation.
    DescribeSnapshotScheduleResponse -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | A value that indicates the time zone of the gateway.
    DescribeSnapshotScheduleResponse -> Maybe Text
timezone :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the volume that was specified in the
    -- request.
    DescribeSnapshotScheduleResponse -> Maybe Text
volumeARN :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribeSnapshotScheduleResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeSnapshotScheduleResponse
-> DescribeSnapshotScheduleResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeSnapshotScheduleResponse
-> DescribeSnapshotScheduleResponse -> Bool
$c/= :: DescribeSnapshotScheduleResponse
-> DescribeSnapshotScheduleResponse -> Bool
== :: DescribeSnapshotScheduleResponse
-> DescribeSnapshotScheduleResponse -> Bool
$c== :: DescribeSnapshotScheduleResponse
-> DescribeSnapshotScheduleResponse -> Bool
Prelude.Eq, ReadPrec [DescribeSnapshotScheduleResponse]
ReadPrec DescribeSnapshotScheduleResponse
Int -> ReadS DescribeSnapshotScheduleResponse
ReadS [DescribeSnapshotScheduleResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeSnapshotScheduleResponse]
$creadListPrec :: ReadPrec [DescribeSnapshotScheduleResponse]
readPrec :: ReadPrec DescribeSnapshotScheduleResponse
$creadPrec :: ReadPrec DescribeSnapshotScheduleResponse
readList :: ReadS [DescribeSnapshotScheduleResponse]
$creadList :: ReadS [DescribeSnapshotScheduleResponse]
readsPrec :: Int -> ReadS DescribeSnapshotScheduleResponse
$creadsPrec :: Int -> ReadS DescribeSnapshotScheduleResponse
Prelude.Read, Int -> DescribeSnapshotScheduleResponse -> ShowS
[DescribeSnapshotScheduleResponse] -> ShowS
DescribeSnapshotScheduleResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeSnapshotScheduleResponse] -> ShowS
$cshowList :: [DescribeSnapshotScheduleResponse] -> ShowS
show :: DescribeSnapshotScheduleResponse -> String
$cshow :: DescribeSnapshotScheduleResponse -> String
showsPrec :: Int -> DescribeSnapshotScheduleResponse -> ShowS
$cshowsPrec :: Int -> DescribeSnapshotScheduleResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeSnapshotScheduleResponse x
-> DescribeSnapshotScheduleResponse
forall x.
DescribeSnapshotScheduleResponse
-> Rep DescribeSnapshotScheduleResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeSnapshotScheduleResponse x
-> DescribeSnapshotScheduleResponse
$cfrom :: forall x.
DescribeSnapshotScheduleResponse
-> Rep DescribeSnapshotScheduleResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeSnapshotScheduleResponse' 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:
--
-- 'description', 'describeSnapshotScheduleResponse_description' - The snapshot description.
--
-- 'recurrenceInHours', 'describeSnapshotScheduleResponse_recurrenceInHours' - The number of hours between snapshots.
--
-- 'startAt', 'describeSnapshotScheduleResponse_startAt' - The hour of the day at which the snapshot schedule begins represented as
-- /hh/, where /hh/ is the hour (0 to 23). The hour of the day is in the
-- time zone of the gateway.
--
-- 'tags', 'describeSnapshotScheduleResponse_tags' - A list of up to 50 tags assigned to the snapshot schedule, sorted
-- alphabetically by key name. Each tag is a key-value pair. For a gateway
-- with more than 10 tags assigned, you can view all tags using the
-- @ListTagsForResource@ API operation.
--
-- 'timezone', 'describeSnapshotScheduleResponse_timezone' - A value that indicates the time zone of the gateway.
--
-- 'volumeARN', 'describeSnapshotScheduleResponse_volumeARN' - The Amazon Resource Name (ARN) of the volume that was specified in the
-- request.
--
-- 'httpStatus', 'describeSnapshotScheduleResponse_httpStatus' - The response's http status code.
newDescribeSnapshotScheduleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeSnapshotScheduleResponse
newDescribeSnapshotScheduleResponse :: Int -> DescribeSnapshotScheduleResponse
newDescribeSnapshotScheduleResponse Int
pHttpStatus_ =
  DescribeSnapshotScheduleResponse'
    { $sel:description:DescribeSnapshotScheduleResponse' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:recurrenceInHours:DescribeSnapshotScheduleResponse' :: Maybe Natural
recurrenceInHours = forall a. Maybe a
Prelude.Nothing,
      $sel:startAt:DescribeSnapshotScheduleResponse' :: Maybe Natural
startAt = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:DescribeSnapshotScheduleResponse' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:timezone:DescribeSnapshotScheduleResponse' :: Maybe Text
timezone = forall a. Maybe a
Prelude.Nothing,
      $sel:volumeARN:DescribeSnapshotScheduleResponse' :: Maybe Text
volumeARN = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeSnapshotScheduleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The snapshot description.
describeSnapshotScheduleResponse_description :: Lens.Lens' DescribeSnapshotScheduleResponse (Prelude.Maybe Prelude.Text)
describeSnapshotScheduleResponse_description :: Lens' DescribeSnapshotScheduleResponse (Maybe Text)
describeSnapshotScheduleResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSnapshotScheduleResponse' {Maybe Text
description :: Maybe Text
$sel:description:DescribeSnapshotScheduleResponse' :: DescribeSnapshotScheduleResponse -> Maybe Text
description} -> Maybe Text
description) (\s :: DescribeSnapshotScheduleResponse
s@DescribeSnapshotScheduleResponse' {} Maybe Text
a -> DescribeSnapshotScheduleResponse
s {$sel:description:DescribeSnapshotScheduleResponse' :: Maybe Text
description = Maybe Text
a} :: DescribeSnapshotScheduleResponse)

-- | The number of hours between snapshots.
describeSnapshotScheduleResponse_recurrenceInHours :: Lens.Lens' DescribeSnapshotScheduleResponse (Prelude.Maybe Prelude.Natural)
describeSnapshotScheduleResponse_recurrenceInHours :: Lens' DescribeSnapshotScheduleResponse (Maybe Natural)
describeSnapshotScheduleResponse_recurrenceInHours = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSnapshotScheduleResponse' {Maybe Natural
recurrenceInHours :: Maybe Natural
$sel:recurrenceInHours:DescribeSnapshotScheduleResponse' :: DescribeSnapshotScheduleResponse -> Maybe Natural
recurrenceInHours} -> Maybe Natural
recurrenceInHours) (\s :: DescribeSnapshotScheduleResponse
s@DescribeSnapshotScheduleResponse' {} Maybe Natural
a -> DescribeSnapshotScheduleResponse
s {$sel:recurrenceInHours:DescribeSnapshotScheduleResponse' :: Maybe Natural
recurrenceInHours = Maybe Natural
a} :: DescribeSnapshotScheduleResponse)

-- | The hour of the day at which the snapshot schedule begins represented as
-- /hh/, where /hh/ is the hour (0 to 23). The hour of the day is in the
-- time zone of the gateway.
describeSnapshotScheduleResponse_startAt :: Lens.Lens' DescribeSnapshotScheduleResponse (Prelude.Maybe Prelude.Natural)
describeSnapshotScheduleResponse_startAt :: Lens' DescribeSnapshotScheduleResponse (Maybe Natural)
describeSnapshotScheduleResponse_startAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSnapshotScheduleResponse' {Maybe Natural
startAt :: Maybe Natural
$sel:startAt:DescribeSnapshotScheduleResponse' :: DescribeSnapshotScheduleResponse -> Maybe Natural
startAt} -> Maybe Natural
startAt) (\s :: DescribeSnapshotScheduleResponse
s@DescribeSnapshotScheduleResponse' {} Maybe Natural
a -> DescribeSnapshotScheduleResponse
s {$sel:startAt:DescribeSnapshotScheduleResponse' :: Maybe Natural
startAt = Maybe Natural
a} :: DescribeSnapshotScheduleResponse)

-- | A list of up to 50 tags assigned to the snapshot schedule, sorted
-- alphabetically by key name. Each tag is a key-value pair. For a gateway
-- with more than 10 tags assigned, you can view all tags using the
-- @ListTagsForResource@ API operation.
describeSnapshotScheduleResponse_tags :: Lens.Lens' DescribeSnapshotScheduleResponse (Prelude.Maybe [Tag])
describeSnapshotScheduleResponse_tags :: Lens' DescribeSnapshotScheduleResponse (Maybe [Tag])
describeSnapshotScheduleResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSnapshotScheduleResponse' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:DescribeSnapshotScheduleResponse' :: DescribeSnapshotScheduleResponse -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: DescribeSnapshotScheduleResponse
s@DescribeSnapshotScheduleResponse' {} Maybe [Tag]
a -> DescribeSnapshotScheduleResponse
s {$sel:tags:DescribeSnapshotScheduleResponse' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: DescribeSnapshotScheduleResponse) 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

-- | A value that indicates the time zone of the gateway.
describeSnapshotScheduleResponse_timezone :: Lens.Lens' DescribeSnapshotScheduleResponse (Prelude.Maybe Prelude.Text)
describeSnapshotScheduleResponse_timezone :: Lens' DescribeSnapshotScheduleResponse (Maybe Text)
describeSnapshotScheduleResponse_timezone = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSnapshotScheduleResponse' {Maybe Text
timezone :: Maybe Text
$sel:timezone:DescribeSnapshotScheduleResponse' :: DescribeSnapshotScheduleResponse -> Maybe Text
timezone} -> Maybe Text
timezone) (\s :: DescribeSnapshotScheduleResponse
s@DescribeSnapshotScheduleResponse' {} Maybe Text
a -> DescribeSnapshotScheduleResponse
s {$sel:timezone:DescribeSnapshotScheduleResponse' :: Maybe Text
timezone = Maybe Text
a} :: DescribeSnapshotScheduleResponse)

-- | The Amazon Resource Name (ARN) of the volume that was specified in the
-- request.
describeSnapshotScheduleResponse_volumeARN :: Lens.Lens' DescribeSnapshotScheduleResponse (Prelude.Maybe Prelude.Text)
describeSnapshotScheduleResponse_volumeARN :: Lens' DescribeSnapshotScheduleResponse (Maybe Text)
describeSnapshotScheduleResponse_volumeARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeSnapshotScheduleResponse' {Maybe Text
volumeARN :: Maybe Text
$sel:volumeARN:DescribeSnapshotScheduleResponse' :: DescribeSnapshotScheduleResponse -> Maybe Text
volumeARN} -> Maybe Text
volumeARN) (\s :: DescribeSnapshotScheduleResponse
s@DescribeSnapshotScheduleResponse' {} Maybe Text
a -> DescribeSnapshotScheduleResponse
s {$sel:volumeARN:DescribeSnapshotScheduleResponse' :: Maybe Text
volumeARN = Maybe Text
a} :: DescribeSnapshotScheduleResponse)

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

instance
  Prelude.NFData
    DescribeSnapshotScheduleResponse
  where
  rnf :: DescribeSnapshotScheduleResponse -> ()
rnf DescribeSnapshotScheduleResponse' {Int
Maybe Natural
Maybe [Tag]
Maybe Text
httpStatus :: Int
volumeARN :: Maybe Text
timezone :: Maybe Text
tags :: Maybe [Tag]
startAt :: Maybe Natural
recurrenceInHours :: Maybe Natural
description :: Maybe Text
$sel:httpStatus:DescribeSnapshotScheduleResponse' :: DescribeSnapshotScheduleResponse -> Int
$sel:volumeARN:DescribeSnapshotScheduleResponse' :: DescribeSnapshotScheduleResponse -> Maybe Text
$sel:timezone:DescribeSnapshotScheduleResponse' :: DescribeSnapshotScheduleResponse -> Maybe Text
$sel:tags:DescribeSnapshotScheduleResponse' :: DescribeSnapshotScheduleResponse -> Maybe [Tag]
$sel:startAt:DescribeSnapshotScheduleResponse' :: DescribeSnapshotScheduleResponse -> Maybe Natural
$sel:recurrenceInHours:DescribeSnapshotScheduleResponse' :: DescribeSnapshotScheduleResponse -> Maybe Natural
$sel:description:DescribeSnapshotScheduleResponse' :: DescribeSnapshotScheduleResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
recurrenceInHours
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
startAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
timezone
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
volumeARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus