{-# 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.Chime.PutRetentionSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Puts retention settings for the specified Amazon Chime Enterprise
-- account. We recommend using AWS CloudTrail to monitor usage of this API
-- for your account. For more information, see
-- <https://docs.aws.amazon.com/chime/latest/ag/cloudtrail.html Logging Amazon Chime API Calls with AWS CloudTrail>
-- in the /Amazon Chime Administration Guide/.
--
-- To turn off existing retention settings, remove the number of days from
-- the corresponding __RetentionDays__ field in the __RetentionSettings__
-- object. For more information about retention settings, see
-- <https://docs.aws.amazon.com/chime/latest/ag/chat-retention.html Managing Chat Retention Policies>
-- in the /Amazon Chime Administration Guide/.
module Amazonka.Chime.PutRetentionSettings
  ( -- * Creating a Request
    PutRetentionSettings (..),
    newPutRetentionSettings,

    -- * Request Lenses
    putRetentionSettings_accountId,
    putRetentionSettings_retentionSettings,

    -- * Destructuring the Response
    PutRetentionSettingsResponse (..),
    newPutRetentionSettingsResponse,

    -- * Response Lenses
    putRetentionSettingsResponse_initiateDeletionTimestamp,
    putRetentionSettingsResponse_retentionSettings,
    putRetentionSettingsResponse_httpStatus,
  )
where

import Amazonka.Chime.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:/ 'newPutRetentionSettings' smart constructor.
data PutRetentionSettings = PutRetentionSettings'
  { -- | The Amazon Chime account ID.
    PutRetentionSettings -> Text
accountId :: Prelude.Text,
    -- | The retention settings.
    PutRetentionSettings -> RetentionSettings
retentionSettings :: RetentionSettings
  }
  deriving (PutRetentionSettings -> PutRetentionSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutRetentionSettings -> PutRetentionSettings -> Bool
$c/= :: PutRetentionSettings -> PutRetentionSettings -> Bool
== :: PutRetentionSettings -> PutRetentionSettings -> Bool
$c== :: PutRetentionSettings -> PutRetentionSettings -> Bool
Prelude.Eq, ReadPrec [PutRetentionSettings]
ReadPrec PutRetentionSettings
Int -> ReadS PutRetentionSettings
ReadS [PutRetentionSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutRetentionSettings]
$creadListPrec :: ReadPrec [PutRetentionSettings]
readPrec :: ReadPrec PutRetentionSettings
$creadPrec :: ReadPrec PutRetentionSettings
readList :: ReadS [PutRetentionSettings]
$creadList :: ReadS [PutRetentionSettings]
readsPrec :: Int -> ReadS PutRetentionSettings
$creadsPrec :: Int -> ReadS PutRetentionSettings
Prelude.Read, Int -> PutRetentionSettings -> ShowS
[PutRetentionSettings] -> ShowS
PutRetentionSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutRetentionSettings] -> ShowS
$cshowList :: [PutRetentionSettings] -> ShowS
show :: PutRetentionSettings -> String
$cshow :: PutRetentionSettings -> String
showsPrec :: Int -> PutRetentionSettings -> ShowS
$cshowsPrec :: Int -> PutRetentionSettings -> ShowS
Prelude.Show, forall x. Rep PutRetentionSettings x -> PutRetentionSettings
forall x. PutRetentionSettings -> Rep PutRetentionSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutRetentionSettings x -> PutRetentionSettings
$cfrom :: forall x. PutRetentionSettings -> Rep PutRetentionSettings x
Prelude.Generic)

-- |
-- Create a value of 'PutRetentionSettings' 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:
--
-- 'accountId', 'putRetentionSettings_accountId' - The Amazon Chime account ID.
--
-- 'retentionSettings', 'putRetentionSettings_retentionSettings' - The retention settings.
newPutRetentionSettings ::
  -- | 'accountId'
  Prelude.Text ->
  -- | 'retentionSettings'
  RetentionSettings ->
  PutRetentionSettings
newPutRetentionSettings :: Text -> RetentionSettings -> PutRetentionSettings
newPutRetentionSettings
  Text
pAccountId_
  RetentionSettings
pRetentionSettings_ =
    PutRetentionSettings'
      { $sel:accountId:PutRetentionSettings' :: Text
accountId = Text
pAccountId_,
        $sel:retentionSettings:PutRetentionSettings' :: RetentionSettings
retentionSettings = RetentionSettings
pRetentionSettings_
      }

-- | The Amazon Chime account ID.
putRetentionSettings_accountId :: Lens.Lens' PutRetentionSettings Prelude.Text
putRetentionSettings_accountId :: Lens' PutRetentionSettings Text
putRetentionSettings_accountId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRetentionSettings' {Text
accountId :: Text
$sel:accountId:PutRetentionSettings' :: PutRetentionSettings -> Text
accountId} -> Text
accountId) (\s :: PutRetentionSettings
s@PutRetentionSettings' {} Text
a -> PutRetentionSettings
s {$sel:accountId:PutRetentionSettings' :: Text
accountId = Text
a} :: PutRetentionSettings)

-- | The retention settings.
putRetentionSettings_retentionSettings :: Lens.Lens' PutRetentionSettings RetentionSettings
putRetentionSettings_retentionSettings :: Lens' PutRetentionSettings RetentionSettings
putRetentionSettings_retentionSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRetentionSettings' {RetentionSettings
retentionSettings :: RetentionSettings
$sel:retentionSettings:PutRetentionSettings' :: PutRetentionSettings -> RetentionSettings
retentionSettings} -> RetentionSettings
retentionSettings) (\s :: PutRetentionSettings
s@PutRetentionSettings' {} RetentionSettings
a -> PutRetentionSettings
s {$sel:retentionSettings:PutRetentionSettings' :: RetentionSettings
retentionSettings = RetentionSettings
a} :: PutRetentionSettings)

instance Core.AWSRequest PutRetentionSettings where
  type
    AWSResponse PutRetentionSettings =
      PutRetentionSettingsResponse
  request :: (Service -> Service)
-> PutRetentionSettings -> Request PutRetentionSettings
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutRetentionSettings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse PutRetentionSettings)))
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 ISO8601
-> Maybe RetentionSettings -> Int -> PutRetentionSettingsResponse
PutRetentionSettingsResponse'
            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
"InitiateDeletionTimestamp")
            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
"RetentionSettings")
            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 PutRetentionSettings where
  hashWithSalt :: Int -> PutRetentionSettings -> Int
hashWithSalt Int
_salt PutRetentionSettings' {Text
RetentionSettings
retentionSettings :: RetentionSettings
accountId :: Text
$sel:retentionSettings:PutRetentionSettings' :: PutRetentionSettings -> RetentionSettings
$sel:accountId:PutRetentionSettings' :: PutRetentionSettings -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RetentionSettings
retentionSettings

instance Prelude.NFData PutRetentionSettings where
  rnf :: PutRetentionSettings -> ()
rnf PutRetentionSettings' {Text
RetentionSettings
retentionSettings :: RetentionSettings
accountId :: Text
$sel:retentionSettings:PutRetentionSettings' :: PutRetentionSettings -> RetentionSettings
$sel:accountId:PutRetentionSettings' :: PutRetentionSettings -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
accountId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RetentionSettings
retentionSettings

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

instance Data.ToJSON PutRetentionSettings where
  toJSON :: PutRetentionSettings -> Value
toJSON PutRetentionSettings' {Text
RetentionSettings
retentionSettings :: RetentionSettings
accountId :: Text
$sel:retentionSettings:PutRetentionSettings' :: PutRetentionSettings -> RetentionSettings
$sel:accountId:PutRetentionSettings' :: PutRetentionSettings -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just
              (Key
"RetentionSettings" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= RetentionSettings
retentionSettings)
          ]
      )

instance Data.ToPath PutRetentionSettings where
  toPath :: PutRetentionSettings -> ByteString
toPath PutRetentionSettings' {Text
RetentionSettings
retentionSettings :: RetentionSettings
accountId :: Text
$sel:retentionSettings:PutRetentionSettings' :: PutRetentionSettings -> RetentionSettings
$sel:accountId:PutRetentionSettings' :: PutRetentionSettings -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/accounts/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
accountId,
        ByteString
"/retention-settings"
      ]

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

