{-# 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.DataExchange.Types.DataSetEntry
-- 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.DataExchange.Types.DataSetEntry where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DataExchange.Types.AssetType
import Amazonka.DataExchange.Types.Origin
import Amazonka.DataExchange.Types.OriginDetails
import qualified Amazonka.Prelude as Prelude

-- | A data set is an AWS resource with one or more revisions.
--
-- /See:/ 'newDataSetEntry' smart constructor.
data DataSetEntry = DataSetEntry'
  { -- | If the origin of this data set is ENTITLED, includes the details for the
    -- product on AWS Marketplace.
    DataSetEntry -> Maybe OriginDetails
originDetails :: Prelude.Maybe OriginDetails,
    -- | The data set ID of the owned data set corresponding to the entitled data
    -- set being viewed. This parameter is returned when a data set owner is
    -- viewing the entitled copy of its owned data set.
    DataSetEntry -> Maybe Text
sourceId :: Prelude.Maybe Prelude.Text,
    -- | The ARN for the data set.
    DataSetEntry -> Text
arn :: Prelude.Text,
    -- | The type of asset that is added to a data set.
    DataSetEntry -> AssetType
assetType :: AssetType,
    -- | The date and time that the data set was created, in ISO 8601 format.
    DataSetEntry -> ISO8601
createdAt :: Data.ISO8601,
    -- | The description for the data set.
    DataSetEntry -> Text
description :: Prelude.Text,
    -- | The unique identifier for the data set.
    DataSetEntry -> Text
id :: Prelude.Text,
    -- | The name of the data set.
    DataSetEntry -> Text
name :: Prelude.Text,
    -- | A property that defines the data set as OWNED by the account (for
    -- providers) or ENTITLED to the account (for subscribers).
    DataSetEntry -> Origin
origin :: Origin,
    -- | The date and time that the data set was last updated, in ISO 8601
    -- format.
    DataSetEntry -> ISO8601
updatedAt :: Data.ISO8601
  }
  deriving (DataSetEntry -> DataSetEntry -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DataSetEntry -> DataSetEntry -> Bool
$c/= :: DataSetEntry -> DataSetEntry -> Bool
== :: DataSetEntry -> DataSetEntry -> Bool
$c== :: DataSetEntry -> DataSetEntry -> Bool
Prelude.Eq, ReadPrec [DataSetEntry]
ReadPrec DataSetEntry
Int -> ReadS DataSetEntry
ReadS [DataSetEntry]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DataSetEntry]
$creadListPrec :: ReadPrec [DataSetEntry]
readPrec :: ReadPrec DataSetEntry
$creadPrec :: ReadPrec DataSetEntry
readList :: ReadS [DataSetEntry]
$creadList :: ReadS [DataSetEntry]
readsPrec :: Int -> ReadS DataSetEntry
$creadsPrec :: Int -> ReadS DataSetEntry
Prelude.Read, Int -> DataSetEntry -> ShowS
[DataSetEntry] -> ShowS
DataSetEntry -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DataSetEntry] -> ShowS
$cshowList :: [DataSetEntry] -> ShowS
show :: DataSetEntry -> String
$cshow :: DataSetEntry -> String
showsPrec :: Int -> DataSetEntry -> ShowS
$cshowsPrec :: Int -> DataSetEntry -> ShowS
Prelude.Show, forall x. Rep DataSetEntry x -> DataSetEntry
forall x. DataSetEntry -> Rep DataSetEntry x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DataSetEntry x -> DataSetEntry
$cfrom :: forall x. DataSetEntry -> Rep DataSetEntry x
Prelude.Generic)

-- |
-- Create a value of 'DataSetEntry' 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:
--
-- 'originDetails', 'dataSetEntry_originDetails' - If the origin of this data set is ENTITLED, includes the details for the
-- product on AWS Marketplace.
--
-- 'sourceId', 'dataSetEntry_sourceId' - The data set ID of the owned data set corresponding to the entitled data
-- set being viewed. This parameter is returned when a data set owner is
-- viewing the entitled copy of its owned data set.
--
-- 'arn', 'dataSetEntry_arn' - The ARN for the data set.
--
-- 'assetType', 'dataSetEntry_assetType' - The type of asset that is added to a data set.
--
-- 'createdAt', 'dataSetEntry_createdAt' - The date and time that the data set was created, in ISO 8601 format.
--
-- 'description', 'dataSetEntry_description' - The description for the data set.
--
-- 'id', 'dataSetEntry_id' - The unique identifier for the data set.
--
-- 'name', 'dataSetEntry_name' - The name of the data set.
--
-- 'origin', 'dataSetEntry_origin' - A property that defines the data set as OWNED by the account (for
-- providers) or ENTITLED to the account (for subscribers).
--
-- 'updatedAt', 'dataSetEntry_updatedAt' - The date and time that the data set was last updated, in ISO 8601
-- format.
newDataSetEntry ::
  -- | 'arn'
  Prelude.Text ->
  -- | 'assetType'
  AssetType ->
  -- | 'createdAt'
  Prelude.UTCTime ->
  -- | 'description'
  Prelude.Text ->
  -- | 'id'
  Prelude.Text ->
  -- | 'name'
  Prelude.Text ->
  -- | 'origin'
  Origin ->
  -- | 'updatedAt'
  Prelude.UTCTime ->
  DataSetEntry
newDataSetEntry :: Text
-> AssetType
-> UTCTime
-> Text
-> Text
-> Text
-> Origin
-> UTCTime
-> DataSetEntry
newDataSetEntry
  Text
pArn_
  AssetType
pAssetType_
  UTCTime
pCreatedAt_
  Text
pDescription_
  Text
pId_
  Text
pName_
  Origin
pOrigin_
  UTCTime
pUpdatedAt_ =
    DataSetEntry'
      { $sel:originDetails:DataSetEntry' :: Maybe OriginDetails
originDetails = forall a. Maybe a
Prelude.Nothing,
        $sel:sourceId:DataSetEntry' :: Maybe Text
sourceId = forall a. Maybe a
Prelude.Nothing,
        $sel:arn:DataSetEntry' :: Text
arn = Text
pArn_,
        $sel:assetType:DataSetEntry' :: AssetType
assetType = AssetType
pAssetType_,
        $sel:createdAt:DataSetEntry' :: ISO8601
createdAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreatedAt_,
        $sel:description:DataSetEntry' :: Text
description = Text
pDescription_,
        $sel:id:DataSetEntry' :: Text
id = Text
pId_,
        $sel:name:DataSetEntry' :: Text
name = Text
pName_,
        $sel:origin:DataSetEntry' :: Origin
origin = Origin
pOrigin_,
        $sel:updatedAt:DataSetEntry' :: ISO8601
updatedAt = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdatedAt_
      }

-- | If the origin of this data set is ENTITLED, includes the details for the
-- product on AWS Marketplace.
dataSetEntry_originDetails :: Lens.Lens' DataSetEntry (Prelude.Maybe OriginDetails)
dataSetEntry_originDetails :: Lens' DataSetEntry (Maybe OriginDetails)
dataSetEntry_originDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSetEntry' {Maybe OriginDetails
originDetails :: Maybe OriginDetails
$sel:originDetails:DataSetEntry' :: DataSetEntry -> Maybe OriginDetails
originDetails} -> Maybe OriginDetails
originDetails) (\s :: DataSetEntry
s@DataSetEntry' {} Maybe OriginDetails
a -> DataSetEntry
s {$sel:originDetails:DataSetEntry' :: Maybe OriginDetails
originDetails = Maybe OriginDetails
a} :: DataSetEntry)

-- | The data set ID of the owned data set corresponding to the entitled data
-- set being viewed. This parameter is returned when a data set owner is
-- viewing the entitled copy of its owned data set.
dataSetEntry_sourceId :: Lens.Lens' DataSetEntry (Prelude.Maybe Prelude.Text)
dataSetEntry_sourceId :: Lens' DataSetEntry (Maybe Text)
dataSetEntry_sourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSetEntry' {Maybe Text
sourceId :: Maybe Text
$sel:sourceId:DataSetEntry' :: DataSetEntry -> Maybe Text
sourceId} -> Maybe Text
sourceId) (\s :: DataSetEntry
s@DataSetEntry' {} Maybe Text
a -> DataSetEntry
s {$sel:sourceId:DataSetEntry' :: Maybe Text
sourceId = Maybe Text
a} :: DataSetEntry)

-- | The ARN for the data set.
dataSetEntry_arn :: Lens.Lens' DataSetEntry Prelude.Text
dataSetEntry_arn :: Lens' DataSetEntry Text
dataSetEntry_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSetEntry' {Text
arn :: Text
$sel:arn:DataSetEntry' :: DataSetEntry -> Text
arn} -> Text
arn) (\s :: DataSetEntry
s@DataSetEntry' {} Text
a -> DataSetEntry
s {$sel:arn:DataSetEntry' :: Text
arn = Text
a} :: DataSetEntry)

-- | The type of asset that is added to a data set.
dataSetEntry_assetType :: Lens.Lens' DataSetEntry AssetType
dataSetEntry_assetType :: Lens' DataSetEntry AssetType
dataSetEntry_assetType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSetEntry' {AssetType
assetType :: AssetType
$sel:assetType:DataSetEntry' :: DataSetEntry -> AssetType
assetType} -> AssetType
assetType) (\s :: DataSetEntry
s@DataSetEntry' {} AssetType
a -> DataSetEntry
s {$sel:assetType:DataSetEntry' :: AssetType
assetType = AssetType
a} :: DataSetEntry)

-- | The date and time that the data set was created, in ISO 8601 format.
dataSetEntry_createdAt :: Lens.Lens' DataSetEntry Prelude.UTCTime
dataSetEntry_createdAt :: Lens' DataSetEntry UTCTime
dataSetEntry_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSetEntry' {ISO8601
createdAt :: ISO8601
$sel:createdAt:DataSetEntry' :: DataSetEntry -> ISO8601
createdAt} -> ISO8601
createdAt) (\s :: DataSetEntry
s@DataSetEntry' {} ISO8601
a -> DataSetEntry
s {$sel:createdAt:DataSetEntry' :: ISO8601
createdAt = ISO8601
a} :: DataSetEntry) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The description for the data set.
dataSetEntry_description :: Lens.Lens' DataSetEntry Prelude.Text
dataSetEntry_description :: Lens' DataSetEntry Text
dataSetEntry_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSetEntry' {Text
description :: Text
$sel:description:DataSetEntry' :: DataSetEntry -> Text
description} -> Text
description) (\s :: DataSetEntry
s@DataSetEntry' {} Text
a -> DataSetEntry
s {$sel:description:DataSetEntry' :: Text
description = Text
a} :: DataSetEntry)

-- | The unique identifier for the data set.
dataSetEntry_id :: Lens.Lens' DataSetEntry Prelude.Text
dataSetEntry_id :: Lens' DataSetEntry Text
dataSetEntry_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSetEntry' {Text
id :: Text
$sel:id:DataSetEntry' :: DataSetEntry -> Text
id} -> Text
id) (\s :: DataSetEntry
s@DataSetEntry' {} Text
a -> DataSetEntry
s {$sel:id:DataSetEntry' :: Text
id = Text
a} :: DataSetEntry)

-- | The name of the data set.
dataSetEntry_name :: Lens.Lens' DataSetEntry Prelude.Text
dataSetEntry_name :: Lens' DataSetEntry Text
dataSetEntry_name = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSetEntry' {Text
name :: Text
$sel:name:DataSetEntry' :: DataSetEntry -> Text
name} -> Text
name) (\s :: DataSetEntry
s@DataSetEntry' {} Text
a -> DataSetEntry
s {$sel:name:DataSetEntry' :: Text
name = Text
a} :: DataSetEntry)

-- | A property that defines the data set as OWNED by the account (for
-- providers) or ENTITLED to the account (for subscribers).
dataSetEntry_origin :: Lens.Lens' DataSetEntry Origin
dataSetEntry_origin :: Lens' DataSetEntry Origin
dataSetEntry_origin = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSetEntry' {Origin
origin :: Origin
$sel:origin:DataSetEntry' :: DataSetEntry -> Origin
origin} -> Origin
origin) (\s :: DataSetEntry
s@DataSetEntry' {} Origin
a -> DataSetEntry
s {$sel:origin:DataSetEntry' :: Origin
origin = Origin
a} :: DataSetEntry)

-- | The date and time that the data set was last updated, in ISO 8601
-- format.
dataSetEntry_updatedAt :: Lens.Lens' DataSetEntry Prelude.UTCTime
dataSetEntry_updatedAt :: Lens' DataSetEntry UTCTime
dataSetEntry_updatedAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DataSetEntry' {ISO8601
updatedAt :: ISO8601
$sel:updatedAt:DataSetEntry' :: DataSetEntry -> ISO8601
updatedAt} -> ISO8601
updatedAt) (\s :: DataSetEntry
s@DataSetEntry' {} ISO8601
a -> DataSetEntry
s {$sel:updatedAt:DataSetEntry' :: ISO8601
updatedAt = ISO8601
a} :: DataSetEntry) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Data.FromJSON DataSetEntry where
  parseJSON :: Value -> Parser DataSetEntry
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"DataSetEntry"
      ( \Object
x ->
          Maybe OriginDetails
-> Maybe Text
-> Text
-> AssetType
-> ISO8601
-> Text
-> Text
-> Text
-> Origin
-> ISO8601
-> DataSetEntry
DataSetEntry'
            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
"OriginDetails")
            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
"SourceId")
            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
"Arn")
            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
"AssetType")
            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
"CreatedAt")
            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
"Description")
            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
"Id")
            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
"Name")
            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
"Origin")
            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
"UpdatedAt")
      )

instance Prelude.Hashable DataSetEntry where
  hashWithSalt :: Int -> DataSetEntry -> Int
hashWithSalt Int
_salt DataSetEntry' {Maybe Text
Maybe OriginDetails
Text
ISO8601
AssetType
Origin
updatedAt :: ISO8601
origin :: Origin
name :: Text
id :: Text
description :: Text
createdAt :: ISO8601
assetType :: AssetType
arn :: Text
sourceId :: Maybe Text
originDetails :: Maybe OriginDetails
$sel:updatedAt:DataSetEntry' :: DataSetEntry -> ISO8601
$sel:origin:DataSetEntry' :: DataSetEntry -> Origin
$sel:name:DataSetEntry' :: DataSetEntry -> Text
$sel:id:DataSetEntry' :: DataSetEntry -> Text
$sel:description:DataSetEntry' :: DataSetEntry -> Text
$sel:createdAt:DataSetEntry' :: DataSetEntry -> ISO8601
$sel:assetType:DataSetEntry' :: DataSetEntry -> AssetType
$sel:arn:DataSetEntry' :: DataSetEntry -> Text
$sel:sourceId:DataSetEntry' :: DataSetEntry -> Maybe Text
$sel:originDetails:DataSetEntry' :: DataSetEntry -> Maybe OriginDetails
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OriginDetails
originDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
sourceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` AssetType
assetType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
name
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Origin
origin
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ISO8601
updatedAt

instance Prelude.NFData DataSetEntry where
  rnf :: DataSetEntry -> ()
rnf DataSetEntry' {Maybe Text
Maybe OriginDetails
Text
ISO8601
AssetType
Origin
updatedAt :: ISO8601
origin :: Origin
name :: Text
id :: Text
description :: Text
createdAt :: ISO8601
assetType :: AssetType
arn :: Text
sourceId :: Maybe Text
originDetails :: Maybe OriginDetails
$sel:updatedAt:DataSetEntry' :: DataSetEntry -> ISO8601
$sel:origin:DataSetEntry' :: DataSetEntry -> Origin
$sel:name:DataSetEntry' :: DataSetEntry -> Text
$sel:id:DataSetEntry' :: DataSetEntry -> Text
$sel:description:DataSetEntry' :: DataSetEntry -> Text
$sel:createdAt:DataSetEntry' :: DataSetEntry -> ISO8601
$sel:assetType:DataSetEntry' :: DataSetEntry -> AssetType
$sel:arn:DataSetEntry' :: DataSetEntry -> Text
$sel:sourceId:DataSetEntry' :: DataSetEntry -> Maybe Text
$sel:originDetails:DataSetEntry' :: DataSetEntry -> Maybe OriginDetails
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe OriginDetails
originDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
sourceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AssetType
assetType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
name
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Origin
origin
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
updatedAt