{-# 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.OpsWorksCM.Types.Server
-- 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.OpsWorksCM.Types.Server where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.OpsWorksCM.Types.EngineAttribute
import Amazonka.OpsWorksCM.Types.MaintenanceStatus
import Amazonka.OpsWorksCM.Types.ServerStatus
import qualified Amazonka.Prelude as Prelude

-- | Describes a configuration management server.
--
-- /See:/ 'newServer' smart constructor.
data Server = Server'
  { -- | Associate a public IP address with a server that you are launching.
    Server -> Maybe Bool
associatePublicIpAddress :: Prelude.Maybe Prelude.Bool,
    -- | The number of automated backups to keep.
    Server -> Maybe Int
backupRetentionCount :: Prelude.Maybe Prelude.Int,
    -- | The ARN of the CloudFormation stack that was used to create the server.
    Server -> Maybe Text
cloudFormationStackArn :: Prelude.Maybe Prelude.Text,
    -- | Time stamp of server creation. Example @2016-07-29T13:38:47.520Z@
    Server -> Maybe POSIX
createdAt :: Prelude.Maybe Data.POSIX,
    -- | An optional public endpoint of a server, such as
    -- @https:\/\/aws.my-company.com@. You cannot access the server by using
    -- the @Endpoint@ value if the server has a @CustomDomain@ specified.
    Server -> Maybe Text
customDomain :: Prelude.Maybe Prelude.Text,
    -- | Disables automated backups. The number of stored backups is dependent on
    -- the value of PreferredBackupCount.
    Server -> Maybe Bool
disableAutomatedBackup :: Prelude.Maybe Prelude.Bool,
    -- | A DNS name that can be used to access the engine. Example:
    -- @myserver-asdfghjkl.us-east-1.opsworks.io@. You cannot access the server
    -- by using the @Endpoint@ value if the server has a @CustomDomain@
    -- specified.
    Server -> Maybe Text
endpoint :: Prelude.Maybe Prelude.Text,
    -- | The engine type of the server. Valid values in this release include
    -- @ChefAutomate@ and @Puppet@.
    Server -> Maybe Text
engine :: Prelude.Maybe Prelude.Text,
    -- | The response of a createServer() request returns the master credential
    -- to access the server in EngineAttributes. These credentials are not
    -- stored by AWS OpsWorks CM; they are returned only as part of the result
    -- of createServer().
    --
    -- __Attributes returned in a createServer response for Chef__
    --
    -- -   @CHEF_AUTOMATE_PIVOTAL_KEY@: A base64-encoded RSA private key that
    --     is generated by AWS OpsWorks for Chef Automate. This private key is
    --     required to access the Chef API.
    --
    -- -   @CHEF_STARTER_KIT@: A base64-encoded ZIP file. The ZIP file contains
    --     a Chef starter kit, which includes a README, a configuration file,
    --     and the required RSA private key. Save this file, unzip it, and then
    --     change to the directory where you\'ve unzipped the file contents.
    --     From this directory, you can run Knife commands.
    --
    -- __Attributes returned in a createServer response for Puppet__
    --
    -- -   @PUPPET_STARTER_KIT@: A base64-encoded ZIP file. The ZIP file
    --     contains a Puppet starter kit, including a README and a required
    --     private key. Save this file, unzip it, and then change to the
    --     directory where you\'ve unzipped the file contents.
    --
    -- -   @PUPPET_ADMIN_PASSWORD@: An administrator password that you can use
    --     to sign in to the Puppet Enterprise console after the server is
    --     online.
    Server -> Maybe [EngineAttribute]
engineAttributes :: Prelude.Maybe [EngineAttribute],
    -- | The engine model of the server. Valid values in this release include
    -- @Monolithic@ for Puppet and @Single@ for Chef.
    Server -> Maybe Text
engineModel :: Prelude.Maybe Prelude.Text,
    -- | The engine version of the server. For a Chef server, the valid value for
    -- EngineVersion is currently @2@. For a Puppet server, specify either
    -- @2019@ or @2017@.
    Server -> Maybe Text
engineVersion :: Prelude.Maybe Prelude.Text,
    -- | The instance profile ARN of the server.
    Server -> Maybe Text
instanceProfileArn :: Prelude.Maybe Prelude.Text,
    -- | The instance type for the server, as specified in the CloudFormation
    -- stack. This might not be the same instance type that is shown in the EC2
    -- console.
    Server -> Maybe Text
instanceType :: Prelude.Maybe Prelude.Text,
    -- | The key pair associated with the server.
    Server -> Maybe Text
keyPair :: Prelude.Maybe Prelude.Text,
    -- | The status of the most recent server maintenance run. Shows @SUCCESS@ or
    -- @FAILED@.
    Server -> Maybe MaintenanceStatus
maintenanceStatus :: Prelude.Maybe MaintenanceStatus,
    -- | The preferred backup period specified for the server.
    Server -> Maybe Text
preferredBackupWindow :: Prelude.Maybe Prelude.Text,
    -- | The preferred maintenance period specified for the server.
    Server -> Maybe Text
preferredMaintenanceWindow :: Prelude.Maybe Prelude.Text,
    -- | The security group IDs for the server, as specified in the
    -- CloudFormation stack. These might not be the same security groups that
    -- are shown in the EC2 console.
    Server -> Maybe [Text]
securityGroupIds :: Prelude.Maybe [Prelude.Text],
    -- | The ARN of the server.
    Server -> Maybe Text
serverArn :: Prelude.Maybe Prelude.Text,
    -- | The name of the server.
    Server -> Maybe Text
serverName :: Prelude.Maybe Prelude.Text,
    -- | The service role ARN used to create the server.
    Server -> Maybe Text
serviceRoleArn :: Prelude.Maybe Prelude.Text,
    -- | The server\'s status. This field displays the states of actions in
    -- progress, such as creating, running, or backing up the server, as well
    -- as the server\'s health state.
    Server -> Maybe ServerStatus
status :: Prelude.Maybe ServerStatus,
    -- | Depending on the server status, this field has either a human-readable
    -- message (such as a create or backup error), or an escaped block of JSON
    -- (used for health check results).
    Server -> Maybe Text
statusReason :: Prelude.Maybe Prelude.Text,
    -- | The subnet IDs specified in a CreateServer request.
    Server -> Maybe [Text]
subnetIds :: Prelude.Maybe [Prelude.Text]
  }
  deriving (Server -> Server -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Server -> Server -> Bool
$c/= :: Server -> Server -> Bool
== :: Server -> Server -> Bool
$c== :: Server -> Server -> Bool
Prelude.Eq, Int -> Server -> ShowS
[Server] -> ShowS
Server -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Server] -> ShowS
$cshowList :: [Server] -> ShowS
show :: Server -> String
$cshow :: Server -> String
showsPrec :: Int -> Server -> ShowS
$cshowsPrec :: Int -> Server -> ShowS
Prelude.Show, forall x. Rep Server x -> Server
forall x. Server -> Rep Server x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Server x -> Server
$cfrom :: forall x. Server -> Rep Server x
Prelude.Generic)

