{-# 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.Transfer.Types.DescribedServer
-- 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.Transfer.Types.DescribedServer 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.Transfer.Types.Domain
import Amazonka.Transfer.Types.EndpointDetails
import Amazonka.Transfer.Types.EndpointType
import Amazonka.Transfer.Types.IdentityProviderDetails
import Amazonka.Transfer.Types.IdentityProviderType
import Amazonka.Transfer.Types.Protocol
import Amazonka.Transfer.Types.ProtocolDetails
import Amazonka.Transfer.Types.State
import Amazonka.Transfer.Types.Tag
import Amazonka.Transfer.Types.WorkflowDetails

-- | Describes the properties of a file transfer protocol-enabled server that
-- was specified.
--
-- /See:/ 'newDescribedServer' smart constructor.
data DescribedServer = DescribedServer'
  { -- | Specifies the ARN of the Amazon Web ServicesCertificate Manager (ACM)
    -- certificate. Required when @Protocols@ is set to @FTPS@.
    DescribedServer -> Maybe Text
certificate :: Prelude.Maybe Prelude.Text,
    -- | Specifies the domain of the storage system that is used for file
    -- transfers.
    DescribedServer -> Maybe Domain
domain :: Prelude.Maybe Domain,
    -- | The virtual private cloud (VPC) endpoint settings that are configured
    -- for your server. When you host your endpoint within your VPC, you can
    -- make your endpoint accessible only to resources within your VPC, or you
    -- can attach Elastic IP addresses and make your endpoint accessible to
    -- clients over the internet. Your VPC\'s default security groups are
    -- automatically assigned to your endpoint.
    DescribedServer -> Maybe EndpointDetails
endpointDetails :: Prelude.Maybe EndpointDetails,
    -- | Defines the type of endpoint that your server is connected to. If your
    -- server is connected to a VPC endpoint, your server isn\'t accessible
    -- over the public internet.
    DescribedServer -> Maybe EndpointType
endpointType :: Prelude.Maybe EndpointType,
    -- | Specifies the Base64-encoded SHA256 fingerprint of the server\'s host
    -- key. This value is equivalent to the output of the
    -- @ssh-keygen -l -f my-new-server-key@ command.
    DescribedServer -> Maybe Text
hostKeyFingerprint :: Prelude.Maybe Prelude.Text,
    -- | Specifies information to call a customer-supplied authentication API.
    -- This field is not populated when the @IdentityProviderType@ of a server
    -- is @AWS_DIRECTORY_SERVICE@ or @SERVICE_MANAGED@.
    DescribedServer -> Maybe IdentityProviderDetails
identityProviderDetails :: Prelude.Maybe IdentityProviderDetails,
    -- | The mode of authentication for a server. The default value is
    -- @SERVICE_MANAGED@, which allows you to store and access user credentials
    -- within the Transfer Family service.
    --
    -- Use @AWS_DIRECTORY_SERVICE@ to provide access to Active Directory groups
    -- in Directory Service for Microsoft Active Directory or Microsoft Active
    -- Directory in your on-premises environment or in Amazon Web Services
    -- using AD Connector. This option also requires you to provide a Directory
    -- ID by using the @IdentityProviderDetails@ parameter.
    --
    -- Use the @API_GATEWAY@ value to integrate with an identity provider of
    -- your choosing. The @API_GATEWAY@ setting requires you to provide an
    -- Amazon API Gateway endpoint URL to call for authentication by using the
    -- @IdentityProviderDetails@ parameter.
    --
    -- Use the @AWS_LAMBDA@ value to directly use an Lambda function as your
    -- identity provider. If you choose this value, you must specify the ARN
    -- for the Lambda function in the @Function@ parameter or the
    -- @IdentityProviderDetails@ data type.
    DescribedServer -> Maybe IdentityProviderType
identityProviderType :: Prelude.Maybe IdentityProviderType,
    -- | The Amazon Resource Name (ARN) of the Identity and Access Management
    -- (IAM) role that allows a server to turn on Amazon CloudWatch logging for
    -- Amazon S3 or Amazon EFSevents. When set, you can view user activity in
    -- your CloudWatch logs.
    DescribedServer -> Maybe Text
loggingRole :: Prelude.Maybe Prelude.Text,
    -- | Specifies a string to display when users connect to a server. This
    -- string is displayed after the user authenticates.
    --
    -- The SFTP protocol does not support post-authentication display banners.
    DescribedServer -> Maybe Text
postAuthenticationLoginBanner :: Prelude.Maybe Prelude.Text,
    -- | Specifies a string to display when users connect to a server. This
    -- string is displayed before the user authenticates. For example, the
    -- following banner displays details about using the system:
    --
    -- @This system is for the use of authorized users only. Individuals using this computer system without authority, or in excess of their authority, are subject to having all of their activities on this system monitored and recorded by system personnel.@
    DescribedServer -> Maybe Text
preAuthenticationLoginBanner :: Prelude.Maybe Prelude.Text,
    -- | The protocol settings that are configured for your server.
    --
    -- -   To indicate passive mode (for FTP and FTPS protocols), use the
    --     @PassiveIp@ parameter. Enter a single dotted-quad IPv4 address, such
    --     as the external IP address of a firewall, router, or load balancer.
    --
    -- -   To ignore the error that is generated when the client attempts to
    --     use the @SETSTAT@ command on a file that you are uploading to an
    --     Amazon S3 bucket, use the @SetStatOption@ parameter. To have the
    --     Transfer Family server ignore the @SETSTAT@ command and upload files
    --     without needing to make any changes to your SFTP client, set the
    --     value to @ENABLE_NO_OP@. If you set the @SetStatOption@ parameter to
    --     @ENABLE_NO_OP@, Transfer Family generates a log entry to Amazon
    --     CloudWatch Logs, so that you can determine when the client is making
    --     a @SETSTAT@ call.
    --
    -- -   To determine whether your Transfer Family server resumes recent,
    --     negotiated sessions through a unique session ID, use the
    --     @TlsSessionResumptionMode@ parameter.
    --
    -- -   @As2Transports@ indicates the transport method for the AS2 messages.
    --     Currently, only HTTP is supported.
    DescribedServer -> Maybe ProtocolDetails
protocolDetails :: Prelude.Maybe ProtocolDetails,
    -- | Specifies the file transfer protocol or protocols over which your file
    -- transfer protocol client can connect to your server\'s endpoint. The
    -- available protocols are:
    --
    -- -   @SFTP@ (Secure Shell (SSH) File Transfer Protocol): File transfer
    --     over SSH
    --
    -- -   @FTPS@ (File Transfer Protocol Secure): File transfer with TLS
    --     encryption
    --
    -- -   @FTP@ (File Transfer Protocol): Unencrypted file transfer
    --
    -- -   @AS2@ (Applicability Statement 2): used for transporting structured
    --     business-to-business data
    --
    -- -   If you select @FTPS@, you must choose a certificate stored in
    --     Certificate Manager (ACM) which is used to identify your server when
    --     clients connect to it over FTPS.
    --
    -- -   If @Protocol@ includes either @FTP@ or @FTPS@, then the
    --     @EndpointType@ must be @VPC@ and the @IdentityProviderType@ must be
    --     @AWS_DIRECTORY_SERVICE@ or @API_GATEWAY@.
    --
    -- -   If @Protocol@ includes @FTP@, then @AddressAllocationIds@ cannot be
    --     associated.
    --
    -- -   If @Protocol@ is set only to @SFTP@, the @EndpointType@ can be set
    --     to @PUBLIC@ and the @IdentityProviderType@ can be set to
    --     @SERVICE_MANAGED@.
    --
    -- -   If @Protocol@ includes @AS2@, then the @EndpointType@ must be @VPC@,
    --     and domain must be Amazon S3.
    DescribedServer -> Maybe (NonEmpty Protocol)
protocols :: Prelude.Maybe (Prelude.NonEmpty Protocol),
    -- | Specifies the name of the security policy that is attached to the
    -- server.
    DescribedServer -> Maybe Text
securityPolicyName :: Prelude.Maybe Prelude.Text,
    -- | Specifies the unique system-assigned identifier for a server that you
    -- instantiate.
    DescribedServer -> Maybe Text
serverId :: Prelude.Maybe Prelude.Text,
    -- | The condition of the server that was described. A value of @ONLINE@
    -- indicates that the server can accept jobs and transfer files. A @State@
    -- value of @OFFLINE@ means that the server cannot perform file transfer
    -- operations.
    --
    -- The states of @STARTING@ and @STOPPING@ indicate that the server is in
    -- an intermediate state, either not fully able to respond, or not fully
    -- offline. The values of @START_FAILED@ or @STOP_FAILED@ can indicate an
    -- error condition.
    DescribedServer -> Maybe State
state :: Prelude.Maybe State,
    -- | Specifies the key-value pairs that you can use to search for and group
    -- servers that were assigned to the server that was described.
    DescribedServer -> Maybe (NonEmpty Tag)
tags :: Prelude.Maybe (Prelude.NonEmpty Tag),
    -- | Specifies the number of users that are assigned to a server you
    -- specified with the @ServerId@.
    DescribedServer -> Maybe Int
userCount :: Prelude.Maybe Prelude.Int,
    -- | Specifies the workflow ID for the workflow to assign and the execution
    -- role that\'s used for executing the workflow.
    --
    -- In additon to a workflow to execute when a file is uploaded completely,
    -- @WorkflowDeatails@ can also contain a workflow ID (and execution role)
    -- for a workflow to execute on partial upload. A partial upload occurs
    -- when a file is open when the session disconnects.
    DescribedServer -> Maybe WorkflowDetails
workflowDetails :: Prelude.Maybe WorkflowDetails,
    -- | Specifies the unique Amazon Resource Name (ARN) of the server.
    DescribedServer -> Text
arn :: Prelude.Text
  }
  deriving (DescribedServer -> DescribedServer -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribedServer -> DescribedServer -> Bool
$c/= :: DescribedServer -> DescribedServer -> Bool
== :: DescribedServer -> DescribedServer -> Bool
$c== :: DescribedServer -> DescribedServer -> Bool
Prelude.Eq, ReadPrec [DescribedServer]
ReadPrec DescribedServer
Int -> ReadS DescribedServer
ReadS [DescribedServer]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribedServer]
$creadListPrec :: ReadPrec [DescribedServer]
readPrec :: ReadPrec DescribedServer
$creadPrec :: ReadPrec DescribedServer
readList :: ReadS [DescribedServer]
$creadList :: ReadS [DescribedServer]
readsPrec :: Int -> ReadS DescribedServer
$creadsPrec :: Int -> ReadS DescribedServer
Prelude.Read, Int -> DescribedServer -> ShowS
[DescribedServer] -> ShowS
DescribedServer -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribedServer] -> ShowS
$cshowList :: [DescribedServer] -> ShowS
show :: DescribedServer -> String
$cshow :: DescribedServer -> String
showsPrec :: Int -> DescribedServer -> ShowS
$cshowsPrec :: Int -> DescribedServer -> ShowS
Prelude.Show, forall x. Rep DescribedServer x -> DescribedServer
forall x. DescribedServer -> Rep DescribedServer x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribedServer x -> DescribedServer
$cfrom :: forall x. DescribedServer -> Rep DescribedServer x
Prelude.Generic)

