{-# 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.WorkSpacesWeb.UpdateBrowserSettings
-- 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 browser settings.
module Amazonka.WorkSpacesWeb.UpdateBrowserSettings
  ( -- * Creating a Request
    UpdateBrowserSettings (..),
    newUpdateBrowserSettings,

    -- * Request Lenses
    updateBrowserSettings_browserPolicy,
    updateBrowserSettings_clientToken,
    updateBrowserSettings_browserSettingsArn,

    -- * Destructuring the Response
    UpdateBrowserSettingsResponse (..),
    newUpdateBrowserSettingsResponse,

    -- * Response Lenses
    updateBrowserSettingsResponse_httpStatus,
    updateBrowserSettingsResponse_browserSettings,
  )
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.WorkSpacesWeb.Types

-- | /See:/ 'newUpdateBrowserSettings' smart constructor.
data UpdateBrowserSettings = UpdateBrowserSettings'
  { -- | A JSON string containing Chrome Enterprise policies that will be applied
    -- to all streaming sessions.
    UpdateBrowserSettings -> Maybe (Sensitive Text)
browserPolicy :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | A unique, case-sensitive identifier that you provide to ensure the
    -- idempotency of the request. Idempotency ensures that an API request
    -- completes only once. With an idempotent request, if the original request
    -- completes successfully, subsequent retries with the same client token
    -- return the result from the original successful request.
    --
    -- If you do not specify a client token, one is automatically generated by
    -- the AWS SDK.
    UpdateBrowserSettings -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The ARN of the browser settings.
    UpdateBrowserSettings -> Text
browserSettingsArn :: Prelude.Text
  }
  deriving (UpdateBrowserSettings -> UpdateBrowserSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBrowserSettings -> UpdateBrowserSettings -> Bool
$c/= :: UpdateBrowserSettings -> UpdateBrowserSettings -> Bool
== :: UpdateBrowserSettings -> UpdateBrowserSettings -> Bool
$c== :: UpdateBrowserSettings -> UpdateBrowserSettings -> Bool
Prelude.Eq, Int -> UpdateBrowserSettings -> ShowS
[UpdateBrowserSettings] -> ShowS
UpdateBrowserSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBrowserSettings] -> ShowS
$cshowList :: [UpdateBrowserSettings] -> ShowS
show :: UpdateBrowserSettings -> String
$cshow :: UpdateBrowserSettings -> String
showsPrec :: Int -> UpdateBrowserSettings -> ShowS
$cshowsPrec :: Int -> UpdateBrowserSettings -> ShowS
Prelude.Show, forall x. Rep UpdateBrowserSettings x -> UpdateBrowserSettings
forall x. UpdateBrowserSettings -> Rep UpdateBrowserSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateBrowserSettings x -> UpdateBrowserSettings
$cfrom :: forall x. UpdateBrowserSettings -> Rep UpdateBrowserSettings x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBrowserSettings' 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:
--
-- 'browserPolicy', 'updateBrowserSettings_browserPolicy' - A JSON string containing Chrome Enterprise policies that will be applied
-- to all streaming sessions.
--
-- 'clientToken', 'updateBrowserSettings_clientToken' - A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. Idempotency ensures that an API request
-- completes only once. With an idempotent request, if the original request
-- completes successfully, subsequent retries with the same client token
-- return the result from the original successful request.
--
-- If you do not specify a client token, one is automatically generated by
-- the AWS SDK.
--
-- 'browserSettingsArn', 'updateBrowserSettings_browserSettingsArn' - The ARN of the browser settings.
newUpdateBrowserSettings ::
  -- | 'browserSettingsArn'
  Prelude.Text ->
  UpdateBrowserSettings
newUpdateBrowserSettings :: Text -> UpdateBrowserSettings
newUpdateBrowserSettings Text
pBrowserSettingsArn_ =
  UpdateBrowserSettings'
    { $sel:browserPolicy:UpdateBrowserSettings' :: Maybe (Sensitive Text)
browserPolicy =
        forall a. Maybe a
Prelude.Nothing,
      $sel:clientToken:UpdateBrowserSettings' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
      $sel:browserSettingsArn:UpdateBrowserSettings' :: Text
browserSettingsArn = Text
pBrowserSettingsArn_
    }

-- | A JSON string containing Chrome Enterprise policies that will be applied
-- to all streaming sessions.
updateBrowserSettings_browserPolicy :: Lens.Lens' UpdateBrowserSettings (Prelude.Maybe Prelude.Text)
updateBrowserSettings_browserPolicy :: Lens' UpdateBrowserSettings (Maybe Text)
updateBrowserSettings_browserPolicy = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrowserSettings' {Maybe (Sensitive Text)
browserPolicy :: Maybe (Sensitive Text)
$sel:browserPolicy:UpdateBrowserSettings' :: UpdateBrowserSettings -> Maybe (Sensitive Text)
browserPolicy} -> Maybe (Sensitive Text)
browserPolicy) (\s :: UpdateBrowserSettings
s@UpdateBrowserSettings' {} Maybe (Sensitive Text)
a -> UpdateBrowserSettings
s {$sel:browserPolicy:UpdateBrowserSettings' :: Maybe (Sensitive Text)
browserPolicy = Maybe (Sensitive Text)
a} :: UpdateBrowserSettings) 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 a. Iso' (Sensitive a) a
Data._Sensitive

-- | A unique, case-sensitive identifier that you provide to ensure the
-- idempotency of the request. Idempotency ensures that an API request
-- completes only once. With an idempotent request, if the original request
-- completes successfully, subsequent retries with the same client token
-- return the result from the original successful request.
--
-- If you do not specify a client token, one is automatically generated by
-- the AWS SDK.
updateBrowserSettings_clientToken :: Lens.Lens' UpdateBrowserSettings (Prelude.Maybe Prelude.Text)
updateBrowserSettings_clientToken :: Lens' UpdateBrowserSettings (Maybe Text)
updateBrowserSettings_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrowserSettings' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:UpdateBrowserSettings' :: UpdateBrowserSettings -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: UpdateBrowserSettings
s@UpdateBrowserSettings' {} Maybe Text
a -> UpdateBrowserSettings
s {$sel:clientToken:UpdateBrowserSettings' :: Maybe Text
clientToken = Maybe Text
a} :: UpdateBrowserSettings)

-- | The ARN of the browser settings.
updateBrowserSettings_browserSettingsArn :: Lens.Lens' UpdateBrowserSettings Prelude.Text
updateBrowserSettings_browserSettingsArn :: Lens' UpdateBrowserSettings Text
updateBrowserSettings_browserSettingsArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrowserSettings' {Text
browserSettingsArn :: Text
$sel:browserSettingsArn:UpdateBrowserSettings' :: UpdateBrowserSettings -> Text
browserSettingsArn} -> Text
browserSettingsArn) (\s :: UpdateBrowserSettings
s@UpdateBrowserSettings' {} Text
a -> UpdateBrowserSettings
s {$sel:browserSettingsArn:UpdateBrowserSettings' :: Text
browserSettingsArn = Text
a} :: UpdateBrowserSettings)

instance Core.AWSRequest UpdateBrowserSettings where
  type
    AWSResponse UpdateBrowserSettings =
      UpdateBrowserSettingsResponse
  request :: (Service -> Service)
-> UpdateBrowserSettings -> Request UpdateBrowserSettings
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateBrowserSettings
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse UpdateBrowserSettings)))
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 -> BrowserSettings -> UpdateBrowserSettingsResponse
UpdateBrowserSettingsResponse'
            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
"browserSettings")
      )

instance Prelude.Hashable UpdateBrowserSettings where
  hashWithSalt :: Int -> UpdateBrowserSettings -> Int
hashWithSalt Int
_salt UpdateBrowserSettings' {Maybe Text
Maybe (Sensitive Text)
Text
browserSettingsArn :: Text
clientToken :: Maybe Text
browserPolicy :: Maybe (Sensitive Text)
$sel:browserSettingsArn:UpdateBrowserSettings' :: UpdateBrowserSettings -> Text
$sel:clientToken:UpdateBrowserSettings' :: UpdateBrowserSettings -> Maybe Text
$sel:browserPolicy:UpdateBrowserSettings' :: UpdateBrowserSettings -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
browserPolicy
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
browserSettingsArn

instance Prelude.NFData UpdateBrowserSettings where
  rnf :: UpdateBrowserSettings -> ()
rnf UpdateBrowserSettings' {Maybe Text
Maybe (Sensitive Text)
Text
browserSettingsArn :: Text
clientToken :: Maybe Text
browserPolicy :: Maybe (Sensitive Text)
$sel:browserSettingsArn:UpdateBrowserSettings' :: UpdateBrowserSettings -> Text
$sel:clientToken:UpdateBrowserSettings' :: UpdateBrowserSettings -> Maybe Text
$sel:browserPolicy:UpdateBrowserSettings' :: UpdateBrowserSettings -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
browserPolicy
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
clientToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
browserSettingsArn

instance Data.ToHeaders UpdateBrowserSettings where
  toHeaders :: UpdateBrowserSettings -> 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 UpdateBrowserSettings where
  toJSON :: UpdateBrowserSettings -> Value
toJSON UpdateBrowserSettings' {Maybe Text
Maybe (Sensitive Text)
Text
browserSettingsArn :: Text
clientToken :: Maybe Text
browserPolicy :: Maybe (Sensitive Text)
$sel:browserSettingsArn:UpdateBrowserSettings' :: UpdateBrowserSettings -> Text
$sel:clientToken:UpdateBrowserSettings' :: UpdateBrowserSettings -> Maybe Text
$sel:browserPolicy:UpdateBrowserSettings' :: UpdateBrowserSettings -> Maybe (Sensitive Text)
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"browserPolicy" 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 (Sensitive Text)
browserPolicy,
            (Key
"clientToken" 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
clientToken
          ]
      )

instance Data.ToPath UpdateBrowserSettings where
  toPath :: UpdateBrowserSettings -> ByteString
toPath UpdateBrowserSettings' {Maybe Text
Maybe (Sensitive Text)
Text
browserSettingsArn :: Text
clientToken :: Maybe Text
browserPolicy :: Maybe (Sensitive Text)
$sel:browserSettingsArn:UpdateBrowserSettings' :: UpdateBrowserSettings -> Text
$sel:clientToken:UpdateBrowserSettings' :: UpdateBrowserSettings -> Maybe Text
$sel:browserPolicy:UpdateBrowserSettings' :: UpdateBrowserSettings -> Maybe (Sensitive Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/browserSettings/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
browserSettingsArn]

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

-- | /See:/ 'newUpdateBrowserSettingsResponse' smart constructor.
data UpdateBrowserSettingsResponse = UpdateBrowserSettingsResponse'
  { -- | The response's http status code.
    UpdateBrowserSettingsResponse -> Int
httpStatus :: Prelude.Int,
    -- | The browser settings.
    UpdateBrowserSettingsResponse -> BrowserSettings
browserSettings :: BrowserSettings
  }
  deriving (UpdateBrowserSettingsResponse
-> UpdateBrowserSettingsResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateBrowserSettingsResponse
-> UpdateBrowserSettingsResponse -> Bool
$c/= :: UpdateBrowserSettingsResponse
-> UpdateBrowserSettingsResponse -> Bool
== :: UpdateBrowserSettingsResponse
-> UpdateBrowserSettingsResponse -> Bool
$c== :: UpdateBrowserSettingsResponse
-> UpdateBrowserSettingsResponse -> Bool
Prelude.Eq, Int -> UpdateBrowserSettingsResponse -> ShowS
[UpdateBrowserSettingsResponse] -> ShowS
UpdateBrowserSettingsResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateBrowserSettingsResponse] -> ShowS
$cshowList :: [UpdateBrowserSettingsResponse] -> ShowS
show :: UpdateBrowserSettingsResponse -> String
$cshow :: UpdateBrowserSettingsResponse -> String
showsPrec :: Int -> UpdateBrowserSettingsResponse -> ShowS
$cshowsPrec :: Int -> UpdateBrowserSettingsResponse -> ShowS
Prelude.Show, forall x.
Rep UpdateBrowserSettingsResponse x
-> UpdateBrowserSettingsResponse
forall x.
UpdateBrowserSettingsResponse
-> Rep UpdateBrowserSettingsResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep UpdateBrowserSettingsResponse x
-> UpdateBrowserSettingsResponse
$cfrom :: forall x.
UpdateBrowserSettingsResponse
-> Rep UpdateBrowserSettingsResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateBrowserSettingsResponse' 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', 'updateBrowserSettingsResponse_httpStatus' - The response's http status code.
--
-- 'browserSettings', 'updateBrowserSettingsResponse_browserSettings' - The browser settings.
newUpdateBrowserSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'browserSettings'
  BrowserSettings ->
  UpdateBrowserSettingsResponse
newUpdateBrowserSettingsResponse :: Int -> BrowserSettings -> UpdateBrowserSettingsResponse
newUpdateBrowserSettingsResponse
  Int
pHttpStatus_
  BrowserSettings
pBrowserSettings_ =
    UpdateBrowserSettingsResponse'
      { $sel:httpStatus:UpdateBrowserSettingsResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:browserSettings:UpdateBrowserSettingsResponse' :: BrowserSettings
browserSettings = BrowserSettings
pBrowserSettings_
      }

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

-- | The browser settings.
updateBrowserSettingsResponse_browserSettings :: Lens.Lens' UpdateBrowserSettingsResponse BrowserSettings
updateBrowserSettingsResponse_browserSettings :: Lens' UpdateBrowserSettingsResponse BrowserSettings
updateBrowserSettingsResponse_browserSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateBrowserSettingsResponse' {BrowserSettings
browserSettings :: BrowserSettings
$sel:browserSettings:UpdateBrowserSettingsResponse' :: UpdateBrowserSettingsResponse -> BrowserSettings
browserSettings} -> BrowserSettings
browserSettings) (\s :: UpdateBrowserSettingsResponse
s@UpdateBrowserSettingsResponse' {} BrowserSettings
a -> UpdateBrowserSettingsResponse
s {$sel:browserSettings:UpdateBrowserSettingsResponse' :: BrowserSettings
browserSettings = BrowserSettings
a} :: UpdateBrowserSettingsResponse)

instance Prelude.NFData UpdateBrowserSettingsResponse where
  rnf :: UpdateBrowserSettingsResponse -> ()
rnf UpdateBrowserSettingsResponse' {Int
BrowserSettings
browserSettings :: BrowserSettings
httpStatus :: Int
$sel:browserSettings:UpdateBrowserSettingsResponse' :: UpdateBrowserSettingsResponse -> BrowserSettings
$sel:httpStatus:UpdateBrowserSettingsResponse' :: UpdateBrowserSettingsResponse -> 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 BrowserSettings
browserSettings