{-# 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.UpdateTracker
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Updates the specified properties of a given tracker resource.
module Amazonka.Location.UpdateTracker
  ( -- * Creating a Request
    UpdateTracker (..),
    newUpdateTracker,

    -- * Request Lenses
    updateTracker_description,
    updateTracker_positionFiltering,
    updateTracker_pricingPlan,
    updateTracker_pricingPlanDataSource,
    updateTracker_trackerName,

    -- * Destructuring the Response
    UpdateTrackerResponse (..),
    newUpdateTrackerResponse,

    -- * Response Lenses
    updateTrackerResponse_httpStatus,
    updateTrackerResponse_trackerArn,
    updateTrackerResponse_trackerName,
    updateTrackerResponse_updateTime,
  )
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:/ 'newUpdateTracker' smart constructor.
data UpdateTracker = UpdateTracker'
  { -- | Updates the description for the tracker resource.
    UpdateTracker -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | Updates the position filtering for the tracker resource.
    --
    -- Valid values:
    --
    -- -   @TimeBased@ - Location updates are evaluated against linked geofence
    --     collections, but not every location update is stored. If your update
    --     frequency is more often than 30 seconds, only one update per 30
    --     seconds is stored for each unique device ID.
    --
    -- -   @DistanceBased@ - If the device has moved less than 30 m (98.4 ft),
    --     location updates are ignored. Location updates within this distance
    --     are neither evaluated against linked geofence collections, nor
    --     stored. This helps control costs by reducing the number of geofence
    --     evaluations and historical device positions to paginate through.
    --     Distance-based filtering can also reduce the effects of GPS noise
    --     when displaying device trajectories on a map.
    --
    -- -   @AccuracyBased@ - If the device has moved less than the measured
    --     accuracy, location updates are ignored. For example, if two
    --     consecutive updates from a device have a horizontal accuracy of 5 m
    --     and 10 m, the second update is ignored if the device has moved less
    --     than 15 m. Ignored location updates are neither evaluated against
    --     linked geofence collections, nor stored. This helps educe the
    --     effects of GPS noise when displaying device trajectories on a map,
    --     and can help control costs by reducing the number of geofence
    --     evaluations.
    UpdateTracker -> Maybe PositionFiltering
positionFiltering :: Prelude.Maybe PositionFiltering,
    -- | No longer used. If included, the only allowed value is
    -- @RequestBasedUsage@.
    UpdateTracker -> Maybe PricingPlan
pricingPlan :: Prelude.Maybe PricingPlan,
    -- | This parameter is no longer used.
    UpdateTracker -> Maybe Text
pricingPlanDataSource :: Prelude.Maybe Prelude.Text,
    -- | The name of the tracker resource to update.
    UpdateTracker -> Text
trackerName :: Prelude.Text
  }
  deriving (UpdateTracker -> UpdateTracker -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTracker -> UpdateTracker -> Bool
$c/= :: UpdateTracker -> UpdateTracker -> Bool
== :: UpdateTracker -> UpdateTracker -> Bool
$c== :: UpdateTracker -> UpdateTracker -> Bool
Prelude.Eq, ReadPrec [UpdateTracker]
ReadPrec UpdateTracker
Int -> ReadS UpdateTracker
ReadS [UpdateTracker]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTracker]
$creadListPrec :: ReadPrec [UpdateTracker]
readPrec :: ReadPrec UpdateTracker
$creadPrec :: ReadPrec UpdateTracker
readList :: ReadS [UpdateTracker]
$creadList :: ReadS [UpdateTracker]
readsPrec :: Int -> ReadS UpdateTracker
$creadsPrec :: Int -> ReadS UpdateTracker
Prelude.Read, Int -> UpdateTracker -> ShowS
[UpdateTracker] -> ShowS
UpdateTracker -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTracker] -> ShowS
$cshowList :: [UpdateTracker] -> ShowS
show :: UpdateTracker -> String
$cshow :: UpdateTracker -> String
showsPrec :: Int -> UpdateTracker -> ShowS
$cshowsPrec :: Int -> UpdateTracker -> ShowS
Prelude.Show, forall x. Rep UpdateTracker x -> UpdateTracker
forall x. UpdateTracker -> Rep UpdateTracker x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTracker x -> UpdateTracker
$cfrom :: forall x. UpdateTracker -> Rep UpdateTracker x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTracker' 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:
--
-- 'description', 'updateTracker_description' - Updates the description for the tracker resource.
--
-- 'positionFiltering', 'updateTracker_positionFiltering' - Updates the position filtering for the tracker resource.
--
-- Valid values:
--
-- -   @TimeBased@ - Location updates are evaluated against linked geofence
--     collections, but not every location update is stored. If your update
--     frequency is more often than 30 seconds, only one update per 30
--     seconds is stored for each unique device ID.
--
-- -   @DistanceBased@ - If the device has moved less than 30 m (98.4 ft),
--     location updates are ignored. Location updates within this distance
--     are neither evaluated against linked geofence collections, nor
--     stored. This helps control costs by reducing the number of geofence
--     evaluations and historical device positions to paginate through.
--     Distance-based filtering can also reduce the effects of GPS noise
--     when displaying device trajectories on a map.
--
-- -   @AccuracyBased@ - If the device has moved less than the measured
--     accuracy, location updates are ignored. For example, if two
--     consecutive updates from a device have a horizontal accuracy of 5 m
--     and 10 m, the second update is ignored if the device has moved less
--     than 15 m. Ignored location updates are neither evaluated against
--     linked geofence collections, nor stored. This helps educe the
--     effects of GPS noise when displaying device trajectories on a map,
--     and can help control costs by reducing the number of geofence
--     evaluations.
--
-- 'pricingPlan', 'updateTracker_pricingPlan' - No longer used. If included, the only allowed value is
-- @RequestBasedUsage@.
--
-- 'pricingPlanDataSource', 'updateTracker_pricingPlanDataSource' - This parameter is no longer used.
--
-- 'trackerName', 'updateTracker_trackerName' - The name of the tracker resource to update.
newUpdateTracker ::
  -- | 'trackerName'
  Prelude.Text ->
  UpdateTracker
newUpdateTracker :: Text -> UpdateTracker
newUpdateTracker Text
pTrackerName_ =
  UpdateTracker'
    { $sel:description:UpdateTracker' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:positionFiltering:UpdateTracker' :: Maybe PositionFiltering
positionFiltering = forall a. Maybe a
Prelude.Nothing,
      $sel:pricingPlan:UpdateTracker' :: Maybe PricingPlan
pricingPlan = forall a. Maybe a
Prelude.Nothing,
      $sel:pricingPlanDataSource:UpdateTracker' :: Maybe Text
pricingPlanDataSource = forall a. Maybe a
Prelude.Nothing,
      $sel:trackerName:UpdateTracker' :: Text
trackerName = Text
pTrackerName_
    }

-- | Updates the description for the tracker resource.
updateTracker_description :: Lens.Lens' UpdateTracker (Prelude.Maybe Prelude.Text)
updateTracker_description :: Lens' UpdateTracker (Maybe Text)
updateTracker_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTracker' {Maybe Text
description :: Maybe Text
$sel:description:UpdateTracker' :: UpdateTracker -> Maybe Text
description} -> Maybe Text
description) (\s :: UpdateTracker
s@UpdateTracker' {} Maybe Text
a -> UpdateTracker
s {$sel:description:UpdateTracker' :: Maybe Text
description = Maybe Text
a} :: UpdateTracker)

