{-# 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.Backup.DeleteBackupPlan
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Deletes a backup plan. A backup plan can only be deleted after all
-- associated selections of resources have been deleted. Deleting a backup
-- plan deletes the current version of a backup plan. Previous versions, if
-- any, will still exist.
module Amazonka.Backup.DeleteBackupPlan
  ( -- * Creating a Request
    DeleteBackupPlan (..),
    newDeleteBackupPlan,

    -- * Request Lenses
    deleteBackupPlan_backupPlanId,

    -- * Destructuring the Response
    DeleteBackupPlanResponse (..),
    newDeleteBackupPlanResponse,

    -- * Response Lenses
    deleteBackupPlanResponse_backupPlanArn,
    deleteBackupPlanResponse_backupPlanId,
    deleteBackupPlanResponse_deletionDate,
    deleteBackupPlanResponse_versionId,
    deleteBackupPlanResponse_httpStatus,
  )
where

import Amazonka.Backup.Types
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

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

-- |
-- Create a value of 'DeleteBackupPlan' 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:
--
-- 'backupPlanId', 'deleteBackupPlan_backupPlanId' - Uniquely identifies a backup plan.
newDeleteBackupPlan ::
  -- | 'backupPlanId'
  Prelude.Text ->
  DeleteBackupPlan
newDeleteBackupPlan :: Text -> DeleteBackupPlan
newDeleteBackupPlan Text
pBackupPlanId_ =
  DeleteBackupPlan' {$sel:backupPlanId:DeleteBackupPlan' :: Text
backupPlanId = Text
pBackupPlanId_}

-- | Uniquely identifies a backup plan.
deleteBackupPlan_backupPlanId :: Lens.Lens' DeleteBackupPlan Prelude.Text
deleteBackupPlan_backupPlanId :: Lens' DeleteBackupPlan Text
deleteBackupPlan_backupPlanId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteBackupPlan' {Text
backupPlanId :: Text
$sel:backupPlanId:DeleteBackupPlan' :: DeleteBackupPlan -> Text
backupPlanId} -> Text
backupPlanId) (\s :: DeleteBackupPlan
s@DeleteBackupPlan' {} Text
a -> DeleteBackupPlan
s {$sel:backupPlanId:DeleteBackupPlan' :: Text
backupPlanId = Text
a} :: DeleteBackupPlan)

instance Core.AWSRequest DeleteBackupPlan where
  type
    AWSResponse DeleteBackupPlan =
      DeleteBackupPlanResponse
  request :: (Service -> Service)
-> DeleteBackupPlan -> Request DeleteBackupPlan
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.delete (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy DeleteBackupPlan
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DeleteBackupPlan)))
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 Text
-> Maybe POSIX
-> Maybe Text
-> Int
-> DeleteBackupPlanResponse
DeleteBackupPlanResponse'
            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
"BackupPlanArn")
            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
"BackupPlanId")
            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
"DeletionDate")
            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
"VersionId")
            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 DeleteBackupPlan where
  hashWithSalt :: Int -> DeleteBackupPlan -> Int
hashWithSalt Int
_salt DeleteBackupPlan' {Text
backupPlanId :: Text
$sel:backupPlanId:DeleteBackupPlan' :: DeleteBackupPlan -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
backupPlanId

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

instance Data.ToHeaders DeleteBackupPlan where
  toHeaders :: DeleteBackupPlan -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToPath DeleteBackupPlan where
  toPath :: DeleteBackupPlan -> ByteString
toPath DeleteBackupPlan' {Text
backupPlanId :: Text
$sel:backupPlanId:DeleteBackupPlan' :: DeleteBackupPlan -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/backup/plans/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
backupPlanId]

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

