{-# 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.UpdatePortal
-- 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 a web portal.
module Amazonka.WorkSpacesWeb.UpdatePortal
  ( -- * Creating a Request
    UpdatePortal (..),
    newUpdatePortal,

    -- * Request Lenses
    updatePortal_displayName,
    updatePortal_portalArn,

    -- * Destructuring the Response
    UpdatePortalResponse (..),
    newUpdatePortalResponse,

    -- * Response Lenses
    updatePortalResponse_portal,
    updatePortalResponse_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:/ 'newUpdatePortal' smart constructor.
data UpdatePortal = UpdatePortal'
  { -- | The name of the web portal. This is not visible to users who log into
    -- the web portal.
    UpdatePortal -> Maybe (Sensitive Text)
displayName :: Prelude.Maybe (Data.Sensitive Prelude.Text),
    -- | The ARN of the web portal.
    UpdatePortal -> Text
portalArn :: Prelude.Text
  }
  deriving (UpdatePortal -> UpdatePortal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdatePortal -> UpdatePortal -> Bool
$c/= :: UpdatePortal -> UpdatePortal -> Bool
== :: UpdatePortal -> UpdatePortal -> Bool
$c== :: UpdatePortal -> UpdatePortal -> Bool
Prelude.Eq, Int -> UpdatePortal -> ShowS
[UpdatePortal] -> ShowS
UpdatePortal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdatePortal] -> ShowS
$cshowList :: [UpdatePortal] -> ShowS
show :: UpdatePortal -> String
$cshow :: UpdatePortal -> String
showsPrec :: Int -> UpdatePortal -> ShowS
$cshowsPrec :: Int -> UpdatePortal -> ShowS
Prelude.Show, forall x. Rep UpdatePortal x -> UpdatePortal
forall x. UpdatePortal -> Rep UpdatePortal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdatePortal x -> UpdatePortal
$cfrom :: forall x. UpdatePortal -> Rep UpdatePortal x
Prelude.Generic)

-- |
-- Create a value of 'UpdatePortal' 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:
--
-- 'displayName', 'updatePortal_displayName' - The name of the web portal. This is not visible to users who log into
-- the web portal.
--
-- 'portalArn', 'updatePortal_portalArn' - The ARN of the web portal.
newUpdatePortal ::
  -- | 'portalArn'
  Prelude.Text ->
  UpdatePortal
newUpdatePortal :: Text -> UpdatePortal
newUpdatePortal Text
pPortalArn_ =
  UpdatePortal'
    { $sel:displayName:UpdatePortal' :: Maybe (Sensitive Text)
displayName = forall a. Maybe a
Prelude.Nothing,
      $sel:portalArn:UpdatePortal' :: Text
portalArn = Text
pPortalArn_
    }

-- | The name of the web portal. This is not visible to users who log into
-- the web portal.
updatePortal_displayName :: Lens.Lens' UpdatePortal (Prelude.Maybe Prelude.Text)
updatePortal_displayName :: Lens' UpdatePortal (Maybe Text)
updatePortal_displayName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortal' {Maybe (Sensitive Text)
displayName :: Maybe (Sensitive Text)
$sel:displayName:UpdatePortal' :: UpdatePortal -> Maybe (Sensitive Text)
displayName} -> Maybe (Sensitive Text)
displayName) (\s :: UpdatePortal
s@UpdatePortal' {} Maybe (Sensitive Text)
a -> UpdatePortal
s {$sel:displayName:UpdatePortal' :: Maybe (Sensitive Text)
displayName = Maybe (Sensitive Text)
a} :: UpdatePortal) 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

-- | The ARN of the web portal.
updatePortal_portalArn :: Lens.Lens' UpdatePortal Prelude.Text
updatePortal_portalArn :: Lens' UpdatePortal Text
updatePortal_portalArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortal' {Text
portalArn :: Text
$sel:portalArn:UpdatePortal' :: UpdatePortal -> Text
portalArn} -> Text
portalArn) (\s :: UpdatePortal
s@UpdatePortal' {} Text
a -> UpdatePortal
s {$sel:portalArn:UpdatePortal' :: Text
portalArn = Text
a} :: UpdatePortal)

instance Core.AWSRequest UpdatePortal where
  type AWSResponse UpdatePortal = UpdatePortalResponse
  request :: (Service -> Service) -> UpdatePortal -> Request UpdatePortal
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdatePortal
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdatePortal)))
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 Portal -> Int -> UpdatePortalResponse
UpdatePortalResponse'
            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
"portal")
            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 UpdatePortal where
  hashWithSalt :: Int -> UpdatePortal -> Int
hashWithSalt Int
_salt UpdatePortal' {Maybe (Sensitive Text)
Text
portalArn :: Text
displayName :: Maybe (Sensitive Text)
$sel:portalArn:UpdatePortal' :: UpdatePortal -> Text
$sel:displayName:UpdatePortal' :: UpdatePortal -> Maybe (Sensitive Text)
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (Sensitive Text)
displayName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
portalArn

instance Prelude.NFData UpdatePortal where
  rnf :: UpdatePortal -> ()
rnf UpdatePortal' {Maybe (Sensitive Text)
Text
portalArn :: Text
displayName :: Maybe (Sensitive Text)
$sel:portalArn:UpdatePortal' :: UpdatePortal -> Text
$sel:displayName:UpdatePortal' :: UpdatePortal -> Maybe (Sensitive Text)
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe (Sensitive Text)
displayName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
portalArn

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

instance Data.ToPath UpdatePortal where
  toPath :: UpdatePortal -> ByteString
toPath UpdatePortal' {Maybe (Sensitive Text)
Text
portalArn :: Text
displayName :: Maybe (Sensitive Text)
$sel:portalArn:UpdatePortal' :: UpdatePortal -> Text
$sel:displayName:UpdatePortal' :: UpdatePortal -> Maybe (Sensitive Text)
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat [ByteString
"/portals/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
portalArn]

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

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

-- |
-- Create a value of 'UpdatePortalResponse' 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:
--
-- 'portal', 'updatePortalResponse_portal' - The web portal.
--
-- 'httpStatus', 'updatePortalResponse_httpStatus' - The response's http status code.
newUpdatePortalResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  UpdatePortalResponse
newUpdatePortalResponse :: Int -> UpdatePortalResponse
newUpdatePortalResponse Int
pHttpStatus_ =
  UpdatePortalResponse'
    { $sel:portal:UpdatePortalResponse' :: Maybe Portal
portal = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:UpdatePortalResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The web portal.
updatePortalResponse_portal :: Lens.Lens' UpdatePortalResponse (Prelude.Maybe Portal)
updatePortalResponse_portal :: Lens' UpdatePortalResponse (Maybe Portal)
updatePortalResponse_portal = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdatePortalResponse' {Maybe Portal
portal :: Maybe Portal
$sel:portal:UpdatePortalResponse' :: UpdatePortalResponse -> Maybe Portal
portal} -> Maybe Portal
portal) (\s :: UpdatePortalResponse
s@UpdatePortalResponse' {} Maybe Portal
a -> UpdatePortalResponse
s {$sel:portal:UpdatePortalResponse' :: Maybe Portal
portal = Maybe Portal
a} :: UpdatePortalResponse)

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

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