{-# 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.GetMapGlyphs
-- 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 glyphs used to display labels on a map.
module Amazonka.Location.GetMapGlyphs
  ( -- * Creating a Request
    GetMapGlyphs (..),
    newGetMapGlyphs,

    -- * Request Lenses
    getMapGlyphs_fontStack,
    getMapGlyphs_fontUnicodeRange,
    getMapGlyphs_mapName,

    -- * Destructuring the Response
    GetMapGlyphsResponse (..),
    newGetMapGlyphsResponse,

    -- * Response Lenses
    getMapGlyphsResponse_blob,
    getMapGlyphsResponse_contentType,
    getMapGlyphsResponse_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:/ 'newGetMapGlyphs' smart constructor.
data GetMapGlyphs = GetMapGlyphs'
  { -- | A comma-separated list of fonts to load glyphs from in order of
    -- preference. For example, @Noto Sans Regular, Arial Unicode@.
    --
    -- Valid fonts stacks for
    -- <https://docs.aws.amazon.com/location/latest/developerguide/esri.html Esri>
    -- styles:
    --
    -- -   VectorEsriDarkGrayCanvas – @Ubuntu Medium Italic@ | @Ubuntu Medium@
    --     | @Ubuntu Italic@ | @Ubuntu Regular@ | @Ubuntu Bold@
    --
    -- -   VectorEsriLightGrayCanvas – @Ubuntu Italic@ | @Ubuntu Regular@ |
    --     @Ubuntu Light@ | @Ubuntu Bold@
    --
    -- -   VectorEsriTopographic – @Noto Sans Italic@ | @Noto Sans Regular@ |
    --     @Noto Sans Bold@ | @Noto Serif Regular@ |
    --     @Roboto Condensed Light Italic@
    --
    -- -   VectorEsriStreets – @Arial Regular@ | @Arial Italic@ | @Arial Bold@
    --
    -- -   VectorEsriNavigation – @Arial Regular@ | @Arial Italic@ |
    --     @Arial Bold@
    --
    -- Valid font stacks for
    -- <https://docs.aws.amazon.com/location/latest/developerguide/HERE.html HERE Technologies>
    -- styles:
    --
    -- -   VectorHereContrast – @Fira GO Regular@ | @Fira GO Bold@
    --
    -- -   VectorHereExplore, VectorHereExploreTruck,
    --     HybridHereExploreSatellite – @Fira GO Italic@ | @Fira GO Map@ |
    --     @Fira GO Map Bold@ | @Noto Sans CJK JP Bold@ |
    --     @Noto Sans CJK JP Light@ | @Noto Sans CJK JP Regular@
    --
    -- Valid font stacks for
    -- <https://docs.aws.amazon.com/location/latest/developerguide/open-data.html Open Data (Preview)>
    -- styles:
    --
    -- -   VectorOpenDataStandardLight –
    --     @Amazon Ember Regular,Noto Sans Regular@ |
    --     @Amazon Ember Bold,Noto Sans Bold@ |
    --     @Amazon Ember Medium,Noto Sans Medium@ |
    --     @Amazon Ember Regular Italic,Noto Sans Italic@ |
    --     @Amazon Ember Condensed RC Regular,Noto Sans Regular@ |
    --     @Amazon Ember Condensed RC Bold,Noto Sans Bold@
    --
    -- The fonts used by @VectorOpenDataStandardLight@ are combined fonts that
    -- use @Amazon Ember@ for most glyphs but @Noto Sans@ for glyphs
    -- unsupported by @Amazon Ember@.
    GetMapGlyphs -> Text
fontStack :: Prelude.Text,
    -- | A Unicode range of characters to download glyphs for. Each response will
    -- contain 256 characters. For example, 0–255 includes all characters from
    -- range @U+0000@ to @00FF@. Must be aligned to multiples of 256.
    GetMapGlyphs -> Text
fontUnicodeRange :: Prelude.Text,
    -- | The map resource associated with the glyph file.
    GetMapGlyphs -> Text
mapName :: Prelude.Text
  }
  deriving (GetMapGlyphs -> GetMapGlyphs -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetMapGlyphs -> GetMapGlyphs -> Bool
$c/= :: GetMapGlyphs -> GetMapGlyphs -> Bool
== :: GetMapGlyphs -> GetMapGlyphs -> Bool
$c== :: GetMapGlyphs -> GetMapGlyphs -> Bool
Prelude.Eq, ReadPrec [GetMapGlyphs]
ReadPrec GetMapGlyphs
Int -> ReadS GetMapGlyphs
ReadS [GetMapGlyphs]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetMapGlyphs]
$creadListPrec :: ReadPrec [GetMapGlyphs]
readPrec :: ReadPrec GetMapGlyphs
$creadPrec :: ReadPrec GetMapGlyphs
readList :: ReadS [GetMapGlyphs]
$creadList :: ReadS [GetMapGlyphs]
readsPrec :: Int -> ReadS GetMapGlyphs
$creadsPrec :: Int -> ReadS GetMapGlyphs
Prelude.Read, Int -> GetMapGlyphs -> ShowS
[GetMapGlyphs] -> ShowS
GetMapGlyphs -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetMapGlyphs] -> ShowS
$cshowList :: [GetMapGlyphs] -> ShowS
show :: GetMapGlyphs -> String
$cshow :: GetMapGlyphs -> String
showsPrec :: Int -> GetMapGlyphs -> ShowS
$cshowsPrec :: Int -> GetMapGlyphs -> ShowS
Prelude.Show, forall x. Rep GetMapGlyphs x -> GetMapGlyphs
forall x. GetMapGlyphs -> Rep GetMapGlyphs x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetMapGlyphs x -> GetMapGlyphs
$cfrom :: forall x. GetMapGlyphs -> Rep GetMapGlyphs x
Prelude.Generic)

-- |
-- Create a value of 'GetMapGlyphs' 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:
--
-- 'fontStack', 'getMapGlyphs_fontStack' - A comma-separated list of fonts to load glyphs from in order of
-- preference. For example, @Noto Sans Regular, Arial Unicode@.
--
-- Valid fonts stacks for
-- <https://docs.aws.amazon.com/location/latest/developerguide/esri.html Esri>
-- styles:
--
-- -   VectorEsriDarkGrayCanvas – @Ubuntu Medium Italic@ | @Ubuntu Medium@
--     | @Ubuntu Italic@ | @Ubuntu Regular@ | @Ubuntu Bold@
--
-- -   VectorEsriLightGrayCanvas – @Ubuntu Italic@ | @Ubuntu Regular@ |
--     @Ubuntu Light@ | @Ubuntu Bold@
--
-- -   VectorEsriTopographic – @Noto Sans Italic@ | @Noto Sans Regular@ |
--     @Noto Sans Bold@ | @Noto Serif Regular@ |
--     @Roboto Condensed Light Italic@
--
-- -   VectorEsriStreets – @Arial Regular@ | @Arial Italic@ | @Arial Bold@
--
-- -   VectorEsriNavigation – @Arial Regular@ | @Arial Italic@ |
--     @Arial Bold@
--
-- Valid font stacks for
-- <https://docs.aws.amazon.com/location/latest/developerguide/HERE.html HERE Technologies>
-- styles:
--
-- -   VectorHereContrast – @Fira GO Regular@ | @Fira GO Bold@
--
-- -   VectorHereExplore, VectorHereExploreTruck,
--     HybridHereExploreSatellite – @Fira GO Italic@ | @Fira GO Map@ |
--     @Fira GO Map Bold@ | @Noto Sans CJK JP Bold@ |
--     @Noto Sans CJK JP Light@ | @Noto Sans CJK JP Regular@
--
-- Valid font stacks for
-- <https://docs.aws.amazon.com/location/latest/developerguide/open-data.html Open Data (Preview)>
-- styles:
--
-- -   VectorOpenDataStandardLight –
--     @Amazon Ember Regular,Noto Sans Regular@ |
--     @Amazon Ember Bold,Noto Sans Bold@ |
--     @Amazon Ember Medium,Noto Sans Medium@ |
--     @Amazon Ember Regular Italic,Noto Sans Italic@ |
--     @Amazon Ember Condensed RC Regular,Noto Sans Regular@ |
--     @Amazon Ember Condensed RC Bold,Noto Sans Bold@
--
-- The fonts used by @VectorOpenDataStandardLight@ are combined fonts that
-- use @Amazon Ember@ for most glyphs but @Noto Sans@ for glyphs
-- unsupported by @Amazon Ember@.
--
-- 'fontUnicodeRange', 'getMapGlyphs_fontUnicodeRange' - A Unicode range of characters to download glyphs for. Each response will
-- contain 256 characters. For example, 0–255 includes all characters from
-- range @U+0000@ to @00FF@. Must be aligned to multiples of 256.
--
-- 'mapName', 'getMapGlyphs_mapName' - The map resource associated with the glyph file.
newGetMapGlyphs ::
  -- | 'fontStack'
  Prelude.Text ->
  -- | 'fontUnicodeRange'
  Prelude.Text ->
  -- | 'mapName'
  Prelude.Text ->
  GetMapGlyphs
newGetMapGlyphs :: Text -> Text -> Text -> GetMapGlyphs
newGetMapGlyphs
  Text
pFontStack_
  Text
pFontUnicodeRange_
  Text
pMapName_ =
    GetMapGlyphs'
      { $sel:fontStack:GetMapGlyphs' :: Text
fontStack = Text
pFontStack_,
        $sel:fontUnicodeRange:GetMapGlyphs' :: Text
fontUnicodeRange = Text
pFontUnicodeRange_,
        $sel:mapName:GetMapGlyphs' :: Text
mapName = Text
pMapName_
      }

-- | A comma-separated list of fonts to load glyphs from in order of
-- preference. For example, @Noto Sans Regular, Arial Unicode@.
--
-- Valid fonts stacks for
-- <https://docs.aws.amazon.com/location/latest/developerguide/esri.html Esri>
-- styles:
--
-- -   VectorEsriDarkGrayCanvas – @Ubuntu Medium Italic@ | @Ubuntu Medium@
--     | @Ubuntu Italic@ | @Ubuntu Regular@ | @Ubuntu Bold@
--
-- -   VectorEsriLightGrayCanvas – @Ubuntu Italic@ | @Ubuntu Regular@ |
--     @Ubuntu Light@ | @Ubuntu Bold@
--
-- -   VectorEsriTopographic – @Noto Sans Italic@ | @Noto Sans Regular@ |
--     @Noto Sans Bold@ | @Noto Serif Regular@ |
--     @Roboto Condensed Light Italic@
--
-- -   VectorEsriStreets – @Arial Regular@ | @Arial Italic@ | @Arial Bold@
--
-- -   VectorEsriNavigation – @Arial Regular@ | @Arial Italic@ |
--     @Arial Bold@
--
-- Valid font stacks for
-- <https://docs.aws.amazon.com/location/latest/developerguide/HERE.html HERE Technologies>
-- styles:
--
-- -   VectorHereContrast – @Fira GO Regular@ | @Fira GO Bold@
--
-- -   VectorHereExplore, VectorHereExploreTruck,
--     HybridHereExploreSatellite – @Fira GO Italic@ | @Fira GO Map@ |
--     @Fira GO Map Bold@ | @Noto Sans CJK JP Bold@ |
--     @Noto Sans CJK JP Light@ | @Noto Sans CJK JP Regular@
--
-- Valid font stacks for
-- <https://docs.aws.amazon.com/location/latest/developerguide/open-data.html Open Data (Preview)>
-- styles:
--
-- -   VectorOpenDataStandardLight –
--     @Amazon Ember Regular,Noto Sans Regular@ |
--     @Amazon Ember Bold,Noto Sans Bold@ |
--     @Amazon Ember Medium,Noto Sans Medium@ |
--     @Amazon Ember Regular Italic,Noto Sans Italic@ |
--     @Amazon Ember Condensed RC Regular,Noto Sans Regular@ |
--     @Amazon Ember Condensed RC Bold,Noto Sans Bold@
--
-- The fonts used by @VectorOpenDataStandardLight@ are combined fonts that
-- use @Amazon Ember@ for most glyphs but @Noto Sans@ for glyphs
-- unsupported by @Amazon Ember@.
getMapGlyphs_fontStack :: Lens.Lens' GetMapGlyphs Prelude.Text
getMapGlyphs_fontStack :: Lens' GetMapGlyphs Text
getMapGlyphs_fontStack = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapGlyphs' {Text
fontStack :: Text
$sel:fontStack:GetMapGlyphs' :: GetMapGlyphs -> Text
fontStack} -> Text
fontStack) (\s :: GetMapGlyphs
s@GetMapGlyphs' {} Text
a -> GetMapGlyphs
s {$sel:fontStack:GetMapGlyphs' :: Text
fontStack = Text
a} :: GetMapGlyphs)

-- | A Unicode range of characters to download glyphs for. Each response will
-- contain 256 characters. For example, 0–255 includes all characters from
-- range @U+0000@ to @00FF@. Must be aligned to multiples of 256.
getMapGlyphs_fontUnicodeRange :: Lens.Lens' GetMapGlyphs Prelude.Text
getMapGlyphs_fontUnicodeRange :: Lens' GetMapGlyphs Text
getMapGlyphs_fontUnicodeRange = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapGlyphs' {Text
fontUnicodeRange :: Text
$sel:fontUnicodeRange:GetMapGlyphs' :: GetMapGlyphs -> Text
fontUnicodeRange} -> Text
fontUnicodeRange) (\s :: GetMapGlyphs
s@GetMapGlyphs' {} Text
a -> GetMapGlyphs
s {$sel:fontUnicodeRange:GetMapGlyphs' :: Text
fontUnicodeRange = Text
a} :: GetMapGlyphs)

-- | The map resource associated with the glyph file.
getMapGlyphs_mapName :: Lens.Lens' GetMapGlyphs Prelude.Text
getMapGlyphs_mapName :: Lens' GetMapGlyphs Text
getMapGlyphs_mapName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapGlyphs' {Text
mapName :: Text
$sel:mapName:GetMapGlyphs' :: GetMapGlyphs -> Text
mapName} -> Text
mapName) (\s :: GetMapGlyphs
s@GetMapGlyphs' {} Text
a -> GetMapGlyphs
s {$sel:mapName:GetMapGlyphs' :: Text
mapName = Text
a} :: GetMapGlyphs)

instance Core.AWSRequest GetMapGlyphs where
  type AWSResponse GetMapGlyphs = GetMapGlyphsResponse
  request :: (Service -> Service) -> GetMapGlyphs -> Request GetMapGlyphs
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 GetMapGlyphs
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetMapGlyphs)))
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 -> GetMapGlyphsResponse
GetMapGlyphsResponse'
            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 GetMapGlyphs where
  hashWithSalt :: Int -> GetMapGlyphs -> Int
hashWithSalt Int
_salt GetMapGlyphs' {Text
mapName :: Text
fontUnicodeRange :: Text
fontStack :: Text
$sel:mapName:GetMapGlyphs' :: GetMapGlyphs -> Text
$sel:fontUnicodeRange:GetMapGlyphs' :: GetMapGlyphs -> Text
$sel:fontStack:GetMapGlyphs' :: GetMapGlyphs -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fontStack
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
fontUnicodeRange
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
mapName

instance Prelude.NFData GetMapGlyphs where
  rnf :: GetMapGlyphs -> ()
rnf GetMapGlyphs' {Text
mapName :: Text
fontUnicodeRange :: Text
fontStack :: Text
$sel:mapName:GetMapGlyphs' :: GetMapGlyphs -> Text
$sel:fontUnicodeRange:GetMapGlyphs' :: GetMapGlyphs -> Text
$sel:fontStack:GetMapGlyphs' :: GetMapGlyphs -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
fontStack
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
fontUnicodeRange
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
mapName