-- | /See:/ 'newDeleteBackupPlanResponse' smart constructor.
data DeleteBackupPlanResponse = DeleteBackupPlanResponse'
  { -- | An Amazon Resource Name (ARN) that uniquely identifies a backup plan;
    -- for example,
    -- @arn:aws:backup:us-east-1:123456789012:plan:8F81F553-3A74-4A3F-B93D-B3360DC80C50@.
    DeleteBackupPlanResponse -> Maybe Text
backupPlanArn :: Prelude.Maybe Prelude.Text,
    -- | Uniquely identifies a backup plan.
    DeleteBackupPlanResponse -> Maybe Text
backupPlanId :: Prelude.Maybe Prelude.Text,
    -- | The date and time a backup plan is deleted, in Unix format and
    -- Coordinated Universal Time (UTC). The value of @DeletionDate@ is
    -- accurate to milliseconds. For example, the value 1516925490.087
    -- represents Friday, January 26, 2018 12:11:30.087 AM.
    DeleteBackupPlanResponse -> Maybe POSIX
deletionDate :: Prelude.Maybe Data.POSIX,
    -- | Unique, randomly generated, Unicode, UTF-8 encoded strings that are at
    -- most 1,024 bytes long. Version IDs cannot be edited.
    DeleteBackupPlanResponse -> Maybe Text
versionId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DeleteBackupPlanResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DeleteBackupPlanResponse -> DeleteBackupPlanResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DeleteBackupPlanResponse -> DeleteBackupPlanResponse -> Bool
$c/= :: DeleteBackupPlanResponse -> DeleteBackupPlanResponse -> Bool
== :: DeleteBackupPlanResponse -> DeleteBackupPlanResponse -> Bool
$c== :: DeleteBackupPlanResponse -> DeleteBackupPlanResponse -> Bool
Prelude.Eq, ReadPrec [DeleteBackupPlanResponse]
ReadPrec DeleteBackupPlanResponse
Int -> ReadS DeleteBackupPlanResponse
ReadS [DeleteBackupPlanResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DeleteBackupPlanResponse]
$creadListPrec :: ReadPrec [DeleteBackupPlanResponse]
readPrec :: ReadPrec DeleteBackupPlanResponse
$creadPrec :: ReadPrec DeleteBackupPlanResponse
readList :: ReadS [DeleteBackupPlanResponse]
$creadList :: ReadS [DeleteBackupPlanResponse]
readsPrec :: Int -> ReadS DeleteBackupPlanResponse
$creadsPrec :: Int -> ReadS DeleteBackupPlanResponse
Prelude.Read, Int -> DeleteBackupPlanResponse -> ShowS
[DeleteBackupPlanResponse] -> ShowS
DeleteBackupPlanResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DeleteBackupPlanResponse] -> ShowS
$cshowList :: [DeleteBackupPlanResponse] -> ShowS
show :: DeleteBackupPlanResponse -> String
$cshow :: DeleteBackupPlanResponse -> String
showsPrec :: Int -> DeleteBackupPlanResponse -> ShowS
$cshowsPrec :: Int -> DeleteBackupPlanResponse -> ShowS
Prelude.Show, forall x.
Rep DeleteBackupPlanResponse x -> DeleteBackupPlanResponse
forall x.
DeleteBackupPlanResponse -> Rep DeleteBackupPlanResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DeleteBackupPlanResponse x -> DeleteBackupPlanResponse
$cfrom :: forall x.
DeleteBackupPlanResponse -> Rep DeleteBackupPlanResponse x
Prelude.Generic)

-- |
-- Create a value of 'DeleteBackupPlanResponse' 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:
--
-- 'backupPlanArn', 'deleteBackupPlanResponse_backupPlanArn' - An Amazon Resource Name (ARN) that uniquely identifies a backup plan;
-- for example,
-- @arn:aws:backup:us-east-1:123456789012:plan:8F81F553-3A74-4A3F-B93D-B3360DC80C50@.
--
-- 'backupPlanId', 'deleteBackupPlanResponse_backupPlanId' - Uniquely identifies a backup plan.
--
-- 'deletionDate', 'deleteBackupPlanResponse_deletionDate' - The date and time a backup plan is deleted, in Unix format and
-- Coordinated Universal Time (UTC). The value of @DeletionDate@ is
-- accurate to milliseconds. For example, the value 1516925490.087
-- represents Friday, January 26, 2018 12:11:30.087 AM.
--
-- 'versionId', 'deleteBackupPlanResponse_versionId' - Unique, randomly generated, Unicode, UTF-8 encoded strings that are at
-- most 1,024 bytes long. Version IDs cannot be edited.
--
-- 'httpStatus', 'deleteBackupPlanResponse_httpStatus' - The response's http status code.
newDeleteBackupPlanResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DeleteBackupPlanResponse
newDeleteBackupPlanResponse :: Int -> DeleteBackupPlanResponse
newDeleteBackupPlanResponse Int
pHttpStatus_ =
  DeleteBackupPlanResponse'
    { $sel:backupPlanArn:DeleteBackupPlanResponse' :: Maybe Text
backupPlanArn =
        forall a. Maybe a
Prelude.Nothing,
      $sel:backupPlanId:DeleteBackupPlanResponse' :: Maybe Text
backupPlanId = forall a. Maybe a
Prelude.Nothing,
      $sel:deletionDate:DeleteBackupPlanResponse' :: Maybe POSIX
deletionDate = forall a. Maybe a
Prelude.Nothing,
      $sel:versionId:DeleteBackupPlanResponse' :: Maybe Text
versionId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DeleteBackupPlanResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | An Amazon Resource Name (ARN) that uniquely identifies a backup plan;
-- for example,
-- @arn:aws:backup:us-east-1:123456789012:plan:8F81F553-3A74-4A3F-B93D-B3360DC80C50@.
deleteBackupPlanResponse_backupPlanArn :: Lens.Lens' DeleteBackupPlanResponse (Prelude.Maybe Prelude.Text)
deleteBackupPlanResponse_backupPlanArn :: Lens' DeleteBackupPlanResponse (Maybe Text)
deleteBackupPlanResponse_backupPlanArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteBackupPlanResponse' {Maybe Text
backupPlanArn :: Maybe Text
$sel:backupPlanArn:DeleteBackupPlanResponse' :: DeleteBackupPlanResponse -> Maybe Text
backupPlanArn} -> Maybe Text
backupPlanArn) (\s :: DeleteBackupPlanResponse
s@DeleteBackupPlanResponse' {} Maybe Text
a -> DeleteBackupPlanResponse
s {$sel:backupPlanArn:DeleteBackupPlanResponse' :: Maybe Text
backupPlanArn = Maybe Text
a} :: DeleteBackupPlanResponse)