-- |
-- Create a value of 'Server' 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:
--
-- 'associatePublicIpAddress', 'server_associatePublicIpAddress' - Associate a public IP address with a server that you are launching.
--
-- 'backupRetentionCount', 'server_backupRetentionCount' - The number of automated backups to keep.
--
-- 'cloudFormationStackArn', 'server_cloudFormationStackArn' - The ARN of the CloudFormation stack that was used to create the server.
--
-- 'createdAt', 'server_createdAt' - Time stamp of server creation. Example @2016-07-29T13:38:47.520Z@
--
-- 'customDomain', 'server_customDomain' - An optional public endpoint of a server, such as
-- @https:\/\/aws.my-company.com@. You cannot access the server by using
-- the @Endpoint@ value if the server has a @CustomDomain@ specified.
--
-- 'disableAutomatedBackup', 'server_disableAutomatedBackup' - Disables automated backups. The number of stored backups is dependent on
-- the value of PreferredBackupCount.
--
-- 'endpoint', 'server_endpoint' - A DNS name that can be used to access the engine. Example:
-- @myserver-asdfghjkl.us-east-1.opsworks.io@. You cannot access the server
-- by using the @Endpoint@ value if the server has a @CustomDomain@
-- specified.
--
-- 'engine', 'server_engine' - The engine type of the server. Valid values in this release include
-- @ChefAutomate@ and @Puppet@.
--
-- 'engineAttributes', 'server_engineAttributes' - The response of a createServer() request returns the master credential
-- to access the server in EngineAttributes. These credentials are not
-- stored by AWS OpsWorks CM; they are returned only as part of the result
-- of createServer().
--
-- __Attributes returned in a createServer response for Chef__
--
-- -   @CHEF_AUTOMATE_PIVOTAL_KEY@: A base64-encoded RSA private key that
--     is generated by AWS OpsWorks for Chef Automate. This private key is
--     required to access the Chef API.
--
-- -   @CHEF_STARTER_KIT@: A base64-encoded ZIP file. The ZIP file contains
--     a Chef starter kit, which includes a README, a configuration file,
--     and the required RSA private key. Save this file, unzip it, and then
--     change to the directory where you\'ve unzipped the file contents.
--     From this directory, you can run Knife commands.
--
-- __Attributes returned in a createServer response for Puppet__
--
-- -   @PUPPET_STARTER_KIT@: A base64-encoded ZIP file. The ZIP file
--     contains a Puppet starter kit, including a README and a required
--     private key. Save this file, unzip it, and then change to the
--     directory where you\'ve unzipped the file contents.
--
-- -   @PUPPET_ADMIN_PASSWORD@: An administrator password that you can use
--     to sign in to the Puppet Enterprise console after the server is
--     online.
--
-- 'engineModel', 'server_engineModel' - The engine model of the server. Valid values in this release include
-- @Monolithic@ for Puppet and @Single@ for Chef.
--
-- 'engineVersion', 'server_engineVersion' - The engine version of the server. For a Chef server, the valid value for
-- EngineVersion is currently @2@. For a Puppet server, specify either
-- @2019@ or @2017@.
--
-- 'instanceProfileArn', 'server_instanceProfileArn' - The instance profile ARN of the server.
--
-- 'instanceType', 'server_instanceType' - The instance type for the server, as specified in the CloudFormation
-- stack. This might not be the same instance type that is shown in the EC2
-- console.
--
-- 'keyPair', 'server_keyPair' - The key pair associated with the server.
--
-- 'maintenanceStatus', 'server_maintenanceStatus' - The status of the most recent server maintenance run. Shows @SUCCESS@ or
-- @FAILED@.
--
-- 'preferredBackupWindow', 'server_preferredBackupWindow' - The preferred backup period specified for the server.
--
-- 'preferredMaintenanceWindow', 'server_preferredMaintenanceWindow' - The preferred maintenance period specified for the server.
--
-- 'securityGroupIds', 'server_securityGroupIds' - The security group IDs for the server, as specified in the
-- CloudFormation stack. These might not be the same security groups that
-- are shown in the EC2 console.
--
-- 'serverArn', 'server_serverArn' - The ARN of the server.
--
-- 'serverName', 'server_serverName' - The name of the server.
--
-- 'serviceRoleArn', 'server_serviceRoleArn' - The service role ARN used to create the server.
--
-- 'status', 'server_status' - The server\'s status. This field displays the states of actions in
-- progress, such as creating, running, or backing up the server, as well
-- as the server\'s health state.
--
-- 'statusReason', 'server_statusReason' - Depending on the server status, this field has either a human-readable
-- message (such as a create or backup error), or an escaped block of JSON
-- (used for health check results).
--
-- 'subnetIds', 'server_subnetIds' - The subnet IDs specified in a CreateServer request.
newServer ::
  Server
newServer :: Server
newServer =
  Server'
    { $sel:associatePublicIpAddress:Server' :: Maybe Bool
associatePublicIpAddress = forall a. Maybe a
Prelude.Nothing,
      $sel:backupRetentionCount:Server' :: Maybe Int
backupRetentionCount = forall a. Maybe a
Prelude.Nothing,
      $sel:cloudFormationStackArn:Server' :: Maybe Text
cloudFormationStackArn = forall a. Maybe a
Prelude.Nothing,
      $sel:createdAt:Server' :: Maybe POSIX
createdAt = forall a. Maybe a
Prelude.Nothing,
      $sel:customDomain:Server' :: Maybe Text
customDomain = forall a. Maybe a
Prelude.Nothing,
      $sel:disableAutomatedBackup:Server' :: Maybe Bool
disableAutomatedBackup = forall a. Maybe a
Prelude.Nothing,
      $sel:endpoint:Server' :: Maybe Text
endpoint = forall a. Maybe a
Prelude.Nothing,
      $sel:engine:Server' :: Maybe Text
engine = forall a. Maybe a
Prelude.Nothing,
      $sel:engineAttributes:Server' :: Maybe [EngineAttribute]
engineAttributes = forall a. Maybe a
Prelude.Nothing,
      $sel:engineModel:Server' :: Maybe Text
engineModel = forall a. Maybe a
Prelude.Nothing,
      $sel:engineVersion:Server' :: Maybe Text
engineVersion = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceProfileArn:Server' :: Maybe Text
instanceProfileArn = forall a. Maybe a
Prelude.Nothing,
      $sel:instanceType:Server' :: Maybe Text
instanceType = forall a. Maybe a
Prelude.Nothing,
      $sel:keyPair:Server' :: Maybe Text
keyPair = forall a. Maybe a
Prelude.Nothing,
      $sel:maintenanceStatus:Server' :: Maybe MaintenanceStatus
maintenanceStatus = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredBackupWindow:Server' :: Maybe Text
preferredBackupWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:preferredMaintenanceWindow:Server' :: Maybe Text
preferredMaintenanceWindow = forall a. Maybe a
Prelude.Nothing,
      $sel:securityGroupIds:Server' :: Maybe [Text]
securityGroupIds = forall a. Maybe a
Prelude.Nothing,
      $sel:serverArn:Server' :: Maybe Text
serverArn = forall a. Maybe a
Prelude.Nothing,
      $sel:serverName:Server' :: Maybe Text
serverName = forall a. Maybe a
Prelude.Nothing,
      $sel:serviceRoleArn:Server' :: Maybe Text
serviceRoleArn = forall a. Maybe a
Prelude.Nothing,
      $sel:status:Server' :: Maybe ServerStatus
status = forall a. Maybe a
Prelude.Nothing,
      $sel:statusReason:Server' :: Maybe Text
statusReason = forall a. Maybe a
Prelude.Nothing,
      $sel:subnetIds:Server' :: Maybe [Text]
subnetIds = forall a. Maybe a
Prelude.Nothing
    }

