{-# 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.As2ConnectorConfig
-- 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.As2ConnectorConfig 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.CompressionEnum
import Amazonka.Transfer.Types.EncryptionAlg
import Amazonka.Transfer.Types.MdnResponse
import Amazonka.Transfer.Types.MdnSigningAlg
import Amazonka.Transfer.Types.SigningAlg

-- | Contains the details for a connector object. The connector object is
-- used for AS2 outbound processes, to connect the Transfer Family customer
-- with the trading partner.
--
-- /See:/ 'newAs2ConnectorConfig' smart constructor.
data As2ConnectorConfig = As2ConnectorConfig'
  { -- | Specifies whether the AS2 file is compressed.
    As2ConnectorConfig -> Maybe CompressionEnum
compression :: Prelude.Maybe CompressionEnum,
    -- | The algorithm that is used to encrypt the file.
    As2ConnectorConfig -> Maybe EncryptionAlg
encryptionAlgorithm :: Prelude.Maybe EncryptionAlg,
    -- | A unique identifier for the AS2 local profile.
    As2ConnectorConfig -> Maybe Text
localProfileId :: Prelude.Maybe Prelude.Text,
    -- | Used for outbound requests (from an Transfer Family server to a partner
    -- AS2 server) to determine whether the partner response for transfers is
    -- synchronous or asynchronous. Specify either of the following values:
    --
    -- -   @SYNC@: The system expects a synchronous MDN response, confirming
    --     that the file was transferred successfully (or not).
    --
    -- -   @NONE@: Specifies that no MDN response is required.
    As2ConnectorConfig -> Maybe MdnResponse
mdnResponse :: Prelude.Maybe MdnResponse,
    -- | The signing algorithm for the MDN response.
    --
    -- If set to DEFAULT (or not set at all), the value for @SigningAlogorithm@
    -- is used.
    As2ConnectorConfig -> Maybe MdnSigningAlg
mdnSigningAlgorithm :: Prelude.Maybe MdnSigningAlg,
    -- | Used as the @Subject@ HTTP header attribute in AS2 messages that are
    -- being sent with the connector.
    As2ConnectorConfig -> Maybe Text
messageSubject :: Prelude.Maybe Prelude.Text,
    -- | A unique identifier for the partner profile for the connector.
    As2ConnectorConfig -> Maybe Text
partnerProfileId :: Prelude.Maybe Prelude.Text,
    -- | The algorithm that is used to sign the AS2 messages sent with the
    -- connector.
    As2ConnectorConfig -> Maybe SigningAlg
signingAlgorithm :: Prelude.Maybe SigningAlg
  }
  deriving (As2ConnectorConfig -> As2ConnectorConfig -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: As2ConnectorConfig -> As2ConnectorConfig -> Bool
$c/= :: As2ConnectorConfig -> As2ConnectorConfig -> Bool
== :: As2ConnectorConfig -> As2ConnectorConfig -> Bool
$c== :: As2ConnectorConfig -> As2ConnectorConfig -> Bool
Prelude.Eq, ReadPrec [As2ConnectorConfig]
ReadPrec As2ConnectorConfig
Int -> ReadS As2ConnectorConfig
ReadS [As2ConnectorConfig]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [As2ConnectorConfig]
$creadListPrec :: ReadPrec [As2ConnectorConfig]
readPrec :: ReadPrec As2ConnectorConfig
$creadPrec :: ReadPrec As2ConnectorConfig
readList :: ReadS [As2ConnectorConfig]
$creadList :: ReadS [As2ConnectorConfig]
readsPrec :: Int -> ReadS As2ConnectorConfig
$creadsPrec :: Int -> ReadS As2ConnectorConfig
Prelude.Read, Int -> As2ConnectorConfig -> ShowS
[As2ConnectorConfig] -> ShowS
As2ConnectorConfig -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [As2ConnectorConfig] -> ShowS
$cshowList :: [As2ConnectorConfig] -> ShowS
show :: As2ConnectorConfig -> String
$cshow :: As2ConnectorConfig -> String
showsPrec :: Int -> As2ConnectorConfig -> ShowS
$cshowsPrec :: Int -> As2ConnectorConfig -> ShowS
Prelude.Show, forall x. Rep As2ConnectorConfig x -> As2ConnectorConfig
forall x. As2ConnectorConfig -> Rep As2ConnectorConfig x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep As2ConnectorConfig x -> As2ConnectorConfig
$cfrom :: forall x. As2ConnectorConfig -> Rep As2ConnectorConfig x
Prelude.Generic)

-- |
-- Create a value of 'As2ConnectorConfig' 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:
--
-- 'compression', 'as2ConnectorConfig_compression' - Specifies whether the AS2 file is compressed.
--
-- 'encryptionAlgorithm', 'as2ConnectorConfig_encryptionAlgorithm' - The algorithm that is used to encrypt the file.
--
-- 'localProfileId', 'as2ConnectorConfig_localProfileId' - A unique identifier for the AS2 local profile.
--
-- 'mdnResponse', 'as2ConnectorConfig_mdnResponse' - Used for outbound requests (from an Transfer Family server to a partner
-- AS2 server) to determine whether the partner response for transfers is
-- synchronous or asynchronous. Specify either of the following values:
--
-- -   @SYNC@: The system expects a synchronous MDN response, confirming
--     that the file was transferred successfully (or not).
--
-- -   @NONE@: Specifies that no MDN response is required.
--
-- 'mdnSigningAlgorithm', 'as2ConnectorConfig_mdnSigningAlgorithm' - The signing algorithm for the MDN response.
--
-- If set to DEFAULT (or not set at all), the value for @SigningAlogorithm@
-- is used.
--
-- 'messageSubject', 'as2ConnectorConfig_messageSubject' - Used as the @Subject@ HTTP header attribute in AS2 messages that are
-- being sent with the connector.
--
-- 'partnerProfileId', 'as2ConnectorConfig_partnerProfileId' - A unique identifier for the partner profile for the connector.
--
-- 'signingAlgorithm', 'as2ConnectorConfig_signingAlgorithm' - The algorithm that is used to sign the AS2 messages sent with the
-- connector.
newAs2ConnectorConfig ::
  As2ConnectorConfig
newAs2ConnectorConfig :: As2ConnectorConfig
newAs2ConnectorConfig =
  As2ConnectorConfig'
    { $sel:compression:As2ConnectorConfig' :: Maybe CompressionEnum
compression = forall a. Maybe a
Prelude.Nothing,
      $sel:encryptionAlgorithm:As2ConnectorConfig' :: Maybe EncryptionAlg
encryptionAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:localProfileId:As2ConnectorConfig' :: Maybe Text
localProfileId = forall a. Maybe a
Prelude.Nothing,
      $sel:mdnResponse:As2ConnectorConfig' :: Maybe MdnResponse
mdnResponse = forall a. Maybe a
Prelude.Nothing,
      $sel:mdnSigningAlgorithm:As2ConnectorConfig' :: Maybe MdnSigningAlg
mdnSigningAlgorithm = forall a. Maybe a
Prelude.Nothing,
      $sel:messageSubject:As2ConnectorConfig' :: Maybe Text
messageSubject = forall a. Maybe a
Prelude.Nothing,
      $sel:partnerProfileId:As2ConnectorConfig' :: Maybe Text
partnerProfileId = forall a. Maybe a
Prelude.Nothing,
      $sel:signingAlgorithm:As2ConnectorConfig' :: Maybe SigningAlg
signingAlgorithm = forall a. Maybe a
Prelude.Nothing
    }

-- | Specifies whether the AS2 file is compressed.
as2ConnectorConfig_compression :: Lens.Lens' As2ConnectorConfig (Prelude.Maybe CompressionEnum)
as2ConnectorConfig_compression :: Lens' As2ConnectorConfig (Maybe CompressionEnum)
as2ConnectorConfig_compression = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\As2ConnectorConfig' {Maybe CompressionEnum
compression :: Maybe CompressionEnum
$sel:compression:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe CompressionEnum
compression} -> Maybe CompressionEnum
compression) (\s :: As2ConnectorConfig
s@As2ConnectorConfig' {} Maybe CompressionEnum
a -> As2ConnectorConfig
s {$sel:compression:As2ConnectorConfig' :: Maybe CompressionEnum
compression = Maybe CompressionEnum
a} :: As2ConnectorConfig)

-- | The algorithm that is used to encrypt the file.
as2ConnectorConfig_encryptionAlgorithm :: Lens.Lens' As2ConnectorConfig (Prelude.Maybe EncryptionAlg)
as2ConnectorConfig_encryptionAlgorithm :: Lens' As2ConnectorConfig (Maybe EncryptionAlg)
as2ConnectorConfig_encryptionAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\As2ConnectorConfig' {Maybe EncryptionAlg
encryptionAlgorithm :: Maybe EncryptionAlg
$sel:encryptionAlgorithm:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe EncryptionAlg
encryptionAlgorithm} -> Maybe EncryptionAlg
encryptionAlgorithm) (\s :: As2ConnectorConfig
s@As2ConnectorConfig' {} Maybe EncryptionAlg
a -> As2ConnectorConfig
s {$sel:encryptionAlgorithm:As2ConnectorConfig' :: Maybe EncryptionAlg
encryptionAlgorithm = Maybe EncryptionAlg
a} :: As2ConnectorConfig)

-- | A unique identifier for the AS2 local profile.
as2ConnectorConfig_localProfileId :: Lens.Lens' As2ConnectorConfig (Prelude.Maybe Prelude.Text)
as2ConnectorConfig_localProfileId :: Lens' As2ConnectorConfig (Maybe Text)
as2ConnectorConfig_localProfileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\As2ConnectorConfig' {Maybe Text
localProfileId :: Maybe Text
$sel:localProfileId:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe Text
localProfileId} -> Maybe Text
localProfileId) (\s :: As2ConnectorConfig
s@As2ConnectorConfig' {} Maybe Text
a -> As2ConnectorConfig
s {$sel:localProfileId:As2ConnectorConfig' :: Maybe Text
localProfileId = Maybe Text
a} :: As2ConnectorConfig)

-- | Used for outbound requests (from an Transfer Family server to a partner
-- AS2 server) to determine whether the partner response for transfers is
-- synchronous or asynchronous. Specify either of the following values:
--
-- -   @SYNC@: The system expects a synchronous MDN response, confirming
--     that the file was transferred successfully (or not).
--
-- -   @NONE@: Specifies that no MDN response is required.
as2ConnectorConfig_mdnResponse :: Lens.Lens' As2ConnectorConfig (Prelude.Maybe MdnResponse)
as2ConnectorConfig_mdnResponse :: Lens' As2ConnectorConfig (Maybe MdnResponse)
as2ConnectorConfig_mdnResponse = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\As2ConnectorConfig' {Maybe MdnResponse
mdnResponse :: Maybe MdnResponse
$sel:mdnResponse:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe MdnResponse
mdnResponse} -> Maybe MdnResponse
mdnResponse) (\s :: As2ConnectorConfig
s@As2ConnectorConfig' {} Maybe MdnResponse
a -> As2ConnectorConfig
s {$sel:mdnResponse:As2ConnectorConfig' :: Maybe MdnResponse
mdnResponse = Maybe MdnResponse
a} :: As2ConnectorConfig)

-- | The signing algorithm for the MDN response.
--
-- If set to DEFAULT (or not set at all), the value for @SigningAlogorithm@
-- is used.
as2ConnectorConfig_mdnSigningAlgorithm :: Lens.Lens' As2ConnectorConfig (Prelude.Maybe MdnSigningAlg)
as2ConnectorConfig_mdnSigningAlgorithm :: Lens' As2ConnectorConfig (Maybe MdnSigningAlg)
as2ConnectorConfig_mdnSigningAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\As2ConnectorConfig' {Maybe MdnSigningAlg
mdnSigningAlgorithm :: Maybe MdnSigningAlg
$sel:mdnSigningAlgorithm:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe MdnSigningAlg
mdnSigningAlgorithm} -> Maybe MdnSigningAlg
mdnSigningAlgorithm) (\s :: As2ConnectorConfig
s@As2ConnectorConfig' {} Maybe MdnSigningAlg
a -> As2ConnectorConfig
s {$sel:mdnSigningAlgorithm:As2ConnectorConfig' :: Maybe MdnSigningAlg
mdnSigningAlgorithm = Maybe MdnSigningAlg
a} :: As2ConnectorConfig)

-- | Used as the @Subject@ HTTP header attribute in AS2 messages that are
-- being sent with the connector.
as2ConnectorConfig_messageSubject :: Lens.Lens' As2ConnectorConfig (Prelude.Maybe Prelude.Text)
as2ConnectorConfig_messageSubject :: Lens' As2ConnectorConfig (Maybe Text)
as2ConnectorConfig_messageSubject = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\As2ConnectorConfig' {Maybe Text
messageSubject :: Maybe Text
$sel:messageSubject:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe Text
messageSubject} -> Maybe Text
messageSubject) (\s :: As2ConnectorConfig
s@As2ConnectorConfig' {} Maybe Text
a -> As2ConnectorConfig
s {$sel:messageSubject:As2ConnectorConfig' :: Maybe Text
messageSubject = Maybe Text
a} :: As2ConnectorConfig)

-- | A unique identifier for the partner profile for the connector.
as2ConnectorConfig_partnerProfileId :: Lens.Lens' As2ConnectorConfig (Prelude.Maybe Prelude.Text)
as2ConnectorConfig_partnerProfileId :: Lens' As2ConnectorConfig (Maybe Text)
as2ConnectorConfig_partnerProfileId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\As2ConnectorConfig' {Maybe Text
partnerProfileId :: Maybe Text
$sel:partnerProfileId:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe Text
partnerProfileId} -> Maybe Text
partnerProfileId) (\s :: As2ConnectorConfig
s@As2ConnectorConfig' {} Maybe Text
a -> As2ConnectorConfig
s {$sel:partnerProfileId:As2ConnectorConfig' :: Maybe Text
partnerProfileId = Maybe Text
a} :: As2ConnectorConfig)

-- | The algorithm that is used to sign the AS2 messages sent with the
-- connector.
as2ConnectorConfig_signingAlgorithm :: Lens.Lens' As2ConnectorConfig (Prelude.Maybe SigningAlg)
as2ConnectorConfig_signingAlgorithm :: Lens' As2ConnectorConfig (Maybe SigningAlg)
as2ConnectorConfig_signingAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\As2ConnectorConfig' {Maybe SigningAlg
signingAlgorithm :: Maybe SigningAlg
$sel:signingAlgorithm:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe SigningAlg
signingAlgorithm} -> Maybe SigningAlg
signingAlgorithm) (\s :: As2ConnectorConfig
s@As2ConnectorConfig' {} Maybe SigningAlg
a -> As2ConnectorConfig
s {$sel:signingAlgorithm:As2ConnectorConfig' :: Maybe SigningAlg
signingAlgorithm = Maybe SigningAlg
a} :: As2ConnectorConfig)

instance Data.FromJSON As2ConnectorConfig where
  parseJSON :: Value -> Parser As2ConnectorConfig
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"As2ConnectorConfig"
      ( \Object
x ->
          Maybe CompressionEnum
-> Maybe EncryptionAlg
-> Maybe Text
-> Maybe MdnResponse
-> Maybe MdnSigningAlg
-> Maybe Text
-> Maybe Text
-> Maybe SigningAlg
-> As2ConnectorConfig
As2ConnectorConfig'
            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
"Compression")
            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
"EncryptionAlgorithm")
            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
"LocalProfileId")
            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
"MdnResponse")
            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
"MdnSigningAlgorithm")
            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
"MessageSubject")
            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
"PartnerProfileId")
            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
"SigningAlgorithm")
      )

instance Prelude.Hashable As2ConnectorConfig where
  hashWithSalt :: Int -> As2ConnectorConfig -> Int
