{-# 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.SageMaker.Types.ModelPackageGroup
-- 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.SageMaker.Types.ModelPackageGroup where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import Amazonka.SageMaker.Types.ModelPackageGroupStatus
import Amazonka.SageMaker.Types.Tag
import Amazonka.SageMaker.Types.UserContext

-- | A group of versioned models in the model registry.
--
-- /See:/ 'newModelPackageGroup' smart constructor.
data ModelPackageGroup = ModelPackageGroup'
  { ModelPackageGroup -> Maybe UserContext
createdBy :: Prelude.Maybe UserContext,
    -- | The time that the model group was created.
    ModelPackageGroup -> Maybe POSIX
creationTime :: Prelude.Maybe Data.POSIX,
    -- | The Amazon Resource Name (ARN) of the model group.
    ModelPackageGroup -> Maybe Text
modelPackageGroupArn :: Prelude.Maybe Prelude.Text,
    -- | The description for the model group.
    ModelPackageGroup -> Maybe Text
modelPackageGroupDescription :: Prelude.Maybe Prelude.Text,
    -- | The name of the model group.
    ModelPackageGroup -> Maybe Text
modelPackageGroupName :: Prelude.Maybe Prelude.Text,
    -- | The status of the model group. This can be one of the following values.
    --
    -- -   @PENDING@ - The model group is pending being created.
    --
    -- -   @IN_PROGRESS@ - The model group is in the process of being created.
    --
    -- -   @COMPLETED@ - The model group was successfully created.
    --
    -- -   @FAILED@ - The model group failed.
    --
    -- -   @DELETING@ - The model group is in the process of being deleted.
    --
    -- -   @DELETE_FAILED@ - SageMaker failed to delete the model group.
    ModelPackageGroup -> Maybe ModelPackageGroupStatus
modelPackageGroupStatus :: Prelude.Maybe ModelPackageGroupStatus,
    -- | A list of the tags associated with the model group. For more
    -- information, see
    -- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services resources>
    -- in the /Amazon Web Services General Reference Guide/.
    ModelPackageGroup -> Maybe [Tag]
tags :: Prelude.Maybe [Tag]
  }
  deriving (ModelPackageGroup -> ModelPackageGroup -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModelPackageGroup -> ModelPackageGroup -> Bool
$c/= :: ModelPackageGroup -> ModelPackageGroup -> Bool
== :: ModelPackageGroup -> ModelPackageGroup -> Bool
$c== :: ModelPackageGroup -> ModelPackageGroup -> Bool
Prelude.Eq, ReadPrec [ModelPackageGroup]
ReadPrec ModelPackageGroup
Int -> ReadS ModelPackageGroup
ReadS [ModelPackageGroup]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModelPackageGroup]
$creadListPrec :: ReadPrec [ModelPackageGroup]
readPrec :: ReadPrec ModelPackageGroup
$creadPrec :: ReadPrec ModelPackageGroup
readList :: ReadS [ModelPackageGroup]
$creadList :: ReadS [ModelPackageGroup]
readsPrec :: Int -> ReadS ModelPackageGroup
$creadsPrec :: Int -> ReadS ModelPackageGroup
Prelude.Read, Int -> ModelPackageGroup -> ShowS
[ModelPackageGroup] -> ShowS
ModelPackageGroup -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModelPackageGroup] -> ShowS
$cshowList :: [ModelPackageGroup] -> ShowS
show :: ModelPackageGroup -> String
$cshow :: ModelPackageGroup -> String
showsPrec :: Int -> ModelPackageGroup -> ShowS
$cshowsPrec :: Int -> ModelPackageGroup -> ShowS
Prelude.Show, forall x. Rep ModelPackageGroup x -> ModelPackageGroup
forall x. ModelPackageGroup -> Rep ModelPackageGroup x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModelPackageGroup x -> ModelPackageGroup
$cfrom :: forall x. ModelPackageGroup -> Rep ModelPackageGroup x
Prelude.Generic)

-- |
-- Create a value of 'ModelPackageGroup' 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:
--
-- 'createdBy', 'modelPackageGroup_createdBy' - Undocumented member.
--
-- 'creationTime', 'modelPackageGroup_creationTime' - The time that the model group was created.
--
-- 'modelPackageGroupArn', 'modelPackageGroup_modelPackageGroupArn' - The Amazon Resource Name (ARN) of the model group.
--
-- 'modelPackageGroupDescription', 'modelPackageGroup_modelPackageGroupDescription' - The description for the model group.
--
-- 'modelPackageGroupName', 'modelPackageGroup_modelPackageGroupName' - The name of the model group.
--
-- 'modelPackageGroupStatus', 'modelPackageGroup_modelPackageGroupStatus' - The status of the model group. This can be one of the following values.
--
-- -   @PENDING@ - The model group is pending being created.
--
-- -   @IN_PROGRESS@ - The model group is in the process of being created.
--
-- -   @COMPLETED@ - The model group was successfully created.
--
-- -   @FAILED@ - The model group failed.
--
-- -   @DELETING@ - The model group is in the process of being deleted.
--
-- -   @DELETE_FAILED@ - SageMaker failed to delete the model group.
--
-- 'tags', 'modelPackageGroup_tags' - A list of the tags associated with the model group. For more
-- information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services resources>
-- in the /Amazon Web Services General Reference Guide/.
newModelPackageGroup ::
  ModelPackageGroup
newModelPackageGroup :: ModelPackageGroup
newModelPackageGroup =
  ModelPackageGroup'
    { $sel:createdBy:ModelPackageGroup' :: Maybe UserContext
createdBy = forall a. Maybe a
Prelude.Nothing,
      $sel:creationTime:ModelPackageGroup' :: Maybe POSIX
creationTime = forall a. Maybe a
Prelude.Nothing,
      $sel:modelPackageGroupArn:ModelPackageGroup' :: Maybe Text
modelPackageGroupArn = forall a. Maybe a
Prelude.Nothing,
      $sel:modelPackageGroupDescription:ModelPackageGroup' :: Maybe Text
modelPackageGroupDescription = forall a. Maybe a
Prelude.Nothing,
      $sel:modelPackageGroupName:ModelPackageGroup' :: Maybe Text
modelPackageGroupName = forall a. Maybe a
Prelude.Nothing,
      $sel:modelPackageGroupStatus:ModelPackageGroup' :: Maybe ModelPackageGroupStatus
modelPackageGroupStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:ModelPackageGroup' :: Maybe [Tag]
tags = forall a. Maybe a
Prelude.Nothing
    }

-- | Undocumented member.
modelPackageGroup_createdBy :: Lens.Lens' ModelPackageGroup (Prelude.Maybe UserContext)
modelPackageGroup_createdBy :: Lens' ModelPackageGroup (Maybe UserContext)
modelPackageGroup_createdBy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelPackageGroup' {Maybe UserContext
createdBy :: Maybe UserContext
$sel:createdBy:ModelPackageGroup' :: ModelPackageGroup -> Maybe UserContext
createdBy} -> Maybe UserContext
createdBy) (\s :: ModelPackageGroup
s@ModelPackageGroup' {} Maybe UserContext
a -> ModelPackageGroup
s {$sel:createdBy:ModelPackageGroup' :: Maybe UserContext
createdBy = Maybe UserContext
a} :: ModelPackageGroup)

-- | The time that the model group was created.
modelPackageGroup_creationTime :: Lens.Lens' ModelPackageGroup (Prelude.Maybe Prelude.UTCTime)
modelPackageGroup_creationTime :: Lens' ModelPackageGroup (Maybe UTCTime)
modelPackageGroup_creationTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelPackageGroup' {Maybe POSIX
creationTime :: Maybe POSIX
$sel:creationTime:ModelPackageGroup' :: ModelPackageGroup -> Maybe POSIX
creationTime} -> Maybe POSIX
creationTime) (\s :: ModelPackageGroup
s@ModelPackageGroup' {} Maybe POSIX
a -> ModelPackageGroup
s {$sel:creationTime:ModelPackageGroup' :: Maybe POSIX
creationTime = Maybe POSIX
a} :: ModelPackageGroup) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The Amazon Resource Name (ARN) of the model group.
modelPackageGroup_modelPackageGroupArn :: Lens.Lens' ModelPackageGroup (Prelude.Maybe Prelude.Text)
modelPackageGroup_modelPackageGroupArn :: Lens' ModelPackageGroup (Maybe Text)
modelPackageGroup_modelPackageGroupArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelPackageGroup' {Maybe Text
modelPackageGroupArn :: Maybe Text
$sel:modelPackageGroupArn:ModelPackageGroup' :: ModelPackageGroup -> Maybe Text
modelPackageGroupArn} -> Maybe Text
modelPackageGroupArn) (\s :: ModelPackageGroup
s@ModelPackageGroup' {} Maybe Text
a -> ModelPackageGroup
s {$sel:modelPackageGroupArn:ModelPackageGroup' :: Maybe Text
modelPackageGroupArn = Maybe Text
a} :: ModelPackageGroup)

-- | The description for the model group.
modelPackageGroup_modelPackageGroupDescription :: Lens.Lens' ModelPackageGroup (Prelude.Maybe Prelude.Text)
modelPackageGroup_modelPackageGroupDescription :: Lens' ModelPackageGroup (Maybe Text)
modelPackageGroup_modelPackageGroupDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelPackageGroup' {Maybe Text
modelPackageGroupDescription :: Maybe Text
$sel:modelPackageGroupDescription:ModelPackageGroup' :: ModelPackageGroup -> Maybe Text
modelPackageGroupDescription} -> Maybe Text
modelPackageGroupDescription) (\s :: ModelPackageGroup
s@ModelPackageGroup' {} Maybe Text
a -> ModelPackageGroup
s {$sel:modelPackageGroupDescription:ModelPackageGroup' :: Maybe Text
modelPackageGroupDescription = Maybe Text
a} :: ModelPackageGroup)

-- | The name of the model group.
modelPackageGroup_modelPackageGroupName :: Lens.Lens' ModelPackageGroup (Prelude.Maybe Prelude.Text)
modelPackageGroup_modelPackageGroupName :: Lens' ModelPackageGroup (Maybe Text)
modelPackageGroup_modelPackageGroupName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelPackageGroup' {Maybe Text
modelPackageGroupName :: Maybe Text
$sel:modelPackageGroupName:ModelPackageGroup' :: ModelPackageGroup -> Maybe Text
modelPackageGroupName} -> Maybe Text
modelPackageGroupName) (\s :: ModelPackageGroup
s@ModelPackageGroup' {} Maybe Text
a -> ModelPackageGroup
s {$sel:modelPackageGroupName:ModelPackageGroup' :: Maybe Text
modelPackageGroupName = Maybe Text
a} :: ModelPackageGroup)

-- | The status of the model group. This can be one of the following values.
--
-- -   @PENDING@ - The model group is pending being created.
--
-- -   @IN_PROGRESS@ - The model group is in the process of being created.
--
-- -   @COMPLETED@ - The model group was successfully created.
--
-- -   @FAILED@ - The model group failed.
--
-- -   @DELETING@ - The model group is in the process of being deleted.
--
-- -   @DELETE_FAILED@ - SageMaker failed to delete the model group.
modelPackageGroup_modelPackageGroupStatus :: Lens.Lens' ModelPackageGroup (Prelude.Maybe ModelPackageGroupStatus)
modelPackageGroup_modelPackageGroupStatus :: Lens' ModelPackageGroup (Maybe ModelPackageGroupStatus)
modelPackageGroup_modelPackageGroupStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelPackageGroup' {Maybe ModelPackageGroupStatus
modelPackageGroupStatus :: Maybe ModelPackageGroupStatus
$sel:modelPackageGroupStatus:ModelPackageGroup' :: ModelPackageGroup -> Maybe ModelPackageGroupStatus
modelPackageGroupStatus} -> Maybe ModelPackageGroupStatus
modelPackageGroupStatus) (\s :: ModelPackageGroup
s@ModelPackageGroup' {} Maybe ModelPackageGroupStatus
a -> ModelPackageGroup
s {$sel:modelPackageGroupStatus:ModelPackageGroup' :: Maybe ModelPackageGroupStatus
modelPackageGroupStatus = Maybe ModelPackageGroupStatus
a} :: ModelPackageGroup)

-- | A list of the tags associated with the model group. For more
-- information, see
-- <https://docs.aws.amazon.com/general/latest/gr/aws_tagging.html Tagging Amazon Web Services resources>
-- in the /Amazon Web Services General Reference Guide/.
modelPackageGroup_tags :: Lens.Lens' ModelPackageGroup (Prelude.Maybe [Tag])
modelPackageGroup_tags :: Lens' ModelPackageGroup (Maybe [Tag])
modelPackageGroup_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModelPackageGroup' {Maybe [Tag]
tags :: Maybe [Tag]
$sel:tags:ModelPackageGroup' :: ModelPackageGroup -> Maybe [Tag]
tags} -> Maybe [Tag]
tags) (\s :: ModelPackageGroup
s@ModelPackageGroup' {} Maybe [Tag]
a -> ModelPackageGroup
s {$sel:tags:ModelPackageGroup' :: Maybe [Tag]
tags = Maybe [Tag]
a} :: ModelPackageGroup) 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

instance Data.FromJSON ModelPackageGroup where
  parseJSON :: Value -> Parser ModelPackageGroup
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ModelPackageGroup"
      ( \Object
x ->
          Maybe UserContext
-> Maybe POSIX
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe ModelPackageGroupStatus
-> Maybe [Tag]
-> ModelPackageGroup
ModelPackageGroup'
            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
"CreatedBy")
            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
"CreationTime")
            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
"ModelPackageGroupArn")
            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
"ModelPackageGroupDescription")
            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
"ModelPackageGroupName")
            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
"ModelPackageGroupStatus")
            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
"Tags" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable ModelPackageGroup where
  hashWithSalt :: Int -> ModelPackageGroup -> Int
hashWithSalt Int
_salt ModelPackageGroup' {Maybe [Tag]
Maybe Text
Maybe POSIX
Maybe ModelPackageGroupStatus
Maybe UserContext
tags :: Maybe [Tag]
modelPackageGroupStatus :: Maybe ModelPackageGroupStatus
modelPackageGroupName :: Maybe Text
modelPackageGroupDescription :: Maybe Text
modelPackageGroupArn :: Maybe Text
creationTime :: Maybe POSIX
createdBy :: Maybe UserContext
$sel:tags:ModelPackageGroup' :: ModelPackageGroup -> Maybe [Tag]
$sel:modelPackageGroupStatus:ModelPackageGroup' :: ModelPackageGroup -> Maybe ModelPackageGroupStatus
$sel:modelPackageGroupName:ModelPackageGroup' :: ModelPackageGroup -> Maybe Text
$sel:modelPackageGroupDescription:ModelPackageGroup' :: ModelPackageGroup -> Maybe Text
$sel:modelPackageGroupArn:ModelPackageGroup' :: ModelPackageGroup -> Maybe Text
$sel:creationTime:ModelPackageGroup' :: ModelPackageGroup -> Maybe POSIX
$sel:createdBy:ModelPackageGroup' :: ModelPackageGroup -> Maybe UserContext
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe UserContext
createdBy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
creationTime
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
modelPackageGroupArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
modelPackageGroupDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
modelPackageGroupName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ModelPackageGroupStatus
modelPackageGroupStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Tag]
tags

instance Prelude.NFData ModelPackageGroup where
  rnf :: ModelPackageGroup -> ()
rnf ModelPackageGroup' {Maybe [Tag]
Maybe Text
Maybe POSIX
Maybe ModelPackageGroupStatus
Maybe UserContext
tags :: Maybe [Tag]
modelPackageGroupStatus :: Maybe ModelPackageGroupStatus
modelPackageGroupName :: Maybe Text
modelPackageGroupDescription :: Maybe Text
modelPackageGroupArn :: Maybe Text
creationTime :: Maybe POSIX
createdBy :: Maybe UserContext
$sel:tags:ModelPackageGroup' :: ModelPackageGroup -> Maybe [Tag]
$sel:modelPackageGroupStatus:ModelPackageGroup' :: ModelPackageGroup -> Maybe ModelPackageGroupStatus
$sel:modelPackageGroupName:ModelPackageGroup' :: ModelPackageGroup -> Maybe Text
$sel:modelPackageGroupDescription:ModelPackageGroup' :: ModelPackageGroup -> Maybe Text
$sel:modelPackageGroupArn:ModelPackageGroup' :: ModelPackageGroup -> Maybe Text
$sel:creationTime:ModelPackageGroup' :: ModelPackageGroup -> Maybe POSIX
$sel:createdBy:ModelPackageGroup' :: ModelPackageGroup -> Maybe UserContext
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe UserContext
createdBy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
creationTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
modelPackageGroupArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
modelPackageGroupDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
modelPackageGroupName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ModelPackageGroupStatus
modelPackageGroupStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Tag]
tags