{-# 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.DescribePortal
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves information about a portal.
module Amazonka.IoTSiteWise.DescribePortal
  ( -- * Creating a Request
    DescribePortal (..),
    newDescribePortal,

    -- * Request Lenses
    describePortal_portalId,

    -- * Destructuring the Response
    DescribePortalResponse (..),
    newDescribePortalResponse,

    -- * Response Lenses
    describePortalResponse_alarms,
    describePortalResponse_notificationSenderEmail,
    describePortalResponse_portalAuthMode,
    describePortalResponse_portalDescription,
    describePortalResponse_portalLogoImageLocation,
    describePortalResponse_roleArn,
    describePortalResponse_httpStatus,
    describePortalResponse_portalId,
    describePortalResponse_portalArn,
    describePortalResponse_portalName,
    describePortalResponse_portalClientId,
    describePortalResponse_portalStartUrl,
    describePortalResponse_portalContactEmail,
    describePortalResponse_portalStatus,
    describePortalResponse_portalCreationDate,
    describePortalResponse_portalLastUpdateDate,
  )
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:/ 'newDescribePortal' smart constructor.
data DescribePortal = DescribePortal'
  { -- | The ID of the portal.
    DescribePortal -> Text
portalId :: Prelude.Text
  }
  deriving (DescribePortal -> DescribePortal -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePortal -> DescribePortal -> Bool
$c/= :: DescribePortal -> DescribePortal -> Bool
== :: DescribePortal -> DescribePortal -> Bool
$c== :: DescribePortal -> DescribePortal -> Bool
Prelude.Eq, ReadPrec [DescribePortal]
ReadPrec DescribePortal
Int -> ReadS DescribePortal
ReadS [DescribePortal]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePortal]
$creadListPrec :: ReadPrec [DescribePortal]
readPrec :: ReadPrec DescribePortal
$creadPrec :: ReadPrec DescribePortal
readList :: ReadS [DescribePortal]
$creadList :: ReadS [DescribePortal]
readsPrec :: Int -> ReadS DescribePortal
$creadsPrec :: Int -> ReadS DescribePortal
Prelude.Read, Int -> DescribePortal -> ShowS
[DescribePortal] -> ShowS
DescribePortal -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePortal] -> ShowS
$cshowList :: [DescribePortal] -> ShowS
show :: DescribePortal -> String
$cshow :: DescribePortal -> String
showsPrec :: Int -> DescribePortal -> ShowS
$cshowsPrec :: Int -> DescribePortal -> ShowS
Prelude.Show, forall x. Rep DescribePortal x -> DescribePortal
forall x. DescribePortal -> Rep DescribePortal x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribePortal x -> DescribePortal
$cfrom :: forall x. DescribePortal -> Rep DescribePortal x
Prelude.Generic)

-- |
-- Create a value of 'DescribePortal' 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:
--
-- 'portalId', 'describePortal_portalId' - The ID of the portal.
newDescribePortal ::
  -- | 'portalId'
  Prelude.Text ->
  DescribePortal
newDescribePortal :: Text -> DescribePortal
newDescribePortal Text
pPortalId_ =
  DescribePortal' {$sel:portalId:DescribePortal' :: Text
portalId = Text
pPortalId_}

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

instance Core.AWSRequest DescribePortal where
  type
    AWSResponse DescribePortal =
      DescribePortalResponse
  request :: (Service -> Service) -> DescribePortal -> Request DescribePortal
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 DescribePortal
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse DescribePortal)))
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 Alarms
-> Maybe Text
-> Maybe AuthMode
-> Maybe Text
-> Maybe ImageLocation
-> Maybe Text
-> Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> PortalStatus
-> POSIX
-> POSIX
-> DescribePortalResponse
DescribePortalResponse'
            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
"alarms")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"notificationSenderEmail")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"portalAuthMode")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"portalDescription")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"portalLogoImageLocation")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"roleArn")
            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))
            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
"portalName")
            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
"portalClientId")
            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
"portalContactEmail")
            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
"portalCreationDate")
            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
"portalLastUpdateDate")
      )

instance Prelude.Hashable DescribePortal where
  hashWithSalt :: Int -> DescribePortal -> Int
hashWithSalt Int
_salt DescribePortal' {Text
portalId :: Text
$sel:portalId:DescribePortal' :: DescribePortal -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
portalId

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

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

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

-- | /See:/ 'newDescribePortalResponse' smart constructor.
data DescribePortalResponse = DescribePortalResponse'
  { -- | Contains the configuration information of an alarm created in an IoT
    -- SiteWise Monitor portal.
    DescribePortalResponse -> Maybe Alarms
alarms :: Prelude.Maybe Alarms,
    -- | The email address that sends alarm notifications.
    DescribePortalResponse -> Maybe Text
notificationSenderEmail :: Prelude.Maybe Prelude.Text,
    -- | The service to use to authenticate users to the portal.
    DescribePortalResponse -> Maybe AuthMode
portalAuthMode :: Prelude.Maybe AuthMode,
    -- | The portal\'s description.
    DescribePortalResponse -> Maybe Text
portalDescription :: Prelude.Maybe Prelude.Text,
    -- | The portal\'s logo image, which is available at a URL.
    DescribePortalResponse -> Maybe ImageLocation
portalLogoImageLocation :: Prelude.Maybe ImageLocation,
    -- | The
    -- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
    -- of the 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/.
    DescribePortalResponse -> Maybe Text
roleArn :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    DescribePortalResponse -> Int
httpStatus :: Prelude.Int,
    -- | The ID of the portal.
    DescribePortalResponse -> 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}@
    DescribePortalResponse -> Text
portalArn :: Prelude.Text,
    -- | The name of the portal.
    DescribePortalResponse -> Text
portalName :: Prelude.Text,
    -- | The IAM Identity Center application generated client ID (used with IAM
    -- Identity Center APIs). IoT SiteWise includes @portalClientId@ for only
    -- portals that use IAM Identity Center to authenticate users.
    DescribePortalResponse -> Text
portalClientId :: 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.
    DescribePortalResponse -> Text
portalStartUrl :: Prelude.Text,
    -- | The Amazon Web Services administrator\'s contact email address.
    DescribePortalResponse -> Text
portalContactEmail :: Prelude.Text,
    -- | The current status of the portal, which contains a state and any error
    -- message.
    DescribePortalResponse -> PortalStatus
portalStatus :: PortalStatus,
    -- | The date the portal was created, in Unix epoch time.
    DescribePortalResponse -> POSIX
portalCreationDate :: Data.POSIX,
    -- | The date the portal was last updated, in Unix epoch time.
    DescribePortalResponse -> POSIX
portalLastUpdateDate :: Data.POSIX
  }
  deriving (DescribePortalResponse -> DescribePortalResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribePortalResponse -> DescribePortalResponse -> Bool
$c/= :: DescribePortalResponse -> DescribePortalResponse -> Bool
== :: DescribePortalResponse -> DescribePortalResponse -> Bool
$c== :: DescribePortalResponse -> DescribePortalResponse -> Bool
Prelude.Eq, ReadPrec [DescribePortalResponse]
ReadPrec DescribePortalResponse
Int -> ReadS DescribePortalResponse
ReadS [DescribePortalResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribePortalResponse]
$creadListPrec :: ReadPrec [DescribePortalResponse]
readPrec :: ReadPrec DescribePortalResponse
$creadPrec :: ReadPrec DescribePortalResponse
readList :: ReadS [DescribePortalResponse]
$creadList :: ReadS [DescribePortalResponse]
readsPrec :: Int -> ReadS DescribePortalResponse
$creadsPrec :: Int -> ReadS DescribePortalResponse
Prelude.Read, Int -> DescribePortalResponse -> ShowS
[DescribePortalResponse] -> ShowS
DescribePortalResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribePortalResponse] -> ShowS
$cshowList :: [DescribePortalResponse] -> ShowS
show :: DescribePortalResponse -> String
$cshow :: DescribePortalResponse -> String
showsPrec :: Int -> DescribePortalResponse -> ShowS
$cshowsPrec :: Int -> DescribePortalResponse -> ShowS
Prelude.Show, forall x. Rep DescribePortalResponse x -> DescribePortalResponse
forall x. DescribePortalResponse -> Rep DescribePortalResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep DescribePortalResponse x -> DescribePortalResponse
$cfrom :: forall x. DescribePortalResponse -> Rep DescribePortalResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribePortalResponse' 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', 'describePortalResponse_alarms' - Contains the configuration information of an alarm created in an IoT
-- SiteWise Monitor portal.
--
-- 'notificationSenderEmail', 'describePortalResponse_notificationSenderEmail' - The email address that sends alarm notifications.
--
-- 'portalAuthMode', 'describePortalResponse_portalAuthMode' - The service to use to authenticate users to the portal.
--
-- 'portalDescription', 'describePortalResponse_portalDescription' - The portal\'s description.
--
-- 'portalLogoImageLocation', 'describePortalResponse_portalLogoImageLocation' - The portal\'s logo image, which is available at a URL.
--
-- 'roleArn', 'describePortalResponse_roleArn' - The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the 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/.
--
-- 'httpStatus', 'describePortalResponse_httpStatus' - The response's http status code.
--
-- 'portalId', 'describePortalResponse_portalId' - The ID of the portal.
--
-- 'portalArn', 'describePortalResponse_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}@
--
-- 'portalName', 'describePortalResponse_portalName' - The name of the portal.
--
-- 'portalClientId', 'describePortalResponse_portalClientId' - The IAM Identity Center application generated client ID (used with IAM
-- Identity Center APIs). IoT SiteWise includes @portalClientId@ for only
-- portals that use IAM Identity Center to authenticate users.
--
-- 'portalStartUrl', 'describePortalResponse_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.
--
-- 'portalContactEmail', 'describePortalResponse_portalContactEmail' - The Amazon Web Services administrator\'s contact email address.
--
-- 'portalStatus', 'describePortalResponse_portalStatus' - The current status of the portal, which contains a state and any error
-- message.
--
-- 'portalCreationDate', 'describePortalResponse_portalCreationDate' - The date the portal was created, in Unix epoch time.
--
-- 'portalLastUpdateDate', 'describePortalResponse_portalLastUpdateDate' - The date the portal was last updated, in Unix epoch time.
newDescribePortalResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'portalId'
  Prelude.Text ->
  -- | 'portalArn'
  Prelude.Text ->
  -- | 'portalName'
  Prelude.Text ->
  -- | 'portalClientId'
  Prelude.Text ->
  -- | 'portalStartUrl'
  Prelude.Text ->
  -- | 'portalContactEmail'
  Prelude.Text ->
  -- | 'portalStatus'
  PortalStatus ->
  -- | 'portalCreationDate'
  Prelude.UTCTime ->
  -- | 'portalLastUpdateDate'
  Prelude.UTCTime ->
  DescribePortalResponse
newDescribePortalResponse :: Int
-> Text
-> Text
-> Text
-> Text
-> Text
-> Text
-> PortalStatus
-> UTCTime
-> UTCTime
-> DescribePortalResponse
newDescribePortalResponse
  Int
pHttpStatus_
  Text
pPortalId_
  Text
pPortalArn_
  Text
pPortalName_
  Text
pPortalClientId_
  Text
pPortalStartUrl_
  Text
pPortalContactEmail_
  PortalStatus
pPortalStatus_
  UTCTime
pPortalCreationDate_
  UTCTime
pPortalLastUpdateDate_ =
    DescribePortalResponse'
      { $sel:alarms:DescribePortalResponse' :: Maybe Alarms
alarms = forall a. Maybe a
Prelude.Nothing,
        $sel:notificationSenderEmail:DescribePortalResponse' :: Maybe Text
notificationSenderEmail = forall a. Maybe a
Prelude.Nothing,
        $sel:portalAuthMode:DescribePortalResponse' :: Maybe AuthMode
portalAuthMode = forall a. Maybe a
Prelude.Nothing,
        $sel:portalDescription:DescribePortalResponse' :: Maybe Text
portalDescription = forall a. Maybe a
Prelude.Nothing,
        $sel:portalLogoImageLocation:DescribePortalResponse' :: Maybe ImageLocation
portalLogoImageLocation = forall a. Maybe a
Prelude.Nothing,
        $sel:roleArn:DescribePortalResponse' :: Maybe Text
roleArn = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribePortalResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:portalId:DescribePortalResponse' :: Text
portalId = Text
pPortalId_,
        $sel:portalArn:DescribePortalResponse' :: Text
portalArn = Text
pPortalArn_,
        $sel:portalName:DescribePortalResponse' :: Text
portalName = Text
pPortalName_,
        $sel:portalClientId:DescribePortalResponse' :: Text
portalClientId = Text
pPortalClientId_,
        $sel:portalStartUrl:DescribePortalResponse' :: Text
portalStartUrl = Text
pPortalStartUrl_,
        $sel:portalContactEmail:DescribePortalResponse' :: Text
portalContactEmail = Text
pPortalContactEmail_,
        $sel:portalStatus:DescribePortalResponse' :: PortalStatus
portalStatus = PortalStatus
pPortalStatus_,
        $sel:portalCreationDate:DescribePortalResponse' :: POSIX
portalCreationDate =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pPortalCreationDate_,
        $sel:portalLastUpdateDate:DescribePortalResponse' :: POSIX
portalLastUpdateDate =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pPortalLastUpdateDate_
      }

-- | Contains the configuration information of an alarm created in an IoT
-- SiteWise Monitor portal.
describePortalResponse_alarms :: Lens.Lens' DescribePortalResponse (Prelude.Maybe Alarms)
describePortalResponse_alarms :: Lens' DescribePortalResponse (Maybe Alarms)
describePortalResponse_alarms = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortalResponse' {Maybe Alarms
alarms :: Maybe Alarms
$sel:alarms:DescribePortalResponse' :: DescribePortalResponse -> Maybe Alarms
alarms} -> Maybe Alarms
alarms) (\s :: DescribePortalResponse
s@DescribePortalResponse' {} Maybe Alarms
a -> DescribePortalResponse
s {$sel:alarms:DescribePortalResponse' :: Maybe Alarms
alarms = Maybe Alarms
a} :: DescribePortalResponse)

-- | The email address that sends alarm notifications.
describePortalResponse_notificationSenderEmail :: Lens.Lens' DescribePortalResponse (Prelude.Maybe Prelude.Text)
describePortalResponse_notificationSenderEmail :: Lens' DescribePortalResponse (Maybe Text)
describePortalResponse_notificationSenderEmail = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortalResponse' {Maybe Text
notificationSenderEmail :: Maybe Text
$sel:notificationSenderEmail:DescribePortalResponse' :: DescribePortalResponse -> Maybe Text
notificationSenderEmail} -> Maybe Text
notificationSenderEmail) (\s :: DescribePortalResponse
s@DescribePortalResponse' {} Maybe Text
a -> DescribePortalResponse
s {$sel:notificationSenderEmail:DescribePortalResponse' :: Maybe Text
notificationSenderEmail = Maybe Text
a} :: DescribePortalResponse)

-- | The service to use to authenticate users to the portal.
describePortalResponse_portalAuthMode :: Lens.Lens' DescribePortalResponse (Prelude.Maybe AuthMode)
describePortalResponse_portalAuthMode :: Lens' DescribePortalResponse (Maybe AuthMode)
describePortalResponse_portalAuthMode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortalResponse' {Maybe AuthMode
portalAuthMode :: Maybe AuthMode
$sel:portalAuthMode:DescribePortalResponse' :: DescribePortalResponse -> Maybe AuthMode
portalAuthMode} -> Maybe AuthMode
portalAuthMode) (\s :: DescribePortalResponse
s@DescribePortalResponse' {} Maybe AuthMode
a -> DescribePortalResponse
s {$sel:portalAuthMode:DescribePortalResponse' :: Maybe AuthMode
portalAuthMode = Maybe AuthMode
a} :: DescribePortalResponse)

-- | The portal\'s description.
describePortalResponse_portalDescription :: Lens.Lens' DescribePortalResponse (Prelude.Maybe Prelude.Text)
describePortalResponse_portalDescription :: Lens' DescribePortalResponse (Maybe Text)
describePortalResponse_portalDescription = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortalResponse' {Maybe Text
portalDescription :: Maybe Text
$sel:portalDescription:DescribePortalResponse' :: DescribePortalResponse -> Maybe Text
portalDescription} -> Maybe Text
portalDescription) (\s :: DescribePortalResponse
s@DescribePortalResponse' {} Maybe Text
a -> DescribePortalResponse
s {$sel:portalDescription:DescribePortalResponse' :: Maybe Text
portalDescription = Maybe Text
a} :: DescribePortalResponse)

-- | The portal\'s logo image, which is available at a URL.
describePortalResponse_portalLogoImageLocation :: Lens.Lens' DescribePortalResponse (Prelude.Maybe ImageLocation)
describePortalResponse_portalLogoImageLocation :: Lens' DescribePortalResponse (Maybe ImageLocation)
describePortalResponse_portalLogoImageLocation = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortalResponse' {Maybe ImageLocation
portalLogoImageLocation :: Maybe ImageLocation
$sel:portalLogoImageLocation:DescribePortalResponse' :: DescribePortalResponse -> Maybe ImageLocation
portalLogoImageLocation} -> Maybe ImageLocation
portalLogoImageLocation) (\s :: DescribePortalResponse
s@DescribePortalResponse' {} Maybe ImageLocation
a -> DescribePortalResponse
s {$sel:portalLogoImageLocation:DescribePortalResponse' :: Maybe ImageLocation
portalLogoImageLocation = Maybe ImageLocation
a} :: DescribePortalResponse)

-- | The
-- <https://docs.aws.amazon.com/general/latest/gr/aws-arns-and-namespaces.html ARN>
-- of the 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/.
describePortalResponse_roleArn :: Lens.Lens' DescribePortalResponse (Prelude.Maybe Prelude.Text)
describePortalResponse_roleArn :: Lens' DescribePortalResponse (Maybe Text)
describePortalResponse_roleArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortalResponse' {Maybe Text
roleArn :: Maybe Text
$sel:roleArn:DescribePortalResponse' :: DescribePortalResponse -> Maybe Text
roleArn} -> Maybe Text
roleArn) (\s :: DescribePortalResponse
s@DescribePortalResponse' {} Maybe Text
a -> DescribePortalResponse
s {$sel:roleArn:DescribePortalResponse' :: Maybe Text
roleArn = Maybe Text
a} :: DescribePortalResponse)

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

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

-- | 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}@
describePortalResponse_portalArn :: Lens.Lens' DescribePortalResponse Prelude.Text
describePortalResponse_portalArn :: Lens' DescribePortalResponse Text
describePortalResponse_portalArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortalResponse' {Text
portalArn :: Text
$sel:portalArn:DescribePortalResponse' :: DescribePortalResponse -> Text
portalArn} -> Text
portalArn) (\s :: DescribePortalResponse
s@DescribePortalResponse' {} Text
a -> DescribePortalResponse
s {$sel:portalArn:DescribePortalResponse' :: Text
portalArn = Text
a} :: DescribePortalResponse)

-- | The name of the portal.
describePortalResponse_portalName :: Lens.Lens' DescribePortalResponse Prelude.Text
describePortalResponse_portalName :: Lens' DescribePortalResponse Text
describePortalResponse_portalName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortalResponse' {Text
portalName :: Text
$sel:portalName:DescribePortalResponse' :: DescribePortalResponse -> Text
portalName} -> Text
portalName) (\s :: DescribePortalResponse
s@DescribePortalResponse' {} Text
a -> DescribePortalResponse
s {$sel:portalName:DescribePortalResponse' :: Text
portalName = Text
a} :: DescribePortalResponse)

-- | The IAM Identity Center application generated client ID (used with IAM
-- Identity Center APIs). IoT SiteWise includes @portalClientId@ for only
-- portals that use IAM Identity Center to authenticate users.
describePortalResponse_portalClientId :: Lens.Lens' DescribePortalResponse Prelude.Text
describePortalResponse_portalClientId :: Lens' DescribePortalResponse Text
describePortalResponse_portalClientId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortalResponse' {Text
portalClientId :: Text
$sel:portalClientId:DescribePortalResponse' :: DescribePortalResponse -> Text
portalClientId} -> Text
portalClientId) (\s :: DescribePortalResponse
s@DescribePortalResponse' {} Text
a -> DescribePortalResponse
s {$sel:portalClientId:DescribePortalResponse' :: Text
portalClientId = Text
a} :: DescribePortalResponse)

-- | 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.
describePortalResponse_portalStartUrl :: Lens.Lens' DescribePortalResponse Prelude.Text
describePortalResponse_portalStartUrl :: Lens' DescribePortalResponse Text
describePortalResponse_portalStartUrl = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortalResponse' {Text
portalStartUrl :: Text
$sel:portalStartUrl:DescribePortalResponse' :: DescribePortalResponse -> Text
portalStartUrl} -> Text
portalStartUrl) (\s :: DescribePortalResponse
s@DescribePortalResponse' {} Text
a -> DescribePortalResponse
s {$sel:portalStartUrl:DescribePortalResponse' :: Text
portalStartUrl = Text
a} :: DescribePortalResponse)

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

-- | The current status of the portal, which contains a state and any error
-- message.
describePortalResponse_portalStatus :: Lens.Lens' DescribePortalResponse PortalStatus
describePortalResponse_portalStatus :: Lens' DescribePortalResponse PortalStatus
describePortalResponse_portalStatus = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortalResponse' {PortalStatus
portalStatus :: PortalStatus
$sel:portalStatus:DescribePortalResponse' :: DescribePortalResponse -> PortalStatus
portalStatus} -> PortalStatus
portalStatus) (\s :: DescribePortalResponse
s@DescribePortalResponse' {} PortalStatus
a -> DescribePortalResponse
s {$sel:portalStatus:DescribePortalResponse' :: PortalStatus
portalStatus = PortalStatus
a} :: DescribePortalResponse)

-- | The date the portal was created, in Unix epoch time.
describePortalResponse_portalCreationDate :: Lens.Lens' DescribePortalResponse Prelude.UTCTime
describePortalResponse_portalCreationDate :: Lens' DescribePortalResponse UTCTime
describePortalResponse_portalCreationDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortalResponse' {POSIX
portalCreationDate :: POSIX
$sel:portalCreationDate:DescribePortalResponse' :: DescribePortalResponse -> POSIX
portalCreationDate} -> POSIX
portalCreationDate) (\s :: DescribePortalResponse
s@DescribePortalResponse' {} POSIX
a -> DescribePortalResponse
s {$sel:portalCreationDate:DescribePortalResponse' :: POSIX
portalCreationDate = POSIX
a} :: DescribePortalResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The date the portal was last updated, in Unix epoch time.
describePortalResponse_portalLastUpdateDate :: Lens.Lens' DescribePortalResponse Prelude.UTCTime
describePortalResponse_portalLastUpdateDate :: Lens' DescribePortalResponse UTCTime
describePortalResponse_portalLastUpdateDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribePortalResponse' {POSIX
portalLastUpdateDate :: POSIX
$sel:portalLastUpdateDate:DescribePortalResponse' :: DescribePortalResponse -> POSIX
portalLastUpdateDate} -> POSIX
portalLastUpdateDate) (\s :: DescribePortalResponse
s@DescribePortalResponse' {} POSIX
a -> DescribePortalResponse
s {$sel:portalLastUpdateDate:DescribePortalResponse' :: POSIX
portalLastUpdateDate = POSIX
a} :: DescribePortalResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.NFData DescribePortalResponse where
  rnf :: DescribePortalResponse -> ()
rnf DescribePortalResponse' {Int
Maybe Text
Maybe Alarms
Maybe AuthMode
Maybe ImageLocation
Text
POSIX
PortalStatus
portalLastUpdateDate :: POSIX
portalCreationDate :: POSIX
portalStatus :: PortalStatus
portalContactEmail :: Text
portalStartUrl :: Text
portalClientId :: Text
portalName :: Text
portalArn :: Text
portalId :: Text
httpStatus :: Int
roleArn :: Maybe Text
portalLogoImageLocation :: Maybe ImageLocation
portalDescription :: Maybe Text
portalAuthMode :: Maybe AuthMode
notificationSenderEmail :: Maybe Text
alarms :: Maybe Alarms
$sel:portalLastUpdateDate:DescribePortalResponse' :: DescribePortalResponse -> POSIX
$sel:portalCreationDate:DescribePortalResponse' :: DescribePortalResponse -> POSIX
$sel:portalStatus:DescribePortalResponse' :: DescribePortalResponse -> PortalStatus
$sel:portalContactEmail:DescribePortalResponse' :: DescribePortalResponse -> Text
$sel:portalStartUrl:DescribePortalResponse' :: DescribePortalResponse -> Text
$sel:portalClientId:DescribePortalResponse' :: DescribePortalResponse -> Text
$sel:portalName:DescribePortalResponse' :: DescribePortalResponse -> Text
$sel:portalArn:DescribePortalResponse' :: DescribePortalResponse -> Text
$sel:portalId:DescribePortalResponse' :: DescribePortalResponse -> Text
$sel:httpStatus:DescribePortalResponse' :: DescribePortalResponse -> Int
$sel:roleArn:DescribePortalResponse' :: DescribePortalResponse -> Maybe Text
$sel:portalLogoImageLocation:DescribePortalResponse' :: DescribePortalResponse -> Maybe ImageLocation
$sel:portalDescription:DescribePortalResponse' :: DescribePortalResponse -> Maybe Text
$sel:portalAuthMode:DescribePortalResponse' :: DescribePortalResponse -> Maybe AuthMode
$sel:notificationSenderEmail:DescribePortalResponse' :: DescribePortalResponse -> Maybe Text
$sel:alarms:DescribePortalResponse' :: DescribePortalResponse -> 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
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 ImageLocation
portalLogoImageLocation
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
roleArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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
portalName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
portalClientId
      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 Text
portalContactEmail
      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 POSIX
portalCreationDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf POSIX
portalLastUpdateDate