{-# 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.IoTSiteWise.CreatePortal
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a portal, which can contain projects and dashboards. IoT
-- SiteWise Monitor uses IAM Identity Center or IAM to authenticate portal
-- users and manage user permissions.
--
-- Before you can sign in to a new portal, you must add at least one
-- identity to that portal. For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/administer-portals.html#portal-change-admins Adding or removing portal administrators>
-- in the /IoT SiteWise User Guide/.
module Amazonka.IoTSiteWise.CreatePortal
  ( -- * Creating a Request
    CreatePortal (..),
    newCreatePortal,

    -- * Request Lenses
    createPortal_alarms,
    createPortal_clientToken,
    createPortal_notificationSenderEmail,
    createPortal_portalAuthMode,
    createPortal_portalDescription,
    createPortal_portalLogoImageFile,
    createPortal_tags,
    createPortal_portalName,
    createPortal_portalContactEmail,
    createPortal_roleArn,

    -- * Destructuring the Response
    CreatePortalResponse (..),
    newCreatePortalResponse,

    -- * Response Lenses
    createPortalResponse_httpStatus,
    createPortalResponse_portalId,
    createPortalResponse_portalArn,
    createPortalResponse_portalStartUrl,
    createPortalResponse_portalStatus,
    createPortalResponse_ssoApplicationId,
  )
where

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

-- | /See:/ 'newCreatePortal' smart constructor.
data CreatePortal = CreatePortal'
  { -- | Contains the configuration information of an alarm created in an IoT
    -- SiteWise Monitor portal. You can use the alarm to monitor an asset
    -- property and get notified when the asset property value is outside a
    -- specified range. For more information, see
    -- <https://docs.aws.amazon.com/iot-sitewise/latest/appguide/monitor-alarms.html Monitoring with alarms>
    -- in the /IoT SiteWise Application Guide/.
    CreatePortal -> Maybe Alarms
alarms :: Prelude.Maybe Alarms,
    -- | A unique case-sensitive identifier that you can provide to ensure the
    -- idempotency of the request. Don\'t reuse this client token if a new
    -- idempotent request is required.
    CreatePortal -> Maybe Text
clientToken :: Prelude.Maybe Prelude.Text,
    -- | The email address that sends alarm notifications.
    --
    -- If you use the
    -- <https://docs.aws.amazon.com/iotevents/latest/developerguide/lambda-support.html IoT Events managed Lambda function>
    -- to manage your emails, you must
    -- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/verify-email-addresses.html verify the sender email address in Amazon SES>.
    CreatePortal -> Maybe Text
notificationSenderEmail :: Prelude.Maybe Prelude.Text,
    -- | The service to use to authenticate users to the portal. Choose from the
    -- following options:
    --
    -- -   @SSO@ – The portal uses IAM Identity Center (successor to Single
    --     Sign-On) to authenticate users and manage user permissions. Before
    --     you can create a portal that uses IAM Identity Center, you must
    --     enable IAM Identity Center. For more information, see
    --     <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/monitor-get-started.html#mon-gs-sso Enabling IAM Identity Center>
    --     in the /IoT SiteWise User Guide/. This option is only available in
    --     Amazon Web Services Regions other than the China Regions.
    --
    -- -   @IAM@ – The portal uses Identity and Access Management to
    --     authenticate users and manage user permissions.
    --
    -- You can\'t change this value after you create a portal.
    --
    -- Default: @SSO@
    CreatePortal -> Maybe AuthMode
portalAuthMode :: Prelude.Maybe AuthMode,
    -- | A description for the portal.
    CreatePortal -> Maybe Text
portalDescription :: Prelude.Maybe Prelude.Text,
    -- | A logo image to display in the portal. Upload a square, high-resolution
    -- image. The image is displayed on a dark background.
    CreatePortal -> Maybe ImageFile
portalLogoImageFile :: Prelude.Maybe ImageFile,
    -- | A list of key-value pairs that contain metadata for the portal. For more
    -- information, see
    -- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/tag-resources.html Tagging your IoT SiteWise resources>
    -- in the /IoT SiteWise User Guide/.
    CreatePortal -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A friendly name for the portal.
    CreatePortal -> Text
portalName :: Prelude.Text,
    -- | The Amazon Web Services administrator\'s contact email address.
    CreatePortal -> Text
portalContactEmail :: Prelude.Text,
    -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
    -- of a service role that allows the portal\'s users to access your IoT
    -- SiteWise resources on your behalf. For more information, see
    -- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/monitor-service-role.html Using service roles for IoT SiteWise Monitor>
    -- in the /IoT SiteWise User Guide/.
    CreatePortal -> Text
roleArn :: Prelude.Text
  }
  deriving (CreatePortal -> CreatePortal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePortal -> CreatePortal -> Bool
$c/= :: CreatePortal -> CreatePortal -> Bool
== :: CreatePortal -> CreatePortal -> Bool
$c== :: CreatePortal -> CreatePortal -> Bool
Prelude.Eq, ReadPrec [CreatePortal]
ReadPrec CreatePortal
Int -> ReadS CreatePortal
ReadS [CreatePortal]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePortal]
$creadListPrec :: ReadPrec [CreatePortal]
readPrec :: ReadPrec CreatePortal
$creadPrec :: ReadPrec CreatePortal
readList :: ReadS [CreatePortal]
$creadList :: ReadS [CreatePortal]
readsPrec :: Int -> ReadS CreatePortal
$creadsPrec :: Int -> ReadS CreatePortal
Prelude.Read, Int -> CreatePortal -> ShowS
[CreatePortal] -> ShowS
CreatePortal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePortal] -> ShowS
$cshowList :: [CreatePortal] -> ShowS
show :: CreatePortal -> String
$cshow :: CreatePortal -> String
showsPrec :: Int -> CreatePortal -> ShowS
$cshowsPrec :: Int -> CreatePortal -> ShowS
Prelude.Show, forall x. Rep CreatePortal x -> CreatePortal
forall x. CreatePortal -> Rep CreatePortal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePortal x -> CreatePortal
$cfrom :: forall x. CreatePortal -> Rep CreatePortal x
Prelude.Generic)