-- | Associate a public IP address with a server that you are launching.
server_associatePublicIpAddress :: Lens.Lens' Server (Prelude.Maybe Prelude.Bool)
server_associatePublicIpAddress :: Lens' Server (Maybe Bool)
server_associatePublicIpAddress = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Bool
associatePublicIpAddress :: Maybe Bool
$sel:associatePublicIpAddress:Server' :: Server -> Maybe Bool
associatePublicIpAddress} -> Maybe Bool
associatePublicIpAddress) (\s :: Server
s@Server' {} Maybe Bool
a -> Server
s {$sel:associatePublicIpAddress:Server' :: Maybe Bool
associatePublicIpAddress = Maybe Bool
a} :: Server)

-- | The number of automated backups to keep.
server_backupRetentionCount :: Lens.Lens' Server (Prelude.Maybe Prelude.Int)
server_backupRetentionCount :: Lens' Server (Maybe Int)
server_backupRetentionCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Int
backupRetentionCount :: Maybe Int
$sel:backupRetentionCount:Server' :: Server -> Maybe Int
backupRetentionCount} -> Maybe Int
backupRetentionCount) (\s :: Server
s@Server' {} Maybe Int
a -> Server
s {$sel:backupRetentionCount:Server' :: Maybe Int
backupRetentionCount = Maybe Int
a} :: Server)

-- | The ARN of the CloudFormation stack that was used to create the server.
server_cloudFormationStackArn :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_cloudFormationStackArn :: Lens' Server (Maybe Text)
server_cloudFormationStackArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
cloudFormationStackArn :: Maybe Text
$sel:cloudFormationStackArn:Server' :: Server -> Maybe Text
cloudFormationStackArn} -> Maybe Text
cloudFormationStackArn) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:cloudFormationStackArn:Server' :: Maybe Text
cloudFormationStackArn = Maybe Text
a} :: Server)

-- | Time stamp of server creation. Example @2016-07-29T13:38:47.520Z@
server_createdAt :: Lens.Lens' Server (Prelude.Maybe Prelude.UTCTime)
server_createdAt :: Lens' Server (Maybe UTCTime)
server_createdAt = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe POSIX
createdAt :: Maybe POSIX
$sel:createdAt:Server' :: Server -> Maybe POSIX
createdAt} -> Maybe POSIX
createdAt) (\s :: Server
s@Server' {} Maybe POSIX
a -> Server
s {$sel:createdAt:Server' :: Maybe POSIX
createdAt = Maybe POSIX
a} :: Server) 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

-- | An optional public endpoint of a server, such as
-- @https:\/\/aws.my-company.com@. You cannot access the server by using
-- the @Endpoint@ value if the server has a @CustomDomain@ specified.
server_customDomain :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_customDomain :: Lens' Server (Maybe Text)
server_customDomain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
customDomain :: Maybe Text
$sel:customDomain:Server' :: Server -> Maybe Text
customDomain} -> Maybe Text
customDomain) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:customDomain:Server' :: Maybe Text
customDomain = Maybe Text
a} :: Server)

-- | Disables automated backups. The number of stored backups is dependent on
-- the value of PreferredBackupCount.
server_disableAutomatedBackup :: Lens.Lens' Server (Prelude.Maybe Prelude.Bool)
server_disableAutomatedBackup :: Lens' Server (Maybe Bool)
server_disableAutomatedBackup = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Bool
disableAutomatedBackup :: Maybe Bool
$sel:disableAutomatedBackup:Server' :: Server -> Maybe Bool
disableAutomatedBackup} -> Maybe Bool
disableAutomatedBackup) (\s :: Server
s@Server' {} Maybe Bool
a -> Server
s {$sel:disableAutomatedBackup:Server' :: Maybe Bool
disableAutomatedBackup = Maybe Bool
a} :: Server)