-- |
-- Create a value of 'DescribedServer' 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:
--
-- 'certificate', 'describedServer_certificate' - Specifies the ARN of the Amazon Web ServicesCertificate Manager (ACM)
-- certificate. Required when @Protocols@ is set to @FTPS@.
--
-- 'domain', 'describedServer_domain' - Specifies the domain of the storage system that is used for file
-- transfers.
--
-- 'endpointDetails', 'describedServer_endpointDetails' - The virtual private cloud (VPC) endpoint settings that are configured
-- for your server. When you host your endpoint within your VPC, you can
-- make your endpoint accessible only to resources within your VPC, or you
-- can attach Elastic IP addresses and make your endpoint accessible to
-- clients over the internet. Your VPC\'s default security groups are
-- automatically assigned to your endpoint.
--
-- 'endpointType', 'describedServer_endpointType' - Defines the type of endpoint that your server is connected to. If your
-- server is connected to a VPC endpoint, your server isn\'t accessible
-- over the public internet.
--
-- 'hostKeyFingerprint', 'describedServer_hostKeyFingerprint' - Specifies the Base64-encoded SHA256 fingerprint of the server\'s host
-- key. This value is equivalent to the output of the
-- @ssh-keygen -l -f my-new-server-key@ command.
--
-- 'identityProviderDetails', 'describedServer_identityProviderDetails' - Specifies information to call a customer-supplied authentication API.
-- This field is not populated when the @IdentityProviderType@ of a server
-- is @AWS_DIRECTORY_SERVICE@ or @SERVICE_MANAGED@.
--
-- 'identityProviderType', 'describedServer_identityProviderType' - The mode of authentication for a server. The default value is
-- @SERVICE_MANAGED@, which allows you to store and access user credentials
-- within the Transfer Family service.
--
-- Use @AWS_DIRECTORY_SERVICE@ to provide access to Active Directory groups
-- in Directory Service for Microsoft Active Directory or Microsoft Active
-- Directory in your on-premises environment or in Amazon Web Services
-- using AD Connector. This option also requires you to provide a Directory
-- ID by using the @IdentityProviderDetails@ parameter.
--
-- Use the @API_GATEWAY@ value to integrate with an identity provider of
-- your choosing. The @API_GATEWAY@ setting requires you to provide an
-- Amazon API Gateway endpoint URL to call for authentication by using the
-- @IdentityProviderDetails@ parameter.
--
-- Use the @AWS_LAMBDA@ value to directly use an Lambda function as your
-- identity provider. If you choose this value, you must specify the ARN
-- for the Lambda function in the @Function@ parameter or the
-- @IdentityProviderDetails@ data type.
--
-- 'loggingRole', 'describedServer_loggingRole' - The Amazon Resource Name (ARN) of the Identity and Access Management
-- (IAM) role that allows a server to turn on Amazon CloudWatch logging for
-- Amazon S3 or Amazon EFSevents. When set, you can view user activity in
-- your CloudWatch logs.
--
-- 'postAuthenticationLoginBanner', 'describedServer_postAuthenticationLoginBanner' - Specifies a string to display when users connect to a server. This
-- string is displayed after the user authenticates.
--
-- The SFTP protocol does not support post-authentication display banners.
--
-- 'preAuthenticationLoginBanner', 'describedServer_preAuthenticationLoginBanner' - Specifies a string to display when users connect to a server. This
-- string is displayed before the user authenticates. For example, the
-- following banner displays details about using the system:
--
-- @This system is for the use of authorized users only. Individuals using this computer system without authority, or in excess of their authority, are subject to having all of their activities on this system monitored and recorded by system personnel.@
--
-- 'protocolDetails', 'describedServer_protocolDetails' - The protocol settings that are configured for your server.
--
-- -   To indicate passive mode (for FTP and FTPS protocols), use the
--     @PassiveIp@ parameter. Enter a single dotted-quad IPv4 address, such
--     as the external IP address of a firewall, router, or load balancer.
--
-- -   To ignore the error that is generated when the client attempts to
--     use the @SETSTAT@ command on a file that you are uploading to an
--     Amazon S3 bucket, use the @SetStatOption@ parameter. To have the
--     Transfer Family server ignore the @SETSTAT@ command and upload files
--     without needing to make any changes to your SFTP client, set the
--     value to @ENABLE_NO_OP@. If you set the @SetStatOption@ parameter to
--     @ENABLE_NO_OP@, Transfer Family generates a log entry to Amazon
--     CloudWatch Logs, so that you can determine when the client is making
--     a @SETSTAT@ call.
--
-- -   To determine whether your Transfer Family server resumes recent,
--     negotiated sessions through a unique session ID, use the
--     @TlsSessionResumptionMode@ parameter.
--
-- -   @As2Transports@ indicates the transport method for the AS2 messages.
--     Currently, only HTTP is supported.
--
-- 'protocols', 'describedServer_protocols' - Specifies the file transfer protocol or protocols over which your file
-- transfer protocol client can connect to your server\'s endpoint. The
-- available protocols are:
--
-- -   @SFTP@ (Secure Shell (SSH) File Transfer Protocol): File transfer
--     over SSH
--
-- -   @FTPS@ (File Transfer Protocol Secure): File transfer with TLS
--     encryption
--
-- -   @FTP@ (File Transfer Protocol): Unencrypted file transfer
--
-- -   @AS2@ (Applicability Statement 2): used for transporting structured
--     business-to-business data
--
-- -   If you select @FTPS@, you must choose a certificate stored in
--     Certificate Manager (ACM) which is used to identify your server when
--     clients connect to it over FTPS.
--
-- -   If @Protocol@ includes either @FTP@ or @FTPS@, then the
--     @EndpointType@ must be @VPC@ and the @IdentityProviderType@ must be
--     @AWS_DIRECTORY_SERVICE@ or @API_GATEWAY@.
--
-- -   If @Protocol@ includes @FTP@, then @AddressAllocationIds@ cannot be
--     associated.
--
-- -   If @Protocol@ is set only to @SFTP@, the @EndpointType@ can be set
--     to @PUBLIC@ and the @IdentityProviderType@ can be set to
--     @SERVICE_MANAGED@.
--
-- -   If @Protocol@ includes @AS2@, then the @EndpointType@ must be @VPC@,
--     and domain must be Amazon S3.
--
-- 'securityPolicyName', 'describedServer_securityPolicyName' - Specifies the name of the security policy that is attached to the
-- server.
--
-- 'serverId', 'describedServer_serverId' - Specifies the unique system-assigned identifier for a server that you
-- instantiate.
--
-- 'state', 'describedServer_state' - The condition of the server that was described. A value of @ONLINE@
-- indicates that the server can accept jobs and transfer files. A @State@
-- value of @OFFLINE@ means that the server cannot perform file transfer
-- operations.
--
-- The states of @STARTING@ and @STOPPING@ indicate that the server is in
-- an intermediate state, either not fully able to respond, or not fully
-- offline. The values of @START_FAILED@ or @STOP_FAILED@ can indicate an
-- error condition.
--
-- 'tags', 'describedServer_tags' - Specifies the key-value pairs that you can use to search for and group
-- servers that were assigned to the server that was described.
--
-- 'userCount', 'describedServer_userCount' - Specifies the number of users that are assigned to a server you
-- specified with the @ServerId@.
--
-- 'workflowDetails', 'describedServer_workflowDetails' - Specifies the workflow ID for the workflow to assign and the execution
-- role that\'s used for executing the workflow.
--
-- In additon to a workflow to execute when a file is uploaded completely,
-- @WorkflowDeatails@ can also contain a workflow ID (and execution role)
-- for a workflow to execute on partial upload. A partial upload occurs
-- when a file is open when the session disconnects.
--
-- 'arn', 'describedServer_arn' - Specifies the unique Amazon Resource Name (ARN) of the server.
newDescribedServer ::
  -- | 'arn'
  Prelude.Text ->
  DescribedServer
newDescribedServer :: Text -> DescribedServer
newDescribedServer Text
pArn_ =
  DescribedServer'
    { $sel:certificate:DescribedServer' :: Maybe Text
certificate = forall a. Maybe a
Prelude.Nothing,
      $sel:domain:DescribedServer' :: Maybe Domain
domain = forall a. Maybe a
Prelude.Nothing,
      $sel:endpointDetails:DescribedServer' :: Maybe EndpointDetails
endpointDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:endpointType:DescribedServer' :: Maybe EndpointType
endpointType = forall a. Maybe a
Prelude.Nothing,
      $sel:hostKeyFingerprint:DescribedServer' :: Maybe Text
hostKeyFingerprint = forall a. Maybe a
Prelude.Nothing,
      $sel:identityProviderDetails:DescribedServer' :: Maybe IdentityProviderDetails
identityProviderDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:identityProviderType:DescribedServer' :: Maybe IdentityProviderType
identityProviderType = forall a. Maybe a
Prelude.Nothing,
      $sel:loggingRole:DescribedServer' :: Maybe Text
loggingRole = forall a. Maybe a
Prelude.Nothing,
      $sel:postAuthenticationLoginBanner:DescribedServer' :: Maybe Text
postAuthenticationLoginBanner = forall a. Maybe a
Prelude.Nothing,
      $sel:preAuthenticationLoginBanner:DescribedServer' :: Maybe Text
preAuthenticationLoginBanner = forall a. Maybe a
Prelude.Nothing,
      $sel:protocolDetails:DescribedServer' :: Maybe ProtocolDetails
protocolDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:protocols:DescribedServer' :: Maybe (NonEmpty Protocol)
protocols = forall a. Maybe a
Prelude.Nothing,
      $sel:securityPolicyName:DescribedServer' :: Maybe Text
securityPolicyName = forall a. Maybe a
Prelude.Nothing,
      $sel:serverId:DescribedServer' :: Maybe Text
serverId = forall a. Maybe a
Prelude.Nothing,
      $sel:state:DescribedServer' :: Maybe State
state = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:DescribedServer' :: Maybe (NonEmpty Tag)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:userCount:DescribedServer' :: Maybe Int
userCount = forall a. Maybe a
Prelude.Nothing,
      $sel:workflowDetails:DescribedServer' :: Maybe WorkflowDetails
workflowDetails = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:DescribedServer' :: Text
arn = Text
pArn_
    }

-- | Specifies the ARN of the Amazon Web ServicesCertificate Manager (ACM)
-- certificate. Required when @Protocols@ is set to @FTPS@.
describedServer_certificate :: Lens.Lens' DescribedServer (Prelude.Maybe Prelude.Text)
describedServer_certificate :: Lens' DescribedServer (Maybe Text)
describedServer_certificate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe Text
certificate :: Maybe Text
$sel:certificate:DescribedServer' :: DescribedServer -> Maybe Text
certificate} -> Maybe Text
certificate) (\s :: DescribedServer
s@DescribedServer' {} Maybe Text
a -> DescribedServer
s {$sel:certificate:DescribedServer' :: Maybe Text
certificate = Maybe Text
a} :: DescribedServer)

-- | Specifies the domain of the storage system that is used for file
-- transfers.
describedServer_domain :: Lens.Lens' DescribedServer (Prelude.Maybe Domain)
describedServer_domain :: Lens' DescribedServer (Maybe Domain)
describedServer_domain = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe Domain
domain :: Maybe Domain
$sel:domain:DescribedServer' :: DescribedServer -> Maybe Domain
domain} -> Maybe Domain
domain) (\s :: DescribedServer
s@DescribedServer' {} Maybe Domain
a -> DescribedServer
s {$sel:domain:DescribedServer' :: Maybe Domain
domain = Maybe Domain
a} :: DescribedServer)

-- | The virtual private cloud (VPC) endpoint settings that are configured
-- for your server. When you host your endpoint within your VPC, you can
-- make your endpoint accessible only to resources within your VPC, or you
-- can attach Elastic IP addresses and make your endpoint accessible to
-- clients over the internet. Your VPC\'s default security groups are
-- automatically assigned to your endpoint.
describedServer_endpointDetails :: Lens.Lens' DescribedServer (Prelude.Maybe EndpointDetails)
describedServer_endpointDetails :: Lens' DescribedServer (Maybe EndpointDetails)
describedServer_endpointDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe EndpointDetails
endpointDetails :: Maybe EndpointDetails
$sel:endpointDetails:DescribedServer' :: DescribedServer -> Maybe EndpointDetails
endpointDetails} -> Maybe EndpointDetails
endpointDetails) (\s :: DescribedServer
s@DescribedServer' {} Maybe EndpointDetails
a -> DescribedServer
s {$sel:endpointDetails:DescribedServer' :: Maybe EndpointDetails
endpointDetails = Maybe EndpointDetails
a} :: DescribedServer)

-- | Defines the type of endpoint that your server is connected to. If your
-- server is connected to a VPC endpoint, your server isn\'t accessible
-- over the public internet.
describedServer_endpointType :: Lens.Lens' DescribedServer (Prelude.Maybe EndpointType)
describedServer_endpointType :: Lens' DescribedServer (Maybe EndpointType)
describedServer_endpointType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe EndpointType
endpointType :: Maybe EndpointType
$sel:endpointType:DescribedServer' :: DescribedServer -> Maybe EndpointType
endpointType} -> Maybe EndpointType
endpointType) (\s :: DescribedServer
s@DescribedServer' {} Maybe EndpointType
a -> DescribedServer
s {$sel:endpointType:DescribedServer' :: Maybe EndpointType
endpointType = Maybe EndpointType
a} :: DescribedServer)

-- | Specifies the Base64-encoded SHA256 fingerprint of the server\'s host
-- key. This value is equivalent to the output of the
-- @ssh-keygen -l -f my-new-server-key@ command.
describedServer_hostKeyFingerprint :: Lens.Lens' DescribedServer (Prelude.Maybe Prelude.Text)
describedServer_hostKeyFingerprint :: Lens' DescribedServer (Maybe Text)
describedServer_hostKeyFingerprint = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe Text
hostKeyFingerprint :: Maybe Text
$sel:hostKeyFingerprint:DescribedServer' :: DescribedServer -> Maybe Text
hostKeyFingerprint} -> Maybe Text
hostKeyFingerprint) (\s :: DescribedServer
s@DescribedServer' {} Maybe Text
a -> DescribedServer
s {$sel:hostKeyFingerprint:DescribedServer' :: Maybe Text
hostKeyFingerprint = Maybe Text
a} :: DescribedServer)

-- | Specifies information to call a customer-supplied authentication API.
-- This field is not populated when the @IdentityProviderType@ of a server
-- is @AWS_DIRECTORY_SERVICE@ or @SERVICE_MANAGED@.
describedServer_identityProviderDetails :: Lens.Lens' DescribedServer (Prelude.Maybe IdentityProviderDetails)
describedServer_identityProviderDetails :: Lens' DescribedServer (Maybe IdentityProviderDetails)
describedServer_identityProviderDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe IdentityProviderDetails
identityProviderDetails :: Maybe IdentityProviderDetails
$sel:identityProviderDetails:DescribedServer' :: DescribedServer -> Maybe IdentityProviderDetails
identityProviderDetails} -> Maybe IdentityProviderDetails
identityProviderDetails) (\s :: DescribedServer
s@DescribedServer' {} Maybe IdentityProviderDetails
a -> DescribedServer
s {$sel:identityProviderDetails:DescribedServer' :: Maybe IdentityProviderDetails
identityProviderDetails = Maybe IdentityProviderDetails
a} :: DescribedServer)

-- | The mode of authentication for a server. The default value is
-- @SERVICE_MANAGED@, which allows you to store and access user credentials
-- within the Transfer Family service.
--
-- Use @AWS_DIRECTORY_SERVICE@ to provide access to Active Directory groups
-- in Directory Service for Microsoft Active Directory or Microsoft Active
-- Directory in your on-premises environment or in Amazon Web Services
-- using AD Connector. This option also requires you to provide a Directory
-- ID by using the @IdentityProviderDetails@ parameter.
--
-- Use the @API_GATEWAY@ value to integrate with an identity provider of
-- your choosing. The @API_GATEWAY@ setting requires you to provide an
-- Amazon API Gateway endpoint URL to call for authentication by using the
-- @IdentityProviderDetails@ parameter.
--
-- Use the @AWS_LAMBDA@ value to directly use an Lambda function as your
-- identity provider. If you choose this value, you must specify the ARN
-- for the Lambda function in the @Function@ parameter or the
-- @IdentityProviderDetails@ data type.
describedServer_identityProviderType :: Lens.Lens' DescribedServer (Prelude.Maybe IdentityProviderType)
describedServer_identityProviderType :: Lens' DescribedServer (Maybe IdentityProviderType)
describedServer_identityProviderType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe IdentityProviderType
identityProviderType :: Maybe IdentityProviderType
$sel:identityProviderType:DescribedServer' :: DescribedServer -> Maybe IdentityProviderType
identityProviderType} -> Maybe IdentityProviderType
identityProviderType) (\s :: DescribedServer
s@DescribedServer' {} Maybe IdentityProviderType
a -> DescribedServer
s {$sel:identityProviderType:DescribedServer' :: Maybe IdentityProviderType
identityProviderType = Maybe IdentityProviderType
a} :: DescribedServer)

-- | The Amazon Resource Name (ARN) of the Identity and Access Management
-- (IAM) role that allows a server to turn on Amazon CloudWatch logging for
-- Amazon S3 or Amazon EFSevents. When set, you can view user activity in
-- your CloudWatch logs.
describedServer_loggingRole :: Lens.Lens' DescribedServer (Prelude.Maybe Prelude.Text)
describedServer_loggingRole :: Lens' DescribedServer (Maybe Text)
describedServer_loggingRole = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe Text
loggingRole :: Maybe Text
$sel:loggingRole:DescribedServer' :: DescribedServer -> Maybe Text
loggingRole} -> Maybe Text
loggingRole) (\s :: DescribedServer
s@DescribedServer' {} Maybe Text
a -> DescribedServer
s {$sel:loggingRole:DescribedServer' :: Maybe Text
loggingRole = Maybe Text
a} :: DescribedServer)

-- | Specifies a string to display when users connect to a server. This
-- string is displayed after the user authenticates.
--
-- The SFTP protocol does not support post-authentication display banners.
describedServer_postAuthenticationLoginBanner :: Lens.Lens' DescribedServer (Prelude.Maybe Prelude.Text)
describedServer_postAuthenticationLoginBanner :: Lens' DescribedServer (Maybe Text)
describedServer_postAuthenticationLoginBanner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe Text
postAuthenticationLoginBanner :: Maybe Text
$sel:postAuthenticationLoginBanner:DescribedServer' :: DescribedServer -> Maybe Text
postAuthenticationLoginBanner} -> Maybe Text
postAuthenticationLoginBanner) (\s :: DescribedServer
s@DescribedServer' {} Maybe Text
a -> DescribedServer
s {$sel:postAuthenticationLoginBanner:DescribedServer' :: Maybe Text
postAuthenticationLoginBanner = Maybe Text
a} :: DescribedServer)

-- | Specifies a string to display when users connect to a server. This
-- string is displayed before the user authenticates. For example, the
-- following banner displays details about using the system:
--
-- @This system is for the use of authorized users only. Individuals using this computer system without authority, or in excess of their authority, are subject to having all of their activities on this system monitored and recorded by system personnel.@
describedServer_preAuthenticationLoginBanner :: Lens.Lens' DescribedServer (Prelude.Maybe Prelude.Text)
describedServer_preAuthenticationLoginBanner :: Lens' DescribedServer (Maybe Text)
describedServer_preAuthenticationLoginBanner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe Text
preAuthenticationLoginBanner :: Maybe Text
$sel:preAuthenticationLoginBanner:DescribedServer' :: DescribedServer -> Maybe Text
preAuthenticationLoginBanner} -> Maybe Text
preAuthenticationLoginBanner) (\s :: DescribedServer
s@DescribedServer' {} Maybe Text
a -> DescribedServer
s {$sel:preAuthenticationLoginBanner:DescribedServer' :: Maybe Text
preAuthenticationLoginBanner = Maybe Text
a} :: DescribedServer)

-- | The protocol settings that are configured for your server.
--
-- -   To indicate passive mode (for FTP and FTPS protocols), use the
--     @PassiveIp@ parameter. Enter a single dotted-quad IPv4 address, such
--     as the external IP address of a firewall, router, or load balancer.
--
-- -   To ignore the error that is generated when the client attempts to
--     use the @SETSTAT@ command on a file that you are uploading to an
--     Amazon S3 bucket, use the @SetStatOption@ parameter. To have the
--     Transfer Family server ignore the @SETSTAT@ command and upload files
--     without needing to make any changes to your SFTP client, set the
--     value to @ENABLE_NO_OP@. If you set the @SetStatOption@ parameter to
--     @ENABLE_NO_OP@, Transfer Family generates a log entry to Amazon
--     CloudWatch Logs, so that you can determine when the client is making
--     a @SETSTAT@ call.
--
-- -   To determine whether your Transfer Family server resumes recent,
--     negotiated sessions through a unique session ID, use the
--     @TlsSessionResumptionMode@ parameter.
--
-- -   @As2Transports@ indicates the transport method for the AS2 messages.
--     Currently, only HTTP is supported.
describedServer_protocolDetails :: Lens.Lens' DescribedServer (Prelude.Maybe ProtocolDetails)
describedServer_protocolDetails :: Lens' DescribedServer (Maybe ProtocolDetails)
describedServer_protocolDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe ProtocolDetails
protocolDetails :: Maybe ProtocolDetails
$sel:protocolDetails:DescribedServer' :: DescribedServer -> Maybe ProtocolDetails
protocolDetails} -> Maybe ProtocolDetails
protocolDetails) (\s :: DescribedServer
s@DescribedServer' {} Maybe ProtocolDetails
a -> DescribedServer
s {$sel:protocolDetails:DescribedServer' :: Maybe ProtocolDetails
protocolDetails = Maybe ProtocolDetails
a} :: DescribedServer)

-- | Specifies the file transfer protocol or protocols over which your file
-- transfer protocol client can connect to your server\'s endpoint. The
-- available protocols are:
--
-- -   @SFTP@ (Secure Shell (SSH) File Transfer Protocol): File transfer
--     over SSH
--
-- -   @FTPS@ (File Transfer Protocol Secure): File transfer with TLS
--     encryption
--
-- -   @FTP@ (File Transfer Protocol): Unencrypted file transfer
--
-- -   @AS2@ (Applicability Statement 2): used for transporting structured
--     business-to-business data
--
-- -   If you select @FTPS@, you must choose a certificate stored in
--     Certificate Manager (ACM) which is used to identify your server when
--     clients connect to it over FTPS.
--
-- -   If @Protocol@ includes either @FTP@ or @FTPS@, then the
--     @EndpointType@ must be @VPC@ and the @IdentityProviderType@ must be
--     @AWS_DIRECTORY_SERVICE@ or @API_GATEWAY@.
--
-- -   If @Protocol@ includes @FTP@, then @AddressAllocationIds@ cannot be
--     associated.
--
-- -   If @Protocol@ is set only to @SFTP@, the @EndpointType@ can be set
--     to @PUBLIC@ and the @IdentityProviderType@ can be set to
--     @SERVICE_MANAGED@.
--
-- -   If @Protocol@ includes @AS2@, then the @EndpointType@ must be @VPC@,
--     and domain must be Amazon S3.
describedServer_protocols :: Lens.Lens' DescribedServer (Prelude.Maybe (Prelude.NonEmpty Protocol))
describedServer_protocols :: Lens' DescribedServer (Maybe (NonEmpty Protocol))
describedServer_protocols = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe (NonEmpty Protocol)
protocols :: Maybe (NonEmpty Protocol)
$sel:protocols:DescribedServer' :: DescribedServer -> Maybe (NonEmpty Protocol)
protocols} -> Maybe (NonEmpty Protocol)
protocols) (\s :: DescribedServer
s@DescribedServer' {} Maybe (NonEmpty Protocol)
a -> DescribedServer
s {$sel:protocols:DescribedServer' :: Maybe (NonEmpty Protocol)
protocols = Maybe (NonEmpty Protocol)
a} :: DescribedServer) 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

-- | Specifies the name of the security policy that is attached to the
-- server.
describedServer_securityPolicyName :: Lens.Lens' DescribedServer (Prelude.Maybe Prelude.Text)
describedServer_securityPolicyName :: Lens' DescribedServer (Maybe Text)
describedServer_securityPolicyName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe Text
securityPolicyName :: Maybe Text
$sel:securityPolicyName:DescribedServer' :: DescribedServer -> Maybe Text
securityPolicyName} -> Maybe Text
securityPolicyName) (\s :: DescribedServer
s@DescribedServer' {} Maybe Text
a -> DescribedServer
s {$sel:securityPolicyName:DescribedServer' :: Maybe Text
securityPolicyName = Maybe Text
a} :: DescribedServer)

-- | Specifies the unique system-assigned identifier for a server that you
-- instantiate.
describedServer_serverId :: Lens.Lens' DescribedServer (Prelude.Maybe Prelude.Text)
describedServer_serverId :: Lens' DescribedServer (Maybe Text)
describedServer_serverId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe Text
serverId :: Maybe Text
$sel:serverId:DescribedServer' :: DescribedServer -> Maybe Text
serverId} -> Maybe Text
serverId) (\s :: DescribedServer
s@DescribedServer' {} Maybe Text
a -> DescribedServer
s {$sel:serverId:DescribedServer' :: Maybe Text
serverId = Maybe Text
a} :: DescribedServer)

-- | The condition of the server that was described. A value of @ONLINE@
-- indicates that the server can accept jobs and transfer files. A @State@
-- value of @OFFLINE@ means that the server cannot perform file transfer
-- operations.
--
-- The states of @STARTING@ and @STOPPING@ indicate that the server is in
-- an intermediate state, either not fully able to respond, or not fully
-- offline. The values of @START_FAILED@ or @STOP_FAILED@ can indicate an
-- error condition.
describedServer_state :: Lens.Lens' DescribedServer (Prelude.Maybe State)
describedServer_state :: Lens' DescribedServer (Maybe State)
describedServer_state = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe State
state :: Maybe State
$sel:state:DescribedServer' :: DescribedServer -> Maybe State
state} -> Maybe State
state) (\s :: DescribedServer
s@DescribedServer' {} Maybe State
a -> DescribedServer
s {$sel:state:DescribedServer' :: Maybe State
state = Maybe State
a} :: DescribedServer)

-- | Specifies the key-value pairs that you can use to search for and group
-- servers that were assigned to the server that was described.
describedServer_tags :: Lens.Lens' DescribedServer (Prelude.Maybe (Prelude.NonEmpty Tag))
describedServer_tags :: Lens' DescribedServer (Maybe (NonEmpty Tag))
describedServer_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe (NonEmpty Tag)
tags :: Maybe (NonEmpty Tag)
$sel:tags:DescribedServer' :: DescribedServer -> Maybe (NonEmpty Tag)
tags} -> Maybe (NonEmpty Tag)
tags) (\s :: DescribedServer
s@DescribedServer' {} Maybe (NonEmpty Tag)
a -> DescribedServer
s {$sel:tags:DescribedServer' :: Maybe (NonEmpty Tag)
tags = Maybe (NonEmpty Tag)
a} :: DescribedServer) 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

-- | Specifies the number of users that are assigned to a server you
-- specified with the @ServerId@.
describedServer_userCount :: Lens.Lens' DescribedServer (Prelude.Maybe Prelude.Int)
describedServer_userCount :: Lens' DescribedServer (Maybe Int)
describedServer_userCount = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe Int
userCount :: Maybe Int
$sel:userCount:DescribedServer' :: DescribedServer -> Maybe Int
userCount} -> Maybe Int
userCount) (\s :: DescribedServer
s@DescribedServer' {} Maybe Int
a -> DescribedServer
s {$sel:userCount:DescribedServer' :: Maybe Int
userCount = Maybe Int
a} :: DescribedServer)

-- | Specifies the workflow ID for the workflow to assign and the execution
-- role that\'s used for executing the workflow.
--
-- In additon to a workflow to execute when a file is uploaded completely,
-- @WorkflowDeatails@ can also contain a workflow ID (and execution role)
-- for a workflow to execute on partial upload. A partial upload occurs
-- when a file is open when the session disconnects.
describedServer_workflowDetails :: Lens.Lens' DescribedServer (Prelude.Maybe WorkflowDetails)
describedServer_workflowDetails :: Lens' DescribedServer (Maybe WorkflowDetails)
describedServer_workflowDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Maybe WorkflowDetails
workflowDetails :: Maybe WorkflowDetails
$sel:workflowDetails:DescribedServer' :: DescribedServer -> Maybe WorkflowDetails
workflowDetails} -> Maybe WorkflowDetails
workflowDetails) (\s :: DescribedServer
s@DescribedServer' {} Maybe WorkflowDetails
a -> DescribedServer
s {$sel:workflowDetails:DescribedServer' :: Maybe WorkflowDetails
workflowDetails = Maybe WorkflowDetails
a} :: DescribedServer)

-- | Specifies the unique Amazon Resource Name (ARN) of the server.
describedServer_arn :: Lens.Lens' DescribedServer Prelude.Text
describedServer_arn :: Lens' DescribedServer Text
describedServer_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribedServer' {Text
arn :: Text
$sel:arn:DescribedServer' :: DescribedServer -> Text
arn} -> Text
arn) (\s :: DescribedServer
s@DescribedServer' {} Text
a -> DescribedServer
s {$sel:arn:DescribedServer' :: Text
arn = Text
a} :: DescribedServer)

instance Data.FromJSON DescribedServer where
  parseJSON :: Value -> Parser DescribedServer
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"DescribedServer"
      ( \Object
x ->
          Maybe Text
-> Maybe Domain
-> Maybe EndpointDetails
-> Maybe EndpointType
-> Maybe Text
-> Maybe IdentityProviderDetails
-> Maybe IdentityProviderType
-> Maybe Text
-> Maybe Text
-> Maybe Text
-> Maybe ProtocolDetails
-> Maybe (NonEmpty Protocol)
-> Maybe Text
-> Maybe Text
-> Maybe State
-> Maybe (NonEmpty Tag)
-> Maybe Int
-> Maybe WorkflowDetails
-> Text
-> DescribedServer
DescribedServer'
            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
"Certificate")
            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
"Domain")
            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
"EndpointDetails")
            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
"EndpointType")
            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
"HostKeyFingerprint")
            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
"IdentityProviderDetails")
            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
"IdentityProviderType")
            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
"LoggingRole")
            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
"PostAuthenticationLoginBanner")
            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
"PreAuthenticationLoginBanner")
            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
"ProtocolDetails")
            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
"Protocols")
            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
"SecurityPolicyName")
            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
"ServerId")
            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
"State")
            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 (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
"UserCount")
            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
"WorkflowDetails")
            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")
      )

instance Prelude.Hashable DescribedServer where
  hashWithSalt :: Int -> DescribedServer -> Int
hashWithSalt Int
_salt DescribedServer' {Maybe Int
Maybe (NonEmpty Protocol)
Maybe (NonEmpty Tag)
Maybe Text
Maybe Domain
Maybe EndpointDetails
Maybe EndpointType
Maybe IdentityProviderDetails
Maybe IdentityProviderType
Maybe State
Maybe ProtocolDetails
Maybe WorkflowDetails
Text
arn :: Text
workflowDetails :: Maybe WorkflowDetails
userCount :: Maybe Int
tags :: Maybe (NonEmpty Tag)
state :: Maybe State
serverId :: Maybe Text
securityPolicyName :: Maybe Text
protocols :: Maybe (NonEmpty Protocol)
protocolDetails :: Maybe ProtocolDetails
preAuthenticationLoginBanner :: Maybe Text
postAuthenticationLoginBanner :: Maybe Text
loggingRole :: Maybe Text
identityProviderType :: Maybe IdentityProviderType
identityProviderDetails :: Maybe IdentityProviderDetails
hostKeyFingerprint :: Maybe Text
endpointType :: Maybe EndpointType
endpointDetails :: Maybe EndpointDetails
domain :: Maybe Domain
certificate :: Maybe Text
$sel:arn:DescribedServer' :: DescribedServer -> Text
$sel:workflowDetails:DescribedServer' :: DescribedServer -> Maybe WorkflowDetails
$sel:userCount:DescribedServer' :: DescribedServer -> Maybe Int
$sel:tags:DescribedServer' :: DescribedServer -> Maybe (NonEmpty Tag)
$sel:state:DescribedServer' :: DescribedServer -> Maybe State
$sel:serverId:DescribedServer' :: DescribedServer -> Maybe Text
$sel:securityPolicyName:DescribedServer' :: DescribedServer -> Maybe Text
$sel:protocols:DescribedServer' :: DescribedServer -> Maybe (NonEmpty Protocol)
$sel:protocolDetails:DescribedServer' :: DescribedServer -> Maybe ProtocolDetails
$sel:preAuthenticationLoginBanner:DescribedServer' :: DescribedServer -> Maybe Text
$sel:postAuthenticationLoginBanner:DescribedServer' :: DescribedServer -> Maybe Text
$sel:loggingRole:DescribedServer' :: DescribedServer -> Maybe Text
$sel:identityProviderType:DescribedServer' :: DescribedServer -> Maybe IdentityProviderType
$sel:identityProviderDetails:DescribedServer' :: DescribedServer -> Maybe IdentityProviderDetails
$sel:hostKeyFingerprint:DescribedServer' :: DescribedServer -> Maybe Text
$sel:endpointType:DescribedServer' :: DescribedServer -> Maybe EndpointType
$sel:endpointDetails:DescribedServer' :: DescribedServer -> Maybe EndpointDetails
$sel:domain:DescribedServer' :: DescribedServer -> Maybe Domain
$sel:certificate:DescribedServer' :: DescribedServer -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
certificate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Domain
domain
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EndpointDetails
endpointDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EndpointType
endpointType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
hostKeyFingerprint
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IdentityProviderDetails
identityProviderDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe IdentityProviderType
identityProviderType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
loggingRole
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
postAuthenticationLoginBanner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
preAuthenticationLoginBanner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ProtocolDetails
protocolDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Protocol)
protocols
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
securityPolicyName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
serverId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe State
state
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Tag)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Int
userCount
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe WorkflowDetails
workflowDetails
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn

instance Prelude.NFData DescribedServer where
  rnf :: DescribedServer -> ()
rnf DescribedServer' {Maybe Int
Maybe (NonEmpty Protocol)
Maybe (NonEmpty Tag)
Maybe Text
Maybe Domain
Maybe EndpointDetails
Maybe EndpointType
Maybe IdentityProviderDetails
Maybe IdentityProviderType
Maybe State
Maybe ProtocolDetails
Maybe WorkflowDetails
Text
arn :: Text
workflowDetails :: Maybe WorkflowDetails
userCount :: Maybe Int
tags :: Maybe (NonEmpty Tag)
state :: Maybe State
serverId :: Maybe Text
securityPolicyName :: Maybe Text
protocols :: Maybe (NonEmpty Protocol)
protocolDetails :: Maybe ProtocolDetails
preAuthenticationLoginBanner :: Maybe Text
postAuthenticationLoginBanner :: Maybe Text
loggingRole :: Maybe Text
identityProviderType :: Maybe IdentityProviderType
identityProviderDetails :: Maybe IdentityProviderDetails
hostKeyFingerprint :: Maybe Text
endpointType :: Maybe EndpointType
endpointDetails :: Maybe EndpointDetails
domain :: Maybe Domain
certificate :: Maybe Text
$sel:arn:DescribedServer' :: DescribedServer -> Text
$sel:workflowDetails:DescribedServer' :: DescribedServer -> Maybe WorkflowDetails
$sel:userCount:DescribedServer' :: DescribedServer -> Maybe Int
$sel:tags:DescribedServer' :: DescribedServer -> Maybe (NonEmpty Tag)
$sel:state:DescribedServer' :: DescribedServer -> Maybe State
$sel:serverId:DescribedServer' :: DescribedServer -> Maybe Text
$sel:securityPolicyName:DescribedServer' :: DescribedServer -> Maybe Text
$sel:protocols:DescribedServer' :: DescribedServer -> Maybe (NonEmpty Protocol)
$sel:protocolDetails:DescribedServer' :: DescribedServer -> Maybe ProtocolDetails
$sel:preAuthenticationLoginBanner:DescribedServer' :: DescribedServer -> Maybe Text
$sel:postAuthenticationLoginBanner:DescribedServer' :: DescribedServer -> Maybe Text
$sel:loggingRole:DescribedServer' :: DescribedServer -> Maybe Text
$sel:identityProviderType:DescribedServer' :: DescribedServer -> Maybe IdentityProviderType
$sel:identityProviderDetails:DescribedServer' :: DescribedServer -> Maybe IdentityProviderDetails
$sel:hostKeyFingerprint:DescribedServer' :: DescribedServer -> Maybe Text
$sel:endpointType:DescribedServer' :: DescribedServer -> Maybe EndpointType
$sel:endpointDetails:DescribedServer' :: DescribedServer -> Maybe EndpointDetails
$sel:domain:DescribedServer' :: DescribedServer -> Maybe Domain
$sel:certificate:DescribedServer' :: DescribedServer -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
certificate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Domain
domain
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EndpointDetails
endpointDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EndpointType
endpointType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
hostKeyFingerprint
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IdentityProviderDetails
identityProviderDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe IdentityProviderType
identityProviderType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
loggingRole
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
postAuthenticationLoginBanner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
preAuthenticationLoginBanner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ProtocolDetails
protocolDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Protocol)
protocols
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
securityPolicyName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
serverId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe State
state
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Tag)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Int
userCount
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe WorkflowDetails
workflowDetails
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn