{-# 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.Grafana.UpdateWorkspaceAuthentication
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Use this operation to define the identity provider (IdP) that this
-- workspace authenticates users from, using SAML. You can also map SAML
-- assertion attributes to workspace user information and define which
-- groups in the assertion attribute are to have the @Admin@ and @Editor@
-- roles in the workspace.
module Amazonka.Grafana.UpdateWorkspaceAuthentication
  ( -- * Creating a Request
    UpdateWorkspaceAuthentication (..),
    newUpdateWorkspaceAuthentication,

    -- * Request Lenses
    updateWorkspaceAuthentication_samlConfiguration,
    updateWorkspaceAuthentication_authenticationProviders,
    updateWorkspaceAuthentication_workspaceId,

    -- * Destructuring the Response
    UpdateWorkspaceAuthenticationResponse (..),
    newUpdateWorkspaceAuthenticationResponse,

    -- * Response Lenses
    updateWorkspaceAuthenticationResponse_httpStatus,
    updateWorkspaceAuthenticationResponse_authentication,
  )
where

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

-- | /See:/ 'newUpdateWorkspaceAuthentication' smart constructor.
data UpdateWorkspaceAuthentication = UpdateWorkspaceAuthentication'
  { -- | If the workspace uses SAML, use this structure to map SAML assertion
    -- attributes to workspace user information and define which groups in the
    -- assertion attribute are to have the @Admin@ and @Editor@ roles in the
    -- workspace.
    UpdateWorkspaceAuthentication -> Maybe SamlConfiguration
samlConfiguration :: Prelude.Maybe SamlConfiguration,
    -- | Specifies whether this workspace uses SAML 2.0, IAM Identity Center
    -- (successor to Single Sign-On), or both to authenticate users for using
    -- the Grafana console within a workspace. For more information, see
    -- <https://docs.aws.amazon.com/grafana/latest/userguide/authentication-in-AMG.html User authentication in Amazon Managed Grafana>.
    UpdateWorkspaceAuthentication -> [AuthenticationProviderTypes]
authenticationProviders :: [AuthenticationProviderTypes],
    -- | The ID of the workspace to update the authentication for.
    UpdateWorkspaceAuthentication -> Text
workspaceId :: Prelude.Text
  }
  deriving (UpdateWorkspaceAuthentication
-> UpdateWorkspaceAuthentication -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWorkspaceAuthentication
-> UpdateWorkspaceAuthentication -> Bool
$c/= :: UpdateWorkspaceAuthentication
-> UpdateWorkspaceAuthentication -> Bool
== :: UpdateWorkspaceAuthentication
-> UpdateWorkspaceAuthentication -> Bool
$c== :: UpdateWorkspaceAuthentication
-> UpdateWorkspaceAuthentication -> Bool
Prelude.Eq, ReadPrec [UpdateWorkspaceAuthentication]
ReadPrec UpdateWorkspaceAuthentication
Int -> ReadS UpdateWorkspaceAuthentication
ReadS [UpdateWorkspaceAuthentication]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWorkspaceAuthentication]
$creadListPrec :: ReadPrec [UpdateWorkspaceAuthentication]
readPrec :: ReadPrec UpdateWorkspaceAuthentication
$creadPrec :: ReadPrec UpdateWorkspaceAuthentication
readList :: ReadS [UpdateWorkspaceAuthentication]
$creadList :: ReadS [UpdateWorkspaceAuthentication]
readsPrec :: Int -> ReadS UpdateWorkspaceAuthentication
$creadsPrec :: Int -> ReadS UpdateWorkspaceAuthentication
Prelude.Read, Int -> UpdateWorkspaceAuthentication -> ShowS
[UpdateWorkspaceAuthentication] -> ShowS
UpdateWorkspaceAuthentication -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWorkspaceAuthentication] -> ShowS
$cshowList :: [UpdateWorkspaceAuthentication] -> ShowS
show :: UpdateWorkspaceAuthentication -> String
$cshow :: UpdateWorkspaceAuthentication -> String
showsPrec :: Int -> UpdateWorkspaceAuthentication -> ShowS
$cshowsPrec :: Int -> UpdateWorkspaceAuthentication -> ShowS
Prelude.Show, forall x.
Rep UpdateWorkspaceAuthentication x
-> UpdateWorkspaceAuthentication
forall x.
UpdateWorkspaceAuthentication
-> Rep UpdateWorkspaceAuthentication x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateWorkspaceAuthentication x
-> UpdateWorkspaceAuthentication
$cfrom :: forall x.
UpdateWorkspaceAuthentication
-> Rep UpdateWorkspaceAuthentication x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWorkspaceAuthentication' 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:
--
-- 'samlConfiguration', 'updateWorkspaceAuthentication_samlConfiguration' - If the workspace uses SAML, use this structure to map SAML assertion
-- attributes to workspace user information and define which groups in the
-- assertion attribute are to have the @Admin@ and @Editor@ roles in the
-- workspace.
--
-- 'authenticationProviders', 'updateWorkspaceAuthentication_authenticationProviders' - Specifies whether this workspace uses SAML 2.0, IAM Identity Center
-- (successor to Single Sign-On), or both to authenticate users for using
-- the Grafana console within a workspace. For more information, see
-- <https://docs.aws.amazon.com/grafana/latest/userguide/authentication-in-AMG.html User authentication in Amazon Managed Grafana>.
--
-- 'workspaceId', 'updateWorkspaceAuthentication_workspaceId' - The ID of the workspace to update the authentication for.
newUpdateWorkspaceAuthentication ::
  -- | 'workspaceId'
  Prelude.Text ->
  UpdateWorkspaceAuthentication
