{-# LANGUAGE DeriveGeneric #-} {-# LANGUAGE DuplicateRecordFields #-} {-# LANGUAGE NamedFieldPuns #-} {-# LANGUAGE OverloadedStrings #-} {-# LANGUAGE RecordWildCards #-} {-# LANGUAGE StrictData #-} {-# LANGUAGE NoImplicitPrelude #-} {-# OPTIONS_GHC -fno-warn-unused-imports #-} {-# OPTIONS_GHC -fno-warn-unused-matches #-} -- Derived from AWS service descriptions, licensed under Apache 2.0. -- | -- Module : Amazonka.Lightsail.Types.AccountLevelBpaSync -- Copyright : (c) 2013-2023 Brendan Hay -- License : Mozilla Public License, v. 2.0. -- Maintainer : Brendan Hay -- Stability : auto-generated -- Portability : non-portable (GHC extensions) module Amazonka.Lightsail.Types.AccountLevelBpaSync where import qualified Amazonka.Core as Core import qualified Amazonka.Core.Lens.Internal as Lens import qualified Amazonka.Data as Data import Amazonka.Lightsail.Types.AccountLevelBpaSyncStatus import Amazonka.Lightsail.Types.BPAStatusMessage import qualified Amazonka.Prelude as Prelude -- | Describes the synchronization status of the Amazon Simple Storage -- Service (Amazon S3) account-level block public access (BPA) feature for -- your Lightsail buckets. -- -- The account-level BPA feature of Amazon S3 provides centralized controls -- to limit public access to all Amazon S3 buckets in an account. BPA can -- make all Amazon S3 buckets in an Amazon Web Services account private -- regardless of the individual bucket and object permissions that are -- configured. Lightsail buckets take into account the Amazon S3 -- account-level BPA configuration when allowing or denying public access. -- To do this, Lightsail periodically fetches the account-level BPA -- configuration from Amazon S3. When the account-level BPA status is -- @InSync@, the Amazon S3 account-level BPA configuration is synchronized -- and it applies to your Lightsail buckets. For more information about -- Amazon Simple Storage Service account-level BPA and how it affects -- Lightsail buckets, see -- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-block-public-access-for-buckets Block public access for buckets in Amazon Lightsail> -- in the /Amazon Lightsail Developer Guide/. -- -- /See:/ 'newAccountLevelBpaSync' smart constructor. data AccountLevelBpaSync = AccountLevelBpaSync' { -- | A Boolean value that indicates whether account-level block public access -- is affecting your Lightsail buckets. AccountLevelBpaSync -> Maybe Bool bpaImpactsLightsail :: Prelude.Maybe Prelude.Bool, -- | The timestamp of when the account-level BPA configuration was last -- synchronized. This value is null when the account-level BPA -- configuration has not been synchronized. AccountLevelBpaSync -> Maybe POSIX lastSyncedAt :: Prelude.Maybe Data.POSIX, -- | A message that provides a reason for a @Failed@ or @Defaulted@ -- synchronization status. -- -- The following messages are possible: -- -- - @SYNC_ON_HOLD@ - The synchronization has not yet happened. This -- status message occurs immediately after you create your first -- Lightsail bucket. This status message should change after the first -- synchronization happens, approximately 1 hour after the first bucket -- is created. -- -- - @DEFAULTED_FOR_SLR_MISSING@ - The synchronization failed because the -- required service-linked role is missing from your Amazon Web -- Services account. The account-level BPA configuration for your -- Lightsail buckets is defaulted to /active/ until the synchronization -- can occur. This means that all your buckets are private and not -- publicly accessible. For more information about how to create the -- required service-linked role to allow synchronization, see -- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-using-service-linked-roles Using Service-Linked Roles for Amazon Lightsail> -- in the /Amazon Lightsail Developer Guide/. -- -- - @DEFAULTED_FOR_SLR_MISSING_ON_HOLD@ - The synchronization failed -- because the required service-linked role is missing from your Amazon -- Web Services account. Account-level BPA is not yet configured for -- your Lightsail buckets. Therefore, only the bucket access -- permissions and individual object access permissions apply to your -- Lightsail buckets. For more information about how to create the -- required service-linked role to allow synchronization, see -- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-using-service-linked-roles Using Service-Linked Roles for Amazon Lightsail> -- in the /Amazon Lightsail Developer Guide/. -- -- - @Unknown@ - The reason that synchronization failed is unknown. -- Contact Amazon Web Services Support for more information. AccountLevelBpaSync -> Maybe BPAStatusMessage message :: Prelude.Maybe BPAStatusMessage, -- | The status of the account-level BPA synchronization. -- -- The following statuses are possible: -- -- - @InSync@ - Account-level BPA is synchronized. The Amazon S3 -- account-level BPA configuration applies to your Lightsail buckets. -- -- - @NeverSynced@ - Synchronization has not yet happened. The Amazon S3 -- account-level BPA configuration does not apply to your Lightsail -- buckets. -- -- - @Failed@ - Synchronization failed. The Amazon S3 account-level BPA -- configuration does not apply to your Lightsail buckets. -- -- - @Defaulted@ - Synchronization failed and account-level BPA for your -- Lightsail buckets is defaulted to /active/. -- -- You might need to complete further actions if the status is @Failed@ or -- @Defaulted@. The @message@ parameter provides more information for those -- statuses. AccountLevelBpaSync -> Maybe AccountLevelBpaSyncStatus status :: Prelude.Maybe AccountLevelBpaSyncStatus } deriving (AccountLevelBpaSync -> AccountLevelBpaSync -> Bool forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a /= :: AccountLevelBpaSync -> AccountLevelBpaSync -> Bool $c/= :: AccountLevelBpaSync -> AccountLevelBpaSync -> Bool == :: AccountLevelBpaSync -> AccountLevelBpaSync -> Bool $c== :: AccountLevelBpaSync -> AccountLevelBpaSync -> Bool Prelude.Eq, ReadPrec [AccountLevelBpaSync] ReadPrec AccountLevelBpaSync Int -> ReadS AccountLevelBpaSync ReadS [AccountLevelBpaSync] forall a. (Int -> ReadS a) -> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a readListPrec :: ReadPrec [AccountLevelBpaSync] $creadListPrec :: ReadPrec [AccountLevelBpaSync] readPrec :: ReadPrec AccountLevelBpaSync $creadPrec :: ReadPrec AccountLevelBpaSync readList :: ReadS [AccountLevelBpaSync] $creadList :: ReadS [AccountLevelBpaSync] readsPrec :: Int -> ReadS AccountLevelBpaSync $creadsPrec :: Int -> ReadS AccountLevelBpaSync Prelude.Read, Int -> AccountLevelBpaSync -> ShowS [AccountLevelBpaSync] -> ShowS AccountLevelBpaSync -> String forall a. (Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a showList :: [AccountLevelBpaSync] -> ShowS $cshowList :: [AccountLevelBpaSync] -> ShowS show :: AccountLevelBpaSync -> String $cshow :: AccountLevelBpaSync -> String showsPrec :: Int -> AccountLevelBpaSync -> ShowS $cshowsPrec :: Int -> AccountLevelBpaSync -> ShowS Prelude.Show, forall x. Rep AccountLevelBpaSync x -> AccountLevelBpaSync forall x. AccountLevelBpaSync -> Rep AccountLevelBpaSync x forall a. (forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a $cto :: forall x. Rep AccountLevelBpaSync x -> AccountLevelBpaSync $cfrom :: forall x. AccountLevelBpaSync -> Rep AccountLevelBpaSync x Prelude.Generic) -- | -- Create a value of 'AccountLevelBpaSync' 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: -- -- 'bpaImpactsLightsail', 'accountLevelBpaSync_bpaImpactsLightsail' - A Boolean value that indicates whether account-level block public access -- is affecting your Lightsail buckets. -- -- 'lastSyncedAt', 'accountLevelBpaSync_lastSyncedAt' - The timestamp of when the account-level BPA configuration was last -- synchronized. This value is null when the account-level BPA -- configuration has not been synchronized. -- -- 'message', 'accountLevelBpaSync_message' - A message that provides a reason for a @Failed@ or @Defaulted@ -- synchronization status. -- -- The following messages are possible: -- -- - @SYNC_ON_HOLD@ - The synchronization has not yet happened. This -- status message occurs immediately after you create your first -- Lightsail bucket. This status message should change after the first -- synchronization happens, approximately 1 hour after the first bucket -- is created. -- -- - @DEFAULTED_FOR_SLR_MISSING@ - The synchronization failed because the -- required service-linked role is missing from your Amazon Web -- Services account. The account-level BPA configuration for your -- Lightsail buckets is defaulted to /active/ until the synchronization -- can occur. This means that all your buckets are private and not -- publicly accessible. For more information about how to create the -- required service-linked role to allow synchronization, see -- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-using-service-linked-roles Using Service-Linked Roles for Amazon Lightsail> -- in the /Amazon Lightsail Developer Guide/. -- -- - @DEFAULTED_FOR_SLR_MISSING_ON_HOLD@ - The synchronization failed -- because the required service-linked role is missing from your Amazon -- Web Services account. Account-level BPA is not yet configured for -- your Lightsail buckets. Therefore, only the bucket access -- permissions and individual object access permissions apply to your -- Lightsail buckets. For more information about how to create the -- required service-linked role to allow synchronization, see -- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-using-service-linked-roles Using Service-Linked Roles for Amazon Lightsail> -- in the /Amazon Lightsail Developer Guide/. -- -- - @Unknown@ - The reason that synchronization failed is unknown. -- Contact Amazon Web Services Support for more information. -- -- 'status', 'accountLevelBpaSync_status' - The status of the account-level BPA synchronization. -- -- The following statuses are possible: -- -- - @InSync@ - Account-level BPA is synchronized. The Amazon S3 -- account-level BPA configuration applies to your Lightsail buckets. -- -- - @NeverSynced@ - Synchronization has not yet happened. The Amazon S3 -- account-level BPA configuration does not apply to your Lightsail -- buckets. -- -- - @Failed@ - Synchronization failed. The Amazon S3 account-level BPA -- configuration does not apply to your Lightsail buckets. -- -- - @Defaulted@ - Synchronization failed and account-level BPA for your -- Lightsail buckets is defaulted to /active/. -- -- You might need to complete further actions if the status is @Failed@ or -- @Defaulted@. The @message@ parameter provides more information for those -- statuses. newAccountLevelBpaSync :: AccountLevelBpaSync newAccountLevelBpaSync :: AccountLevelBpaSync newAccountLevelBpaSync = AccountLevelBpaSync' { $sel:bpaImpactsLightsail:AccountLevelBpaSync' :: Maybe Bool bpaImpactsLightsail = forall a. Maybe a Prelude.Nothing, $sel:lastSyncedAt:AccountLevelBpaSync' :: Maybe POSIX lastSyncedAt = forall a. Maybe a Prelude.Nothing, $sel:message:AccountLevelBpaSync' :: Maybe BPAStatusMessage message = forall a. Maybe a Prelude.Nothing, $sel:status:AccountLevelBpaSync' :: Maybe AccountLevelBpaSyncStatus status = forall a. Maybe a Prelude.Nothing } -- | A Boolean value that indicates whether account-level block public access -- is affecting your Lightsail buckets. accountLevelBpaSync_bpaImpactsLightsail :: Lens.Lens' AccountLevelBpaSync (Prelude.Maybe Prelude.Bool) accountLevelBpaSync_bpaImpactsLightsail :: Lens' AccountLevelBpaSync (Maybe Bool) accountLevelBpaSync_bpaImpactsLightsail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b Lens.lens (\AccountLevelBpaSync' {Maybe Bool bpaImpactsLightsail :: Maybe Bool $sel:bpaImpactsLightsail:AccountLevelBpaSync' :: AccountLevelBpaSync -> Maybe Bool bpaImpactsLightsail} -> Maybe Bool bpaImpactsLightsail) (\s :: AccountLevelBpaSync s@AccountLevelBpaSync' {} Maybe Bool a -> AccountLevelBpaSync s {$sel:bpaImpactsLightsail:AccountLevelBpaSync' :: Maybe Bool bpaImpactsLightsail = Maybe Bool a} :: AccountLevelBpaSync) -- | The timestamp of when the account-level BPA configuration was last -- synchronized. This value is null when the account-level BPA -- configuration has not been synchronized. accountLevelBpaSync_lastSyncedAt :: Lens.Lens' AccountLevelBpaSync (Prelude.Maybe Prelude.UTCTime) accountLevelBpaSync_lastSyncedAt :: Lens' AccountLevelBpaSync (Maybe UTCTime) accountLevelBpaSync_lastSyncedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b Lens.lens (\AccountLevelBpaSync' {Maybe POSIX lastSyncedAt :: Maybe POSIX $sel:lastSyncedAt:AccountLevelBpaSync' :: AccountLevelBpaSync -> Maybe POSIX lastSyncedAt} -> Maybe POSIX lastSyncedAt) (\s :: AccountLevelBpaSync s@AccountLevelBpaSync' {} Maybe POSIX a -> AccountLevelBpaSync s {$sel:lastSyncedAt:AccountLevelBpaSync' :: Maybe POSIX lastSyncedAt = Maybe POSIX a} :: AccountLevelBpaSync) 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 -- | A message that provides a reason for a @Failed@ or @Defaulted@ -- synchronization status. -- -- The following messages are possible: -- -- - @SYNC_ON_HOLD@ - The synchronization has not yet happened. This -- status message occurs immediately after you create your first -- Lightsail bucket. This status message should change after the first -- synchronization happens, approximately 1 hour after the first bucket -- is created. -- -- - @DEFAULTED_FOR_SLR_MISSING@ - The synchronization failed because the -- required service-linked role is missing from your Amazon Web -- Services account. The account-level BPA configuration for your -- Lightsail buckets is defaulted to /active/ until the synchronization -- can occur. This means that all your buckets are private and not -- publicly accessible. For more information about how to create the -- required service-linked role to allow synchronization, see -- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-using-service-linked-roles Using Service-Linked Roles for Amazon Lightsail> -- in the /Amazon Lightsail Developer Guide/. -- -- - @DEFAULTED_FOR_SLR_MISSING_ON_HOLD@ - The synchronization failed -- because the required service-linked role is missing from your Amazon -- Web Services account. Account-level BPA is not yet configured for -- your Lightsail buckets. Therefore, only the bucket access -- permissions and individual object access permissions apply to your -- Lightsail buckets. For more information about how to create the -- required service-linked role to allow synchronization, see -- <https://lightsail.aws.amazon.com/ls/docs/en_us/articles/amazon-lightsail-using-service-linked-roles Using Service-Linked Roles for Amazon Lightsail> -- in the /Amazon Lightsail Developer Guide/. -- -- - @Unknown@ - The reason that synchronization failed is unknown. -- Contact Amazon Web Services Support for more information. accountLevelBpaSync_message :: Lens.Lens' AccountLevelBpaSync (Prelude.Maybe BPAStatusMessage) accountLevelBpaSync_message :: Lens' AccountLevelBpaSync (Maybe BPAStatusMessage) accountLevelBpaSync_message = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b Lens.lens (\AccountLevelBpaSync' {Maybe BPAStatusMessage message :: Maybe BPAStatusMessage $sel:message:AccountLevelBpaSync' :: AccountLevelBpaSync -> Maybe BPAStatusMessage message} -> Maybe BPAStatusMessage message) (\s :: AccountLevelBpaSync s@AccountLevelBpaSync' {} Maybe BPAStatusMessage a -> AccountLevelBpaSync s {$sel:message:AccountLevelBpaSync' :: Maybe BPAStatusMessage message = Maybe BPAStatusMessage a} :: AccountLevelBpaSync) -- | The status of the account-level BPA synchronization. -- -- The following statuses are possible: -- -- - @InSync@ - Account-level BPA is synchronized. The Amazon S3 -- account-level BPA configuration applies to your Lightsail buckets. -- -- - @NeverSynced@ - Synchronization has not yet happened. The Amazon S3 -- account-level BPA configuration does not apply to your Lightsail -- buckets. -- -- - @Failed@ - Synchronization failed. The Amazon S3 account-level BPA -- configuration does not apply to your Lightsail buckets. -- -- - @Defaulted@ - Synchronization failed and account-level BPA for your -- Lightsail buckets is defaulted to /active/. -- -- You might need to complete further actions if the status is @Failed@ or -- @Defaulted@. The @message@ parameter provides more information for those -- statuses. accountLevelBpaSync_status :: Lens.Lens' AccountLevelBpaSync (Prelude.Maybe AccountLevelBpaSyncStatus) accountLevelBpaSync_status :: Lens' AccountLevelBpaSync (Maybe AccountLevelBpaSyncStatus) accountLevelBpaSync_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b Lens.lens (\AccountLevelBpaSync' {Maybe AccountLevelBpaSyncStatus status :: Maybe AccountLevelBpaSyncStatus $sel:status:AccountLevelBpaSync' :: AccountLevelBpaSync -> Maybe AccountLevelBpaSyncStatus status} -> Maybe AccountLevelBpaSyncStatus status) (\s :: AccountLevelBpaSync s@AccountLevelBpaSync' {} Maybe AccountLevelBpaSyncStatus a -> AccountLevelBpaSync s {$sel:status:AccountLevelBpaSync' :: Maybe AccountLevelBpaSyncStatus status = Maybe AccountLevelBpaSyncStatus a} :: AccountLevelBpaSync) instance Data.FromJSON AccountLevelBpaSync where parseJSON :: Value -> Parser AccountLevelBpaSync parseJSON = forall a. String -> (Object -> Parser a) -> Value -> Parser a Data.withObject String "AccountLevelBpaSync" ( \Object x -> Maybe Bool -> Maybe POSIX -> Maybe BPAStatusMessage -> Maybe AccountLevelBpaSyncStatus -> AccountLevelBpaSync AccountLevelBpaSync' forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b Prelude.<$> (Object x forall a. FromJSON a => Object -> Key -> Parser (Maybe a) Data..:? Key "bpaImpactsLightsail") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b Prelude.<*> (Object x forall a. FromJSON a => Object -> Key -> Parser (Maybe a) Data..:? Key "lastSyncedAt") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b Prelude.<*> (Object x forall a. FromJSON a => Object -> Key -> Parser (Maybe a) Data..:? Key "message") forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b Prelude.<*> (Object x forall a. FromJSON a => Object -> Key -> Parser (Maybe a) Data..:? Key "status") ) instance Prelude.Hashable AccountLevelBpaSync where hashWithSalt :: Int -> AccountLevelBpaSync -> Int hashWithSalt Int _salt AccountLevelBpaSync' {Maybe Bool Maybe POSIX Maybe AccountLevelBpaSyncStatus Maybe BPAStatusMessage status :: Maybe AccountLevelBpaSyncStatus message :: Maybe BPAStatusMessage lastSyncedAt :: Maybe POSIX bpaImpactsLightsail :: Maybe Bool $sel:status:AccountLevelBpaSync' :: AccountLevelBpaSync -> Maybe AccountLevelBpaSyncStatus $sel:message:AccountLevelBpaSync' :: AccountLevelBpaSync -> Maybe BPAStatusMessage $sel:lastSyncedAt:AccountLevelBpaSync' :: AccountLevelBpaSync -> Maybe POSIX $sel:bpaImpactsLightsail:AccountLevelBpaSync' :: AccountLevelBpaSync -> Maybe Bool ..} = Int _salt forall a. Hashable a => Int -> a -> Int `Prelude.hashWithSalt` Maybe Bool bpaImpactsLightsail forall a. Hashable a => Int -> a -> Int `Prelude.hashWithSalt` Maybe POSIX lastSyncedAt forall a. Hashable a => Int -> a -> Int `Prelude.hashWithSalt` Maybe BPAStatusMessage message forall a. Hashable a => Int -> a -> Int `Prelude.hashWithSalt` Maybe AccountLevelBpaSyncStatus status instance Prelude.NFData AccountLevelBpaSync where rnf :: AccountLevelBpaSync -> () rnf AccountLevelBpaSync' {Maybe Bool Maybe POSIX Maybe AccountLevelBpaSyncStatus Maybe BPAStatusMessage status :: Maybe AccountLevelBpaSyncStatus message :: Maybe BPAStatusMessage lastSyncedAt :: Maybe POSIX bpaImpactsLightsail :: Maybe Bool $sel:status:AccountLevelBpaSync' :: AccountLevelBpaSync -> Maybe AccountLevelBpaSyncStatus $sel:message:AccountLevelBpaSync' :: AccountLevelBpaSync -> Maybe BPAStatusMessage $sel:lastSyncedAt:AccountLevelBpaSync' :: AccountLevelBpaSync -> Maybe POSIX $sel:bpaImpactsLightsail:AccountLevelBpaSync' :: AccountLevelBpaSync -> Maybe Bool ..} = forall a. NFData a => a -> () Prelude.rnf Maybe Bool bpaImpactsLightsail seq :: forall a b. a -> b -> b `Prelude.seq` forall a. NFData a => a -> () Prelude.rnf Maybe POSIX lastSyncedAt seq :: forall a b. a -> b -> b `Prelude.seq` forall a. NFData a => a -> () Prelude.rnf Maybe BPAStatusMessage message seq :: forall a b. a -> b -> b `Prelude.seq` forall a. NFData a => a -> () Prelude.rnf Maybe AccountLevelBpaSyncStatus status