{-# 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.GetUserSettings
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets user settings.
module Amazonka.WorkSpacesWeb.GetUserSettings
  ( -- * Creating a Request
    GetUserSettings (..),
    newGetUserSettings,

    -- * Request Lenses
    getUserSettings_userSettingsArn,

    -- * Destructuring the Response
    GetUserSettingsResponse (..),
    newGetUserSettingsResponse,

    -- * Response Lenses
    getUserSettingsResponse_userSettings,
    getUserSettingsResponse_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.WorkSpacesWeb.Types

-- | /See:/ 'newGetUserSettings' smart constructor.
data GetUserSettings = GetUserSettings'
  { -- | The ARN of the user settings.
    GetUserSettings -> Text
userSettingsArn :: Prelude.Text
  }
  deriving (GetUserSettings -> GetUserSettings -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetUserSettings -> GetUserSettings -> Bool
$c/= :: GetUserSettings -> GetUserSettings -> Bool
== :: GetUserSettings -> GetUserSettings -> Bool
$c== :: GetUserSettings -> GetUserSettings -> Bool
Prelude.Eq, ReadPrec [GetUserSettings]
ReadPrec GetUserSettings
Int -> ReadS GetUserSettings
ReadS [GetUserSettings]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetUserSettings]
$creadListPrec :: ReadPrec [GetUserSettings]
readPrec :: ReadPrec GetUserSettings
$creadPrec :: ReadPrec GetUserSettings
readList :: ReadS [GetUserSettings]
$creadList :: ReadS [GetUserSettings]
readsPrec :: Int -> ReadS GetUserSettings
$creadsPrec :: Int -> ReadS GetUserSettings
Prelude.Read, Int -> GetUserSettings -> ShowS
[GetUserSettings] -> ShowS
GetUserSettings -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetUserSettings] -> ShowS
$cshowList :: [GetUserSettings] -> ShowS
show :: GetUserSettings -> String
$cshow :: GetUserSettings -> String
showsPrec :: Int -> GetUserSettings -> ShowS
$cshowsPrec :: Int -> GetUserSettings -> ShowS
Prelude.Show, forall x. Rep GetUserSettings x -> GetUserSettings
forall x. GetUserSettings -> Rep GetUserSettings x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetUserSettings x -> GetUserSettings
$cfrom :: forall x. GetUserSettings -> Rep GetUserSettings x
Prelude.Generic)

-- |
-- Create a value of 'GetUserSettings' 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:
--
-- 'userSettingsArn', 'getUserSettings_userSettingsArn' - The ARN of the user settings.
newGetUserSettings ::
  -- | 'userSettingsArn'
  Prelude.Text ->
  GetUserSettings
newGetUserSettings :: Text -> GetUserSettings
newGetUserSettings Text
pUserSettingsArn_ =
  GetUserSettings'
    { $sel:userSettingsArn:GetUserSettings' :: Text
userSettingsArn =
        Text
pUserSettingsArn_
    }

-- | The ARN of the user settings.
getUserSettings_userSettingsArn :: Lens.Lens' GetUserSettings Prelude.Text
getUserSettings_userSettingsArn :: Lens' GetUserSettings Text
getUserSettings_userSettingsArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserSettings' {Text
userSettingsArn :: Text
$sel:userSettingsArn:GetUserSettings' :: GetUserSettings -> Text
userSettingsArn} -> Text
userSettingsArn) (\s :: GetUserSettings
s@GetUserSettings' {} Text
a -> GetUserSettings
s {$sel:userSettingsArn:GetUserSettings' :: Text
userSettingsArn = Text
a} :: GetUserSettings)

instance Core.AWSRequest GetUserSettings where
  type
    AWSResponse GetUserSettings =
      GetUserSettingsResponse
  request :: (Service -> Service) -> GetUserSettings -> Request GetUserSettings
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetUserSettings
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetUserSettings)))
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 UserSettings -> Int -> GetUserSettingsResponse
GetUserSettingsResponse'
            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
"userSettings")
            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 GetUserSettings where
  hashWithSalt :: Int -> GetUserSettings -> Int
hashWithSalt Int
_salt GetUserSettings' {Text
userSettingsArn :: Text
$sel:userSettingsArn:GetUserSettings' :: GetUserSettings -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
userSettingsArn

instance Prelude.NFData GetUserSettings where
  rnf :: GetUserSettings -> ()
rnf GetUserSettings' {Text
userSettingsArn :: Text
$sel:userSettingsArn:GetUserSettings' :: GetUserSettings -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
userSettingsArn

instance Data.ToHeaders GetUserSettings where
  toHeaders :: GetUserSettings -> 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.ToPath GetUserSettings where
  toPath :: GetUserSettings -> ByteString
toPath GetUserSettings' {Text
userSettingsArn :: Text
$sel:userSettingsArn:GetUserSettings' :: GetUserSettings -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/userSettings/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
userSettingsArn]

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

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

-- |
-- Create a value of 'GetUserSettingsResponse' 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:
--
-- 'userSettings', 'getUserSettingsResponse_userSettings' - The user settings.
--
-- 'httpStatus', 'getUserSettingsResponse_httpStatus' - The response's http status code.
newGetUserSettingsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetUserSettingsResponse
newGetUserSettingsResponse :: Int -> GetUserSettingsResponse
newGetUserSettingsResponse Int
pHttpStatus_ =
  GetUserSettingsResponse'
    { $sel:userSettings:GetUserSettingsResponse' :: Maybe UserSettings
userSettings =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetUserSettingsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The user settings.
getUserSettingsResponse_userSettings :: Lens.Lens' GetUserSettingsResponse (Prelude.Maybe UserSettings)
getUserSettingsResponse_userSettings :: Lens' GetUserSettingsResponse (Maybe UserSettings)
getUserSettingsResponse_userSettings = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetUserSettingsResponse' {Maybe UserSettings
userSettings :: Maybe UserSettings
$sel:userSettings:GetUserSettingsResponse' :: GetUserSettingsResponse -> Maybe UserSettings
userSettings} -> Maybe UserSettings
userSettings) (\s :: GetUserSettingsResponse
s@GetUserSettingsResponse' {} Maybe UserSettings
a -> GetUserSettingsResponse
s {$sel:userSettings:GetUserSettingsResponse' :: Maybe UserSettings
userSettings = Maybe UserSettings
a} :: GetUserSettingsResponse)

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

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