newUpdateWorkspaceAuthentication :: Text -> UpdateWorkspaceAuthentication
newUpdateWorkspaceAuthentication Text
pWorkspaceId_ =
  UpdateWorkspaceAuthentication'
    { $sel:samlConfiguration:UpdateWorkspaceAuthentication' :: Maybe SamlConfiguration
samlConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:authenticationProviders:UpdateWorkspaceAuthentication' :: [AuthenticationProviderTypes]
authenticationProviders = forall a. Monoid a => a
Prelude.mempty,
      $sel:workspaceId:UpdateWorkspaceAuthentication' :: Text
workspaceId = Text
pWorkspaceId_
    }

-- | If the workspace uses SAML, use this structure to map SAML assertion
-- attributes to workspace user information and define which groups in the
-- assertion attribute are to have the @Admin@ and @Editor@ roles in the
-- workspace.
updateWorkspaceAuthentication_samlConfiguration :: Lens.Lens' UpdateWorkspaceAuthentication (Prelude.Maybe SamlConfiguration)
updateWorkspaceAuthentication_samlConfiguration :: Lens' UpdateWorkspaceAuthentication (Maybe SamlConfiguration)
updateWorkspaceAuthentication_samlConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkspaceAuthentication' {Maybe SamlConfiguration
samlConfiguration :: Maybe SamlConfiguration
$sel:samlConfiguration:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> Maybe SamlConfiguration
samlConfiguration} -> Maybe SamlConfiguration
samlConfiguration) (\s :: UpdateWorkspaceAuthentication
s@UpdateWorkspaceAuthentication' {} Maybe SamlConfiguration
a -> UpdateWorkspaceAuthentication
s {$sel:samlConfiguration:UpdateWorkspaceAuthentication' :: Maybe SamlConfiguration
samlConfiguration = Maybe SamlConfiguration
a} :: UpdateWorkspaceAuthentication)

-- | Specifies whether this workspace uses SAML 2.0, IAM Identity Center
-- (successor to Single Sign-On), or both to authenticate users for using
-- the Grafana console within a workspace. For more information, see
-- <https://docs.aws.amazon.com/grafana/latest/userguide/authentication-in-AMG.html User authentication in Amazon Managed Grafana>.
updateWorkspaceAuthentication_authenticationProviders :: Lens.Lens' UpdateWorkspaceAuthentication [AuthenticationProviderTypes]
updateWorkspaceAuthentication_authenticationProviders :: Lens' UpdateWorkspaceAuthentication [AuthenticationProviderTypes]
updateWorkspaceAuthentication_authenticationProviders = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkspaceAuthentication' {[AuthenticationProviderTypes]
authenticationProviders :: [AuthenticationProviderTypes]
$sel:authenticationProviders:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> [AuthenticationProviderTypes]
authenticationProviders} -> [AuthenticationProviderTypes]
authenticationProviders) (\s :: UpdateWorkspaceAuthentication
s@UpdateWorkspaceAuthentication' {} [AuthenticationProviderTypes]
a -> UpdateWorkspaceAuthentication
s {$sel:authenticationProviders:UpdateWorkspaceAuthentication' :: [AuthenticationProviderTypes]
authenticationProviders = [AuthenticationProviderTypes]
a} :: UpdateWorkspaceAuthentication) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | The ID of the workspace to update the authentication for.
updateWorkspaceAuthentication_workspaceId :: Lens.Lens' UpdateWorkspaceAuthentication Prelude.Text
updateWorkspaceAuthentication_workspaceId :: Lens' UpdateWorkspaceAuthentication Text
updateWorkspaceAuthentication_workspaceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkspaceAuthentication' {Text
workspaceId :: Text
$sel:workspaceId:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> Text
workspaceId} -> Text
workspaceId) (\s :: UpdateWorkspaceAuthentication
s@UpdateWorkspaceAuthentication' {} Text
a -> UpdateWorkspaceAuthentication
s {$sel:workspaceId:UpdateWorkspaceAuthentication' :: Text
workspaceId = Text
a} :: UpdateWorkspaceAuthentication)

instance
  Core.AWSRequest
    UpdateWorkspaceAuthentication
  where
  type
    AWSResponse UpdateWorkspaceAuthentication =
      UpdateWorkspaceAuthenticationResponse
  request :: (Service -> Service)
-> UpdateWorkspaceAuthentication
-> Request UpdateWorkspaceAuthentication
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 UpdateWorkspaceAuthentication
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateWorkspaceAuthentication)))
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 ->
          Int
-> AuthenticationDescription
-> UpdateWorkspaceAuthenticationResponse
UpdateWorkspaceAuthenticationResponse'
            forall (f :: * -> *) a b. Functor 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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"authentication")
      )

instance
  Prelude.Hashable
    UpdateWorkspaceAuthentication
  where
  hashWithSalt :: Int -> UpdateWorkspaceAuthentication -> Int
hashWithSalt Int
_salt UpdateWorkspaceAuthentication' {[AuthenticationProviderTypes]
Maybe SamlConfiguration
Text
workspaceId :: Text
authenticationProviders :: [AuthenticationProviderTypes]
samlConfiguration :: Maybe SamlConfiguration
$sel:workspaceId:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> Text
$sel:authenticationProviders:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> [AuthenticationProviderTypes]
$sel:samlConfiguration:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> Maybe SamlConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SamlConfiguration
samlConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` [AuthenticationProviderTypes]
authenticationProviders
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
workspaceId

instance Prelude.NFData UpdateWorkspaceAuthentication where
  rnf :: UpdateWorkspaceAuthentication -> ()
rnf UpdateWorkspaceAuthentication' {[AuthenticationProviderTypes]
Maybe SamlConfiguration
Text
workspaceId :: Text
authenticationProviders :: [AuthenticationProviderTypes]
samlConfiguration :: Maybe SamlConfiguration
$sel:workspaceId:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> Text
$sel:authenticationProviders:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> [AuthenticationProviderTypes]
$sel:samlConfiguration:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> Maybe SamlConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe SamlConfiguration
samlConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [AuthenticationProviderTypes]
authenticationProviders
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
workspaceId

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

instance Data.ToJSON UpdateWorkspaceAuthentication where
  toJSON :: UpdateWorkspaceAuthentication -> Value
toJSON UpdateWorkspaceAuthentication' {[AuthenticationProviderTypes]
Maybe SamlConfiguration
Text
workspaceId :: Text
authenticationProviders :: [AuthenticationProviderTypes]
samlConfiguration :: Maybe SamlConfiguration
$sel:workspaceId:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> Text
$sel:authenticationProviders:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> [AuthenticationProviderTypes]
$sel:samlConfiguration:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> Maybe SamlConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"samlConfiguration" 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 SamlConfiguration
samlConfiguration,
            forall a. a -> Maybe a
Prelude.Just
              ( Key
"authenticationProviders"
                  forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= [AuthenticationProviderTypes]
authenticationProviders
              )
          ]
      )

instance Data.ToPath UpdateWorkspaceAuthentication where
  toPath :: UpdateWorkspaceAuthentication -> ByteString
toPath UpdateWorkspaceAuthentication' {[AuthenticationProviderTypes]
Maybe SamlConfiguration
Text
workspaceId :: Text
authenticationProviders :: [AuthenticationProviderTypes]
samlConfiguration :: Maybe SamlConfiguration
$sel:workspaceId:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> Text
$sel:authenticationProviders:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> [AuthenticationProviderTypes]
$sel:samlConfiguration:UpdateWorkspaceAuthentication' :: UpdateWorkspaceAuthentication -> Maybe SamlConfiguration
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/workspaces/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
workspaceId,
        ByteString
"/authentication"
      ]

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

-- | /See:/ 'newUpdateWorkspaceAuthenticationResponse' smart constructor.
data UpdateWorkspaceAuthenticationResponse = UpdateWorkspaceAuthenticationResponse'
  { -- | The response's http status code.
    UpdateWorkspaceAuthenticationResponse -> Int
httpStatus :: Prelude.Int,
    -- | A structure that describes the user authentication for this workspace
    -- after the update is made.
    UpdateWorkspaceAuthenticationResponse -> AuthenticationDescription
authentication :: AuthenticationDescription
  }
  deriving (UpdateWorkspaceAuthenticationResponse
-> UpdateWorkspaceAuthenticationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateWorkspaceAuthenticationResponse
-> UpdateWorkspaceAuthenticationResponse -> Bool
$c/= :: UpdateWorkspaceAuthenticationResponse
-> UpdateWorkspaceAuthenticationResponse -> Bool
== :: UpdateWorkspaceAuthenticationResponse
-> UpdateWorkspaceAuthenticationResponse -> Bool
$c== :: UpdateWorkspaceAuthenticationResponse
-> UpdateWorkspaceAuthenticationResponse -> Bool
Prelude.Eq, ReadPrec [UpdateWorkspaceAuthenticationResponse]
ReadPrec UpdateWorkspaceAuthenticationResponse
Int -> ReadS UpdateWorkspaceAuthenticationResponse
ReadS [UpdateWorkspaceAuthenticationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateWorkspaceAuthenticationResponse]
$creadListPrec :: ReadPrec [UpdateWorkspaceAuthenticationResponse]
readPrec :: ReadPrec UpdateWorkspaceAuthenticationResponse
$creadPrec :: ReadPrec UpdateWorkspaceAuthenticationResponse
readList :: ReadS [UpdateWorkspaceAuthenticationResponse]
$creadList :: ReadS [UpdateWorkspaceAuthenticationResponse]
readsPrec :: Int -> ReadS UpdateWorkspaceAuthenticationResponse
$creadsPrec :: Int -> ReadS UpdateWorkspaceAuthenticationResponse
Prelude.Read, Int -> UpdateWorkspaceAuthenticationResponse -> ShowS
[UpdateWorkspaceAuthenticationResponse] -> ShowS
UpdateWorkspaceAuthenticationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateWorkspaceAuthenticationResponse] -> ShowS
$cshowList :: [UpdateWorkspaceAuthenticationResponse] -> ShowS
show :: UpdateWorkspaceAuthenticationResponse -> String
$cshow :: UpdateWorkspaceAuthenticationResponse -> String
showsPrec :: Int -> UpdateWorkspaceAuthenticationResponse -> ShowS
$cshowsPrec :: Int -> UpdateWorkspaceAuthenticationResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateWorkspaceAuthenticationResponse x
-> UpdateWorkspaceAuthenticationResponse
forall x.
UpdateWorkspaceAuthenticationResponse
-> Rep UpdateWorkspaceAuthenticationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateWorkspaceAuthenticationResponse x
-> UpdateWorkspaceAuthenticationResponse
$cfrom :: forall x.
UpdateWorkspaceAuthenticationResponse
-> Rep UpdateWorkspaceAuthenticationResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateWorkspaceAuthenticationResponse' 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:
--
-- 'httpStatus', 'updateWorkspaceAuthenticationResponse_httpStatus' - The response's http status code.
--
-- 'authentication', 'updateWorkspaceAuthenticationResponse_authentication' - A structure that describes the user authentication for this workspace
-- after the update is made.
newUpdateWorkspaceAuthenticationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'authentication'
  AuthenticationDescription ->
  UpdateWorkspaceAuthenticationResponse
newUpdateWorkspaceAuthenticationResponse :: Int
-> AuthenticationDescription
-> UpdateWorkspaceAuthenticationResponse
newUpdateWorkspaceAuthenticationResponse
  Int
pHttpStatus_
  AuthenticationDescription
pAuthentication_ =
    UpdateWorkspaceAuthenticationResponse'
      { $sel:httpStatus:UpdateWorkspaceAuthenticationResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:authentication:UpdateWorkspaceAuthenticationResponse' :: AuthenticationDescription
authentication = AuthenticationDescription
pAuthentication_
      }

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

-- | A structure that describes the user authentication for this workspace
-- after the update is made.
updateWorkspaceAuthenticationResponse_authentication :: Lens.Lens' UpdateWorkspaceAuthenticationResponse AuthenticationDescription
updateWorkspaceAuthenticationResponse_authentication :: Lens'
  UpdateWorkspaceAuthenticationResponse AuthenticationDescription
updateWorkspaceAuthenticationResponse_authentication = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateWorkspaceAuthenticationResponse' {AuthenticationDescription
authentication :: AuthenticationDescription
$sel:authentication:UpdateWorkspaceAuthenticationResponse' :: UpdateWorkspaceAuthenticationResponse -> AuthenticationDescription
authentication} -> AuthenticationDescription
authentication) (\s :: UpdateWorkspaceAuthenticationResponse
s@UpdateWorkspaceAuthenticationResponse' {} AuthenticationDescription
a -> UpdateWorkspaceAuthenticationResponse
s {$sel:authentication:UpdateWorkspaceAuthenticationResponse' :: AuthenticationDescription
authentication = AuthenticationDescription
a} :: UpdateWorkspaceAuthenticationResponse)

instance
  Prelude.NFData
    UpdateWorkspaceAuthenticationResponse
  where
  rnf :: UpdateWorkspaceAuthenticationResponse -> ()
rnf UpdateWorkspaceAuthenticationResponse' {Int
AuthenticationDescription
authentication :: AuthenticationDescription
httpStatus :: Int
$sel:authentication:UpdateWorkspaceAuthenticationResponse' :: UpdateWorkspaceAuthenticationResponse -> AuthenticationDescription
$sel:httpStatus:UpdateWorkspaceAuthenticationResponse' :: UpdateWorkspaceAuthenticationResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf AuthenticationDescription
authentication