{-# 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.Location.GetDevicePositionHistory
-- 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 the device position history from a tracker resource within a
-- specified range of time.
--
-- Device positions are deleted after 30 days.
--
-- This operation returns paginated results.
module Amazonka.Location.GetDevicePositionHistory
  ( -- * Creating a Request
    GetDevicePositionHistory (..),
    newGetDevicePositionHistory,

    -- * Request Lenses
    getDevicePositionHistory_endTimeExclusive,
    getDevicePositionHistory_maxResults,
    getDevicePositionHistory_nextToken,
    getDevicePositionHistory_startTimeInclusive,
    getDevicePositionHistory_deviceId,
    getDevicePositionHistory_trackerName,

    -- * Destructuring the Response
    GetDevicePositionHistoryResponse (..),
    newGetDevicePositionHistoryResponse,

    -- * Response Lenses
    getDevicePositionHistoryResponse_nextToken,
    getDevicePositionHistoryResponse_httpStatus,
    getDevicePositionHistoryResponse_devicePositions,
  )
where

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

-- | /See:/ 'newGetDevicePositionHistory' smart constructor.
data GetDevicePositionHistory = GetDevicePositionHistory'
  { -- | Specify the end time for the position history in
    -- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
    -- format: @YYYY-MM-DDThh:mm:ss.sssZ@. By default, the value will be the
    -- time that the request is made.
    --
    -- Requirement:
    --
    -- -   The time specified for @EndTimeExclusive@ must be after the time for
    --     @StartTimeInclusive@.
    GetDevicePositionHistory -> Maybe ISO8601
endTimeExclusive :: Prelude.Maybe Data.ISO8601,
    -- | An optional limit for the number of device positions returned in a
    -- single call.
    --
    -- Default value: @100@
    GetDevicePositionHistory -> Maybe Natural
maxResults :: Prelude.Maybe Prelude.Natural,
    -- | The pagination token specifying which page of results to return in the
    -- response. If no token is provided, the default page is the first page.
    --
    -- Default value: @null@
    GetDevicePositionHistory -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | Specify the start time for the position history in
    -- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
    -- format: @YYYY-MM-DDThh:mm:ss.sssZ@. By default, the value will be 24
    -- hours prior to the time that the request is made.
    --
    -- Requirement:
    --
    -- -   The time specified for @StartTimeInclusive@ must be before
    --     @EndTimeExclusive@.
    GetDevicePositionHistory -> Maybe ISO8601
startTimeInclusive :: Prelude.Maybe Data.ISO8601,
    -- | The device whose position history you want to retrieve.
    GetDevicePositionHistory -> Text
deviceId :: Prelude.Text,
    -- | The tracker resource receiving the request for the device position
    -- history.
    GetDevicePositionHistory -> Text
trackerName :: Prelude.Text
  }
  deriving (GetDevicePositionHistory -> GetDevicePositionHistory -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDevicePositionHistory -> GetDevicePositionHistory -> Bool
$c/= :: GetDevicePositionHistory -> GetDevicePositionHistory -> Bool
== :: GetDevicePositionHistory -> GetDevicePositionHistory -> Bool
$c== :: GetDevicePositionHistory -> GetDevicePositionHistory -> Bool
Prelude.Eq, ReadPrec [GetDevicePositionHistory]
ReadPrec GetDevicePositionHistory
Int -> ReadS GetDevicePositionHistory
ReadS [GetDevicePositionHistory]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetDevicePositionHistory]
$creadListPrec :: ReadPrec [GetDevicePositionHistory]
readPrec :: ReadPrec GetDevicePositionHistory
$creadPrec :: ReadPrec GetDevicePositionHistory
readList :: ReadS [GetDevicePositionHistory]
$creadList :: ReadS [GetDevicePositionHistory]
readsPrec :: Int -> ReadS GetDevicePositionHistory
$creadsPrec :: Int -> ReadS GetDevicePositionHistory
Prelude.Read, Int -> GetDevicePositionHistory -> ShowS
[GetDevicePositionHistory] -> ShowS
GetDevicePositionHistory -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDevicePositionHistory] -> ShowS
$cshowList :: [GetDevicePositionHistory] -> ShowS
show :: GetDevicePositionHistory -> String
$cshow :: GetDevicePositionHistory -> String
showsPrec :: Int -> GetDevicePositionHistory -> ShowS
$cshowsPrec :: Int -> GetDevicePositionHistory -> ShowS
Prelude.Show, forall x.
Rep GetDevicePositionHistory x -> GetDevicePositionHistory
forall x.
GetDevicePositionHistory -> Rep GetDevicePositionHistory x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDevicePositionHistory x -> GetDevicePositionHistory
$cfrom :: forall x.
GetDevicePositionHistory -> Rep GetDevicePositionHistory x
Prelude.Generic)

-- |
-- Create a value of 'GetDevicePositionHistory' 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:
--
-- 'endTimeExclusive', 'getDevicePositionHistory_endTimeExclusive' - Specify the end time for the position history in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@. By default, the value will be the
-- time that the request is made.
--
-- Requirement:
--
-- -   The time specified for @EndTimeExclusive@ must be after the time for
--     @StartTimeInclusive@.
--
-- 'maxResults', 'getDevicePositionHistory_maxResults' - An optional limit for the number of device positions returned in a
-- single call.
--
-- Default value: @100@
--
-- 'nextToken', 'getDevicePositionHistory_nextToken' - The pagination token specifying which page of results to return in the
-- response. If no token is provided, the default page is the first page.
--
-- Default value: @null@
--
-- 'startTimeInclusive', 'getDevicePositionHistory_startTimeInclusive' - Specify the start time for the position history in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@. By default, the value will be 24
-- hours prior to the time that the request is made.
--
-- Requirement:
--
-- -   The time specified for @StartTimeInclusive@ must be before
--     @EndTimeExclusive@.
--
-- 'deviceId', 'getDevicePositionHistory_deviceId' - The device whose position history you want to retrieve.
--
-- 'trackerName', 'getDevicePositionHistory_trackerName' - The tracker resource receiving the request for the device position
-- history.
newGetDevicePositionHistory ::
  -- | 'deviceId'
  Prelude.Text ->
  -- | 'trackerName'
  Prelude.Text ->
  GetDevicePositionHistory
newGetDevicePositionHistory :: Text -> Text -> GetDevicePositionHistory
newGetDevicePositionHistory Text
pDeviceId_ Text
pTrackerName_ =
  GetDevicePositionHistory'
    { $sel:endTimeExclusive:GetDevicePositionHistory' :: Maybe ISO8601
endTimeExclusive =
        forall a. Maybe a
Prelude.Nothing,
      $sel:maxResults:GetDevicePositionHistory' :: Maybe Natural
maxResults = forall a. Maybe a
Prelude.Nothing,
      $sel:nextToken:GetDevicePositionHistory' :: Maybe Text
nextToken = forall a. Maybe a
Prelude.Nothing,
      $sel:startTimeInclusive:GetDevicePositionHistory' :: Maybe ISO8601
startTimeInclusive = forall a. Maybe a
Prelude.Nothing,
      $sel:deviceId:GetDevicePositionHistory' :: Text
deviceId = Text
pDeviceId_,
      $sel:trackerName:GetDevicePositionHistory' :: Text
trackerName = Text
pTrackerName_
    }

-- | Specify the end time for the position history in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@. By default, the value will be the
-- time that the request is made.
--
-- Requirement:
--
-- -   The time specified for @EndTimeExclusive@ must be after the time for
--     @StartTimeInclusive@.
getDevicePositionHistory_endTimeExclusive :: Lens.Lens' GetDevicePositionHistory (Prelude.Maybe Prelude.UTCTime)
getDevicePositionHistory_endTimeExclusive :: Lens' GetDevicePositionHistory (Maybe UTCTime)
getDevicePositionHistory_endTimeExclusive = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDevicePositionHistory' {Maybe ISO8601
endTimeExclusive :: Maybe ISO8601
$sel:endTimeExclusive:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe ISO8601
endTimeExclusive} -> Maybe ISO8601
endTimeExclusive) (\s :: GetDevicePositionHistory
s@GetDevicePositionHistory' {} Maybe ISO8601
a -> GetDevicePositionHistory
s {$sel:endTimeExclusive:GetDevicePositionHistory' :: Maybe ISO8601
endTimeExclusive = Maybe ISO8601
a} :: GetDevicePositionHistory) 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

-- | An optional limit for the number of device positions returned in a
-- single call.
--
-- Default value: @100@
getDevicePositionHistory_maxResults :: Lens.Lens' GetDevicePositionHistory (Prelude.Maybe Prelude.Natural)
getDevicePositionHistory_maxResults :: Lens' GetDevicePositionHistory (Maybe Natural)
getDevicePositionHistory_maxResults = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDevicePositionHistory' {Maybe Natural
maxResults :: Maybe Natural
$sel:maxResults:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe Natural
maxResults} -> Maybe Natural
maxResults) (\s :: GetDevicePositionHistory
s@GetDevicePositionHistory' {} Maybe Natural
a -> GetDevicePositionHistory
s {$sel:maxResults:GetDevicePositionHistory' :: Maybe Natural
maxResults = Maybe Natural
a} :: GetDevicePositionHistory)

-- | The pagination token specifying which page of results to return in the
-- response. If no token is provided, the default page is the first page.
--
-- Default value: @null@
getDevicePositionHistory_nextToken :: Lens.Lens' GetDevicePositionHistory (Prelude.Maybe Prelude.Text)
getDevicePositionHistory_nextToken :: Lens' GetDevicePositionHistory (Maybe Text)
getDevicePositionHistory_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDevicePositionHistory' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetDevicePositionHistory
s@GetDevicePositionHistory' {} Maybe Text
a -> GetDevicePositionHistory
s {$sel:nextToken:GetDevicePositionHistory' :: Maybe Text
nextToken = Maybe Text
a} :: GetDevicePositionHistory)

-- | Specify the start time for the position history in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@. By default, the value will be 24
-- hours prior to the time that the request is made.
--
-- Requirement:
--
-- -   The time specified for @StartTimeInclusive@ must be before
--     @EndTimeExclusive@.
getDevicePositionHistory_startTimeInclusive :: Lens.Lens' GetDevicePositionHistory (Prelude.Maybe Prelude.UTCTime)
getDevicePositionHistory_startTimeInclusive :: Lens' GetDevicePositionHistory (Maybe UTCTime)
getDevicePositionHistory_startTimeInclusive = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDevicePositionHistory' {Maybe ISO8601
startTimeInclusive :: Maybe ISO8601
$sel:startTimeInclusive:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe ISO8601
startTimeInclusive} -> Maybe ISO8601
startTimeInclusive) (\s :: GetDevicePositionHistory
s@GetDevicePositionHistory' {} Maybe ISO8601
a -> GetDevicePositionHistory
s {$sel:startTimeInclusive:GetDevicePositionHistory' :: Maybe ISO8601
startTimeInclusive = Maybe ISO8601
a} :: GetDevicePositionHistory) 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 device whose position history you want to retrieve.
getDevicePositionHistory_deviceId :: Lens.Lens' GetDevicePositionHistory Prelude.Text
getDevicePositionHistory_deviceId :: Lens' GetDevicePositionHistory Text
getDevicePositionHistory_deviceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDevicePositionHistory' {Text
deviceId :: Text
$sel:deviceId:GetDevicePositionHistory' :: GetDevicePositionHistory -> Text
deviceId} -> Text
deviceId) (\s :: GetDevicePositionHistory
s@GetDevicePositionHistory' {} Text
a -> GetDevicePositionHistory
s {$sel:deviceId:GetDevicePositionHistory' :: Text
deviceId = Text
a} :: GetDevicePositionHistory)

-- | The tracker resource receiving the request for the device position
-- history.
getDevicePositionHistory_trackerName :: Lens.Lens' GetDevicePositionHistory Prelude.Text
getDevicePositionHistory_trackerName :: Lens' GetDevicePositionHistory Text
getDevicePositionHistory_trackerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDevicePositionHistory' {Text
trackerName :: Text
$sel:trackerName:GetDevicePositionHistory' :: GetDevicePositionHistory -> Text
trackerName} -> Text
trackerName) (\s :: GetDevicePositionHistory
s@GetDevicePositionHistory' {} Text
a -> GetDevicePositionHistory
s {$sel:trackerName:GetDevicePositionHistory' :: Text
trackerName = Text
a} :: GetDevicePositionHistory)

instance Core.AWSPager GetDevicePositionHistory where
  page :: GetDevicePositionHistory
-> AWSResponse GetDevicePositionHistory
-> Maybe GetDevicePositionHistory
page GetDevicePositionHistory
rq AWSResponse GetDevicePositionHistory
rs
    | forall a. AWSTruncated a => a -> Bool
Core.stop
        ( AWSResponse GetDevicePositionHistory
rs
            forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetDevicePositionHistoryResponse (Maybe Text)
getDevicePositionHistoryResponse_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 GetDevicePositionHistory
rs
            forall s a. s -> Getting a s a -> a
Lens.^. Lens' GetDevicePositionHistoryResponse [DevicePosition]
getDevicePositionHistoryResponse_devicePositions
        ) =
        forall a. Maybe a
Prelude.Nothing
    | Bool
Prelude.otherwise =
        forall a. a -> Maybe a
Prelude.Just
          forall a b. (a -> b) -> a -> b
Prelude.$ GetDevicePositionHistory
rq
          forall a b. a -> (a -> b) -> b
Prelude.& Lens' GetDevicePositionHistory (Maybe Text)
getDevicePositionHistory_nextToken
          forall s t a b. ASetter s t a b -> b -> s -> t
Lens..~ AWSResponse GetDevicePositionHistory
rs
          forall s a. s -> Getting (First a) s a -> Maybe a
Lens.^? Lens' GetDevicePositionHistoryResponse (Maybe Text)
getDevicePositionHistoryResponse_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 GetDevicePositionHistory where
  type
    AWSResponse GetDevicePositionHistory =
      GetDevicePositionHistoryResponse
  request :: (Service -> Service)
-> GetDevicePositionHistory -> Request GetDevicePositionHistory
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 GetDevicePositionHistory
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetDevicePositionHistory)))
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 -> [DevicePosition] -> GetDevicePositionHistoryResponse
GetDevicePositionHistoryResponse'
            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
"DevicePositions"
                            forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty
                        )
      )

instance Prelude.Hashable GetDevicePositionHistory where
  hashWithSalt :: Int -> GetDevicePositionHistory -> Int
hashWithSalt Int
_salt GetDevicePositionHistory' {Maybe Natural
Maybe Text
Maybe ISO8601
Text
trackerName :: Text
deviceId :: Text
startTimeInclusive :: Maybe ISO8601
nextToken :: Maybe Text
maxResults :: Maybe Natural
endTimeExclusive :: Maybe ISO8601
$sel:trackerName:GetDevicePositionHistory' :: GetDevicePositionHistory -> Text
$sel:deviceId:GetDevicePositionHistory' :: GetDevicePositionHistory -> Text
$sel:startTimeInclusive:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe ISO8601
$sel:nextToken:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe Text
$sel:maxResults:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe Natural
$sel:endTimeExclusive:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe ISO8601
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ISO8601
endTimeExclusive
      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 ISO8601
startTimeInclusive
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
deviceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
trackerName

instance Prelude.NFData GetDevicePositionHistory where
  rnf :: GetDevicePositionHistory -> ()
rnf GetDevicePositionHistory' {Maybe Natural
Maybe Text
Maybe ISO8601
Text
trackerName :: Text
deviceId :: Text
startTimeInclusive :: Maybe ISO8601
nextToken :: Maybe Text
maxResults :: Maybe Natural
endTimeExclusive :: Maybe ISO8601
$sel:trackerName:GetDevicePositionHistory' :: GetDevicePositionHistory -> Text
$sel:deviceId:GetDevicePositionHistory' :: GetDevicePositionHistory -> Text
$sel:startTimeInclusive:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe ISO8601
$sel:nextToken:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe Text
$sel:maxResults:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe Natural
$sel:endTimeExclusive:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe ISO8601
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ISO8601
endTimeExclusive
      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 ISO8601
startTimeInclusive
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
deviceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
trackerName

