{-# 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.RoutingRule
-- 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.RoutingRule 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.Condition
import Amazonka.S3.Types.Redirect

-- | Specifies the redirect behavior and when a redirect is applied. For more
-- information about routing rules, see
-- <https://docs.aws.amazon.com/AmazonS3/latest/dev/how-to-page-redirect.html#advanced-conditional-redirects Configuring advanced conditional redirects>
-- in the /Amazon S3 User Guide/.
--
-- /See:/ 'newRoutingRule' smart constructor.
data RoutingRule = RoutingRule'
  { -- | A container for describing a condition that must be met for the
    -- specified redirect to apply. For example, 1. If request is for pages in
    -- the @\/docs@ folder, redirect to the @\/documents@ folder. 2. If request
    -- results in HTTP error 4xx, redirect request to another host where you
    -- might process the error.
    RoutingRule -> Maybe Condition
condition :: Prelude.Maybe Condition,
    -- | Container for redirect information. You can redirect requests to another
    -- host, to another page, or with another protocol. In the event of an
    -- error, you can specify a different error code to return.
    RoutingRule -> Redirect
redirect :: Redirect
  }
  deriving (RoutingRule -> RoutingRule -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: RoutingRule -> RoutingRule -> Bool
$c/= :: RoutingRule -> RoutingRule -> Bool
== :: RoutingRule -> RoutingRule -> Bool
$c== :: RoutingRule -> RoutingRule -> Bool
Prelude.Eq, ReadPrec [RoutingRule]
ReadPrec RoutingRule
Int -> ReadS RoutingRule
ReadS [RoutingRule]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [RoutingRule]
$creadListPrec :: ReadPrec [RoutingRule]
readPrec :: ReadPrec RoutingRule
$creadPrec :: ReadPrec RoutingRule
readList :: ReadS [RoutingRule]
$creadList :: ReadS [RoutingRule]
readsPrec :: Int -> ReadS RoutingRule
$creadsPrec :: Int -> ReadS RoutingRule
Prelude.Read, Int -> RoutingRule -> ShowS
[RoutingRule] -> ShowS
RoutingRule -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [RoutingRule] -> ShowS
$cshowList :: [RoutingRule] -> ShowS
show :: RoutingRule -> String
$cshow :: RoutingRule -> String
showsPrec :: Int -> RoutingRule -> ShowS
$cshowsPrec :: Int -> RoutingRule -> ShowS
Prelude.Show, forall x. Rep RoutingRule x -> RoutingRule
forall x. RoutingRule -> Rep RoutingRule x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep RoutingRule x -> RoutingRule
$cfrom :: forall x. RoutingRule -> Rep RoutingRule x
Prelude.Generic)

-- |
-- Create a value of 'RoutingRule' 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:
--
-- 'condition', 'routingRule_condition' - A container for describing a condition that must be met for the
-- specified redirect to apply. For example, 1. If request is for pages in
-- the @\/docs@ folder, redirect to the @\/documents@ folder. 2. If request
-- results in HTTP error 4xx, redirect request to another host where you
-- might process the error.
--
-- 'redirect', 'routingRule_redirect' - Container for redirect information. You can redirect requests to another
-- host, to another page, or with another protocol. In the event of an
-- error, you can specify a different error code to return.
newRoutingRule ::
  -- | 'redirect'
  Redirect ->
  RoutingRule
newRoutingRule :: Redirect -> RoutingRule
newRoutingRule Redirect
pRedirect_ =
  RoutingRule'
    { $sel:condition:RoutingRule' :: Maybe Condition
condition = forall a. Maybe a
Prelude.Nothing,
      $sel:redirect:RoutingRule' :: Redirect
redirect = Redirect
pRedirect_
    }

-- | A container for describing a condition that must be met for the
-- specified redirect to apply. For example, 1. If request is for pages in
-- the @\/docs@ folder, redirect to the @\/documents@ folder. 2. If request
-- results in HTTP error 4xx, redirect request to another host where you
-- might process the error.
routingRule_condition :: Lens.Lens' RoutingRule (Prelude.Maybe Condition)
routingRule_condition :: Lens' RoutingRule (Maybe Condition)
routingRule_condition = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RoutingRule' {Maybe Condition
condition :: Maybe Condition
$sel:condition:RoutingRule' :: RoutingRule -> Maybe Condition
condition} -> Maybe Condition
condition) (\s :: RoutingRule
s@RoutingRule' {} Maybe Condition
a -> RoutingRule
s {$sel:condition:RoutingRule' :: Maybe Condition
condition = Maybe Condition
a} :: RoutingRule)

-- | Container for redirect information. You can redirect requests to another
-- host, to another page, or with another protocol. In the event of an
-- error, you can specify a different error code to return.
routingRule_redirect :: Lens.Lens' RoutingRule Redirect
routingRule_redirect :: Lens' RoutingRule Redirect
routingRule_redirect = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\RoutingRule' {Redirect
redirect :: Redirect
$sel:redirect:RoutingRule' :: RoutingRule -> Redirect
redirect} -> Redirect
redirect) (\s :: RoutingRule
s@RoutingRule' {} Redirect
a -> RoutingRule
s {$sel:redirect:RoutingRule' :: Redirect
redirect = Redirect
a} :: RoutingRule)

instance Data.FromXML RoutingRule where
  parseXML :: [Node] -> Either String RoutingRule
parseXML [Node]
x =
    Maybe Condition -> Redirect -> RoutingRule
RoutingRule'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Condition")
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"Redirect")

instance Prelude.Hashable RoutingRule where
  hashWithSalt :: Int -> RoutingRule -> Int
hashWithSalt Int
_salt RoutingRule' {Maybe Condition
Redirect
redirect :: Redirect
condition :: Maybe Condition
$sel:redirect:RoutingRule' :: RoutingRule -> Redirect
$sel:condition:RoutingRule' :: RoutingRule -> Maybe Condition
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Condition
condition
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Redirect
redirect

instance Prelude.NFData RoutingRule where
  rnf :: RoutingRule -> ()
rnf RoutingRule' {Maybe Condition
Redirect
redirect :: Redirect
condition :: Maybe Condition
$sel:redirect:RoutingRule' :: RoutingRule -> Redirect
$sel:condition:RoutingRule' :: RoutingRule -> Maybe Condition
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Condition
condition
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Redirect
redirect

instance Data.ToXML RoutingRule where
  toXML :: RoutingRule -> XML
toXML RoutingRule' {Maybe Condition
Redirect
redirect :: Redirect
condition :: Maybe Condition
$sel:redirect:RoutingRule' :: RoutingRule -> Redirect
$sel:condition:RoutingRule' :: RoutingRule -> Maybe Condition
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ Name
"Condition" forall a. ToXML a => Name -> a -> XML
Data.@= Maybe Condition
condition,
        Name
"Redirect" forall a. ToXML a => Name -> a -> XML
Data.@= Redirect
redirect
      ]