{-# 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.DescribeGlobalSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Describes whether the Amazon Web Services account is opted in to
-- cross-account backup. Returns an error if the account is not a member of
-- an Organizations organization. Example:
-- @describe-global-settings --region us-west-2@
module Amazonka.Backup.DescribeGlobalSettings
  ( -- * Creating a Request
    DescribeGlobalSettings (..),
    newDescribeGlobalSettings,

    -- * Destructuring the Response
    DescribeGlobalSettingsResponse (..),
    newDescribeGlobalSettingsResponse,

    -- * Response Lenses
    describeGlobalSettingsResponse_globalSettings,
    describeGlobalSettingsResponse_lastUpdateTime,
    describeGlobalSettingsResponse_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:/ 'newDescribeGlobalSettings' smart constructor.
data DescribeGlobalSettings = DescribeGlobalSettings'
  {
  }
  deriving (DescribeGlobalSettings -> DescribeGlobalSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeGlobalSettings -> DescribeGlobalSettings -> Bool
$c/= :: DescribeGlobalSettings -> DescribeGlobalSettings -> Bool
== :: DescribeGlobalSettings -> DescribeGlobalSettings -> Bool
$c== :: DescribeGlobalSettings -> DescribeGlobalSettings -> Bool
Prelude.Eq, ReadPrec [DescribeGlobalSettings]
ReadPrec DescribeGlobalSettings
Int -> ReadS DescribeGlobalSettings
ReadS [DescribeGlobalSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeGlobalSettings]
$creadListPrec :: ReadPrec [DescribeGlobalSettings]
readPrec :: ReadPrec DescribeGlobalSettings
$creadPrec :: ReadPrec DescribeGlobalSettings
readList :: ReadS [DescribeGlobalSettings]
$creadList :: ReadS [DescribeGlobalSettings]
readsPrec :: Int -> ReadS DescribeGlobalSettings
$creadsPrec :: Int -> ReadS DescribeGlobalSettings
Prelude.Read, Int -> DescribeGlobalSettings -> ShowS
[DescribeGlobalSettings] -> ShowS
DescribeGlobalSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeGlobalSettings] -> ShowS
$cshowList :: [DescribeGlobalSettings] -> ShowS
show :: DescribeGlobalSettings -> String
$cshow :: DescribeGlobalSettings -> String
showsPrec :: Int -> DescribeGlobalSettings -> ShowS
$cshowsPrec :: Int -> DescribeGlobalSettings -> ShowS
Prelude.Show, forall x. Rep DescribeGlobalSettings x -> DescribeGlobalSettings
forall x. DescribeGlobalSettings -> Rep DescribeGlobalSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribeGlobalSettings x -> DescribeGlobalSettings
$cfrom :: forall x. DescribeGlobalSettings -> Rep DescribeGlobalSettings x
Prelude.Generic)

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

instance Core.AWSRequest DescribeGlobalSettings where
  type
    AWSResponse DescribeGlobalSettings =
      DescribeGlobalSettingsResponse
  request :: (Service -> Service)
-> DescribeGlobalSettings -> Request DescribeGlobalSettings
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 DescribeGlobalSettings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeGlobalSettings)))
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 (HashMap Text Text)
-> Maybe POSIX -> Int -> DescribeGlobalSettingsResponse
DescribeGlobalSettingsResponse'
            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
"GlobalSettings" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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
"LastUpdateTime")
            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 DescribeGlobalSettings where
  hashWithSalt :: Int -> DescribeGlobalSettings -> Int
hashWithSalt Int
_salt DescribeGlobalSettings
_ =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ()

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

instance Data.ToHeaders DescribeGlobalSettings where
  toHeaders :: DescribeGlobalSettings -> 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 DescribeGlobalSettings where
  toPath :: DescribeGlobalSettings -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/global-settings"

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