instance Data.ToHeaders GetMapGlyphs where
  toHeaders :: GetMapGlyphs -> 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 GetMapGlyphs where
  toPath :: GetMapGlyphs -> ByteString
toPath GetMapGlyphs' {Text
mapName :: Text
fontUnicodeRange :: Text
fontStack :: Text
$sel:mapName:GetMapGlyphs' :: GetMapGlyphs -> Text
$sel:fontUnicodeRange:GetMapGlyphs' :: GetMapGlyphs -> Text
$sel:fontStack:GetMapGlyphs' :: GetMapGlyphs -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/maps/v0/maps/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
mapName,
        ByteString
"/glyphs/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
fontStack,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
fontUnicodeRange
      ]

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

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

-- |
-- Create a value of 'GetMapGlyphsResponse' 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', 'getMapGlyphsResponse_blob' - The blob\'s content type.
--
-- 'contentType', 'getMapGlyphsResponse_contentType' - The map glyph content type. For example, @application\/octet-stream@.
--
-- 'httpStatus', 'getMapGlyphsResponse_httpStatus' - The response's http status code.
newGetMapGlyphsResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetMapGlyphsResponse
newGetMapGlyphsResponse :: Int -> GetMapGlyphsResponse
newGetMapGlyphsResponse Int
pHttpStatus_ =
  GetMapGlyphsResponse'
    { $sel:blob:GetMapGlyphsResponse' :: Maybe ByteString
blob = forall a. Maybe a
Prelude.Nothing,
      $sel:contentType:GetMapGlyphsResponse' :: Maybe Text
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetMapGlyphsResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The blob\'s content type.
getMapGlyphsResponse_blob :: Lens.Lens' GetMapGlyphsResponse (Prelude.Maybe Prelude.ByteString)
getMapGlyphsResponse_blob :: Lens' GetMapGlyphsResponse (Maybe ByteString)
getMapGlyphsResponse_blob = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapGlyphsResponse' {Maybe ByteString
blob :: Maybe ByteString
$sel:blob:GetMapGlyphsResponse' :: GetMapGlyphsResponse -> Maybe ByteString
blob} -> Maybe ByteString
blob) (\s :: GetMapGlyphsResponse
s@GetMapGlyphsResponse' {} Maybe ByteString
a -> GetMapGlyphsResponse
s {$sel:blob:GetMapGlyphsResponse' :: Maybe ByteString
blob = Maybe ByteString
a} :: GetMapGlyphsResponse)

-- | The map glyph content type. For example, @application\/octet-stream@.
getMapGlyphsResponse_contentType :: Lens.Lens' GetMapGlyphsResponse (Prelude.Maybe Prelude.Text)
getMapGlyphsResponse_contentType :: Lens' GetMapGlyphsResponse (Maybe Text)
getMapGlyphsResponse_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetMapGlyphsResponse' {Maybe Text
contentType :: Maybe Text
$sel:contentType:GetMapGlyphsResponse' :: GetMapGlyphsResponse -> Maybe Text
contentType} -> Maybe Text
contentType) (\s :: GetMapGlyphsResponse
s@GetMapGlyphsResponse' {} Maybe Text
a -> GetMapGlyphsResponse
s {$sel:contentType:GetMapGlyphsResponse' :: Maybe Text
contentType = Maybe Text
a} :: GetMapGlyphsResponse)

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

instance Prelude.NFData GetMapGlyphsResponse where
  rnf :: GetMapGlyphsResponse -> ()
rnf GetMapGlyphsResponse' {Int
Maybe ByteString
Maybe Text
httpStatus :: Int
contentType :: Maybe Text
blob :: Maybe ByteString
$sel:httpStatus:GetMapGlyphsResponse' :: GetMapGlyphsResponse -> Int
$sel:contentType:GetMapGlyphsResponse' :: GetMapGlyphsResponse -> Maybe Text
$sel:blob:GetMapGlyphsResponse' :: GetMapGlyphsResponse -> 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