{-# 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.Bucket
-- 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.Bucket 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.AccessRules
import Amazonka.Lightsail.Types.BucketAccessLogConfig
import Amazonka.Lightsail.Types.BucketState
import Amazonka.Lightsail.Types.ResourceLocation
import Amazonka.Lightsail.Types.ResourceReceivingAccess
import Amazonka.Lightsail.Types.Tag
import qualified Amazonka.Prelude as Prelude

-- | Describes an Amazon Lightsail bucket.
--
-- /See:/ 'newBucket' smart constructor.
data Bucket = Bucket'
  { -- | Indicates whether the bundle that is currently applied to a bucket can
    -- be changed to another bundle.
    --
    -- You can update a bucket\'s bundle only one time within a monthly Amazon
    -- Web Services billing cycle.
    --
    -- Use the
    -- <https://docs.aws.amazon.com/lightsail/2016-11-28/api-reference/API_UpdateBucketBundle.html UpdateBucketBundle>
    -- action to change a bucket\'s bundle.
    Bucket -> Maybe Bool
ableToUpdateBundle :: Prelude.Maybe Prelude.Bool,
    -- | An object that describes the access log configuration for the bucket.
    Bucket -> Maybe BucketAccessLogConfig
accessLogConfig :: Prelude.Maybe BucketAccessLogConfig,
    -- | An object that describes the access rules of the bucket.
    Bucket -> Maybe AccessRules
accessRules :: Prelude.Maybe AccessRules,
    -- | The Amazon Resource Name (ARN) of the bucket.
    Bucket -> Maybe Text
arn :: Prelude.Maybe Prelude.Text,
    -- | The ID of the bundle currently applied to the bucket.
    --
    -- A bucket bundle specifies the monthly cost, storage space, and data
    -- transfer quota for a bucket.
    --
    -- Use the
    -- <https://docs.aws.amazon.com/lightsail/2016-11-28/api-reference/API_UpdateBucketBundle.html UpdateBucketBundle>
    -- action to change the bundle of a bucket.
    Bucket -> Maybe Text
bundleId :: Prelude.Maybe Prelude.Text,
    -- | The timestamp when the distribution was created.
    Bucket -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | An object that describes the location of the bucket, such as the Amazon
    -- Web Services Region and Availability Zone.
    Bucket -> Maybe ResourceLocation
location :: Prelude.Maybe ResourceLocation,
    -- | The name of the bucket.
    Bucket -> Maybe Text
name :: Prelude.Maybe Prelude.Text,
    -- | Indicates whether object versioning is enabled for the bucket.
    --
    -- The following options can be configured:
    --
    -- -   @Enabled@ - Object versioning is enabled.
    --
    -- -   @Suspended@ - Object versioning was previously enabled but is
    --     currently suspended. Existing object versions are retained.
    --
    -- -   @NeverEnabled@ - Object versioning has never been enabled.
    Bucket -> Maybe Text
objectVersioning :: Prelude.Maybe Prelude.Text,
    -- | An array of strings that specify the Amazon Web Services account IDs
    -- that have read-only access to the bucket.
    Bucket -> Maybe [Text]
readonlyAccessAccounts :: Prelude.Maybe [Prelude.Text],
    -- | The Lightsail resource type of the bucket (for example, @Bucket@).
    Bucket -> Maybe Text
resourceType :: Prelude.Maybe Prelude.Text,
    -- | An array of objects that describe Lightsail instances that have access
    -- to the bucket.
    --
    -- Use the
    -- <https://docs.aws.amazon.com/lightsail/2016-11-28/api-reference/API_SetResourceAccessForBucket.html SetResourceAccessForBucket>
    -- action to update the instances that have access to a bucket.
    Bucket -> Maybe [ResourceReceivingAccess]
resourcesReceivingAccess :: Prelude.Maybe [ResourceReceivingAccess],
    -- | An object that describes the state of the bucket.
    Bucket -> Maybe BucketState
state :: Prelude.Maybe BucketState,
    -- | The support code for a bucket. Include this code in your email to
    -- support when you have questions about a Lightsail bucket. This code
    -- enables our support team to look up your Lightsail information more
    -- easily.
    Bucket -> Maybe Text
supportCode :: Prelude.Maybe Prelude.Text,
    -- | The tag keys and optional values for the bucket. For more information,
    -- see
    -- <https://lightsail.aws.amazon.com/ls/docs/en/articles/amazon-lightsail-tags Tags in Amazon Lightsail>
    -- in the /Amazon Lightsail Developer Guide/.
    Bucket -> Maybe [Tag]
tags :: Prelude.Maybe [Tag],
    -- | The URL of the bucket.
    Bucket -> Maybe Text
url :: Prelude.Maybe Prelude.Text
  }
  deriving (Bucket -> Bucket -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Bucket -> Bucket -> Bool
$c/= :: Bucket -> Bucket -> Bool
== :: Bucket -> Bucket -> Bool
$c== :: Bucket -> Bucket -> Bool
Prelude.Eq, ReadPrec [Bucket]
ReadPrec Bucket
Int -> ReadS Bucket
ReadS [Bucket]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Bucket]
$creadListPrec :: ReadPrec [Bucket]
readPrec :: ReadPrec Bucket
$creadPrec :: ReadPrec Bucket
readList :: ReadS [Bucket]
$creadList :: ReadS [Bucket]
readsPrec :: Int -> ReadS Bucket
$creadsPrec :: Int -> ReadS Bucket
Prelude.Read, Int -> Bucket -> ShowS
[Bucket] -> ShowS
Bucket -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Bucket] -> ShowS
$cshowList :: [Bucket] -> ShowS
show :: Bucket -> String
$cshow :: Bucket -> String
showsPrec :: Int -> Bucket -> ShowS
$cshowsPrec :: Int -> Bucket -> ShowS
Prelude.Show, forall x. Rep Bucket x -> Bucket
forall x. Bucket -> Rep Bucket x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Bucket x -> Bucket
$cfrom :: forall x. Bucket -> Rep Bucket x
Prelude.Generic)

-- |
-- Create a value of 'Bucket' 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:
--
-- 'ableToUpdateBundle', 'bucket_ableToUpdateBundle' - Indicates whether the bundle that is currently applied to a bucket can
-- be changed to another bundle.
--
-- You can update a bucket\'s bundle only one time within a monthly Amazon
-- Web Services billing cycle.
--
-- Use the
-- <https://docs.aws.amazon.com/lightsail/2016-11-28/api-reference/API_UpdateBucketBundle.html UpdateBucketBundle>
-- action to change a bucket\'s bundle.
--
-- 'accessLogConfig', 'bucket_accessLogConfig' - An object that describes the access log configuration for the bucket.
--
-- 'accessRules', 'bucket_accessRules' - An object that describes the access rules of the bucket.
--
-- 'arn', 'bucket_arn' - The Amazon Resource Name (ARN) of the bucket.
--
-- 'bundleId', 'bucket_bundleId' - The ID of the bundle currently applied to the bucket.
--
-- A bucket bundle specifies the monthly cost, storage space, and data
-- transfer quota for a bucket.
--
-- Use the
-- <https://docs.aws.amazon.com/lightsail/2016-11-28/api-reference/API_UpdateBucketBundle.html UpdateBucketBundle>
-- action to change the bundle of a bucket.
--
-- 'createdAt', 'bucket_createdAt' - The timestamp when the distribution was created.
--
-- 'location', 'bucket_location' - An object that describes the location of the bucket, such as the Amazon
-- Web Services Region and Availability Zone.
--
-- 'name', 'bucket_name' - The name of the bucket.
--
-- 'objectVersioning', 'bucket_objectVersioning' - Indicates whether object versioning is enabled for the bucket.
--
-- The following options can be configured:
--
-- -   @Enabled@ - Object versioning is enabled.
--
-- -   @Suspended@ - Object versioning was previously enabled but is
--     currently suspended. Existing object versions are retained.
--
-- -   @NeverEnabled@ - Object versioning has never been enabled.
--
-- 'readonlyAccessAccounts', 'bucket_readonlyAccessAccounts' - An array of strings that specify the Amazon Web Services account IDs
-- that have read-only access to the bucket.
--
-- 'resourceType', 'bucket_resourceType' - The Lightsail resource type of the bucket (for example, @Bucket@).
--
-- 'resourcesReceivingAccess', 'bucket_resourcesReceivingAccess' - An array of objects that describe Lightsail instances that have access
-- to the bucket.
--
-- Use the
-- <https://docs.aws.amazon.com/lightsail/2016-11-28/api-reference/API_SetResourceAccessForBucket.html SetResourceAccessForBucket>
-- action to update the instances that have access to a bucket.
--
-- 'state', 'bucket_state' - An object that describes the state of the bucket.
--
-- 'supportCode', 'bucket_supportCode' - The support code for a bucket. Include this code in your email to
-- support when you have questions about a Lightsail bucket. This code
-- enables our support team to look up your Lightsail information more
-- easily.
--
-- 'tags', 'bucket_tags' - The tag keys and optional values for the bucket. For more information,
-- see
-- <https://lightsail.aws.amazon.com/ls/docs/en/articles/amazon-lightsail-tags Tags in Amazon Lightsail>
-- in the /Amazon Lightsail Developer Guide/.
--
-- 'url', 'bucket_url' - The URL of the bucket.
newBucket ::
  Bucket
newBucket :: Bucket
newBucket =
  Bucket'
    { $sel:ableToUpdateBundle:Bucket' :: Maybe Bool
ableToUpdateBundle = forall a. Maybe a
Prelude.Nothing,
      $sel:accessLogConfig:Bucket' :: Maybe BucketAccessLogConfig
accessLogConfig = forall a. Maybe a
Prelude.Nothing,
      $sel:accessRules:Bucket' :: Maybe AccessRules
accessRules = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:Bucket' :: Maybe Text
arn = forall a. Maybe a
Prelude.Nothing,
      $sel:bundleId:Bucket' :: Maybe Text
bundleId = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:Bucket' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:location:Bucket' :: Maybe ResourceLocation
location = forall a. Maybe a
Prelude.Nothing,
      $sel:name:Bucket' :: Maybe Text
name = forall a. Maybe a
Prelude.Nothing,
      $sel:objectVersioning:Bucket' :: Maybe Text
objectVersioning = forall a. Maybe a
Prelude.Nothing,
      $sel:readonlyAccessAccounts:Bucket' :: Maybe [Text]
readonlyAccessAccounts = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceType:Bucket' :: Maybe Text
resourceType = forall a. Maybe a
Prelude.Nothing,
      $sel:resourcesReceivingAccess:Bucket' :: Maybe [ResourceReceivingAccess]
resourcesReceivingAccess = forall a. Maybe a
Prelude.Nothing,
      $sel:state:Bucket' :: Maybe BucketState
state = forall a. Maybe a
Prelude.Nothing,
      $sel:supportCode:Bucket' :: Maybe Text
supportCode = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:Bucket' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:url:Bucket' :: Maybe Text
url = forall a. Maybe a
Prelude.Nothing
    }

-- | Indicates whether the bundle that is currently applied to a bucket can
-- be changed to another bundle.
--
-- You can update a bucket\'s bundle only one time within a monthly Amazon
-- Web Services billing cycle.
--
-- Use the
-- <https://docs.aws.amazon.com/lightsail/2016-11-28/api-reference/API_UpdateBucketBundle.html UpdateBucketBundle>
-- action to change a bucket\'s bundle.
bucket_ableToUpdateBundle :: Lens.Lens' Bucket (Prelude.Maybe Prelude.Bool)
bucket_ableToUpdateBundle :: Lens' Bucket (Maybe Bool)
bucket_ableToUpdateBundle = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe Bool
ableToUpdateBundle :: Maybe Bool
$sel:ableToUpdateBundle:Bucket' :: Bucket -> Maybe Bool
ableToUpdateBundle} -> Maybe Bool
ableToUpdateBundle) (\s :: Bucket
s@Bucket' {} Maybe Bool
a -> Bucket
s {$sel:ableToUpdateBundle:Bucket' :: Maybe Bool
ableToUpdateBundle = Maybe Bool
a} :: Bucket)

-- | An object that describes the access log configuration for the bucket.
bucket_accessLogConfig :: Lens.Lens' Bucket (Prelude.Maybe BucketAccessLogConfig)
bucket_accessLogConfig :: Lens' Bucket (Maybe BucketAccessLogConfig)
bucket_accessLogConfig = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe BucketAccessLogConfig
accessLogConfig :: Maybe BucketAccessLogConfig
$sel:accessLogConfig:Bucket' :: Bucket -> Maybe BucketAccessLogConfig
accessLogConfig} -> Maybe BucketAccessLogConfig
accessLogConfig) (\s :: Bucket
s@Bucket' {} Maybe BucketAccessLogConfig
a -> Bucket
s {$sel:accessLogConfig:Bucket' :: Maybe BucketAccessLogConfig
accessLogConfig = Maybe BucketAccessLogConfig
a} :: Bucket)

-- | An object that describes the access rules of the bucket.
bucket_accessRules :: Lens.Lens' Bucket (Prelude.Maybe AccessRules)
bucket_accessRules :: Lens' Bucket (Maybe AccessRules)
bucket_accessRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe AccessRules
accessRules :: Maybe AccessRules
$sel:accessRules:Bucket' :: Bucket -> Maybe AccessRules
accessRules} -> Maybe AccessRules
accessRules) (\s :: Bucket
s@Bucket' {} Maybe AccessRules
a -> Bucket
s {$sel:accessRules:Bucket' :: Maybe AccessRules
accessRules = Maybe AccessRules
a} :: Bucket)

-- | The Amazon Resource Name (ARN) of the bucket.
bucket_arn :: Lens.Lens' Bucket (Prelude.Maybe Prelude.Text)
bucket_arn :: Lens' Bucket (Maybe Text)
bucket_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe Text
arn :: Maybe Text
$sel:arn:Bucket' :: Bucket -> Maybe Text
arn} -> Maybe Text
arn) (\s :: Bucket
s@Bucket' {} Maybe Text
a -> Bucket
s {$sel:arn:Bucket' :: Maybe Text
arn = Maybe Text
a} :: Bucket)

-- | The ID of the bundle currently applied to the bucket.
--
-- A bucket bundle specifies the monthly cost, storage space, and data
-- transfer quota for a bucket.
--
-- Use the
-- <https://docs.aws.amazon.com/lightsail/2016-11-28/api-reference/API_UpdateBucketBundle.html UpdateBucketBundle>
-- action to change the bundle of a bucket.
bucket_bundleId :: Lens.Lens' Bucket (Prelude.Maybe Prelude.Text)
bucket_bundleId :: Lens' Bucket (Maybe Text)
bucket_bundleId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe Text
bundleId :: Maybe Text
$sel:bundleId:Bucket' :: Bucket -> Maybe Text
bundleId} -> Maybe Text
bundleId) (\s :: Bucket
s@Bucket' {} Maybe Text
a -> Bucket
s {$sel:bundleId:Bucket' :: Maybe Text
bundleId = Maybe Text
a} :: Bucket)

-- | The timestamp when the distribution was created.
bucket_createdAt :: Lens.Lens' Bucket (Prelude.Maybe Prelude.UTCTime)
bucket_createdAt :: Lens' Bucket (Maybe UTCTime)
bucket_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:Bucket' :: Bucket -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: Bucket
s@Bucket' {} Maybe POSIX
a -> Bucket
s {$sel:createdAt:Bucket' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: Bucket) 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

-- | An object that describes the location of the bucket, such as the Amazon
-- Web Services Region and Availability Zone.
bucket_location :: Lens.Lens' Bucket (Prelude.Maybe ResourceLocation)
bucket_location :: Lens' Bucket (Maybe ResourceLocation)
bucket_location = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe ResourceLocation
location :: Maybe ResourceLocation
$sel:location:Bucket' :: Bucket -> Maybe ResourceLocation
location} -> Maybe ResourceLocation
location) (\s :: Bucket
s@Bucket' {} Maybe ResourceLocation
a -> Bucket
s {$sel:location:Bucket' :: Maybe ResourceLocation
location = Maybe ResourceLocation
a} :: Bucket)

-- | The name of the bucket.
bucket_name :: Lens.Lens' Bucket (Prelude.Maybe Prelude.Text)
bucket_name :: Lens' Bucket (Maybe Text)
bucket_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe Text
name :: Maybe Text
$sel:name:Bucket' :: Bucket -> Maybe Text
name} -> Maybe Text
name) (\s :: Bucket
s@Bucket' {} Maybe Text
a -> Bucket
s {$sel:name:Bucket' :: Maybe Text
name = Maybe Text
a} :: Bucket)

-- | Indicates whether object versioning is enabled for the bucket.
--
-- The following options can be configured:
--
-- -   @Enabled@ - Object versioning is enabled.
--
-- -   @Suspended@ - Object versioning was previously enabled but is
--     currently suspended. Existing object versions are retained.
--
-- -   @NeverEnabled@ - Object versioning has never been enabled.
bucket_objectVersioning :: Lens.Lens' Bucket (Prelude.Maybe Prelude.Text)
bucket_objectVersioning :: Lens' Bucket (Maybe Text)
bucket_objectVersioning = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe Text
objectVersioning :: Maybe Text
$sel:objectVersioning:Bucket' :: Bucket -> Maybe Text
objectVersioning} -> Maybe Text
objectVersioning) (\s :: Bucket
s@Bucket' {} Maybe Text
a -> Bucket
s {$sel:objectVersioning:Bucket' :: Maybe Text
objectVersioning = Maybe Text
a} :: Bucket)

-- | An array of strings that specify the Amazon Web Services account IDs
-- that have read-only access to the bucket.
bucket_readonlyAccessAccounts :: Lens.Lens' Bucket (Prelude.Maybe [Prelude.Text])
bucket_readonlyAccessAccounts :: Lens' Bucket (Maybe [Text])
bucket_readonlyAccessAccounts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe [Text]
readonlyAccessAccounts :: Maybe [Text]
$sel:readonlyAccessAccounts:Bucket' :: Bucket -> Maybe [Text]
readonlyAccessAccounts} -> Maybe [Text]
readonlyAccessAccounts) (\s :: Bucket
s@Bucket' {} Maybe [Text]
a -> Bucket
s {$sel:readonlyAccessAccounts:Bucket' :: Maybe [Text]
readonlyAccessAccounts = Maybe [Text]
a} :: Bucket) 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 Lightsail resource type of the bucket (for example, @Bucket@).
bucket_resourceType :: Lens.Lens' Bucket (Prelude.Maybe Prelude.Text)
bucket_resourceType :: Lens' Bucket (Maybe Text)
bucket_resourceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe Text
resourceType :: Maybe Text
$sel:resourceType:Bucket' :: Bucket -> Maybe Text
resourceType} -> Maybe Text
resourceType) (\s :: Bucket
s@Bucket' {} Maybe Text
a -> Bucket
s {$sel:resourceType:Bucket' :: Maybe Text
resourceType = Maybe Text
a} :: Bucket)

-- | An array of objects that describe Lightsail instances that have access
-- to the bucket.
--
-- Use the
-- <https://docs.aws.amazon.com/lightsail/2016-11-28/api-reference/API_SetResourceAccessForBucket.html SetResourceAccessForBucket>
-- action to update the instances that have access to a bucket.
bucket_resourcesReceivingAccess :: Lens.Lens' Bucket (Prelude.Maybe [ResourceReceivingAccess])
bucket_resourcesReceivingAccess :: Lens' Bucket (Maybe [ResourceReceivingAccess])
bucket_resourcesReceivingAccess = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe [ResourceReceivingAccess]
resourcesReceivingAccess :: Maybe [ResourceReceivingAccess]
$sel:resourcesReceivingAccess:Bucket' :: Bucket -> Maybe [ResourceReceivingAccess]
resourcesReceivingAccess} -> Maybe [ResourceReceivingAccess]
resourcesReceivingAccess) (\s :: Bucket
s@Bucket' {} Maybe [ResourceReceivingAccess]
a -> Bucket
s {$sel:resourcesReceivingAccess:Bucket' :: Maybe [ResourceReceivingAccess]
resourcesReceivingAccess = Maybe [ResourceReceivingAccess]
a} :: Bucket) 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

-- | An object that describes the state of the bucket.
bucket_state :: Lens.Lens' Bucket (Prelude.Maybe BucketState)
bucket_state :: Lens' Bucket (Maybe BucketState)
bucket_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe BucketState
state :: Maybe BucketState
$sel:state:Bucket' :: Bucket -> Maybe BucketState
state} -> Maybe BucketState
state) (\s :: Bucket
s@Bucket' {} Maybe BucketState
a -> Bucket
s {$sel:state:Bucket' :: Maybe BucketState
state = Maybe BucketState
a} :: Bucket)

-- | The support code for a bucket. Include this code in your email to
-- support when you have questions about a Lightsail bucket. This code
-- enables our support team to look up your Lightsail information more
-- easily.
bucket_supportCode :: Lens.Lens' Bucket (Prelude.Maybe Prelude.Text)
bucket_supportCode :: Lens' Bucket (Maybe Text)
bucket_supportCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe Text
supportCode :: Maybe Text
$sel:supportCode:Bucket' :: Bucket -> Maybe Text
supportCode} -> Maybe Text
supportCode) (\s :: Bucket
s@Bucket' {} Maybe Text
a -> Bucket
s {$sel:supportCode:Bucket' :: Maybe Text
supportCode = Maybe Text
a} :: Bucket)

-- | The tag keys and optional values for the bucket. For more information,
-- see
-- <https://lightsail.aws.amazon.com/ls/docs/en/articles/amazon-lightsail-tags Tags in Amazon Lightsail>
-- in the /Amazon Lightsail Developer Guide/.
bucket_tags :: Lens.Lens' Bucket (Prelude.Maybe [Tag])
bucket_tags :: Lens' Bucket (Maybe [Tag])
bucket_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:Bucket' :: Bucket -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: Bucket
s@Bucket' {} Maybe [Tag]
a -> Bucket
s {$sel:tags:Bucket' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: Bucket) 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 URL of the bucket.
bucket_url :: Lens.Lens' Bucket (Prelude.Maybe Prelude.Text)
bucket_url :: Lens' Bucket (Maybe Text)
bucket_url = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Bucket' {Maybe Text
url :: Maybe Text
$sel:url:Bucket' :: Bucket -> Maybe Text
url} -> Maybe Text
url) (\s :: Bucket
s@Bucket' {} Maybe Text
a -> Bucket
s {$sel:url:Bucket' :: Maybe Text
url = Maybe Text
a} :: Bucket)

instance Data.FromJSON Bucket where
  parseJSON :: Value -> Parser Bucket
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Bucket"
      ( \Object
x ->
          Maybe Bool
-> Maybe BucketAccessLogConfig
-> Maybe AccessRules
-> Maybe Text
-> Maybe Text
-> Maybe POSIX
-> Maybe ResourceLocation
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe [ResourceReceivingAccess]
-> Maybe BucketState
-> Maybe Text
-> Maybe [Tag]
-> Maybe Text
-> Bucket
Bucket'
            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
"ableToUpdateBundle")
            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
"accessLogConfig")
            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
"accessRules")
            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
"arn")
            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
"bundleId")
            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
"createdAt")
            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
"location")
            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
"name")
            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
"objectVersioning")
            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
"readonlyAccessAccounts"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"resourceType")
            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
"resourcesReceivingAccess"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"state")
            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
"supportCode")
            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
"tags" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= 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 -> Parser (Maybe a)
Data..:? Key
"url")
      )

instance Prelude.Hashable Bucket where
  hashWithSalt :: Int -> Bucket -> Int
hashWithSalt Int
_salt Bucket' {Maybe Bool
Maybe [Text]
Maybe [ResourceReceivingAccess]
Maybe [Tag]
Maybe Text
Maybe POSIX
Maybe AccessRules
Maybe BucketAccessLogConfig
Maybe BucketState
Maybe ResourceLocation
url :: Maybe Text
tags :: Maybe [Tag]
supportCode :: Maybe Text
state :: Maybe BucketState
resourcesReceivingAccess :: Maybe [ResourceReceivingAccess]
resourceType :: Maybe Text
readonlyAccessAccounts :: Maybe [Text]
objectVersioning :: Maybe Text
name :: Maybe Text
location :: Maybe ResourceLocation
createdAt :: Maybe POSIX
bundleId :: Maybe Text
arn :: Maybe Text
accessRules :: Maybe AccessRules
accessLogConfig :: Maybe BucketAccessLogConfig
ableToUpdateBundle :: Maybe Bool
$sel:url:Bucket' :: Bucket -> Maybe Text
$sel:tags:Bucket' :: Bucket -> Maybe [Tag]
$sel:supportCode:Bucket' :: Bucket -> Maybe Text
$sel:state:Bucket' :: Bucket -> Maybe BucketState
$sel:resourcesReceivingAccess:Bucket' :: Bucket -> Maybe [ResourceReceivingAccess]
$sel:resourceType:Bucket' :: Bucket -> Maybe Text
$sel:readonlyAccessAccounts:Bucket' :: Bucket -> Maybe [Text]
$sel:objectVersioning:Bucket' :: Bucket -> Maybe Text
$sel:name:Bucket' :: Bucket -> Maybe Text
$sel:location:Bucket' :: Bucket -> Maybe ResourceLocation
$sel:createdAt:Bucket' :: Bucket -> Maybe POSIX
$sel:bundleId:Bucket' :: Bucket -> Maybe Text
$sel:arn:Bucket' :: Bucket -> Maybe Text
$sel:accessRules:Bucket' :: Bucket -> Maybe AccessRules
$sel:accessLogConfig:Bucket' :: Bucket -> Maybe BucketAccessLogConfig
$sel:ableToUpdateBundle:Bucket' :: Bucket -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
ableToUpdateBundle
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BucketAccessLogConfig
accessLogConfig
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AccessRules
accessRules
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
bundleId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ResourceLocation
location
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
objectVersioning
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
readonlyAccessAccounts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
resourceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ResourceReceivingAccess]
resourcesReceivingAccess
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe BucketState
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
supportCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
url

instance Prelude.NFData Bucket where
  rnf :: Bucket -> ()
rnf Bucket' {Maybe Bool
Maybe [Text]
Maybe [ResourceReceivingAccess]
Maybe [Tag]
Maybe Text
Maybe POSIX
Maybe AccessRules
Maybe BucketAccessLogConfig
Maybe BucketState
Maybe ResourceLocation
url :: Maybe Text
tags :: Maybe [Tag]
supportCode :: Maybe Text
state :: Maybe BucketState
resourcesReceivingAccess :: Maybe [ResourceReceivingAccess]
resourceType :: Maybe Text
readonlyAccessAccounts :: Maybe [Text]
objectVersioning :: Maybe Text
name :: Maybe Text
location :: Maybe ResourceLocation
createdAt :: Maybe POSIX
bundleId :: Maybe Text
arn :: Maybe Text
accessRules :: Maybe AccessRules
accessLogConfig :: Maybe BucketAccessLogConfig
ableToUpdateBundle :: Maybe Bool
$sel:url:Bucket' :: Bucket -> Maybe Text
$sel:tags:Bucket' :: Bucket -> Maybe [Tag]
$sel:supportCode:Bucket' :: Bucket -> Maybe Text
$sel:state:Bucket' :: Bucket -> Maybe BucketState
$sel:resourcesReceivingAccess:Bucket' :: Bucket -> Maybe [ResourceReceivingAccess]
$sel:resourceType:Bucket' :: Bucket -> Maybe Text
$sel:readonlyAccessAccounts:Bucket' :: Bucket -> Maybe [Text]
$sel:objectVersioning:Bucket' :: Bucket -> Maybe Text
$sel:name:Bucket' :: Bucket -> Maybe Text
$sel:location:Bucket' :: Bucket -> Maybe ResourceLocation
$sel:createdAt:Bucket' :: Bucket -> Maybe POSIX
$sel:bundleId:Bucket' :: Bucket -> Maybe Text
$sel:arn:Bucket' :: Bucket -> Maybe Text
$sel:accessRules:Bucket' :: Bucket -> Maybe AccessRules
$sel:accessLogConfig:Bucket' :: Bucket -> Maybe BucketAccessLogConfig
$sel:ableToUpdateBundle:Bucket' :: Bucket -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
ableToUpdateBundle
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BucketAccessLogConfig
accessLogConfig
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AccessRules
accessRules
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
bundleId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ResourceLocation
location
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
objectVersioning
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
readonlyAccessAccounts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
resourceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [ResourceReceivingAccess]
resourcesReceivingAccess
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe BucketState
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
supportCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
url