{-# 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.Kinesis.DecreaseStreamRetentionPeriod
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Decreases the Kinesis data stream\'s retention period, which is the
-- length of time data records are accessible after they are added to the
-- stream. The minimum value of a stream\'s retention period is 24 hours.
--
-- When invoking this API, it is recommended you use the @StreamARN@ input
-- parameter rather than the @StreamName@ input parameter.
--
-- This operation may result in lost data. For example, if the stream\'s
-- retention period is 48 hours and is decreased to 24 hours, any data
-- already in the stream that is older than 24 hours is inaccessible.
module Amazonka.Kinesis.DecreaseStreamRetentionPeriod
  ( -- * Creating a Request
    DecreaseStreamRetentionPeriod (..),
    newDecreaseStreamRetentionPeriod,

    -- * Request Lenses
    decreaseStreamRetentionPeriod_streamARN,
    decreaseStreamRetentionPeriod_streamName,
    decreaseStreamRetentionPeriod_retentionPeriodHours,

    -- * Destructuring the Response
    DecreaseStreamRetentionPeriodResponse (..),
    newDecreaseStreamRetentionPeriodResponse,
  )
where

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

-- | Represents the input for DecreaseStreamRetentionPeriod.
--
-- /See:/ 'newDecreaseStreamRetentionPeriod' smart constructor.
data DecreaseStreamRetentionPeriod = DecreaseStreamRetentionPeriod'
  { -- | The ARN of the stream.
    DecreaseStreamRetentionPeriod -> Maybe Text
streamARN :: Prelude.Maybe Prelude.Text,
    -- | The name of the stream to modify.
    DecreaseStreamRetentionPeriod -> Maybe Text
streamName :: Prelude.Maybe Prelude.Text,
    -- | The new retention period of the stream, in hours. Must be less than the
    -- current retention period.
    DecreaseStreamRetentionPeriod -> Int
retentionPeriodHours :: Prelude.Int
  }
  deriving (DecreaseStreamRetentionPeriod
-> DecreaseStreamRetentionPeriod -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DecreaseStreamRetentionPeriod
-> DecreaseStreamRetentionPeriod -> Bool
$c/= :: DecreaseStreamRetentionPeriod
-> DecreaseStreamRetentionPeriod -> Bool
== :: DecreaseStreamRetentionPeriod
-> DecreaseStreamRetentionPeriod -> Bool
$c== :: DecreaseStreamRetentionPeriod
-> DecreaseStreamRetentionPeriod -> Bool
Prelude.Eq, ReadPrec [DecreaseStreamRetentionPeriod]
ReadPrec DecreaseStreamRetentionPeriod
Int -> ReadS DecreaseStreamRetentionPeriod
ReadS [DecreaseStreamRetentionPeriod]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DecreaseStreamRetentionPeriod]
$creadListPrec :: ReadPrec [DecreaseStreamRetentionPeriod]
readPrec :: ReadPrec DecreaseStreamRetentionPeriod
$creadPrec :: ReadPrec DecreaseStreamRetentionPeriod
readList :: ReadS [DecreaseStreamRetentionPeriod]
$creadList :: ReadS [DecreaseStreamRetentionPeriod]
readsPrec :: Int -> ReadS DecreaseStreamRetentionPeriod
$creadsPrec :: Int -> ReadS DecreaseStreamRetentionPeriod
Prelude.Read, Int -> DecreaseStreamRetentionPeriod -> ShowS
[DecreaseStreamRetentionPeriod] -> ShowS
DecreaseStreamRetentionPeriod -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DecreaseStreamRetentionPeriod] -> ShowS
$cshowList :: [DecreaseStreamRetentionPeriod] -> ShowS
show :: DecreaseStreamRetentionPeriod -> String
$cshow :: DecreaseStreamRetentionPeriod -> String
showsPrec :: Int -> DecreaseStreamRetentionPeriod -> ShowS
$cshowsPrec :: Int -> DecreaseStreamRetentionPeriod -> ShowS
Prelude.Show, forall x.
Rep DecreaseStreamRetentionPeriod x
-> DecreaseStreamRetentionPeriod
forall x.
DecreaseStreamRetentionPeriod
-> Rep DecreaseStreamRetentionPeriod x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DecreaseStreamRetentionPeriod x
-> DecreaseStreamRetentionPeriod
$cfrom :: forall x.
DecreaseStreamRetentionPeriod
-> Rep DecreaseStreamRetentionPeriod x
Prelude.Generic)

-- |
-- Create a value of 'DecreaseStreamRetentionPeriod' 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', 'decreaseStreamRetentionPeriod_streamARN' - The ARN of the stream.
--
-- 'streamName', 'decreaseStreamRetentionPeriod_streamName' - The name of the stream to modify.
--
-- 'retentionPeriodHours', 'decreaseStreamRetentionPeriod_retentionPeriodHours' - The new retention period of the stream, in hours. Must be less than the
-- current retention period.
newDecreaseStreamRetentionPeriod ::
  -- | 'retentionPeriodHours'
  Prelude.Int ->
  DecreaseStreamRetentionPeriod
newDecreaseStreamRetentionPeriod :: Int -> DecreaseStreamRetentionPeriod
newDecreaseStreamRetentionPeriod
  Int
pRetentionPeriodHours_ =
    DecreaseStreamRetentionPeriod'
      { $sel:streamARN:DecreaseStreamRetentionPeriod' :: Maybe Text
streamARN =
          forall a. Maybe a
Prelude.Nothing,
        $sel:streamName:DecreaseStreamRetentionPeriod' :: Maybe Text
streamName = forall a. Maybe a
Prelude.Nothing,
        $sel:retentionPeriodHours:DecreaseStreamRetentionPeriod' :: Int
retentionPeriodHours =
          Int
pRetentionPeriodHours_
      }

-- | The ARN of the stream.
decreaseStreamRetentionPeriod_streamARN :: Lens.Lens' DecreaseStreamRetentionPeriod (Prelude.Maybe Prelude.Text)
decreaseStreamRetentionPeriod_streamARN :: Lens' DecreaseStreamRetentionPeriod (Maybe Text)
decreaseStreamRetentionPeriod_streamARN = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseStreamRetentionPeriod' {Maybe Text
streamARN :: Maybe Text
$sel:streamARN:DecreaseStreamRetentionPeriod' :: DecreaseStreamRetentionPeriod -> Maybe Text
streamARN} -> Maybe Text
streamARN) (\s :: DecreaseStreamRetentionPeriod
s@DecreaseStreamRetentionPeriod' {} Maybe Text
a -> DecreaseStreamRetentionPeriod
s {$sel:streamARN:DecreaseStreamRetentionPeriod' :: Maybe Text
streamARN = Maybe Text
a} :: DecreaseStreamRetentionPeriod)

-- | The name of the stream to modify.
decreaseStreamRetentionPeriod_streamName :: Lens.Lens' DecreaseStreamRetentionPeriod (Prelude.Maybe Prelude.Text)
decreaseStreamRetentionPeriod_streamName :: Lens' DecreaseStreamRetentionPeriod (Maybe Text)
decreaseStreamRetentionPeriod_streamName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseStreamRetentionPeriod' {Maybe Text
streamName :: Maybe Text
$sel:streamName:DecreaseStreamRetentionPeriod' :: DecreaseStreamRetentionPeriod -> Maybe Text
streamName} -> Maybe Text
streamName) (\s :: DecreaseStreamRetentionPeriod
s@DecreaseStreamRetentionPeriod' {} Maybe Text
a -> DecreaseStreamRetentionPeriod
s {$sel:streamName:DecreaseStreamRetentionPeriod' :: Maybe Text
streamName = Maybe Text
a} :: DecreaseStreamRetentionPeriod)

-- | The new retention period of the stream, in hours. Must be less than the
-- current retention period.
decreaseStreamRetentionPeriod_retentionPeriodHours :: Lens.Lens' DecreaseStreamRetentionPeriod Prelude.Int
decreaseStreamRetentionPeriod_retentionPeriodHours :: Lens' DecreaseStreamRetentionPeriod Int
decreaseStreamRetentionPeriod_retentionPeriodHours = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DecreaseStreamRetentionPeriod' {Int
retentionPeriodHours :: Int
$sel:retentionPeriodHours:DecreaseStreamRetentionPeriod' :: DecreaseStreamRetentionPeriod -> Int
retentionPeriodHours} -> Int
retentionPeriodHours) (\s :: DecreaseStreamRetentionPeriod
s@DecreaseStreamRetentionPeriod' {} Int
a -> DecreaseStreamRetentionPeriod
s {$sel:retentionPeriodHours:DecreaseStreamRetentionPeriod' :: Int
retentionPeriodHours = Int
a} :: DecreaseStreamRetentionPeriod)

instance
  Core.AWSRequest
    DecreaseStreamRetentionPeriod
  where
  type
    AWSResponse DecreaseStreamRetentionPeriod =
      DecreaseStreamRetentionPeriodResponse
  request :: (Service -> Service)
-> DecreaseStreamRetentionPeriod
-> Request DecreaseStreamRetentionPeriod
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 DecreaseStreamRetentionPeriod
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DecreaseStreamRetentionPeriod)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
AWSResponse a
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveNull
      DecreaseStreamRetentionPeriodResponse
DecreaseStreamRetentionPeriodResponse'

instance
  Prelude.Hashable
    DecreaseStreamRetentionPeriod
  where
  hashWithSalt :: Int -> DecreaseStreamRetentionPeriod -> Int
hashWithSalt Int
_salt DecreaseStreamRetentionPeriod' {Int
Maybe Text
retentionPeriodHours :: Int
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:retentionPeriodHours:DecreaseStreamRetentionPeriod' :: DecreaseStreamRetentionPeriod -> Int
$sel:streamName:DecreaseStreamRetentionPeriod' :: DecreaseStreamRetentionPeriod -> Maybe Text
$sel:streamARN:DecreaseStreamRetentionPeriod' :: DecreaseStreamRetentionPeriod -> 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` Int
retentionPeriodHours

instance Prelude.NFData DecreaseStreamRetentionPeriod where
  rnf :: DecreaseStreamRetentionPeriod -> ()
rnf DecreaseStreamRetentionPeriod' {Int
Maybe Text
retentionPeriodHours :: Int
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:retentionPeriodHours:DecreaseStreamRetentionPeriod' :: DecreaseStreamRetentionPeriod -> Int
$sel:streamName:DecreaseStreamRetentionPeriod' :: DecreaseStreamRetentionPeriod -> Maybe Text
$sel:streamARN:DecreaseStreamRetentionPeriod' :: DecreaseStreamRetentionPeriod -> 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 Int
retentionPeriodHours

instance Data.ToHeaders DecreaseStreamRetentionPeriod where
  toHeaders :: DecreaseStreamRetentionPeriod -> [Header]
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 -> [Header]
Data.=# ( ByteString
"Kinesis_20131202.DecreaseStreamRetentionPeriod" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> [Header]
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON DecreaseStreamRetentionPeriod where
  toJSON :: DecreaseStreamRetentionPeriod -> Value
toJSON DecreaseStreamRetentionPeriod' {Int
Maybe Text
retentionPeriodHours :: Int
streamName :: Maybe Text
streamARN :: Maybe Text
$sel:retentionPeriodHours:DecreaseStreamRetentionPeriod' :: DecreaseStreamRetentionPeriod -> Int
$sel:streamName:DecreaseStreamRetentionPeriod' :: DecreaseStreamRetentionPeriod -> Maybe Text
$sel:streamARN:DecreaseStreamRetentionPeriod' :: DecreaseStreamRetentionPeriod -> 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
"RetentionPeriodHours"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Int
retentionPeriodHours
              )
          ]
      )

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

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

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

-- |
-- Create a value of 'DecreaseStreamRetentionPeriodResponse' 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.
newDecreaseStreamRetentionPeriodResponse ::
  DecreaseStreamRetentionPeriodResponse
newDecreaseStreamRetentionPeriodResponse :: DecreaseStreamRetentionPeriodResponse
newDecreaseStreamRetentionPeriodResponse =
  DecreaseStreamRetentionPeriodResponse
DecreaseStreamRetentionPeriodResponse'

instance
  Prelude.NFData
    DecreaseStreamRetentionPeriodResponse
  where
  rnf :: DecreaseStreamRetentionPeriodResponse -> ()
rnf DecreaseStreamRetentionPeriodResponse
_ = ()