hashWithSalt Int
_salt As2ConnectorConfig' {Maybe Text
Maybe CompressionEnum
Maybe EncryptionAlg
Maybe MdnResponse
Maybe MdnSigningAlg
Maybe SigningAlg
signingAlgorithm :: Maybe SigningAlg
partnerProfileId :: Maybe Text
messageSubject :: Maybe Text
mdnSigningAlgorithm :: Maybe MdnSigningAlg
mdnResponse :: Maybe MdnResponse
localProfileId :: Maybe Text
encryptionAlgorithm :: Maybe EncryptionAlg
compression :: Maybe CompressionEnum
$sel:signingAlgorithm:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe SigningAlg
$sel:partnerProfileId:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe Text
$sel:messageSubject:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe Text
$sel:mdnSigningAlgorithm:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe MdnSigningAlg
$sel:mdnResponse:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe MdnResponse
$sel:localProfileId:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe Text
$sel:encryptionAlgorithm:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe EncryptionAlg
$sel:compression:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe CompressionEnum
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CompressionEnum
compression
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe EncryptionAlg
encryptionAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
localProfileId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MdnResponse
mdnResponse
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe MdnSigningAlg
mdnSigningAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
messageSubject
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
partnerProfileId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SigningAlg
signingAlgorithm

instance Prelude.NFData As2ConnectorConfig where
  rnf :: As2ConnectorConfig -> ()
rnf As2ConnectorConfig' {Maybe Text
Maybe CompressionEnum
Maybe EncryptionAlg
Maybe MdnResponse
Maybe MdnSigningAlg
Maybe SigningAlg
signingAlgorithm :: Maybe SigningAlg
partnerProfileId :: Maybe Text
messageSubject :: Maybe Text
mdnSigningAlgorithm :: Maybe MdnSigningAlg
mdnResponse :: Maybe MdnResponse
localProfileId :: Maybe Text
encryptionAlgorithm :: Maybe EncryptionAlg
compression :: Maybe CompressionEnum
$sel:signingAlgorithm:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe SigningAlg
$sel:partnerProfileId:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe Text
$sel:messageSubject:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe Text
$sel:mdnSigningAlgorithm:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe MdnSigningAlg
$sel:mdnResponse:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe MdnResponse
$sel:localProfileId:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe Text
$sel:encryptionAlgorithm:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe EncryptionAlg
$sel:compression:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe CompressionEnum
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CompressionEnum
compression
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe EncryptionAlg
encryptionAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
localProfileId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MdnResponse
mdnResponse
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe MdnSigningAlg
mdnSigningAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
messageSubject
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
partnerProfileId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SigningAlg
signingAlgorithm

instance Data.ToJSON As2ConnectorConfig where
  toJSON :: As2ConnectorConfig -> Value
toJSON As2ConnectorConfig' {Maybe Text
Maybe CompressionEnum
Maybe EncryptionAlg
Maybe MdnResponse
Maybe MdnSigningAlg
Maybe SigningAlg
signingAlgorithm :: Maybe SigningAlg
partnerProfileId :: Maybe Text
messageSubject :: Maybe Text
mdnSigningAlgorithm :: Maybe MdnSigningAlg
mdnResponse :: Maybe MdnResponse
localProfileId :: Maybe Text
encryptionAlgorithm :: Maybe EncryptionAlg
compression :: Maybe CompressionEnum
$sel:signingAlgorithm:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe SigningAlg
$sel:partnerProfileId:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe Text
$sel:messageSubject:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe Text
$sel:mdnSigningAlgorithm:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe MdnSigningAlg
$sel:mdnResponse:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe MdnResponse
$sel:localProfileId:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe Text
$sel:encryptionAlgorithm:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe EncryptionAlg
$sel:compression:As2ConnectorConfig' :: As2ConnectorConfig -> Maybe CompressionEnum
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Compression" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe CompressionEnum
compression,
            (Key
"EncryptionAlgorithm" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe EncryptionAlg
encryptionAlgorithm,
            (Key
"LocalProfileId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
localProfileId,
            (Key
"MdnResponse" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MdnResponse
mdnResponse,
            (Key
"MdnSigningAlgorithm" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe MdnSigningAlg
mdnSigningAlgorithm,
            (Key
"MessageSubject" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
messageSubject,
            (Key
"PartnerProfileId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe Text
partnerProfileId,
            (Key
"SigningAlgorithm" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..=)
              forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe SigningAlg
signingAlgorithm
          ]
      )