{-# 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.KinesisVideo.UpdateDataRetention
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Increases or decreases the stream\'s data retention period by the value
-- that you specify. To indicate whether you want to increase or decrease
-- the data retention period, specify the @Operation@ parameter in the
-- request body. In the request, you must specify either the @StreamName@
-- or the @StreamARN@.
--
-- The retention period that you specify replaces the current value.
--
-- This operation requires permission for the
-- @KinesisVideo:UpdateDataRetention@ action.
--
-- Changing the data retention period affects the data in the stream as
-- follows:
--
-- -   If the data retention period is increased, existing data is retained
--     for the new retention period. For example, if the data retention
--     period is increased from one hour to seven hours, all existing data
--     is retained for seven hours.
--
-- -   If the data retention period is decreased, existing data is retained
--     for the new retention period. For example, if the data retention
--     period is decreased from seven hours to one hour, all existing data
--     is retained for one hour, and any data older than one hour is
--     deleted immediately.
module Amazonka.KinesisVideo.UpdateDataRetention
  ( -- * Creating a Request
    UpdateDataRetention (..),
    newUpdateDataRetention,

    -- * Request Lenses
    updateDataRetention_streamARN,
    updateDataRetention_streamName,
    updateDataRetention_currentVersion,
    updateDataRetention_operation,
    updateDataRetention_dataRetentionChangeInHours,

    -- * Destructuring the Response
    UpdateDataRetentionResponse (..),
    newUpdateDataRetentionResponse,

    -- * Response Lenses
    updateDataRetentionResponse_httpStatus,
  )
where

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

-- | /See:/ 'newUpdateDataRetention' smart constructor.
data UpdateDataRetention = UpdateDataRetention'
  { -- | The Amazon Resource Name (ARN) of the stream whose retention period you
    -- want to change.
    UpdateDataRetention -> Maybe Text
streamARN :: Prelude.Maybe Prelude.Text,
    -- | The name of the stream whose retention period you want to change.
    UpdateDataRetention -> Maybe Text
streamName :: Prelude.Maybe Prelude.Text,
    -- | The version of the stream whose retention period you want to change. To
    -- get the version, call either the @DescribeStream@ or the @ListStreams@
    -- API.
    UpdateDataRetention -> Text
currentVersion :: Prelude.Text,
    -- | Indicates whether you want to increase or decrease the retention period.
    UpdateDataRetention -> UpdateDataRetentionOperation
operation :: UpdateDataRetentionOperation,
    -- | The retention period, in hours. The value you specify replaces the
    -- current value. The maximum value for this parameter is 87600 (ten
    -- years).
    UpdateDataRetention -> Natural
dataRetentionChangeInHours :: Prelude.Natural
  }
  deriving (UpdateDataRetention -> UpdateDataRetention -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateDataRetention -> UpdateDataRetention -> Bool
$c/= :: UpdateDataRetention -> UpdateDataRetention -> Bool
== :: UpdateDataRetention -> UpdateDataRetention -> Bool
$c== :: UpdateDataRetention -> UpdateDataRetention -> Bool
Prelude.Eq, ReadPrec [UpdateDataRetention]
ReadPrec UpdateDataRetention
Int -> ReadS UpdateDataRetention
ReadS [UpdateDataRetention]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateDataRetention]
$creadListPrec :: ReadPrec [UpdateDataRetention]
readPrec :: ReadPrec UpdateDataRetention
$creadPrec :: ReadPrec UpdateDataRetention
readList :: ReadS [UpdateDataRetention]
$creadList :: ReadS [UpdateDataRetention]
readsPrec :: Int -> ReadS UpdateDataRetention
$creadsPrec :: Int -> ReadS UpdateDataRetention
Prelude.Read, Int -> UpdateDataRetention -> ShowS
[UpdateDataRetention] -> ShowS
UpdateDataRetention -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateDataRetention] -> ShowS
$cshowList :: [UpdateDataRetention] -> ShowS
show :: UpdateDataRetention -> String
$cshow :: UpdateDataRetention -> String
showsPrec :: Int -> UpdateDataRetention -> ShowS
$cshowsPrec :: Int -> UpdateDataRetention -> ShowS
Prelude.Show, forall x. Rep UpdateDataRetention x -> UpdateDataRetention
forall x. UpdateDataRetention -> Rep UpdateDataRetention x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateDataRetention x -> UpdateDataRetention
$cfrom :: forall x. UpdateDataRetention -> Rep UpdateDataRetention x
Prelude.Generic)

-- |
-- Create a value of 'UpdateDataRetention' 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:
--
-- 'streamARN', 'updateDataRetention_streamARN' - The Amazon Resource Name (ARN) of the stream whose retention period you
-- want to change.
--
-- 'streamName', 'updateDataRetention_streamName' - The name of the stream whose retention period you want to change.
--
-- 'currentVersion', 'updateDataRetention_currentVersion' - The version of the stream whose retention period you want to change. To
-- get the version, call either the @DescribeStream@ or the @ListStreams@
-- API.
--
-- 'operation', 'updateDataRetention_operation' - Indicates whether you want to increase or decrease the retention period.
--
-- 'dataRetentionChangeInHours', 'updateDataRetention_dataRetentionChangeInHours' - The retention period, in hours. The value you specify replaces the
-- current value. The maximum value for this parameter is 87600 (ten
-- years).
newUpdateDataRetention ::
  -- | 'currentVersion'
  Prelude.Text ->
  -- | 'operation'
  UpdateDataRetentionOperation ->
  -- | 'dataRetentionChangeInHours'
  Prelude.Natural ->
  UpdateDataRetention
newUpdateDataRetention :: Text
-> UpdateDataRetentionOperation -> Natural -> UpdateDataRetention
newUpdateDataRetention
  Text
pCurrentVersion_
  UpdateDataRetentionOperation
pOperation_
  Natural
pDataRetentionChangeInHours_ =
    UpdateDataRetention'
      { $sel:streamARN:UpdateDataRetention' :: Maybe Text
streamARN = forall a. Maybe a
Prelude.Nothing,
        $sel:streamName:UpdateDataRetention' :: Maybe Text
streamName = forall a. Maybe a
Prelude.Nothing,
        $sel:currentVersion:UpdateDataRetention' :: Text
currentVersion = Text
pCurrentVersion_,
        $sel:operation:UpdateDataRetention' :: UpdateDataRetentionOperation
operation = UpdateDataRetentionOperation
pOperation_,
        $sel:dataRetentionChangeInHours:UpdateDataRetention' :: Natural
dataRetentionChangeInHours =
          Natural
pDataRetentionChangeInHours_
      }

-- | The Amazon Resource Name (ARN) of the stream whose retention period you
-- want to change.
updateDataRetention_streamARN :: Lens.Lens' UpdateDataRetention (Prelude.Maybe Prelude.Text)
updateDataRetention_streamARN :: Lens' UpdateDataRetention (Maybe Text)
updateDataRetention_streamARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataRetention' {Maybe Text
streamARN :: Maybe Text
$sel:streamARN:UpdateDataRetention' :: UpdateDataRetention -> Maybe Text
streamARN} -> Maybe Text
streamARN) (\s :: UpdateDataRetention
s@UpdateDataRetention' {} Maybe Text
a -> UpdateDataRetention
s {$sel:streamARN:UpdateDataRetention' :: Maybe Text
streamARN = Maybe Text
a} :: UpdateDataRetention)

-- | The name of the stream whose retention period you want to change.
updateDataRetention_streamName :: Lens.Lens' UpdateDataRetention (Prelude.Maybe Prelude.Text)
updateDataRetention_streamName :: Lens' UpdateDataRetention (Maybe Text)
updateDataRetention_streamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataRetention' {Maybe Text
streamName :: Maybe Text
$sel:streamName:UpdateDataRetention' :: UpdateDataRetention -> Maybe Text
streamName} -> Maybe Text
streamName) (\s :: UpdateDataRetention
s@UpdateDataRetention' {} Maybe Text
a -> UpdateDataRetention
s {$sel:streamName:UpdateDataRetention' :: Maybe Text
streamName = Maybe Text
a} :: UpdateDataRetention)

-- | The version of the stream whose retention period you want to change. To
-- get the version, call either the @DescribeStream@ or the @ListStreams@
-- API.
updateDataRetention_currentVersion :: Lens.Lens' UpdateDataRetention Prelude.Text
updateDataRetention_currentVersion :: Lens' UpdateDataRetention Text
updateDataRetention_currentVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataRetention' {Text
currentVersion :: Text
$sel:currentVersion:UpdateDataRetention' :: UpdateDataRetention -> Text
currentVersion} -> Text
currentVersion) (\s :: UpdateDataRetention
s@UpdateDataRetention' {} Text
a -> UpdateDataRetention
s {$sel:currentVersion:UpdateDataRetention' :: Text
currentVersion = Text
a} :: UpdateDataRetention)

-- | Indicates whether you want to increase or decrease the retention period.
updateDataRetention_operation :: Lens.Lens' UpdateDataRetention UpdateDataRetentionOperation
updateDataRetention_operation :: Lens' UpdateDataRetention UpdateDataRetentionOperation
updateDataRetention_operation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataRetention' {UpdateDataRetentionOperation
operation :: UpdateDataRetentionOperation
$sel:operation:UpdateDataRetention' :: UpdateDataRetention -> UpdateDataRetentionOperation
operation} -> UpdateDataRetentionOperation
operation) (\s :: UpdateDataRetention
s@UpdateDataRetention' {} UpdateDataRetentionOperation
a -> UpdateDataRetention
s {$sel:operation:UpdateDataRetention' :: UpdateDataRetentionOperation
operation = UpdateDataRetentionOperation
a} :: UpdateDataRetention)

-- | The retention period, in hours. The value you specify replaces the
-- current value. The maximum value for this parameter is 87600 (ten
-- years).
updateDataRetention_dataRetentionChangeInHours :: Lens.Lens' UpdateDataRetention Prelude.Natural
updateDataRetention_dataRetentionChangeInHours :: Lens' UpdateDataRetention Natural
updateDataRetention_dataRetentionChangeInHours = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateDataRetention' {Natural
dataRetentionChangeInHours :: Natural
$sel:dataRetentionChangeInHours:UpdateDataRetention' :: UpdateDataRetention -> Natural
dataRetentionChangeInHours} -> Natural
dataRetentionChangeInHours) (\s :: UpdateDataRetention
s@UpdateDataRetention' {} Natural
a -> UpdateDataRetention
s {$sel:dataRetentionChangeInHours:UpdateDataRetention' :: Natural
dataRetentionChangeInHours = Natural
a} :: UpdateDataRetention)

instance Core.AWSRequest UpdateDataRetention where
  type
    AWSResponse UpdateDataRetention =
      UpdateDataRetentionResponse
  request :: (Service -> Service)
-> UpdateDataRetention -> Request UpdateDataRetention
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 UpdateDataRetention
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateDataRetention)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> UpdateDataRetentionResponse
UpdateDataRetentionResponse'
            forall (f :: * -> *) a b. Functor 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 UpdateDataRetention where
  hashWithSalt :: Int -> UpdateDataRetention -> Int
hashWithSalt Int
_salt UpdateDataRetention' {Natural
Maybe Text
Text
UpdateDataRetentionOperation
dataRetentionChangeInHours :: Natural
operation :: UpdateDataRetentionOperation
currentVersion :: Text
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:dataRetentionChangeInHours:UpdateDataRetention' :: UpdateDataRetention -> Natural
$sel:operation:UpdateDataRetention' :: UpdateDataRetention -> UpdateDataRetentionOperation
$sel:currentVersion:UpdateDataRetention' :: UpdateDataRetention -> Text
$sel:streamName:UpdateDataRetention' :: UpdateDataRetention -> Maybe Text
$sel:streamARN:UpdateDataRetention' :: UpdateDataRetention -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
streamARN
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
streamName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
currentVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` UpdateDataRetentionOperation
operation
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Natural
dataRetentionChangeInHours

instance Prelude.NFData UpdateDataRetention where
  rnf :: UpdateDataRetention -> ()
rnf UpdateDataRetention' {Natural
Maybe Text
Text
UpdateDataRetentionOperation
dataRetentionChangeInHours :: Natural
operation :: UpdateDataRetentionOperation
currentVersion :: Text
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:dataRetentionChangeInHours:UpdateDataRetention' :: UpdateDataRetention -> Natural
$sel:operation:UpdateDataRetention' :: UpdateDataRetention -> UpdateDataRetentionOperation
$sel:currentVersion:UpdateDataRetention' :: UpdateDataRetention -> Text
$sel:streamName:UpdateDataRetention' :: UpdateDataRetention -> Maybe Text
$sel:streamARN:UpdateDataRetention' :: UpdateDataRetention -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamARN
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
streamName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
currentVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf UpdateDataRetentionOperation
operation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Natural
dataRetentionChangeInHours

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

instance Data.ToJSON UpdateDataRetention where
  toJSON :: UpdateDataRetention -> Value
toJSON UpdateDataRetention' {Natural
Maybe Text
Text
UpdateDataRetentionOperation
dataRetentionChangeInHours :: Natural
operation :: UpdateDataRetentionOperation
currentVersion :: Text
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:dataRetentionChangeInHours:UpdateDataRetention' :: UpdateDataRetention -> Natural
$sel:operation:UpdateDataRetention' :: UpdateDataRetention -> UpdateDataRetentionOperation
$sel:currentVersion:UpdateDataRetention' :: UpdateDataRetention -> Text
$sel:streamName:UpdateDataRetention' :: UpdateDataRetention -> Maybe Text
$sel:streamARN:UpdateDataRetention' :: UpdateDataRetention -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"StreamARN" 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
streamARN,
            (Key
"StreamName" 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
streamName,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"CurrentVersion" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
currentVersion),
            forall a. a -> Maybe a
Prelude.Just (Key
"Operation" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= UpdateDataRetentionOperation
operation),
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"DataRetentionChangeInHours"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Natural
dataRetentionChangeInHours
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateDataRetentionResponse' 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:
--
-- 'httpStatus', 'updateDataRetentionResponse_httpStatus' - The response's http status code.
newUpdateDataRetentionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateDataRetentionResponse
newUpdateDataRetentionResponse :: Int -> UpdateDataRetentionResponse
newUpdateDataRetentionResponse Int
pHttpStatus_ =
  UpdateDataRetentionResponse'
    { $sel:httpStatus:UpdateDataRetentionResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData UpdateDataRetentionResponse where
  rnf :: UpdateDataRetentionResponse -> ()
rnf UpdateDataRetentionResponse' {Int
httpStatus :: Int
$sel:httpStatus:UpdateDataRetentionResponse' :: UpdateDataRetentionResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus