{-# 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.UpdateTrust
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the trust that has been set up between your Managed Microsoft AD
-- directory and an self-managed Active Directory.
module Amazonka.DirectoryService.UpdateTrust
  ( -- * Creating a Request
    UpdateTrust (..),
    newUpdateTrust,

    -- * Request Lenses
    updateTrust_selectiveAuth,
    updateTrust_trustId,

    -- * Destructuring the Response
    UpdateTrustResponse (..),
    newUpdateTrustResponse,

    -- * Response Lenses
    updateTrustResponse_requestId,
    updateTrustResponse_trustId,
    updateTrustResponse_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

-- | /See:/ 'newUpdateTrust' smart constructor.
data UpdateTrust = UpdateTrust'
  { -- | Updates selective authentication for the trust.
    UpdateTrust -> Maybe SelectiveAuth
selectiveAuth :: Prelude.Maybe SelectiveAuth,
    -- | Identifier of the trust relationship.
    UpdateTrust -> Text
trustId :: Prelude.Text
  }
  deriving (UpdateTrust -> UpdateTrust -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTrust -> UpdateTrust -> Bool
$c/= :: UpdateTrust -> UpdateTrust -> Bool
== :: UpdateTrust -> UpdateTrust -> Bool
$c== :: UpdateTrust -> UpdateTrust -> Bool
Prelude.Eq, ReadPrec [UpdateTrust]
ReadPrec UpdateTrust
Int -> ReadS UpdateTrust
ReadS [UpdateTrust]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTrust]
$creadListPrec :: ReadPrec [UpdateTrust]
readPrec :: ReadPrec UpdateTrust
$creadPrec :: ReadPrec UpdateTrust
readList :: ReadS [UpdateTrust]
$creadList :: ReadS [UpdateTrust]
readsPrec :: Int -> ReadS UpdateTrust
$creadsPrec :: Int -> ReadS UpdateTrust
Prelude.Read, Int -> UpdateTrust -> ShowS
[UpdateTrust] -> ShowS
UpdateTrust -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTrust] -> ShowS
$cshowList :: [UpdateTrust] -> ShowS
show :: UpdateTrust -> String
$cshow :: UpdateTrust -> String
showsPrec :: Int -> UpdateTrust -> ShowS
$cshowsPrec :: Int -> UpdateTrust -> ShowS
Prelude.Show, forall x. Rep UpdateTrust x -> UpdateTrust
forall x. UpdateTrust -> Rep UpdateTrust x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTrust x -> UpdateTrust
$cfrom :: forall x. UpdateTrust -> Rep UpdateTrust x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTrust' 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:
--
-- 'selectiveAuth', 'updateTrust_selectiveAuth' - Updates selective authentication for the trust.
--
-- 'trustId', 'updateTrust_trustId' - Identifier of the trust relationship.
newUpdateTrust ::
  -- | 'trustId'
  Prelude.Text ->
  UpdateTrust
newUpdateTrust :: Text -> UpdateTrust
newUpdateTrust Text
pTrustId_ =
  UpdateTrust'
    { $sel:selectiveAuth:UpdateTrust' :: Maybe SelectiveAuth
selectiveAuth = forall a. Maybe a
Prelude.Nothing,
      $sel:trustId:UpdateTrust' :: Text
trustId = Text
pTrustId_
    }

-- | Updates selective authentication for the trust.
updateTrust_selectiveAuth :: Lens.Lens' UpdateTrust (Prelude.Maybe SelectiveAuth)
updateTrust_selectiveAuth :: Lens' UpdateTrust (Maybe SelectiveAuth)
updateTrust_selectiveAuth = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTrust' {Maybe SelectiveAuth
selectiveAuth :: Maybe SelectiveAuth
$sel:selectiveAuth:UpdateTrust' :: UpdateTrust -> Maybe SelectiveAuth
selectiveAuth} -> Maybe SelectiveAuth
selectiveAuth) (\s :: UpdateTrust
s@UpdateTrust' {} Maybe SelectiveAuth
a -> UpdateTrust
s {$sel:selectiveAuth:UpdateTrust' :: Maybe SelectiveAuth
selectiveAuth = Maybe SelectiveAuth
a} :: UpdateTrust)

-- | Identifier of the trust relationship.
updateTrust_trustId :: Lens.Lens' UpdateTrust Prelude.Text
updateTrust_trustId :: Lens' UpdateTrust Text
updateTrust_trustId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTrust' {Text
trustId :: Text
$sel:trustId:UpdateTrust' :: UpdateTrust -> Text
trustId} -> Text
trustId) (\s :: UpdateTrust
s@UpdateTrust' {} Text
a -> UpdateTrust
s {$sel:trustId:UpdateTrust' :: Text
trustId = Text
a} :: UpdateTrust)

instance Core.AWSRequest UpdateTrust where
  type AWSResponse UpdateTrust = UpdateTrustResponse
  request :: (Service -> Service) -> UpdateTrust -> Request UpdateTrust
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 UpdateTrust
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateTrust)))
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 -> Maybe Text -> Int -> UpdateTrustResponse
UpdateTrustResponse'
            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
"RequestId")
            forall (f :: * -> *) a b. Applicative f => 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 UpdateTrust where
  hashWithSalt :: Int -> UpdateTrust -> Int
hashWithSalt Int
_salt UpdateTrust' {Maybe SelectiveAuth
Text
trustId :: Text
selectiveAuth :: Maybe SelectiveAuth
$sel:trustId:UpdateTrust' :: UpdateTrust -> Text
$sel:selectiveAuth:UpdateTrust' :: UpdateTrust -> Maybe SelectiveAuth
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SelectiveAuth
selectiveAuth
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
trustId

instance Prelude.NFData UpdateTrust where
  rnf :: UpdateTrust -> ()
rnf UpdateTrust' {Maybe SelectiveAuth
Text
trustId :: Text
selectiveAuth :: Maybe SelectiveAuth
$sel:trustId:UpdateTrust' :: UpdateTrust -> Text
$sel:selectiveAuth:UpdateTrust' :: UpdateTrust -> Maybe SelectiveAuth
..} =
    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 Text
trustId

instance Data.ToHeaders UpdateTrust where
  toHeaders :: UpdateTrust -> 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.UpdateTrust" ::
                          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 UpdateTrust where
  toJSON :: UpdateTrust -> Value
toJSON UpdateTrust' {Maybe SelectiveAuth
Text
trustId :: Text
selectiveAuth :: Maybe SelectiveAuth
$sel:trustId:UpdateTrust' :: UpdateTrust -> Text
$sel:selectiveAuth:UpdateTrust' :: UpdateTrust -> Maybe SelectiveAuth
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (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,
            forall a. a -> Maybe a
Prelude.Just (Key
"TrustId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
trustId)
          ]
      )

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

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

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

-- |
-- Create a value of 'UpdateTrustResponse' 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:
--
-- 'requestId', 'updateTrustResponse_requestId' - Undocumented member.
--
-- 'trustId', 'updateTrustResponse_trustId' - Identifier of the trust relationship.
--
-- 'httpStatus', 'updateTrustResponse_httpStatus' - The response's http status code.
newUpdateTrustResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdateTrustResponse
newUpdateTrustResponse :: Int -> UpdateTrustResponse
newUpdateTrustResponse Int
pHttpStatus_ =
  UpdateTrustResponse'
    { $sel:requestId:UpdateTrustResponse' :: Maybe Text
requestId = forall a. Maybe a
Prelude.Nothing,
      $sel:trustId:UpdateTrustResponse' :: Maybe Text
trustId = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdateTrustResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Undocumented member.
updateTrustResponse_requestId :: Lens.Lens' UpdateTrustResponse (Prelude.Maybe Prelude.Text)
updateTrustResponse_requestId :: Lens' UpdateTrustResponse (Maybe Text)
updateTrustResponse_requestId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTrustResponse' {Maybe Text
requestId :: Maybe Text
$sel:requestId:UpdateTrustResponse' :: UpdateTrustResponse -> Maybe Text
requestId} -> Maybe Text
requestId) (\s :: UpdateTrustResponse
s@UpdateTrustResponse' {} Maybe Text
a -> UpdateTrustResponse
s {$sel:requestId:UpdateTrustResponse' :: Maybe Text
requestId = Maybe Text
a} :: UpdateTrustResponse)

-- | Identifier of the trust relationship.
updateTrustResponse_trustId :: Lens.Lens' UpdateTrustResponse (Prelude.Maybe Prelude.Text)
updateTrustResponse_trustId :: Lens' UpdateTrustResponse (Maybe Text)
updateTrustResponse_trustId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTrustResponse' {Maybe Text
trustId :: Maybe Text
$sel:trustId:UpdateTrustResponse' :: UpdateTrustResponse -> Maybe Text
trustId} -> Maybe Text
trustId) (\s :: UpdateTrustResponse
s@UpdateTrustResponse' {} Maybe Text
a -> UpdateTrustResponse
s {$sel:trustId:UpdateTrustResponse' :: Maybe Text
trustId = Maybe Text
a} :: UpdateTrustResponse)

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

instance Prelude.NFData UpdateTrustResponse where
  rnf :: UpdateTrustResponse -> ()
rnf UpdateTrustResponse' {Int
Maybe Text
httpStatus :: Int
trustId :: Maybe Text
requestId :: Maybe Text
$sel:httpStatus:UpdateTrustResponse' :: UpdateTrustResponse -> Int
$sel:trustId:UpdateTrustResponse' :: UpdateTrustResponse -> Maybe Text
$sel:requestId:UpdateTrustResponse' :: UpdateTrustResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
requestId
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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