{-# 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.GetAssetPropertyValueHistory
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets the history of an asset property\'s values. For more information,
-- see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/query-industrial-data.html#historical-values Querying historical values>
-- in the /IoT SiteWise User Guide/.
--
-- To identify an asset property, you must specify one of the following:
--
-- -   The @assetId@ and @propertyId@ of an asset property.
--
-- -   A @propertyAlias@, which is a data stream alias (for example,
--     @\/company\/windfarm\/3\/turbine\/7\/temperature@). To define an
--     asset property\'s alias, see
--     <https://docs.aws.amazon.com/iot-sitewise/latest/APIReference/API_UpdateAssetProperty.html UpdateAssetProperty>.
--
-- This operation returns paginated results.
module Amazonka.IoTSiteWise.GetAssetPropertyValueHistory
  ( -- * Creating a Request
    GetAssetPropertyValueHistory (..),
    newGetAssetPropertyValueHistory,

    -- * Request Lenses
    getAssetPropertyValueHistory_assetId,
    getAssetPropertyValueHistory_endDate,
    getAssetPropertyValueHistory_maxResults,
    getAssetPropertyValueHistory_nextToken,
    getAssetPropertyValueHistory_propertyAlias,
    getAssetPropertyValueHistory_propertyId,
    getAssetPropertyValueHistory_qualities,
    getAssetPropertyValueHistory_startDate,
    getAssetPropertyValueHistory_timeOrdering,

    -- * Destructuring the Response
    GetAssetPropertyValueHistoryResponse (..),
    newGetAssetPropertyValueHistoryResponse,

    -- * Response Lenses
    getAssetPropertyValueHistoryResponse_nextToken,
    getAssetPropertyValueHistoryResponse_httpStatus,
    getAssetPropertyValueHistoryResponse_assetPropertyValueHistory,
  )
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:/ 'newGetAssetPropertyValueHistory' smart constructor.
data GetAssetPropertyValueHistory = GetAssetPropertyValueHistory'
  { -- | The ID of the asset.
    GetAssetPropertyValueHistory -> Maybe Text
assetId :: Prelude.Maybe Prelude.Text,
    -- | The inclusive end of the range from which to query historical data,
    -- expressed in seconds in Unix epoch time.
    GetAssetPropertyValueHistory -> Maybe POSIX
endDate :: Prelude.Maybe Data.POSIX,
    -- | The maximum number of results to return for each paginated request.
    --
    -- Default: 100
    GetAssetPropertyValueHistory -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The token to be used for the next set of paginated results.
    GetAssetPropertyValueHistory -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The alias that identifies the property, such as an OPC-UA server data
    -- stream path (for example,
    -- @\/company\/windfarm\/3\/turbine\/7\/temperature@). For more
    -- information, see
    -- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/connect-data-streams.html Mapping industrial data streams to asset properties>
    -- in the /IoT SiteWise User Guide/.
    GetAssetPropertyValueHistory -> Maybe Text
propertyAlias :: Prelude.Maybe Prelude.Text,
    -- | The ID of the asset property.
    GetAssetPropertyValueHistory -> Maybe Text
propertyId :: Prelude.Maybe Prelude.Text,
    -- | The quality by which to filter asset data.
    GetAssetPropertyValueHistory -> Maybe (NonEmpty Quality)
qualities :: Prelude.Maybe (Prelude.NonEmpty Quality),
    -- | The exclusive start of the range from which to query historical data,
    -- expressed in seconds in Unix epoch time.
    GetAssetPropertyValueHistory -> Maybe POSIX
startDate :: Prelude.Maybe Data.POSIX,
    -- | The chronological sorting order of the requested information.
    --
    -- Default: @ASCENDING@
    GetAssetPropertyValueHistory -> Maybe TimeOrdering
timeOrdering :: Prelude.Maybe TimeOrdering
  }
  deriving (GetAssetPropertyValueHistory
-> GetAssetPropertyValueHistory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAssetPropertyValueHistory
-> GetAssetPropertyValueHistory -> Bool
$c/= :: GetAssetPropertyValueHistory
-> GetAssetPropertyValueHistory -> Bool
== :: GetAssetPropertyValueHistory
-> GetAssetPropertyValueHistory -> Bool
$c== :: GetAssetPropertyValueHistory
-> GetAssetPropertyValueHistory -> Bool
Prelude.Eq, ReadPrec [GetAssetPropertyValueHistory]
ReadPrec GetAssetPropertyValueHistory
Int -> ReadS GetAssetPropertyValueHistory
ReadS [GetAssetPropertyValueHistory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAssetPropertyValueHistory]
$creadListPrec :: ReadPrec [GetAssetPropertyValueHistory]
readPrec :: ReadPrec GetAssetPropertyValueHistory
$creadPrec :: ReadPrec GetAssetPropertyValueHistory
readList :: ReadS [GetAssetPropertyValueHistory]
$creadList :: ReadS [GetAssetPropertyValueHistory]
readsPrec :: Int -> ReadS GetAssetPropertyValueHistory
$creadsPrec :: Int -> ReadS GetAssetPropertyValueHistory
Prelude.Read, Int -> GetAssetPropertyValueHistory -> ShowS
[GetAssetPropertyValueHistory] -> ShowS
GetAssetPropertyValueHistory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAssetPropertyValueHistory] -> ShowS
$cshowList :: [GetAssetPropertyValueHistory] -> ShowS
show :: GetAssetPropertyValueHistory -> String
$cshow :: GetAssetPropertyValueHistory -> String
showsPrec :: Int -> GetAssetPropertyValueHistory -> ShowS
$cshowsPrec :: Int -> GetAssetPropertyValueHistory -> ShowS
Prelude.Show, forall x.
Rep GetAssetPropertyValueHistory x -> GetAssetPropertyValueHistory
forall x.
GetAssetPropertyValueHistory -> Rep GetAssetPropertyValueHistory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetAssetPropertyValueHistory x -> GetAssetPropertyValueHistory
$cfrom :: forall x.
GetAssetPropertyValueHistory -> Rep GetAssetPropertyValueHistory x
Prelude.Generic)

-- |
-- Create a value of 'GetAssetPropertyValueHistory' 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:
--
-- 'assetId', 'getAssetPropertyValueHistory_assetId' - The ID of the asset.
--
-- 'endDate', 'getAssetPropertyValueHistory_endDate' - The inclusive end of the range from which to query historical data,
-- expressed in seconds in Unix epoch time.
--
-- 'maxResults', 'getAssetPropertyValueHistory_maxResults' - The maximum number of results to return for each paginated request.
--
-- Default: 100
--
-- 'nextToken', 'getAssetPropertyValueHistory_nextToken' - The token to be used for the next set of paginated results.
--
-- 'propertyAlias', 'getAssetPropertyValueHistory_propertyAlias' - The alias that identifies the property, such as an OPC-UA server data
-- stream path (for example,
-- @\/company\/windfarm\/3\/turbine\/7\/temperature@). For more
-- information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/connect-data-streams.html Mapping industrial data streams to asset properties>
-- in the /IoT SiteWise User Guide/.
--
-- 'propertyId', 'getAssetPropertyValueHistory_propertyId' - The ID of the asset property.
--
-- 'qualities', 'getAssetPropertyValueHistory_qualities' - The quality by which to filter asset data.
--
-- 'startDate', 'getAssetPropertyValueHistory_startDate' - The exclusive start of the range from which to query historical data,
-- expressed in seconds in Unix epoch time.
--
-- 'timeOrdering', 'getAssetPropertyValueHistory_timeOrdering' - The chronological sorting order of the requested information.
--
-- Default: @ASCENDING@
newGetAssetPropertyValueHistory ::
  GetAssetPropertyValueHistory
newGetAssetPropertyValueHistory :: GetAssetPropertyValueHistory
newGetAssetPropertyValueHistory =
  GetAssetPropertyValueHistory'
    { $sel:assetId:GetAssetPropertyValueHistory' :: Maybe Text
assetId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:endDate:GetAssetPropertyValueHistory' :: Maybe POSIX
endDate = forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetAssetPropertyValueHistory' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetAssetPropertyValueHistory' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:propertyAlias:GetAssetPropertyValueHistory' :: Maybe Text
propertyAlias = forall a. Maybe a
Prelude.Nothing,
      $sel:propertyId:GetAssetPropertyValueHistory' :: Maybe Text
propertyId = forall a. Maybe a
Prelude.Nothing,
      $sel:qualities:GetAssetPropertyValueHistory' :: Maybe (NonEmpty Quality)
qualities = forall a. Maybe a
Prelude.Nothing,
      $sel:startDate:GetAssetPropertyValueHistory' :: Maybe POSIX
startDate = forall a. Maybe a
Prelude.Nothing,
      $sel:timeOrdering:GetAssetPropertyValueHistory' :: Maybe TimeOrdering
timeOrdering = forall a. Maybe a
Prelude.Nothing
    }

-- | The ID of the asset.
getAssetPropertyValueHistory_assetId :: Lens.Lens' GetAssetPropertyValueHistory (Prelude.Maybe Prelude.Text)
getAssetPropertyValueHistory_assetId :: Lens' GetAssetPropertyValueHistory (Maybe Text)
getAssetPropertyValueHistory_assetId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAssetPropertyValueHistory' {Maybe Text
assetId :: Maybe Text
$sel:assetId:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
assetId} -> Maybe Text
assetId) (\s :: GetAssetPropertyValueHistory
s@GetAssetPropertyValueHistory' {} Maybe Text
a -> GetAssetPropertyValueHistory
s {$sel:assetId:GetAssetPropertyValueHistory' :: Maybe Text
assetId = Maybe Text
a} :: GetAssetPropertyValueHistory)

-- | The inclusive end of the range from which to query historical data,
-- expressed in seconds in Unix epoch time.
getAssetPropertyValueHistory_endDate :: Lens.Lens' GetAssetPropertyValueHistory (Prelude.Maybe Prelude.UTCTime)
getAssetPropertyValueHistory_endDate :: Lens' GetAssetPropertyValueHistory (Maybe UTCTime)
getAssetPropertyValueHistory_endDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAssetPropertyValueHistory' {Maybe POSIX
endDate :: Maybe POSIX
$sel:endDate:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe POSIX
endDate} -> Maybe POSIX
endDate) (\s :: GetAssetPropertyValueHistory
s@GetAssetPropertyValueHistory' {} Maybe POSIX
a -> GetAssetPropertyValueHistory
s {$sel:endDate:GetAssetPropertyValueHistory' :: Maybe POSIX
endDate = Maybe POSIX
a} :: GetAssetPropertyValueHistory) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The maximum number of results to return for each paginated request.
--
-- Default: 100
getAssetPropertyValueHistory_maxResults :: Lens.Lens' GetAssetPropertyValueHistory (Prelude.Maybe Prelude.Natural)
getAssetPropertyValueHistory_maxResults :: Lens' GetAssetPropertyValueHistory (Maybe Natural)
getAssetPropertyValueHistory_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAssetPropertyValueHistory' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetAssetPropertyValueHistory
s@GetAssetPropertyValueHistory' {} Maybe Natural
a -> GetAssetPropertyValueHistory
s {$sel:maxResults:GetAssetPropertyValueHistory' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetAssetPropertyValueHistory)

-- | The token to be used for the next set of paginated results.
getAssetPropertyValueHistory_nextToken :: Lens.Lens' GetAssetPropertyValueHistory (Prelude.Maybe Prelude.Text)
getAssetPropertyValueHistory_nextToken :: Lens' GetAssetPropertyValueHistory (Maybe Text)
getAssetPropertyValueHistory_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAssetPropertyValueHistory' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetAssetPropertyValueHistory
s@GetAssetPropertyValueHistory' {} Maybe Text
a -> GetAssetPropertyValueHistory
s {$sel:nextToken:GetAssetPropertyValueHistory' :: Maybe Text
nextToken = Maybe Text
a} :: GetAssetPropertyValueHistory)

-- | The alias that identifies the property, such as an OPC-UA server data
-- stream path (for example,
-- @\/company\/windfarm\/3\/turbine\/7\/temperature@). For more
-- information, see
-- <https://docs.aws.amazon.com/iot-sitewise/latest/userguide/connect-data-streams.html Mapping industrial data streams to asset properties>
-- in the /IoT SiteWise User Guide/.
getAssetPropertyValueHistory_propertyAlias :: Lens.Lens' GetAssetPropertyValueHistory (Prelude.Maybe Prelude.Text)
getAssetPropertyValueHistory_propertyAlias :: Lens' GetAssetPropertyValueHistory (Maybe Text)
getAssetPropertyValueHistory_propertyAlias = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAssetPropertyValueHistory' {Maybe Text
propertyAlias :: Maybe Text
$sel:propertyAlias:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
propertyAlias} -> Maybe Text
propertyAlias) (\s :: GetAssetPropertyValueHistory
s@GetAssetPropertyValueHistory' {} Maybe Text
a -> GetAssetPropertyValueHistory
s {$sel:propertyAlias:GetAssetPropertyValueHistory' :: Maybe Text
propertyAlias = Maybe Text
a} :: GetAssetPropertyValueHistory)

-- | The ID of the asset property.
getAssetPropertyValueHistory_propertyId :: Lens.Lens' GetAssetPropertyValueHistory (Prelude.Maybe Prelude.Text)
getAssetPropertyValueHistory_propertyId :: Lens' GetAssetPropertyValueHistory (Maybe Text)
getAssetPropertyValueHistory_propertyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAssetPropertyValueHistory' {Maybe Text
propertyId :: Maybe Text
$sel:propertyId:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
propertyId} -> Maybe Text
propertyId) (\s :: GetAssetPropertyValueHistory
s@GetAssetPropertyValueHistory' {} Maybe Text
a -> GetAssetPropertyValueHistory
s {$sel:propertyId:GetAssetPropertyValueHistory' :: Maybe Text
propertyId = Maybe Text
a} :: GetAssetPropertyValueHistory)

-- | The quality by which to filter asset data.
getAssetPropertyValueHistory_qualities :: Lens.Lens' GetAssetPropertyValueHistory (Prelude.Maybe (Prelude.NonEmpty Quality))
getAssetPropertyValueHistory_qualities :: Lens' GetAssetPropertyValueHistory (Maybe (NonEmpty Quality))
getAssetPropertyValueHistory_qualities = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAssetPropertyValueHistory' {Maybe (NonEmpty Quality)
qualities :: Maybe (NonEmpty Quality)
$sel:qualities:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe (NonEmpty Quality)
qualities} -> Maybe (NonEmpty Quality)
qualities) (\s :: GetAssetPropertyValueHistory
s@GetAssetPropertyValueHistory' {} Maybe (NonEmpty Quality)
a -> GetAssetPropertyValueHistory
s {$sel:qualities:GetAssetPropertyValueHistory' :: Maybe (NonEmpty Quality)
qualities = Maybe (NonEmpty Quality)
a} :: GetAssetPropertyValueHistory) 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

-- | The exclusive start of the range from which to query historical data,
-- expressed in seconds in Unix epoch time.
getAssetPropertyValueHistory_startDate :: Lens.Lens' GetAssetPropertyValueHistory (Prelude.Maybe Prelude.UTCTime)
getAssetPropertyValueHistory_startDate :: Lens' GetAssetPropertyValueHistory (Maybe UTCTime)
getAssetPropertyValueHistory_startDate = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAssetPropertyValueHistory' {Maybe POSIX
startDate :: Maybe POSIX
$sel:startDate:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe POSIX
startDate} -> Maybe POSIX
startDate) (\s :: GetAssetPropertyValueHistory
s@GetAssetPropertyValueHistory' {} Maybe POSIX
a -> GetAssetPropertyValueHistory
s {$sel:startDate:GetAssetPropertyValueHistory' :: Maybe POSIX
startDate = Maybe POSIX
a} :: GetAssetPropertyValueHistory) 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 :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The chronological sorting order of the requested information.
--
-- Default: @ASCENDING@
getAssetPropertyValueHistory_timeOrdering :: Lens.Lens' GetAssetPropertyValueHistory (Prelude.Maybe TimeOrdering)
getAssetPropertyValueHistory_timeOrdering :: Lens' GetAssetPropertyValueHistory (Maybe TimeOrdering)
getAssetPropertyValueHistory_timeOrdering = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAssetPropertyValueHistory' {Maybe TimeOrdering
timeOrdering :: Maybe TimeOrdering
$sel:timeOrdering:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe TimeOrdering
timeOrdering} -> Maybe TimeOrdering
timeOrdering) (\s :: GetAssetPropertyValueHistory
s@GetAssetPropertyValueHistory' {} Maybe TimeOrdering
a -> GetAssetPropertyValueHistory
s {$sel:timeOrdering:GetAssetPropertyValueHistory' :: Maybe TimeOrdering
timeOrdering = Maybe TimeOrdering
a} :: GetAssetPropertyValueHistory)

instance Core.AWSPager GetAssetPropertyValueHistory where
  page :: GetAssetPropertyValueHistory
-> AWSResponse GetAssetPropertyValueHistory
-> Maybe GetAssetPropertyValueHistory
page GetAssetPropertyValueHistory
rq AWSResponse GetAssetPropertyValueHistory
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetAssetPropertyValueHistory
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetAssetPropertyValueHistoryResponse (Maybe Text)
getAssetPropertyValueHistoryResponse_nextToken
            forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just
        ) =
        forall a. Maybe a
Prelude.Nothing
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetAssetPropertyValueHistory
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' GetAssetPropertyValueHistoryResponse [AssetPropertyValue]
getAssetPropertyValueHistoryResponse_assetPropertyValueHistory
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ GetAssetPropertyValueHistory
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetAssetPropertyValueHistory (Maybe Text)
getAssetPropertyValueHistory_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetAssetPropertyValueHistory
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetAssetPropertyValueHistoryResponse (Maybe Text)
getAssetPropertyValueHistoryResponse_nextToken
          forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall a b. Prism (Maybe a) (Maybe b) a b
Lens._Just

instance Core.AWSRequest GetAssetPropertyValueHistory where
  type
    AWSResponse GetAssetPropertyValueHistory =
      GetAssetPropertyValueHistoryResponse
  request :: (Service -> Service)
-> GetAssetPropertyValueHistory
-> Request GetAssetPropertyValueHistory
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 GetAssetPropertyValueHistory
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetAssetPropertyValueHistory)))
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 Text
-> Int
-> [AssetPropertyValue]
-> GetAssetPropertyValueHistoryResponse
GetAssetPropertyValueHistoryResponse'
            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
"nextToken")
            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 (Maybe a)
Data..?> Key
"assetPropertyValueHistory"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance
  Prelude.Hashable
    GetAssetPropertyValueHistory
  where
  hashWithSalt :: Int -> GetAssetPropertyValueHistory -> Int
hashWithSalt Int
_salt GetAssetPropertyValueHistory' {Maybe Natural
Maybe (NonEmpty Quality)
Maybe Text
Maybe POSIX
Maybe TimeOrdering
timeOrdering :: Maybe TimeOrdering
startDate :: Maybe POSIX
qualities :: Maybe (NonEmpty Quality)
propertyId :: Maybe Text
propertyAlias :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
endDate :: Maybe POSIX
assetId :: Maybe Text
$sel:timeOrdering:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe TimeOrdering
$sel:startDate:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe POSIX
$sel:qualities:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe (NonEmpty Quality)
$sel:propertyId:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
$sel:propertyAlias:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
$sel:nextToken:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
$sel:maxResults:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Natural
$sel:endDate:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe POSIX
$sel:assetId:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
assetId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
endDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Natural
maxResults
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
nextToken
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
propertyAlias
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
propertyId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty Quality)
qualities
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
startDate
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe TimeOrdering
timeOrdering

instance Prelude.NFData GetAssetPropertyValueHistory where
  rnf :: GetAssetPropertyValueHistory -> ()
rnf GetAssetPropertyValueHistory' {Maybe Natural
Maybe (NonEmpty Quality)
Maybe Text
Maybe POSIX
Maybe TimeOrdering
timeOrdering :: Maybe TimeOrdering
startDate :: Maybe POSIX
qualities :: Maybe (NonEmpty Quality)
propertyId :: Maybe Text
propertyAlias :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
endDate :: Maybe POSIX
assetId :: Maybe Text
$sel:timeOrdering:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe TimeOrdering
$sel:startDate:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe POSIX
$sel:qualities:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe (NonEmpty Quality)
$sel:propertyId:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
$sel:propertyAlias:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
$sel:nextToken:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
$sel:maxResults:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Natural
$sel:endDate:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe POSIX
$sel:assetId:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
assetId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
endDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Natural
maxResults
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
propertyAlias
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
propertyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty Quality)
qualities
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
startDate
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe TimeOrdering
timeOrdering

instance Data.ToHeaders GetAssetPropertyValueHistory where
  toHeaders :: GetAssetPropertyValueHistory -> 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 GetAssetPropertyValueHistory where
  toPath :: GetAssetPropertyValueHistory -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/properties/history"

instance Data.ToQuery GetAssetPropertyValueHistory where
  toQuery :: GetAssetPropertyValueHistory -> QueryString
toQuery GetAssetPropertyValueHistory' {Maybe Natural
Maybe (NonEmpty Quality)
Maybe Text
Maybe POSIX
Maybe TimeOrdering
timeOrdering :: Maybe TimeOrdering
startDate :: Maybe POSIX
qualities :: Maybe (NonEmpty Quality)
propertyId :: Maybe Text
propertyAlias :: Maybe Text
nextToken :: Maybe Text
maxResults :: Maybe Natural
endDate :: Maybe POSIX
assetId :: Maybe Text
$sel:timeOrdering:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe TimeOrdering
$sel:startDate:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe POSIX
$sel:qualities:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe (NonEmpty Quality)
$sel:propertyId:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
$sel:propertyAlias:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
$sel:nextToken:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
$sel:maxResults:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Natural
$sel:endDate:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe POSIX
$sel:assetId:GetAssetPropertyValueHistory' :: GetAssetPropertyValueHistory -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"assetId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
assetId,
        ByteString
"endDate" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe POSIX
endDate,
        ByteString
"maxResults" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Natural
maxResults,
        ByteString
"nextToken" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
nextToken,
        ByteString
"propertyAlias" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
propertyAlias,
        ByteString
"propertyId" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
propertyId,
        ByteString
"qualities"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a. ToQuery a => a -> QueryString
Data.toQuery
            (forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> Maybe (NonEmpty Quality)
qualities),
        ByteString
"startDate" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe POSIX
startDate,
        ByteString
"timeOrdering" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe TimeOrdering
timeOrdering
      ]

-- | /See:/ 'newGetAssetPropertyValueHistoryResponse' smart constructor.
data GetAssetPropertyValueHistoryResponse = GetAssetPropertyValueHistoryResponse'
  { -- | The token for the next set of results, or null if there are no
    -- additional results.
    GetAssetPropertyValueHistoryResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetAssetPropertyValueHistoryResponse -> Int
httpStatus :: Prelude.Int,
    -- | The asset property\'s value history.
    GetAssetPropertyValueHistoryResponse -> [AssetPropertyValue]
assetPropertyValueHistory :: [AssetPropertyValue]
  }
  deriving (GetAssetPropertyValueHistoryResponse
-> GetAssetPropertyValueHistoryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetAssetPropertyValueHistoryResponse
-> GetAssetPropertyValueHistoryResponse -> Bool
$c/= :: GetAssetPropertyValueHistoryResponse
-> GetAssetPropertyValueHistoryResponse -> Bool
== :: GetAssetPropertyValueHistoryResponse
-> GetAssetPropertyValueHistoryResponse -> Bool
$c== :: GetAssetPropertyValueHistoryResponse
-> GetAssetPropertyValueHistoryResponse -> Bool
Prelude.Eq, ReadPrec [GetAssetPropertyValueHistoryResponse]
ReadPrec GetAssetPropertyValueHistoryResponse
Int -> ReadS GetAssetPropertyValueHistoryResponse
ReadS [GetAssetPropertyValueHistoryResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetAssetPropertyValueHistoryResponse]
$creadListPrec :: ReadPrec [GetAssetPropertyValueHistoryResponse]
readPrec :: ReadPrec GetAssetPropertyValueHistoryResponse
$creadPrec :: ReadPrec GetAssetPropertyValueHistoryResponse
readList :: ReadS [GetAssetPropertyValueHistoryResponse]
$creadList :: ReadS [GetAssetPropertyValueHistoryResponse]
readsPrec :: Int -> ReadS GetAssetPropertyValueHistoryResponse
$creadsPrec :: Int -> ReadS GetAssetPropertyValueHistoryResponse
Prelude.Read, Int -> GetAssetPropertyValueHistoryResponse -> ShowS
[GetAssetPropertyValueHistoryResponse] -> ShowS
GetAssetPropertyValueHistoryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetAssetPropertyValueHistoryResponse] -> ShowS
$cshowList :: [GetAssetPropertyValueHistoryResponse] -> ShowS
show :: GetAssetPropertyValueHistoryResponse -> String
$cshow :: GetAssetPropertyValueHistoryResponse -> String
showsPrec :: Int -> GetAssetPropertyValueHistoryResponse -> ShowS
$cshowsPrec :: Int -> GetAssetPropertyValueHistoryResponse -> ShowS
Prelude.Show, forall x.
Rep GetAssetPropertyValueHistoryResponse x
-> GetAssetPropertyValueHistoryResponse
forall x.
GetAssetPropertyValueHistoryResponse
-> Rep GetAssetPropertyValueHistoryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetAssetPropertyValueHistoryResponse x
-> GetAssetPropertyValueHistoryResponse
$cfrom :: forall x.
GetAssetPropertyValueHistoryResponse
-> Rep GetAssetPropertyValueHistoryResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetAssetPropertyValueHistoryResponse' 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:
--
-- 'nextToken', 'getAssetPropertyValueHistoryResponse_nextToken' - The token for the next set of results, or null if there are no
-- additional results.
--
-- 'httpStatus', 'getAssetPropertyValueHistoryResponse_httpStatus' - The response's http status code.
--
-- 'assetPropertyValueHistory', 'getAssetPropertyValueHistoryResponse_assetPropertyValueHistory' - The asset property\'s value history.
newGetAssetPropertyValueHistoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetAssetPropertyValueHistoryResponse
newGetAssetPropertyValueHistoryResponse :: Int -> GetAssetPropertyValueHistoryResponse
newGetAssetPropertyValueHistoryResponse Int
pHttpStatus_ =
  GetAssetPropertyValueHistoryResponse'
    { $sel:nextToken:GetAssetPropertyValueHistoryResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetAssetPropertyValueHistoryResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:assetPropertyValueHistory:GetAssetPropertyValueHistoryResponse' :: [AssetPropertyValue]
assetPropertyValueHistory =
        forall a. Monoid a => a
Prelude.mempty
    }

-- | The token for the next set of results, or null if there are no
-- additional results.
getAssetPropertyValueHistoryResponse_nextToken :: Lens.Lens' GetAssetPropertyValueHistoryResponse (Prelude.Maybe Prelude.Text)
getAssetPropertyValueHistoryResponse_nextToken :: Lens' GetAssetPropertyValueHistoryResponse (Maybe Text)
getAssetPropertyValueHistoryResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAssetPropertyValueHistoryResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetAssetPropertyValueHistoryResponse' :: GetAssetPropertyValueHistoryResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetAssetPropertyValueHistoryResponse
s@GetAssetPropertyValueHistoryResponse' {} Maybe Text
a -> GetAssetPropertyValueHistoryResponse
s {$sel:nextToken:GetAssetPropertyValueHistoryResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetAssetPropertyValueHistoryResponse)

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

-- | The asset property\'s value history.
getAssetPropertyValueHistoryResponse_assetPropertyValueHistory :: Lens.Lens' GetAssetPropertyValueHistoryResponse [AssetPropertyValue]
getAssetPropertyValueHistoryResponse_assetPropertyValueHistory :: Lens' GetAssetPropertyValueHistoryResponse [AssetPropertyValue]
getAssetPropertyValueHistoryResponse_assetPropertyValueHistory = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetAssetPropertyValueHistoryResponse' {[AssetPropertyValue]
assetPropertyValueHistory :: [AssetPropertyValue]
$sel:assetPropertyValueHistory:GetAssetPropertyValueHistoryResponse' :: GetAssetPropertyValueHistoryResponse -> [AssetPropertyValue]
assetPropertyValueHistory} -> [AssetPropertyValue]
assetPropertyValueHistory) (\s :: GetAssetPropertyValueHistoryResponse
s@GetAssetPropertyValueHistoryResponse' {} [AssetPropertyValue]
a -> GetAssetPropertyValueHistoryResponse
s {$sel:assetPropertyValueHistory:GetAssetPropertyValueHistoryResponse' :: [AssetPropertyValue]
assetPropertyValueHistory = [AssetPropertyValue]
a} :: GetAssetPropertyValueHistoryResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

instance
  Prelude.NFData
    GetAssetPropertyValueHistoryResponse
  where
  rnf :: GetAssetPropertyValueHistoryResponse -> ()
rnf GetAssetPropertyValueHistoryResponse' {Int
[AssetPropertyValue]
Maybe Text
assetPropertyValueHistory :: [AssetPropertyValue]
httpStatus :: Int
nextToken :: Maybe Text
$sel:assetPropertyValueHistory:GetAssetPropertyValueHistoryResponse' :: GetAssetPropertyValueHistoryResponse -> [AssetPropertyValue]
$sel:httpStatus:GetAssetPropertyValueHistoryResponse' :: GetAssetPropertyValueHistoryResponse -> Int
$sel:nextToken:GetAssetPropertyValueHistoryResponse' :: GetAssetPropertyValueHistoryResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
nextToken
      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 [AssetPropertyValue]
assetPropertyValueHistory