-- | Updates the position filtering for the tracker resource.
--
-- Valid values:
--
-- -   @TimeBased@ - Location updates are evaluated against linked geofence
--     collections, but not every location update is stored. If your update
--     frequency is more often than 30 seconds, only one update per 30
--     seconds is stored for each unique device ID.
--
-- -   @DistanceBased@ - If the device has moved less than 30 m (98.4 ft),
--     location updates are ignored. Location updates within this distance
--     are neither evaluated against linked geofence collections, nor
--     stored. This helps control costs by reducing the number of geofence
--     evaluations and historical device positions to paginate through.
--     Distance-based filtering can also reduce the effects of GPS noise
--     when displaying device trajectories on a map.
--
-- -   @AccuracyBased@ - If the device has moved less than the measured
--     accuracy, location updates are ignored. For example, if two
--     consecutive updates from a device have a horizontal accuracy of 5 m
--     and 10 m, the second update is ignored if the device has moved less
--     than 15 m. Ignored location updates are neither evaluated against
--     linked geofence collections, nor stored. This helps educe the
--     effects of GPS noise when displaying device trajectories on a map,
--     and can help control costs by reducing the number of geofence
--     evaluations.
updateTracker_positionFiltering :: Lens.Lens' UpdateTracker (Prelude.Maybe PositionFiltering)
updateTracker_positionFiltering :: Lens' UpdateTracker (Maybe PositionFiltering)
updateTracker_positionFiltering = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTracker' {Maybe PositionFiltering
positionFiltering :: Maybe PositionFiltering
$sel:positionFiltering:UpdateTracker' :: UpdateTracker -> Maybe PositionFiltering
positionFiltering} -> Maybe PositionFiltering
positionFiltering) (\s :: UpdateTracker
s@UpdateTracker' {} Maybe PositionFiltering
a -> UpdateTracker
s {$sel:positionFiltering:UpdateTracker' :: Maybe PositionFiltering
positionFiltering = Maybe PositionFiltering
a} :: UpdateTracker)

-- | No longer used. If included, the only allowed value is
-- @RequestBasedUsage@.
updateTracker_pricingPlan :: Lens.Lens' UpdateTracker (Prelude.Maybe PricingPlan)
updateTracker_pricingPlan :: Lens' UpdateTracker (Maybe PricingPlan)
updateTracker_pricingPlan = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTracker' {Maybe PricingPlan
pricingPlan :: Maybe PricingPlan
$sel:pricingPlan:UpdateTracker' :: UpdateTracker -> Maybe PricingPlan
pricingPlan} -> Maybe PricingPlan
pricingPlan) (\s :: UpdateTracker
s@UpdateTracker' {} Maybe PricingPlan
a -> UpdateTracker
s {$sel:pricingPlan:UpdateTracker' :: Maybe PricingPlan
pricingPlan = Maybe PricingPlan
a} :: UpdateTracker)

-- | This parameter is no longer used.
updateTracker_pricingPlanDataSource :: Lens.Lens' UpdateTracker (Prelude.Maybe Prelude.Text)
updateTracker_pricingPlanDataSource :: Lens' UpdateTracker (Maybe Text)
updateTracker_pricingPlanDataSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTracker' {Maybe Text
pricingPlanDataSource :: Maybe Text
$sel:pricingPlanDataSource:UpdateTracker' :: UpdateTracker -> Maybe Text
pricingPlanDataSource} -> Maybe Text
pricingPlanDataSource) (\s :: UpdateTracker
s@UpdateTracker' {} Maybe Text
a -> UpdateTracker
s {$sel:pricingPlanDataSource:UpdateTracker' :: Maybe Text
pricingPlanDataSource = Maybe Text
a} :: UpdateTracker)

-- | The name of the tracker resource to update.
updateTracker_trackerName :: Lens.Lens' UpdateTracker Prelude.Text
updateTracker_trackerName :: Lens' UpdateTracker Text
updateTracker_trackerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTracker' {Text
trackerName :: Text
$sel:trackerName:UpdateTracker' :: UpdateTracker -> Text
trackerName} -> Text
trackerName) (\s :: UpdateTracker
s@UpdateTracker' {} Text
a -> UpdateTracker
s {$sel:trackerName:UpdateTracker' :: Text
trackerName = Text
a} :: UpdateTracker)

instance Core.AWSRequest UpdateTracker where
  type
    AWSResponse UpdateTracker =
      UpdateTrackerResponse
  request :: (Service -> Service) -> UpdateTracker -> Request UpdateTracker
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.patchJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy UpdateTracker
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse UpdateTracker)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Int -> Text -> Text -> ISO8601 -> UpdateTrackerResponse
UpdateTrackerResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"TrackerArn")
            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
"TrackerName")
            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
"UpdateTime")
      )

instance Prelude.Hashable UpdateTracker where
  hashWithSalt :: Int -> UpdateTracker -> Int
hashWithSalt Int
_salt UpdateTracker' {Maybe Text
Maybe PositionFiltering
Maybe PricingPlan
Text
trackerName :: Text
pricingPlanDataSource :: Maybe Text
pricingPlan :: Maybe PricingPlan
positionFiltering :: Maybe PositionFiltering
description :: Maybe Text
$sel:trackerName:UpdateTracker' :: UpdateTracker -> Text
$sel:pricingPlanDataSource:UpdateTracker' :: UpdateTracker -> Maybe Text
$sel:pricingPlan:UpdateTracker' :: UpdateTracker -> Maybe PricingPlan
$sel:positionFiltering:UpdateTracker' :: UpdateTracker -> Maybe PositionFiltering
$sel:description:UpdateTracker' :: UpdateTracker -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PositionFiltering
positionFiltering
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PricingPlan
pricingPlan
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
pricingPlanDataSource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
trackerName

instance Prelude.NFData UpdateTracker where
  rnf :: UpdateTracker -> ()
rnf UpdateTracker' {Maybe Text
Maybe PositionFiltering
Maybe PricingPlan
Text
trackerName :: Text
pricingPlanDataSource :: Maybe Text
pricingPlan :: Maybe PricingPlan
positionFiltering :: Maybe PositionFiltering
description :: Maybe Text
$sel:trackerName:UpdateTracker' :: UpdateTracker -> Text
$sel:pricingPlanDataSource:UpdateTracker' :: UpdateTracker -> Maybe Text
$sel:pricingPlan:UpdateTracker' :: UpdateTracker -> Maybe PricingPlan
$sel:positionFiltering:UpdateTracker' :: UpdateTracker -> Maybe PositionFiltering
$sel:description:UpdateTracker' :: UpdateTracker -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PositionFiltering
positionFiltering
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PricingPlan
pricingPlan
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pricingPlanDataSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
trackerName

instance Data.ToHeaders UpdateTracker where
  toHeaders :: UpdateTracker -> 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 UpdateTracker where
  toJSON :: UpdateTracker -> Value
toJSON UpdateTracker' {Maybe Text
Maybe PositionFiltering
Maybe PricingPlan
Text
trackerName :: Text
pricingPlanDataSource :: Maybe Text
pricingPlan :: Maybe PricingPlan
positionFiltering :: Maybe PositionFiltering
description :: Maybe Text
$sel:trackerName:UpdateTracker' :: UpdateTracker -> Text
$sel:pricingPlanDataSource:UpdateTracker' :: UpdateTracker -> Maybe Text
$sel:pricingPlan:UpdateTracker' :: UpdateTracker -> Maybe PricingPlan
$sel:positionFiltering:UpdateTracker' :: UpdateTracker -> Maybe PositionFiltering
$sel:description:UpdateTracker' :: UpdateTracker -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"Description" 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
description,
            (Key
"PositionFiltering" 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 PositionFiltering
positionFiltering,
            (Key
"PricingPlan" 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 PricingPlan
pricingPlan,
            (Key
"PricingPlanDataSource" 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
pricingPlanDataSource
          ]
      )

instance Data.ToPath UpdateTracker where
  toPath :: UpdateTracker -> ByteString
toPath UpdateTracker' {Maybe Text
Maybe PositionFiltering
Maybe PricingPlan
Text
trackerName :: Text
pricingPlanDataSource :: Maybe Text
pricingPlan :: Maybe PricingPlan
positionFiltering :: Maybe PositionFiltering
description :: Maybe Text
$sel:trackerName:UpdateTracker' :: UpdateTracker -> Text
$sel:pricingPlanDataSource:UpdateTracker' :: UpdateTracker -> Maybe Text
$sel:pricingPlan:UpdateTracker' :: UpdateTracker -> Maybe PricingPlan
$sel:positionFiltering:UpdateTracker' :: UpdateTracker -> Maybe PositionFiltering
$sel:description:UpdateTracker' :: UpdateTracker -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ByteString
"/tracking/v0/trackers/", forall a. ToByteString a => a -> ByteString
Data.toBS Text
trackerName]

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

-- | /See:/ 'newUpdateTrackerResponse' smart constructor.
data UpdateTrackerResponse = UpdateTrackerResponse'
  { -- | The response's http status code.
    UpdateTrackerResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) of the updated tracker resource. Used to
    -- specify a resource across AWS.
    --
    -- -   Format example:
    --     @arn:aws:geo:region:account-id:tracker\/ExampleTracker@
    UpdateTrackerResponse -> Text
trackerArn :: Prelude.Text,
    -- | The name of the updated tracker resource.
    UpdateTrackerResponse -> Text
trackerName :: Prelude.Text,
    -- | The timestamp for when the tracker resource was last updated in
    -- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
    -- format: @YYYY-MM-DDThh:mm:ss.sssZ@.
    UpdateTrackerResponse -> ISO8601
updateTime :: Data.ISO8601
  }
  deriving (UpdateTrackerResponse -> UpdateTrackerResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: UpdateTrackerResponse -> UpdateTrackerResponse -> Bool
$c/= :: UpdateTrackerResponse -> UpdateTrackerResponse -> Bool
== :: UpdateTrackerResponse -> UpdateTrackerResponse -> Bool
$c== :: UpdateTrackerResponse -> UpdateTrackerResponse -> Bool
Prelude.Eq, ReadPrec [UpdateTrackerResponse]
ReadPrec UpdateTrackerResponse
Int -> ReadS UpdateTrackerResponse
ReadS [UpdateTrackerResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [UpdateTrackerResponse]
$creadListPrec :: ReadPrec [UpdateTrackerResponse]
readPrec :: ReadPrec UpdateTrackerResponse
$creadPrec :: ReadPrec UpdateTrackerResponse
readList :: ReadS [UpdateTrackerResponse]
$creadList :: ReadS [UpdateTrackerResponse]
readsPrec :: Int -> ReadS UpdateTrackerResponse
$creadsPrec :: Int -> ReadS UpdateTrackerResponse
Prelude.Read, Int -> UpdateTrackerResponse -> ShowS
[UpdateTrackerResponse] -> ShowS
UpdateTrackerResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [UpdateTrackerResponse] -> ShowS
$cshowList :: [UpdateTrackerResponse] -> ShowS
show :: UpdateTrackerResponse -> String
$cshow :: UpdateTrackerResponse -> String
showsPrec :: Int -> UpdateTrackerResponse -> ShowS
$cshowsPrec :: Int -> UpdateTrackerResponse -> ShowS
Prelude.Show, forall x. Rep UpdateTrackerResponse x -> UpdateTrackerResponse
forall x. UpdateTrackerResponse -> Rep UpdateTrackerResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep UpdateTrackerResponse x -> UpdateTrackerResponse
$cfrom :: forall x. UpdateTrackerResponse -> Rep UpdateTrackerResponse x
Prelude.Generic)

-- |
-- Create a value of 'UpdateTrackerResponse' with all optional fields omitted.
--
-- Use <https://hackage.haskell.org/package/generic-lens generic-lens> or <https://hackage.haskell.org/package/optics optics> to modify other optional fields.
--
-- The following record fields are available, with the corresponding lenses provided
-- for backwards compatibility:
--
-- 'httpStatus', 'updateTrackerResponse_httpStatus' - The response's http status code.
--
-- 'trackerArn', 'updateTrackerResponse_trackerArn' - The Amazon Resource Name (ARN) of the updated tracker resource. Used to
-- specify a resource across AWS.
--
-- -   Format example:
--     @arn:aws:geo:region:account-id:tracker\/ExampleTracker@
--
-- 'trackerName', 'updateTrackerResponse_trackerName' - The name of the updated tracker resource.
--
-- 'updateTime', 'updateTrackerResponse_updateTime' - The timestamp for when the tracker resource was last updated in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@.
newUpdateTrackerResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'trackerArn'
  Prelude.Text ->
  -- | 'trackerName'
  Prelude.Text ->
  -- | 'updateTime'
  Prelude.UTCTime ->
  UpdateTrackerResponse
newUpdateTrackerResponse :: Int -> Text -> Text -> UTCTime -> UpdateTrackerResponse
newUpdateTrackerResponse
  Int
pHttpStatus_
  Text
pTrackerArn_
  Text
pTrackerName_
  UTCTime
pUpdateTime_ =
    UpdateTrackerResponse'
      { $sel:httpStatus:UpdateTrackerResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:trackerArn:UpdateTrackerResponse' :: Text
trackerArn = Text
pTrackerArn_,
        $sel:trackerName:UpdateTrackerResponse' :: Text
trackerName = Text
pTrackerName_,
        $sel:updateTime:UpdateTrackerResponse' :: ISO8601
updateTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdateTime_
      }

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

-- | The Amazon Resource Name (ARN) of the updated tracker resource. Used to
-- specify a resource across AWS.
--
-- -   Format example:
--     @arn:aws:geo:region:account-id:tracker\/ExampleTracker@
updateTrackerResponse_trackerArn :: Lens.Lens' UpdateTrackerResponse Prelude.Text
updateTrackerResponse_trackerArn :: Lens' UpdateTrackerResponse Text
updateTrackerResponse_trackerArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTrackerResponse' {Text
trackerArn :: Text
$sel:trackerArn:UpdateTrackerResponse' :: UpdateTrackerResponse -> Text
trackerArn} -> Text
trackerArn) (\s :: UpdateTrackerResponse
s@UpdateTrackerResponse' {} Text
a -> UpdateTrackerResponse
s {$sel:trackerArn:UpdateTrackerResponse' :: Text
trackerArn = Text
a} :: UpdateTrackerResponse)

-- | The name of the updated tracker resource.
updateTrackerResponse_trackerName :: Lens.Lens' UpdateTrackerResponse Prelude.Text
updateTrackerResponse_trackerName :: Lens' UpdateTrackerResponse Text
updateTrackerResponse_trackerName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTrackerResponse' {Text
trackerName :: Text
$sel:trackerName:UpdateTrackerResponse' :: UpdateTrackerResponse -> Text
trackerName} -> Text
trackerName) (\s :: UpdateTrackerResponse
s@UpdateTrackerResponse' {} Text
a -> UpdateTrackerResponse
s {$sel:trackerName:UpdateTrackerResponse' :: Text
trackerName = Text
a} :: UpdateTrackerResponse)

-- | The timestamp for when the tracker resource was last updated in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@.
updateTrackerResponse_updateTime :: Lens.Lens' UpdateTrackerResponse Prelude.UTCTime
updateTrackerResponse_updateTime :: Lens' UpdateTrackerResponse UTCTime
updateTrackerResponse_updateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\UpdateTrackerResponse' {ISO8601
updateTime :: ISO8601
$sel:updateTime:UpdateTrackerResponse' :: UpdateTrackerResponse -> ISO8601
updateTime} -> ISO8601
updateTime) (\s :: UpdateTrackerResponse
s@UpdateTrackerResponse' {} ISO8601
a -> UpdateTrackerResponse
s {$sel:updateTime:UpdateTrackerResponse' :: ISO8601
updateTime = ISO8601
a} :: UpdateTrackerResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Prelude.NFData UpdateTrackerResponse where
  rnf :: UpdateTrackerResponse -> ()
rnf UpdateTrackerResponse' {Int
Text
ISO8601
updateTime :: ISO8601
trackerName :: Text
trackerArn :: Text
httpStatus :: Int
$sel:updateTime:UpdateTrackerResponse' :: UpdateTrackerResponse -> ISO8601
$sel:trackerName:UpdateTrackerResponse' :: UpdateTrackerResponse -> Text
$sel:trackerArn:UpdateTrackerResponse' :: UpdateTrackerResponse -> Text
$sel:httpStatus:UpdateTrackerResponse' :: UpdateTrackerResponse -> Int
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
trackerArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
trackerName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
updateTime