{-# 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.SageMakerGeoSpatial.GetTile
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Gets a web mercator tile for the given Earth Observation job.
module Amazonka.SageMakerGeoSpatial.GetTile
  ( -- * Creating a Request
    GetTile (..),
    newGetTile,

    -- * Request Lenses
    getTile_imageMask,
    getTile_outputDataType,
    getTile_outputFormat,
    getTile_propertyFilters,
    getTile_timeRangeFilter,
    getTile_arn,
    getTile_imageAssets,
    getTile_target,
    getTile_x,
    getTile_y,
    getTile_z,

    -- * Destructuring the Response
    GetTileResponse (..),
    newGetTileResponse,

    -- * Response Lenses
    getTileResponse_httpStatus,
    getTileResponse_binaryFile,
  )
where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import qualified Amazonka.Prelude as Prelude
import qualified Amazonka.Request as Request
import qualified Amazonka.Response as Response
import Amazonka.SageMakerGeoSpatial.Types

-- | /See:/ 'newGetTile' smart constructor.
data GetTile = GetTile'
  { -- | Determines whether or not to return a valid data mask.
    GetTile -> Maybe Bool
imageMask :: Prelude.Maybe Prelude.Bool,
    -- | The output data type of the tile operation.
    GetTile -> Maybe OutputType
outputDataType :: Prelude.Maybe OutputType,
    -- | The data format of the output tile. The formats include .npy, .png and
    -- .jpg.
    GetTile -> Maybe Text
outputFormat :: Prelude.Maybe Prelude.Text,
    -- | Property filters for the imagery to tile.
    GetTile -> Maybe Text
propertyFilters :: Prelude.Maybe Prelude.Text,
    -- | Time range filter applied to imagery to find the images to tile.
    GetTile -> Maybe Text
timeRangeFilter :: Prelude.Maybe Prelude.Text,
    -- | The Amazon Resource Name (ARN) of the tile operation.
    GetTile -> Text
arn :: Prelude.Text,
    -- | The particular assets or bands to tile.
    GetTile -> NonEmpty Text
imageAssets :: Prelude.NonEmpty Prelude.Text,
    -- | Determines what part of the Earth Observation job to tile. \'INPUT\' or
    -- \'OUTPUT\' are the valid options.
    GetTile -> TargetOptions
target :: TargetOptions,
    -- | The x coordinate of the tile input.
    GetTile -> Int
x :: Prelude.Int,
    -- | The y coordinate of the tile input.
    GetTile -> Int
y :: Prelude.Int,
    -- | The z coordinate of the tile input.
    GetTile -> Int
z :: Prelude.Int
  }
  deriving (GetTile -> GetTile -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetTile -> GetTile -> Bool
$c/= :: GetTile -> GetTile -> Bool
== :: GetTile -> GetTile -> Bool
$c== :: GetTile -> GetTile -> Bool
Prelude.Eq, ReadPrec [GetTile]
ReadPrec GetTile
Int -> ReadS GetTile
ReadS [GetTile]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetTile]
$creadListPrec :: ReadPrec [GetTile]
readPrec :: ReadPrec GetTile
$creadPrec :: ReadPrec GetTile
readList :: ReadS [GetTile]
$creadList :: ReadS [GetTile]
readsPrec :: Int -> ReadS GetTile
$creadsPrec :: Int -> ReadS GetTile
Prelude.Read, Int -> GetTile -> ShowS
[GetTile] -> ShowS
GetTile -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTile] -> ShowS
$cshowList :: [GetTile] -> ShowS
show :: GetTile -> String
$cshow :: GetTile -> String
showsPrec :: Int -> GetTile -> ShowS
$cshowsPrec :: Int -> GetTile -> ShowS
Prelude.Show, forall x. Rep GetTile x -> GetTile
forall x. GetTile -> Rep GetTile x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTile x -> GetTile
$cfrom :: forall x. GetTile -> Rep GetTile x
Prelude.Generic)

-- |
-- Create a value of 'GetTile' 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:
--
-- 'imageMask', 'getTile_imageMask' - Determines whether or not to return a valid data mask.
--
-- 'outputDataType', 'getTile_outputDataType' - The output data type of the tile operation.
--
-- 'outputFormat', 'getTile_outputFormat' - The data format of the output tile. The formats include .npy, .png and
-- .jpg.
--
-- 'propertyFilters', 'getTile_propertyFilters' - Property filters for the imagery to tile.
--
-- 'timeRangeFilter', 'getTile_timeRangeFilter' - Time range filter applied to imagery to find the images to tile.
--
-- 'arn', 'getTile_arn' - The Amazon Resource Name (ARN) of the tile operation.
--
-- 'imageAssets', 'getTile_imageAssets' - The particular assets or bands to tile.
--
-- 'target', 'getTile_target' - Determines what part of the Earth Observation job to tile. \'INPUT\' or
-- \'OUTPUT\' are the valid options.
--
-- 'x', 'getTile_x' - The x coordinate of the tile input.
--
-- 'y', 'getTile_y' - The y coordinate of the tile input.
--
-- 'z', 'getTile_z' - The z coordinate of the tile input.
newGetTile ::
  -- | 'arn'
  Prelude.Text ->
  -- | 'imageAssets'
  Prelude.NonEmpty Prelude.Text ->
  -- | 'target'
  TargetOptions ->
  -- | 'x'
  Prelude.Int ->
  -- | 'y'
  Prelude.Int ->
  -- | 'z'
  Prelude.Int ->
  GetTile
newGetTile :: Text
-> NonEmpty Text -> TargetOptions -> Int -> Int -> Int -> GetTile
newGetTile Text
pArn_ NonEmpty Text
pImageAssets_ TargetOptions
pTarget_ Int
pX_ Int
pY_ Int
pZ_ =
  GetTile'
    { $sel:imageMask:GetTile' :: Maybe Bool
imageMask = forall a. Maybe a
Prelude.Nothing,
      $sel:outputDataType:GetTile' :: Maybe OutputType
outputDataType = forall a. Maybe a
Prelude.Nothing,
      $sel:outputFormat:GetTile' :: Maybe Text
outputFormat = forall a. Maybe a
Prelude.Nothing,
      $sel:propertyFilters:GetTile' :: Maybe Text
propertyFilters = forall a. Maybe a
Prelude.Nothing,
      $sel:timeRangeFilter:GetTile' :: Maybe Text
timeRangeFilter = forall a. Maybe a
Prelude.Nothing,
      $sel:arn:GetTile' :: Text
arn = Text
pArn_,
      $sel:imageAssets:GetTile' :: NonEmpty Text
imageAssets = forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced forall t b. AReview t b -> b -> t
Lens.# NonEmpty Text
pImageAssets_,
      $sel:target:GetTile' :: TargetOptions
target = TargetOptions
pTarget_,
      $sel:x:GetTile' :: Int
x = Int
pX_,
      $sel:y:GetTile' :: Int
y = Int
pY_,
      $sel:z:GetTile' :: Int
z = Int
pZ_
    }

-- | Determines whether or not to return a valid data mask.
getTile_imageMask :: Lens.Lens' GetTile (Prelude.Maybe Prelude.Bool)
getTile_imageMask :: Lens' GetTile (Maybe Bool)
getTile_imageMask = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTile' {Maybe Bool
imageMask :: Maybe Bool
$sel:imageMask:GetTile' :: GetTile -> Maybe Bool
imageMask} -> Maybe Bool
imageMask) (\s :: GetTile
s@GetTile' {} Maybe Bool
a -> GetTile
s {$sel:imageMask:GetTile' :: Maybe Bool
imageMask = Maybe Bool
a} :: GetTile)

-- | The output data type of the tile operation.
getTile_outputDataType :: Lens.Lens' GetTile (Prelude.Maybe OutputType)
getTile_outputDataType :: Lens' GetTile (Maybe OutputType)
getTile_outputDataType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTile' {Maybe OutputType
outputDataType :: Maybe OutputType
$sel:outputDataType:GetTile' :: GetTile -> Maybe OutputType
outputDataType} -> Maybe OutputType
outputDataType) (\s :: GetTile
s@GetTile' {} Maybe OutputType
a -> GetTile
s {$sel:outputDataType:GetTile' :: Maybe OutputType
outputDataType = Maybe OutputType
a} :: GetTile)

-- | The data format of the output tile. The formats include .npy, .png and
-- .jpg.
getTile_outputFormat :: Lens.Lens' GetTile (Prelude.Maybe Prelude.Text)
getTile_outputFormat :: Lens' GetTile (Maybe Text)
getTile_outputFormat = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTile' {Maybe Text
outputFormat :: Maybe Text
$sel:outputFormat:GetTile' :: GetTile -> Maybe Text
outputFormat} -> Maybe Text
outputFormat) (\s :: GetTile
s@GetTile' {} Maybe Text
a -> GetTile
s {$sel:outputFormat:GetTile' :: Maybe Text
outputFormat = Maybe Text
a} :: GetTile)

-- | Property filters for the imagery to tile.
getTile_propertyFilters :: Lens.Lens' GetTile (Prelude.Maybe Prelude.Text)
getTile_propertyFilters :: Lens' GetTile (Maybe Text)
getTile_propertyFilters = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTile' {Maybe Text
propertyFilters :: Maybe Text
$sel:propertyFilters:GetTile' :: GetTile -> Maybe Text
propertyFilters} -> Maybe Text
propertyFilters) (\s :: GetTile
s@GetTile' {} Maybe Text
a -> GetTile
s {$sel:propertyFilters:GetTile' :: Maybe Text
propertyFilters = Maybe Text
a} :: GetTile)

-- | Time range filter applied to imagery to find the images to tile.
getTile_timeRangeFilter :: Lens.Lens' GetTile (Prelude.Maybe Prelude.Text)
getTile_timeRangeFilter :: Lens' GetTile (Maybe Text)
getTile_timeRangeFilter = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTile' {Maybe Text
timeRangeFilter :: Maybe Text
$sel:timeRangeFilter:GetTile' :: GetTile -> Maybe Text
timeRangeFilter} -> Maybe Text
timeRangeFilter) (\s :: GetTile
s@GetTile' {} Maybe Text
a -> GetTile
s {$sel:timeRangeFilter:GetTile' :: Maybe Text
timeRangeFilter = Maybe Text
a} :: GetTile)

-- | The Amazon Resource Name (ARN) of the tile operation.
getTile_arn :: Lens.Lens' GetTile Prelude.Text
getTile_arn :: Lens' GetTile Text
getTile_arn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTile' {Text
arn :: Text
$sel:arn:GetTile' :: GetTile -> Text
arn} -> Text
arn) (\s :: GetTile
s@GetTile' {} Text
a -> GetTile
s {$sel:arn:GetTile' :: Text
arn = Text
a} :: GetTile)

-- | The particular assets or bands to tile.
getTile_imageAssets :: Lens.Lens' GetTile (Prelude.NonEmpty Prelude.Text)
getTile_imageAssets :: Lens' GetTile (NonEmpty Text)
getTile_imageAssets = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTile' {NonEmpty Text
imageAssets :: NonEmpty Text
$sel:imageAssets:GetTile' :: GetTile -> NonEmpty Text
imageAssets} -> NonEmpty Text
imageAssets) (\s :: GetTile
s@GetTile' {} NonEmpty Text
a -> GetTile
s {$sel:imageAssets:GetTile' :: NonEmpty Text
imageAssets = NonEmpty Text
a} :: GetTile) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall s t a b. (Coercible s a, Coercible t b) => Iso s t a b
Lens.coerced

-- | Determines what part of the Earth Observation job to tile. \'INPUT\' or
-- \'OUTPUT\' are the valid options.
getTile_target :: Lens.Lens' GetTile TargetOptions
getTile_target :: Lens' GetTile TargetOptions
getTile_target = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTile' {TargetOptions
target :: TargetOptions
$sel:target:GetTile' :: GetTile -> TargetOptions
target} -> TargetOptions
target) (\s :: GetTile
s@GetTile' {} TargetOptions
a -> GetTile
s {$sel:target:GetTile' :: TargetOptions
target = TargetOptions
a} :: GetTile)

-- | The x coordinate of the tile input.
getTile_x :: Lens.Lens' GetTile Prelude.Int
getTile_x :: Lens' GetTile Int
getTile_x = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTile' {Int
x :: Int
$sel:x:GetTile' :: GetTile -> Int
x} -> Int
x) (\s :: GetTile
s@GetTile' {} Int
a -> GetTile
s {$sel:x:GetTile' :: Int
x = Int
a} :: GetTile)

-- | The y coordinate of the tile input.
getTile_y :: Lens.Lens' GetTile Prelude.Int
getTile_y :: Lens' GetTile Int
getTile_y = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTile' {Int
y :: Int
$sel:y:GetTile' :: GetTile -> Int
y} -> Int
y) (\s :: GetTile
s@GetTile' {} Int
a -> GetTile
s {$sel:y:GetTile' :: Int
y = Int
a} :: GetTile)

-- | The z coordinate of the tile input.
getTile_z :: Lens.Lens' GetTile Prelude.Int
getTile_z :: Lens' GetTile Int
getTile_z = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTile' {Int
z :: Int
$sel:z:GetTile' :: GetTile -> Int
z} -> Int
z) (\s :: GetTile
s@GetTile' {} Int
a -> GetTile
s {$sel:z:GetTile' :: Int
z = Int
a} :: GetTile)

instance Core.AWSRequest GetTile where
  type AWSResponse GetTile = GetTileResponse
  request :: (Service -> Service) -> GetTile -> Request GetTile
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 GetTile
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetTile)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int
 -> ResponseHeaders
 -> ResponseBody
 -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveBody
      ( \Int
s ResponseHeaders
h ResponseBody
x ->
          Int -> ResponseBody -> GetTileResponse
GetTileResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure ResponseBody
x)
      )

instance Prelude.Hashable GetTile where
  hashWithSalt :: Int -> GetTile -> Int
hashWithSalt Int
_salt GetTile' {Int
Maybe Bool
Maybe Text
Maybe OutputType
NonEmpty Text
Text
TargetOptions
z :: Int
y :: Int
x :: Int
target :: TargetOptions
imageAssets :: NonEmpty Text
arn :: Text
timeRangeFilter :: Maybe Text
propertyFilters :: Maybe Text
outputFormat :: Maybe Text
outputDataType :: Maybe OutputType
imageMask :: Maybe Bool
$sel:z:GetTile' :: GetTile -> Int
$sel:y:GetTile' :: GetTile -> Int
$sel:x:GetTile' :: GetTile -> Int
$sel:target:GetTile' :: GetTile -> TargetOptions
$sel:imageAssets:GetTile' :: GetTile -> NonEmpty Text
$sel:arn:GetTile' :: GetTile -> Text
$sel:timeRangeFilter:GetTile' :: GetTile -> Maybe Text
$sel:propertyFilters:GetTile' :: GetTile -> Maybe Text
$sel:outputFormat:GetTile' :: GetTile -> Maybe Text
$sel:outputDataType:GetTile' :: GetTile -> Maybe OutputType
$sel:imageMask:GetTile' :: GetTile -> Maybe Bool
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Bool
imageMask
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe OutputType
outputDataType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
outputFormat
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
propertyFilters
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
timeRangeFilter
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
arn
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` NonEmpty Text
imageAssets
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` TargetOptions
target
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
x
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
y
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Int
z

instance Prelude.NFData GetTile where
  rnf :: GetTile -> ()
rnf GetTile' {Int
Maybe Bool
Maybe Text
Maybe OutputType
NonEmpty Text
Text
TargetOptions
z :: Int
y :: Int
x :: Int
target :: TargetOptions
imageAssets :: NonEmpty Text
arn :: Text
timeRangeFilter :: Maybe Text
propertyFilters :: Maybe Text
outputFormat :: Maybe Text
outputDataType :: Maybe OutputType
imageMask :: Maybe Bool
$sel:z:GetTile' :: GetTile -> Int
$sel:y:GetTile' :: GetTile -> Int
$sel:x:GetTile' :: GetTile -> Int
$sel:target:GetTile' :: GetTile -> TargetOptions
$sel:imageAssets:GetTile' :: GetTile -> NonEmpty Text
$sel:arn:GetTile' :: GetTile -> Text
$sel:timeRangeFilter:GetTile' :: GetTile -> Maybe Text
$sel:propertyFilters:GetTile' :: GetTile -> Maybe Text
$sel:outputFormat:GetTile' :: GetTile -> Maybe Text
$sel:outputDataType:GetTile' :: GetTile -> Maybe OutputType
$sel:imageMask:GetTile' :: GetTile -> Maybe Bool
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Bool
imageMask
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe OutputType
outputDataType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
outputFormat
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
propertyFilters
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
timeRangeFilter
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
arn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf NonEmpty Text
imageAssets
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf TargetOptions
target
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
x
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
y
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Int
z

instance Data.ToHeaders GetTile where
  toHeaders :: GetTile -> 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 GetTile where
  toPath :: GetTile -> ByteString
toPath GetTile' {Int
Maybe Bool
Maybe Text
Maybe OutputType
NonEmpty Text
Text
TargetOptions
z :: Int
y :: Int
x :: Int
target :: TargetOptions
imageAssets :: NonEmpty Text
arn :: Text
timeRangeFilter :: Maybe Text
propertyFilters :: Maybe Text
outputFormat :: Maybe Text
outputDataType :: Maybe OutputType
imageMask :: Maybe Bool
$sel:z:GetTile' :: GetTile -> Int
$sel:y:GetTile' :: GetTile -> Int
$sel:x:GetTile' :: GetTile -> Int
$sel:target:GetTile' :: GetTile -> TargetOptions
$sel:imageAssets:GetTile' :: GetTile -> NonEmpty Text
$sel:arn:GetTile' :: GetTile -> Text
$sel:timeRangeFilter:GetTile' :: GetTile -> Maybe Text
$sel:propertyFilters:GetTile' :: GetTile -> Maybe Text
$sel:outputFormat:GetTile' :: GetTile -> Maybe Text
$sel:outputDataType:GetTile' :: GetTile -> Maybe OutputType
$sel:imageMask:GetTile' :: GetTile -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/tile/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Int
z,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Int
x,
        ByteString
"/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Int
y
      ]

instance Data.ToQuery GetTile where
  toQuery :: GetTile -> QueryString
toQuery GetTile' {Int
Maybe Bool
Maybe Text
Maybe OutputType
NonEmpty Text
Text
TargetOptions
z :: Int
y :: Int
x :: Int
target :: TargetOptions
imageAssets :: NonEmpty Text
arn :: Text
timeRangeFilter :: Maybe Text
propertyFilters :: Maybe Text
outputFormat :: Maybe Text
outputDataType :: Maybe OutputType
imageMask :: Maybe Bool
$sel:z:GetTile' :: GetTile -> Int
$sel:y:GetTile' :: GetTile -> Int
$sel:x:GetTile' :: GetTile -> Int
$sel:target:GetTile' :: GetTile -> TargetOptions
$sel:imageAssets:GetTile' :: GetTile -> NonEmpty Text
$sel:arn:GetTile' :: GetTile -> Text
$sel:timeRangeFilter:GetTile' :: GetTile -> Maybe Text
$sel:propertyFilters:GetTile' :: GetTile -> Maybe Text
$sel:outputFormat:GetTile' :: GetTile -> Maybe Text
$sel:outputDataType:GetTile' :: GetTile -> Maybe OutputType
$sel:imageMask:GetTile' :: GetTile -> Maybe Bool
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"ImageMask" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Bool
imageMask,
        ByteString
"OutputDataType" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe OutputType
outputDataType,
        ByteString
"OutputFormat" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
outputFormat,
        ByteString
"PropertyFilters" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
propertyFilters,
        ByteString
"TimeRangeFilter" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
timeRangeFilter,
        ByteString
"Arn" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Text
arn,
        ByteString
"ImageAssets"
          forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: forall a.
(IsList a, ToQuery (Item a)) =>
ByteString -> a -> QueryString
Data.toQueryList ByteString
"member" NonEmpty Text
imageAssets,
        ByteString
"Target" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: TargetOptions
target
      ]

-- | /See:/ 'newGetTileResponse' smart constructor.
data GetTileResponse = GetTileResponse'
  { -- | The response's http status code.
    GetTileResponse -> Int
httpStatus :: Prelude.Int,
    -- | The output binary file.
    GetTileResponse -> ResponseBody
binaryFile :: Data.ResponseBody
  }
  deriving (Int -> GetTileResponse -> ShowS
[GetTileResponse] -> ShowS
GetTileResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetTileResponse] -> ShowS
$cshowList :: [GetTileResponse] -> ShowS
show :: GetTileResponse -> String
$cshow :: GetTileResponse -> String
showsPrec :: Int -> GetTileResponse -> ShowS
$cshowsPrec :: Int -> GetTileResponse -> ShowS
Prelude.Show, forall x. Rep GetTileResponse x -> GetTileResponse
forall x. GetTileResponse -> Rep GetTileResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetTileResponse x -> GetTileResponse
$cfrom :: forall x. GetTileResponse -> Rep GetTileResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetTileResponse' 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', 'getTileResponse_httpStatus' - The response's http status code.
--
-- 'binaryFile', 'getTileResponse_binaryFile' - The output binary file.
newGetTileResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'binaryFile'
  Data.ResponseBody ->
  GetTileResponse
newGetTileResponse :: Int -> ResponseBody -> GetTileResponse
newGetTileResponse Int
pHttpStatus_ ResponseBody
pBinaryFile_ =
  GetTileResponse'
    { $sel:httpStatus:GetTileResponse' :: Int
httpStatus = Int
pHttpStatus_,
      $sel:binaryFile:GetTileResponse' :: ResponseBody
binaryFile = ResponseBody
pBinaryFile_
    }

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

-- | The output binary file.
getTileResponse_binaryFile :: Lens.Lens' GetTileResponse Data.ResponseBody
getTileResponse_binaryFile :: Lens' GetTileResponse ResponseBody
getTileResponse_binaryFile = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetTileResponse' {ResponseBody
binaryFile :: ResponseBody
$sel:binaryFile:GetTileResponse' :: GetTileResponse -> ResponseBody
binaryFile} -> ResponseBody
binaryFile) (\s :: GetTileResponse
s@GetTileResponse' {} ResponseBody
a -> GetTileResponse
s {$sel:binaryFile:GetTileResponse' :: ResponseBody
binaryFile = ResponseBody
a} :: GetTileResponse)