{-# 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.CreateMap
-- 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 map resource in your AWS account, which provides map tiles of
-- different styles sourced from global location data providers.
--
-- 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.CreateMap
  ( -- * Creating a Request
    CreateMap (..),
    newCreateMap,

    -- * Request Lenses
    createMap_description,
    createMap_pricingPlan,
    createMap_tags,
    createMap_configuration,
    createMap_mapName,

    -- * Destructuring the Response
    CreateMapResponse (..),
    newCreateMapResponse,

    -- * Response Lenses
    createMapResponse_httpStatus,
    createMapResponse_createTime,
    createMapResponse_mapArn,
    createMapResponse_mapName,
  )
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:/ 'newCreateMap' smart constructor.
data CreateMap = CreateMap'
  { -- | An optional description for the map resource.
    CreateMap -> Maybe Text
description :: Prelude.Maybe Prelude.Text,
    -- | No longer used. If included, the only allowed value is
    -- @RequestBasedUsage@.
    CreateMap -> Maybe PricingPlan
pricingPlan :: Prelude.Maybe PricingPlan,
    -- | Applies one or more tags to the map resource. 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.
    CreateMap -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | Specifies the @MapConfiguration@, including the map style, for the map
    -- resource that you create. The map style defines the look of maps and the
    -- data provider for your map resource.
    CreateMap -> MapConfiguration
configuration :: MapConfiguration,
    -- | The name for the map resource.
    --
    -- Requirements:
    --
    -- -   Must contain only alphanumeric characters (A–Z, a–z, 0–9), hyphens
    --     (-), periods (.), and underscores (_).
    --
    -- -   Must be a unique map resource name.
    --
    -- -   No spaces allowed. For example, @ExampleMap@.
    CreateMap -> Text
mapName :: Prelude.Text
  }
  deriving (CreateMap -> CreateMap -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: CreateMap -> CreateMap -> Bool
$c/= :: CreateMap -> CreateMap -> Bool
== :: CreateMap -> CreateMap -> Bool
$c== :: CreateMap -> CreateMap -> Bool
Prelude.Eq, ReadPrec [CreateMap]
ReadPrec CreateMap
Int -> ReadS CreateMap
ReadS [CreateMap]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [CreateMap]
$creadListPrec :: ReadPrec [CreateMap]
readPrec :: ReadPrec CreateMap
$creadPrec :: ReadPrec CreateMap
readList :: ReadS [CreateMap]
$creadList :: ReadS [CreateMap]
readsPrec :: Int -> ReadS CreateMap
$creadsPrec :: Int -> ReadS CreateMap
Prelude.Read, Int -> CreateMap -> ShowS
[CreateMap] -> ShowS
CreateMap -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [CreateMap] -> ShowS
$cshowList :: [CreateMap] -> ShowS
show :: CreateMap -> String
$cshow :: CreateMap -> String
showsPrec :: Int -> CreateMap -> ShowS
$cshowsPrec :: Int -> CreateMap -> ShowS
Prelude.Show, forall x. Rep CreateMap x -> CreateMap
forall x. CreateMap -> Rep CreateMap x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep CreateMap x -> CreateMap
$cfrom :: forall x. CreateMap -> Rep CreateMap x
Prelude.Generic)

-- |
-- Create a value of 'CreateMap' 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', 'createMap_description' - An optional description for the map resource.
--
-- 'pricingPlan', 'createMap_pricingPlan' - No longer used. If included, the only allowed value is
-- @RequestBasedUsage@.
--
-- 'tags', 'createMap_tags' - Applies one or more tags to the map resource. 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.
--
-- 'configuration', 'createMap_configuration' - Specifies the @MapConfiguration@, including the map style, for the map
-- resource that you create. The map style defines the look of maps and the
-- data provider for your map resource.
--
-- 'mapName', 'createMap_mapName' - The name for the map resource.
--
-- Requirements:
--
-- -   Must contain only alphanumeric characters (A–Z, a–z, 0–9), hyphens
--     (-), periods (.), and underscores (_).
--
-- -   Must be a unique map resource name.
--
-- -   No spaces allowed. For example, @ExampleMap@.
newCreateMap ::
  -- | 'configuration'
  MapConfiguration ->
  -- | 'mapName'
  Prelude.Text ->
  CreateMap
newCreateMap :: MapConfiguration -> Text -> CreateMap
newCreateMap MapConfiguration
pConfiguration_ Text
pMapName_ =
  CreateMap'
    { $sel:description:CreateMap' :: Maybe Text
description = forall a. Maybe a
Prelude.Nothing,
      $sel:pricingPlan:CreateMap' :: Maybe PricingPlan
pricingPlan = forall a. Maybe a
Prelude.Nothing,
      $sel:tags:CreateMap' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
      $sel:configuration:CreateMap' :: MapConfiguration
configuration = MapConfiguration
pConfiguration_,
      $sel:mapName:CreateMap' :: Text
mapName = Text
pMapName_
    }

-- | An optional description for the map resource.
createMap_description :: Lens.Lens' CreateMap (Prelude.Maybe Prelude.Text)
createMap_description :: Lens' CreateMap (Maybe Text)
createMap_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMap' {Maybe Text
description :: Maybe Text
$sel:description:CreateMap' :: CreateMap -> Maybe Text
description} -> Maybe Text
description) (\s :: CreateMap
s@CreateMap' {} Maybe Text
a -> CreateMap
s {$sel:description:CreateMap' :: Maybe Text
description = Maybe Text
a} :: CreateMap)

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

-- | Applies one or more tags to the map resource. 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.
createMap_tags :: Lens.Lens' CreateMap (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
createMap_tags :: Lens' CreateMap (Maybe (HashMap Text Text))
createMap_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMap' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:CreateMap' :: CreateMap -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: CreateMap
s@CreateMap' {} Maybe (HashMap Text Text)
a -> CreateMap
s {$sel:tags:CreateMap' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: CreateMap) 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 @MapConfiguration@, including the map style, for the map
-- resource that you create. The map style defines the look of maps and the
-- data provider for your map resource.
createMap_configuration :: Lens.Lens' CreateMap MapConfiguration
createMap_configuration :: Lens' CreateMap MapConfiguration
createMap_configuration = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMap' {MapConfiguration
configuration :: MapConfiguration
$sel:configuration:CreateMap' :: CreateMap -> MapConfiguration
configuration} -> MapConfiguration
configuration) (\s :: CreateMap
s@CreateMap' {} MapConfiguration
a -> CreateMap
s {$sel:configuration:CreateMap' :: MapConfiguration
configuration = MapConfiguration
a} :: CreateMap)

-- | The name for the map resource.
--
-- Requirements:
--
-- -   Must contain only alphanumeric characters (A–Z, a–z, 0–9), hyphens
--     (-), periods (.), and underscores (_).
--
-- -   Must be a unique map resource name.
--
-- -   No spaces allowed. For example, @ExampleMap@.
createMap_mapName :: Lens.Lens' CreateMap Prelude.Text
createMap_mapName :: Lens' CreateMap Text
createMap_mapName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMap' {Text
mapName :: Text
$sel:mapName:CreateMap' :: CreateMap -> Text
mapName} -> Text
mapName) (\s :: CreateMap
s@CreateMap' {} Text
a -> CreateMap
s {$sel:mapName:CreateMap' :: Text
mapName = Text
a} :: CreateMap)

instance Core.AWSRequest CreateMap where
  type AWSResponse CreateMap = CreateMapResponse
  request :: (Service -> Service) -> CreateMap -> Request CreateMap
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 CreateMap
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse CreateMap)))
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 -> CreateMapResponse
CreateMapResponse'
            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
"MapArn")
            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
"MapName")
      )

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

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

instance Data.ToHeaders CreateMap where
  toHeaders :: CreateMap -> 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 CreateMap where
  toJSON :: CreateMap -> Value
toJSON CreateMap' {Maybe Text
Maybe (HashMap Text Text)
Maybe PricingPlan
Text
MapConfiguration
mapName :: Text
configuration :: MapConfiguration
tags :: Maybe (HashMap Text Text)
pricingPlan :: Maybe PricingPlan
description :: Maybe Text
$sel:mapName:CreateMap' :: CreateMap -> Text
$sel:configuration:CreateMap' :: CreateMap -> MapConfiguration
$sel:tags:CreateMap' :: CreateMap -> Maybe (HashMap Text Text)
$sel:pricingPlan:CreateMap' :: CreateMap -> Maybe PricingPlan
$sel:description:CreateMap' :: CreateMap -> 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
"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
"Configuration" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= MapConfiguration
configuration),
            forall a. a -> Maybe a
Prelude.Just (Key
"MapName" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
mapName)
          ]
      )

instance Data.ToPath CreateMap where
  toPath :: CreateMap -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/maps/v0/maps"

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

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

-- |
-- Create a value of 'CreateMapResponse' 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', 'createMapResponse_httpStatus' - The response's http status code.
--
-- 'createTime', 'createMapResponse_createTime' - The timestamp for when the map resource was created in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@.
--
-- 'mapArn', 'createMapResponse_mapArn' - The Amazon Resource Name (ARN) for the map resource. Used to specify a
-- resource across all AWS.
--
-- -   Format example: @arn:aws:geo:region:account-id:map\/ExampleMap@
--
-- 'mapName', 'createMapResponse_mapName' - The name of the map resource.
newCreateMapResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'createTime'
  Prelude.UTCTime ->
  -- | 'mapArn'
  Prelude.Text ->
  -- | 'mapName'
  Prelude.Text ->
  CreateMapResponse
newCreateMapResponse :: Int -> UTCTime -> Text -> Text -> CreateMapResponse
newCreateMapResponse
  Int
pHttpStatus_
  UTCTime
pCreateTime_
  Text
pMapArn_
  Text
pMapName_ =
    CreateMapResponse'
      { $sel:httpStatus:CreateMapResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:createTime:CreateMapResponse' :: ISO8601
createTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreateTime_,
        $sel:mapArn:CreateMapResponse' :: Text
mapArn = Text
pMapArn_,
        $sel:mapName:CreateMapResponse' :: Text
mapName = Text
pMapName_
      }

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

-- | The timestamp for when the map resource was created in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@.
createMapResponse_createTime :: Lens.Lens' CreateMapResponse Prelude.UTCTime
createMapResponse_createTime :: Lens' CreateMapResponse UTCTime
createMapResponse_createTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMapResponse' {ISO8601
createTime :: ISO8601
$sel:createTime:CreateMapResponse' :: CreateMapResponse -> ISO8601
createTime} -> ISO8601
createTime) (\s :: CreateMapResponse
s@CreateMapResponse' {} ISO8601
a -> CreateMapResponse
s {$sel:createTime:CreateMapResponse' :: ISO8601
createTime = ISO8601
a} :: CreateMapResponse) 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 map resource. Used to specify a
-- resource across all AWS.
--
-- -   Format example: @arn:aws:geo:region:account-id:map\/ExampleMap@
createMapResponse_mapArn :: Lens.Lens' CreateMapResponse Prelude.Text
createMapResponse_mapArn :: Lens' CreateMapResponse Text
createMapResponse_mapArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMapResponse' {Text
mapArn :: Text
$sel:mapArn:CreateMapResponse' :: CreateMapResponse -> Text
mapArn} -> Text
mapArn) (\s :: CreateMapResponse
s@CreateMapResponse' {} Text
a -> CreateMapResponse
s {$sel:mapArn:CreateMapResponse' :: Text
mapArn = Text
a} :: CreateMapResponse)

-- | The name of the map resource.
createMapResponse_mapName :: Lens.Lens' CreateMapResponse Prelude.Text
createMapResponse_mapName :: Lens' CreateMapResponse Text
createMapResponse_mapName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\CreateMapResponse' {Text
mapName :: Text
$sel:mapName:CreateMapResponse' :: CreateMapResponse -> Text
mapName} -> Text
mapName) (\s :: CreateMapResponse
s@CreateMapResponse' {} Text
a -> CreateMapResponse
s {$sel:mapName:CreateMapResponse' :: Text
mapName = Text
a} :: CreateMapResponse)

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