-- | A DNS name that can be used to access the engine. Example:
-- @myserver-asdfghjkl.us-east-1.opsworks.io@. You cannot access the server
-- by using the @Endpoint@ value if the server has a @CustomDomain@
-- specified.
server_endpoint :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_endpoint :: Lens' Server (Maybe Text)
server_endpoint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
endpoint :: Maybe Text
$sel:endpoint:Server' :: Server -> Maybe Text
endpoint} -> Maybe Text
endpoint) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:endpoint:Server' :: Maybe Text
endpoint = Maybe Text
a} :: Server)

-- | The engine type of the server. Valid values in this release include
-- @ChefAutomate@ and @Puppet@.
server_engine :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_engine :: Lens' Server (Maybe Text)
server_engine = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
engine :: Maybe Text
$sel:engine:Server' :: Server -> Maybe Text
engine} -> Maybe Text
engine) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:engine:Server' :: Maybe Text
engine = Maybe Text
a} :: Server)

-- | The response of a createServer() request returns the master credential
-- to access the server in EngineAttributes. These credentials are not
-- stored by AWS OpsWorks CM; they are returned only as part of the result
-- of createServer().
--
-- __Attributes returned in a createServer response for Chef__
--
-- -   @CHEF_AUTOMATE_PIVOTAL_KEY@: A base64-encoded RSA private key that
--     is generated by AWS OpsWorks for Chef Automate. This private key is
--     required to access the Chef API.
--
-- -   @CHEF_STARTER_KIT@: A base64-encoded ZIP file. The ZIP file contains
--     a Chef starter kit, which includes a README, a configuration file,
--     and the required RSA private key. Save this file, unzip it, and then
--     change to the directory where you\'ve unzipped the file contents.
--     From this directory, you can run Knife commands.
--
-- __Attributes returned in a createServer response for Puppet__
--
-- -   @PUPPET_STARTER_KIT@: A base64-encoded ZIP file. The ZIP file
--     contains a Puppet starter kit, including a README and a required
--     private key. Save this file, unzip it, and then change to the
--     directory where you\'ve unzipped the file contents.
--
-- -   @PUPPET_ADMIN_PASSWORD@: An administrator password that you can use
--     to sign in to the Puppet Enterprise console after the server is
--     online.
server_engineAttributes :: Lens.Lens' Server (Prelude.Maybe [EngineAttribute])
server_engineAttributes :: Lens' Server (Maybe [EngineAttribute])
server_engineAttributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe [EngineAttribute]
engineAttributes :: Maybe [EngineAttribute]
$sel:engineAttributes:Server' :: Server -> Maybe [EngineAttribute]
engineAttributes} -> Maybe [EngineAttribute]
engineAttributes) (\s :: Server
s@Server' {} Maybe [EngineAttribute]
a -> Server
s {$sel:engineAttributes:Server' :: Maybe [EngineAttribute]
engineAttributes = Maybe [EngineAttribute]
a} :: Server) 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 engine model of the server. Valid values in this release include
-- @Monolithic@ for Puppet and @Single@ for Chef.
server_engineModel :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_engineModel :: Lens' Server (Maybe Text)
server_engineModel = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
engineModel :: Maybe Text
$sel:engineModel:Server' :: Server -> Maybe Text
engineModel} -> Maybe Text
engineModel) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:engineModel:Server' :: Maybe Text
engineModel = Maybe Text
a} :: Server)

-- | The engine version of the server. For a Chef server, the valid value for
-- EngineVersion is currently @2@. For a Puppet server, specify either
-- @2019@ or @2017@.
server_engineVersion :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_engineVersion :: Lens' Server (Maybe Text)
server_engineVersion = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
engineVersion :: Maybe Text
$sel:engineVersion:Server' :: Server -> Maybe Text
engineVersion} -> Maybe Text
engineVersion) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:engineVersion:Server' :: Maybe Text
engineVersion = Maybe Text
a} :: Server)

-- | The instance profile ARN of the server.
server_instanceProfileArn :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_instanceProfileArn :: Lens' Server (Maybe Text)
server_instanceProfileArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
instanceProfileArn :: Maybe Text
$sel:instanceProfileArn:Server' :: Server -> Maybe Text
instanceProfileArn} -> Maybe Text
instanceProfileArn) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:instanceProfileArn:Server' :: Maybe Text
instanceProfileArn = Maybe Text
a} :: Server)

-- | The instance type for the server, as specified in the CloudFormation
-- stack. This might not be the same instance type that is shown in the EC2
-- console.
server_instanceType :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_instanceType :: Lens' Server (Maybe Text)
server_instanceType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
instanceType :: Maybe Text
$sel:instanceType:Server' :: Server -> Maybe Text
instanceType} -> Maybe Text
instanceType) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:instanceType:Server' :: Maybe Text
instanceType = Maybe Text
a} :: Server)

-- | The key pair associated with the server.
server_keyPair :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_keyPair :: Lens' Server (Maybe Text)
server_keyPair = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
keyPair :: Maybe Text
$sel:keyPair:Server' :: Server -> Maybe Text
keyPair} -> Maybe Text
keyPair) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:keyPair:Server' :: Maybe Text
keyPair = Maybe Text
a} :: Server)

-- | The status of the most recent server maintenance run. Shows @SUCCESS@ or
-- @FAILED@.
server_maintenanceStatus :: Lens.Lens' Server (Prelude.Maybe MaintenanceStatus)
server_maintenanceStatus :: Lens' Server (Maybe MaintenanceStatus)
server_maintenanceStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe MaintenanceStatus
maintenanceStatus :: Maybe MaintenanceStatus
$sel:maintenanceStatus:Server' :: Server -> Maybe MaintenanceStatus
maintenanceStatus} -> Maybe MaintenanceStatus
maintenanceStatus) (\s :: Server
s@Server' {} Maybe MaintenanceStatus
a -> Server
s {$sel:maintenanceStatus:Server' :: Maybe MaintenanceStatus
maintenanceStatus = Maybe MaintenanceStatus
a} :: Server)

-- | The preferred backup period specified for the server.
server_preferredBackupWindow :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_preferredBackupWindow :: Lens' Server (Maybe Text)
server_preferredBackupWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
preferredBackupWindow :: Maybe Text
$sel:preferredBackupWindow:Server' :: Server -> Maybe Text
preferredBackupWindow} -> Maybe Text
preferredBackupWindow) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:preferredBackupWindow:Server' :: Maybe Text
preferredBackupWindow = Maybe Text
a} :: Server)

-- | The preferred maintenance period specified for the server.
server_preferredMaintenanceWindow :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_preferredMaintenanceWindow :: Lens' Server (Maybe Text)
server_preferredMaintenanceWindow = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
preferredMaintenanceWindow :: Maybe Text
$sel:preferredMaintenanceWindow:Server' :: Server -> Maybe Text
preferredMaintenanceWindow} -> Maybe Text
preferredMaintenanceWindow) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:preferredMaintenanceWindow:Server' :: Maybe Text
preferredMaintenanceWindow = Maybe Text
a} :: Server)

-- | The security group IDs for the server, as specified in the
-- CloudFormation stack. These might not be the same security groups that
-- are shown in the EC2 console.
server_securityGroupIds :: Lens.Lens' Server (Prelude.Maybe [Prelude.Text])
server_securityGroupIds :: Lens' Server (Maybe [Text])
server_securityGroupIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe [Text]
securityGroupIds :: Maybe [Text]
$sel:securityGroupIds:Server' :: Server -> Maybe [Text]
securityGroupIds} -> Maybe [Text]
securityGroupIds) (\s :: Server
s@Server' {} Maybe [Text]
a -> Server
s {$sel:securityGroupIds:Server' :: Maybe [Text]
securityGroupIds = Maybe [Text]
a} :: Server) 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 ARN of the server.
server_serverArn :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_serverArn :: Lens' Server (Maybe Text)
server_serverArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
serverArn :: Maybe Text
$sel:serverArn:Server' :: Server -> Maybe Text
serverArn} -> Maybe Text
serverArn) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:serverArn:Server' :: Maybe Text
serverArn = Maybe Text
a} :: Server)

-- | The name of the server.
server_serverName :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_serverName :: Lens' Server (Maybe Text)
server_serverName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
serverName :: Maybe Text
$sel:serverName:Server' :: Server -> Maybe Text
serverName} -> Maybe Text
serverName) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:serverName:Server' :: Maybe Text
serverName = Maybe Text
a} :: Server)

-- | The service role ARN used to create the server.
server_serviceRoleArn :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_serviceRoleArn :: Lens' Server (Maybe Text)
server_serviceRoleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
serviceRoleArn :: Maybe Text
$sel:serviceRoleArn:Server' :: Server -> Maybe Text
serviceRoleArn} -> Maybe Text
serviceRoleArn) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:serviceRoleArn:Server' :: Maybe Text
serviceRoleArn = Maybe Text
a} :: Server)

-- | The server\'s status. This field displays the states of actions in
-- progress, such as creating, running, or backing up the server, as well
-- as the server\'s health state.
server_status :: Lens.Lens' Server (Prelude.Maybe ServerStatus)
server_status :: Lens' Server (Maybe ServerStatus)
server_status = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe ServerStatus
status :: Maybe ServerStatus
$sel:status:Server' :: Server -> Maybe ServerStatus
status} -> Maybe ServerStatus
status) (\s :: Server
s@Server' {} Maybe ServerStatus
a -> Server
s {$sel:status:Server' :: Maybe ServerStatus
status = Maybe ServerStatus
a} :: Server)

