{-# 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.CreateGeofenceCollection
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Creates a geofence collection, which manages and stores geofences.
module Amazonka.Location.CreateGeofenceCollection
  ( -- * Creating a Request
    CreateGeofenceCollection (..),
    newCreateGeofenceCollection,

    -- * Request Lenses
    createGeofenceCollection_description,
    createGeofenceCollection_kmsKeyId,
    createGeofenceCollection_pricingPlan,
    createGeofenceCollection_pricingPlanDataSource,
    createGeofenceCollection_tags,
    createGeofenceCollection_collectionName,

    -- * Destructuring the Response
    CreateGeofenceCollectionResponse (..),
    newCreateGeofenceCollectionResponse,

    -- * Response Lenses
    createGeofenceCollectionResponse_httpStatus,
    createGeofenceCollectionResponse_collectionArn,
    createGeofenceCollectionResponse_collectionName,
    createGeofenceCollectionResponse_createTime,
  )
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:/ 'newCreateGeofenceCollection' smart constructor.
data CreateGeofenceCollection = CreateGeofenceCollection'
  { -- | An optional description for the geofence collection.
    CreateGeofenceCollection -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | A key identifier for an
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/create-keys.html AWS KMS customer managed key>.
    -- Enter a key ID, key ARN, alias name, or alias ARN.
    CreateGeofenceCollection -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | No longer used. If included, the only allowed value is
    -- @RequestBasedUsage@.
    CreateGeofenceCollection -> Maybe PricingPlan
pricingPlan :: Prelude.Maybe PricingPlan,
    -- | This parameter is no longer used.
    CreateGeofenceCollection -> Maybe Text
pricingPlanDataSource :: Prelude.Maybe Prelude.Text,
    -- | Applies one or more tags to the geofence collection. A tag is a
    -- key-value pair helps manage, identify, search, and filter your resources
    -- by labelling them.
    --
    -- Format: @\"key\" : \"value\"@
    --
    -- Restrictions:
    --
    -- -   Maximum 50 tags per resource
    --
    -- -   Each resource tag must be unique with a maximum of one value.
    --
    -- -   Maximum key length: 128 Unicode characters in UTF-8
    --
    -- -   Maximum value length: 256 Unicode characters in UTF-8
    --
    -- -   Can use alphanumeric characters (A–Z, a–z, 0–9), and the following
    --     characters: + - = . _ : \/ \@.
    --
    -- -   Cannot use \"aws:\" as a prefix for a key.
    CreateGeofenceCollection -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A custom name for the geofence collection.
    --
    -- Requirements:
    --
    -- -   Contain only alphanumeric characters (A–Z, a–z, 0–9), hyphens (-),
    --     periods (.), and underscores (_).
    --
    -- -   Must be a unique geofence collection name.
    --
    -- -   No spaces allowed. For example, @ExampleGeofenceCollection@.
    CreateGeofenceCollection -> Text
collectionName :: Prelude.Text
  }
  deriving (CreateGeofenceCollection -> CreateGeofenceCollection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateGeofenceCollection -> CreateGeofenceCollection -> Bool
$c/= :: CreateGeofenceCollection -> CreateGeofenceCollection -> Bool
== :: CreateGeofenceCollection -> CreateGeofenceCollection -> Bool
$c== :: CreateGeofenceCollection -> CreateGeofenceCollection -> Bool
Prelude.Eq, ReadPrec [CreateGeofenceCollection]
ReadPrec CreateGeofenceCollection
Int -> ReadS CreateGeofenceCollection
ReadS [CreateGeofenceCollection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateGeofenceCollection]
$creadListPrec :: ReadPrec [CreateGeofenceCollection]
readPrec :: ReadPrec CreateGeofenceCollection
$creadPrec :: ReadPrec CreateGeofenceCollection
readList :: ReadS [CreateGeofenceCollection]
$creadList :: ReadS [CreateGeofenceCollection]
readsPrec :: Int -> ReadS CreateGeofenceCollection
$creadsPrec :: Int -> ReadS CreateGeofenceCollection
Prelude.Read, Int -> CreateGeofenceCollection -> ShowS
[CreateGeofenceCollection] -> ShowS
CreateGeofenceCollection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateGeofenceCollection] -> ShowS
$cshowList :: [CreateGeofenceCollection] -> ShowS
show :: CreateGeofenceCollection -> String
$cshow :: CreateGeofenceCollection -> String
showsPrec :: Int -> CreateGeofenceCollection -> ShowS
$cshowsPrec :: Int -> CreateGeofenceCollection -> ShowS
Prelude.Show, forall x.
Rep CreateGeofenceCollection x -> CreateGeofenceCollection
forall x.
CreateGeofenceCollection -> Rep CreateGeofenceCollection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep CreateGeofenceCollection x -> CreateGeofenceCollection
$cfrom :: forall x.
CreateGeofenceCollection -> Rep CreateGeofenceCollection x
Prelude.Generic)

-- |
-- Create a value of 'CreateGeofenceCollection' 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', 'createGeofenceCollection_description' - An optional description for the geofence collection.
--
-- 'kmsKeyId', 'createGeofenceCollection_kmsKeyId' - A key identifier for an
-- <https://docs.aws.amazon.com/kms/latest/developerguide/create-keys.html AWS KMS customer managed key>.
-- Enter a key ID, key ARN, alias name, or alias ARN.
--
-- 'pricingPlan', 'createGeofenceCollection_pricingPlan' - No longer used. If included, the only allowed value is
-- @RequestBasedUsage@.
--
-- 'pricingPlanDataSource', 'createGeofenceCollection_pricingPlanDataSource' - This parameter is no longer used.
--
-- 'tags', 'createGeofenceCollection_tags' - Applies one or more tags to the geofence collection. A tag is a
-- key-value pair helps manage, identify, search, and filter your resources
-- by labelling them.
--
-- Format: @\"key\" : \"value\"@
--
-- Restrictions:
--
-- -   Maximum 50 tags per resource
--
-- -   Each resource tag must be unique with a maximum of one value.
--
-- -   Maximum key length: 128 Unicode characters in UTF-8
--
-- -   Maximum value length: 256 Unicode characters in UTF-8
--
-- -   Can use alphanumeric characters (A–Z, a–z, 0–9), and the following
--     characters: + - = . _ : \/ \@.
--
-- -   Cannot use \"aws:\" as a prefix for a key.
--
-- 'collectionName', 'createGeofenceCollection_collectionName' - A custom name for the geofence collection.
--
-- Requirements:
--
-- -   Contain only alphanumeric characters (A–Z, a–z, 0–9), hyphens (-),
--     periods (.), and underscores (_).
--
-- -   Must be a unique geofence collection name.
--
-- -   No spaces allowed. For example, @ExampleGeofenceCollection@.
newCreateGeofenceCollection ::
  -- | 'collectionName'
  Prelude.Text ->
  CreateGeofenceCollection
newCreateGeofenceCollection :: Text -> CreateGeofenceCollection
newCreateGeofenceCollection Text
pCollectionName_ =
  CreateGeofenceCollection'
    { $sel:description:CreateGeofenceCollection' :: Maybe Text
description =
        forall a. Maybe a
Prelude.Nothing,
      $sel:kmsKeyId:CreateGeofenceCollection' :: Maybe Text
kmsKeyId = forall a. Maybe a
Prelude.Nothing,
      $sel:pricingPlan:CreateGeofenceCollection' :: Maybe PricingPlan
pricingPlan = forall a. Maybe a
Prelude.Nothing,
      $sel:pricingPlanDataSource:CreateGeofenceCollection' :: Maybe Text
pricingPlanDataSource = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateGeofenceCollection' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:collectionName:CreateGeofenceCollection' :: Text
collectionName = Text
pCollectionName_
    }

-- | An optional description for the geofence collection.
createGeofenceCollection_description :: Lens.Lens' CreateGeofenceCollection (Prelude.Maybe Prelude.Text)
createGeofenceCollection_description :: Lens' CreateGeofenceCollection (Maybe Text)
createGeofenceCollection_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGeofenceCollection' {Maybe Text
description :: Maybe Text
$sel:description:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateGeofenceCollection
s@CreateGeofenceCollection' {} Maybe Text
a -> CreateGeofenceCollection
s {$sel:description:CreateGeofenceCollection' :: Maybe Text
description = Maybe Text
a} :: CreateGeofenceCollection)

-- | A key identifier for an
-- <https://docs.aws.amazon.com/kms/latest/developerguide/create-keys.html AWS KMS customer managed key>.
-- Enter a key ID, key ARN, alias name, or alias ARN.
createGeofenceCollection_kmsKeyId :: Lens.Lens' CreateGeofenceCollection (Prelude.Maybe Prelude.Text)
createGeofenceCollection_kmsKeyId :: Lens' CreateGeofenceCollection (Maybe Text)
createGeofenceCollection_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGeofenceCollection' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: CreateGeofenceCollection
s@CreateGeofenceCollection' {} Maybe Text
a -> CreateGeofenceCollection
s {$sel:kmsKeyId:CreateGeofenceCollection' :: Maybe Text
kmsKeyId = Maybe Text
a} :: CreateGeofenceCollection)

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

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

-- | Applies one or more tags to the geofence collection. A tag is a
-- key-value pair helps manage, identify, search, and filter your resources
-- by labelling them.
--
-- Format: @\"key\" : \"value\"@
--
-- Restrictions:
--
-- -   Maximum 50 tags per resource
--
-- -   Each resource tag must be unique with a maximum of one value.
--
-- -   Maximum key length: 128 Unicode characters in UTF-8
--
-- -   Maximum value length: 256 Unicode characters in UTF-8
--
-- -   Can use alphanumeric characters (A–Z, a–z, 0–9), and the following
--     characters: + - = . _ : \/ \@.
--
-- -   Cannot use \"aws:\" as a prefix for a key.
createGeofenceCollection_tags :: Lens.Lens' CreateGeofenceCollection (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createGeofenceCollection_tags :: Lens' CreateGeofenceCollection (Maybe (HashMap Text Text))
createGeofenceCollection_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGeofenceCollection' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateGeofenceCollection
s@CreateGeofenceCollection' {} Maybe (HashMap Text Text)
a -> CreateGeofenceCollection
s {$sel:tags:CreateGeofenceCollection' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateGeofenceCollection) 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 s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | A custom name for the geofence collection.
--
-- Requirements:
--
-- -   Contain only alphanumeric characters (A–Z, a–z, 0–9), hyphens (-),
--     periods (.), and underscores (_).
--
-- -   Must be a unique geofence collection name.
--
-- -   No spaces allowed. For example, @ExampleGeofenceCollection@.
createGeofenceCollection_collectionName :: Lens.Lens' CreateGeofenceCollection Prelude.Text
createGeofenceCollection_collectionName :: Lens' CreateGeofenceCollection Text
createGeofenceCollection_collectionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGeofenceCollection' {Text
collectionName :: Text
$sel:collectionName:CreateGeofenceCollection' :: CreateGeofenceCollection -> Text
collectionName} -> Text
collectionName) (\s :: CreateGeofenceCollection
s@CreateGeofenceCollection' {} Text
a -> CreateGeofenceCollection
s {$sel:collectionName:CreateGeofenceCollection' :: Text
collectionName = Text
a} :: CreateGeofenceCollection)

instance Core.AWSRequest CreateGeofenceCollection where
  type
    AWSResponse CreateGeofenceCollection =
      CreateGeofenceCollectionResponse
  request :: (Service -> Service)
-> CreateGeofenceCollection -> Request CreateGeofenceCollection
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 CreateGeofenceCollection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse CreateGeofenceCollection)))
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 -> CreateGeofenceCollectionResponse
CreateGeofenceCollectionResponse'
            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
"CollectionArn")
            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
"CollectionName")
            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
"CreateTime")
      )

instance Prelude.Hashable CreateGeofenceCollection where
  hashWithSalt :: Int -> CreateGeofenceCollection -> Int
hashWithSalt Int
_salt CreateGeofenceCollection' {Maybe Text
Maybe (HashMap Text Text)
Maybe PricingPlan
Text
collectionName :: Text
tags :: Maybe (HashMap Text Text)
pricingPlanDataSource :: Maybe Text
pricingPlan :: Maybe PricingPlan
kmsKeyId :: Maybe Text
description :: Maybe Text
$sel:collectionName:CreateGeofenceCollection' :: CreateGeofenceCollection -> Text
$sel:tags:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe (HashMap Text Text)
$sel:pricingPlanDataSource:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe Text
$sel:pricingPlan:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe PricingPlan
$sel:kmsKeyId:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe Text
$sel:description:CreateGeofenceCollection' :: CreateGeofenceCollection -> 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 Text
kmsKeyId
      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` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
collectionName

instance Prelude.NFData CreateGeofenceCollection where
  rnf :: CreateGeofenceCollection -> ()
rnf CreateGeofenceCollection' {Maybe Text
Maybe (HashMap Text Text)
Maybe PricingPlan
Text
collectionName :: Text
tags :: Maybe (HashMap Text Text)
pricingPlanDataSource :: Maybe Text
pricingPlan :: Maybe PricingPlan
kmsKeyId :: Maybe Text
description :: Maybe Text
$sel:collectionName:CreateGeofenceCollection' :: CreateGeofenceCollection -> Text
$sel:tags:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe (HashMap Text Text)
$sel:pricingPlanDataSource:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe Text
$sel:pricingPlan:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe PricingPlan
$sel:kmsKeyId:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe Text
$sel:description:CreateGeofenceCollection' :: CreateGeofenceCollection -> 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 Text
kmsKeyId
      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 Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
collectionName

instance Data.ToHeaders CreateGeofenceCollection where
  toHeaders :: CreateGeofenceCollection -> 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 CreateGeofenceCollection where
  toJSON :: CreateGeofenceCollection -> Value
toJSON CreateGeofenceCollection' {Maybe Text
Maybe (HashMap Text Text)
Maybe PricingPlan
Text
collectionName :: Text
tags :: Maybe (HashMap Text Text)
pricingPlanDataSource :: Maybe Text
pricingPlan :: Maybe PricingPlan
kmsKeyId :: Maybe Text
description :: Maybe Text
$sel:collectionName:CreateGeofenceCollection' :: CreateGeofenceCollection -> Text
$sel:tags:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe (HashMap Text Text)
$sel:pricingPlanDataSource:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe Text
$sel:pricingPlan:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe PricingPlan
$sel:kmsKeyId:CreateGeofenceCollection' :: CreateGeofenceCollection -> Maybe Text
$sel:description:CreateGeofenceCollection' :: CreateGeofenceCollection -> 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
"KmsKeyId" 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
kmsKeyId,
            (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,
            (Key
"Tags" 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 (HashMap Text Text)
tags,
            forall a. a -> Maybe a
Prelude.Just
              (Key
"CollectionName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
collectionName)
          ]
      )

instance Data.ToPath CreateGeofenceCollection where
  toPath :: CreateGeofenceCollection -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/geofencing/v0/collections"

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

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

-- |
-- Create a value of 'CreateGeofenceCollectionResponse' 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', 'createGeofenceCollectionResponse_httpStatus' - The response's http status code.
--
-- 'collectionArn', 'createGeofenceCollectionResponse_collectionArn' - The Amazon Resource Name (ARN) for the geofence collection resource.
-- Used when you need to specify a resource across all AWS.
--
-- -   Format example:
--     @arn:aws:geo:region:account-id:geofence-collection\/ExampleGeofenceCollection@
--
-- 'collectionName', 'createGeofenceCollectionResponse_collectionName' - The name for the geofence collection.
--
-- 'createTime', 'createGeofenceCollectionResponse_createTime' - The timestamp for when the geofence collection was created in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@
newCreateGeofenceCollectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'collectionArn'
  Prelude.Text ->
  -- | 'collectionName'
  Prelude.Text ->
  -- | 'createTime'
  Prelude.UTCTime ->
  CreateGeofenceCollectionResponse
newCreateGeofenceCollectionResponse :: Int -> Text -> Text -> UTCTime -> CreateGeofenceCollectionResponse
newCreateGeofenceCollectionResponse
  Int
pHttpStatus_
  Text
pCollectionArn_
  Text
pCollectionName_
  UTCTime
pCreateTime_ =
    CreateGeofenceCollectionResponse'
      { $sel:httpStatus:CreateGeofenceCollectionResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:collectionArn:CreateGeofenceCollectionResponse' :: Text
collectionArn = Text
pCollectionArn_,
        $sel:collectionName:CreateGeofenceCollectionResponse' :: Text
collectionName = Text
pCollectionName_,
        $sel:createTime:CreateGeofenceCollectionResponse' :: ISO8601
createTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreateTime_
      }

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

-- | The Amazon Resource Name (ARN) for the geofence collection resource.
-- Used when you need to specify a resource across all AWS.
--
-- -   Format example:
--     @arn:aws:geo:region:account-id:geofence-collection\/ExampleGeofenceCollection@
createGeofenceCollectionResponse_collectionArn :: Lens.Lens' CreateGeofenceCollectionResponse Prelude.Text
createGeofenceCollectionResponse_collectionArn :: Lens' CreateGeofenceCollectionResponse Text
createGeofenceCollectionResponse_collectionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGeofenceCollectionResponse' {Text
collectionArn :: Text
$sel:collectionArn:CreateGeofenceCollectionResponse' :: CreateGeofenceCollectionResponse -> Text
collectionArn} -> Text
collectionArn) (\s :: CreateGeofenceCollectionResponse
s@CreateGeofenceCollectionResponse' {} Text
a -> CreateGeofenceCollectionResponse
s {$sel:collectionArn:CreateGeofenceCollectionResponse' :: Text
collectionArn = Text
a} :: CreateGeofenceCollectionResponse)

-- | The name for the geofence collection.
createGeofenceCollectionResponse_collectionName :: Lens.Lens' CreateGeofenceCollectionResponse Prelude.Text
createGeofenceCollectionResponse_collectionName :: Lens' CreateGeofenceCollectionResponse Text
createGeofenceCollectionResponse_collectionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateGeofenceCollectionResponse' {Text
collectionName :: Text
$sel:collectionName:CreateGeofenceCollectionResponse' :: CreateGeofenceCollectionResponse -> Text
collectionName} -> Text
collectionName) (\s :: CreateGeofenceCollectionResponse
s@CreateGeofenceCollectionResponse' {} Text
a -> CreateGeofenceCollectionResponse
s {$sel:collectionName:CreateGeofenceCollectionResponse' :: Text
collectionName = Text
a} :: CreateGeofenceCollectionResponse)

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

instance
  Prelude.NFData
    CreateGeofenceCollectionResponse
  where
  rnf :: CreateGeofenceCollectionResponse -> ()
rnf CreateGeofenceCollectionResponse' {Int
Text
ISO8601
createTime :: ISO8601
collectionName :: Text
collectionArn :: Text
httpStatus :: Int
$sel:createTime:CreateGeofenceCollectionResponse' :: CreateGeofenceCollectionResponse -> ISO8601
$sel:collectionName:CreateGeofenceCollectionResponse' :: CreateGeofenceCollectionResponse -> Text
$sel:collectionArn:CreateGeofenceCollectionResponse' :: CreateGeofenceCollectionResponse -> Text
$sel:httpStatus:CreateGeofenceCollectionResponse' :: CreateGeofenceCollectionResponse -> 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
collectionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 ISO8601
createTime