{-# 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.GroundStation.Types.SpectrumConfig
-- 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.GroundStation.Types.SpectrumConfig where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.GroundStation.Types.Frequency
import Amazonka.GroundStation.Types.FrequencyBandwidth
import Amazonka.GroundStation.Types.Polarization
import qualified Amazonka.Prelude as Prelude

-- | Object that describes a spectral @Config@.
--
-- /See:/ 'newSpectrumConfig' smart constructor.
data SpectrumConfig = SpectrumConfig'
  { -- | Polarization of a spectral @Config@. Capturing both @\"RIGHT_HAND\"@ and
    -- @\"LEFT_HAND\"@ polarization requires two separate configs.
    SpectrumConfig -> Maybe Polarization
polarization :: Prelude.Maybe Polarization,
    -- | Bandwidth of a spectral @Config@. AWS Ground Station currently has the
    -- following bandwidth limitations:
    --
    -- -   For @AntennaDownlinkDemodDecodeconfig@, valid values are between 125
    --     kHz to 650 MHz.
    --
    -- -   For @AntennaDownlinkconfig@ valid values are between 10 kHz to 54
    --     MHz.
    --
    -- -   For @AntennaUplinkConfig@, valid values are between 10 kHz to 54
    --     MHz.
    SpectrumConfig -> FrequencyBandwidth
bandwidth :: FrequencyBandwidth,
    -- | Center frequency of a spectral @Config@. Valid values are between 2200
    -- to 2300 MHz and 7750 to 8400 MHz for downlink and 2025 to 2120 MHz for
    -- uplink.
    SpectrumConfig -> Frequency
centerFrequency :: Frequency
  }
  deriving (SpectrumConfig -> SpectrumConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: SpectrumConfig -> SpectrumConfig -> Bool
$c/= :: SpectrumConfig -> SpectrumConfig -> Bool
== :: SpectrumConfig -> SpectrumConfig -> Bool
$c== :: SpectrumConfig -> SpectrumConfig -> Bool
Prelude.Eq, ReadPrec [SpectrumConfig]
ReadPrec SpectrumConfig
Int -> ReadS SpectrumConfig
ReadS [SpectrumConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [SpectrumConfig]
$creadListPrec :: ReadPrec [SpectrumConfig]
readPrec :: ReadPrec SpectrumConfig
$creadPrec :: ReadPrec SpectrumConfig
readList :: ReadS [SpectrumConfig]
$creadList :: ReadS [SpectrumConfig]
readsPrec :: Int -> ReadS SpectrumConfig
$creadsPrec :: Int -> ReadS SpectrumConfig
Prelude.Read, Int -> SpectrumConfig -> ShowS
[SpectrumConfig] -> ShowS
SpectrumConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [SpectrumConfig] -> ShowS
$cshowList :: [SpectrumConfig] -> ShowS
show :: SpectrumConfig -> String
$cshow :: SpectrumConfig -> String
showsPrec :: Int -> SpectrumConfig -> ShowS
$cshowsPrec :: Int -> SpectrumConfig -> ShowS
Prelude.Show, forall x. Rep SpectrumConfig x -> SpectrumConfig
forall x. SpectrumConfig -> Rep SpectrumConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep SpectrumConfig x -> SpectrumConfig
$cfrom :: forall x. SpectrumConfig -> Rep SpectrumConfig x
Prelude.Generic)

-- |
-- Create a value of 'SpectrumConfig' 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:
--
-- 'polarization', 'spectrumConfig_polarization' - Polarization of a spectral @Config@. Capturing both @\"RIGHT_HAND\"@ and
-- @\"LEFT_HAND\"@ polarization requires two separate configs.
--
-- 'bandwidth', 'spectrumConfig_bandwidth' - Bandwidth of a spectral @Config@. AWS Ground Station currently has the
-- following bandwidth limitations:
--
-- -   For @AntennaDownlinkDemodDecodeconfig@, valid values are between 125
--     kHz to 650 MHz.
--
-- -   For @AntennaDownlinkconfig@ valid values are between 10 kHz to 54
--     MHz.
--
-- -   For @AntennaUplinkConfig@, valid values are between 10 kHz to 54
--     MHz.
--
-- 'centerFrequency', 'spectrumConfig_centerFrequency' - Center frequency of a spectral @Config@. Valid values are between 2200
-- to 2300 MHz and 7750 to 8400 MHz for downlink and 2025 to 2120 MHz for
-- uplink.
newSpectrumConfig ::
  -- | 'bandwidth'
  FrequencyBandwidth ->
  -- | 'centerFrequency'
  Frequency ->
  SpectrumConfig
newSpectrumConfig :: FrequencyBandwidth -> Frequency -> SpectrumConfig
newSpectrumConfig FrequencyBandwidth
pBandwidth_ Frequency
pCenterFrequency_ =
  SpectrumConfig'
    { $sel:polarization:SpectrumConfig' :: Maybe Polarization
polarization = forall a. Maybe a
Prelude.Nothing,
      $sel:bandwidth:SpectrumConfig' :: FrequencyBandwidth
bandwidth = FrequencyBandwidth
pBandwidth_,
      $sel:centerFrequency:SpectrumConfig' :: Frequency
centerFrequency = Frequency
pCenterFrequency_
    }

-- | Polarization of a spectral @Config@. Capturing both @\"RIGHT_HAND\"@ and
-- @\"LEFT_HAND\"@ polarization requires two separate configs.
spectrumConfig_polarization :: Lens.Lens' SpectrumConfig (Prelude.Maybe Polarization)
spectrumConfig_polarization :: Lens' SpectrumConfig (Maybe Polarization)
spectrumConfig_polarization = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpectrumConfig' {Maybe Polarization
polarization :: Maybe Polarization
$sel:polarization:SpectrumConfig' :: SpectrumConfig -> Maybe Polarization
polarization} -> Maybe Polarization
polarization) (\s :: SpectrumConfig
s@SpectrumConfig' {} Maybe Polarization
a -> SpectrumConfig
s {$sel:polarization:SpectrumConfig' :: Maybe Polarization
polarization = Maybe Polarization
a} :: SpectrumConfig)

-- | Bandwidth of a spectral @Config@. AWS Ground Station currently has the
-- following bandwidth limitations:
--
-- -   For @AntennaDownlinkDemodDecodeconfig@, valid values are between 125
--     kHz to 650 MHz.
--
-- -   For @AntennaDownlinkconfig@ valid values are between 10 kHz to 54
--     MHz.
--
-- -   For @AntennaUplinkConfig@, valid values are between 10 kHz to 54
--     MHz.
spectrumConfig_bandwidth :: Lens.Lens' SpectrumConfig FrequencyBandwidth
spectrumConfig_bandwidth :: Lens' SpectrumConfig FrequencyBandwidth
spectrumConfig_bandwidth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpectrumConfig' {FrequencyBandwidth
bandwidth :: FrequencyBandwidth
$sel:bandwidth:SpectrumConfig' :: SpectrumConfig -> FrequencyBandwidth
bandwidth} -> FrequencyBandwidth
bandwidth) (\s :: SpectrumConfig
s@SpectrumConfig' {} FrequencyBandwidth
a -> SpectrumConfig
s {$sel:bandwidth:SpectrumConfig' :: FrequencyBandwidth
bandwidth = FrequencyBandwidth
a} :: SpectrumConfig)

-- | Center frequency of a spectral @Config@. Valid values are between 2200
-- to 2300 MHz and 7750 to 8400 MHz for downlink and 2025 to 2120 MHz for
-- uplink.
spectrumConfig_centerFrequency :: Lens.Lens' SpectrumConfig Frequency
spectrumConfig_centerFrequency :: Lens' SpectrumConfig Frequency
spectrumConfig_centerFrequency = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\SpectrumConfig' {Frequency
centerFrequency :: Frequency
$sel:centerFrequency:SpectrumConfig' :: SpectrumConfig -> Frequency
centerFrequency} -> Frequency
centerFrequency) (\s :: SpectrumConfig
s@SpectrumConfig' {} Frequency
a -> SpectrumConfig
s {$sel:centerFrequency:SpectrumConfig' :: Frequency
centerFrequency = Frequency
a} :: SpectrumConfig)

instance Data.FromJSON SpectrumConfig where
  parseJSON :: Value -> Parser SpectrumConfig
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"SpectrumConfig"
      ( \Object
x ->
          Maybe Polarization
-> FrequencyBandwidth -> Frequency -> SpectrumConfig
SpectrumConfig'
            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
"polarization")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"bandwidth")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"centerFrequency")
      )

instance Prelude.Hashable SpectrumConfig where
  hashWithSalt :: Int -> SpectrumConfig -> Int
hashWithSalt Int
_salt SpectrumConfig' {Maybe Polarization
FrequencyBandwidth
Frequency
centerFrequency :: Frequency
bandwidth :: FrequencyBandwidth
polarization :: Maybe Polarization
$sel:centerFrequency:SpectrumConfig' :: SpectrumConfig -> Frequency
$sel:bandwidth:SpectrumConfig' :: SpectrumConfig -> FrequencyBandwidth
$sel:polarization:SpectrumConfig' :: SpectrumConfig -> Maybe Polarization
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Polarization
polarization
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` FrequencyBandwidth
bandwidth
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Frequency
centerFrequency

instance Prelude.NFData SpectrumConfig where
  rnf :: SpectrumConfig -> ()
rnf SpectrumConfig' {Maybe Polarization
FrequencyBandwidth
Frequency
centerFrequency :: Frequency
bandwidth :: FrequencyBandwidth
polarization :: Maybe Polarization
$sel:centerFrequency:SpectrumConfig' :: SpectrumConfig -> Frequency
$sel:bandwidth:SpectrumConfig' :: SpectrumConfig -> FrequencyBandwidth
$sel:polarization:SpectrumConfig' :: SpectrumConfig -> Maybe Polarization
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Polarization
polarization
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf FrequencyBandwidth
bandwidth
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Frequency
centerFrequency

instance Data.ToJSON SpectrumConfig where
  toJSON :: SpectrumConfig -> Value
toJSON SpectrumConfig' {Maybe Polarization
FrequencyBandwidth
Frequency
centerFrequency :: Frequency
bandwidth :: FrequencyBandwidth
polarization :: Maybe Polarization
$sel:centerFrequency:SpectrumConfig' :: SpectrumConfig -> Frequency
$sel:bandwidth:SpectrumConfig' :: SpectrumConfig -> FrequencyBandwidth
$sel:polarization:SpectrumConfig' :: SpectrumConfig -> Maybe Polarization
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"polarization" 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 Polarization
polarization,
            forall a. a -> Maybe a
Prelude.Just (Key
"bandwidth" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= FrequencyBandwidth
bandwidth),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"centerFrequency" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Frequency
centerFrequency)
          ]
      )