{-# 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.CreatePlaceIndex
-- 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 place index resource in your AWS account. Use a place index
-- resource to geocode addresses and other text queries by using the
-- @SearchPlaceIndexForText@ operation, and reverse geocode coordinates by
-- using the @SearchPlaceIndexForPosition@ operation, and enable
-- autosuggestions by using the @SearchPlaceIndexForSuggestions@ operation.
--
-- If your application is tracking or routing assets you use in your
-- business, such as delivery vehicles or employees, you may only use HERE
-- as your geolocation provider. See section 82 of the
-- <http://aws.amazon.com/service-terms AWS service terms> for more
-- details.
module Amazonka.Location.CreatePlaceIndex
  ( -- * Creating a Request
    CreatePlaceIndex (..),
    newCreatePlaceIndex,

    -- * Request Lenses
    createPlaceIndex_dataSourceConfiguration,
    createPlaceIndex_description,
    createPlaceIndex_pricingPlan,
    createPlaceIndex_tags,
    createPlaceIndex_dataSource,
    createPlaceIndex_indexName,

    -- * Destructuring the Response
    CreatePlaceIndexResponse (..),
    newCreatePlaceIndexResponse,

    -- * Response Lenses
    createPlaceIndexResponse_httpStatus,
    createPlaceIndexResponse_createTime,
    createPlaceIndexResponse_indexArn,
    createPlaceIndexResponse_indexName,
  )
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:/ 'newCreatePlaceIndex' smart constructor.
data CreatePlaceIndex = CreatePlaceIndex'
  { -- | Specifies the data storage option requesting Places.
    CreatePlaceIndex -> Maybe DataSourceConfiguration
dataSourceConfiguration :: Prelude.Maybe DataSourceConfiguration,
    -- | The optional description for the place index resource.
    CreatePlaceIndex -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | No longer used. If included, the only allowed value is
    -- @RequestBasedUsage@.
    CreatePlaceIndex -> Maybe PricingPlan
pricingPlan :: Prelude.Maybe PricingPlan,
    -- | Applies one or more tags to the place index resource. A tag is a
    -- key-value pair that helps you manage, identify, search, and filter your
    -- resources.
    --
    -- Format: @\"key\" : \"value\"@
    --
    -- Restrictions:
    --
    -- -   Maximum 50 tags per resource.
    --
    -- -   Each tag key must be unique and must have exactly one associated
    --     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.
    CreatePlaceIndex -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Specifies the geospatial data provider for the new place index.
    --
    -- This field is case-sensitive. Enter the valid values as shown. For
    -- example, entering @HERE@ returns an error.
    --
    -- Valid values include:
    --
    -- -   @Esri@ – For additional information about
    --     <https://docs.aws.amazon.com/location/latest/developerguide/esri.html Esri>\'s
    --     coverage in your region of interest, see
    --     <https://developers.arcgis.com/rest/geocode/api-reference/geocode-coverage.htm Esri details on geocoding coverage>.
    --
    -- -   @Here@ – For additional information about
    --     <https://docs.aws.amazon.com/location/latest/developerguide/HERE.html HERE Technologies>\'
    --     coverage in your region of interest, see
    --     <https://developer.here.com/documentation/geocoder/dev_guide/topics/coverage-geocoder.html HERE details on goecoding coverage>.
    --
    --     If you specify HERE Technologies (@Here@) as the data provider, you
    --     may not
    --     <https://docs.aws.amazon.com/location-places/latest/APIReference/API_DataSourceConfiguration.html store results>
    --     for locations in Japan. For more information, see the
    --     <https://aws.amazon.com/service-terms/ AWS Service Terms> for Amazon
    --     Location Service.
    --
    -- For additional information , see
    -- <https://docs.aws.amazon.com/location/latest/developerguide/what-is-data-provider.html Data providers>
    -- on the /Amazon Location Service Developer Guide/.
    CreatePlaceIndex -> Text
dataSource :: Prelude.Text,
    -- | The name of the place index resource.
    --
    -- Requirements:
    --
    -- -   Contain only alphanumeric characters (A–Z, a–z, 0–9), hyphens (-),
    --     periods (.), and underscores (_).
    --
    -- -   Must be a unique place index resource name.
    --
    -- -   No spaces allowed. For example, @ExamplePlaceIndex@.
    CreatePlaceIndex -> Text
indexName :: Prelude.Text
  }
  deriving (CreatePlaceIndex -> CreatePlaceIndex -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreatePlaceIndex -> CreatePlaceIndex -> Bool
$c/= :: CreatePlaceIndex -> CreatePlaceIndex -> Bool
== :: CreatePlaceIndex -> CreatePlaceIndex -> Bool
$c== :: CreatePlaceIndex -> CreatePlaceIndex -> Bool
Prelude.Eq, ReadPrec [CreatePlaceIndex]
ReadPrec CreatePlaceIndex
Int -> ReadS CreatePlaceIndex
ReadS [CreatePlaceIndex]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreatePlaceIndex]
$creadListPrec :: ReadPrec [CreatePlaceIndex]
readPrec :: ReadPrec CreatePlaceIndex
$creadPrec :: ReadPrec CreatePlaceIndex
readList :: ReadS [CreatePlaceIndex]
$creadList :: ReadS [CreatePlaceIndex]
readsPrec :: Int -> ReadS CreatePlaceIndex
$creadsPrec :: Int -> ReadS CreatePlaceIndex
Prelude.Read, Int -> CreatePlaceIndex -> ShowS
[CreatePlaceIndex] -> ShowS
CreatePlaceIndex -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreatePlaceIndex] -> ShowS
$cshowList :: [CreatePlaceIndex] -> ShowS
show :: CreatePlaceIndex -> String
$cshow :: CreatePlaceIndex -> String
showsPrec :: Int -> CreatePlaceIndex -> ShowS
$cshowsPrec :: Int -> CreatePlaceIndex -> ShowS
Prelude.Show, forall x. Rep CreatePlaceIndex x -> CreatePlaceIndex
forall x. CreatePlaceIndex -> Rep CreatePlaceIndex x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreatePlaceIndex x -> CreatePlaceIndex
$cfrom :: forall x. CreatePlaceIndex -> Rep CreatePlaceIndex x
Prelude.Generic)

-- |
-- Create a value of 'CreatePlaceIndex' 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:
--
-- 'dataSourceConfiguration', 'createPlaceIndex_dataSourceConfiguration' - Specifies the data storage option requesting Places.
--
-- 'description', 'createPlaceIndex_description' - The optional description for the place index resource.
--
-- 'pricingPlan', 'createPlaceIndex_pricingPlan' - No longer used. If included, the only allowed value is
-- @RequestBasedUsage@.
--
-- 'tags', 'createPlaceIndex_tags' - Applies one or more tags to the place index resource. A tag is a
-- key-value pair that helps you manage, identify, search, and filter your
-- resources.
--
-- Format: @\"key\" : \"value\"@
--
-- Restrictions:
--
-- -   Maximum 50 tags per resource.
--
-- -   Each tag key must be unique and must have exactly one associated
--     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.
--
-- 'dataSource', 'createPlaceIndex_dataSource' - Specifies the geospatial data provider for the new place index.
--
-- This field is case-sensitive. Enter the valid values as shown. For
-- example, entering @HERE@ returns an error.
--
-- Valid values include:
--
-- -   @Esri@ – For additional information about
--     <https://docs.aws.amazon.com/location/latest/developerguide/esri.html Esri>\'s
--     coverage in your region of interest, see
--     <https://developers.arcgis.com/rest/geocode/api-reference/geocode-coverage.htm Esri details on geocoding coverage>.
--
-- -   @Here@ – For additional information about
--     <https://docs.aws.amazon.com/location/latest/developerguide/HERE.html HERE Technologies>\'
--     coverage in your region of interest, see
--     <https://developer.here.com/documentation/geocoder/dev_guide/topics/coverage-geocoder.html HERE details on goecoding coverage>.
--
--     If you specify HERE Technologies (@Here@) as the data provider, you
--     may not
--     <https://docs.aws.amazon.com/location-places/latest/APIReference/API_DataSourceConfiguration.html store results>
--     for locations in Japan. For more information, see the
--     <https://aws.amazon.com/service-terms/ AWS Service Terms> for Amazon
--     Location Service.
--
-- For additional information , see
-- <https://docs.aws.amazon.com/location/latest/developerguide/what-is-data-provider.html Data providers>
-- on the /Amazon Location Service Developer Guide/.
--
-- 'indexName', 'createPlaceIndex_indexName' - The name of the place index resource.
--
-- Requirements:
--
-- -   Contain only alphanumeric characters (A–Z, a–z, 0–9), hyphens (-),
--     periods (.), and underscores (_).
--
-- -   Must be a unique place index resource name.
--
-- -   No spaces allowed. For example, @ExamplePlaceIndex@.
newCreatePlaceIndex ::
  -- | 'dataSource'
  Prelude.Text ->
  -- | 'indexName'
  Prelude.Text ->
  CreatePlaceIndex
newCreatePlaceIndex :: Text -> Text -> CreatePlaceIndex
newCreatePlaceIndex Text
pDataSource_ Text
pIndexName_ =
  CreatePlaceIndex'
    { $sel:dataSourceConfiguration:CreatePlaceIndex' :: Maybe DataSourceConfiguration
dataSourceConfiguration =
        forall a. Maybe a
Prelude.Nothing,
      $sel:description:CreatePlaceIndex' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:pricingPlan:CreatePlaceIndex' :: Maybe PricingPlan
pricingPlan = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreatePlaceIndex' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:dataSource:CreatePlaceIndex' :: Text
dataSource = Text
pDataSource_,
      $sel:indexName:CreatePlaceIndex' :: Text
indexName = Text
pIndexName_
    }

-- | Specifies the data storage option requesting Places.
createPlaceIndex_dataSourceConfiguration :: Lens.Lens' CreatePlaceIndex (Prelude.Maybe DataSourceConfiguration)
createPlaceIndex_dataSourceConfiguration :: Lens' CreatePlaceIndex (Maybe DataSourceConfiguration)
createPlaceIndex_dataSourceConfiguration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlaceIndex' {Maybe DataSourceConfiguration
dataSourceConfiguration :: Maybe DataSourceConfiguration
$sel:dataSourceConfiguration:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe DataSourceConfiguration
dataSourceConfiguration} -> Maybe DataSourceConfiguration
dataSourceConfiguration) (\s :: CreatePlaceIndex
s@CreatePlaceIndex' {} Maybe DataSourceConfiguration
a -> CreatePlaceIndex
s {$sel:dataSourceConfiguration:CreatePlaceIndex' :: Maybe DataSourceConfiguration
dataSourceConfiguration = Maybe DataSourceConfiguration
a} :: CreatePlaceIndex)

-- | The optional description for the place index resource.
createPlaceIndex_description :: Lens.Lens' CreatePlaceIndex (Prelude.Maybe Prelude.Text)
createPlaceIndex_description :: Lens' CreatePlaceIndex (Maybe Text)
createPlaceIndex_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlaceIndex' {Maybe Text
description :: Maybe Text
$sel:description:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe Text
description} -> Maybe Text
description) (\s :: CreatePlaceIndex
s@CreatePlaceIndex' {} Maybe Text
a -> CreatePlaceIndex
s {$sel:description:CreatePlaceIndex' :: Maybe Text
description = Maybe Text
a} :: CreatePlaceIndex)

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

-- | Applies one or more tags to the place index resource. A tag is a
-- key-value pair that helps you manage, identify, search, and filter your
-- resources.
--
-- Format: @\"key\" : \"value\"@
--
-- Restrictions:
--
-- -   Maximum 50 tags per resource.
--
-- -   Each tag key must be unique and must have exactly one associated
--     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.
createPlaceIndex_tags :: Lens.Lens' CreatePlaceIndex (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createPlaceIndex_tags :: Lens' CreatePlaceIndex (Maybe (HashMap Text Text))
createPlaceIndex_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlaceIndex' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreatePlaceIndex
s@CreatePlaceIndex' {} Maybe (HashMap Text Text)
a -> CreatePlaceIndex
s {$sel:tags:CreatePlaceIndex' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreatePlaceIndex) 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

-- | Specifies the geospatial data provider for the new place index.
--
-- This field is case-sensitive. Enter the valid values as shown. For
-- example, entering @HERE@ returns an error.
--
-- Valid values include:
--
-- -   @Esri@ – For additional information about
--     <https://docs.aws.amazon.com/location/latest/developerguide/esri.html Esri>\'s
--     coverage in your region of interest, see
--     <https://developers.arcgis.com/rest/geocode/api-reference/geocode-coverage.htm Esri details on geocoding coverage>.
--
-- -   @Here@ – For additional information about
--     <https://docs.aws.amazon.com/location/latest/developerguide/HERE.html HERE Technologies>\'
--     coverage in your region of interest, see
--     <https://developer.here.com/documentation/geocoder/dev_guide/topics/coverage-geocoder.html HERE details on goecoding coverage>.
--
--     If you specify HERE Technologies (@Here@) as the data provider, you
--     may not
--     <https://docs.aws.amazon.com/location-places/latest/APIReference/API_DataSourceConfiguration.html store results>
--     for locations in Japan. For more information, see the
--     <https://aws.amazon.com/service-terms/ AWS Service Terms> for Amazon
--     Location Service.
--
-- For additional information , see
-- <https://docs.aws.amazon.com/location/latest/developerguide/what-is-data-provider.html Data providers>
-- on the /Amazon Location Service Developer Guide/.
createPlaceIndex_dataSource :: Lens.Lens' CreatePlaceIndex Prelude.Text
createPlaceIndex_dataSource :: Lens' CreatePlaceIndex Text
createPlaceIndex_dataSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlaceIndex' {Text
dataSource :: Text
$sel:dataSource:CreatePlaceIndex' :: CreatePlaceIndex -> Text
dataSource} -> Text
dataSource) (\s :: CreatePlaceIndex
s@CreatePlaceIndex' {} Text
a -> CreatePlaceIndex
s {$sel:dataSource:CreatePlaceIndex' :: Text
dataSource = Text
a} :: CreatePlaceIndex)

-- | The name of the place index resource.
--
-- Requirements:
--
-- -   Contain only alphanumeric characters (A–Z, a–z, 0–9), hyphens (-),
--     periods (.), and underscores (_).
--
-- -   Must be a unique place index resource name.
--
-- -   No spaces allowed. For example, @ExamplePlaceIndex@.
createPlaceIndex_indexName :: Lens.Lens' CreatePlaceIndex Prelude.Text
createPlaceIndex_indexName :: Lens' CreatePlaceIndex Text
createPlaceIndex_indexName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlaceIndex' {Text
indexName :: Text
$sel:indexName:CreatePlaceIndex' :: CreatePlaceIndex -> Text
indexName} -> Text
indexName) (\s :: CreatePlaceIndex
s@CreatePlaceIndex' {} Text
a -> CreatePlaceIndex
s {$sel:indexName:CreatePlaceIndex' :: Text
indexName = Text
a} :: CreatePlaceIndex)

instance Core.AWSRequest CreatePlaceIndex where
  type
    AWSResponse CreatePlaceIndex =
      CreatePlaceIndexResponse
  request :: (Service -> Service)
-> CreatePlaceIndex -> Request CreatePlaceIndex
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 CreatePlaceIndex
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreatePlaceIndex)))
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 -> ISO8601 -> Text -> Text -> CreatePlaceIndexResponse
CreatePlaceIndexResponse'
            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
"CreateTime")
            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
"IndexArn")
            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
"IndexName")
      )

instance Prelude.Hashable CreatePlaceIndex where
  hashWithSalt :: Int -> CreatePlaceIndex -> Int
hashWithSalt Int
_salt CreatePlaceIndex' {Maybe Text
Maybe (HashMap Text Text)
Maybe DataSourceConfiguration
Maybe PricingPlan
Text
indexName :: Text
dataSource :: Text
tags :: Maybe (HashMap Text Text)
pricingPlan :: Maybe PricingPlan
description :: Maybe Text
dataSourceConfiguration :: Maybe DataSourceConfiguration
$sel:indexName:CreatePlaceIndex' :: CreatePlaceIndex -> Text
$sel:dataSource:CreatePlaceIndex' :: CreatePlaceIndex -> Text
$sel:tags:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe (HashMap Text Text)
$sel:pricingPlan:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe PricingPlan
$sel:description:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe Text
$sel:dataSourceConfiguration:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe DataSourceConfiguration
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe DataSourceConfiguration
dataSourceConfiguration
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
description
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe PricingPlan
pricingPlan
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tags
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
dataSource
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
indexName

instance Prelude.NFData CreatePlaceIndex where
  rnf :: CreatePlaceIndex -> ()
rnf CreatePlaceIndex' {Maybe Text
Maybe (HashMap Text Text)
Maybe DataSourceConfiguration
Maybe PricingPlan
Text
indexName :: Text
dataSource :: Text
tags :: Maybe (HashMap Text Text)
pricingPlan :: Maybe PricingPlan
description :: Maybe Text
dataSourceConfiguration :: Maybe DataSourceConfiguration
$sel:indexName:CreatePlaceIndex' :: CreatePlaceIndex -> Text
$sel:dataSource:CreatePlaceIndex' :: CreatePlaceIndex -> Text
$sel:tags:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe (HashMap Text Text)
$sel:pricingPlan:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe PricingPlan
$sel:description:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe Text
$sel:dataSourceConfiguration:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe DataSourceConfiguration
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe DataSourceConfiguration
dataSourceConfiguration
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 PricingPlan
pricingPlan
      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
dataSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
indexName

instance Data.ToHeaders CreatePlaceIndex where
  toHeaders :: CreatePlaceIndex -> 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 CreatePlaceIndex where
  toJSON :: CreatePlaceIndex -> Value
toJSON CreatePlaceIndex' {Maybe Text
Maybe (HashMap Text Text)
Maybe DataSourceConfiguration
Maybe PricingPlan
Text
indexName :: Text
dataSource :: Text
tags :: Maybe (HashMap Text Text)
pricingPlan :: Maybe PricingPlan
description :: Maybe Text
dataSourceConfiguration :: Maybe DataSourceConfiguration
$sel:indexName:CreatePlaceIndex' :: CreatePlaceIndex -> Text
$sel:dataSource:CreatePlaceIndex' :: CreatePlaceIndex -> Text
$sel:tags:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe (HashMap Text Text)
$sel:pricingPlan:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe PricingPlan
$sel:description:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe Text
$sel:dataSourceConfiguration:CreatePlaceIndex' :: CreatePlaceIndex -> Maybe DataSourceConfiguration
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"DataSourceConfiguration" 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 DataSourceConfiguration
dataSourceConfiguration,
            (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
"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
"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
"DataSource" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
dataSource),
            forall a. a -> Maybe a
Prelude.Just (Key
"IndexName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
indexName)
          ]
      )

instance Data.ToPath CreatePlaceIndex where
  toPath :: CreatePlaceIndex -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/places/v0/indexes"

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

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

-- |
-- Create a value of 'CreatePlaceIndexResponse' 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', 'createPlaceIndexResponse_httpStatus' - The response's http status code.
--
-- 'createTime', 'createPlaceIndexResponse_createTime' - The timestamp for when the place index resource was created in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@.
--
-- 'indexArn', 'createPlaceIndexResponse_indexArn' - The Amazon Resource Name (ARN) for the place index resource. Used to
-- specify a resource across AWS.
--
-- -   Format example:
--     @arn:aws:geo:region:account-id:place-index\/ExamplePlaceIndex@
--
-- 'indexName', 'createPlaceIndexResponse_indexName' - The name for the place index resource.
newCreatePlaceIndexResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'createTime'
  Prelude.UTCTime ->
  -- | 'indexArn'
  Prelude.Text ->
  -- | 'indexName'
  Prelude.Text ->
  CreatePlaceIndexResponse
newCreatePlaceIndexResponse :: Int -> UTCTime -> Text -> Text -> CreatePlaceIndexResponse
newCreatePlaceIndexResponse
  Int
pHttpStatus_
  UTCTime
pCreateTime_
  Text
pIndexArn_
  Text
pIndexName_ =
    CreatePlaceIndexResponse'
      { $sel:httpStatus:CreatePlaceIndexResponse' :: Int
httpStatus =
          Int
pHttpStatus_,
        $sel:createTime:CreatePlaceIndexResponse' :: ISO8601
createTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreateTime_,
        $sel:indexArn:CreatePlaceIndexResponse' :: Text
indexArn = Text
pIndexArn_,
        $sel:indexName:CreatePlaceIndexResponse' :: Text
indexName = Text
pIndexName_
      }

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

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

-- | The Amazon Resource Name (ARN) for the place index resource. Used to
-- specify a resource across AWS.
--
-- -   Format example:
--     @arn:aws:geo:region:account-id:place-index\/ExamplePlaceIndex@
createPlaceIndexResponse_indexArn :: Lens.Lens' CreatePlaceIndexResponse Prelude.Text
createPlaceIndexResponse_indexArn :: Lens' CreatePlaceIndexResponse Text
createPlaceIndexResponse_indexArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlaceIndexResponse' {Text
indexArn :: Text
$sel:indexArn:CreatePlaceIndexResponse' :: CreatePlaceIndexResponse -> Text
indexArn} -> Text
indexArn) (\s :: CreatePlaceIndexResponse
s@CreatePlaceIndexResponse' {} Text
a -> CreatePlaceIndexResponse
s {$sel:indexArn:CreatePlaceIndexResponse' :: Text
indexArn = Text
a} :: CreatePlaceIndexResponse)

-- | The name for the place index resource.
createPlaceIndexResponse_indexName :: Lens.Lens' CreatePlaceIndexResponse Prelude.Text
createPlaceIndexResponse_indexName :: Lens' CreatePlaceIndexResponse Text
createPlaceIndexResponse_indexName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreatePlaceIndexResponse' {Text
indexName :: Text
$sel:indexName:CreatePlaceIndexResponse' :: CreatePlaceIndexResponse -> Text
indexName} -> Text
indexName) (\s :: CreatePlaceIndexResponse
s@CreatePlaceIndexResponse' {} Text
a -> CreatePlaceIndexResponse
s {$sel:indexName:CreatePlaceIndexResponse' :: Text
indexName = Text
a} :: CreatePlaceIndexResponse)

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