{-# 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.BatchUpdateDevicePosition
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Uploads position update data for one or more devices to a tracker
-- resource. Amazon Location uses the data when it reports the last known
-- device position and position history. Amazon Location retains location
-- data for 30 days.
--
-- Position updates are handled based on the @PositionFiltering@ property
-- of the tracker. When @PositionFiltering@ is set to @TimeBased@, updates
-- are evaluated against linked geofence collections, and location data is
-- stored at a maximum of one position per 30 second interval. If your
-- update frequency is more often than every 30 seconds, only one update
-- per 30 seconds is stored for each unique device ID.
--
-- When @PositionFiltering@ is set to @DistanceBased@ filtering, location
-- data is stored and evaluated against linked geofence collections only if
-- the device has moved more than 30 m (98.4 ft).
--
-- When @PositionFiltering@ is set to @AccuracyBased@ filtering, location
-- data is stored and evaluated against linked geofence collections only if
-- the device has moved more than the measured accuracy. For example, if
-- two consecutive updates from a device have a horizontal accuracy of 5 m
-- and 10 m, the second update is neither stored or evaluated if the device
-- has moved less than 15 m. If @PositionFiltering@ is set to
-- @AccuracyBased@ filtering, Amazon Location uses the default value
-- @{ \"Horizontal\": 0}@ when accuracy is not provided on a
-- @DevicePositionUpdate@.
module Amazonka.Location.BatchUpdateDevicePosition
  ( -- * Creating a Request
    BatchUpdateDevicePosition (..),
    newBatchUpdateDevicePosition,

    -- * Request Lenses
    batchUpdateDevicePosition_trackerName,
    batchUpdateDevicePosition_updates,

    -- * Destructuring the Response
    BatchUpdateDevicePositionResponse (..),
    newBatchUpdateDevicePositionResponse,

    -- * Response Lenses
    batchUpdateDevicePositionResponse_httpStatus,
    batchUpdateDevicePositionResponse_errors,
  )
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:/ 'newBatchUpdateDevicePosition' smart constructor.
data BatchUpdateDevicePosition = BatchUpdateDevicePosition'
  { -- | The name of the tracker resource to update.
    BatchUpdateDevicePosition -> Text
trackerName :: Prelude.Text,
    -- | Contains the position update details for each device.
    BatchUpdateDevicePosition -> NonEmpty DevicePositionUpdate
updates :: Prelude.NonEmpty DevicePositionUpdate
  }
  deriving (BatchUpdateDevicePosition -> BatchUpdateDevicePosition -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchUpdateDevicePosition -> BatchUpdateDevicePosition -> Bool
$c/= :: BatchUpdateDevicePosition -> BatchUpdateDevicePosition -> Bool
== :: BatchUpdateDevicePosition -> BatchUpdateDevicePosition -> Bool
$c== :: BatchUpdateDevicePosition -> BatchUpdateDevicePosition -> Bool
Prelude.Eq, Int -> BatchUpdateDevicePosition -> ShowS
[BatchUpdateDevicePosition] -> ShowS
BatchUpdateDevicePosition -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchUpdateDevicePosition] -> ShowS
$cshowList :: [BatchUpdateDevicePosition] -> ShowS
show :: BatchUpdateDevicePosition -> String
$cshow :: BatchUpdateDevicePosition -> String
showsPrec :: Int -> BatchUpdateDevicePosition -> ShowS
$cshowsPrec :: Int -> BatchUpdateDevicePosition -> ShowS
Prelude.Show, forall x.
Rep BatchUpdateDevicePosition x -> BatchUpdateDevicePosition
forall x.
BatchUpdateDevicePosition -> Rep BatchUpdateDevicePosition x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchUpdateDevicePosition x -> BatchUpdateDevicePosition
$cfrom :: forall x.
BatchUpdateDevicePosition -> Rep BatchUpdateDevicePosition x
Prelude.Generic)

-- |
-- Create a value of 'BatchUpdateDevicePosition' 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:
--
-- 'trackerName', 'batchUpdateDevicePosition_trackerName' - The name of the tracker resource to update.
--
-- 'updates', 'batchUpdateDevicePosition_updates' - Contains the position update details for each device.
newBatchUpdateDevicePosition ::
  -- | 'trackerName'
  Prelude.Text ->
  -- | 'updates'
  Prelude.NonEmpty DevicePositionUpdate ->
  BatchUpdateDevicePosition
newBatchUpdateDevicePosition :: Text -> NonEmpty DevicePositionUpdate -> BatchUpdateDevicePosition
newBatchUpdateDevicePosition Text
pTrackerName_ NonEmpty DevicePositionUpdate
pUpdates_ =
  BatchUpdateDevicePosition'
    { $sel:trackerName:BatchUpdateDevicePosition' :: Text
trackerName =
        Text
pTrackerName_,
      $sel:updates:BatchUpdateDevicePosition' :: NonEmpty DevicePositionUpdate
updates = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty DevicePositionUpdate
pUpdates_
    }

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

-- | Contains the position update details for each device.
batchUpdateDevicePosition_updates :: Lens.Lens' BatchUpdateDevicePosition (Prelude.NonEmpty DevicePositionUpdate)
batchUpdateDevicePosition_updates :: Lens' BatchUpdateDevicePosition (NonEmpty DevicePositionUpdate)
batchUpdateDevicePosition_updates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchUpdateDevicePosition' {NonEmpty DevicePositionUpdate
updates :: NonEmpty DevicePositionUpdate
$sel:updates:BatchUpdateDevicePosition' :: BatchUpdateDevicePosition -> NonEmpty DevicePositionUpdate
updates} -> NonEmpty DevicePositionUpdate
updates) (\s :: BatchUpdateDevicePosition
s@BatchUpdateDevicePosition' {} NonEmpty DevicePositionUpdate
a -> BatchUpdateDevicePosition
s {$sel:updates:BatchUpdateDevicePosition' :: NonEmpty DevicePositionUpdate
updates = NonEmpty DevicePositionUpdate
a} :: BatchUpdateDevicePosition) 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 Core.AWSRequest BatchUpdateDevicePosition where
  type
    AWSResponse BatchUpdateDevicePosition =
      BatchUpdateDevicePositionResponse
  request :: (Service -> Service)