-- | Depending on the server status, this field has either a human-readable
-- message (such as a create or backup error), or an escaped block of JSON
-- (used for health check results).
server_statusReason :: Lens.Lens' Server (Prelude.Maybe Prelude.Text)
server_statusReason :: Lens' Server (Maybe Text)
server_statusReason = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe Text
statusReason :: Maybe Text
$sel:statusReason:Server' :: Server -> Maybe Text
statusReason} -> Maybe Text
statusReason) (\s :: Server
s@Server' {} Maybe Text
a -> Server
s {$sel:statusReason:Server' :: Maybe Text
statusReason = Maybe Text
a} :: Server)

-- | The subnet IDs specified in a CreateServer request.
server_subnetIds :: Lens.Lens' Server (Prelude.Maybe [Prelude.Text])
server_subnetIds :: Lens' Server (Maybe [Text])
server_subnetIds = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Server' {Maybe [Text]
subnetIds :: Maybe [Text]
$sel:subnetIds:Server' :: Server -> Maybe [Text]
subnetIds} -> Maybe [Text]
subnetIds) (\s :: Server
s@Server' {} Maybe [Text]
a -> Server
s {$sel:subnetIds:Server' :: Maybe [Text]
subnetIds = Maybe [Text]
a} :: Server) 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 Server where
  parseJSON :: Value -> Parser Server
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"Server"
      ( \Object
x ->
          Maybe Bool
-> Maybe Int
-> Maybe Text
-> Maybe POSIX
-> Maybe Text
-> Maybe Bool
-> Maybe Text
-> Maybe Text
-> Maybe [EngineAttribute]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe MaintenanceStatus
-> Maybe Text
-> Maybe Text
-> Maybe [Text]
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe ServerStatus
-> Maybe Text
-> Maybe [Text]
-> Server
Server'
            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
"AssociatePublicIpAddress")
            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
"BackupRetentionCount")
            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
"CloudFormationStackArn")
            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
"CreatedAt")
            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
"CustomDomain")
            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
"DisableAutomatedBackup")
            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
"Endpoint")
            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
"Engine")
            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
"EngineAttributes"
                            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
"EngineModel")
            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
"EngineVersion")
            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
"InstanceProfileArn")
            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
"InstanceType")
            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
"KeyPair")
            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
"MaintenanceStatus")
            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
"PreferredBackupWindow")
            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
"PreferredMaintenanceWindow")
            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
"SecurityGroupIds"
                            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
"ServerArn")
            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
"ServerName")
            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
"ServiceRoleArn")
            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")
            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
"StatusReason")
            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
"SubnetIds" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable Server where
  hashWithSalt :: Int -> Server -> Int
hashWithSalt Int
_salt Server' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [EngineAttribute]
Maybe Text
Maybe POSIX
Maybe MaintenanceStatus
Maybe ServerStatus
subnetIds :: Maybe [Text]
statusReason :: Maybe Text
status :: Maybe ServerStatus
serviceRoleArn :: Maybe Text
serverName :: Maybe Text
serverArn :: Maybe Text
securityGroupIds :: Maybe [Text]
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
maintenanceStatus :: Maybe MaintenanceStatus
keyPair :: Maybe Text
instanceType :: Maybe Text
instanceProfileArn :: Maybe Text
engineVersion :: Maybe Text
engineModel :: Maybe Text
engineAttributes :: Maybe [EngineAttribute]
engine :: Maybe Text
endpoint :: Maybe Text
disableAutomatedBackup :: Maybe Bool
customDomain :: Maybe Text
createdAt :: Maybe POSIX
cloudFormationStackArn :: Maybe Text
backupRetentionCount :: Maybe Int
associatePublicIpAddress :: Maybe Bool
$sel:subnetIds:Server' :: Server -> Maybe [Text]
$sel:statusReason:Server' :: Server -> Maybe Text
$sel:status:Server' :: Server -> Maybe ServerStatus
$sel:serviceRoleArn:Server' :: Server -> Maybe Text
$sel:serverName:Server' :: Server -> Maybe Text
$sel:serverArn:Server' :: Server -> Maybe Text
$sel:securityGroupIds:Server' :: Server -> Maybe [Text]
$sel:preferredMaintenanceWindow:Server' :: Server -> Maybe Text
$sel:preferredBackupWindow:Server' :: Server -> Maybe Text
$sel:maintenanceStatus:Server' :: Server -> Maybe MaintenanceStatus
$sel:keyPair:Server' :: Server -> Maybe Text
$sel:instanceType:Server' :: Server -> Maybe Text
$sel:instanceProfileArn:Server' :: Server -> Maybe Text
$sel:engineVersion:Server' :: Server -> Maybe Text
$sel:engineModel:Server' :: Server -> Maybe Text
$sel:engineAttributes:Server' :: Server -> Maybe [EngineAttribute]
$sel:engine:Server' :: Server -> Maybe Text
$sel:endpoint:Server' :: Server -> Maybe Text
$sel:disableAutomatedBackup:Server' :: Server -> Maybe Bool
$sel:customDomain:Server' :: Server -> Maybe Text
$sel:createdAt:Server' :: Server -> Maybe POSIX
$sel:cloudFormationStackArn:Server' :: Server -> Maybe Text
$sel:backupRetentionCount:Server' :: Server -> Maybe Int
$sel:associatePublicIpAddress:Server' :: Server -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
associatePublicIpAddress
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
backupRetentionCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
cloudFormationStackArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
createdAt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
customDomain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
disableAutomatedBackup
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
endpoint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engine
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [EngineAttribute]
engineAttributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineModel
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
engineVersion
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceProfileArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
instanceType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
keyPair
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MaintenanceStatus
maintenanceStatus
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredBackupWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preferredMaintenanceWindow
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
securityGroupIds
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serverArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serverName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serviceRoleArn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ServerStatus
status
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
statusReason
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
subnetIds

