{-# 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.UpdateSnapshotSchedule
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates a snapshot schedule configured for a gateway volume. This
-- operation is only supported in the cached volume and stored volume
-- gateway types.
--
-- The default snapshot schedule for volume is once every 24 hours,
-- starting at the creation time of the volume. You can use this API to
-- change the snapshot schedule configured for the volume.
--
-- In the request you must identify the gateway volume whose snapshot
-- schedule you want to update, and the schedule information, including
-- when you want the snapshot to begin on a day and the frequency (in
-- hours) of snapshots.
module Amazonka.StorageGateway.UpdateSnapshotSchedule
  ( -- * Creating a Request
    UpdateSnapshotSchedule (..),
    newUpdateSnapshotSchedule,

    -- * Request Lenses
    updateSnapshotSchedule_description,
    updateSnapshotSchedule_tags,
    updateSnapshotSchedule_volumeARN,
    updateSnapshotSchedule_startAt,
    updateSnapshotSchedule_recurrenceInHours,

    -- * Destructuring the Response
    UpdateSnapshotScheduleResponse (..),
    newUpdateSnapshotScheduleResponse,

    -- * Response Lenses
    updateSnapshotScheduleResponse_volumeARN,
    updateSnapshotScheduleResponse_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 one or more of the following fields:
--
-- -   UpdateSnapshotScheduleInput$Description
--
-- -   UpdateSnapshotScheduleInput$RecurrenceInHours
--
-- -   UpdateSnapshotScheduleInput$StartAt
--
-- -   UpdateSnapshotScheduleInput$VolumeARN
--
-- /See:/ 'newUpdateSnapshotSchedule' smart constructor.
data UpdateSnapshotSchedule = UpdateSnapshotSchedule'
  { -- | Optional description of the snapshot that overwrites the existing
    -- description.
    UpdateSnapshotSchedule -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A list of up to 50 tags that can be assigned to a snapshot. Each tag is
    -- a key-value pair.
    --
    -- Valid characters for key and value are letters, spaces, and numbers
    -- representable in UTF-8 format, and the following special characters: + -
    -- = . _ : \/ \@. The maximum length of a tag\'s key is 128 characters, and
    -- the maximum length for a tag\'s value is 256.
    UpdateSnapshotSchedule -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The Amazon Resource Name (ARN) of the volume. Use the ListVolumes
    -- operation to return a list of gateway volumes.
    UpdateSnapshotSchedule -> Text
volumeARN :: Prelude.Text,
    -- | 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.
    UpdateSnapshotSchedule -> Natural
startAt :: Prelude.Natural,
    -- | Frequency of snapshots. Specify the number of hours between snapshots.
    UpdateSnapshotSchedule -> Natural
recurrenceInHours :: Prelude.Natural
  }
  deriving (UpdateSnapshotSchedule -> UpdateSnapshotSchedule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateSnapshotSchedule -> UpdateSnapshotSchedule -> Bool
$c/= :: UpdateSnapshotSchedule -> UpdateSnapshotSchedule -> Bool
== :: UpdateSnapshotSchedule -> UpdateSnapshotSchedule -> Bool
$c== :: UpdateSnapshotSchedule -> UpdateSnapshotSchedule -> Bool
Prelude.Eq, ReadPrec [UpdateSnapshotSchedule]
ReadPrec UpdateSnapshotSchedule
Int -> ReadS UpdateSnapshotSchedule
ReadS [UpdateSnapshotSchedule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateSnapshotSchedule]
$creadListPrec :: ReadPrec [UpdateSnapshotSchedule]
readPrec :: ReadPrec UpdateSnapshotSchedule
$creadPrec :: ReadPrec UpdateSnapshotSchedule
readList :: ReadS [UpdateSnapshotSchedule]
$creadList :: ReadS [UpdateSnapshotSchedule]
readsPrec :: Int -> ReadS UpdateSnapshotSchedule
$creadsPrec :: Int -> ReadS UpdateSnapshotSchedule
Prelude.Read, Int -> UpdateSnapshotSchedule -> ShowS
[UpdateSnapshotSchedule] -> ShowS
UpdateSnapshotSchedule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateSnapshotSchedule] -> ShowS
$cshowList :: [UpdateSnapshotSchedule] -> ShowS
show :: UpdateSnapshotSchedule -> String
$cshow :: UpdateSnapshotSchedule -> String
showsPrec :: Int -> UpdateSnapshotSchedule -> ShowS
$cshowsPrec :: Int -> UpdateSnapshotSchedule -> ShowS
Prelude.Show, forall x. Rep UpdateSnapshotSchedule x -> UpdateSnapshotSchedule
forall x. UpdateSnapshotSchedule -> Rep UpdateSnapshotSchedule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateSnapshotSchedule x -> UpdateSnapshotSchedule
$cfrom :: forall x. UpdateSnapshotSchedule -> Rep UpdateSnapshotSchedule x
Prelude.Generic)

-- |
-- Create a value of 'UpdateSnapshotSchedule' 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', 'updateSnapshotSchedule_description' - Optional description of the snapshot that overwrites the existing
-- description.
--
-- 'tags', 'updateSnapshotSchedule_tags' - A list of up to 50 tags that can be assigned to a snapshot. Each tag is
-- a key-value pair.
--
-- Valid characters for key and value are letters, spaces, and numbers
-- representable in UTF-8 format, and the following special characters: + -
-- = . _ : \/ \@. The maximum length of a tag\'s key is 128 characters, and
-- the maximum length for a tag\'s value is 256.
--
-- 'volumeARN', 'updateSnapshotSchedule_volumeARN' - The Amazon Resource Name (ARN) of the volume. Use the ListVolumes
-- operation to return a list of gateway volumes.
--
-- 'startAt', 'updateSnapshotSchedule_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.
--
-- 'recurrenceInHours', 'updateSnapshotSchedule_recurrenceInHours' - Frequency of snapshots. Specify the number of hours between snapshots.
newUpdateSnapshotSchedule ::
  -- | 'volumeARN'
  Prelude.Text ->
  -- | 'startAt'
  Prelude.Natural ->
  -- | 'recurrenceInHours'
  Prelude.Natural ->
  UpdateSnapshotSchedule
newUpdateSnapshotSchedule :: Text -> Natural -> Natural -> UpdateSnapshotSchedule
newUpdateSnapshotSchedule
  Text
pVolumeARN_
  Natural
pStartAt_
  Natural
pRecurrenceInHours_ =
    UpdateSnapshotSchedule'
      { $sel:description:UpdateSnapshotSchedule' :: Maybe Text
description =
          forall a. Maybe a
Prelude.Nothing,
        $sel:tags:UpdateSnapshotSchedule' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:volumeARN:UpdateSnapshotSchedule' :: Text
volumeARN = Text
pVolumeARN_,
        $sel:startAt:UpdateSnapshotSchedule' :: Natural
startAt = Natural
pStartAt_,
        $sel:recurrenceInHours:UpdateSnapshotSchedule' :: Natural
recurrenceInHours = Natural
pRecurrenceInHours_
      }

-- | Optional description of the snapshot that overwrites the existing
-- description.
updateSnapshotSchedule_description :: Lens.Lens' UpdateSnapshotSchedule (Prelude.Maybe Prelude.Text)
updateSnapshotSchedule_description :: Lens' UpdateSnapshotSchedule (Maybe Text)
updateSnapshotSchedule_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSnapshotSchedule' {Maybe Text
description :: Maybe Text
$sel:description:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateSnapshotSchedule
s@UpdateSnapshotSchedule' {} Maybe Text
a -> UpdateSnapshotSchedule
s {$sel:description:UpdateSnapshotSchedule' :: Maybe Text
description = Maybe Text
a} :: UpdateSnapshotSchedule)

