{-# 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.Route53.GetGeoLocation
-- 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 information about whether a specified geographic location is
-- supported for Amazon Route 53 geolocation resource record sets.
--
-- Route 53 does not perform authorization for this API because it
-- retrieves information that is already available to the public.
--
-- Use the following syntax to determine whether a continent is supported
-- for geolocation:
--
-- @GET \/2013-04-01\/geolocation?continentcode=@/@two-letter abbreviation for a continent@/@ @
--
-- Use the following syntax to determine whether a country is supported for
-- geolocation:
--
-- @GET \/2013-04-01\/geolocation?countrycode=@/@two-character country code@/@ @
--
-- Use the following syntax to determine whether a subdivision of a country
-- is supported for geolocation:
--
-- @GET \/2013-04-01\/geolocation?countrycode=@/@two-character country code@/@&subdivisioncode=@/@subdivision code@/@ @
module Amazonka.Route53.GetGeoLocation
  ( -- * Creating a Request
    GetGeoLocation (..),
    newGetGeoLocation,

    -- * Request Lenses
    getGeoLocation_continentCode,
    getGeoLocation_countryCode,
    getGeoLocation_subdivisionCode,

    -- * Destructuring the Response
    GetGeoLocationResponse (..),
    newGetGeoLocationResponse,

    -- * Response Lenses
    getGeoLocationResponse_httpStatus,
    getGeoLocationResponse_geoLocationDetails,
  )
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.Route53.Types

-- | A request for information about whether a specified geographic location
-- is supported for Amazon Route 53 geolocation resource record sets.
--
-- /See:/ 'newGetGeoLocation' smart constructor.
data GetGeoLocation = GetGeoLocation'
  { -- | For geolocation resource record sets, a two-letter abbreviation that
    -- identifies a continent. Amazon Route 53 supports the following continent
    -- codes:
    --
    -- -   __AF__: Africa
    --
    -- -   __AN__: Antarctica
    --
    -- -   __AS__: Asia
    --
    -- -   __EU__: Europe
    --
    -- -   __OC__: Oceania
    --
    -- -   __NA__: North America
    --
    -- -   __SA__: South America
    GetGeoLocation -> Maybe Text
continentCode :: Prelude.Maybe Prelude.Text,
    -- | Amazon Route 53 uses the two-letter country codes that are specified in
    -- <https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2 ISO standard 3166-1 alpha-2>.
    GetGeoLocation -> Maybe Text
countryCode :: Prelude.Maybe Prelude.Text,
    -- | The code for the subdivision, such as a particular state within the
    -- United States. For a list of US state abbreviations, see
    -- <https://pe.usps.com/text/pub28/28apb.htm Appendix B: Two–Letter State and Possession Abbreviations>
    -- on the United States Postal Service website. For a list of all supported
    -- subdivision codes, use the
    -- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_ListGeoLocations.html ListGeoLocations>
    -- API.
    GetGeoLocation -> Maybe Text
subdivisionCode :: Prelude.Maybe Prelude.Text
  }
  deriving (GetGeoLocation -> GetGeoLocation -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetGeoLocation -> GetGeoLocation -> Bool
$c/= :: GetGeoLocation -> GetGeoLocation -> Bool
== :: GetGeoLocation -> GetGeoLocation -> Bool
$c== :: GetGeoLocation -> GetGeoLocation -> Bool
Prelude.Eq, ReadPrec [GetGeoLocation]
ReadPrec GetGeoLocation
Int -> ReadS GetGeoLocation
ReadS [GetGeoLocation]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetGeoLocation]
$creadListPrec :: ReadPrec [GetGeoLocation]
readPrec :: ReadPrec GetGeoLocation
$creadPrec :: ReadPrec GetGeoLocation
readList :: ReadS [GetGeoLocation]
$creadList :: ReadS [GetGeoLocation]
readsPrec :: Int -> ReadS GetGeoLocation
$creadsPrec :: Int -> ReadS GetGeoLocation
Prelude.Read, Int -> GetGeoLocation -> ShowS
[GetGeoLocation] -> ShowS
GetGeoLocation -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetGeoLocation] -> ShowS
$cshowList :: [GetGeoLocation] -> ShowS
show :: GetGeoLocation -> String
$cshow :: GetGeoLocation -> String
showsPrec :: Int -> GetGeoLocation -> ShowS
$cshowsPrec :: Int -> GetGeoLocation -> ShowS
Prelude.Show, forall x. Rep GetGeoLocation x -> GetGeoLocation
forall x. GetGeoLocation -> Rep GetGeoLocation x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetGeoLocation x -> GetGeoLocation
$cfrom :: forall x. GetGeoLocation -> Rep GetGeoLocation x
Prelude.Generic)

-- |
-- Create a value of 'GetGeoLocation' 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:
--
-- 'continentCode', 'getGeoLocation_continentCode' - For geolocation resource record sets, a two-letter abbreviation that
-- identifies a continent. Amazon Route 53 supports the following continent
-- codes:
--
-- -   __AF__: Africa
--
-- -   __AN__: Antarctica
--
-- -   __AS__: Asia
--
-- -   __EU__: Europe
--
-- -   __OC__: Oceania
--
-- -   __NA__: North America
--
-- -   __SA__: South America
--
-- 'countryCode', 'getGeoLocation_countryCode' - Amazon Route 53 uses the two-letter country codes that are specified in
-- <https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2 ISO standard 3166-1 alpha-2>.
--
-- 'subdivisionCode', 'getGeoLocation_subdivisionCode' - The code for the subdivision, such as a particular state within the
-- United States. For a list of US state abbreviations, see
-- <https://pe.usps.com/text/pub28/28apb.htm Appendix B: Two–Letter State and Possession Abbreviations>
-- on the United States Postal Service website. For a list of all supported
-- subdivision codes, use the
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_ListGeoLocations.html ListGeoLocations>
-- API.
newGetGeoLocation ::
  GetGeoLocation
newGetGeoLocation :: GetGeoLocation
newGetGeoLocation =
  GetGeoLocation'
    { $sel:continentCode:GetGeoLocation' :: Maybe Text
continentCode = forall a. Maybe a
Prelude.Nothing,
      $sel:countryCode:GetGeoLocation' :: Maybe Text
countryCode = forall a. Maybe a
Prelude.Nothing,
      $sel:subdivisionCode:GetGeoLocation' :: Maybe Text
subdivisionCode = forall a. Maybe a
Prelude.Nothing
    }

-- | For geolocation resource record sets, a two-letter abbreviation that
-- identifies a continent. Amazon Route 53 supports the following continent
-- codes:
--
-- -   __AF__: Africa
--
-- -   __AN__: Antarctica
--
-- -   __AS__: Asia
--
-- -   __EU__: Europe
--
-- -   __OC__: Oceania
--
-- -   __NA__: North America
--
-- -   __SA__: South America
getGeoLocation_continentCode :: Lens.Lens' GetGeoLocation (Prelude.Maybe Prelude.Text)
getGeoLocation_continentCode :: Lens' GetGeoLocation (Maybe Text)
getGeoLocation_continentCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGeoLocation' {Maybe Text
continentCode :: Maybe Text
$sel:continentCode:GetGeoLocation' :: GetGeoLocation -> Maybe Text
continentCode} -> Maybe Text
continentCode) (\s :: GetGeoLocation
s@GetGeoLocation' {} Maybe Text
a -> GetGeoLocation
s {$sel:continentCode:GetGeoLocation' :: Maybe Text
continentCode = Maybe Text
a} :: GetGeoLocation)

-- | Amazon Route 53 uses the two-letter country codes that are specified in
-- <https://en.wikipedia.org/wiki/ISO_3166-1_alpha-2 ISO standard 3166-1 alpha-2>.
getGeoLocation_countryCode :: Lens.Lens' GetGeoLocation (Prelude.Maybe Prelude.Text)
getGeoLocation_countryCode :: Lens' GetGeoLocation (Maybe Text)
getGeoLocation_countryCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGeoLocation' {Maybe Text
countryCode :: Maybe Text
$sel:countryCode:GetGeoLocation' :: GetGeoLocation -> Maybe Text
countryCode} -> Maybe Text
countryCode) (\s :: GetGeoLocation
s@GetGeoLocation' {} Maybe Text
a -> GetGeoLocation
s {$sel:countryCode:GetGeoLocation' :: Maybe Text
countryCode = Maybe Text
a} :: GetGeoLocation)

-- | The code for the subdivision, such as a particular state within the
-- United States. For a list of US state abbreviations, see
-- <https://pe.usps.com/text/pub28/28apb.htm Appendix B: Two–Letter State and Possession Abbreviations>
-- on the United States Postal Service website. For a list of all supported
-- subdivision codes, use the
-- <https://docs.aws.amazon.com/Route53/latest/APIReference/API_ListGeoLocations.html ListGeoLocations>
-- API.
getGeoLocation_subdivisionCode :: Lens.Lens' GetGeoLocation (Prelude.Maybe Prelude.Text)
getGeoLocation_subdivisionCode :: Lens' GetGeoLocation (Maybe Text)
getGeoLocation_subdivisionCode = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGeoLocation' {Maybe Text
subdivisionCode :: Maybe Text
$sel:subdivisionCode:GetGeoLocation' :: GetGeoLocation -> Maybe Text
subdivisionCode} -> Maybe Text
subdivisionCode) (\s :: GetGeoLocation
s@GetGeoLocation' {} Maybe Text
a -> GetGeoLocation
s {$sel:subdivisionCode:GetGeoLocation' :: Maybe Text
subdivisionCode = Maybe Text
a} :: GetGeoLocation)

instance Core.AWSRequest GetGeoLocation where
  type
    AWSResponse GetGeoLocation =
      GetGeoLocationResponse
  request :: (Service -> Service) -> GetGeoLocation -> Request GetGeoLocation
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 GetGeoLocation
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse GetGeoLocation)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> [Node] -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveXML
      ( \Int
s ResponseHeaders
h [Node]
x ->
          Int -> GeoLocationDetails -> GetGeoLocationResponse
GetGeoLocationResponse'
            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.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String a
Data..@ Text
"GeoLocationDetails")
      )

instance Prelude.Hashable GetGeoLocation where
  hashWithSalt :: Int -> GetGeoLocation -> Int
hashWithSalt Int
_salt GetGeoLocation' {Maybe Text
subdivisionCode :: Maybe Text
countryCode :: Maybe Text
continentCode :: Maybe Text
$sel:subdivisionCode:GetGeoLocation' :: GetGeoLocation -> Maybe Text
$sel:countryCode:GetGeoLocation' :: GetGeoLocation -> Maybe Text
$sel:continentCode:GetGeoLocation' :: GetGeoLocation -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
continentCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
countryCode
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
subdivisionCode

instance Prelude.NFData GetGeoLocation where
  rnf :: GetGeoLocation -> ()
rnf GetGeoLocation' {Maybe Text
subdivisionCode :: Maybe Text
countryCode :: Maybe Text
continentCode :: Maybe Text
$sel:subdivisionCode:GetGeoLocation' :: GetGeoLocation -> Maybe Text
$sel:countryCode:GetGeoLocation' :: GetGeoLocation -> Maybe Text
$sel:continentCode:GetGeoLocation' :: GetGeoLocation -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
continentCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
countryCode
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
subdivisionCode

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

instance Data.ToPath GetGeoLocation where
  toPath :: GetGeoLocation -> ByteString
toPath = forall a b. a -> b -> a
Prelude.const ByteString
"/2013-04-01/geolocation"

instance Data.ToQuery GetGeoLocation where
  toQuery :: GetGeoLocation -> QueryString
toQuery GetGeoLocation' {Maybe Text
subdivisionCode :: Maybe Text
countryCode :: Maybe Text
continentCode :: Maybe Text
$sel:subdivisionCode:GetGeoLocation' :: GetGeoLocation -> Maybe Text
$sel:countryCode:GetGeoLocation' :: GetGeoLocation -> Maybe Text
$sel:continentCode:GetGeoLocation' :: GetGeoLocation -> Maybe Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"continentcode" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
continentCode,
        ByteString
"countrycode" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
countryCode,
        ByteString
"subdivisioncode" forall a. ToQuery a => ByteString -> a -> QueryString
Data.=: Maybe Text
subdivisionCode
      ]

-- | A complex type that contains the response information for the specified
-- geolocation code.
--
-- /See:/ 'newGetGeoLocationResponse' smart constructor.
data GetGeoLocationResponse = GetGeoLocationResponse'
  { -- | The response's http status code.
    GetGeoLocationResponse -> Int
httpStatus :: Prelude.Int,
    -- | A complex type that contains the codes and full continent, country, and
    -- subdivision names for the specified geolocation code.
    GetGeoLocationResponse -> GeoLocationDetails
geoLocationDetails :: GeoLocationDetails
  }
  deriving (GetGeoLocationResponse -> GetGeoLocationResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: GetGeoLocationResponse -> GetGeoLocationResponse -> Bool
$c/= :: GetGeoLocationResponse -> GetGeoLocationResponse -> Bool
== :: GetGeoLocationResponse -> GetGeoLocationResponse -> Bool
$c== :: GetGeoLocationResponse -> GetGeoLocationResponse -> Bool
Prelude.Eq, ReadPrec [GetGeoLocationResponse]
ReadPrec GetGeoLocationResponse
Int -> ReadS GetGeoLocationResponse
ReadS [GetGeoLocationResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [GetGeoLocationResponse]
$creadListPrec :: ReadPrec [GetGeoLocationResponse]
readPrec :: ReadPrec GetGeoLocationResponse
$creadPrec :: ReadPrec GetGeoLocationResponse
readList :: ReadS [GetGeoLocationResponse]
$creadList :: ReadS [GetGeoLocationResponse]
readsPrec :: Int -> ReadS GetGeoLocationResponse
$creadsPrec :: Int -> ReadS GetGeoLocationResponse
Prelude.Read, Int -> GetGeoLocationResponse -> ShowS
[GetGeoLocationResponse] -> ShowS
GetGeoLocationResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [GetGeoLocationResponse] -> ShowS
$cshowList :: [GetGeoLocationResponse] -> ShowS
show :: GetGeoLocationResponse -> String
$cshow :: GetGeoLocationResponse -> String
showsPrec :: Int -> GetGeoLocationResponse -> ShowS
$cshowsPrec :: Int -> GetGeoLocationResponse -> ShowS
Prelude.Show, forall x. Rep GetGeoLocationResponse x -> GetGeoLocationResponse
forall x. GetGeoLocationResponse -> Rep GetGeoLocationResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep GetGeoLocationResponse x -> GetGeoLocationResponse
$cfrom :: forall x. GetGeoLocationResponse -> Rep GetGeoLocationResponse x
Prelude.Generic)

-- |
-- Create a value of 'GetGeoLocationResponse' 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', 'getGeoLocationResponse_httpStatus' - The response's http status code.
--
-- 'geoLocationDetails', 'getGeoLocationResponse_geoLocationDetails' - A complex type that contains the codes and full continent, country, and
-- subdivision names for the specified geolocation code.
newGetGeoLocationResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'geoLocationDetails'
  GeoLocationDetails ->
  GetGeoLocationResponse
newGetGeoLocationResponse :: Int -> GeoLocationDetails -> GetGeoLocationResponse
newGetGeoLocationResponse
  Int
pHttpStatus_
  GeoLocationDetails
pGeoLocationDetails_ =
    GetGeoLocationResponse'
      { $sel:httpStatus:GetGeoLocationResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:geoLocationDetails:GetGeoLocationResponse' :: GeoLocationDetails
geoLocationDetails = GeoLocationDetails
pGeoLocationDetails_
      }

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

-- | A complex type that contains the codes and full continent, country, and
-- subdivision names for the specified geolocation code.
getGeoLocationResponse_geoLocationDetails :: Lens.Lens' GetGeoLocationResponse GeoLocationDetails
getGeoLocationResponse_geoLocationDetails :: Lens' GetGeoLocationResponse GeoLocationDetails
getGeoLocationResponse_geoLocationDetails = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\GetGeoLocationResponse' {GeoLocationDetails
geoLocationDetails :: GeoLocationDetails
$sel:geoLocationDetails:GetGeoLocationResponse' :: GetGeoLocationResponse -> GeoLocationDetails
geoLocationDetails} -> GeoLocationDetails
geoLocationDetails) (\s :: GetGeoLocationResponse
s@GetGeoLocationResponse' {} GeoLocationDetails
a -> GetGeoLocationResponse
s {$sel:geoLocationDetails:GetGeoLocationResponse' :: GeoLocationDetails
geoLocationDetails = GeoLocationDetails
a} :: GetGeoLocationResponse)

instance Prelude.NFData GetGeoLocationResponse where
  rnf :: GetGeoLocationResponse -> ()
rnf GetGeoLocationResponse' {Int
GeoLocationDetails
geoLocationDetails :: GeoLocationDetails
httpStatus :: Int
$sel:geoLocationDetails:GetGeoLocationResponse' :: GetGeoLocationResponse -> GeoLocationDetails
$sel:httpStatus:GetGeoLocationResponse' :: GetGeoLocationResponse -> 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 GeoLocationDetails
geoLocationDetails