-> BatchUpdateDevicePosition -> Request BatchUpdateDevicePosition
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 BatchUpdateDevicePosition
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchUpdateDevicePosition)))
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
-> [BatchUpdateDevicePositionError]
-> BatchUpdateDevicePositionResponse
BatchUpdateDevicePositionResponse'
            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 (Maybe a)
Data..?> Key
"Errors" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable BatchUpdateDevicePosition where
  hashWithSalt :: Int -> BatchUpdateDevicePosition -> Int
hashWithSalt Int
_salt BatchUpdateDevicePosition' {NonEmpty DevicePositionUpdate
Text
updates :: NonEmpty DevicePositionUpdate
trackerName :: Text
$sel:updates:BatchUpdateDevicePosition' :: BatchUpdateDevicePosition -> NonEmpty DevicePositionUpdate
$sel:trackerName:BatchUpdateDevicePosition' :: BatchUpdateDevicePosition -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
trackerName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty DevicePositionUpdate
updates

instance Prelude.NFData BatchUpdateDevicePosition where
  rnf :: BatchUpdateDevicePosition -> ()
rnf BatchUpdateDevicePosition' {NonEmpty DevicePositionUpdate
Text
updates :: NonEmpty DevicePositionUpdate
trackerName :: Text
$sel:updates:BatchUpdateDevicePosition' :: BatchUpdateDevicePosition -> NonEmpty DevicePositionUpdate
$sel:trackerName:BatchUpdateDevicePosition' :: BatchUpdateDevicePosition -> Text
..} =
    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 NonEmpty DevicePositionUpdate
updates

instance Data.ToHeaders BatchUpdateDevicePosition where
  toHeaders :: BatchUpdateDevicePosition -> 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 BatchUpdateDevicePosition where
  toJSON :: BatchUpdateDevicePosition -> Value
toJSON BatchUpdateDevicePosition' {NonEmpty DevicePositionUpdate
Text
updates :: NonEmpty DevicePositionUpdate
trackerName :: Text
$sel:updates:BatchUpdateDevicePosition' :: BatchUpdateDevicePosition -> NonEmpty DevicePositionUpdate
$sel:trackerName:BatchUpdateDevicePosition' :: BatchUpdateDevicePosition -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"Updates" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= NonEmpty DevicePositionUpdate
updates)]
      )

instance Data.ToPath BatchUpdateDevicePosition where
  toPath :: BatchUpdateDevicePosition -> ByteString
toPath BatchUpdateDevicePosition' {NonEmpty DevicePositionUpdate
Text
updates :: NonEmpty DevicePositionUpdate
trackerName :: Text
$sel:updates:BatchUpdateDevicePosition' :: BatchUpdateDevicePosition -> NonEmpty DevicePositionUpdate
$sel:trackerName:BatchUpdateDevicePosition' :: BatchUpdateDevicePosition -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/tracking/v0/trackers/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
trackerName,
        ByteString
"/positions"
      ]

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

-- | /See:/ 'newBatchUpdateDevicePositionResponse' smart constructor.
data BatchUpdateDevicePositionResponse = BatchUpdateDevicePositionResponse'
  { -- | The response's http status code.
    BatchUpdateDevicePositionResponse -> Int
httpStatus :: Prelude.Int,
    -- | Contains error details for each device that failed to update its
    -- position.
    BatchUpdateDevicePositionResponse
-> [BatchUpdateDevicePositionError]
errors :: [BatchUpdateDevicePositionError]
  }
  deriving (BatchUpdateDevicePositionResponse
-> BatchUpdateDevicePositionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchUpdateDevicePositionResponse
-> BatchUpdateDevicePositionResponse -> Bool
$c/= :: BatchUpdateDevicePositionResponse
-> BatchUpdateDevicePositionResponse -> Bool
== :: BatchUpdateDevicePositionResponse
-> BatchUpdateDevicePositionResponse -> Bool
$c== :: BatchUpdateDevicePositionResponse
-> BatchUpdateDevicePositionResponse -> Bool
Prelude.Eq, ReadPrec [BatchUpdateDevicePositionResponse]
ReadPrec BatchUpdateDevicePositionResponse
Int -> ReadS BatchUpdateDevicePositionResponse
ReadS [BatchUpdateDevicePositionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchUpdateDevicePositionResponse]
$creadListPrec :: ReadPrec [BatchUpdateDevicePositionResponse]
readPrec :: ReadPrec BatchUpdateDevicePositionResponse
$creadPrec :: ReadPrec BatchUpdateDevicePositionResponse
readList :: ReadS [BatchUpdateDevicePositionResponse]
$creadList :: ReadS [BatchUpdateDevicePositionResponse]
readsPrec :: Int -> ReadS BatchUpdateDevicePositionResponse
$creadsPrec :: Int -> ReadS BatchUpdateDevicePositionResponse
Prelude.Read, Int -> BatchUpdateDevicePositionResponse -> ShowS
[BatchUpdateDevicePositionResponse] -> ShowS
BatchUpdateDevicePositionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchUpdateDevicePositionResponse] -> ShowS
$cshowList :: [BatchUpdateDevicePositionResponse] -> ShowS
show :: BatchUpdateDevicePositionResponse -> String
$cshow :: BatchUpdateDevicePositionResponse -> String
showsPrec :: Int -> BatchUpdateDevicePositionResponse -> ShowS
$cshowsPrec :: Int -> BatchUpdateDevicePositionResponse -> ShowS
Prelude.Show, forall x.
Rep BatchUpdateDevicePositionResponse x
-> BatchUpdateDevicePositionResponse
forall x.
BatchUpdateDevicePositionResponse
-> Rep BatchUpdateDevicePositionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchUpdateDevicePositionResponse x
-> BatchUpdateDevicePositionResponse
$cfrom :: forall x.
BatchUpdateDevicePositionResponse
-> Rep BatchUpdateDevicePositionResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchUpdateDevicePositionResponse' 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', 'batchUpdateDevicePositionResponse_httpStatus' - The response's http status code.
--
-- 'errors', 'batchUpdateDevicePositionResponse_errors' - Contains error details for each device that failed to update its
-- position.
newBatchUpdateDevicePositionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchUpdateDevicePositionResponse
newBatchUpdateDevicePositionResponse :: Int -> BatchUpdateDevicePositionResponse
newBatchUpdateDevicePositionResponse Int
pHttpStatus_ =
  BatchUpdateDevicePositionResponse'
    { $sel:httpStatus:BatchUpdateDevicePositionResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:errors:BatchUpdateDevicePositionResponse' :: [BatchUpdateDevicePositionError]
errors = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | Contains error details for each device that failed to update its
-- position.
batchUpdateDevicePositionResponse_errors :: Lens.Lens' BatchUpdateDevicePositionResponse [BatchUpdateDevicePositionError]
batchUpdateDevicePositionResponse_errors :: Lens'
  BatchUpdateDevicePositionResponse [BatchUpdateDevicePositionError]
batchUpdateDevicePositionResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchUpdateDevicePositionResponse' {[BatchUpdateDevicePositionError]
errors :: [BatchUpdateDevicePositionError]
$sel:errors:BatchUpdateDevicePositionResponse' :: BatchUpdateDevicePositionResponse
-> [BatchUpdateDevicePositionError]
errors} -> [BatchUpdateDevicePositionError]
errors) (\s :: BatchUpdateDevicePositionResponse
s@BatchUpdateDevicePositionResponse' {} [BatchUpdateDevicePositionError]
a -> BatchUpdateDevicePositionResponse
s {$sel:errors:BatchUpdateDevicePositionResponse' :: [BatchUpdateDevicePositionError]
errors = [BatchUpdateDevicePositionError]
a} :: BatchUpdateDevicePositionResponse) 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
    BatchUpdateDevicePositionResponse
  where
  rnf :: BatchUpdateDevicePositionResponse -> ()
rnf BatchUpdateDevicePositionResponse' {Int
[BatchUpdateDevicePositionError]
errors :: [BatchUpdateDevicePositionError]
httpStatus :: Int
$sel:errors:BatchUpdateDevicePositionResponse' :: BatchUpdateDevicePositionResponse
-> [BatchUpdateDevicePositionError]
$sel:httpStatus:BatchUpdateDevicePositionResponse' :: BatchUpdateDevicePositionResponse -> 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 [BatchUpdateDevicePositionError]
errors