-- | Uniquely identifies a backup plan.
deleteBackupPlanResponse_backupPlanId :: Lens.Lens' DeleteBackupPlanResponse (Prelude.Maybe Prelude.Text)
deleteBackupPlanResponse_backupPlanId :: Lens' DeleteBackupPlanResponse (Maybe Text)
deleteBackupPlanResponse_backupPlanId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteBackupPlanResponse' {Maybe Text
backupPlanId :: Maybe Text
$sel:backupPlanId:DeleteBackupPlanResponse' :: DeleteBackupPlanResponse -> Maybe Text
backupPlanId} -> Maybe Text
backupPlanId) (\s :: DeleteBackupPlanResponse
s@DeleteBackupPlanResponse' {} Maybe Text
a -> DeleteBackupPlanResponse
s {$sel:backupPlanId:DeleteBackupPlanResponse' :: Maybe Text
backupPlanId = Maybe Text
a} :: DeleteBackupPlanResponse)

-- | The date and time a backup plan is deleted, in Unix format and
-- Coordinated Universal Time (UTC). The value of @DeletionDate@ is
-- accurate to milliseconds. For example, the value 1516925490.087
-- represents Friday, January 26, 2018 12:11:30.087 AM.
deleteBackupPlanResponse_deletionDate :: Lens.Lens' DeleteBackupPlanResponse (Prelude.Maybe Prelude.UTCTime)
deleteBackupPlanResponse_deletionDate :: Lens' DeleteBackupPlanResponse (Maybe UTCTime)
deleteBackupPlanResponse_deletionDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteBackupPlanResponse' {Maybe POSIX
deletionDate :: Maybe POSIX
$sel:deletionDate:DeleteBackupPlanResponse' :: DeleteBackupPlanResponse -> Maybe POSIX
deletionDate} -> Maybe POSIX
deletionDate) (\s :: DeleteBackupPlanResponse
s@DeleteBackupPlanResponse' {} Maybe POSIX
a -> DeleteBackupPlanResponse
s {$sel:deletionDate:DeleteBackupPlanResponse' :: Maybe POSIX
deletionDate = Maybe POSIX
a} :: DeleteBackupPlanResponse) 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

-- | Unique, randomly generated, Unicode, UTF-8 encoded strings that are at
-- most 1,024 bytes long. Version IDs cannot be edited.
deleteBackupPlanResponse_versionId :: Lens.Lens' DeleteBackupPlanResponse (Prelude.Maybe Prelude.Text)
deleteBackupPlanResponse_versionId :: Lens' DeleteBackupPlanResponse (Maybe Text)
deleteBackupPlanResponse_versionId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DeleteBackupPlanResponse' {Maybe Text
versionId :: Maybe Text
$sel:versionId:DeleteBackupPlanResponse' :: DeleteBackupPlanResponse -> Maybe Text
versionId} -> Maybe Text
versionId) (\s :: DeleteBackupPlanResponse
s@DeleteBackupPlanResponse' {} Maybe Text
a -> DeleteBackupPlanResponse
s {$sel:versionId:DeleteBackupPlanResponse' :: Maybe Text
versionId = Maybe Text
a} :: DeleteBackupPlanResponse)

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

instance Prelude.NFData DeleteBackupPlanResponse where
  rnf :: DeleteBackupPlanResponse -> ()
rnf DeleteBackupPlanResponse' {Int
Maybe Text
Maybe POSIX
httpStatus :: Int
versionId :: Maybe Text
deletionDate :: Maybe POSIX
backupPlanId :: Maybe Text
backupPlanArn :: Maybe Text
$sel:httpStatus:DeleteBackupPlanResponse' :: DeleteBackupPlanResponse -> Int
$sel:versionId:DeleteBackupPlanResponse' :: DeleteBackupPlanResponse -> Maybe Text
$sel:deletionDate:DeleteBackupPlanResponse' :: DeleteBackupPlanResponse -> Maybe POSIX
$sel:backupPlanId:DeleteBackupPlanResponse' :: DeleteBackupPlanResponse -> Maybe Text
$sel:backupPlanArn:DeleteBackupPlanResponse' :: DeleteBackupPlanResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
backupPlanArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
backupPlanId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
deletionDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
versionId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus