{-# 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.GetMapTile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Retrieves a vector data tile from the map resource. Map tiles are used
-- by clients to render a map. they\'re addressed using a grid arrangement
-- with an X coordinate, Y coordinate, and Z (zoom) level.
--
-- The origin (0, 0) is the top left of the map. Increasing the zoom level
-- by 1 doubles both the X and Y dimensions, so a tile containing data for
-- the entire world at (0\/0\/0) will be split into 4 tiles at zoom 1
-- (1\/0\/0, 1\/0\/1, 1\/1\/0, 1\/1\/1).
module Amazonka.Location.GetMapTile
  ( -- * Creating a Request
    GetMapTile (..),
    newGetMapTile,

    -- * Request Lenses
    getMapTile_mapName,
    getMapTile_x,
    getMapTile_y,
    getMapTile_z,

    -- * Destructuring the Response
    GetMapTileResponse (..),
    newGetMapTileResponse,

    -- * Response Lenses
    getMapTileResponse_blob,
    getMapTileResponse_contentType,
    getMapTileResponse_httpStatus,
  )
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:/ 'newGetMapTile' smart constructor.
data GetMapTile = GetMapTile'
  { -- | The map resource to retrieve the map tiles from.
    GetMapTile -> Text
mapName :: Prelude.Text,
    -- | The X axis value for the map tile.
    GetMapTile -> Text
x :: Prelude.Text,
    -- | The Y axis value for the map tile.
    GetMapTile -> Text
y :: Prelude.Text,
    -- | The zoom value for the map tile.
    GetMapTile -> Text
z :: Prelude.Text
  }
  deriving (GetMapTile -> GetMapTile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMapTile -> GetMapTile -> Bool
$c/= :: GetMapTile -> GetMapTile -> Bool
== :: GetMapTile -> GetMapTile -> Bool
$c== :: GetMapTile -> GetMapTile -> Bool
Prelude.Eq, ReadPrec [GetMapTile]
ReadPrec GetMapTile
Int -> ReadS GetMapTile
ReadS [GetMapTile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMapTile]
$creadListPrec :: ReadPrec [GetMapTile]
readPrec :: ReadPrec GetMapTile
$creadPrec :: ReadPrec GetMapTile
readList :: ReadS [GetMapTile]
$creadList :: ReadS [GetMapTile]
readsPrec :: Int -> ReadS GetMapTile
$creadsPrec :: Int -> ReadS GetMapTile
Prelude.Read, Int -> GetMapTile -> ShowS
[GetMapTile] -> ShowS
GetMapTile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMapTile] -> ShowS
$cshowList :: [GetMapTile] -> ShowS
show :: GetMapTile -> String
$cshow :: GetMapTile -> String
showsPrec :: Int -> GetMapTile -> ShowS
$cshowsPrec :: Int -> GetMapTile -> ShowS
Prelude.Show, forall x. Rep GetMapTile x -> GetMapTile
forall x. GetMapTile -> Rep GetMapTile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMapTile x -> GetMapTile
$cfrom :: forall x. GetMapTile -> Rep GetMapTile x
Prelude.Generic)

-- |
-- Create a value of 'GetMapTile' 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:
--
-- 'mapName', 'getMapTile_mapName' - The map resource to retrieve the map tiles from.
--
-- 'x', 'getMapTile_x' - The X axis value for the map tile.
--
-- 'y', 'getMapTile_y' - The Y axis value for the map tile.
--
-- 'z', 'getMapTile_z' - The zoom value for the map tile.
newGetMapTile ::
  -- | 'mapName'
  Prelude.Text ->
  -- | 'x'
  Prelude.Text ->
  -- | 'y'
  Prelude.Text ->
  -- | 'z'
  Prelude.Text ->
  GetMapTile
newGetMapTile :: Text -> Text -> Text -> Text -> GetMapTile
newGetMapTile Text
pMapName_ Text
pX_ Text
pY_ Text
pZ_ =
  GetMapTile'
    { $sel:mapName:GetMapTile' :: Text
mapName = Text
pMapName_,
      $sel:x:GetMapTile' :: Text
x = Text
pX_,
      $sel:y:GetMapTile' :: Text
y = Text
pY_,
      $sel:z:GetMapTile' :: Text
z = Text
pZ_
    }

-- | The map resource to retrieve the map tiles from.
getMapTile_mapName :: Lens.Lens' GetMapTile Prelude.Text
getMapTile_mapName :: Lens' GetMapTile Text
getMapTile_mapName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapTile' {Text
mapName :: Text
$sel:mapName:GetMapTile' :: GetMapTile -> Text
mapName} -> Text
mapName) (\s :: GetMapTile
s@GetMapTile' {} Text
a -> GetMapTile
s {$sel:mapName:GetMapTile' :: Text
mapName = Text
a} :: GetMapTile)

