{-# 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.DeviceFarm.Types.Offering
-- 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.DeviceFarm.Types.Offering where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DeviceFarm.Types.DevicePlatform
import Amazonka.DeviceFarm.Types.OfferingType
import Amazonka.DeviceFarm.Types.RecurringCharge
import qualified Amazonka.Prelude as Prelude

-- | Represents the metadata of a device offering.
--
-- /See:/ 'newOffering' smart constructor.
data Offering = Offering'
  { -- | A string that describes the offering.
    Offering -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | The ID that corresponds to a device offering.
    Offering -> Maybe Text
id :: Prelude.Maybe Prelude.Text,
    -- | The platform of the device (for example, @ANDROID@ or @IOS@).
    Offering -> Maybe DevicePlatform
platform :: Prelude.Maybe DevicePlatform,
    -- | Specifies whether there are recurring charges for the offering.
    Offering -> Maybe [RecurringCharge]
recurringCharges :: Prelude.Maybe [RecurringCharge],
    -- | The type of offering (for example, @RECURRING@) for a device.
    Offering -> Maybe OfferingType
type' :: Prelude.Maybe OfferingType
  }
  deriving (Offering -> Offering -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Offering -> Offering -> Bool
$c/= :: Offering -> Offering -> Bool
== :: Offering -> Offering -> Bool
$c== :: Offering -> Offering -> Bool
Prelude.Eq, ReadPrec [Offering]
ReadPrec Offering
Int -> ReadS Offering
ReadS [Offering]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Offering]
$creadListPrec :: ReadPrec [Offering]
readPrec :: ReadPrec Offering
$creadPrec :: ReadPrec Offering
readList :: ReadS [Offering]
$creadList :: ReadS [Offering]
readsPrec :: Int -> ReadS Offering
$creadsPrec :: Int -> ReadS Offering
Prelude.Read, Int -> Offering -> ShowS
[Offering] -> ShowS
Offering -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Offering] -> ShowS
$cshowList :: [Offering] -> ShowS
show :: Offering -> String
$cshow :: Offering -> String
showsPrec :: Int -> Offering -> ShowS
$cshowsPrec :: Int -> Offering -> ShowS
Prelude.Show, forall x. Rep Offering x -> Offering
forall x. Offering -> Rep Offering x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Offering x -> Offering
$cfrom :: forall x. Offering -> Rep Offering x
Prelude.Generic)

-- |
-- Create a value of 'Offering' 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:
--
-- 'description', 'offering_description' - A string that describes the offering.
--
-- 'id', 'offering_id' - The ID that corresponds to a device offering.
--
-- 'platform', 'offering_platform' - The platform of the device (for example, @ANDROID@ or @IOS@).
--
-- 'recurringCharges', 'offering_recurringCharges' - Specifies whether there are recurring charges for the offering.
--
-- 'type'', 'offering_type' - The type of offering (for example, @RECURRING@) for a device.
newOffering ::
  Offering
newOffering :: Offering
newOffering =
  Offering'
    { $sel:description:Offering' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Offering' :: Maybe Text
id = forall a. Maybe a
Prelude.Nothing,
      $sel:platform:Offering' :: Maybe DevicePlatform
platform = forall a. Maybe a
Prelude.Nothing,
      $sel:recurringCharges:Offering' :: Maybe [RecurringCharge]
recurringCharges = forall a. Maybe a
Prelude.Nothing,
      $sel:type':Offering' :: Maybe OfferingType
type' = forall a. Maybe a
Prelude.Nothing
    }

-- | A string that describes the offering.
offering_description :: Lens.Lens' Offering (Prelude.Maybe Prelude.Text)
offering_description :: Lens' Offering (Maybe Text)
offering_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Offering' {Maybe Text
description :: Maybe Text
$sel:description:Offering' :: Offering -> Maybe Text
description} -> Maybe Text
description) (\s :: Offering
s@Offering' {} Maybe Text
a -> Offering
s {$sel:description:Offering' :: Maybe Text
description = Maybe Text
a} :: Offering)

-- | The ID that corresponds to a device offering.
offering_id :: Lens.Lens' Offering (Prelude.Maybe Prelude.Text)
offering_id :: Lens' Offering (Maybe Text)
offering_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Offering' {Maybe Text
id :: Maybe Text
$sel:id:Offering' :: Offering -> Maybe Text
id} -> Maybe Text
id) (\s :: Offering
s@Offering' {} Maybe Text
a -> Offering
s {$sel:id:Offering' :: Maybe Text
id = Maybe Text
a} :: Offering)