-- | A list of up to 50 tags that can be assigned to a snapshot. Each tag is
-- a key-value pair.
--
-- Valid characters for key and value are letters, spaces, and numbers
-- representable in UTF-8 format, and the following special characters: + -
-- = . _ : \/ \@. The maximum length of a tag\'s key is 128 characters, and
-- the maximum length for a tag\'s value is 256.
updateSnapshotSchedule_tags :: Lens.Lens' UpdateSnapshotSchedule (Prelude.Maybe [Tag])
updateSnapshotSchedule_tags :: Lens' UpdateSnapshotSchedule (Maybe [Tag])
updateSnapshotSchedule_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSnapshotSchedule' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: UpdateSnapshotSchedule
s@UpdateSnapshotSchedule' {} Maybe [Tag]
a -> UpdateSnapshotSchedule
s {$sel:tags:UpdateSnapshotSchedule' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: UpdateSnapshotSchedule) 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 Amazon Resource Name (ARN) of the volume. Use the ListVolumes
-- operation to return a list of gateway volumes.
updateSnapshotSchedule_volumeARN :: Lens.Lens' UpdateSnapshotSchedule Prelude.Text
updateSnapshotSchedule_volumeARN :: Lens' UpdateSnapshotSchedule Text
updateSnapshotSchedule_volumeARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSnapshotSchedule' {Text
volumeARN :: Text
$sel:volumeARN:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Text
volumeARN} -> Text
volumeARN) (\s :: UpdateSnapshotSchedule
s@UpdateSnapshotSchedule' {} Text
a -> UpdateSnapshotSchedule
s {$sel:volumeARN:UpdateSnapshotSchedule' :: Text
volumeARN = Text
a} :: UpdateSnapshotSchedule)

-- | 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.
updateSnapshotSchedule_startAt :: Lens.Lens' UpdateSnapshotSchedule Prelude.Natural
updateSnapshotSchedule_startAt :: Lens' UpdateSnapshotSchedule Natural
updateSnapshotSchedule_startAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSnapshotSchedule' {Natural
startAt :: Natural
$sel:startAt:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Natural
startAt} -> Natural
startAt) (\s :: UpdateSnapshotSchedule
s@UpdateSnapshotSchedule' {} Natural
a -> UpdateSnapshotSchedule
s {$sel:startAt:UpdateSnapshotSchedule' :: Natural
startAt = Natural
a} :: UpdateSnapshotSchedule)

-- | Frequency of snapshots. Specify the number of hours between snapshots.
updateSnapshotSchedule_recurrenceInHours :: Lens.Lens' UpdateSnapshotSchedule Prelude.Natural
updateSnapshotSchedule_recurrenceInHours :: Lens' UpdateSnapshotSchedule Natural
updateSnapshotSchedule_recurrenceInHours = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateSnapshotSchedule' {Natural
recurrenceInHours :: Natural
$sel:recurrenceInHours:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Natural
recurrenceInHours} -> Natural
recurrenceInHours) (\s :: UpdateSnapshotSchedule
s@UpdateSnapshotSchedule' {} Natural
a -> UpdateSnapshotSchedule
s {$sel:recurrenceInHours:UpdateSnapshotSchedule' :: Natural
recurrenceInHours = Natural
a} :: UpdateSnapshotSchedule)

instance Core.AWSRequest UpdateSnapshotSchedule where
  type
    AWSResponse UpdateSnapshotSchedule =
      UpdateSnapshotScheduleResponse
  request :: (Service -> Service)
-> UpdateSnapshotSchedule -> Request UpdateSnapshotSchedule
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 UpdateSnapshotSchedule
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateSnapshotSchedule)))
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 -> Int -> UpdateSnapshotScheduleResponse
UpdateSnapshotScheduleResponse'
            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
"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 UpdateSnapshotSchedule where
  hashWithSalt :: Int -> UpdateSnapshotSchedule -> Int
hashWithSalt Int
_salt UpdateSnapshotSchedule' {Natural
Maybe [Tag]
Maybe Text
Text
recurrenceInHours :: Natural
startAt :: Natural
volumeARN :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:recurrenceInHours:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Natural
$sel:startAt:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Natural
$sel:volumeARN:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Text
$sel:tags:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Maybe [Tag]
$sel:description:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
volumeARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
startAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
recurrenceInHours

instance Prelude.NFData UpdateSnapshotSchedule where
  rnf :: UpdateSnapshotSchedule -> ()
rnf UpdateSnapshotSchedule' {Natural
Maybe [Tag]
Maybe Text
Text
recurrenceInHours :: Natural
startAt :: Natural
volumeARN :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:recurrenceInHours:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Natural
$sel:startAt:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Natural
$sel:volumeARN:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Text
$sel:tags:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Maybe [Tag]
$sel:description:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> 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 [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
volumeARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
startAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
recurrenceInHours

instance Data.ToHeaders UpdateSnapshotSchedule where
  toHeaders :: UpdateSnapshotSchedule -> 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.UpdateSnapshotSchedule" ::
                          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 UpdateSnapshotSchedule where
  toJSON :: UpdateSnapshotSchedule -> Value
toJSON UpdateSnapshotSchedule' {Natural
Maybe [Tag]
Maybe Text
Text
recurrenceInHours :: Natural
startAt :: Natural
volumeARN :: Text
tags :: Maybe [Tag]
description :: Maybe Text
$sel:recurrenceInHours:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Natural
$sel:startAt:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Natural
$sel:volumeARN:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Text
$sel:tags:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Maybe [Tag]
$sel:description:UpdateSnapshotSchedule' :: UpdateSnapshotSchedule -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
description,
            (Key
"Tags" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [Tag]
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"VolumeARN" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
volumeARN),
            forall a. a -> Maybe a
Prelude.Just (Key
"StartAt" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
startAt),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"RecurrenceInHours" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
recurrenceInHours)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateSnapshotScheduleResponse' 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', 'updateSnapshotScheduleResponse_volumeARN' - The Amazon Resource Name (ARN) of the volume. Use the ListVolumes
-- operation to return a list of gateway volumes.
--
-- 'httpStatus', 'updateSnapshotScheduleResponse_httpStatus' - The response's http status code.
newUpdateSnapshotScheduleResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateSnapshotScheduleResponse
newUpdateSnapshotScheduleResponse :: Int -> UpdateSnapshotScheduleResponse
newUpdateSnapshotScheduleResponse Int
pHttpStatus_ =
  UpdateSnapshotScheduleResponse'
    { $sel:volumeARN:UpdateSnapshotScheduleResponse' :: Maybe Text
volumeARN =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateSnapshotScheduleResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

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

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

instance
  Prelude.NFData
    UpdateSnapshotScheduleResponse
  where
  rnf :: UpdateSnapshotScheduleResponse -> ()
rnf UpdateSnapshotScheduleResponse' {Int
Maybe Text
httpStatus :: Int
volumeARN :: Maybe Text
$sel:httpStatus:UpdateSnapshotScheduleResponse' :: UpdateSnapshotScheduleResponse -> Int
$sel:volumeARN:UpdateSnapshotScheduleResponse' :: UpdateSnapshotScheduleResponse -> Maybe Text
..} =
    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