{-# 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.GameLift.Types.LocationAttributes
-- 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.GameLift.Types.LocationAttributes where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.GameLift.Types.FleetAction
import Amazonka.GameLift.Types.LocationState
import Amazonka.GameLift.Types.LocationUpdateStatus
import qualified Amazonka.Prelude as Prelude

-- | Details about a location in a multi-location fleet.
--
-- /See:/ 'newLocationAttributes' smart constructor.
data LocationAttributes = LocationAttributes'
  { -- | A fleet location and its current life-cycle state.
    LocationAttributes -> Maybe LocationState
locationState :: Prelude.Maybe LocationState,
    -- | A list of fleet actions that have been suspended in the fleet location.
    LocationAttributes -> Maybe (NonEmpty FleetAction)
stoppedActions :: Prelude.Maybe (Prelude.NonEmpty FleetAction),
    -- | The status of fleet activity updates to the location. The status
    -- @PENDING_UPDATE@ indicates that @StopFleetActions@ or
    -- @StartFleetActions@ has been requested but the update has not yet been
    -- completed for the location.
    LocationAttributes -> Maybe LocationUpdateStatus
updateStatus :: Prelude.Maybe LocationUpdateStatus
  }
  deriving (LocationAttributes -> LocationAttributes -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: LocationAttributes -> LocationAttributes -> Bool
$c/= :: LocationAttributes -> LocationAttributes -> Bool
== :: LocationAttributes -> LocationAttributes -> Bool
$c== :: LocationAttributes -> LocationAttributes -> Bool
Prelude.Eq, ReadPrec [LocationAttributes]
ReadPrec LocationAttributes
Int -> ReadS LocationAttributes
ReadS [LocationAttributes]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [LocationAttributes]
$creadListPrec :: ReadPrec [LocationAttributes]
readPrec :: ReadPrec LocationAttributes
$creadPrec :: ReadPrec LocationAttributes
readList :: ReadS [LocationAttributes]
$creadList :: ReadS [LocationAttributes]
readsPrec :: Int -> ReadS LocationAttributes
$creadsPrec :: Int -> ReadS LocationAttributes
Prelude.Read, Int -> LocationAttributes -> ShowS
[LocationAttributes] -> ShowS
LocationAttributes -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [LocationAttributes] -> ShowS
$cshowList :: [LocationAttributes] -> ShowS
show :: LocationAttributes -> String
$cshow :: LocationAttributes -> String
showsPrec :: Int -> LocationAttributes -> ShowS
$cshowsPrec :: Int -> LocationAttributes -> ShowS
Prelude.Show, forall x. Rep LocationAttributes x -> LocationAttributes
forall x. LocationAttributes -> Rep LocationAttributes x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep LocationAttributes x -> LocationAttributes
$cfrom :: forall x. LocationAttributes -> Rep LocationAttributes x
Prelude.Generic)

-- |
-- Create a value of 'LocationAttributes' 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:
--
-- 'locationState', 'locationAttributes_locationState' - A fleet location and its current life-cycle state.
--
-- 'stoppedActions', 'locationAttributes_stoppedActions' - A list of fleet actions that have been suspended in the fleet location.
--
-- 'updateStatus', 'locationAttributes_updateStatus' - The status of fleet activity updates to the location. The status
-- @PENDING_UPDATE@ indicates that @StopFleetActions@ or
-- @StartFleetActions@ has been requested but the update has not yet been
-- completed for the location.
newLocationAttributes ::
  LocationAttributes
newLocationAttributes :: LocationAttributes
newLocationAttributes =
  LocationAttributes'
    { $sel:locationState:LocationAttributes' :: Maybe LocationState
locationState =
        forall a. Maybe a
Prelude.Nothing,
      $sel:stoppedActions:LocationAttributes' :: Maybe (NonEmpty FleetAction)
stoppedActions = forall a. Maybe a
Prelude.Nothing,
      $sel:updateStatus:LocationAttributes' :: Maybe LocationUpdateStatus
updateStatus = forall a. Maybe a
Prelude.Nothing
    }

-- | A fleet location and its current life-cycle state.
locationAttributes_locationState :: Lens.Lens' LocationAttributes (Prelude.Maybe LocationState)
locationAttributes_locationState :: Lens' LocationAttributes (Maybe LocationState)
locationAttributes_locationState = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LocationAttributes' {Maybe LocationState
locationState :: Maybe LocationState
$sel:locationState:LocationAttributes' :: LocationAttributes -> Maybe LocationState
locationState} -> Maybe LocationState
locationState) (\s :: LocationAttributes
s@LocationAttributes' {} Maybe LocationState
a -> LocationAttributes
s {$sel:locationState:LocationAttributes' :: Maybe LocationState
locationState = Maybe LocationState
a} :: LocationAttributes)

-- | A list of fleet actions that have been suspended in the fleet location.
locationAttributes_stoppedActions :: Lens.Lens' LocationAttributes (Prelude.Maybe (Prelude.NonEmpty FleetAction))
locationAttributes_stoppedActions :: Lens' LocationAttributes (Maybe (NonEmpty FleetAction))
locationAttributes_stoppedActions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LocationAttributes' {Maybe (NonEmpty FleetAction)
stoppedActions :: Maybe (NonEmpty FleetAction)
$sel:stoppedActions:LocationAttributes' :: LocationAttributes -> Maybe (NonEmpty FleetAction)
stoppedActions} -> Maybe (NonEmpty FleetAction)
stoppedActions) (\s :: LocationAttributes
s@LocationAttributes' {} Maybe (NonEmpty FleetAction)
a -> LocationAttributes
s {$sel:stoppedActions:LocationAttributes' :: Maybe (NonEmpty FleetAction)
stoppedActions = Maybe (NonEmpty FleetAction)
a} :: LocationAttributes) 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 status of fleet activity updates to the location. The status
-- @PENDING_UPDATE@ indicates that @StopFleetActions@ or
-- @StartFleetActions@ has been requested but the update has not yet been
-- completed for the location.
locationAttributes_updateStatus :: Lens.Lens' LocationAttributes (Prelude.Maybe LocationUpdateStatus)
locationAttributes_updateStatus :: Lens' LocationAttributes (Maybe LocationUpdateStatus)
locationAttributes_updateStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\LocationAttributes' {Maybe LocationUpdateStatus
updateStatus :: Maybe LocationUpdateStatus
$sel:updateStatus:LocationAttributes' :: LocationAttributes -> Maybe LocationUpdateStatus
updateStatus} -> Maybe LocationUpdateStatus
updateStatus) (\s :: LocationAttributes
s@LocationAttributes' {} Maybe LocationUpdateStatus
a -> LocationAttributes
s {$sel:updateStatus:LocationAttributes' :: Maybe LocationUpdateStatus
updateStatus = Maybe LocationUpdateStatus
a} :: LocationAttributes)

instance Data.FromJSON LocationAttributes where
  parseJSON :: Value -> Parser LocationAttributes
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"LocationAttributes"
      ( \Object
x ->
          Maybe LocationState
-> Maybe (NonEmpty FleetAction)
-> Maybe LocationUpdateStatus
-> LocationAttributes
LocationAttributes'
            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
"LocationState")
            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
"StoppedActions")
            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
"UpdateStatus")
      )

instance Prelude.Hashable LocationAttributes where
  hashWithSalt :: Int -> LocationAttributes -> Int
hashWithSalt Int
_salt LocationAttributes' {Maybe (NonEmpty FleetAction)
Maybe LocationState
Maybe LocationUpdateStatus
updateStatus :: Maybe LocationUpdateStatus
stoppedActions :: Maybe (NonEmpty FleetAction)
locationState :: Maybe LocationState
$sel:updateStatus:LocationAttributes' :: LocationAttributes -> Maybe LocationUpdateStatus
$sel:stoppedActions:LocationAttributes' :: LocationAttributes -> Maybe (NonEmpty FleetAction)
$sel:locationState:LocationAttributes' :: LocationAttributes -> Maybe LocationState
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LocationState
locationState
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty FleetAction)
stoppedActions
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe LocationUpdateStatus
updateStatus

instance Prelude.NFData LocationAttributes where
  rnf :: LocationAttributes -> ()
rnf LocationAttributes' {Maybe (NonEmpty FleetAction)
Maybe LocationState
Maybe LocationUpdateStatus
updateStatus :: Maybe LocationUpdateStatus
stoppedActions :: Maybe (NonEmpty FleetAction)
locationState :: Maybe LocationState
$sel:updateStatus:LocationAttributes' :: LocationAttributes -> Maybe LocationUpdateStatus
$sel:stoppedActions:LocationAttributes' :: LocationAttributes -> Maybe (NonEmpty FleetAction)
$sel:locationState:LocationAttributes' :: LocationAttributes -> Maybe LocationState
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe LocationState
locationState
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty FleetAction)
stoppedActions
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe LocationUpdateStatus
updateStatus