{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-binds #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.DirectoryService.CreateTrust
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Directory Service for Microsoft Active Directory allows you to configure
-- trust relationships. For example, you can establish a trust between your
-- Managed Microsoft AD directory, and your existing self-managed Microsoft
-- Active Directory. This would allow you to provide users and groups
-- access to resources in either domain, with a single set of credentials.
--
-- This action initiates the creation of the Amazon Web Services side of a
-- trust relationship between an Managed Microsoft AD directory and an
-- external domain. You can create either a forest trust or an external
-- trust.
module Amazonka.DirectoryService.CreateTrust
  ( -- * Creating a Request
    CreateTrust (..),
    newCreateTrust,

    -- * Request Lenses
    createTrust_conditionalForwarderIpAddrs,
    createTrust_selectiveAuth,
    createTrust_trustType,
    createTrust_directoryId,
    createTrust_remoteDomainName,
    createTrust_trustPassword,
    createTrust_trustDirection,

    -- * Destructuring the Response
    CreateTrustResponse (..),
    newCreateTrustResponse,

    -- * Response Lenses
    createTrustResponse_trustId,
    createTrustResponse_httpStatus,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.DirectoryService.Types
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response

-- | Directory Service for Microsoft Active Directory allows you to configure
-- trust relationships. For example, you can establish a trust between your
-- Managed Microsoft AD directory, and your existing self-managed Microsoft
-- Active Directory. This would allow you to provide users and groups
-- access to resources in either domain, with a single set of credentials.
--
-- This action initiates the creation of the Amazon Web Services side of a
-- trust relationship between an Managed Microsoft AD directory and an
-- external domain.
--
-- /See:/ 'newCreateTrust' smart constructor.
data CreateTrust = CreateTrust'
  { -- | The IP addresses of the remote DNS server associated with
    -- RemoteDomainName.
    CreateTrust -> Maybe [Text]
conditionalForwarderIpAddrs :: Prelude.Maybe [Prelude.Text],
    -- | Optional parameter to enable selective authentication for the trust.
    CreateTrust -> Maybe SelectiveAuth
selectiveAuth :: Prelude.Maybe SelectiveAuth,
    -- | The trust relationship type. @Forest@ is the default.
    CreateTrust -> Maybe TrustType
trustType :: Prelude.Maybe TrustType,
    -- | The Directory ID of the Managed Microsoft AD directory for which to
    -- establish the trust relationship.
    CreateTrust -> Text
directoryId :: Prelude.Text,
    -- | The Fully Qualified Domain Name (FQDN) of the external domain for which
    -- to create the trust relationship.
    CreateTrust -> Text
remoteDomainName :: Prelude.Text,
    -- | The trust password. The must be the same password that was used when
    -- creating the trust relationship on the external domain.
    CreateTrust -> Sensitive Text
trustPassword :: Data.Sensitive Prelude.Text,
    -- | The direction of the trust relationship.
    CreateTrust -> TrustDirection
trustDirection :: TrustDirection
  }
  deriving (CreateTrust -> CreateTrust -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTrust -> CreateTrust -> Bool
$c/= :: CreateTrust -> CreateTrust -> Bool
== :: CreateTrust -> CreateTrust -> Bool
$c== :: CreateTrust -> CreateTrust -> Bool
Prelude.Eq, Int -> CreateTrust -> ShowS
[CreateTrust] -> ShowS
CreateTrust -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTrust] -> ShowS
$cshowList :: [CreateTrust] -> ShowS
show :: CreateTrust -> String
$cshow :: CreateTrust -> String
showsPrec :: Int -> CreateTrust -> ShowS
$cshowsPrec :: Int -> CreateTrust -> ShowS
Prelude.Show, forall x. Rep CreateTrust x -> CreateTrust
forall x. CreateTrust -> Rep CreateTrust x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTrust x -> CreateTrust
$cfrom :: forall x. CreateTrust -> Rep CreateTrust x
Prelude.Generic)

-- |
-- Create a value of 'CreateTrust' 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:
--
-- 'conditionalForwarderIpAddrs', 'createTrust_conditionalForwarderIpAddrs' - The IP addresses of the remote DNS server associated with
-- RemoteDomainName.
--
-- 'selectiveAuth', 'createTrust_selectiveAuth' - Optional parameter to enable selective authentication for the trust.
--
-- 'trustType', 'createTrust_trustType' - The trust relationship type. @Forest@ is the default.
--
-- 'directoryId', 'createTrust_directoryId' - The Directory ID of the Managed Microsoft AD directory for which to
-- establish the trust relationship.
--
-- 'remoteDomainName', 'createTrust_remoteDomainName' - The Fully Qualified Domain Name (FQDN) of the external domain for which
-- to create the trust relationship.
--
-- 'trustPassword', 'createTrust_trustPassword' - The trust password. The must be the same password that was used when
-- creating the trust relationship on the external domain.
--
-- 'trustDirection', 'createTrust_trustDirection' - The direction of the trust relationship.
newCreateTrust ::
  -- | 'directoryId'
  Prelude.Text ->
  -- | 'remoteDomainName'
  Prelude.Text ->
  -- | 'trustPassword'
  Prelude.Text ->
  -- | 'trustDirection'
  TrustDirection ->
  CreateTrust
newCreateTrust :: Text -> Text -> Text -> TrustDirection -> CreateTrust
newCreateTrust
  Text
pDirectoryId_
  Text
pRemoteDomainName_
  Text
pTrustPassword_
  TrustDirection
pTrustDirection_ =
    CreateTrust'
      { $sel:conditionalForwarderIpAddrs:CreateTrust' :: Maybe [Text]
conditionalForwarderIpAddrs =
          forall a. Maybe a
Prelude.Nothing,
        $sel:selectiveAuth:CreateTrust' :: Maybe SelectiveAuth
selectiveAuth = forall a. Maybe a
Prelude.Nothing,
        $sel:trustType:CreateTrust' :: Maybe TrustType
trustType = forall a. Maybe a
Prelude.Nothing,
        $sel:directoryId:CreateTrust' :: Text
directoryId = Text
pDirectoryId_,
        $sel:remoteDomainName:CreateTrust' :: Text
remoteDomainName = Text
pRemoteDomainName_,
        $sel:trustPassword:CreateTrust' :: Sensitive Text
trustPassword =
          forall a. Iso' (Sensitive a) a
Data._Sensitive forall t b. AReview t b -> b -> t
Lens.# Text
pTrustPassword_,
        $sel:trustDirection:CreateTrust' :: TrustDirection
trustDirection = TrustDirection
pTrustDirection_
      }

-- | The IP addresses of the remote DNS server associated with
-- RemoteDomainName.
createTrust_conditionalForwarderIpAddrs :: Lens.Lens' CreateTrust (Prelude.Maybe [Prelude.Text])
createTrust_conditionalForwarderIpAddrs :: Lens' CreateTrust (Maybe [Text])
createTrust_conditionalForwarderIpAddrs = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrust' {Maybe [Text]
conditionalForwarderIpAddrs :: Maybe [Text]
$sel:conditionalForwarderIpAddrs:CreateTrust' :: CreateTrust -> Maybe [Text]
conditionalForwarderIpAddrs} -> Maybe [Text]
conditionalForwarderIpAddrs) (\s :: CreateTrust
s@CreateTrust' {} Maybe [Text]
a -> CreateTrust
s {$sel:conditionalForwarderIpAddrs:CreateTrust' :: Maybe [Text]
conditionalForwarderIpAddrs = Maybe [Text]
a} :: CreateTrust) 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

-- | Optional parameter to enable selective authentication for the trust.
createTrust_selectiveAuth :: Lens.Lens' CreateTrust (Prelude.Maybe SelectiveAuth)
createTrust_selectiveAuth :: Lens' CreateTrust (Maybe SelectiveAuth)
createTrust_selectiveAuth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrust' {Maybe SelectiveAuth
selectiveAuth :: Maybe SelectiveAuth
$sel:selectiveAuth:CreateTrust' :: CreateTrust -> Maybe SelectiveAuth
selectiveAuth} -> Maybe SelectiveAuth
selectiveAuth) (\s :: CreateTrust
s@CreateTrust' {} Maybe SelectiveAuth
a -> CreateTrust
s {$sel:selectiveAuth:CreateTrust' :: Maybe SelectiveAuth
selectiveAuth = Maybe SelectiveAuth
a} :: CreateTrust)

-- | The trust relationship type. @Forest@ is the default.
createTrust_trustType :: Lens.Lens' CreateTrust (Prelude.Maybe TrustType)
createTrust_trustType :: Lens' CreateTrust (Maybe TrustType)
createTrust_trustType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrust' {Maybe TrustType
trustType :: Maybe TrustType
$sel:trustType:CreateTrust' :: CreateTrust -> Maybe TrustType
trustType} -> Maybe TrustType
trustType) (\s :: CreateTrust
s@CreateTrust' {} Maybe TrustType
a -> CreateTrust
s {$sel:trustType:CreateTrust' :: Maybe TrustType
trustType = Maybe TrustType
a} :: CreateTrust)

-- | The Directory ID of the Managed Microsoft AD directory for which to
-- establish the trust relationship.
createTrust_directoryId :: Lens.Lens' CreateTrust Prelude.Text
createTrust_directoryId :: Lens' CreateTrust Text
createTrust_directoryId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrust' {Text
directoryId :: Text
$sel:directoryId:CreateTrust' :: CreateTrust -> Text
directoryId} -> Text
directoryId) (\s :: CreateTrust
s@CreateTrust' {} Text
a -> CreateTrust
s {$sel:directoryId:CreateTrust' :: Text
directoryId = Text
a} :: CreateTrust)

-- | The Fully Qualified Domain Name (FQDN) of the external domain for which
-- to create the trust relationship.
createTrust_remoteDomainName :: Lens.Lens' CreateTrust Prelude.Text
createTrust_remoteDomainName :: Lens' CreateTrust Text
createTrust_remoteDomainName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrust' {Text
remoteDomainName :: Text
$sel:remoteDomainName:CreateTrust' :: CreateTrust -> Text
remoteDomainName} -> Text
remoteDomainName) (\s :: CreateTrust
s@CreateTrust' {} Text
a -> CreateTrust
s {$sel:remoteDomainName:CreateTrust' :: Text
remoteDomainName = Text
a} :: CreateTrust)

-- | The trust password. The must be the same password that was used when
-- creating the trust relationship on the external domain.
createTrust_trustPassword :: Lens.Lens' CreateTrust Prelude.Text
createTrust_trustPassword :: Lens' CreateTrust Text
createTrust_trustPassword = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrust' {Sensitive Text
trustPassword :: Sensitive Text
$sel:trustPassword:CreateTrust' :: CreateTrust -> Sensitive Text
trustPassword} -> Sensitive Text
trustPassword) (\s :: CreateTrust
s@CreateTrust' {} Sensitive Text
a -> CreateTrust
s {$sel:trustPassword:CreateTrust' :: Sensitive Text
trustPassword = Sensitive Text
a} :: CreateTrust) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a. Iso' (Sensitive a) a
Data._Sensitive

-- | The direction of the trust relationship.
createTrust_trustDirection :: Lens.Lens' CreateTrust TrustDirection
createTrust_trustDirection :: Lens' CreateTrust TrustDirection
createTrust_trustDirection = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrust' {TrustDirection
trustDirection :: TrustDirection
$sel:trustDirection:CreateTrust' :: CreateTrust -> TrustDirection
trustDirection} -> TrustDirection
trustDirection) (\s :: CreateTrust
s@CreateTrust' {} TrustDirection
a -> CreateTrust
s {$sel:trustDirection:CreateTrust' :: TrustDirection
trustDirection = TrustDirection
a} :: CreateTrust)

instance Core.AWSRequest CreateTrust where
  type AWSResponse CreateTrust = CreateTrustResponse
  request :: (Service -> Service) -> CreateTrust -> Request CreateTrust
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.postJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy CreateTrust
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateTrust)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text -> Int -> CreateTrustResponse
CreateTrustResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"TrustId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable CreateTrust where
  hashWithSalt :: Int -> CreateTrust -> Int
hashWithSalt Int
_salt CreateTrust' {Maybe [Text]
Maybe SelectiveAuth
Maybe TrustType
Text
Sensitive Text
TrustDirection
trustDirection :: TrustDirection
trustPassword :: Sensitive Text
remoteDomainName :: Text
directoryId :: Text
trustType :: Maybe TrustType
selectiveAuth :: Maybe SelectiveAuth
conditionalForwarderIpAddrs :: Maybe [Text]
$sel:trustDirection:CreateTrust' :: CreateTrust -> TrustDirection
$sel:trustPassword:CreateTrust' :: CreateTrust -> Sensitive Text
$sel:remoteDomainName:CreateTrust' :: CreateTrust -> Text
$sel:directoryId:CreateTrust' :: CreateTrust -> Text
$sel:trustType:CreateTrust' :: CreateTrust -> Maybe TrustType
$sel:selectiveAuth:CreateTrust' :: CreateTrust -> Maybe SelectiveAuth
$sel:conditionalForwarderIpAddrs:CreateTrust' :: CreateTrust -> Maybe [Text]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Text]
conditionalForwarderIpAddrs
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SelectiveAuth
selectiveAuth
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TrustType
trustType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
directoryId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
remoteDomainName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Sensitive Text
trustPassword
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TrustDirection
trustDirection

instance Prelude.NFData CreateTrust where
  rnf :: CreateTrust -> ()
rnf CreateTrust' {Maybe [Text]
Maybe SelectiveAuth
Maybe TrustType
Text
Sensitive Text
TrustDirection
trustDirection :: TrustDirection
trustPassword :: Sensitive Text
remoteDomainName :: Text
directoryId :: Text
trustType :: Maybe TrustType
selectiveAuth :: Maybe SelectiveAuth
conditionalForwarderIpAddrs :: Maybe [Text]
$sel:trustDirection:CreateTrust' :: CreateTrust -> TrustDirection
$sel:trustPassword:CreateTrust' :: CreateTrust -> Sensitive Text
$sel:remoteDomainName:CreateTrust' :: CreateTrust -> Text
$sel:directoryId:CreateTrust' :: CreateTrust -> Text
$sel:trustType:CreateTrust' :: CreateTrust -> Maybe TrustType
$sel:selectiveAuth:CreateTrust' :: CreateTrust -> Maybe SelectiveAuth
$sel:conditionalForwarderIpAddrs:CreateTrust' :: CreateTrust -> Maybe [Text]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Text]
conditionalForwarderIpAddrs
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SelectiveAuth
selectiveAuth
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TrustType
trustType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
directoryId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
remoteDomainName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Sensitive Text
trustPassword
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TrustDirection
trustDirection

instance Data.ToHeaders CreateTrust where
  toHeaders :: CreateTrust -> ResponseHeaders
toHeaders =
    forall a b. a -> b -> a
Prelude.const
      ( forall a. Monoid a => [a] -> a
Prelude.mconcat
          [ HeaderName
"X-Amz-Target"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"DirectoryService_20150416.CreateTrust" ::
                          Prelude.ByteString
                      ),
            HeaderName
"Content-Type"
              forall a. ToHeader a => HeaderName -> a -> ResponseHeaders
Data.=# ( ByteString
"application/x-amz-json-1.1" ::
                          Prelude.ByteString
                      )
          ]
      )

instance Data.ToJSON CreateTrust where
  toJSON :: CreateTrust -> Value
toJSON CreateTrust' {Maybe [Text]
Maybe SelectiveAuth
Maybe TrustType
Text
Sensitive Text
TrustDirection
trustDirection :: TrustDirection
trustPassword :: Sensitive Text
remoteDomainName :: Text
directoryId :: Text
trustType :: Maybe TrustType
selectiveAuth :: Maybe SelectiveAuth
conditionalForwarderIpAddrs :: Maybe [Text]
$sel:trustDirection:CreateTrust' :: CreateTrust -> TrustDirection
$sel:trustPassword:CreateTrust' :: CreateTrust -> Sensitive Text
$sel:remoteDomainName:CreateTrust' :: CreateTrust -> Text
$sel:directoryId:CreateTrust' :: CreateTrust -> Text
$sel:trustType:CreateTrust' :: CreateTrust -> Maybe TrustType
$sel:selectiveAuth:CreateTrust' :: CreateTrust -> Maybe SelectiveAuth
$sel:conditionalForwarderIpAddrs:CreateTrust' :: CreateTrust -> Maybe [Text]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"ConditionalForwarderIpAddrs" 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]
conditionalForwarderIpAddrs,
            (Key
"SelectiveAuth" 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 SelectiveAuth
selectiveAuth,
            (Key
"TrustType" 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 TrustType
trustType,
            forall a. a -> Maybe a
Prelude.Just (Key
"DirectoryId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
directoryId),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"RemoteDomainName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
remoteDomainName),
            forall a. a -> Maybe a
Prelude.Just (Key
"TrustPassword" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Sensitive Text
trustPassword),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"TrustDirection" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= TrustDirection
trustDirection)
          ]
      )

instance Data.ToPath CreateTrust where
  toPath :: CreateTrust -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/"

instance Data.ToQuery CreateTrust where
  toQuery :: CreateTrust -> QueryString
toQuery = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

-- | The result of a CreateTrust request.
--
-- /See:/ 'newCreateTrustResponse' smart constructor.
data CreateTrustResponse = CreateTrustResponse'
  { -- | A unique identifier for the trust relationship that was created.
    CreateTrustResponse -> Maybe Text
trustId :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    CreateTrustResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (CreateTrustResponse -> CreateTrustResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateTrustResponse -> CreateTrustResponse -> Bool
$c/= :: CreateTrustResponse -> CreateTrustResponse -> Bool
== :: CreateTrustResponse -> CreateTrustResponse -> Bool
$c== :: CreateTrustResponse -> CreateTrustResponse -> Bool
Prelude.Eq, ReadPrec [CreateTrustResponse]
ReadPrec CreateTrustResponse
Int -> ReadS CreateTrustResponse
ReadS [CreateTrustResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateTrustResponse]
$creadListPrec :: ReadPrec [CreateTrustResponse]
readPrec :: ReadPrec CreateTrustResponse
$creadPrec :: ReadPrec CreateTrustResponse
readList :: ReadS [CreateTrustResponse]
$creadList :: ReadS [CreateTrustResponse]
readsPrec :: Int -> ReadS CreateTrustResponse
$creadsPrec :: Int -> ReadS CreateTrustResponse
Prelude.Read, Int -> CreateTrustResponse -> ShowS
[CreateTrustResponse] -> ShowS
CreateTrustResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateTrustResponse] -> ShowS
$cshowList :: [CreateTrustResponse] -> ShowS
show :: CreateTrustResponse -> String
$cshow :: CreateTrustResponse -> String
showsPrec :: Int -> CreateTrustResponse -> ShowS
$cshowsPrec :: Int -> CreateTrustResponse -> ShowS
Prelude.Show, forall x. Rep CreateTrustResponse x -> CreateTrustResponse
forall x. CreateTrustResponse -> Rep CreateTrustResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateTrustResponse x -> CreateTrustResponse
$cfrom :: forall x. CreateTrustResponse -> Rep CreateTrustResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreateTrustResponse' 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:
--
-- 'trustId', 'createTrustResponse_trustId' - A unique identifier for the trust relationship that was created.
--
-- 'httpStatus', 'createTrustResponse_httpStatus' - The response's http status code.
newCreateTrustResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  CreateTrustResponse
newCreateTrustResponse :: Int -> CreateTrustResponse
newCreateTrustResponse Int
pHttpStatus_ =
  CreateTrustResponse'
    { $sel:trustId:CreateTrustResponse' :: Maybe Text
trustId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:CreateTrustResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | A unique identifier for the trust relationship that was created.
createTrustResponse_trustId :: Lens.Lens' CreateTrustResponse (Prelude.Maybe Prelude.Text)
createTrustResponse_trustId :: Lens' CreateTrustResponse (Maybe Text)
createTrustResponse_trustId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrustResponse' {Maybe Text
trustId :: Maybe Text
$sel:trustId:CreateTrustResponse' :: CreateTrustResponse -> Maybe Text
trustId} -> Maybe Text
trustId) (\s :: CreateTrustResponse
s@CreateTrustResponse' {} Maybe Text
a -> CreateTrustResponse
s {$sel:trustId:CreateTrustResponse' :: Maybe Text
trustId = Maybe Text
a} :: CreateTrustResponse)

-- | The response's http status code.
createTrustResponse_httpStatus :: Lens.Lens' CreateTrustResponse Prelude.Int
createTrustResponse_httpStatus :: Lens' CreateTrustResponse Int
createTrustResponse_httpStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateTrustResponse' {Int
httpStatus :: Int
$sel:httpStatus:CreateTrustResponse' :: CreateTrustResponse -> Int
httpStatus} -> Int
httpStatus) (\s :: CreateTrustResponse
s@CreateTrustResponse' {} Int
a -> CreateTrustResponse
s {$sel:httpStatus:CreateTrustResponse' :: Int
httpStatus = Int
a} :: CreateTrustResponse)

instance Prelude.NFData CreateTrustResponse where
  rnf :: CreateTrustResponse -> ()
rnf CreateTrustResponse' {Int
Maybe Text
httpStatus :: Int
trustId :: Maybe Text
$sel:httpStatus:CreateTrustResponse' :: CreateTrustResponse -> Int
$sel:trustId:CreateTrustResponse' :: CreateTrustResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
trustId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus