{-# 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.GetRetentionSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the retention settings for the specified Amazon Chime Enterprise
-- account. 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.GetRetentionSettings
  ( -- * Creating a Request
    GetRetentionSettings (..),
    newGetRetentionSettings,

    -- * Request Lenses
    getRetentionSettings_accountId,

    -- * Destructuring the Response
    GetRetentionSettingsResponse (..),
    newGetRetentionSettingsResponse,

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

-- |
-- Create a value of 'GetRetentionSettings' 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', 'getRetentionSettings_accountId' - The Amazon Chime account ID.
newGetRetentionSettings ::
  -- | 'accountId'
  Prelude.Text ->
  GetRetentionSettings
newGetRetentionSettings :: Text -> GetRetentionSettings
newGetRetentionSettings Text
pAccountId_ =
  GetRetentionSettings' {$sel:accountId:GetRetentionSettings' :: Text
accountId = Text
pAccountId_}

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

instance Core.AWSRequest GetRetentionSettings where
  type
    AWSResponse GetRetentionSettings =
      GetRetentionSettingsResponse
  request :: (Service -> Service)
-> GetRetentionSettings -> Request GetRetentionSettings
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetRetentionSettings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetRetentionSettings)))
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 -> GetRetentionSettingsResponse
GetRetentionSettingsResponse'
            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 GetRetentionSettings where
  hashWithSalt :: Int -> GetRetentionSettings -> Int
hashWithSalt Int
_salt GetRetentionSettings' {Text
accountId :: Text
$sel:accountId:GetRetentionSettings' :: GetRetentionSettings -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
accountId

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

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

instance Data.ToPath GetRetentionSettings where
  toPath :: GetRetentionSettings -> ByteString
toPath GetRetentionSettings' {Text
accountId :: Text
$sel:accountId:GetRetentionSettings' :: GetRetentionSettings -> 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 GetRetentionSettings where
  toQuery :: GetRetentionSettings -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

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

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

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

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

instance Prelude.NFData GetRetentionSettingsResponse where
  rnf :: GetRetentionSettingsResponse -> ()
rnf GetRetentionSettingsResponse' {Int
Maybe ISO8601
Maybe RetentionSettings
httpStatus :: Int
retentionSettings :: Maybe RetentionSettings
initiateDeletionTimestamp :: Maybe ISO8601
$sel:httpStatus:GetRetentionSettingsResponse' :: GetRetentionSettingsResponse -> Int
$sel:retentionSettings:GetRetentionSettingsResponse' :: GetRetentionSettingsResponse -> Maybe RetentionSettings
$sel:initiateDeletionTimestamp:GetRetentionSettingsResponse' :: GetRetentionSettingsResponse -> 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