{-# 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.EC2.ModifySnapshotTier
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Archives an Amazon EBS snapshot. When you archive a snapshot, it is
-- converted to a full snapshot that includes all of the blocks of data
-- that were written to the volume at the time the snapshot was created,
-- and moved from the standard tier to the archive tier. For more
-- information, see
-- <https://docs.aws.amazon.com/AWSEC2/latest/UserGuide/snapshot-archive.html Archive Amazon EBS snapshots>
-- in the /Amazon Elastic Compute Cloud User Guide/.
module Amazonka.EC2.ModifySnapshotTier
  ( -- * Creating a Request
    ModifySnapshotTier (..),
    newModifySnapshotTier,

    -- * Request Lenses
    modifySnapshotTier_dryRun,
    modifySnapshotTier_storageTier,
    modifySnapshotTier_snapshotId,

    -- * Destructuring the Response
    ModifySnapshotTierResponse (..),
    newModifySnapshotTierResponse,

    -- * Response Lenses
    modifySnapshotTierResponse_snapshotId,
    modifySnapshotTierResponse_tieringStartTime,
    modifySnapshotTierResponse_httpStatus,
  )
where

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

-- | /See:/ 'newModifySnapshotTier' smart constructor.
data ModifySnapshotTier = ModifySnapshotTier'
  { -- | Checks whether you have the required permissions for the action, without
    -- actually making the request, and provides an error response. If you have
    -- the required permissions, the error response is @DryRunOperation@.
    -- Otherwise, it is @UnauthorizedOperation@.
    ModifySnapshotTier -> Maybe Bool
dryRun :: Prelude.Maybe Prelude.Bool,
    -- | The name of the storage tier. You must specify @archive@.
    ModifySnapshotTier -> Maybe TargetStorageTier
storageTier :: Prelude.Maybe TargetStorageTier,
    -- | The ID of the snapshot.
    ModifySnapshotTier -> Text
snapshotId :: Prelude.Text
  }
  deriving (ModifySnapshotTier -> ModifySnapshotTier -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifySnapshotTier -> ModifySnapshotTier -> Bool
$c/= :: ModifySnapshotTier -> ModifySnapshotTier -> Bool
== :: ModifySnapshotTier -> ModifySnapshotTier -> Bool
$c== :: ModifySnapshotTier -> ModifySnapshotTier -> Bool
Prelude.Eq, ReadPrec [ModifySnapshotTier]
ReadPrec ModifySnapshotTier
Int -> ReadS ModifySnapshotTier
ReadS [ModifySnapshotTier]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifySnapshotTier]
$creadListPrec :: ReadPrec [ModifySnapshotTier]
readPrec :: ReadPrec ModifySnapshotTier
$creadPrec :: ReadPrec ModifySnapshotTier
readList :: ReadS [ModifySnapshotTier]
$creadList :: ReadS [ModifySnapshotTier]
readsPrec :: Int -> ReadS ModifySnapshotTier
$creadsPrec :: Int -> ReadS ModifySnapshotTier
Prelude.Read, Int -> ModifySnapshotTier -> ShowS
[ModifySnapshotTier] -> ShowS
ModifySnapshotTier -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifySnapshotTier] -> ShowS
$cshowList :: [ModifySnapshotTier] -> ShowS
show :: ModifySnapshotTier -> String
$cshow :: ModifySnapshotTier -> String
showsPrec :: Int -> ModifySnapshotTier -> ShowS
$cshowsPrec :: Int -> ModifySnapshotTier -> ShowS
Prelude.Show, forall x. Rep ModifySnapshotTier x -> ModifySnapshotTier
forall x. ModifySnapshotTier -> Rep ModifySnapshotTier x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifySnapshotTier x -> ModifySnapshotTier
$cfrom :: forall x. ModifySnapshotTier -> Rep ModifySnapshotTier x
Prelude.Generic)

-- |
-- Create a value of 'ModifySnapshotTier' 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:
--
-- 'dryRun', 'modifySnapshotTier_dryRun' - Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
--
-- 'storageTier', 'modifySnapshotTier_storageTier' - The name of the storage tier. You must specify @archive@.
--
-- 'snapshotId', 'modifySnapshotTier_snapshotId' - The ID of the snapshot.
newModifySnapshotTier ::
  -- | 'snapshotId'
  Prelude.Text ->
  ModifySnapshotTier
newModifySnapshotTier :: Text -> ModifySnapshotTier
newModifySnapshotTier Text
pSnapshotId_ =
  ModifySnapshotTier'
    { $sel:dryRun:ModifySnapshotTier' :: Maybe Bool
dryRun = forall a. Maybe a
Prelude.Nothing,
      $sel:storageTier:ModifySnapshotTier' :: Maybe TargetStorageTier
storageTier = forall a. Maybe a
Prelude.Nothing,
      $sel:snapshotId:ModifySnapshotTier' :: Text
snapshotId = Text
pSnapshotId_
    }

-- | Checks whether you have the required permissions for the action, without
-- actually making the request, and provides an error response. If you have
-- the required permissions, the error response is @DryRunOperation@.
-- Otherwise, it is @UnauthorizedOperation@.
modifySnapshotTier_dryRun :: Lens.Lens' ModifySnapshotTier (Prelude.Maybe Prelude.Bool)
modifySnapshotTier_dryRun :: Lens' ModifySnapshotTier (Maybe Bool)
modifySnapshotTier_dryRun = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySnapshotTier' {Maybe Bool
dryRun :: Maybe Bool
$sel:dryRun:ModifySnapshotTier' :: ModifySnapshotTier -> Maybe Bool
dryRun} -> Maybe Bool
dryRun) (\s :: ModifySnapshotTier
s@ModifySnapshotTier' {} Maybe Bool
a -> ModifySnapshotTier
s {$sel:dryRun:ModifySnapshotTier' :: Maybe Bool
dryRun = Maybe Bool
a} :: ModifySnapshotTier)

-- | The name of the storage tier. You must specify @archive@.
modifySnapshotTier_storageTier :: Lens.Lens' ModifySnapshotTier (Prelude.Maybe TargetStorageTier)
modifySnapshotTier_storageTier :: Lens' ModifySnapshotTier (Maybe TargetStorageTier)
modifySnapshotTier_storageTier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySnapshotTier' {Maybe TargetStorageTier
storageTier :: Maybe TargetStorageTier
$sel:storageTier:ModifySnapshotTier' :: ModifySnapshotTier -> Maybe TargetStorageTier
storageTier} -> Maybe TargetStorageTier
storageTier) (\s :: ModifySnapshotTier
s@ModifySnapshotTier' {} Maybe TargetStorageTier
a -> ModifySnapshotTier
s {$sel:storageTier:ModifySnapshotTier' :: Maybe TargetStorageTier
storageTier = Maybe TargetStorageTier
a} :: ModifySnapshotTier)

-- | The ID of the snapshot.
modifySnapshotTier_snapshotId :: Lens.Lens' ModifySnapshotTier Prelude.Text
modifySnapshotTier_snapshotId :: Lens' ModifySnapshotTier Text
modifySnapshotTier_snapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySnapshotTier' {Text
snapshotId :: Text
$sel:snapshotId:ModifySnapshotTier' :: ModifySnapshotTier -> Text
snapshotId} -> Text
snapshotId) (\s :: ModifySnapshotTier
s@ModifySnapshotTier' {} Text
a -> ModifySnapshotTier
s {$sel:snapshotId:ModifySnapshotTier' :: Text
snapshotId = Text
a} :: ModifySnapshotTier)

instance Core.AWSRequest ModifySnapshotTier where
  type
    AWSResponse ModifySnapshotTier =
      ModifySnapshotTierResponse
  request :: (Service -> Service)
-> ModifySnapshotTier -> Request ModifySnapshotTier
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 ModifySnapshotTier
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifySnapshotTier)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Maybe Text -> Maybe ISO8601 -> Int -> ModifySnapshotTierResponse
ModifySnapshotTierResponse'
            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
"snapshotId")
            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
"tieringStartTime")
            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 ModifySnapshotTier where
  hashWithSalt :: Int -> ModifySnapshotTier -> Int
hashWithSalt Int
_salt ModifySnapshotTier' {Maybe Bool
Maybe TargetStorageTier
Text
snapshotId :: Text
storageTier :: Maybe TargetStorageTier
dryRun :: Maybe Bool
$sel:snapshotId:ModifySnapshotTier' :: ModifySnapshotTier -> Text
$sel:storageTier:ModifySnapshotTier' :: ModifySnapshotTier -> Maybe TargetStorageTier
$sel:dryRun:ModifySnapshotTier' :: ModifySnapshotTier -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
dryRun
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TargetStorageTier
storageTier
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
snapshotId

instance Prelude.NFData ModifySnapshotTier where
  rnf :: ModifySnapshotTier -> ()
rnf ModifySnapshotTier' {Maybe Bool
Maybe TargetStorageTier
Text
snapshotId :: Text
storageTier :: Maybe TargetStorageTier
dryRun :: Maybe Bool
$sel:snapshotId:ModifySnapshotTier' :: ModifySnapshotTier -> Text
$sel:storageTier:ModifySnapshotTier' :: ModifySnapshotTier -> Maybe TargetStorageTier
$sel:dryRun:ModifySnapshotTier' :: ModifySnapshotTier -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
dryRun
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TargetStorageTier
storageTier
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
snapshotId

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

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

instance Data.ToQuery ModifySnapshotTier where
  toQuery :: ModifySnapshotTier -> QueryString
toQuery ModifySnapshotTier' {Maybe Bool
Maybe TargetStorageTier
Text
snapshotId :: Text
storageTier :: Maybe TargetStorageTier
dryRun :: Maybe Bool
$sel:snapshotId:ModifySnapshotTier' :: ModifySnapshotTier -> Text
$sel:storageTier:ModifySnapshotTier' :: ModifySnapshotTier -> Maybe TargetStorageTier
$sel:dryRun:ModifySnapshotTier' :: ModifySnapshotTier -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"Action"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"ModifySnapshotTier" :: Prelude.ByteString),
        ByteString
"Version"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: (ByteString
"2016-11-15" :: Prelude.ByteString),
        ByteString
"DryRun" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
dryRun,
        ByteString
"StorageTier" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TargetStorageTier
storageTier,
        ByteString
"SnapshotId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
snapshotId
      ]

-- | /See:/ 'newModifySnapshotTierResponse' smart constructor.
data ModifySnapshotTierResponse = ModifySnapshotTierResponse'
  { -- | The ID of the snapshot.
    ModifySnapshotTierResponse -> Maybe Text
snapshotId :: Prelude.Maybe Prelude.Text,
    -- | The date and time when the archive process was started.
    ModifySnapshotTierResponse -> Maybe ISO8601
tieringStartTime :: Prelude.Maybe Data.ISO8601,
    -- | The response's http status code.
    ModifySnapshotTierResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (ModifySnapshotTierResponse -> ModifySnapshotTierResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifySnapshotTierResponse -> ModifySnapshotTierResponse -> Bool
$c/= :: ModifySnapshotTierResponse -> ModifySnapshotTierResponse -> Bool
== :: ModifySnapshotTierResponse -> ModifySnapshotTierResponse -> Bool
$c== :: ModifySnapshotTierResponse -> ModifySnapshotTierResponse -> Bool
Prelude.Eq, ReadPrec [ModifySnapshotTierResponse]
ReadPrec ModifySnapshotTierResponse
Int -> ReadS ModifySnapshotTierResponse
ReadS [ModifySnapshotTierResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifySnapshotTierResponse]
$creadListPrec :: ReadPrec [ModifySnapshotTierResponse]
readPrec :: ReadPrec ModifySnapshotTierResponse
$creadPrec :: ReadPrec ModifySnapshotTierResponse
readList :: ReadS [ModifySnapshotTierResponse]
$creadList :: ReadS [ModifySnapshotTierResponse]
readsPrec :: Int -> ReadS ModifySnapshotTierResponse
$creadsPrec :: Int -> ReadS ModifySnapshotTierResponse
Prelude.Read, Int -> ModifySnapshotTierResponse -> ShowS
[ModifySnapshotTierResponse] -> ShowS
ModifySnapshotTierResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifySnapshotTierResponse] -> ShowS
$cshowList :: [ModifySnapshotTierResponse] -> ShowS
show :: ModifySnapshotTierResponse -> String
$cshow :: ModifySnapshotTierResponse -> String
showsPrec :: Int -> ModifySnapshotTierResponse -> ShowS
$cshowsPrec :: Int -> ModifySnapshotTierResponse -> ShowS
Prelude.Show, forall x.
Rep ModifySnapshotTierResponse x -> ModifySnapshotTierResponse
forall x.
ModifySnapshotTierResponse -> Rep ModifySnapshotTierResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep ModifySnapshotTierResponse x -> ModifySnapshotTierResponse
$cfrom :: forall x.
ModifySnapshotTierResponse -> Rep ModifySnapshotTierResponse x
Prelude.Generic)

-- |
-- Create a value of 'ModifySnapshotTierResponse' 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:
--
-- 'snapshotId', 'modifySnapshotTierResponse_snapshotId' - The ID of the snapshot.
--
-- 'tieringStartTime', 'modifySnapshotTierResponse_tieringStartTime' - The date and time when the archive process was started.
--
-- 'httpStatus', 'modifySnapshotTierResponse_httpStatus' - The response's http status code.
newModifySnapshotTierResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifySnapshotTierResponse
newModifySnapshotTierResponse :: Int -> ModifySnapshotTierResponse
newModifySnapshotTierResponse Int
pHttpStatus_ =
  ModifySnapshotTierResponse'
    { $sel:snapshotId:ModifySnapshotTierResponse' :: Maybe Text
snapshotId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:tieringStartTime:ModifySnapshotTierResponse' :: Maybe ISO8601
tieringStartTime = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:ModifySnapshotTierResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The ID of the snapshot.
modifySnapshotTierResponse_snapshotId :: Lens.Lens' ModifySnapshotTierResponse (Prelude.Maybe Prelude.Text)
modifySnapshotTierResponse_snapshotId :: Lens' ModifySnapshotTierResponse (Maybe Text)
modifySnapshotTierResponse_snapshotId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySnapshotTierResponse' {Maybe Text
snapshotId :: Maybe Text
$sel:snapshotId:ModifySnapshotTierResponse' :: ModifySnapshotTierResponse -> Maybe Text
snapshotId} -> Maybe Text
snapshotId) (\s :: ModifySnapshotTierResponse
s@ModifySnapshotTierResponse' {} Maybe Text
a -> ModifySnapshotTierResponse
s {$sel:snapshotId:ModifySnapshotTierResponse' :: Maybe Text
snapshotId = Maybe Text
a} :: ModifySnapshotTierResponse)

-- | The date and time when the archive process was started.
modifySnapshotTierResponse_tieringStartTime :: Lens.Lens' ModifySnapshotTierResponse (Prelude.Maybe Prelude.UTCTime)
modifySnapshotTierResponse_tieringStartTime :: Lens' ModifySnapshotTierResponse (Maybe UTCTime)
modifySnapshotTierResponse_tieringStartTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySnapshotTierResponse' {Maybe ISO8601
tieringStartTime :: Maybe ISO8601
$sel:tieringStartTime:ModifySnapshotTierResponse' :: ModifySnapshotTierResponse -> Maybe ISO8601
tieringStartTime} -> Maybe ISO8601
tieringStartTime) (\s :: ModifySnapshotTierResponse
s@ModifySnapshotTierResponse' {} Maybe ISO8601
a -> ModifySnapshotTierResponse
s {$sel:tieringStartTime:ModifySnapshotTierResponse' :: Maybe ISO8601
tieringStartTime = Maybe ISO8601
a} :: ModifySnapshotTierResponse) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

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

instance Prelude.NFData ModifySnapshotTierResponse where
  rnf :: ModifySnapshotTierResponse -> ()
rnf ModifySnapshotTierResponse' {Int
Maybe Text
Maybe ISO8601
httpStatus :: Int
tieringStartTime :: Maybe ISO8601
snapshotId :: Maybe Text
$sel:httpStatus:ModifySnapshotTierResponse' :: ModifySnapshotTierResponse -> Int
$sel:tieringStartTime:ModifySnapshotTierResponse' :: ModifySnapshotTierResponse -> Maybe ISO8601
$sel:snapshotId:ModifySnapshotTierResponse' :: ModifySnapshotTierResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
snapshotId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
tieringStartTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus