{-# 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.IoTWireless.GetPositionEstimate
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Get estimated position information as a payload in GeoJSON format. The
-- payload measurement data is resolved using solvers that are provided by
-- third-party vendors.
module Amazonka.IoTWireless.GetPositionEstimate
  ( -- * Creating a Request
    GetPositionEstimate (..),
    newGetPositionEstimate,

    -- * Request Lenses
    getPositionEstimate_cellTowers,
    getPositionEstimate_gnss,
    getPositionEstimate_ip,
    getPositionEstimate_timestamp,
    getPositionEstimate_wiFiAccessPoints,

    -- * Destructuring the Response
    GetPositionEstimateResponse (..),
    newGetPositionEstimateResponse,

    -- * Response Lenses
    getPositionEstimateResponse_geoJsonPayload,
    getPositionEstimateResponse_httpStatus,
  )
where

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

-- | /See:/ 'newGetPositionEstimate' smart constructor.
data GetPositionEstimate = GetPositionEstimate'
  { -- | Retrieves an estimated device position by resolving measurement data
    -- from cellular radio towers. The position is resolved using HERE\'s
    -- cellular-based solver.
    GetPositionEstimate -> Maybe CellTowers
cellTowers :: Prelude.Maybe CellTowers,
    -- | Retrieves an estimated device position by resolving the global
    -- navigation satellite system (GNSS) scan data. The position is resolved
    -- using the GNSS solver powered by LoRa Cloud.
    GetPositionEstimate -> Maybe Gnss
gnss :: Prelude.Maybe Gnss,
    -- | Retrieves an estimated device position by resolving the IP address
    -- information from the device. The position is resolved using MaxMind\'s
    -- IP-based solver.
    GetPositionEstimate -> Maybe Ip
ip :: Prelude.Maybe Ip,
    -- | Optional information that specifies the time when the position
    -- information will be resolved. It uses the UNIX timestamp format. If not
    -- specified, the time at which the request was received will be used.
    GetPositionEstimate -> Maybe POSIX
timestamp :: Prelude.Maybe Data.POSIX,
    -- | Retrieves an estimated device position by resolving WLAN measurement
    -- data. The position is resolved using HERE\'s Wi-Fi based solver.
    GetPositionEstimate -> Maybe [WiFiAccessPoint]
wiFiAccessPoints :: Prelude.Maybe [WiFiAccessPoint]
  }
  deriving (GetPositionEstimate -> GetPositionEstimate -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPositionEstimate -> GetPositionEstimate -> Bool
$c/= :: GetPositionEstimate -> GetPositionEstimate -> Bool
== :: GetPositionEstimate -> GetPositionEstimate -> Bool
$c== :: GetPositionEstimate -> GetPositionEstimate -> Bool
Prelude.Eq, ReadPrec [GetPositionEstimate]
ReadPrec GetPositionEstimate
Int -> ReadS GetPositionEstimate
ReadS [GetPositionEstimate]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPositionEstimate]
$creadListPrec :: ReadPrec [GetPositionEstimate]
readPrec :: ReadPrec GetPositionEstimate
$creadPrec :: ReadPrec GetPositionEstimate
readList :: ReadS [GetPositionEstimate]
$creadList :: ReadS [GetPositionEstimate]
readsPrec :: Int -> ReadS GetPositionEstimate
$creadsPrec :: Int -> ReadS GetPositionEstimate
Prelude.Read, Int -> GetPositionEstimate -> ShowS
[GetPositionEstimate] -> ShowS
GetPositionEstimate -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPositionEstimate] -> ShowS
$cshowList :: [GetPositionEstimate] -> ShowS
show :: GetPositionEstimate -> String
$cshow :: GetPositionEstimate -> String
showsPrec :: Int -> GetPositionEstimate -> ShowS
$cshowsPrec :: Int -> GetPositionEstimate -> ShowS
Prelude.Show, forall x. Rep GetPositionEstimate x -> GetPositionEstimate
forall x. GetPositionEstimate -> Rep GetPositionEstimate x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetPositionEstimate x -> GetPositionEstimate
$cfrom :: forall x. GetPositionEstimate -> Rep GetPositionEstimate x
Prelude.Generic)

-- |
-- Create a value of 'GetPositionEstimate' 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:
--
-- 'cellTowers', 'getPositionEstimate_cellTowers' - Retrieves an estimated device position by resolving measurement data
-- from cellular radio towers. The position is resolved using HERE\'s
-- cellular-based solver.
--
-- 'gnss', 'getPositionEstimate_gnss' - Retrieves an estimated device position by resolving the global
-- navigation satellite system (GNSS) scan data. The position is resolved
-- using the GNSS solver powered by LoRa Cloud.
--
-- 'ip', 'getPositionEstimate_ip' - Retrieves an estimated device position by resolving the IP address
-- information from the device. The position is resolved using MaxMind\'s
-- IP-based solver.
--
-- 'timestamp', 'getPositionEstimate_timestamp' - Optional information that specifies the time when the position
-- information will be resolved. It uses the UNIX timestamp format. If not
-- specified, the time at which the request was received will be used.
--
-- 'wiFiAccessPoints', 'getPositionEstimate_wiFiAccessPoints' - Retrieves an estimated device position by resolving WLAN measurement
-- data. The position is resolved using HERE\'s Wi-Fi based solver.
newGetPositionEstimate ::
  GetPositionEstimate
newGetPositionEstimate :: GetPositionEstimate
newGetPositionEstimate =
  GetPositionEstimate'
    { $sel:cellTowers:GetPositionEstimate' :: Maybe CellTowers
cellTowers = forall a. Maybe a
Prelude.Nothing,
      $sel:gnss:GetPositionEstimate' :: Maybe Gnss
gnss = forall a. Maybe a
Prelude.Nothing,
      $sel:ip:GetPositionEstimate' :: Maybe Ip
ip = forall a. Maybe a
Prelude.Nothing,
      $sel:timestamp:GetPositionEstimate' :: Maybe POSIX
timestamp = forall a. Maybe a
Prelude.Nothing,
      $sel:wiFiAccessPoints:GetPositionEstimate' :: Maybe [WiFiAccessPoint]
wiFiAccessPoints = forall a. Maybe a
Prelude.Nothing
    }

-- | Retrieves an estimated device position by resolving measurement data
-- from cellular radio towers. The position is resolved using HERE\'s
-- cellular-based solver.
getPositionEstimate_cellTowers :: Lens.Lens' GetPositionEstimate (Prelude.Maybe CellTowers)
getPositionEstimate_cellTowers :: Lens' GetPositionEstimate (Maybe CellTowers)
getPositionEstimate_cellTowers = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPositionEstimate' {Maybe CellTowers
cellTowers :: Maybe CellTowers
$sel:cellTowers:GetPositionEstimate' :: GetPositionEstimate -> Maybe CellTowers
cellTowers} -> Maybe CellTowers
cellTowers) (\s :: GetPositionEstimate
s@GetPositionEstimate' {} Maybe CellTowers
a -> GetPositionEstimate
s {$sel:cellTowers:GetPositionEstimate' :: Maybe CellTowers
cellTowers = Maybe CellTowers
a} :: GetPositionEstimate)

-- | Retrieves an estimated device position by resolving the global
-- navigation satellite system (GNSS) scan data. The position is resolved
-- using the GNSS solver powered by LoRa Cloud.
getPositionEstimate_gnss :: Lens.Lens' GetPositionEstimate (Prelude.Maybe Gnss)
getPositionEstimate_gnss :: Lens' GetPositionEstimate (Maybe Gnss)
getPositionEstimate_gnss = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPositionEstimate' {Maybe Gnss
gnss :: Maybe Gnss
$sel:gnss:GetPositionEstimate' :: GetPositionEstimate -> Maybe Gnss
gnss} -> Maybe Gnss
gnss) (\s :: GetPositionEstimate
s@GetPositionEstimate' {} Maybe Gnss
a -> GetPositionEstimate
s {$sel:gnss:GetPositionEstimate' :: Maybe Gnss
gnss = Maybe Gnss
a} :: GetPositionEstimate)

-- | Retrieves an estimated device position by resolving the IP address
-- information from the device. The position is resolved using MaxMind\'s
-- IP-based solver.
getPositionEstimate_ip :: Lens.Lens' GetPositionEstimate (Prelude.Maybe Ip)
getPositionEstimate_ip :: Lens' GetPositionEstimate (Maybe Ip)
getPositionEstimate_ip = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPositionEstimate' {Maybe Ip
ip :: Maybe Ip
$sel:ip:GetPositionEstimate' :: GetPositionEstimate -> Maybe Ip
ip} -> Maybe Ip
ip) (\s :: GetPositionEstimate
s@GetPositionEstimate' {} Maybe Ip
a -> GetPositionEstimate
s {$sel:ip:GetPositionEstimate' :: Maybe Ip
ip = Maybe Ip
a} :: GetPositionEstimate)

-- | Optional information that specifies the time when the position
-- information will be resolved. It uses the UNIX timestamp format. If not
-- specified, the time at which the request was received will be used.
getPositionEstimate_timestamp :: Lens.Lens' GetPositionEstimate (Prelude.Maybe Prelude.UTCTime)
getPositionEstimate_timestamp :: Lens' GetPositionEstimate (Maybe UTCTime)
getPositionEstimate_timestamp = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPositionEstimate' {Maybe POSIX
timestamp :: Maybe POSIX
$sel:timestamp:GetPositionEstimate' :: GetPositionEstimate -> Maybe POSIX
timestamp} -> Maybe POSIX
timestamp) (\s :: GetPositionEstimate
s@GetPositionEstimate' {} Maybe POSIX
a -> GetPositionEstimate
s {$sel:timestamp:GetPositionEstimate' :: Maybe POSIX
timestamp = Maybe POSIX
a} :: GetPositionEstimate) 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 (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | Retrieves an estimated device position by resolving WLAN measurement
-- data. The position is resolved using HERE\'s Wi-Fi based solver.
getPositionEstimate_wiFiAccessPoints :: Lens.Lens' GetPositionEstimate (Prelude.Maybe [WiFiAccessPoint])
getPositionEstimate_wiFiAccessPoints :: Lens' GetPositionEstimate (Maybe [WiFiAccessPoint])
getPositionEstimate_wiFiAccessPoints = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPositionEstimate' {Maybe [WiFiAccessPoint]
wiFiAccessPoints :: Maybe [WiFiAccessPoint]
$sel:wiFiAccessPoints:GetPositionEstimate' :: GetPositionEstimate -> Maybe [WiFiAccessPoint]
wiFiAccessPoints} -> Maybe [WiFiAccessPoint]
wiFiAccessPoints) (\s :: GetPositionEstimate
s@GetPositionEstimate' {} Maybe [WiFiAccessPoint]
a -> GetPositionEstimate
s {$sel:wiFiAccessPoints:GetPositionEstimate' :: Maybe [WiFiAccessPoint]
wiFiAccessPoints = Maybe [WiFiAccessPoint]
a} :: GetPositionEstimate) 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

instance Core.AWSRequest GetPositionEstimate where
  type
    AWSResponse GetPositionEstimate =
      GetPositionEstimateResponse
  request :: (Service -> Service)
-> GetPositionEstimate -> Request GetPositionEstimate
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 GetPositionEstimate
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse GetPositionEstimate)))
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 -> Int -> GetPositionEstimateResponse
GetPositionEstimateResponse'
            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.<*> (forall (f :: * -> *) a. Applicative f => a -> f a
Prelude.pure (forall a. Enum a => a -> Int
Prelude.fromEnum Int
s))
      )

instance Prelude.Hashable GetPositionEstimate where
  hashWithSalt :: Int -> GetPositionEstimate -> Int
hashWithSalt Int
_salt GetPositionEstimate' {Maybe [WiFiAccessPoint]
Maybe POSIX
Maybe Gnss
Maybe Ip
Maybe CellTowers
wiFiAccessPoints :: Maybe [WiFiAccessPoint]
timestamp :: Maybe POSIX
ip :: Maybe Ip
gnss :: Maybe Gnss
cellTowers :: Maybe CellTowers
$sel:wiFiAccessPoints:GetPositionEstimate' :: GetPositionEstimate -> Maybe [WiFiAccessPoint]
$sel:timestamp:GetPositionEstimate' :: GetPositionEstimate -> Maybe POSIX
$sel:ip:GetPositionEstimate' :: GetPositionEstimate -> Maybe Ip
$sel:gnss:GetPositionEstimate' :: GetPositionEstimate -> Maybe Gnss
$sel:cellTowers:GetPositionEstimate' :: GetPositionEstimate -> Maybe CellTowers
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CellTowers
cellTowers
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Gnss
gnss
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Ip
ip
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe POSIX
timestamp
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [WiFiAccessPoint]
wiFiAccessPoints

instance Prelude.NFData GetPositionEstimate where
  rnf :: GetPositionEstimate -> ()
rnf GetPositionEstimate' {Maybe [WiFiAccessPoint]
Maybe POSIX
Maybe Gnss
Maybe Ip
Maybe CellTowers
wiFiAccessPoints :: Maybe [WiFiAccessPoint]
timestamp :: Maybe POSIX
ip :: Maybe Ip
gnss :: Maybe Gnss
cellTowers :: Maybe CellTowers
$sel:wiFiAccessPoints:GetPositionEstimate' :: GetPositionEstimate -> Maybe [WiFiAccessPoint]
$sel:timestamp:GetPositionEstimate' :: GetPositionEstimate -> Maybe POSIX
$sel:ip:GetPositionEstimate' :: GetPositionEstimate -> Maybe Ip
$sel:gnss:GetPositionEstimate' :: GetPositionEstimate -> Maybe Gnss
$sel:cellTowers:GetPositionEstimate' :: GetPositionEstimate -> Maybe CellTowers
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe CellTowers
cellTowers
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Gnss
gnss
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Ip
ip
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe POSIX
timestamp
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [WiFiAccessPoint]
wiFiAccessPoints

instance Data.ToHeaders GetPositionEstimate where
  toHeaders :: GetPositionEstimate -> ResponseHeaders
toHeaders = forall a b. a -> b -> a
Prelude.const forall a. Monoid a => a
Prelude.mempty

instance Data.ToJSON GetPositionEstimate where
  toJSON :: GetPositionEstimate -> Value
toJSON GetPositionEstimate' {Maybe [WiFiAccessPoint]
Maybe POSIX
Maybe Gnss
Maybe Ip
Maybe CellTowers
wiFiAccessPoints :: Maybe [WiFiAccessPoint]
timestamp :: Maybe POSIX
ip :: Maybe Ip
gnss :: Maybe Gnss
cellTowers :: Maybe CellTowers
$sel:wiFiAccessPoints:GetPositionEstimate' :: GetPositionEstimate -> Maybe [WiFiAccessPoint]
$sel:timestamp:GetPositionEstimate' :: GetPositionEstimate -> Maybe POSIX
$sel:ip:GetPositionEstimate' :: GetPositionEstimate -> Maybe Ip
$sel:gnss:GetPositionEstimate' :: GetPositionEstimate -> Maybe Gnss
$sel:cellTowers:GetPositionEstimate' :: GetPositionEstimate -> Maybe CellTowers
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"CellTowers" 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 CellTowers
cellTowers,
            (Key
"Gnss" 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 Gnss
gnss,
            (Key
"Ip" 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 Ip
ip,
            (Key
"Timestamp" 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 POSIX
timestamp,
            (Key
"WiFiAccessPoints" 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 [WiFiAccessPoint]
wiFiAccessPoints
          ]
      )

instance Data.ToPath GetPositionEstimate where
  toPath :: GetPositionEstimate -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/position-estimate"

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

-- | /See:/ 'newGetPositionEstimateResponse' smart constructor.
data GetPositionEstimateResponse = GetPositionEstimateResponse'
  { -- | The position information of the resource, displayed as a JSON payload.
    -- The payload uses the GeoJSON format, which a format that\'s used to
    -- encode geographic data structures. For more information, see
    -- <https://geojson.org/ GeoJSON>.
    GetPositionEstimateResponse -> Maybe ByteString
geoJsonPayload :: Prelude.Maybe Prelude.ByteString,
    -- | The response's http status code.
    GetPositionEstimateResponse -> Int
httpStatus :: Prelude.Int
  }
  deriving (GetPositionEstimateResponse -> GetPositionEstimateResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetPositionEstimateResponse -> GetPositionEstimateResponse -> Bool
$c/= :: GetPositionEstimateResponse -> GetPositionEstimateResponse -> Bool
== :: GetPositionEstimateResponse -> GetPositionEstimateResponse -> Bool
$c== :: GetPositionEstimateResponse -> GetPositionEstimateResponse -> Bool
Prelude.Eq, ReadPrec [GetPositionEstimateResponse]
ReadPrec GetPositionEstimateResponse
Int -> ReadS GetPositionEstimateResponse
ReadS [GetPositionEstimateResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetPositionEstimateResponse]
$creadListPrec :: ReadPrec [GetPositionEstimateResponse]
readPrec :: ReadPrec GetPositionEstimateResponse
$creadPrec :: ReadPrec GetPositionEstimateResponse
readList :: ReadS [GetPositionEstimateResponse]
$creadList :: ReadS [GetPositionEstimateResponse]
readsPrec :: Int -> ReadS GetPositionEstimateResponse
$creadsPrec :: Int -> ReadS GetPositionEstimateResponse
Prelude.Read, Int -> GetPositionEstimateResponse -> ShowS
[GetPositionEstimateResponse] -> ShowS
GetPositionEstimateResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetPositionEstimateResponse] -> ShowS
$cshowList :: [GetPositionEstimateResponse] -> ShowS
show :: GetPositionEstimateResponse -> String
$cshow :: GetPositionEstimateResponse -> String
showsPrec :: Int -> GetPositionEstimateResponse -> ShowS
$cshowsPrec :: Int -> GetPositionEstimateResponse -> ShowS
Prelude.Show, forall x.
Rep GetPositionEstimateResponse x -> GetPositionEstimateResponse
forall x.
GetPositionEstimateResponse -> Rep GetPositionEstimateResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep GetPositionEstimateResponse x -> GetPositionEstimateResponse
$cfrom :: forall x.
GetPositionEstimateResponse -> Rep GetPositionEstimateResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetPositionEstimateResponse' 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:
--
-- 'geoJsonPayload', 'getPositionEstimateResponse_geoJsonPayload' - The position information of the resource, displayed as a JSON payload.
-- The payload uses the GeoJSON format, which a format that\'s used to
-- encode geographic data structures. For more information, see
-- <https://geojson.org/ GeoJSON>.
--
-- 'httpStatus', 'getPositionEstimateResponse_httpStatus' - The response's http status code.
newGetPositionEstimateResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  GetPositionEstimateResponse
newGetPositionEstimateResponse :: Int -> GetPositionEstimateResponse
newGetPositionEstimateResponse Int
pHttpStatus_ =
  GetPositionEstimateResponse'
    { $sel:geoJsonPayload:GetPositionEstimateResponse' :: Maybe ByteString
geoJsonPayload =
        forall a. Maybe a
Prelude.Nothing,
      $sel:httpStatus:GetPositionEstimateResponse' :: Int
httpStatus = Int
pHttpStatus_
    }

-- | The position information of the resource, displayed as a JSON payload.
-- The payload uses the GeoJSON format, which a format that\'s used to
-- encode geographic data structures. For more information, see
-- <https://geojson.org/ GeoJSON>.
getPositionEstimateResponse_geoJsonPayload :: Lens.Lens' GetPositionEstimateResponse (Prelude.Maybe Prelude.ByteString)
getPositionEstimateResponse_geoJsonPayload :: Lens' GetPositionEstimateResponse (Maybe ByteString)
getPositionEstimateResponse_geoJsonPayload = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetPositionEstimateResponse' {Maybe ByteString
geoJsonPayload :: Maybe ByteString
$sel:geoJsonPayload:GetPositionEstimateResponse' :: GetPositionEstimateResponse -> Maybe ByteString
geoJsonPayload} -> Maybe ByteString
geoJsonPayload) (\s :: GetPositionEstimateResponse
s@GetPositionEstimateResponse' {} Maybe ByteString
a -> GetPositionEstimateResponse
s {$sel:geoJsonPayload:GetPositionEstimateResponse' :: Maybe ByteString
geoJsonPayload = Maybe ByteString
a} :: GetPositionEstimateResponse)

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

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