instance Prelude.NFData Server where
  rnf :: Server -> ()
rnf Server' {Maybe Bool
Maybe Int
Maybe [Text]
Maybe [EngineAttribute]
Maybe Text
Maybe POSIX
Maybe MaintenanceStatus
Maybe ServerStatus
subnetIds :: Maybe [Text]
statusReason :: Maybe Text
status :: Maybe ServerStatus
serviceRoleArn :: Maybe Text
serverName :: Maybe Text
serverArn :: Maybe Text
securityGroupIds :: Maybe [Text]
preferredMaintenanceWindow :: Maybe Text
preferredBackupWindow :: Maybe Text
maintenanceStatus :: Maybe MaintenanceStatus
keyPair :: Maybe Text
instanceType :: Maybe Text
instanceProfileArn :: Maybe Text
engineVersion :: Maybe Text
engineModel :: Maybe Text
engineAttributes :: Maybe [EngineAttribute]
engine :: Maybe Text
endpoint :: Maybe Text
disableAutomatedBackup :: Maybe Bool
customDomain :: Maybe Text
createdAt :: Maybe POSIX
cloudFormationStackArn :: Maybe Text
backupRetentionCount :: Maybe Int
associatePublicIpAddress :: Maybe Bool
$sel:subnetIds:Server' :: Server -> Maybe [Text]
$sel:statusReason:Server' :: Server -> Maybe Text
$sel:status:Server' :: Server -> Maybe ServerStatus
$sel:serviceRoleArn:Server' :: Server -> Maybe Text
$sel:serverName:Server' :: Server -> Maybe Text
$sel:serverArn:Server' :: Server -> Maybe Text
$sel:securityGroupIds:Server' :: Server -> Maybe [Text]
$sel:preferredMaintenanceWindow:Server' :: Server -> Maybe Text
$sel:preferredBackupWindow:Server' :: Server -> Maybe Text
$sel:maintenanceStatus:Server' :: Server -> Maybe MaintenanceStatus
$sel:keyPair:Server' :: Server -> Maybe Text
$sel:instanceType:Server' :: Server -> Maybe Text
$sel:instanceProfileArn:Server' :: Server -> Maybe Text
$sel:engineVersion:Server' :: Server -> Maybe Text
$sel:engineModel:Server' :: Server -> Maybe Text
$sel:engineAttributes:Server' :: Server -> Maybe [EngineAttribute]
$sel:engine:Server' :: Server -> Maybe Text
$sel:endpoint:Server' :: Server -> Maybe Text
$sel:disableAutomatedBackup:Server' :: Server -> Maybe Bool
$sel:customDomain:Server' :: Server -> Maybe Text
$sel:createdAt:Server' :: Server -> Maybe POSIX
$sel:cloudFormationStackArn:Server' :: Server -> Maybe Text
$sel:backupRetentionCount:Server' :: Server -> Maybe Int
$sel:associatePublicIpAddress:Server' :: Server -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
associatePublicIpAddress
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
backupRetentionCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
cloudFormationStackArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
createdAt
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
customDomain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
disableAutomatedBackup
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
endpoint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engine
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [EngineAttribute]
engineAttributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineModel
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
engineVersion
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceProfileArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
instanceType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
keyPair
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MaintenanceStatus
maintenanceStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
preferredBackupWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf
        Maybe Text
preferredMaintenanceWindow
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
securityGroupIds
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serverArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serverName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serviceRoleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ServerStatus
status
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
statusReason
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
subnetIds