-- | The X axis value for the map tile.
getMapTile_x :: Lens.Lens' GetMapTile Prelude.Text
getMapTile_x :: Lens' GetMapTile Text
getMapTile_x = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapTile' {Text
x :: Text
$sel:x:GetMapTile' :: GetMapTile -> Text
x} -> Text
x) (\s :: GetMapTile
s@GetMapTile' {} Text
a -> GetMapTile
s {$sel:x:GetMapTile' :: Text
x = Text
a} :: GetMapTile)

-- | The Y axis value for the map tile.
getMapTile_y :: Lens.Lens' GetMapTile Prelude.Text
getMapTile_y :: Lens' GetMapTile Text
getMapTile_y = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapTile' {Text
y :: Text
$sel:y:GetMapTile' :: GetMapTile -> Text
y} -> Text
y) (\s :: GetMapTile
s@GetMapTile' {} Text
a -> GetMapTile
s {$sel:y:GetMapTile' :: Text
y = Text
a} :: GetMapTile)

-- | The zoom value for the map tile.
getMapTile_z :: Lens.Lens' GetMapTile Prelude.Text
getMapTile_z :: Lens' GetMapTile Text
getMapTile_z = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapTile' {Text
z :: Text
$sel:z:GetMapTile' :: GetMapTile -> Text
z} -> Text
z) (\s :: GetMapTile
s@GetMapTile' {} Text
a -> GetMapTile
s {$sel:z:GetMapTile' :: Text
z = Text
a} :: GetMapTile)

instance Core.AWSRequest GetMapTile where
  type AWSResponse GetMapTile = GetMapTileResponse
  request :: (Service -> Service) -> GetMapTile -> Request GetMapTile
request Service -> Service
overrides =
    forall a. ToRequest a => Service -> a -> Request a
Request.get (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy GetMapTile
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetMapTile)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders -> ByteString -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBytes
      ( \Int
s ResponseHeaders
h ByteString
x ->
          Maybe ByteString -> Maybe Text -> Int -> GetMapTileResponse
GetMapTileResponse'
            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. a -> Maybe a
Prelude.Just (coerce :: forall a b. Coercible a b => a -> b
Prelude.coerce ByteString
x)))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (ResponseHeaders
h forall a.
FromText a =>
ResponseHeaders -> HeaderName -> Either String (Maybe a)
Data..#? HeaderName
"Content-Type")
            forall (f :: * -> *) a b. Applicative f => 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))
      )

instance Prelude.Hashable GetMapTile where
  hashWithSalt :: Int -> GetMapTile -> Int
hashWithSalt Int
_salt GetMapTile' {Text
z :: Text
y :: Text
x :: Text
mapName :: Text
$sel:z:GetMapTile' :: GetMapTile -> Text
$sel:y:GetMapTile' :: GetMapTile -> Text
$sel:x:GetMapTile' :: GetMapTile -> Text
$sel:mapName:GetMapTile' :: GetMapTile -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
mapName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
x
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
y
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
z

instance Prelude.NFData GetMapTile where
  rnf :: GetMapTile -> ()
rnf GetMapTile' {Text
z :: Text
y :: Text
x :: Text
mapName :: Text
$sel:z:GetMapTile' :: GetMapTile -> Text
$sel:y:GetMapTile' :: GetMapTile -> Text
$sel:x:GetMapTile' :: GetMapTile -> Text
$sel:mapName:GetMapTile' :: GetMapTile -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
mapName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
x
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
y
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
z

instance Data.ToHeaders GetMapTile where
  toHeaders :: GetMapTile -> 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.ToPath GetMapTile where
  toPath :: GetMapTile -> ByteString
toPath GetMapTile' {Text
z :: Text
y :: Text
x :: Text
mapName :: Text
$sel:z:GetMapTile' :: GetMapTile -> Text
$sel:y:GetMapTile' :: GetMapTile -> Text
$sel:x:GetMapTile' :: GetMapTile -> Text
$sel:mapName:GetMapTile' :: GetMapTile -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/maps/v0/maps/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
mapName,
        ByteString
"/tiles/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
z,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
x,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
y
      ]

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

-- | /See:/ 'newGetMapTileResponse' smart constructor.
data GetMapTileResponse = GetMapTileResponse'
  { -- | Contains Mapbox Vector Tile (MVT) data.
    GetMapTileResponse -> Maybe ByteString
blob :: Prelude.Maybe Prelude.ByteString,
    -- | The map tile\'s content type. For example,
    -- @application\/vnd.mapbox-vector-tile@.
    GetMapTileResponse -> Maybe Text
contentType :: Prelude.Maybe Prelude.Text,
    -- | The response's http status code.
    GetMapTileResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetMapTileResponse -> GetMapTileResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMapTileResponse -> GetMapTileResponse -> Bool
$c/= :: GetMapTileResponse -> GetMapTileResponse -> Bool
== :: GetMapTileResponse -> GetMapTileResponse -> Bool
$c== :: GetMapTileResponse -> GetMapTileResponse -> Bool
Prelude.Eq, ReadPrec [GetMapTileResponse]
ReadPrec GetMapTileResponse
Int -> ReadS GetMapTileResponse
ReadS [GetMapTileResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMapTileResponse]
$creadListPrec :: ReadPrec [GetMapTileResponse]
readPrec :: ReadPrec GetMapTileResponse
$creadPrec :: ReadPrec GetMapTileResponse
readList :: ReadS [GetMapTileResponse]
$creadList :: ReadS [GetMapTileResponse]
readsPrec :: Int -> ReadS GetMapTileResponse
$creadsPrec :: Int -> ReadS GetMapTileResponse
Prelude.Read, Int -> GetMapTileResponse -> ShowS
[GetMapTileResponse] -> ShowS
GetMapTileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMapTileResponse] -> ShowS
$cshowList :: [GetMapTileResponse] -> ShowS
show :: GetMapTileResponse -> String
$cshow :: GetMapTileResponse -> String
showsPrec :: Int -> GetMapTileResponse -> ShowS
$cshowsPrec :: Int -> GetMapTileResponse -> ShowS
Prelude.Show, forall x. Rep GetMapTileResponse x -> GetMapTileResponse
forall x. GetMapTileResponse -> Rep GetMapTileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMapTileResponse x -> GetMapTileResponse
$cfrom :: forall x. GetMapTileResponse -> Rep GetMapTileResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetMapTileResponse' 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:
--
-- 'blob', 'getMapTileResponse_blob' - Contains Mapbox Vector Tile (MVT) data.
--
-- 'contentType', 'getMapTileResponse_contentType' - The map tile\'s content type. For example,
-- @application\/vnd.mapbox-vector-tile@.
--
-- 'httpStatus', 'getMapTileResponse_httpStatus' - The response's http status code.
newGetMapTileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMapTileResponse
newGetMapTileResponse :: Int -> GetMapTileResponse
newGetMapTileResponse Int
pHttpStatus_ =
  GetMapTileResponse'
    { $sel:blob:GetMapTileResponse' :: Maybe ByteString
blob = forall a. Maybe a
Prelude.Nothing,
      $sel:contentType:GetMapTileResponse' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetMapTileResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | Contains Mapbox Vector Tile (MVT) data.
getMapTileResponse_blob :: Lens.Lens' GetMapTileResponse (Prelude.Maybe Prelude.ByteString)
getMapTileResponse_blob :: Lens' GetMapTileResponse (Maybe ByteString)
getMapTileResponse_blob = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapTileResponse' {Maybe ByteString
blob :: Maybe ByteString
$sel:blob:GetMapTileResponse' :: GetMapTileResponse -> Maybe ByteString
blob} -> Maybe ByteString
blob) (\s :: GetMapTileResponse
s@GetMapTileResponse' {} Maybe ByteString
a -> GetMapTileResponse
s {$sel:blob:GetMapTileResponse' :: Maybe ByteString
blob = Maybe ByteString
a} :: GetMapTileResponse)

-- | The map tile\'s content type. For example,
-- @application\/vnd.mapbox-vector-tile@.
getMapTileResponse_contentType :: Lens.Lens' GetMapTileResponse (Prelude.Maybe Prelude.Text)
getMapTileResponse_contentType :: Lens' GetMapTileResponse (Maybe Text)
getMapTileResponse_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapTileResponse' {Maybe Text
contentType :: Maybe Text
$sel:contentType:GetMapTileResponse' :: GetMapTileResponse -> Maybe Text
contentType} -> Maybe Text
contentType) (\s :: GetMapTileResponse
s@GetMapTileResponse' {} Maybe Text
a -> GetMapTileResponse
s {$sel:contentType:GetMapTileResponse' :: Maybe Text
contentType = Maybe Text
a} :: GetMapTileResponse)

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

instance Prelude.NFData GetMapTileResponse where
  rnf :: GetMapTileResponse -> ()
rnf GetMapTileResponse' {Int
Maybe ByteString
Maybe Text
httpStatus :: Int
contentType :: Maybe Text
blob :: Maybe ByteString
$sel:httpStatus:GetMapTileResponse' :: GetMapTileResponse -> Int
$sel:contentType:GetMapTileResponse' :: GetMapTileResponse -> Maybe Text
$sel:blob:GetMapTileResponse' :: GetMapTileResponse -> Maybe ByteString
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe ByteString
blob
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
contentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
httpStatus