{-# 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.WorkSpaces.ModifySamlProperties
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Modifies multiple properties related to SAML 2.0 authentication,
-- including the enablement status, user access URL, and relay state
-- parameter name that are used for configuring federation with an SAML 2.0
-- identity provider.
module Amazonka.WorkSpaces.ModifySamlProperties
  ( -- * Creating a Request
    ModifySamlProperties (..),
    newModifySamlProperties,

    -- * Request Lenses
    modifySamlProperties_propertiesToDelete,
    modifySamlProperties_samlProperties,
    modifySamlProperties_resourceId,

    -- * Destructuring the Response
    ModifySamlPropertiesResponse (..),
    newModifySamlPropertiesResponse,

    -- * Response Lenses
    modifySamlPropertiesResponse_httpStatus,
  )
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 qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.WorkSpaces.Types

-- | /See:/ 'newModifySamlProperties' smart constructor.
data ModifySamlProperties = ModifySamlProperties'
  { -- | The SAML properties to delete as part of your request.
    --
    -- Specify one of the following options:
    --
    -- -   @SAML_PROPERTIES_USER_ACCESS_URL@ to delete the user access URL.
    --
    -- -   @SAML_PROPERTIES_RELAY_STATE_PARAMETER_NAME@ to delete the relay
    --     state parameter name.
    ModifySamlProperties -> Maybe [DeletableSamlProperty]
propertiesToDelete :: Prelude.Maybe [DeletableSamlProperty],
    -- | The properties for configuring SAML 2.0 authentication.
    ModifySamlProperties -> Maybe SamlProperties
samlProperties :: Prelude.Maybe SamlProperties,
    -- | The directory identifier for which you want to configure SAML
    -- properties.
    ModifySamlProperties -> Text
resourceId :: Prelude.Text
  }
  deriving (ModifySamlProperties -> ModifySamlProperties -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ModifySamlProperties -> ModifySamlProperties -> Bool
$c/= :: ModifySamlProperties -> ModifySamlProperties -> Bool
== :: ModifySamlProperties -> ModifySamlProperties -> Bool
$c== :: ModifySamlProperties -> ModifySamlProperties -> Bool
Prelude.Eq, ReadPrec [ModifySamlProperties]
ReadPrec ModifySamlProperties
Int -> ReadS ModifySamlProperties
ReadS [ModifySamlProperties]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ModifySamlProperties]
$creadListPrec :: ReadPrec [ModifySamlProperties]
readPrec :: ReadPrec ModifySamlProperties
$creadPrec :: ReadPrec ModifySamlProperties
readList :: ReadS [ModifySamlProperties]
$creadList :: ReadS [ModifySamlProperties]
readsPrec :: Int -> ReadS ModifySamlProperties
$creadsPrec :: Int -> ReadS ModifySamlProperties
Prelude.Read, Int -> ModifySamlProperties -> ShowS
[ModifySamlProperties] -> ShowS
ModifySamlProperties -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ModifySamlProperties] -> ShowS
$cshowList :: [ModifySamlProperties] -> ShowS
show :: ModifySamlProperties -> String
$cshow :: ModifySamlProperties -> String
showsPrec :: Int -> ModifySamlProperties -> ShowS
$cshowsPrec :: Int -> ModifySamlProperties -> ShowS
Prelude.Show, forall x. Rep ModifySamlProperties x -> ModifySamlProperties
forall x. ModifySamlProperties -> Rep ModifySamlProperties x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ModifySamlProperties x -> ModifySamlProperties
$cfrom :: forall x. ModifySamlProperties -> Rep ModifySamlProperties x
Prelude.Generic)

-- |
-- Create a value of 'ModifySamlProperties' 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:
--
-- 'propertiesToDelete', 'modifySamlProperties_propertiesToDelete' - The SAML properties to delete as part of your request.
--
-- Specify one of the following options:
--
-- -   @SAML_PROPERTIES_USER_ACCESS_URL@ to delete the user access URL.
--
-- -   @SAML_PROPERTIES_RELAY_STATE_PARAMETER_NAME@ to delete the relay
--     state parameter name.
--
-- 'samlProperties', 'modifySamlProperties_samlProperties' - The properties for configuring SAML 2.0 authentication.
--
-- 'resourceId', 'modifySamlProperties_resourceId' - The directory identifier for which you want to configure SAML
-- properties.
newModifySamlProperties ::
  -- | 'resourceId'
  Prelude.Text ->
  ModifySamlProperties
newModifySamlProperties :: Text -> ModifySamlProperties
newModifySamlProperties Text
pResourceId_ =
  ModifySamlProperties'
    { $sel:propertiesToDelete:ModifySamlProperties' :: Maybe [DeletableSamlProperty]
propertiesToDelete =
        forall a. Maybe a
Prelude.Nothing,
      $sel:samlProperties:ModifySamlProperties' :: Maybe SamlProperties
samlProperties = forall a. Maybe a
Prelude.Nothing,
      $sel:resourceId:ModifySamlProperties' :: Text
resourceId = Text
pResourceId_
    }

-- | The SAML properties to delete as part of your request.
--
-- Specify one of the following options:
--
-- -   @SAML_PROPERTIES_USER_ACCESS_URL@ to delete the user access URL.
--
-- -   @SAML_PROPERTIES_RELAY_STATE_PARAMETER_NAME@ to delete the relay
--     state parameter name.
modifySamlProperties_propertiesToDelete :: Lens.Lens' ModifySamlProperties (Prelude.Maybe [DeletableSamlProperty])
modifySamlProperties_propertiesToDelete :: Lens' ModifySamlProperties (Maybe [DeletableSamlProperty])
modifySamlProperties_propertiesToDelete = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySamlProperties' {Maybe [DeletableSamlProperty]
propertiesToDelete :: Maybe [DeletableSamlProperty]
$sel:propertiesToDelete:ModifySamlProperties' :: ModifySamlProperties -> Maybe [DeletableSamlProperty]
propertiesToDelete} -> Maybe [DeletableSamlProperty]
propertiesToDelete) (\s :: ModifySamlProperties
s@ModifySamlProperties' {} Maybe [DeletableSamlProperty]
a -> ModifySamlProperties
s {$sel:propertiesToDelete:ModifySamlProperties' :: Maybe [DeletableSamlProperty]
propertiesToDelete = Maybe [DeletableSamlProperty]
a} :: ModifySamlProperties) 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

-- | The properties for configuring SAML 2.0 authentication.
modifySamlProperties_samlProperties :: Lens.Lens' ModifySamlProperties (Prelude.Maybe SamlProperties)
modifySamlProperties_samlProperties :: Lens' ModifySamlProperties (Maybe SamlProperties)
modifySamlProperties_samlProperties = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySamlProperties' {Maybe SamlProperties
samlProperties :: Maybe SamlProperties
$sel:samlProperties:ModifySamlProperties' :: ModifySamlProperties -> Maybe SamlProperties
samlProperties} -> Maybe SamlProperties
samlProperties) (\s :: ModifySamlProperties
s@ModifySamlProperties' {} Maybe SamlProperties
a -> ModifySamlProperties
s {$sel:samlProperties:ModifySamlProperties' :: Maybe SamlProperties
samlProperties = Maybe SamlProperties
a} :: ModifySamlProperties)

-- | The directory identifier for which you want to configure SAML
-- properties.
modifySamlProperties_resourceId :: Lens.Lens' ModifySamlProperties Prelude.Text
modifySamlProperties_resourceId :: Lens' ModifySamlProperties Text
modifySamlProperties_resourceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ModifySamlProperties' {Text
resourceId :: Text
$sel:resourceId:ModifySamlProperties' :: ModifySamlProperties -> Text
resourceId} -> Text
resourceId) (\s :: ModifySamlProperties
s@ModifySamlProperties' {} Text
a -> ModifySamlProperties
s {$sel:resourceId:ModifySamlProperties' :: Text
resourceId = Text
a} :: ModifySamlProperties)

instance Core.AWSRequest ModifySamlProperties where
  type
    AWSResponse ModifySamlProperties =
      ModifySamlPropertiesResponse
  request :: (Service -> Service)
-> ModifySamlProperties -> Request ModifySamlProperties
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 ModifySamlProperties
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse ModifySamlProperties)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> () -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveEmpty
      ( \Int
s ResponseHeaders
h ()
x ->
          Int -> ModifySamlPropertiesResponse
ModifySamlPropertiesResponse'
            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))
      )

instance Prelude.Hashable ModifySamlProperties where
  hashWithSalt :: Int -> ModifySamlProperties -> Int
hashWithSalt Int
_salt ModifySamlProperties' {Maybe [DeletableSamlProperty]
Maybe SamlProperties
Text
resourceId :: Text
samlProperties :: Maybe SamlProperties
propertiesToDelete :: Maybe [DeletableSamlProperty]
$sel:resourceId:ModifySamlProperties' :: ModifySamlProperties -> Text
$sel:samlProperties:ModifySamlProperties' :: ModifySamlProperties -> Maybe SamlProperties
$sel:propertiesToDelete:ModifySamlProperties' :: ModifySamlProperties -> Maybe [DeletableSamlProperty]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DeletableSamlProperty]
propertiesToDelete
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe SamlProperties
samlProperties
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
resourceId

instance Prelude.NFData ModifySamlProperties where
  rnf :: ModifySamlProperties -> ()
rnf ModifySamlProperties' {Maybe [DeletableSamlProperty]
Maybe SamlProperties
Text
resourceId :: Text
samlProperties :: Maybe SamlProperties
propertiesToDelete :: Maybe [DeletableSamlProperty]
$sel:resourceId:ModifySamlProperties' :: ModifySamlProperties -> Text
$sel:samlProperties:ModifySamlProperties' :: ModifySamlProperties -> Maybe SamlProperties
$sel:propertiesToDelete:ModifySamlProperties' :: ModifySamlProperties -> Maybe [DeletableSamlProperty]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [DeletableSamlProperty]
propertiesToDelete
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe SamlProperties
samlProperties
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
resourceId

instance Data.ToHeaders ModifySamlProperties where
  toHeaders :: ModifySamlProperties -> 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
"WorkspacesService.ModifySamlProperties" ::
                          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 ModifySamlProperties where
  toJSON :: ModifySamlProperties -> Value
toJSON ModifySamlProperties' {Maybe [DeletableSamlProperty]
Maybe SamlProperties
Text
resourceId :: Text
samlProperties :: Maybe SamlProperties
propertiesToDelete :: Maybe [DeletableSamlProperty]
$sel:resourceId:ModifySamlProperties' :: ModifySamlProperties -> Text
$sel:samlProperties:ModifySamlProperties' :: ModifySamlProperties -> Maybe SamlProperties
$sel:propertiesToDelete:ModifySamlProperties' :: ModifySamlProperties -> Maybe [DeletableSamlProperty]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"PropertiesToDelete" 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 [DeletableSamlProperty]
propertiesToDelete,
            (Key
"SamlProperties" 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 SamlProperties
samlProperties,
            forall a. a -> Maybe a
Prelude.Just (Key
"ResourceId" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
resourceId)
          ]
      )

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

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

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

-- |
-- Create a value of 'ModifySamlPropertiesResponse' 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', 'modifySamlPropertiesResponse_httpStatus' - The response's http status code.
newModifySamlPropertiesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  ModifySamlPropertiesResponse
newModifySamlPropertiesResponse :: Int -> ModifySamlPropertiesResponse
newModifySamlPropertiesResponse Int
pHttpStatus_ =
  ModifySamlPropertiesResponse'
    { $sel:httpStatus:ModifySamlPropertiesResponse' :: Int
httpStatus =
        Int
pHttpStatus_
    }

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

instance Prelude.NFData ModifySamlPropertiesResponse where
  rnf :: ModifySamlPropertiesResponse -> ()
rnf ModifySamlPropertiesResponse' {Int
httpStatus :: Int
$sel:httpStatus:ModifySamlPropertiesResponse' :: ModifySamlPropertiesResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus