{-# 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.BatchPutGeofence
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- A batch request for storing geofence geometries into a given geofence
-- collection, or updates the geometry of an existing geofence if a
-- geofence ID is included in the request.
module Amazonka.Location.BatchPutGeofence
  ( -- * Creating a Request
    BatchPutGeofence (..),
    newBatchPutGeofence,

    -- * Request Lenses
    batchPutGeofence_collectionName,
    batchPutGeofence_entries,

    -- * Destructuring the Response
    BatchPutGeofenceResponse (..),
    newBatchPutGeofenceResponse,

    -- * Response Lenses
    batchPutGeofenceResponse_httpStatus,
    batchPutGeofenceResponse_errors,
    batchPutGeofenceResponse_successes,
  )
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:/ 'newBatchPutGeofence' smart constructor.
data BatchPutGeofence = BatchPutGeofence'
  { -- | The geofence collection storing the geofences.
    BatchPutGeofence -> Text
collectionName :: Prelude.Text,
    -- | The batch of geofences to be stored in a geofence collection.
    BatchPutGeofence -> NonEmpty BatchPutGeofenceRequestEntry
entries :: Prelude.NonEmpty BatchPutGeofenceRequestEntry
  }
  deriving (BatchPutGeofence -> BatchPutGeofence -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchPutGeofence -> BatchPutGeofence -> Bool
$c/= :: BatchPutGeofence -> BatchPutGeofence -> Bool
== :: BatchPutGeofence -> BatchPutGeofence -> Bool
$c== :: BatchPutGeofence -> BatchPutGeofence -> Bool
Prelude.Eq, Int -> BatchPutGeofence -> ShowS
[BatchPutGeofence] -> ShowS
BatchPutGeofence -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchPutGeofence] -> ShowS
$cshowList :: [BatchPutGeofence] -> ShowS
show :: BatchPutGeofence -> String
$cshow :: BatchPutGeofence -> String
showsPrec :: Int -> BatchPutGeofence -> ShowS
$cshowsPrec :: Int -> BatchPutGeofence -> ShowS
Prelude.Show, forall x. Rep BatchPutGeofence x -> BatchPutGeofence
forall x. BatchPutGeofence -> Rep BatchPutGeofence x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep BatchPutGeofence x -> BatchPutGeofence
$cfrom :: forall x. BatchPutGeofence -> Rep BatchPutGeofence x
Prelude.Generic)

-- |
-- Create a value of 'BatchPutGeofence' 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', 'batchPutGeofence_collectionName' - The geofence collection storing the geofences.
--
-- 'entries', 'batchPutGeofence_entries' - The batch of geofences to be stored in a geofence collection.
newBatchPutGeofence ::
  -- | 'collectionName'
  Prelude.Text ->
  -- | 'entries'
  Prelude.NonEmpty BatchPutGeofenceRequestEntry ->
  BatchPutGeofence
newBatchPutGeofence :: Text -> NonEmpty BatchPutGeofenceRequestEntry -> BatchPutGeofence
newBatchPutGeofence Text
pCollectionName_ NonEmpty BatchPutGeofenceRequestEntry
pEntries_ =
  BatchPutGeofence'
    { $sel:collectionName:BatchPutGeofence' :: Text
collectionName =
        Text
pCollectionName_,
      $sel:entries:BatchPutGeofence' :: NonEmpty BatchPutGeofenceRequestEntry
entries = 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 BatchPutGeofenceRequestEntry
pEntries_
    }

-- | The geofence collection storing the geofences.
batchPutGeofence_collectionName :: Lens.Lens' BatchPutGeofence Prelude.Text
batchPutGeofence_collectionName :: Lens' BatchPutGeofence Text
batchPutGeofence_collectionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutGeofence' {Text
collectionName :: Text
$sel:collectionName:BatchPutGeofence' :: BatchPutGeofence -> Text
collectionName} -> Text
collectionName) (\s :: BatchPutGeofence
s@BatchPutGeofence' {} Text
a -> BatchPutGeofence
s {$sel:collectionName:BatchPutGeofence' :: Text
collectionName = Text
a} :: BatchPutGeofence)

-- | The batch of geofences to be stored in a geofence collection.
batchPutGeofence_entries :: Lens.Lens' BatchPutGeofence (Prelude.NonEmpty BatchPutGeofenceRequestEntry)
batchPutGeofence_entries :: Lens' BatchPutGeofence (NonEmpty BatchPutGeofenceRequestEntry)
batchPutGeofence_entries = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutGeofence' {NonEmpty BatchPutGeofenceRequestEntry
entries :: NonEmpty BatchPutGeofenceRequestEntry
$sel:entries:BatchPutGeofence' :: BatchPutGeofence -> NonEmpty BatchPutGeofenceRequestEntry
entries} -> NonEmpty BatchPutGeofenceRequestEntry
entries) (\s :: BatchPutGeofence
s@BatchPutGeofence' {} NonEmpty BatchPutGeofenceRequestEntry
a -> BatchPutGeofence
s {$sel:entries:BatchPutGeofence' :: NonEmpty BatchPutGeofenceRequestEntry
entries = NonEmpty BatchPutGeofenceRequestEntry
a} :: BatchPutGeofence) 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 BatchPutGeofence where
  type
    AWSResponse BatchPutGeofence =
      BatchPutGeofenceResponse
  request :: (Service -> Service)
-> BatchPutGeofence -> Request BatchPutGeofence
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 BatchPutGeofence
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse BatchPutGeofence)))
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
-> [BatchPutGeofenceError]
-> [BatchPutGeofenceSuccess]
-> BatchPutGeofenceResponse
BatchPutGeofenceResponse'
            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)
            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
"Successes" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable BatchPutGeofence where
  hashWithSalt :: Int -> BatchPutGeofence -> Int
hashWithSalt Int
_salt BatchPutGeofence' {NonEmpty BatchPutGeofenceRequestEntry
Text
entries :: NonEmpty BatchPutGeofenceRequestEntry
collectionName :: Text
$sel:entries:BatchPutGeofence' :: BatchPutGeofence -> NonEmpty BatchPutGeofenceRequestEntry
$sel:collectionName:BatchPutGeofence' :: BatchPutGeofence -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
collectionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty BatchPutGeofenceRequestEntry
entries

instance Prelude.NFData BatchPutGeofence where
  rnf :: BatchPutGeofence -> ()
rnf BatchPutGeofence' {NonEmpty BatchPutGeofenceRequestEntry
Text
entries :: NonEmpty BatchPutGeofenceRequestEntry
collectionName :: Text
$sel:entries:BatchPutGeofence' :: BatchPutGeofence -> NonEmpty BatchPutGeofenceRequestEntry
$sel:collectionName:BatchPutGeofence' :: BatchPutGeofence -> 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 BatchPutGeofenceRequestEntry
entries

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

instance Data.ToPath BatchPutGeofence where
  toPath :: BatchPutGeofence -> ByteString
toPath BatchPutGeofence' {NonEmpty BatchPutGeofenceRequestEntry
Text
entries :: NonEmpty BatchPutGeofenceRequestEntry
collectionName :: Text
$sel:entries:BatchPutGeofence' :: BatchPutGeofence -> NonEmpty BatchPutGeofenceRequestEntry
$sel:collectionName:BatchPutGeofence' :: BatchPutGeofence -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/geofencing/v0/collections/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
collectionName,
        ByteString
"/put-geofences"
      ]

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

-- | /See:/ 'newBatchPutGeofenceResponse' smart constructor.
data BatchPutGeofenceResponse = BatchPutGeofenceResponse'
  { -- | The response's http status code.
    BatchPutGeofenceResponse -> Int
httpStatus :: Prelude.Int,
    -- | Contains additional error details for each geofence that failed to be
    -- stored in a geofence collection.
    BatchPutGeofenceResponse -> [BatchPutGeofenceError]
errors :: [BatchPutGeofenceError],
    -- | Contains each geofence that was successfully stored in a geofence
    -- collection.
    BatchPutGeofenceResponse -> [BatchPutGeofenceSuccess]
successes :: [BatchPutGeofenceSuccess]
  }
  deriving (BatchPutGeofenceResponse -> BatchPutGeofenceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: BatchPutGeofenceResponse -> BatchPutGeofenceResponse -> Bool
$c/= :: BatchPutGeofenceResponse -> BatchPutGeofenceResponse -> Bool
== :: BatchPutGeofenceResponse -> BatchPutGeofenceResponse -> Bool
$c== :: BatchPutGeofenceResponse -> BatchPutGeofenceResponse -> Bool
Prelude.Eq, ReadPrec [BatchPutGeofenceResponse]
ReadPrec BatchPutGeofenceResponse
Int -> ReadS BatchPutGeofenceResponse
ReadS [BatchPutGeofenceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [BatchPutGeofenceResponse]
$creadListPrec :: ReadPrec [BatchPutGeofenceResponse]
readPrec :: ReadPrec BatchPutGeofenceResponse
$creadPrec :: ReadPrec BatchPutGeofenceResponse
readList :: ReadS [BatchPutGeofenceResponse]
$creadList :: ReadS [BatchPutGeofenceResponse]
readsPrec :: Int -> ReadS BatchPutGeofenceResponse
$creadsPrec :: Int -> ReadS BatchPutGeofenceResponse
Prelude.Read, Int -> BatchPutGeofenceResponse -> ShowS
[BatchPutGeofenceResponse] -> ShowS
BatchPutGeofenceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [BatchPutGeofenceResponse] -> ShowS
$cshowList :: [BatchPutGeofenceResponse] -> ShowS
show :: BatchPutGeofenceResponse -> String
$cshow :: BatchPutGeofenceResponse -> String
showsPrec :: Int -> BatchPutGeofenceResponse -> ShowS
$cshowsPrec :: Int -> BatchPutGeofenceResponse -> ShowS
Prelude.Show, forall x.
Rep BatchPutGeofenceResponse x -> BatchPutGeofenceResponse
forall x.
BatchPutGeofenceResponse -> Rep BatchPutGeofenceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep BatchPutGeofenceResponse x -> BatchPutGeofenceResponse
$cfrom :: forall x.
BatchPutGeofenceResponse -> Rep BatchPutGeofenceResponse x
Prelude.Generic)

-- |
-- Create a value of 'BatchPutGeofenceResponse' 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', 'batchPutGeofenceResponse_httpStatus' - The response's http status code.
--
-- 'errors', 'batchPutGeofenceResponse_errors' - Contains additional error details for each geofence that failed to be
-- stored in a geofence collection.
--
-- 'successes', 'batchPutGeofenceResponse_successes' - Contains each geofence that was successfully stored in a geofence
-- collection.
newBatchPutGeofenceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  BatchPutGeofenceResponse
newBatchPutGeofenceResponse :: Int -> BatchPutGeofenceResponse
newBatchPutGeofenceResponse Int
pHttpStatus_ =
  BatchPutGeofenceResponse'
    { $sel:httpStatus:BatchPutGeofenceResponse' :: Int
httpStatus =
        Int
pHttpStatus_,
      $sel:errors:BatchPutGeofenceResponse' :: [BatchPutGeofenceError]
errors = forall a. Monoid a => a
Prelude.mempty,
      $sel:successes:BatchPutGeofenceResponse' :: [BatchPutGeofenceSuccess]
successes = forall a. Monoid a => a
Prelude.mempty
    }

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

-- | Contains additional error details for each geofence that failed to be
-- stored in a geofence collection.
batchPutGeofenceResponse_errors :: Lens.Lens' BatchPutGeofenceResponse [BatchPutGeofenceError]
batchPutGeofenceResponse_errors :: Lens' BatchPutGeofenceResponse [BatchPutGeofenceError]
batchPutGeofenceResponse_errors = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutGeofenceResponse' {[BatchPutGeofenceError]
errors :: [BatchPutGeofenceError]
$sel:errors:BatchPutGeofenceResponse' :: BatchPutGeofenceResponse -> [BatchPutGeofenceError]
errors} -> [BatchPutGeofenceError]
errors) (\s :: BatchPutGeofenceResponse
s@BatchPutGeofenceResponse' {} [BatchPutGeofenceError]
a -> BatchPutGeofenceResponse
s {$sel:errors:BatchPutGeofenceResponse' :: [BatchPutGeofenceError]
errors = [BatchPutGeofenceError]
a} :: BatchPutGeofenceResponse) 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

-- | Contains each geofence that was successfully stored in a geofence
-- collection.
batchPutGeofenceResponse_successes :: Lens.Lens' BatchPutGeofenceResponse [BatchPutGeofenceSuccess]
batchPutGeofenceResponse_successes :: Lens' BatchPutGeofenceResponse [BatchPutGeofenceSuccess]
batchPutGeofenceResponse_successes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\BatchPutGeofenceResponse' {[BatchPutGeofenceSuccess]
successes :: [BatchPutGeofenceSuccess]
$sel:successes:BatchPutGeofenceResponse' :: BatchPutGeofenceResponse -> [BatchPutGeofenceSuccess]
successes} -> [BatchPutGeofenceSuccess]
successes) (\s :: BatchPutGeofenceResponse
s@BatchPutGeofenceResponse' {} [BatchPutGeofenceSuccess]
a -> BatchPutGeofenceResponse
s {$sel:successes:BatchPutGeofenceResponse' :: [BatchPutGeofenceSuccess]
successes = [BatchPutGeofenceSuccess]
a} :: BatchPutGeofenceResponse) 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 BatchPutGeofenceResponse where
  rnf :: BatchPutGeofenceResponse -> ()
rnf BatchPutGeofenceResponse' {Int
[BatchPutGeofenceError]
[BatchPutGeofenceSuccess]
successes :: [BatchPutGeofenceSuccess]
errors :: [BatchPutGeofenceError]
httpStatus :: Int
$sel:successes:BatchPutGeofenceResponse' :: BatchPutGeofenceResponse -> [BatchPutGeofenceSuccess]
$sel:errors:BatchPutGeofenceResponse' :: BatchPutGeofenceResponse -> [BatchPutGeofenceError]
$sel:httpStatus:BatchPutGeofenceResponse' :: BatchPutGeofenceResponse -> 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 [BatchPutGeofenceError]
errors
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf [BatchPutGeofenceSuccess]
successes