-- | The platform of the device (for example, @ANDROID@ or @IOS@).
offering_platform :: Lens.Lens' Offering (Prelude.Maybe DevicePlatform)
offering_platform :: Lens' Offering (Maybe DevicePlatform)
offering_platform = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Offering' {Maybe DevicePlatform
platform :: Maybe DevicePlatform
$sel:platform:Offering' :: Offering -> Maybe DevicePlatform
platform} -> Maybe DevicePlatform
platform) (\s :: Offering
s@Offering' {} Maybe DevicePlatform
a -> Offering
s {$sel:platform:Offering' :: Maybe DevicePlatform
platform = Maybe DevicePlatform
a} :: Offering)

-- | Specifies whether there are recurring charges for the offering.
offering_recurringCharges :: Lens.Lens' Offering (Prelude.Maybe [RecurringCharge])
offering_recurringCharges :: Lens' Offering (Maybe [RecurringCharge])
offering_recurringCharges = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Offering' {Maybe [RecurringCharge]
recurringCharges :: Maybe [RecurringCharge]
$sel:recurringCharges:Offering' :: Offering -> Maybe [RecurringCharge]
recurringCharges} -> Maybe [RecurringCharge]
recurringCharges) (\s :: Offering
s@Offering' {} Maybe [RecurringCharge]
a -> Offering
s {$sel:recurringCharges:Offering' :: Maybe [RecurringCharge]
recurringCharges = Maybe [RecurringCharge]
a} :: Offering) 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 type of offering (for example, @RECURRING@) for a device.
offering_type :: Lens.Lens' Offering (Prelude.Maybe OfferingType)
offering_type :: Lens' Offering (Maybe OfferingType)
offering_type = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Offering' {Maybe OfferingType
type' :: Maybe OfferingType
$sel:type':Offering' :: Offering -> Maybe OfferingType
type'} -> Maybe OfferingType
type') (\s :: Offering
s@Offering' {} Maybe OfferingType
a -> Offering
s {$sel:type':Offering' :: Maybe OfferingType
type' = Maybe OfferingType
a} :: Offering)

instance Data.FromJSON Offering where
  parseJSON :: Value -> Parser Offering
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Offering"
      ( \Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe DevicePlatform
-> Maybe [RecurringCharge]
-> Maybe OfferingType
-> Offering
Offering'
            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
"description")
            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
"id")
            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
"platform")
            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
"recurringCharges"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            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
"type")
      )

instance Prelude.Hashable Offering where
  hashWithSalt :: Int -> Offering -> Int
hashWithSalt Int
_salt Offering' {Maybe [RecurringCharge]
Maybe Text
Maybe DevicePlatform
Maybe OfferingType
type' :: Maybe OfferingType
recurringCharges :: Maybe [RecurringCharge]
platform :: Maybe DevicePlatform
id :: Maybe Text
description :: Maybe Text
$sel:type':Offering' :: Offering -> Maybe OfferingType
$sel:recurringCharges:Offering' :: Offering -> Maybe [RecurringCharge]
$sel:platform:Offering' :: Offering -> Maybe DevicePlatform
$sel:id:Offering' :: Offering -> Maybe Text
$sel:description:Offering' :: Offering -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DevicePlatform
platform
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [RecurringCharge]
recurringCharges
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OfferingType
type'

instance Prelude.NFData Offering where
  rnf :: Offering -> ()
rnf Offering' {Maybe [RecurringCharge]
Maybe Text
Maybe DevicePlatform
Maybe OfferingType
type' :: Maybe OfferingType
recurringCharges :: Maybe [RecurringCharge]
platform :: Maybe DevicePlatform
id :: Maybe Text
description :: Maybe Text
$sel:type':Offering' :: Offering -> Maybe OfferingType
$sel:recurringCharges:Offering' :: Offering -> Maybe [RecurringCharge]
$sel:platform:Offering' :: Offering -> Maybe DevicePlatform
$sel:id:Offering' :: Offering -> Maybe Text
$sel:description:Offering' :: Offering -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe DevicePlatform
platform
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [RecurringCharge]
recurringCharges
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OfferingType
type'