instance Data.ToHeaders GetDevicePositionHistory where
  toHeaders :: GetDevicePositionHistory -> 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 GetDevicePositionHistory where
  toJSON :: GetDevicePositionHistory -> Value
toJSON GetDevicePositionHistory' {Maybe Natural
Maybe Text
Maybe ISO8601
Text
trackerName :: Text
deviceId :: Text
startTimeInclusive :: Maybe ISO8601
nextToken :: Maybe Text
maxResults :: Maybe Natural
endTimeExclusive :: Maybe ISO8601
$sel:trackerName:GetDevicePositionHistory' :: GetDevicePositionHistory -> Text
$sel:deviceId:GetDevicePositionHistory' :: GetDevicePositionHistory -> Text
$sel:startTimeInclusive:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe ISO8601
$sel:nextToken:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe Text
$sel:maxResults:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe Natural
$sel:endTimeExclusive:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe ISO8601
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"EndTimeExclusive" 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 ISO8601
endTimeExclusive,
            (Key
"MaxResults" 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 Natural
maxResults,
            (Key
"NextToken" 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
nextToken,
            (Key
"StartTimeInclusive" 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 ISO8601
startTimeInclusive
          ]
      )

instance Data.ToPath GetDevicePositionHistory where
  toPath :: GetDevicePositionHistory -> ByteString
toPath GetDevicePositionHistory' {Maybe Natural
Maybe Text
Maybe ISO8601
Text
trackerName :: Text
deviceId :: Text
startTimeInclusive :: Maybe ISO8601
nextToken :: Maybe Text
maxResults :: Maybe Natural
endTimeExclusive :: Maybe ISO8601
$sel:trackerName:GetDevicePositionHistory' :: GetDevicePositionHistory -> Text
$sel:deviceId:GetDevicePositionHistory' :: GetDevicePositionHistory -> Text
$sel:startTimeInclusive:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe ISO8601
$sel:nextToken:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe Text
$sel:maxResults:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe Natural
$sel:endTimeExclusive:GetDevicePositionHistory' :: GetDevicePositionHistory -> Maybe ISO8601
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/tracking/v0/trackers/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
trackerName,
        ByteString
"/devices/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
deviceId,
        ByteString
"/list-positions"
      ]

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

-- | /See:/ 'newGetDevicePositionHistoryResponse' smart constructor.
data GetDevicePositionHistoryResponse = GetDevicePositionHistoryResponse'
  { -- | A pagination token indicating there are additional pages available. You
    -- can use the token in a following request to fetch the next set of
    -- results.
    GetDevicePositionHistoryResponse -> Maybe Text
nextToken :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetDevicePositionHistoryResponse -> Int
httpStatus :: Prelude.Int,
    -- | Contains the position history details for the requested device.
    GetDevicePositionHistoryResponse -> [DevicePosition]
devicePositions :: [DevicePosition]
  }
  deriving (GetDevicePositionHistoryResponse
-> GetDevicePositionHistoryResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetDevicePositionHistoryResponse
-> GetDevicePositionHistoryResponse -> Bool
$c/= :: GetDevicePositionHistoryResponse
-> GetDevicePositionHistoryResponse -> Bool
== :: GetDevicePositionHistoryResponse
-> GetDevicePositionHistoryResponse -> Bool
$c== :: GetDevicePositionHistoryResponse
-> GetDevicePositionHistoryResponse -> Bool
Prelude.Eq, Int -> GetDevicePositionHistoryResponse -> ShowS
[GetDevicePositionHistoryResponse] -> ShowS
GetDevicePositionHistoryResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetDevicePositionHistoryResponse] -> ShowS
$cshowList :: [GetDevicePositionHistoryResponse] -> ShowS
show :: GetDevicePositionHistoryResponse -> String
$cshow :: GetDevicePositionHistoryResponse -> String
showsPrec :: Int -> GetDevicePositionHistoryResponse -> ShowS
$cshowsPrec :: Int -> GetDevicePositionHistoryResponse -> ShowS
Prelude.Show, forall x.
Rep GetDevicePositionHistoryResponse x
-> GetDevicePositionHistoryResponse
forall x.
GetDevicePositionHistoryResponse
-> Rep GetDevicePositionHistoryResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetDevicePositionHistoryResponse x
-> GetDevicePositionHistoryResponse
$cfrom :: forall x.
GetDevicePositionHistoryResponse
-> Rep GetDevicePositionHistoryResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetDevicePositionHistoryResponse' 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', 'getDevicePositionHistoryResponse_nextToken' - A pagination token indicating there are additional pages available. You
-- can use the token in a following request to fetch the next set of
-- results.
--
-- 'httpStatus', 'getDevicePositionHistoryResponse_httpStatus' - The response's http status code.
--
-- 'devicePositions', 'getDevicePositionHistoryResponse_devicePositions' - Contains the position history details for the requested device.
newGetDevicePositionHistoryResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetDevicePositionHistoryResponse
newGetDevicePositionHistoryResponse :: Int -> GetDevicePositionHistoryResponse
newGetDevicePositionHistoryResponse Int
pHttpStatus_ =
  GetDevicePositionHistoryResponse'
    { $sel:nextToken:GetDevicePositionHistoryResponse' :: Maybe Text
nextToken =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetDevicePositionHistoryResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:devicePositions:GetDevicePositionHistoryResponse' :: [DevicePosition]
devicePositions = forall a. Monoid a => a
Prelude.mempty
    }

-- | A pagination token indicating there are additional pages available. You
-- can use the token in a following request to fetch the next set of
-- results.
getDevicePositionHistoryResponse_nextToken :: Lens.Lens' GetDevicePositionHistoryResponse (Prelude.Maybe Prelude.Text)
getDevicePositionHistoryResponse_nextToken :: Lens' GetDevicePositionHistoryResponse (Maybe Text)
getDevicePositionHistoryResponse_nextToken = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDevicePositionHistoryResponse' {Maybe Text
nextToken :: Maybe Text
$sel:nextToken:GetDevicePositionHistoryResponse' :: GetDevicePositionHistoryResponse -> Maybe Text
nextToken} -> Maybe Text
nextToken) (\s :: GetDevicePositionHistoryResponse
s@GetDevicePositionHistoryResponse' {} Maybe Text
a -> GetDevicePositionHistoryResponse
s {$sel:nextToken:GetDevicePositionHistoryResponse' :: Maybe Text
nextToken = Maybe Text
a} :: GetDevicePositionHistoryResponse)

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

-- | Contains the position history details for the requested device.
getDevicePositionHistoryResponse_devicePositions :: Lens.Lens' GetDevicePositionHistoryResponse [DevicePosition]
getDevicePositionHistoryResponse_devicePositions :: Lens' GetDevicePositionHistoryResponse [DevicePosition]
getDevicePositionHistoryResponse_devicePositions = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetDevicePositionHistoryResponse' {[DevicePosition]
devicePositions :: [DevicePosition]
$sel:devicePositions:GetDevicePositionHistoryResponse' :: GetDevicePositionHistoryResponse -> [DevicePosition]
devicePositions} -> [DevicePosition]
devicePositions) (\s :: GetDevicePositionHistoryResponse
s@GetDevicePositionHistoryResponse' {} [DevicePosition]
a -> GetDevicePositionHistoryResponse
s {$sel:devicePositions:GetDevicePositionHistoryResponse' :: [DevicePosition]
devicePositions = [DevicePosition]
a} :: GetDevicePositionHistoryResponse) 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
    GetDevicePositionHistoryResponse
  where
  rnf :: GetDevicePositionHistoryResponse -> ()
rnf GetDevicePositionHistoryResponse' {Int
[DevicePosition]
Maybe Text
devicePositions :: [DevicePosition]
httpStatus :: Int
nextToken :: Maybe Text
$sel:devicePositions:GetDevicePositionHistoryResponse' :: GetDevicePositionHistoryResponse -> [DevicePosition]
$sel:httpStatus:GetDevicePositionHistoryResponse' :: GetDevicePositionHistoryResponse -> Int
$sel:nextToken:GetDevicePositionHistoryResponse' :: GetDevicePositionHistoryResponse -> 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 [DevicePosition]
devicePositions