{-# 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.ArcZonalShift.StartZonalShift
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- You start a zonal shift to temporarily move load balancer traffic away
-- from an Availability Zone in a AWS Region, to help your application
-- recover immediately, for example, from a developer\'s bad code
-- deployment or from an AWS infrastructure failure in a single
-- Availability Zone. You can start a zonal shift in Route 53 ARC only for
-- managed resources in your account in an AWS Region. Resources are
-- automatically registered with Route 53 ARC by AWS services.
--
-- At this time, you can only start a zonal shift for Network Load
-- Balancers and Application Load Balancers with cross-zone load balancing
-- turned off.
--
-- When you start a zonal shift, traffic for the resource is no longer
-- routed to the Availability Zone. The zonal shift is created immediately
-- in Route 53 ARC. However, it can take a short time, typically up to a
-- few minutes, for existing, in-progress connections in the Availability
-- Zone to complete.
--
-- For more information, see
-- <https://docs.aws.amazon.com/r53recovery/latest/dg/arc-zonal-shift.html Zonal shift>
-- in the Amazon Route 53 Application Recovery Controller Developer Guide.
module Amazonka.ArcZonalShift.StartZonalShift
  ( -- * Creating a Request
    StartZonalShift (..),
    newStartZonalShift,

    -- * Request Lenses
    startZonalShift_awayFrom,
    startZonalShift_comment,
    startZonalShift_expiresIn,
    startZonalShift_resourceIdentifier,

    -- * Destructuring the Response
    ZonalShift (..),
    newZonalShift,

    -- * Response Lenses
    zonalShift_awayFrom,
    zonalShift_comment,
    zonalShift_expiryTime,
    zonalShift_resourceIdentifier,
    zonalShift_startTime,
    zonalShift_status,
    zonalShift_zonalShiftId,
  )
where

import Amazonka.ArcZonalShift.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:/ 'newStartZonalShift' smart constructor.
data StartZonalShift = StartZonalShift'
  { -- | The Availability Zone that traffic is moved away from for a resource
    -- when you start a zonal shift. Until the zonal shift expires or you
    -- cancel it, traffic for the resource is instead moved to other
    -- Availability Zones in the AWS Region.
    StartZonalShift -> Text
awayFrom :: Prelude.Text,
    -- | A comment that you enter about the zonal shift. Only the latest comment
    -- is retained; no comment history is maintained. A new comment overwrites
    -- any existing comment string.
    StartZonalShift -> Text
comment :: Prelude.Text,
    -- | The length of time that you want a zonal shift to be active, which Route
    -- 53 ARC converts to an expiry time (expiration time). Zonal shifts are
    -- temporary. You can set a zonal shift to be active initially for up to
    -- three days (72 hours).
    --
    -- If you want to still keep traffic away from an Availability Zone, you
    -- can update the zonal shift and set a new expiration. You can also cancel
    -- a zonal shift, before it expires, for example, if you\'re ready to
    -- restore traffic to the Availability Zone.
    --
    -- To set a length of time for a zonal shift to be active, specify a whole
    -- number, and then one of the following, with no space:
    --
    -- >  <ul> <li> <p> <b>A lowercase letter m:</b> To specify that the value is in minutes.</p> </li> <li> <p> <b>A lowercase letter h:</b> To specify that the value is in hours.</p> </li> </ul> <p>For example: <code>20h</code> means the zonal shift expires in 20 hours. <code>120m</code> means the zonal shift expires in 120 minutes (2 hours).</p>
    StartZonalShift -> Text
expiresIn :: Prelude.Text,
    -- | The identifier for the resource to include in a zonal shift. The
    -- identifier is the Amazon Resource Name (ARN) for the resource.
    --
    -- At this time, you can only start a zonal shift for Network Load
    -- Balancers and Application Load Balancers with cross-zone load balancing
    -- turned off.
    StartZonalShift -> Text
resourceIdentifier :: Prelude.Text
  }
  deriving (StartZonalShift -> StartZonalShift -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: StartZonalShift -> StartZonalShift -> Bool
$c/= :: StartZonalShift -> StartZonalShift -> Bool
== :: StartZonalShift -> StartZonalShift -> Bool
$c== :: StartZonalShift -> StartZonalShift -> Bool
Prelude.Eq, ReadPrec [StartZonalShift]
ReadPrec StartZonalShift
Int -> ReadS StartZonalShift
ReadS [StartZonalShift]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [StartZonalShift]
$creadListPrec :: ReadPrec [StartZonalShift]
readPrec :: ReadPrec StartZonalShift
$creadPrec :: ReadPrec StartZonalShift
readList :: ReadS [StartZonalShift]
$creadList :: ReadS [StartZonalShift]
readsPrec :: Int -> ReadS StartZonalShift
$creadsPrec :: Int -> ReadS StartZonalShift
Prelude.Read, Int -> StartZonalShift -> ShowS
[StartZonalShift] -> ShowS
StartZonalShift -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [StartZonalShift] -> ShowS
$cshowList :: [StartZonalShift] -> ShowS
show :: StartZonalShift -> String
$cshow :: StartZonalShift -> String
showsPrec :: Int -> StartZonalShift -> ShowS
$cshowsPrec :: Int -> StartZonalShift -> ShowS
Prelude.Show, forall x. Rep StartZonalShift x -> StartZonalShift
forall x. StartZonalShift -> Rep StartZonalShift x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep StartZonalShift x -> StartZonalShift
$cfrom :: forall x. StartZonalShift -> Rep StartZonalShift x
Prelude.Generic)

-- |
-- Create a value of 'StartZonalShift' 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:
--
-- 'awayFrom', 'startZonalShift_awayFrom' - The Availability Zone that traffic is moved away from for a resource
-- when you start a zonal shift. Until the zonal shift expires or you
-- cancel it, traffic for the resource is instead moved to other
-- Availability Zones in the AWS Region.
--
-- 'comment', 'startZonalShift_comment' - A comment that you enter about the zonal shift. Only the latest comment
-- is retained; no comment history is maintained. A new comment overwrites
-- any existing comment string.
--
-- 'expiresIn', 'startZonalShift_expiresIn' - The length of time that you want a zonal shift to be active, which Route
-- 53 ARC converts to an expiry time (expiration time). Zonal shifts are
-- temporary. You can set a zonal shift to be active initially for up to
-- three days (72 hours).
--
-- If you want to still keep traffic away from an Availability Zone, you
-- can update the zonal shift and set a new expiration. You can also cancel
-- a zonal shift, before it expires, for example, if you\'re ready to
-- restore traffic to the Availability Zone.
--
-- To set a length of time for a zonal shift to be active, specify a whole
-- number, and then one of the following, with no space:
--
-- >  <ul> <li> <p> <b>A lowercase letter m:</b> To specify that the value is in minutes.</p> </li> <li> <p> <b>A lowercase letter h:</b> To specify that the value is in hours.</p> </li> </ul> <p>For example: <code>20h</code> means the zonal shift expires in 20 hours. <code>120m</code> means the zonal shift expires in 120 minutes (2 hours).</p>
--
-- 'resourceIdentifier', 'startZonalShift_resourceIdentifier' - The identifier for the resource to include in a zonal shift. The
-- identifier is the Amazon Resource Name (ARN) for the resource.
--
-- At this time, you can only start a zonal shift for Network Load
-- Balancers and Application Load Balancers with cross-zone load balancing
-- turned off.
newStartZonalShift ::
  -- | 'awayFrom'
  Prelude.Text ->
  -- | 'comment'
  Prelude.Text ->
  -- | 'expiresIn'
  Prelude.Text ->
  -- | 'resourceIdentifier'
  Prelude.Text ->
  StartZonalShift
newStartZonalShift :: Text -> Text -> Text -> Text -> StartZonalShift
newStartZonalShift
  Text
pAwayFrom_
  Text
pComment_
  Text
pExpiresIn_
  Text
pResourceIdentifier_ =
    StartZonalShift'
      { $sel:awayFrom:StartZonalShift' :: Text
awayFrom = Text
pAwayFrom_,
        $sel:comment:StartZonalShift' :: Text
comment = Text
pComment_,
        $sel:expiresIn:StartZonalShift' :: Text
expiresIn = Text
pExpiresIn_,
        $sel:resourceIdentifier:StartZonalShift' :: Text
resourceIdentifier = Text
pResourceIdentifier_
      }

-- | The Availability Zone that traffic is moved away from for a resource
-- when you start a zonal shift. Until the zonal shift expires or you
-- cancel it, traffic for the resource is instead moved to other
-- Availability Zones in the AWS Region.
startZonalShift_awayFrom :: Lens.Lens' StartZonalShift Prelude.Text
startZonalShift_awayFrom :: Lens' StartZonalShift Text
startZonalShift_awayFrom = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartZonalShift' {Text
awayFrom :: Text
$sel:awayFrom:StartZonalShift' :: StartZonalShift -> Text
awayFrom} -> Text
awayFrom) (\s :: StartZonalShift
s@StartZonalShift' {} Text
a -> StartZonalShift
s {$sel:awayFrom:StartZonalShift' :: Text
awayFrom = Text
a} :: StartZonalShift)

-- | A comment that you enter about the zonal shift. Only the latest comment
-- is retained; no comment history is maintained. A new comment overwrites
-- any existing comment string.
startZonalShift_comment :: Lens.Lens' StartZonalShift Prelude.Text
startZonalShift_comment :: Lens' StartZonalShift Text
startZonalShift_comment = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartZonalShift' {Text
comment :: Text
$sel:comment:StartZonalShift' :: StartZonalShift -> Text
comment} -> Text
comment) (\s :: StartZonalShift
s@StartZonalShift' {} Text
a -> StartZonalShift
s {$sel:comment:StartZonalShift' :: Text
comment = Text
a} :: StartZonalShift)

-- | The length of time that you want a zonal shift to be active, which Route
-- 53 ARC converts to an expiry time (expiration time). Zonal shifts are
-- temporary. You can set a zonal shift to be active initially for up to
-- three days (72 hours).
--
-- If you want to still keep traffic away from an Availability Zone, you
-- can update the zonal shift and set a new expiration. You can also cancel
-- a zonal shift, before it expires, for example, if you\'re ready to
-- restore traffic to the Availability Zone.
--
-- To set a length of time for a zonal shift to be active, specify a whole
-- number, and then one of the following, with no space:
--
-- >  <ul> <li> <p> <b>A lowercase letter m:</b> To specify that the value is in minutes.</p> </li> <li> <p> <b>A lowercase letter h:</b> To specify that the value is in hours.</p> </li> </ul> <p>For example: <code>20h</code> means the zonal shift expires in 20 hours. <code>120m</code> means the zonal shift expires in 120 minutes (2 hours).</p>
startZonalShift_expiresIn :: Lens.Lens' StartZonalShift Prelude.Text
startZonalShift_expiresIn :: Lens' StartZonalShift Text
startZonalShift_expiresIn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartZonalShift' {Text
expiresIn :: Text
$sel:expiresIn:StartZonalShift' :: StartZonalShift -> Text
expiresIn} -> Text
expiresIn) (\s :: StartZonalShift
s@StartZonalShift' {} Text
a -> StartZonalShift
s {$sel:expiresIn:StartZonalShift' :: Text
expiresIn = Text
a} :: StartZonalShift)

-- | The identifier for the resource to include in a zonal shift. The
-- identifier is the Amazon Resource Name (ARN) for the resource.
--
-- At this time, you can only start a zonal shift for Network Load
-- Balancers and Application Load Balancers with cross-zone load balancing
-- turned off.
startZonalShift_resourceIdentifier :: Lens.Lens' StartZonalShift Prelude.Text
startZonalShift_resourceIdentifier :: Lens' StartZonalShift Text
startZonalShift_resourceIdentifier = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\StartZonalShift' {Text
resourceIdentifier :: Text
$sel:resourceIdentifier:StartZonalShift' :: StartZonalShift -> Text
resourceIdentifier} -> Text
resourceIdentifier) (\s :: StartZonalShift
s@StartZonalShift' {} Text
a -> StartZonalShift
s {$sel:resourceIdentifier:StartZonalShift' :: Text
resourceIdentifier = Text
a} :: StartZonalShift)

instance Core.AWSRequest StartZonalShift where
  type AWSResponse StartZonalShift = ZonalShift
  request :: (Service -> Service) -> StartZonalShift -> Request StartZonalShift
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy StartZonalShift
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse StartZonalShift)))
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 -> forall a. FromJSON a => Object -> Either String a
Data.eitherParseJSON Object
x)

instance Prelude.Hashable StartZonalShift where
  hashWithSalt :: Int -> StartZonalShift -> Int
hashWithSalt Int
_salt StartZonalShift' {Text
resourceIdentifier :: Text
expiresIn :: Text
comment :: Text
awayFrom :: Text
$sel:resourceIdentifier:StartZonalShift' :: StartZonalShift -> Text
$sel:expiresIn:StartZonalShift' :: StartZonalShift -> Text
$sel:comment:StartZonalShift' :: StartZonalShift -> Text
$sel:awayFrom:StartZonalShift' :: StartZonalShift -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
awayFrom
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
comment
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
expiresIn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceIdentifier

instance Prelude.NFData StartZonalShift where
  rnf :: StartZonalShift -> ()
rnf StartZonalShift' {Text
resourceIdentifier :: Text
expiresIn :: Text
comment :: Text
awayFrom :: Text
$sel:resourceIdentifier:StartZonalShift' :: StartZonalShift -> Text
$sel:expiresIn:StartZonalShift' :: StartZonalShift -> Text
$sel:comment:StartZonalShift' :: StartZonalShift -> Text
$sel:awayFrom:StartZonalShift' :: StartZonalShift -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
awayFrom
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
comment
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
expiresIn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceIdentifier

instance Data.ToHeaders StartZonalShift where
  toHeaders :: StartZonalShift -> 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.ToJSON StartZonalShift where
  toJSON :: StartZonalShift -> Value
toJSON StartZonalShift' {Text
resourceIdentifier :: Text
expiresIn :: Text
comment :: Text
awayFrom :: Text
$sel:resourceIdentifier:StartZonalShift' :: StartZonalShift -> Text
$sel:expiresIn:StartZonalShift' :: StartZonalShift -> Text
$sel:comment:StartZonalShift' :: StartZonalShift -> Text
$sel:awayFrom:StartZonalShift' :: StartZonalShift -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ forall a. a -> Maybe a
Prelude.Just (Key
"awayFrom" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
awayFrom),
            forall a. a -> Maybe a
Prelude.Just (Key
"comment" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
comment),
            forall a. a -> Maybe a
Prelude.Just (Key
"expiresIn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
expiresIn),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"resourceIdentifier" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceIdentifier)
          ]
      )

instance Data.ToPath StartZonalShift where
  toPath :: StartZonalShift -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/zonalshifts"

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