{-# 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.BatchEvaluateGeofences
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Evaluates device positions against the geofence geometries from a given
-- geofence collection.
--
-- This operation always returns an empty response because geofences are
-- asynchronously evaluated. The evaluation determines if the device has
-- entered or exited a geofenced area, and then publishes one of the
-- following events to Amazon EventBridge:
--
-- -   @ENTER@ if Amazon Location determines that the tracked device has
--     entered a geofenced area.
--
-- -   @EXIT@ if Amazon Location determines that the tracked device has
--     exited a geofenced area.
--
-- The last geofence that a device was observed within is tracked for 30
-- days after the most recent device position update.
--
-- Geofence evaluation uses the given device position. It does not account
-- for the optional @Accuracy@ of a @DevicePositionUpdate@.
--
-- The @DeviceID@ is used as a string to represent the device. You do not
-- need to have a @Tracker@ associated with the @DeviceID@.
module Amazonka.Location.BatchEvaluateGeofences
  ( -- * Creating a Request
    BatchEvaluateGeofences (..),
    newBatchEvaluateGeofences,

    -- * Request Lenses
    batchEvaluateGeofences_collectionName,
    batchEvaluateGeofences_devicePositionUpdates,

    -- * Destructuring the Response
    BatchEvaluateGeofencesResponse (..),
    newBatchEvaluateGeofencesResponse,

    -- * Response Lenses
    batchEvaluateGeofencesResponse_httpStatus,
    batchEvaluateGeofencesResponse_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:/ 'newBatchEvaluateGeofences' smart constructor.
data BatchEvaluateGeofences = BatchEvaluateGeofences'
  { -- | The geofence collection used in evaluating the position of devices
    -- against its geofences.
    BatchEvaluateGeofences -> Text
collectionName :: Prelude.Text,
    -- | Contains device details for each device to be evaluated against the
    -- given geofence collection.
    BatchEvaluateGeofences -> NonEmpty DevicePositionUpdate
devicePositionUpdates :: Prelude.NonEmpty DevicePositionUpdate
  }
  deriving (BatchEvaluateGeofences -> BatchEvaluateGeofences -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchEvaluateGeofences -> BatchEvaluateGeofences -> Bool
$c/= :: BatchEvaluateGeofences -> BatchEvaluateGeofences -> Bool
== :: BatchEvaluateGeofences -> BatchEvaluateGeofences -> Bool
$c== :: BatchEvaluateGeofences -> BatchEvaluateGeofences -> Bool
Prelude.Eq, Int -> BatchEvaluateGeofences -> ShowS
[BatchEvaluateGeofences] -> ShowS
BatchEvaluateGeofences -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchEvaluateGeofences] -> ShowS
$cshowList :: [BatchEvaluateGeofences] -> ShowS
show :: BatchEvaluateGeofences -> String
$cshow :: BatchEvaluateGeofences -> String
showsPrec :: Int -> BatchEvaluateGeofences -> ShowS
$cshowsPrec :: Int -> BatchEvaluateGeofences -> ShowS
Prelude.Show, forall x. Rep BatchEvaluateGeofences x -> BatchEvaluateGeofences
forall x. BatchEvaluateGeofences -> Rep BatchEvaluateGeofences x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchEvaluateGeofences x -> BatchEvaluateGeofences
$cfrom :: forall x. BatchEvaluateGeofences -> Rep BatchEvaluateGeofences x
Prelude.Generic)

-- |
-- Create a value of 'BatchEvaluateGeofences' 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:
--
-- 'collectionName', 'batchEvaluateGeofences_collectionName' - The geofence collection used in evaluating the position of devices
-- against its geofences.
--
-- 'devicePositionUpdates', 'batchEvaluateGeofences_devicePositionUpdates' - Contains device details for each device to be evaluated against the
-- given geofence collection.
newBatchEvaluateGeofences ::
  -- | 'collectionName'
  Prelude.Text ->
  -- | 'devicePositionUpdates'
  Prelude.NonEmpty DevicePositionUpdate ->
  BatchEvaluateGeofences
newBatchEvaluateGeofences :: Text -> NonEmpty DevicePositionUpdate -> BatchEvaluateGeofences
newBatchEvaluateGeofences
  Text
pCollectionName_
  NonEmpty DevicePositionUpdate
pDevicePositionUpdates_ =
    BatchEvaluateGeofences'
      { $sel:collectionName:BatchEvaluateGeofences' :: Text
collectionName =
          Text
pCollectionName_,
        $sel:devicePositionUpdates:BatchEvaluateGeofences' :: NonEmpty DevicePositionUpdate
devicePositionUpdates =
          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
pDevicePositionUpdates_
      }

-- | The geofence collection used in evaluating the position of devices
-- against its geofences.
batchEvaluateGeofences_collectionName :: Lens.Lens' BatchEvaluateGeofences Prelude.Text
batchEvaluateGeofences_collectionName :: Lens' BatchEvaluateGeofences Text
batchEvaluateGeofences_collectionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchEvaluateGeofences' {Text
collectionName :: Text
$sel:collectionName:BatchEvaluateGeofences' :: BatchEvaluateGeofences -> Text
collectionName} -> Text
collectionName) (\s :: BatchEvaluateGeofences
s@BatchEvaluateGeofences' {} Text
a -> BatchEvaluateGeofences
s {$sel:collectionName:BatchEvaluateGeofences' :: Text
collectionName = Text
a} :: BatchEvaluateGeofences)

-- | Contains device details for each device to be evaluated against the
-- given geofence collection.
batchEvaluateGeofences_devicePositionUpdates :: Lens.Lens' BatchEvaluateGeofences (Prelude.NonEmpty DevicePositionUpdate)
batchEvaluateGeofences_devicePositionUpdates :: Lens' BatchEvaluateGeofences (NonEmpty DevicePositionUpdate)
batchEvaluateGeofences_devicePositionUpdates = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchEvaluateGeofences' {NonEmpty DevicePositionUpdate
devicePositionUpdates :: NonEmpty DevicePositionUpdate
$sel:devicePositionUpdates:BatchEvaluateGeofences' :: BatchEvaluateGeofences -> NonEmpty DevicePositionUpdate
devicePositionUpdates} -> NonEmpty DevicePositionUpdate
devicePositionUpdates) (\s :: BatchEvaluateGeofences
s@BatchEvaluateGeofences' {} NonEmpty DevicePositionUpdate
a -> BatchEvaluateGeofences
s {$sel:devicePositionUpdates:BatchEvaluateGeofences' :: NonEmpty DevicePositionUpdate
devicePositionUpdates = NonEmpty DevicePositionUpdate
a} :: BatchEvaluateGeofences) 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 BatchEvaluateGeofences where
  type
    AWSResponse BatchEvaluateGeofences =
      BatchEvaluateGeofencesResponse
  request :: (Service -> Service)
-> BatchEvaluateGeofences -> Request BatchEvaluateGeofences
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 BatchEvaluateGeofences
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse BatchEvaluateGeofences)))
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
-> [BatchEvaluateGeofencesError] -> BatchEvaluateGeofencesResponse
BatchEvaluateGeofencesResponse'
            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 BatchEvaluateGeofences where
  hashWithSalt :: Int -> BatchEvaluateGeofences -> Int
hashWithSalt Int
_salt BatchEvaluateGeofences' {NonEmpty DevicePositionUpdate
Text
devicePositionUpdates :: NonEmpty DevicePositionUpdate
collectionName :: Text
$sel:devicePositionUpdates:BatchEvaluateGeofences' :: BatchEvaluateGeofences -> NonEmpty DevicePositionUpdate
$sel:collectionName:BatchEvaluateGeofences' :: BatchEvaluateGeofences -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
collectionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty DevicePositionUpdate
devicePositionUpdates

instance Prelude.NFData BatchEvaluateGeofences where
  rnf :: BatchEvaluateGeofences -> ()
rnf BatchEvaluateGeofences' {NonEmpty DevicePositionUpdate
Text
devicePositionUpdates :: NonEmpty DevicePositionUpdate
collectionName :: Text
$sel:devicePositionUpdates:BatchEvaluateGeofences' :: BatchEvaluateGeofences -> NonEmpty DevicePositionUpdate
$sel:collectionName:BatchEvaluateGeofences' :: BatchEvaluateGeofences -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
collectionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty DevicePositionUpdate
devicePositionUpdates

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

instance Data.ToPath BatchEvaluateGeofences where
  toPath :: BatchEvaluateGeofences -> ByteString
toPath BatchEvaluateGeofences' {NonEmpty DevicePositionUpdate
Text
devicePositionUpdates :: NonEmpty DevicePositionUpdate
collectionName :: Text
$sel:devicePositionUpdates:BatchEvaluateGeofences' :: BatchEvaluateGeofences -> NonEmpty DevicePositionUpdate
$sel:collectionName:BatchEvaluateGeofences' :: BatchEvaluateGeofences -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/geofencing/v0/collections/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
collectionName,
        ByteString
"/positions"
      ]

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

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

-- |
-- Create a value of 'BatchEvaluateGeofencesResponse' 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', 'batchEvaluateGeofencesResponse_httpStatus' - The response's http status code.
--
-- 'errors', 'batchEvaluateGeofencesResponse_errors' - Contains error details for each device that failed to evaluate its
-- position against the given geofence collection.
newBatchEvaluateGeofencesResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchEvaluateGeofencesResponse
newBatchEvaluateGeofencesResponse :: Int -> BatchEvaluateGeofencesResponse
newBatchEvaluateGeofencesResponse Int
pHttpStatus_ =
  BatchEvaluateGeofencesResponse'
    { $sel:httpStatus:BatchEvaluateGeofencesResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:errors:BatchEvaluateGeofencesResponse' :: [BatchEvaluateGeofencesError]
errors = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | Contains error details for each device that failed to evaluate its
-- position against the given geofence collection.
batchEvaluateGeofencesResponse_errors :: Lens.Lens' BatchEvaluateGeofencesResponse [BatchEvaluateGeofencesError]
batchEvaluateGeofencesResponse_errors :: Lens' BatchEvaluateGeofencesResponse [BatchEvaluateGeofencesError]
batchEvaluateGeofencesResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchEvaluateGeofencesResponse' {[BatchEvaluateGeofencesError]
errors :: [BatchEvaluateGeofencesError]
$sel:errors:BatchEvaluateGeofencesResponse' :: BatchEvaluateGeofencesResponse -> [BatchEvaluateGeofencesError]
errors} -> [BatchEvaluateGeofencesError]
errors) (\s :: BatchEvaluateGeofencesResponse
s@BatchEvaluateGeofencesResponse' {} [BatchEvaluateGeofencesError]
a -> BatchEvaluateGeofencesResponse
s {$sel:errors:BatchEvaluateGeofencesResponse' :: [BatchEvaluateGeofencesError]
errors = [BatchEvaluateGeofencesError]
a} :: BatchEvaluateGeofencesResponse) 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
    BatchEvaluateGeofencesResponse
  where
  rnf :: BatchEvaluateGeofencesResponse -> ()
rnf BatchEvaluateGeofencesResponse' {Int
[BatchEvaluateGeofencesError]
errors :: [BatchEvaluateGeofencesError]
httpStatus :: Int
$sel:errors:BatchEvaluateGeofencesResponse' :: BatchEvaluateGeofencesResponse -> [BatchEvaluateGeofencesError]
$sel:httpStatus:BatchEvaluateGeofencesResponse' :: BatchEvaluateGeofencesResponse -> 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 [BatchEvaluateGeofencesError]
errors