{-# 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.SSMSAP.Types.Component
-- 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.SSMSAP.Types.Component 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.SSMSAP.Types.ComponentStatus
import Amazonka.SSMSAP.Types.ComponentType
import Amazonka.SSMSAP.Types.Host

-- |
--
-- /See:/ 'newComponent' smart constructor.
data Component = Component'
  { Component -> Maybe Text
applicationId :: Prelude.Maybe Prelude.Text,
    Component -> Maybe Text
componentId :: Prelude.Maybe Prelude.Text,
    Component -> Maybe ComponentType
componentType :: Prelude.Maybe ComponentType,
    Component -> Maybe [Text]
databases :: Prelude.Maybe [Prelude.Text],
    Component -> Maybe [Host]
hosts :: Prelude.Maybe [Host],
    Component -> Maybe POSIX
lastUpdated :: Prelude.Maybe Data.POSIX,
    Component -> Maybe Text
primaryHost :: Prelude.Maybe Prelude.Text,
    Component -> Maybe ComponentStatus
status :: Prelude.Maybe ComponentStatus
  }
  deriving (Component -> Component -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Component -> Component -> Bool
$c/= :: Component -> Component -> Bool
== :: Component -> Component -> Bool
$c== :: Component -> Component -> Bool
Prelude.Eq, ReadPrec [Component]
ReadPrec Component
Int -> ReadS Component
ReadS [Component]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Component]
$creadListPrec :: ReadPrec [Component]
readPrec :: ReadPrec Component
$creadPrec :: ReadPrec Component
readList :: ReadS [Component]
$creadList :: ReadS [Component]
readsPrec :: Int -> ReadS Component
$creadsPrec :: Int -> ReadS Component
Prelude.Read, Int -> Component -> ShowS
[Component] -> ShowS
Component -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Component] -> ShowS
$cshowList :: [Component] -> ShowS
show :: Component -> String
$cshow :: Component -> String
showsPrec :: Int -> Component -> ShowS
$cshowsPrec :: Int -> Component -> ShowS
Prelude.Show, forall x. Rep Component x -> Component
forall x. Component -> Rep Component x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Component x -> Component
$cfrom :: forall x. Component -> Rep Component x
Prelude.Generic)

-- |
-- Create a value of 'Component' 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:
--
-- 'applicationId', 'component_applicationId' -
--
-- 'componentId', 'component_componentId' -
--
-- 'componentType', 'component_componentType' -
--
-- 'databases', 'component_databases' -
--
-- 'hosts', 'component_hosts' -
--
-- 'lastUpdated', 'component_lastUpdated' -
--
-- 'primaryHost', 'component_primaryHost' -
--
-- 'status', 'component_status' -
newComponent ::
  Component
newComponent :: Component
newComponent =
  Component'
    { $sel:applicationId:Component' :: Maybe Text
applicationId = forall a. Maybe a
Prelude.Nothing,
      $sel:componentId:Component' :: Maybe Text
componentId = forall a. Maybe a
Prelude.Nothing,
      $sel:componentType:Component' :: Maybe ComponentType
componentType = forall a. Maybe a
Prelude.Nothing,
      $sel:databases:Component' :: Maybe [Text]
databases = forall a. Maybe a
Prelude.Nothing,
      $sel:hosts:Component' :: Maybe [Host]
hosts = forall a. Maybe a
Prelude.Nothing,
      $sel:lastUpdated:Component' :: Maybe POSIX
lastUpdated = forall a. Maybe a
Prelude.Nothing,
      $sel:primaryHost:Component' :: Maybe Text
primaryHost = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Component' :: Maybe ComponentStatus
status = forall a. Maybe a
Prelude.Nothing
    }

component_applicationId :: Lens.Lens' Component (Prelude.Maybe Prelude.Text)
component_applicationId :: Lens' Component (Maybe Text)
component_applicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Component' {Maybe Text
applicationId :: Maybe Text
$sel:applicationId:Component' :: Component -> Maybe Text
applicationId} -> Maybe Text
applicationId) (\s :: Component
s@Component' {} Maybe Text
a -> Component
s {$sel:applicationId:Component' :: Maybe Text
applicationId = Maybe Text
a} :: Component)

component_componentId :: Lens.Lens' Component (Prelude.Maybe Prelude.Text)
component_componentId :: Lens' Component (Maybe Text)
component_componentId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Component' {Maybe Text
componentId :: Maybe Text
$sel:componentId:Component' :: Component -> Maybe Text
componentId} -> Maybe Text
componentId) (\s :: Component
s@Component' {} Maybe Text
a -> Component
s {$sel:componentId:Component' :: Maybe Text
componentId = Maybe Text
a} :: Component)

component_componentType :: Lens.Lens' Component (Prelude.Maybe ComponentType)
component_componentType :: Lens' Component (Maybe ComponentType)
component_componentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Component' {Maybe ComponentType
componentType :: Maybe ComponentType
$sel:componentType:Component' :: Component -> Maybe ComponentType
componentType} -> Maybe ComponentType
componentType) (\s :: Component
s@Component' {} Maybe ComponentType
a -> Component
s {$sel:componentType:Component' :: Maybe ComponentType
componentType = Maybe ComponentType
a} :: Component)

component_databases :: Lens.Lens' Component (Prelude.Maybe [Prelude.Text])
component_databases :: Lens' Component (Maybe [Text])
component_databases = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Component' {Maybe [Text]
databases :: Maybe [Text]
$sel:databases:Component' :: Component -> Maybe [Text]
databases} -> Maybe [Text]
databases) (\s :: Component
s@Component' {} Maybe [Text]
a -> Component
s {$sel:databases:Component' :: Maybe [Text]
databases = Maybe [Text]
a} :: Component) 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

component_hosts :: Lens.Lens' Component (Prelude.Maybe [Host])
component_hosts :: Lens' Component (Maybe [Host])
component_hosts = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Component' {Maybe [Host]
hosts :: Maybe [Host]
$sel:hosts:Component' :: Component -> Maybe [Host]
hosts} -> Maybe [Host]
hosts) (\s :: Component
s@Component' {} Maybe [Host]
a -> Component
s {$sel:hosts:Component' :: Maybe [Host]
hosts = Maybe [Host]
a} :: Component) 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

component_lastUpdated :: Lens.Lens' Component (Prelude.Maybe Prelude.UTCTime)
component_lastUpdated :: Lens' Component (Maybe UTCTime)
component_lastUpdated = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Component' {Maybe POSIX
lastUpdated :: Maybe POSIX
$sel:lastUpdated:Component' :: Component -> Maybe POSIX
lastUpdated} -> Maybe POSIX
lastUpdated) (\s :: Component
s@Component' {} Maybe POSIX
a -> Component
s {$sel:lastUpdated:Component' :: Maybe POSIX
lastUpdated = Maybe POSIX
a} :: Component) 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

component_primaryHost :: Lens.Lens' Component (Prelude.Maybe Prelude.Text)
component_primaryHost :: Lens' Component (Maybe Text)
component_primaryHost = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Component' {Maybe Text
primaryHost :: Maybe Text
$sel:primaryHost:Component' :: Component -> Maybe Text
primaryHost} -> Maybe Text
primaryHost) (\s :: Component
s@Component' {} Maybe Text
a -> Component
s {$sel:primaryHost:Component' :: Maybe Text
primaryHost = Maybe Text
a} :: Component)

component_status :: Lens.Lens' Component (Prelude.Maybe ComponentStatus)
component_status :: Lens' Component (Maybe ComponentStatus)
component_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Component' {Maybe ComponentStatus
status :: Maybe ComponentStatus
$sel:status:Component' :: Component -> Maybe ComponentStatus
status} -> Maybe ComponentStatus
status) (\s :: Component
s@Component' {} Maybe ComponentStatus
a -> Component
s {$sel:status:Component' :: Maybe ComponentStatus
status = Maybe ComponentStatus
a} :: Component)

instance Data.FromJSON Component where
  parseJSON :: Value -> Parser Component
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Component"
      ( \Object
x ->
          Maybe Text
-> Maybe Text
-> Maybe ComponentType
-> Maybe [Text]
-> Maybe [Host]
-> Maybe POSIX
-> Maybe Text
-> Maybe ComponentStatus
-> Component
Component'
            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
"ApplicationId")
            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
"ComponentId")
            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
"ComponentType")
            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
"Databases" 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
"Hosts" 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
"LastUpdated")
            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
"PrimaryHost")
            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
"Status")
      )

instance Prelude.Hashable Component where
  hashWithSalt :: Int -> Component -> Int
hashWithSalt Int
_salt Component' {Maybe [Text]
Maybe [Host]
Maybe Text
Maybe POSIX
Maybe ComponentStatus
Maybe ComponentType
status :: Maybe ComponentStatus
primaryHost :: Maybe Text
lastUpdated :: Maybe POSIX
hosts :: Maybe [Host]
databases :: Maybe [Text]
componentType :: Maybe ComponentType
componentId :: Maybe Text
applicationId :: Maybe Text
$sel:status:Component' :: Component -> Maybe ComponentStatus
$sel:primaryHost:Component' :: Component -> Maybe Text
$sel:lastUpdated:Component' :: Component -> Maybe POSIX
$sel:hosts:Component' :: Component -> Maybe [Host]
$sel:databases:Component' :: Component -> Maybe [Text]
$sel:componentType:Component' :: Component -> Maybe ComponentType
$sel:componentId:Component' :: Component -> Maybe Text
$sel:applicationId:Component' :: Component -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
applicationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
componentId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ComponentType
componentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
databases
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Host]
hosts
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
lastUpdated
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
primaryHost
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ComponentStatus
status

instance Prelude.NFData Component where
  rnf :: Component -> ()
rnf Component' {Maybe [Text]
Maybe [Host]
Maybe Text
Maybe POSIX
Maybe ComponentStatus
Maybe ComponentType
status :: Maybe ComponentStatus
primaryHost :: Maybe Text
lastUpdated :: Maybe POSIX
hosts :: Maybe [Host]
databases :: Maybe [Text]
componentType :: Maybe ComponentType
componentId :: Maybe Text
applicationId :: Maybe Text
$sel:status:Component' :: Component -> Maybe ComponentStatus
$sel:primaryHost:Component' :: Component -> Maybe Text
$sel:lastUpdated:Component' :: Component -> Maybe POSIX
$sel:hosts:Component' :: Component -> Maybe [Host]
$sel:databases:Component' :: Component -> Maybe [Text]
$sel:componentType:Component' :: Component -> Maybe ComponentType
$sel:componentId:Component' :: Component -> Maybe Text
$sel:applicationId:Component' :: Component -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
applicationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
componentId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ComponentType
componentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
databases
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Host]
hosts
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
lastUpdated
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
primaryHost
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ComponentStatus
status