-- | /See:/ 'newPutRetentionSettingsResponse' smart constructor.
data PutRetentionSettingsResponse = PutRetentionSettingsResponse'
  { -- | The timestamp representing the time at which the specified items are
    -- permanently deleted, in ISO 8601 format.
    PutRetentionSettingsResponse -> Maybe ISO8601
initiateDeletionTimestamp :: Prelude.Maybe Data.ISO8601,
    -- | The retention settings.
    PutRetentionSettingsResponse -> Maybe RetentionSettings
retentionSettings :: Prelude.Maybe RetentionSettings,
    -- | The response's http status code.
    PutRetentionSettingsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (PutRetentionSettingsResponse
-> PutRetentionSettingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutRetentionSettingsResponse
-> PutRetentionSettingsResponse -> Bool
$c/= :: PutRetentionSettingsResponse
-> PutRetentionSettingsResponse -> Bool
== :: PutRetentionSettingsResponse
-> PutRetentionSettingsResponse -> Bool
$c== :: PutRetentionSettingsResponse
-> PutRetentionSettingsResponse -> Bool
Prelude.Eq, ReadPrec [PutRetentionSettingsResponse]
ReadPrec PutRetentionSettingsResponse
Int -> ReadS PutRetentionSettingsResponse
ReadS [PutRetentionSettingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutRetentionSettingsResponse]
$creadListPrec :: ReadPrec [PutRetentionSettingsResponse]
readPrec :: ReadPrec PutRetentionSettingsResponse
$creadPrec :: ReadPrec PutRetentionSettingsResponse
readList :: ReadS [PutRetentionSettingsResponse]
$creadList :: ReadS [PutRetentionSettingsResponse]
readsPrec :: Int -> ReadS PutRetentionSettingsResponse
$creadsPrec :: Int -> ReadS PutRetentionSettingsResponse
Prelude.Read, Int -> PutRetentionSettingsResponse -> ShowS
[PutRetentionSettingsResponse] -> ShowS
PutRetentionSettingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutRetentionSettingsResponse] -> ShowS
$cshowList :: [PutRetentionSettingsResponse] -> ShowS
show :: PutRetentionSettingsResponse -> String
$cshow :: PutRetentionSettingsResponse -> String
showsPrec :: Int -> PutRetentionSettingsResponse -> ShowS
$cshowsPrec :: Int -> PutRetentionSettingsResponse -> ShowS
Prelude.Show, forall x.
Rep PutRetentionSettingsResponse x -> PutRetentionSettingsResponse
forall x.
PutRetentionSettingsResponse -> Rep PutRetentionSettingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep PutRetentionSettingsResponse x -> PutRetentionSettingsResponse
$cfrom :: forall x.
PutRetentionSettingsResponse -> Rep PutRetentionSettingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutRetentionSettingsResponse' 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:
--
-- 'initiateDeletionTimestamp', 'putRetentionSettingsResponse_initiateDeletionTimestamp' - The timestamp representing the time at which the specified items are
-- permanently deleted, in ISO 8601 format.
--
-- 'retentionSettings', 'putRetentionSettingsResponse_retentionSettings' - The retention settings.
--
-- 'httpStatus', 'putRetentionSettingsResponse_httpStatus' - The response's http status code.
newPutRetentionSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  PutRetentionSettingsResponse
newPutRetentionSettingsResponse :: Int -> PutRetentionSettingsResponse
newPutRetentionSettingsResponse Int
pHttpStatus_ =
  PutRetentionSettingsResponse'
    { $sel:initiateDeletionTimestamp:PutRetentionSettingsResponse' :: Maybe ISO8601
initiateDeletionTimestamp =
        forall a. Maybe a
Prelude.Nothing,
      $sel:retentionSettings:PutRetentionSettingsResponse' :: Maybe RetentionSettings
retentionSettings = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:PutRetentionSettingsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The timestamp representing the time at which the specified items are
-- permanently deleted, in ISO 8601 format.
putRetentionSettingsResponse_initiateDeletionTimestamp :: Lens.Lens' PutRetentionSettingsResponse (Prelude.Maybe Prelude.UTCTime)
putRetentionSettingsResponse_initiateDeletionTimestamp :: Lens' PutRetentionSettingsResponse (Maybe UTCTime)
putRetentionSettingsResponse_initiateDeletionTimestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRetentionSettingsResponse' {Maybe ISO8601
initiateDeletionTimestamp :: Maybe ISO8601
$sel:initiateDeletionTimestamp:PutRetentionSettingsResponse' :: PutRetentionSettingsResponse -> Maybe ISO8601
initiateDeletionTimestamp} -> Maybe ISO8601
initiateDeletionTimestamp) (\s :: PutRetentionSettingsResponse
s@PutRetentionSettingsResponse' {} Maybe ISO8601
a -> PutRetentionSettingsResponse
s {$sel:initiateDeletionTimestamp:PutRetentionSettingsResponse' :: Maybe ISO8601
initiateDeletionTimestamp = Maybe ISO8601
a} :: PutRetentionSettingsResponse) 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 retention settings.
putRetentionSettingsResponse_retentionSettings :: Lens.Lens' PutRetentionSettingsResponse (Prelude.Maybe RetentionSettings)
putRetentionSettingsResponse_retentionSettings :: Lens' PutRetentionSettingsResponse (Maybe RetentionSettings)
putRetentionSettingsResponse_retentionSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutRetentionSettingsResponse' {Maybe RetentionSettings
retentionSettings :: Maybe RetentionSettings
$sel:retentionSettings:PutRetentionSettingsResponse' :: PutRetentionSettingsResponse -> Maybe RetentionSettings
retentionSettings} -> Maybe RetentionSettings
retentionSettings) (\s :: PutRetentionSettingsResponse
s@PutRetentionSettingsResponse' {} Maybe RetentionSettings
a -> PutRetentionSettingsResponse
s {$sel:retentionSettings:PutRetentionSettingsResponse' :: Maybe RetentionSettings
retentionSettings = Maybe RetentionSettings
a} :: PutRetentionSettingsResponse)

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

instance Prelude.NFData PutRetentionSettingsResponse where
  rnf :: PutRetentionSettingsResponse -> ()
rnf PutRetentionSettingsResponse' {Int
Maybe ISO8601
Maybe RetentionSettings
httpStatus :: Int
retentionSettings :: Maybe RetentionSettings
initiateDeletionTimestamp :: Maybe ISO8601
$sel:httpStatus:PutRetentionSettingsResponse' :: PutRetentionSettingsResponse -> Int
$sel:retentionSettings:PutRetentionSettingsResponse' :: PutRetentionSettingsResponse -> Maybe RetentionSettings
$sel:initiateDeletionTimestamp:PutRetentionSettingsResponse' :: PutRetentionSettingsResponse -> Maybe ISO8601
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
initiateDeletionTimestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RetentionSettings
retentionSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus