{-# 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.S3.Types.WebsiteConfiguration
-- 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.S3.Types.WebsiteConfiguration where

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 Amazonka.S3.Internal
import Amazonka.S3.Types.ErrorDocument
import Amazonka.S3.Types.IndexDocument
import Amazonka.S3.Types.RedirectAllRequestsTo
import Amazonka.S3.Types.RoutingRule

-- | Specifies website configuration parameters for an Amazon S3 bucket.
--
-- /See:/ 'newWebsiteConfiguration' smart constructor.
data WebsiteConfiguration = WebsiteConfiguration'
  { -- | The name of the error document for the website.
    WebsiteConfiguration -> Maybe ErrorDocument
errorDocument :: Prelude.Maybe ErrorDocument,
    -- | The name of the index document for the website.
    WebsiteConfiguration -> Maybe IndexDocument
indexDocument :: Prelude.Maybe IndexDocument,
    -- | The redirect behavior for every request to this bucket\'s website
    -- endpoint.
    --
    -- If you specify this property, you can\'t specify any other property.
    WebsiteConfiguration -> Maybe RedirectAllRequestsTo
redirectAllRequestsTo :: Prelude.Maybe RedirectAllRequestsTo,
    -- | Rules that define when a redirect is applied and the redirect behavior.
    WebsiteConfiguration -> Maybe [RoutingRule]
routingRules :: Prelude.Maybe [RoutingRule]
  }
  deriving (WebsiteConfiguration -> WebsiteConfiguration -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: WebsiteConfiguration -> WebsiteConfiguration -> Bool
$c/= :: WebsiteConfiguration -> WebsiteConfiguration -> Bool
== :: WebsiteConfiguration -> WebsiteConfiguration -> Bool
$c== :: WebsiteConfiguration -> WebsiteConfiguration -> Bool
Prelude.Eq, ReadPrec [WebsiteConfiguration]
ReadPrec WebsiteConfiguration
Int -> ReadS WebsiteConfiguration
ReadS [WebsiteConfiguration]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [WebsiteConfiguration]
$creadListPrec :: ReadPrec [WebsiteConfiguration]
readPrec :: ReadPrec WebsiteConfiguration
$creadPrec :: ReadPrec WebsiteConfiguration
readList :: ReadS [WebsiteConfiguration]
$creadList :: ReadS [WebsiteConfiguration]
readsPrec :: Int -> ReadS WebsiteConfiguration
$creadsPrec :: Int -> ReadS WebsiteConfiguration
Prelude.Read, Int -> WebsiteConfiguration -> ShowS
[WebsiteConfiguration] -> ShowS
WebsiteConfiguration -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [WebsiteConfiguration] -> ShowS
$cshowList :: [WebsiteConfiguration] -> ShowS
show :: WebsiteConfiguration -> String
$cshow :: WebsiteConfiguration -> String
showsPrec :: Int -> WebsiteConfiguration -> ShowS
$cshowsPrec :: Int -> WebsiteConfiguration -> ShowS
Prelude.Show, forall x. Rep WebsiteConfiguration x -> WebsiteConfiguration
forall x. WebsiteConfiguration -> Rep WebsiteConfiguration x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep WebsiteConfiguration x -> WebsiteConfiguration
$cfrom :: forall x. WebsiteConfiguration -> Rep WebsiteConfiguration x
Prelude.Generic)

-- |
-- Create a value of 'WebsiteConfiguration' 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:
--
-- 'errorDocument', 'websiteConfiguration_errorDocument' - The name of the error document for the website.
--
-- 'indexDocument', 'websiteConfiguration_indexDocument' - The name of the index document for the website.
--
-- 'redirectAllRequestsTo', 'websiteConfiguration_redirectAllRequestsTo' - The redirect behavior for every request to this bucket\'s website
-- endpoint.
--
-- If you specify this property, you can\'t specify any other property.
--
-- 'routingRules', 'websiteConfiguration_routingRules' - Rules that define when a redirect is applied and the redirect behavior.
newWebsiteConfiguration ::
  WebsiteConfiguration
newWebsiteConfiguration :: WebsiteConfiguration
newWebsiteConfiguration =
  WebsiteConfiguration'
    { $sel:errorDocument:WebsiteConfiguration' :: Maybe ErrorDocument
errorDocument =
        forall a. Maybe a
Prelude.Nothing,
      $sel:indexDocument:WebsiteConfiguration' :: Maybe IndexDocument
indexDocument = forall a. Maybe a
Prelude.Nothing,
      $sel:redirectAllRequestsTo:WebsiteConfiguration' :: Maybe RedirectAllRequestsTo
redirectAllRequestsTo = forall a. Maybe a
Prelude.Nothing,
      $sel:routingRules:WebsiteConfiguration' :: Maybe [RoutingRule]
routingRules = forall a. Maybe a
Prelude.Nothing
    }

-- | The name of the error document for the website.
websiteConfiguration_errorDocument :: Lens.Lens' WebsiteConfiguration (Prelude.Maybe ErrorDocument)
websiteConfiguration_errorDocument :: Lens' WebsiteConfiguration (Maybe ErrorDocument)
websiteConfiguration_errorDocument = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WebsiteConfiguration' {Maybe ErrorDocument
errorDocument :: Maybe ErrorDocument
$sel:errorDocument:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe ErrorDocument
errorDocument} -> Maybe ErrorDocument
errorDocument) (\s :: WebsiteConfiguration
s@WebsiteConfiguration' {} Maybe ErrorDocument
a -> WebsiteConfiguration
s {$sel:errorDocument:WebsiteConfiguration' :: Maybe ErrorDocument
errorDocument = Maybe ErrorDocument
a} :: WebsiteConfiguration)

-- | The name of the index document for the website.
websiteConfiguration_indexDocument :: Lens.Lens' WebsiteConfiguration (Prelude.Maybe IndexDocument)
websiteConfiguration_indexDocument :: Lens' WebsiteConfiguration (Maybe IndexDocument)
websiteConfiguration_indexDocument = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WebsiteConfiguration' {Maybe IndexDocument
indexDocument :: Maybe IndexDocument
$sel:indexDocument:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe IndexDocument
indexDocument} -> Maybe IndexDocument
indexDocument) (\s :: WebsiteConfiguration
s@WebsiteConfiguration' {} Maybe IndexDocument
a -> WebsiteConfiguration
s {$sel:indexDocument:WebsiteConfiguration' :: Maybe IndexDocument
indexDocument = Maybe IndexDocument
a} :: WebsiteConfiguration)

-- | The redirect behavior for every request to this bucket\'s website
-- endpoint.
--
-- If you specify this property, you can\'t specify any other property.
websiteConfiguration_redirectAllRequestsTo :: Lens.Lens' WebsiteConfiguration (Prelude.Maybe RedirectAllRequestsTo)
websiteConfiguration_redirectAllRequestsTo :: Lens' WebsiteConfiguration (Maybe RedirectAllRequestsTo)
websiteConfiguration_redirectAllRequestsTo = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WebsiteConfiguration' {Maybe RedirectAllRequestsTo
redirectAllRequestsTo :: Maybe RedirectAllRequestsTo
$sel:redirectAllRequestsTo:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe RedirectAllRequestsTo
redirectAllRequestsTo} -> Maybe RedirectAllRequestsTo
redirectAllRequestsTo) (\s :: WebsiteConfiguration
s@WebsiteConfiguration' {} Maybe RedirectAllRequestsTo
a -> WebsiteConfiguration
s {$sel:redirectAllRequestsTo:WebsiteConfiguration' :: Maybe RedirectAllRequestsTo
redirectAllRequestsTo = Maybe RedirectAllRequestsTo
a} :: WebsiteConfiguration)

-- | Rules that define when a redirect is applied and the redirect behavior.
websiteConfiguration_routingRules :: Lens.Lens' WebsiteConfiguration (Prelude.Maybe [RoutingRule])
websiteConfiguration_routingRules :: Lens' WebsiteConfiguration (Maybe [RoutingRule])
websiteConfiguration_routingRules = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\WebsiteConfiguration' {Maybe [RoutingRule]
routingRules :: Maybe [RoutingRule]
$sel:routingRules:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe [RoutingRule]
routingRules} -> Maybe [RoutingRule]
routingRules) (\s :: WebsiteConfiguration
s@WebsiteConfiguration' {} Maybe [RoutingRule]
a -> WebsiteConfiguration
s {$sel:routingRules:WebsiteConfiguration' :: Maybe [RoutingRule]
routingRules = Maybe [RoutingRule]
a} :: WebsiteConfiguration) 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

instance Prelude.Hashable WebsiteConfiguration where
  hashWithSalt :: Int -> WebsiteConfiguration -> Int
hashWithSalt Int
_salt WebsiteConfiguration' {Maybe [RoutingRule]
Maybe ErrorDocument
Maybe IndexDocument
Maybe RedirectAllRequestsTo
routingRules :: Maybe [RoutingRule]
redirectAllRequestsTo :: Maybe RedirectAllRequestsTo
indexDocument :: Maybe IndexDocument
errorDocument :: Maybe ErrorDocument
$sel:routingRules:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe [RoutingRule]
$sel:redirectAllRequestsTo:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe RedirectAllRequestsTo
$sel:indexDocument:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe IndexDocument
$sel:errorDocument:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe ErrorDocument
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ErrorDocument
errorDocument
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IndexDocument
indexDocument
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe RedirectAllRequestsTo
redirectAllRequestsTo
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [RoutingRule]
routingRules

instance Prelude.NFData WebsiteConfiguration where
  rnf :: WebsiteConfiguration -> ()
rnf WebsiteConfiguration' {Maybe [RoutingRule]
Maybe ErrorDocument
Maybe IndexDocument
Maybe RedirectAllRequestsTo
routingRules :: Maybe [RoutingRule]
redirectAllRequestsTo :: Maybe RedirectAllRequestsTo
indexDocument :: Maybe IndexDocument
errorDocument :: Maybe ErrorDocument
$sel:routingRules:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe [RoutingRule]
$sel:redirectAllRequestsTo:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe RedirectAllRequestsTo
$sel:indexDocument:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe IndexDocument
$sel:errorDocument:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe ErrorDocument
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ErrorDocument
errorDocument
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IndexDocument
indexDocument
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe RedirectAllRequestsTo
redirectAllRequestsTo
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [RoutingRule]
routingRules

instance Data.ToXML WebsiteConfiguration where
  toXML :: WebsiteConfiguration -> XML
toXML WebsiteConfiguration' {Maybe [RoutingRule]
Maybe ErrorDocument
Maybe IndexDocument
Maybe RedirectAllRequestsTo
routingRules :: Maybe [RoutingRule]
redirectAllRequestsTo :: Maybe RedirectAllRequestsTo
indexDocument :: Maybe IndexDocument
errorDocument :: Maybe ErrorDocument
$sel:routingRules:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe [RoutingRule]
$sel:redirectAllRequestsTo:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe RedirectAllRequestsTo
$sel:indexDocument:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe IndexDocument
$sel:errorDocument:WebsiteConfiguration' :: WebsiteConfiguration -> Maybe ErrorDocument
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"ErrorDocument" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe ErrorDocument
errorDocument,
        Name
"IndexDocument" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe IndexDocument
indexDocument,
        Name
"RedirectAllRequestsTo"
          forall a. ToXML a => Name -> a -> XML
Data.@= Maybe RedirectAllRequestsTo
redirectAllRequestsTo,
        Name
"RoutingRules"
          forall a. ToXML a => Name -> a -> XML
Data.@= forall a. ToXML a => a -> XML
Data.toXML
            ( forall a. (IsList a, ToXML (Item a)) => Name -> a -> XML
Data.toXMLList Name
"RoutingRule"
                forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe [RoutingRule]
routingRules
            )
      ]