-- |
-- Create a value of 'CreatePortal' 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:
--
-- 'alarms', 'createPortal_alarms' - Contains the configuration information of an alarm created in an IoT
-- SiteWise Monitor portal. You can use the alarm to monitor an asset
-- property and get notified when the asset property value is outside a
-- specified range. For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/appguide/monitor-alarms.html Monitoring with alarms>
-- in the /IoT SiteWise Application Guide/.
--
-- 'clientToken', 'createPortal_clientToken' - A unique case-sensitive identifier that you can provide to ensure the
-- idempotency of the request. Don\'t reuse this client token if a new
-- idempotent request is required.
--
-- 'notificationSenderEmail', 'createPortal_notificationSenderEmail' - The email address that sends alarm notifications.
--
-- If you use the
-- <https://docs.aws.amazon.com/iotevents/latest/developerguide/lambda-support.html IoT Events managed Lambda function>
-- to manage your emails, you must
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/verify-email-addresses.html verify the sender email address in Amazon SES>.
--
-- 'portalAuthMode', 'createPortal_portalAuthMode' - The service to use to authenticate users to the portal. Choose from the
-- following options:
--
-- -   @SSO@ – The portal uses IAM Identity Center (successor to Single
--     Sign-On) to authenticate users and manage user permissions. Before
--     you can create a portal that uses IAM Identity Center, you must
--     enable IAM Identity Center. For more information, see
--     <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/monitor-get-started.html#mon-gs-sso Enabling IAM Identity Center>
--     in the /IoT SiteWise User Guide/. This option is only available in
--     Amazon Web Services Regions other than the China Regions.
--
-- -   @IAM@ – The portal uses Identity and Access Management to
--     authenticate users and manage user permissions.
--
-- You can\'t change this value after you create a portal.
--
-- Default: @SSO@
--
-- 'portalDescription', 'createPortal_portalDescription' - A description for the portal.
--
-- 'portalLogoImageFile', 'createPortal_portalLogoImageFile' - A logo image to display in the portal. Upload a square, high-resolution
-- image. The image is displayed on a dark background.
--
-- 'tags', 'createPortal_tags' - A list of key-value pairs that contain metadata for the portal. For more
-- information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/tag-resources.html Tagging your IoT SiteWise resources>
-- in the /IoT SiteWise User Guide/.
--
-- 'portalName', 'createPortal_portalName' - A friendly name for the portal.
--
-- 'portalContactEmail', 'createPortal_portalContactEmail' - The Amazon Web Services administrator\'s contact email address.
--
-- 'roleArn', 'createPortal_roleArn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of a service role that allows the portal\'s users to access your IoT
-- SiteWise resources on your behalf. For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/monitor-service-role.html Using service roles for IoT SiteWise Monitor>
-- in the /IoT SiteWise User Guide/.
newCreatePortal ::
  -- | 'portalName'
  Prelude.Text ->
  -- | 'portalContactEmail'
  Prelude.Text ->
  -- | 'roleArn'
  Prelude.Text ->
  CreatePortal
newCreatePortal :: Text -> Text -> Text -> CreatePortal
newCreatePortal
  Text
pPortalName_
  Text
pPortalContactEmail_
  Text
pRoleArn_ =
    CreatePortal'
      { $sel:alarms:CreatePortal' :: Maybe Alarms
alarms = forall a. Maybe a
Prelude.Nothing,
        $sel:clientToken:CreatePortal' :: Maybe Text
clientToken = forall a. Maybe a
Prelude.Nothing,
        $sel:notificationSenderEmail:CreatePortal' :: Maybe Text
notificationSenderEmail = forall a. Maybe a
Prelude.Nothing,
        $sel:portalAuthMode:CreatePortal' :: Maybe AuthMode
portalAuthMode = forall a. Maybe a
Prelude.Nothing,
        $sel:portalDescription:CreatePortal' :: Maybe Text
portalDescription = forall a. Maybe a
Prelude.Nothing,
        $sel:portalLogoImageFile:CreatePortal' :: Maybe ImageFile
portalLogoImageFile = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:CreatePortal' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:portalName:CreatePortal' :: Text
portalName = Text
pPortalName_,
        $sel:portalContactEmail:CreatePortal' :: Text
portalContactEmail = Text
pPortalContactEmail_,
        $sel:roleArn:CreatePortal' :: Text
roleArn = Text
pRoleArn_
      }

-- | Contains the configuration information of an alarm created in an IoT
-- SiteWise Monitor portal. You can use the alarm to monitor an asset
-- property and get notified when the asset property value is outside a
-- specified range. For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/appguide/monitor-alarms.html Monitoring with alarms>
-- in the /IoT SiteWise Application Guide/.
createPortal_alarms :: Lens.Lens' CreatePortal (Prelude.Maybe Alarms)
createPortal_alarms :: Lens' CreatePortal (Maybe Alarms)
createPortal_alarms = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortal' {Maybe Alarms
alarms :: Maybe Alarms
$sel:alarms:CreatePortal' :: CreatePortal -> Maybe Alarms
alarms} -> Maybe Alarms
alarms) (\s :: CreatePortal
s@CreatePortal' {} Maybe Alarms
a -> CreatePortal
s {$sel:alarms:CreatePortal' :: Maybe Alarms
alarms = Maybe Alarms
a} :: CreatePortal)

-- | A unique case-sensitive identifier that you can provide to ensure the
-- idempotency of the request. Don\'t reuse this client token if a new
-- idempotent request is required.
createPortal_clientToken :: Lens.Lens' CreatePortal (Prelude.Maybe Prelude.Text)
createPortal_clientToken :: Lens' CreatePortal (Maybe Text)
createPortal_clientToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortal' {Maybe Text
clientToken :: Maybe Text
$sel:clientToken:CreatePortal' :: CreatePortal -> Maybe Text
clientToken} -> Maybe Text
clientToken) (\s :: CreatePortal
s@CreatePortal' {} Maybe Text
a -> CreatePortal
s {$sel:clientToken:CreatePortal' :: Maybe Text
clientToken = Maybe Text
a} :: CreatePortal)

-- | The email address that sends alarm notifications.
--
-- If you use the
-- <https://docs.aws.amazon.com/iotevents/latest/developerguide/lambda-support.html IoT Events managed Lambda function>
-- to manage your emails, you must
-- <https://docs.aws.amazon.com/ses/latest/DeveloperGuide/verify-email-addresses.html verify the sender email address in Amazon SES>.
createPortal_notificationSenderEmail :: Lens.Lens' CreatePortal (Prelude.Maybe Prelude.Text)
createPortal_notificationSenderEmail :: Lens' CreatePortal (Maybe Text)
createPortal_notificationSenderEmail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortal' {Maybe Text
notificationSenderEmail :: Maybe Text
$sel:notificationSenderEmail:CreatePortal' :: CreatePortal -> Maybe Text
notificationSenderEmail} -> Maybe Text
notificationSenderEmail) (\s :: CreatePortal
s@CreatePortal' {} Maybe Text
a -> CreatePortal
s {$sel:notificationSenderEmail:CreatePortal' :: Maybe Text
notificationSenderEmail = Maybe Text
a} :: CreatePortal)

-- | The service to use to authenticate users to the portal. Choose from the
-- following options:
--
-- -   @SSO@ – The portal uses IAM Identity Center (successor to Single
--     Sign-On) to authenticate users and manage user permissions. Before
--     you can create a portal that uses IAM Identity Center, you must
--     enable IAM Identity Center. For more information, see
--     <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/monitor-get-started.html#mon-gs-sso Enabling IAM Identity Center>
--     in the /IoT SiteWise User Guide/. This option is only available in
--     Amazon Web Services Regions other than the China Regions.
--
-- -   @IAM@ – The portal uses Identity and Access Management to
--     authenticate users and manage user permissions.
--
-- You can\'t change this value after you create a portal.
--
-- Default: @SSO@
createPortal_portalAuthMode :: Lens.Lens' CreatePortal (Prelude.Maybe AuthMode)
createPortal_portalAuthMode :: Lens' CreatePortal (Maybe AuthMode)
createPortal_portalAuthMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortal' {Maybe AuthMode
portalAuthMode :: Maybe AuthMode
$sel:portalAuthMode:CreatePortal' :: CreatePortal -> Maybe AuthMode
portalAuthMode} -> Maybe AuthMode
portalAuthMode) (\s :: CreatePortal
s@CreatePortal' {} Maybe AuthMode
a -> CreatePortal
s {$sel:portalAuthMode:CreatePortal' :: Maybe AuthMode
portalAuthMode = Maybe AuthMode
a} :: CreatePortal)

-- | A description for the portal.
createPortal_portalDescription :: Lens.Lens' CreatePortal (Prelude.Maybe Prelude.Text)
createPortal_portalDescription :: Lens' CreatePortal (Maybe Text)
createPortal_portalDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortal' {Maybe Text
portalDescription :: Maybe Text
$sel:portalDescription:CreatePortal' :: CreatePortal -> Maybe Text
portalDescription} -> Maybe Text
portalDescription) (\s :: CreatePortal
s@CreatePortal' {} Maybe Text
a -> CreatePortal
s {$sel:portalDescription:CreatePortal' :: Maybe Text
portalDescription = Maybe Text
a} :: CreatePortal)

-- | A logo image to display in the portal. Upload a square, high-resolution
-- image. The image is displayed on a dark background.
createPortal_portalLogoImageFile :: Lens.Lens' CreatePortal (Prelude.Maybe ImageFile)
createPortal_portalLogoImageFile :: Lens' CreatePortal (Maybe ImageFile)
createPortal_portalLogoImageFile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortal' {Maybe ImageFile
portalLogoImageFile :: Maybe ImageFile
$sel:portalLogoImageFile:CreatePortal' :: CreatePortal -> Maybe ImageFile
portalLogoImageFile} -> Maybe ImageFile
portalLogoImageFile) (\s :: CreatePortal
s@CreatePortal' {} Maybe ImageFile
a -> CreatePortal
s {$sel:portalLogoImageFile:CreatePortal' :: Maybe ImageFile
portalLogoImageFile = Maybe ImageFile
a} :: CreatePortal)

-- | A list of key-value pairs that contain metadata for the portal. For more
-- information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/tag-resources.html Tagging your IoT SiteWise resources>
-- in the /IoT SiteWise User Guide/.
createPortal_tags :: Lens.Lens' CreatePortal (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createPortal_tags :: Lens' CreatePortal (Maybe (HashMap Text Text))
createPortal_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortal' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreatePortal' :: CreatePortal -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreatePortal
s@CreatePortal' {} Maybe (HashMap Text Text)
a -> CreatePortal
s {$sel:tags:CreatePortal' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreatePortal) 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

-- | A friendly name for the portal.
createPortal_portalName :: Lens.Lens' CreatePortal Prelude.Text
createPortal_portalName :: Lens' CreatePortal Text
createPortal_portalName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortal' {Text
portalName :: Text
$sel:portalName:CreatePortal' :: CreatePortal -> Text
portalName} -> Text
portalName) (\s :: CreatePortal
s@CreatePortal' {} Text
a -> CreatePortal
s {$sel:portalName:CreatePortal' :: Text
portalName = Text
a} :: CreatePortal)

-- | The Amazon Web Services administrator\'s contact email address.
createPortal_portalContactEmail :: Lens.Lens' CreatePortal Prelude.Text
createPortal_portalContactEmail :: Lens' CreatePortal Text
createPortal_portalContactEmail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortal' {Text
portalContactEmail :: Text
$sel:portalContactEmail:CreatePortal' :: CreatePortal -> Text
portalContactEmail} -> Text
portalContactEmail) (\s :: CreatePortal
s@CreatePortal' {} Text
a -> CreatePortal
s {$sel:portalContactEmail:CreatePortal' :: Text
portalContactEmail = Text
a} :: CreatePortal)

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of a service role that allows the portal\'s users to access your IoT
-- SiteWise resources on your behalf. For more information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/monitor-service-role.html Using service roles for IoT SiteWise Monitor>
-- in the /IoT SiteWise User Guide/.
createPortal_roleArn :: Lens.Lens' CreatePortal Prelude.Text
createPortal_roleArn :: Lens' CreatePortal Text
createPortal_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortal' {Text
roleArn :: Text
$sel:roleArn:CreatePortal' :: CreatePortal -> Text
roleArn} -> Text
roleArn) (\s :: CreatePortal
s@CreatePortal' {} Text
a -> CreatePortal
s {$sel:roleArn:CreatePortal' :: Text
roleArn = Text
a} :: CreatePortal)

instance Core.AWSRequest CreatePortal where
  type AWSResponse CreatePortal = CreatePortalResponse
  request :: (Service -> Service) -> CreatePortal -> Request CreatePortal
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 CreatePortal
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreatePortal)))
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
-> Text
-> Text
-> Text
-> PortalStatus
-> Text
-> CreatePortalResponse
CreatePortalResponse'
            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
"portalId")
            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
"portalArn")
            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
"portalStartUrl")
            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
"portalStatus")
            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
"ssoApplicationId")
      )

instance Prelude.Hashable CreatePortal where
  hashWithSalt :: Int -> CreatePortal -> Int
hashWithSalt Int
_salt CreatePortal' {Maybe Text
Maybe (HashMap Text Text)
Maybe Alarms
Maybe AuthMode
Maybe ImageFile
Text
roleArn :: Text
portalContactEmail :: Text
portalName :: Text
tags :: Maybe (HashMap Text Text)
portalLogoImageFile :: Maybe ImageFile
portalDescription :: Maybe Text
portalAuthMode :: Maybe AuthMode
notificationSenderEmail :: Maybe Text
clientToken :: Maybe Text
alarms :: Maybe Alarms
$sel:roleArn:CreatePortal' :: CreatePortal -> Text
$sel:portalContactEmail:CreatePortal' :: CreatePortal -> Text
$sel:portalName:CreatePortal' :: CreatePortal -> Text
$sel:tags:CreatePortal' :: CreatePortal -> Maybe (HashMap Text Text)
$sel:portalLogoImageFile:CreatePortal' :: CreatePortal -> Maybe ImageFile
$sel:portalDescription:CreatePortal' :: CreatePortal -> Maybe Text
$sel:portalAuthMode:CreatePortal' :: CreatePortal -> Maybe AuthMode
$sel:notificationSenderEmail:CreatePortal' :: CreatePortal -> Maybe Text
$sel:clientToken:CreatePortal' :: CreatePortal -> Maybe Text
$sel:alarms:CreatePortal' :: CreatePortal -> Maybe Alarms
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Alarms
alarms
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
clientToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
notificationSenderEmail
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe AuthMode
portalAuthMode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
portalDescription
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ImageFile
portalLogoImageFile
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
portalName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
portalContactEmail
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
roleArn

instance Prelude.NFData CreatePortal where
  rnf :: CreatePortal -> ()
rnf CreatePortal' {Maybe Text
Maybe (HashMap Text Text)
Maybe Alarms
Maybe AuthMode
Maybe ImageFile
Text
roleArn :: Text
portalContactEmail :: Text
portalName :: Text
tags :: Maybe (HashMap Text Text)
portalLogoImageFile :: Maybe ImageFile
portalDescription :: Maybe Text
portalAuthMode :: Maybe AuthMode
notificationSenderEmail :: Maybe Text
clientToken :: Maybe Text
alarms :: Maybe Alarms
$sel:roleArn:CreatePortal' :: CreatePortal -> Text
$sel:portalContactEmail:CreatePortal' :: CreatePortal -> Text
$sel:portalName:CreatePortal' :: CreatePortal -> Text
$sel:tags:CreatePortal' :: CreatePortal -> Maybe (HashMap Text Text)
$sel:portalLogoImageFile:CreatePortal' :: CreatePortal -> Maybe ImageFile
$sel:portalDescription:CreatePortal' :: CreatePortal -> Maybe Text
$sel:portalAuthMode:CreatePortal' :: CreatePortal -> Maybe AuthMode
$sel:notificationSenderEmail:CreatePortal' :: CreatePortal -> Maybe Text
$sel:clientToken:CreatePortal' :: CreatePortal -> Maybe Text
$sel:alarms:CreatePortal' :: CreatePortal -> Maybe Alarms
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Alarms
alarms
      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 Maybe Text
notificationSenderEmail
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe AuthMode
portalAuthMode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
portalDescription
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ImageFile
portalLogoImageFile
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
portalName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
portalContactEmail
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
roleArn

instance Data.ToHeaders CreatePortal where
  toHeaders :: CreatePortal -> 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 CreatePortal where
  toJSON :: CreatePortal -> Value
toJSON CreatePortal' {Maybe Text
Maybe (HashMap Text Text)
Maybe Alarms
Maybe AuthMode
Maybe ImageFile
Text
roleArn :: Text
portalContactEmail :: Text
portalName :: Text
tags :: Maybe (HashMap Text Text)
portalLogoImageFile :: Maybe ImageFile
portalDescription :: Maybe Text
portalAuthMode :: Maybe AuthMode
notificationSenderEmail :: Maybe Text
clientToken :: Maybe Text
alarms :: Maybe Alarms
$sel:roleArn:CreatePortal' :: CreatePortal -> Text
$sel:portalContactEmail:CreatePortal' :: CreatePortal -> Text
$sel:portalName:CreatePortal' :: CreatePortal -> Text
$sel:tags:CreatePortal' :: CreatePortal -> Maybe (HashMap Text Text)
$sel:portalLogoImageFile:CreatePortal' :: CreatePortal -> Maybe ImageFile
$sel:portalDescription:CreatePortal' :: CreatePortal -> Maybe Text
$sel:portalAuthMode:CreatePortal' :: CreatePortal -> Maybe AuthMode
$sel:notificationSenderEmail:CreatePortal' :: CreatePortal -> Maybe Text
$sel:clientToken:CreatePortal' :: CreatePortal -> Maybe Text
$sel:alarms:CreatePortal' :: CreatePortal -> Maybe Alarms
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"alarms" 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 Alarms
alarms,
            (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,
            (Key
"notificationSenderEmail" 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
notificationSenderEmail,
            (Key
"portalAuthMode" 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 AuthMode
portalAuthMode,
            (Key
"portalDescription" 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
portalDescription,
            (Key
"portalLogoImageFile" 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 ImageFile
portalLogoImageFile,
            (Key
"tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just (Key
"portalName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
portalName),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"portalContactEmail" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
portalContactEmail),
            forall a. a -> Maybe a
Prelude.Just (Key
"roleArn" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
roleArn)
          ]
      )

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

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

-- | /See:/ 'newCreatePortalResponse' smart constructor.
data CreatePortalResponse = CreatePortalResponse'
  { -- | The response's http status code.
    CreatePortalResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ID of the created portal.
    CreatePortalResponse -> Text
portalId :: Prelude.Text,
    -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
    -- of the portal, which has the following format.
    --
    -- @arn:${Partition}:iotsitewise:${Region}:${Account}:portal\/${PortalId}@
    CreatePortalResponse -> Text
portalArn :: Prelude.Text,
    -- | The URL for the IoT SiteWise Monitor portal. You can use this URL to
    -- access portals that use IAM Identity Center for authentication. For
    -- portals that use IAM for authentication, you must use the IoT SiteWise
    -- console to get a URL that you can use to access the portal.
    CreatePortalResponse -> Text
portalStartUrl :: Prelude.Text,
    -- | The status of the portal, which contains a state (@CREATING@ after
    -- successfully calling this operation) and any error message.
    CreatePortalResponse -> PortalStatus
portalStatus :: PortalStatus,
    -- | The associated IAM Identity Center application ID, if the portal uses
    -- IAM Identity Center.
    CreatePortalResponse -> Text
ssoApplicationId :: Prelude.Text
  }
  deriving (CreatePortalResponse -> CreatePortalResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePortalResponse -> CreatePortalResponse -> Bool
$c/= :: CreatePortalResponse -> CreatePortalResponse -> Bool
== :: CreatePortalResponse -> CreatePortalResponse -> Bool
$c== :: CreatePortalResponse -> CreatePortalResponse -> Bool
Prelude.Eq, ReadPrec [CreatePortalResponse]
ReadPrec CreatePortalResponse
Int -> ReadS CreatePortalResponse
ReadS [CreatePortalResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePortalResponse]
$creadListPrec :: ReadPrec [CreatePortalResponse]
readPrec :: ReadPrec CreatePortalResponse
$creadPrec :: ReadPrec CreatePortalResponse
readList :: ReadS [CreatePortalResponse]
$creadList :: ReadS [CreatePortalResponse]
readsPrec :: Int -> ReadS CreatePortalResponse
$creadsPrec :: Int -> ReadS CreatePortalResponse
Prelude.Read, Int -> CreatePortalResponse -> ShowS
[CreatePortalResponse] -> ShowS
CreatePortalResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePortalResponse] -> ShowS
$cshowList :: [CreatePortalResponse] -> ShowS
show :: CreatePortalResponse -> String
$cshow :: CreatePortalResponse -> String
showsPrec :: Int -> CreatePortalResponse -> ShowS
$cshowsPrec :: Int -> CreatePortalResponse -> ShowS
Prelude.Show, forall x. Rep CreatePortalResponse x -> CreatePortalResponse
forall x. CreatePortalResponse -> Rep CreatePortalResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePortalResponse x -> CreatePortalResponse
$cfrom :: forall x. CreatePortalResponse -> Rep CreatePortalResponse x
Prelude.Generic)

-- |
-- Create a value of 'CreatePortalResponse' 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', 'createPortalResponse_httpStatus' - The response's http status code.
--
-- 'portalId', 'createPortalResponse_portalId' - The ID of the created portal.
--
-- 'portalArn', 'createPortalResponse_portalArn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the portal, which has the following format.
--
-- @arn:${Partition}:iotsitewise:${Region}:${Account}:portal\/${PortalId}@
--
-- 'portalStartUrl', 'createPortalResponse_portalStartUrl' - The URL for the IoT SiteWise Monitor portal. You can use this URL to
-- access portals that use IAM Identity Center for authentication. For
-- portals that use IAM for authentication, you must use the IoT SiteWise
-- console to get a URL that you can use to access the portal.
--
-- 'portalStatus', 'createPortalResponse_portalStatus' - The status of the portal, which contains a state (@CREATING@ after
-- successfully calling this operation) and any error message.
--
-- 'ssoApplicationId', 'createPortalResponse_ssoApplicationId' - The associated IAM Identity Center application ID, if the portal uses
-- IAM Identity Center.
newCreatePortalResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'portalId'
  Prelude.Text ->
  -- | 'portalArn'
  Prelude.Text ->
  -- | 'portalStartUrl'
  Prelude.Text ->
  -- | 'portalStatus'
  PortalStatus ->
  -- | 'ssoApplicationId'
  Prelude.Text ->
  CreatePortalResponse
newCreatePortalResponse :: Int
-> Text
-> Text
-> Text
-> PortalStatus
-> Text
-> CreatePortalResponse
newCreatePortalResponse
  Int
pHttpStatus_
  Text
pPortalId_
  Text
pPortalArn_
  Text
pPortalStartUrl_
  PortalStatus
pPortalStatus_
  Text
pSsoApplicationId_ =
    CreatePortalResponse'
      { $sel:httpStatus:CreatePortalResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:portalId:CreatePortalResponse' :: Text
portalId = Text
pPortalId_,
        $sel:portalArn:CreatePortalResponse' :: Text
portalArn = Text
pPortalArn_,
        $sel:portalStartUrl:CreatePortalResponse' :: Text
portalStartUrl = Text
pPortalStartUrl_,
        $sel:portalStatus:CreatePortalResponse' :: PortalStatus
portalStatus = PortalStatus
pPortalStatus_,
        $sel:ssoApplicationId:CreatePortalResponse' :: Text
ssoApplicationId = Text
pSsoApplicationId_
      }

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

-- | The ID of the created portal.
createPortalResponse_portalId :: Lens.Lens' CreatePortalResponse Prelude.Text
createPortalResponse_portalId :: Lens' CreatePortalResponse Text
createPortalResponse_portalId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortalResponse' {Text
portalId :: Text
$sel:portalId:CreatePortalResponse' :: CreatePortalResponse -> Text
portalId} -> Text
portalId) (\s :: CreatePortalResponse
s@CreatePortalResponse' {} Text
a -> CreatePortalResponse
s {$sel:portalId:CreatePortalResponse' :: Text
portalId = Text
a} :: CreatePortalResponse)

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the portal, which has the following format.
--
-- @arn:${Partition}:iotsitewise:${Region}:${Account}:portal\/${PortalId}@
createPortalResponse_portalArn :: Lens.Lens' CreatePortalResponse Prelude.Text
createPortalResponse_portalArn :: Lens' CreatePortalResponse Text
createPortalResponse_portalArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortalResponse' {Text
portalArn :: Text
$sel:portalArn:CreatePortalResponse' :: CreatePortalResponse -> Text
portalArn} -> Text
portalArn) (\s :: CreatePortalResponse
s@CreatePortalResponse' {} Text
a -> CreatePortalResponse
s {$sel:portalArn:CreatePortalResponse' :: Text
portalArn = Text
a} :: CreatePortalResponse)

-- | The URL for the IoT SiteWise Monitor portal. You can use this URL to
-- access portals that use IAM Identity Center for authentication. For
-- portals that use IAM for authentication, you must use the IoT SiteWise
-- console to get a URL that you can use to access the portal.
createPortalResponse_portalStartUrl :: Lens.Lens' CreatePortalResponse Prelude.Text
createPortalResponse_portalStartUrl :: Lens' CreatePortalResponse Text
createPortalResponse_portalStartUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortalResponse' {Text
portalStartUrl :: Text
$sel:portalStartUrl:CreatePortalResponse' :: CreatePortalResponse -> Text
portalStartUrl} -> Text
portalStartUrl) (\s :: CreatePortalResponse
s@CreatePortalResponse' {} Text
a -> CreatePortalResponse
s {$sel:portalStartUrl:CreatePortalResponse' :: Text
portalStartUrl = Text
a} :: CreatePortalResponse)

-- | The status of the portal, which contains a state (@CREATING@ after
-- successfully calling this operation) and any error message.
createPortalResponse_portalStatus :: Lens.Lens' CreatePortalResponse PortalStatus
createPortalResponse_portalStatus :: Lens' CreatePortalResponse PortalStatus
createPortalResponse_portalStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortalResponse' {PortalStatus
portalStatus :: PortalStatus
$sel:portalStatus:CreatePortalResponse' :: CreatePortalResponse -> PortalStatus
portalStatus} -> PortalStatus
portalStatus) (\s :: CreatePortalResponse
s@CreatePortalResponse' {} PortalStatus
a -> CreatePortalResponse
s {$sel:portalStatus:CreatePortalResponse' :: PortalStatus
portalStatus = PortalStatus
a} :: CreatePortalResponse)

-- | The associated IAM Identity Center application ID, if the portal uses
-- IAM Identity Center.
createPortalResponse_ssoApplicationId :: Lens.Lens' CreatePortalResponse Prelude.Text
createPortalResponse_ssoApplicationId :: Lens' CreatePortalResponse Text
createPortalResponse_ssoApplicationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePortalResponse' {Text
ssoApplicationId :: Text
$sel:ssoApplicationId:CreatePortalResponse' :: CreatePortalResponse -> Text
ssoApplicationId} -> Text
ssoApplicationId) (\s :: CreatePortalResponse
s@CreatePortalResponse' {} Text
a -> CreatePortalResponse
s {$sel:ssoApplicationId:CreatePortalResponse' :: Text
ssoApplicationId = Text
a} :: CreatePortalResponse)

instance Prelude.NFData CreatePortalResponse where
  rnf :: CreatePortalResponse -> ()
rnf CreatePortalResponse' {Int
Text
PortalStatus
ssoApplicationId :: Text
portalStatus :: PortalStatus
portalStartUrl :: Text
portalArn :: Text
portalId :: Text
httpStatus :: Int
$sel:ssoApplicationId:CreatePortalResponse' :: CreatePortalResponse -> Text
$sel:portalStatus:CreatePortalResponse' :: CreatePortalResponse -> PortalStatus
$sel:portalStartUrl:CreatePortalResponse' :: CreatePortalResponse -> Text
$sel:portalArn:CreatePortalResponse' :: CreatePortalResponse -> Text
$sel:portalId:CreatePortalResponse' :: CreatePortalResponse -> Text
$sel:httpStatus:CreatePortalResponse' :: CreatePortalResponse -> 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 Text
portalId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
portalArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
portalStartUrl
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf PortalStatus
portalStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
ssoApplicationId