-- | /See:/ 'newDescribeGlobalSettingsResponse' smart constructor.
data DescribeGlobalSettingsResponse = DescribeGlobalSettingsResponse'
  { -- | The status of the flag @isCrossAccountBackupEnabled@.
    DescribeGlobalSettingsResponse -> Maybe (HashMap Text Text)
globalSettings :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The date and time that the flag @isCrossAccountBackupEnabled@ was last
    -- updated. This update is in Unix format and Coordinated Universal Time
    -- (UTC). The value of @LastUpdateTime@ is accurate to milliseconds. For
    -- example, the value 1516925490.087 represents Friday, January 26, 2018
    -- 12:11:30.087 AM.
    DescribeGlobalSettingsResponse -> Maybe POSIX
lastUpdateTime :: Prelude.Maybe Data.POSIX,
    -- | The response's http status code.
    DescribeGlobalSettingsResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (DescribeGlobalSettingsResponse
-> DescribeGlobalSettingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeGlobalSettingsResponse
-> DescribeGlobalSettingsResponse -> Bool
$c/= :: DescribeGlobalSettingsResponse
-> DescribeGlobalSettingsResponse -> Bool
== :: DescribeGlobalSettingsResponse
-> DescribeGlobalSettingsResponse -> Bool
$c== :: DescribeGlobalSettingsResponse
-> DescribeGlobalSettingsResponse -> Bool
Prelude.Eq, ReadPrec [DescribeGlobalSettingsResponse]
ReadPrec DescribeGlobalSettingsResponse
Int -> ReadS DescribeGlobalSettingsResponse
ReadS [DescribeGlobalSettingsResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeGlobalSettingsResponse]
$creadListPrec :: ReadPrec [DescribeGlobalSettingsResponse]
readPrec :: ReadPrec DescribeGlobalSettingsResponse
$creadPrec :: ReadPrec DescribeGlobalSettingsResponse
readList :: ReadS [DescribeGlobalSettingsResponse]
$creadList :: ReadS [DescribeGlobalSettingsResponse]
readsPrec :: Int -> ReadS DescribeGlobalSettingsResponse
$creadsPrec :: Int -> ReadS DescribeGlobalSettingsResponse
Prelude.Read, Int -> DescribeGlobalSettingsResponse -> ShowS
[DescribeGlobalSettingsResponse] -> ShowS
DescribeGlobalSettingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeGlobalSettingsResponse] -> ShowS
$cshowList :: [DescribeGlobalSettingsResponse] -> ShowS
show :: DescribeGlobalSettingsResponse -> String
$cshow :: DescribeGlobalSettingsResponse -> String
showsPrec :: Int -> DescribeGlobalSettingsResponse -> ShowS
$cshowsPrec :: Int -> DescribeGlobalSettingsResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeGlobalSettingsResponse x
-> DescribeGlobalSettingsResponse
forall x.
DescribeGlobalSettingsResponse
-> Rep DescribeGlobalSettingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeGlobalSettingsResponse x
-> DescribeGlobalSettingsResponse
$cfrom :: forall x.
DescribeGlobalSettingsResponse
-> Rep DescribeGlobalSettingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeGlobalSettingsResponse' 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:
--
-- 'globalSettings', 'describeGlobalSettingsResponse_globalSettings' - The status of the flag @isCrossAccountBackupEnabled@.
--
-- 'lastUpdateTime', 'describeGlobalSettingsResponse_lastUpdateTime' - The date and time that the flag @isCrossAccountBackupEnabled@ was last
-- updated. This update is in Unix format and Coordinated Universal Time
-- (UTC). The value of @LastUpdateTime@ is accurate to milliseconds. For
-- example, the value 1516925490.087 represents Friday, January 26, 2018
-- 12:11:30.087 AM.
--
-- 'httpStatus', 'describeGlobalSettingsResponse_httpStatus' - The response's http status code.
newDescribeGlobalSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  DescribeGlobalSettingsResponse
newDescribeGlobalSettingsResponse :: Int -> DescribeGlobalSettingsResponse
newDescribeGlobalSettingsResponse Int
pHttpStatus_ =
  DescribeGlobalSettingsResponse'
    { $sel:globalSettings:DescribeGlobalSettingsResponse' :: Maybe (HashMap Text Text)
globalSettings =
        forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdateTime:DescribeGlobalSettingsResponse' :: Maybe POSIX
lastUpdateTime = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:DescribeGlobalSettingsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The status of the flag @isCrossAccountBackupEnabled@.
describeGlobalSettingsResponse_globalSettings :: Lens.Lens' DescribeGlobalSettingsResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
describeGlobalSettingsResponse_globalSettings :: Lens' DescribeGlobalSettingsResponse (Maybe (HashMap Text Text))
describeGlobalSettingsResponse_globalSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGlobalSettingsResponse' {Maybe (HashMap Text Text)
globalSettings :: Maybe (HashMap Text Text)
$sel:globalSettings:DescribeGlobalSettingsResponse' :: DescribeGlobalSettingsResponse -> Maybe (HashMap Text Text)
globalSettings} -> Maybe (HashMap Text Text)
globalSettings) (\s :: DescribeGlobalSettingsResponse
s@DescribeGlobalSettingsResponse' {} Maybe (HashMap Text Text)
a -> DescribeGlobalSettingsResponse
s {$sel:globalSettings:DescribeGlobalSettingsResponse' :: Maybe (HashMap Text Text)
globalSettings = Maybe (HashMap Text Text)
a} :: DescribeGlobalSettingsResponse) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The date and time that the flag @isCrossAccountBackupEnabled@ was last
-- updated. This update is in Unix format and Coordinated Universal Time
-- (UTC). The value of @LastUpdateTime@ is accurate to milliseconds. For
-- example, the value 1516925490.087 represents Friday, January 26, 2018
-- 12:11:30.087 AM.
describeGlobalSettingsResponse_lastUpdateTime :: Lens.Lens' DescribeGlobalSettingsResponse (Prelude.Maybe Prelude.UTCTime)
describeGlobalSettingsResponse_lastUpdateTime :: Lens' DescribeGlobalSettingsResponse (Maybe UTCTime)
describeGlobalSettingsResponse_lastUpdateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGlobalSettingsResponse' {Maybe POSIX
lastUpdateTime :: Maybe POSIX
$sel:lastUpdateTime:DescribeGlobalSettingsResponse' :: DescribeGlobalSettingsResponse -> Maybe POSIX
lastUpdateTime} -> Maybe POSIX
lastUpdateTime) (\s :: DescribeGlobalSettingsResponse
s@DescribeGlobalSettingsResponse' {} Maybe POSIX
a -> DescribeGlobalSettingsResponse
s {$sel:lastUpdateTime:DescribeGlobalSettingsResponse' :: Maybe POSIX
lastUpdateTime = Maybe POSIX
a} :: DescribeGlobalSettingsResponse) 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 response's http status code.
describeGlobalSettingsResponse_httpStatus :: Lens.Lens' DescribeGlobalSettingsResponse Prelude.Int
describeGlobalSettingsResponse_httpStatus :: Lens' DescribeGlobalSettingsResponse Int
describeGlobalSettingsResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGlobalSettingsResponse' {Int
httpStatus :: Int
$sel:httpStatus:DescribeGlobalSettingsResponse' :: DescribeGlobalSettingsResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: DescribeGlobalSettingsResponse
s@DescribeGlobalSettingsResponse' {} Int
a -> DescribeGlobalSettingsResponse
s {$sel:httpStatus:DescribeGlobalSettingsResponse' :: Int
httpStatus = Int
a} :: DescribeGlobalSettingsResponse)

instance
  Prelude.NFData
    DescribeGlobalSettingsResponse
  where
  rnf :: DescribeGlobalSettingsResponse -> ()
rnf DescribeGlobalSettingsResponse' {Int
Maybe (HashMap Text Text)
Maybe POSIX
httpStatus :: Int
lastUpdateTime :: Maybe POSIX
globalSettings :: Maybe (HashMap Text Text)
$sel:httpStatus:DescribeGlobalSettingsResponse' :: DescribeGlobalSettingsResponse -> Int
$sel:lastUpdateTime:DescribeGlobalSettingsResponse' :: DescribeGlobalSettingsResponse -> Maybe POSIX
$sel:globalSettings:DescribeGlobalSettingsResponse' :: DescribeGlobalSettingsResponse -> Maybe (HashMap Text Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
globalSettings
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdateTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus