{-# 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.MediaConnect.Types.FailoverConfig
-- 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.MediaConnect.Types.FailoverConfig where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.MediaConnect.Types.FailoverMode
import Amazonka.MediaConnect.Types.SourcePriority
import Amazonka.MediaConnect.Types.State
import qualified Amazonka.Prelude as Prelude

-- | The settings for source failover.
--
-- /See:/ 'newFailoverConfig' smart constructor.
data FailoverConfig = FailoverConfig'
  { -- | The type of failover you choose for this flow. MERGE combines the source
    -- streams into a single stream, allowing graceful recovery from any
    -- single-source loss. FAILOVER allows switching between different streams.
    FailoverConfig -> Maybe FailoverMode
failoverMode :: Prelude.Maybe FailoverMode,
    -- | Search window time to look for dash-7 packets
    FailoverConfig -> Maybe Int
recoveryWindow :: Prelude.Maybe Prelude.Int,
    -- | The priority you want to assign to a source. You can have a primary
    -- stream and a backup stream or two equally prioritized streams.
    FailoverConfig -> Maybe SourcePriority
sourcePriority :: Prelude.Maybe SourcePriority,
    FailoverConfig -> Maybe State
state :: Prelude.Maybe State
  }
  deriving (FailoverConfig -> FailoverConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: FailoverConfig -> FailoverConfig -> Bool
$c/= :: FailoverConfig -> FailoverConfig -> Bool
== :: FailoverConfig -> FailoverConfig -> Bool
$c== :: FailoverConfig -> FailoverConfig -> Bool
Prelude.Eq, ReadPrec [FailoverConfig]
ReadPrec FailoverConfig
Int -> ReadS FailoverConfig
ReadS [FailoverConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [FailoverConfig]
$creadListPrec :: ReadPrec [FailoverConfig]
readPrec :: ReadPrec FailoverConfig
$creadPrec :: ReadPrec FailoverConfig
readList :: ReadS [FailoverConfig]
$creadList :: ReadS [FailoverConfig]
readsPrec :: Int -> ReadS FailoverConfig
$creadsPrec :: Int -> ReadS FailoverConfig
Prelude.Read, Int -> FailoverConfig -> ShowS
[FailoverConfig] -> ShowS
FailoverConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [FailoverConfig] -> ShowS
$cshowList :: [FailoverConfig] -> ShowS
show :: FailoverConfig -> String
$cshow :: FailoverConfig -> String
showsPrec :: Int -> FailoverConfig -> ShowS
$cshowsPrec :: Int -> FailoverConfig -> ShowS
Prelude.Show, forall x. Rep FailoverConfig x -> FailoverConfig
forall x. FailoverConfig -> Rep FailoverConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep FailoverConfig x -> FailoverConfig
$cfrom :: forall x. FailoverConfig -> Rep FailoverConfig x
Prelude.Generic)

-- |
-- Create a value of 'FailoverConfig' 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:
--
-- 'failoverMode', 'failoverConfig_failoverMode' - The type of failover you choose for this flow. MERGE combines the source
-- streams into a single stream, allowing graceful recovery from any
-- single-source loss. FAILOVER allows switching between different streams.
--
-- 'recoveryWindow', 'failoverConfig_recoveryWindow' - Search window time to look for dash-7 packets
--
-- 'sourcePriority', 'failoverConfig_sourcePriority' - The priority you want to assign to a source. You can have a primary
-- stream and a backup stream or two equally prioritized streams.
--
-- 'state', 'failoverConfig_state' - Undocumented member.
newFailoverConfig ::
  FailoverConfig
newFailoverConfig :: FailoverConfig
newFailoverConfig =
  FailoverConfig'
    { $sel:failoverMode:FailoverConfig' :: Maybe FailoverMode
failoverMode = forall a. Maybe a
Prelude.Nothing,
      $sel:recoveryWindow:FailoverConfig' :: Maybe Int
recoveryWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:sourcePriority:FailoverConfig' :: Maybe SourcePriority
sourcePriority = forall a. Maybe a
Prelude.Nothing,
      $sel:state:FailoverConfig' :: Maybe State
state = forall a. Maybe a
Prelude.Nothing
    }

-- | The type of failover you choose for this flow. MERGE combines the source
-- streams into a single stream, allowing graceful recovery from any
-- single-source loss. FAILOVER allows switching between different streams.
failoverConfig_failoverMode :: Lens.Lens' FailoverConfig (Prelude.Maybe FailoverMode)
failoverConfig_failoverMode :: Lens' FailoverConfig (Maybe FailoverMode)
failoverConfig_failoverMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FailoverConfig' {Maybe FailoverMode
failoverMode :: Maybe FailoverMode
$sel:failoverMode:FailoverConfig' :: FailoverConfig -> Maybe FailoverMode
failoverMode} -> Maybe FailoverMode
failoverMode) (\s :: FailoverConfig
s@FailoverConfig' {} Maybe FailoverMode
a -> FailoverConfig
s {$sel:failoverMode:FailoverConfig' :: Maybe FailoverMode
failoverMode = Maybe FailoverMode
a} :: FailoverConfig)

-- | Search window time to look for dash-7 packets
failoverConfig_recoveryWindow :: Lens.Lens' FailoverConfig (Prelude.Maybe Prelude.Int)
failoverConfig_recoveryWindow :: Lens' FailoverConfig (Maybe Int)
failoverConfig_recoveryWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FailoverConfig' {Maybe Int
recoveryWindow :: Maybe Int
$sel:recoveryWindow:FailoverConfig' :: FailoverConfig -> Maybe Int
recoveryWindow} -> Maybe Int
recoveryWindow) (\s :: FailoverConfig
s@FailoverConfig' {} Maybe Int
a -> FailoverConfig
s {$sel:recoveryWindow:FailoverConfig' :: Maybe Int
recoveryWindow = Maybe Int
a} :: FailoverConfig)

-- | The priority you want to assign to a source. You can have a primary
-- stream and a backup stream or two equally prioritized streams.
failoverConfig_sourcePriority :: Lens.Lens' FailoverConfig (Prelude.Maybe SourcePriority)
failoverConfig_sourcePriority :: Lens' FailoverConfig (Maybe SourcePriority)
failoverConfig_sourcePriority = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FailoverConfig' {Maybe SourcePriority
sourcePriority :: Maybe SourcePriority
$sel:sourcePriority:FailoverConfig' :: FailoverConfig -> Maybe SourcePriority
sourcePriority} -> Maybe SourcePriority
sourcePriority) (\s :: FailoverConfig
s@FailoverConfig' {} Maybe SourcePriority
a -> FailoverConfig
s {$sel:sourcePriority:FailoverConfig' :: Maybe SourcePriority
sourcePriority = Maybe SourcePriority
a} :: FailoverConfig)

-- | Undocumented member.
failoverConfig_state :: Lens.Lens' FailoverConfig (Prelude.Maybe State)
failoverConfig_state :: Lens' FailoverConfig (Maybe State)
failoverConfig_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\FailoverConfig' {Maybe State
state :: Maybe State
$sel:state:FailoverConfig' :: FailoverConfig -> Maybe State
state} -> Maybe State
state) (\s :: FailoverConfig
s@FailoverConfig' {} Maybe State
a -> FailoverConfig
s {$sel:state:FailoverConfig' :: Maybe State
state = Maybe State
a} :: FailoverConfig)

instance Data.FromJSON FailoverConfig where
  parseJSON :: Value -> Parser FailoverConfig
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"FailoverConfig"
      ( \Object
x ->
          Maybe FailoverMode
-> Maybe Int
-> Maybe SourcePriority
-> Maybe State
-> FailoverConfig
FailoverConfig'
            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
"failoverMode")
            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
"recoveryWindow")
            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
"sourcePriority")
            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")
      )

instance Prelude.Hashable FailoverConfig where
  hashWithSalt :: Int -> FailoverConfig -> Int
hashWithSalt Int
_salt FailoverConfig' {Maybe Int
Maybe FailoverMode
Maybe SourcePriority
Maybe State
state :: Maybe State
sourcePriority :: Maybe SourcePriority
recoveryWindow :: Maybe Int
failoverMode :: Maybe FailoverMode
$sel:state:FailoverConfig' :: FailoverConfig -> Maybe State
$sel:sourcePriority:FailoverConfig' :: FailoverConfig -> Maybe SourcePriority
$sel:recoveryWindow:FailoverConfig' :: FailoverConfig -> Maybe Int
$sel:failoverMode:FailoverConfig' :: FailoverConfig -> Maybe FailoverMode
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe FailoverMode
failoverMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
recoveryWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SourcePriority
sourcePriority
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe State
state

instance Prelude.NFData FailoverConfig where
  rnf :: FailoverConfig -> ()
rnf FailoverConfig' {Maybe Int
Maybe FailoverMode
Maybe SourcePriority
Maybe State
state :: Maybe State
sourcePriority :: Maybe SourcePriority
recoveryWindow :: Maybe Int
failoverMode :: Maybe FailoverMode
$sel:state:FailoverConfig' :: FailoverConfig -> Maybe State
$sel:sourcePriority:FailoverConfig' :: FailoverConfig -> Maybe SourcePriority
$sel:recoveryWindow:FailoverConfig' :: FailoverConfig -> Maybe Int
$sel:failoverMode:FailoverConfig' :: FailoverConfig -> Maybe FailoverMode
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe FailoverMode
failoverMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
recoveryWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SourcePriority
sourcePriority
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe State
state

instance Data.ToJSON FailoverConfig where
  toJSON :: FailoverConfig -> Value
toJSON FailoverConfig' {Maybe Int
Maybe FailoverMode
Maybe SourcePriority
Maybe State
state :: Maybe State
sourcePriority :: Maybe SourcePriority
recoveryWindow :: Maybe Int
failoverMode :: Maybe FailoverMode
$sel:state:FailoverConfig' :: FailoverConfig -> Maybe State
$sel:sourcePriority:FailoverConfig' :: FailoverConfig -> Maybe SourcePriority
$sel:recoveryWindow:FailoverConfig' :: FailoverConfig -> Maybe Int
$sel:failoverMode:FailoverConfig' :: FailoverConfig -> Maybe FailoverMode
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"failoverMode" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe FailoverMode
failoverMode,
            (Key
"recoveryWindow" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Int
recoveryWindow,
            (Key
"sourcePriority" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe SourcePriority
sourcePriority,
            (Key
"state" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe State
state
          ]
      )