{-# 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.DescribeGeofenceCollection
-- 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 the geofence collection details.
module Amazonka.Location.DescribeGeofenceCollection
  ( -- * Creating a Request
    DescribeGeofenceCollection (..),
    newDescribeGeofenceCollection,

    -- * Request Lenses
    describeGeofenceCollection_collectionName,

    -- * Destructuring the Response
    DescribeGeofenceCollectionResponse (..),
    newDescribeGeofenceCollectionResponse,

    -- * Response Lenses
    describeGeofenceCollectionResponse_kmsKeyId,
    describeGeofenceCollectionResponse_pricingPlan,
    describeGeofenceCollectionResponse_pricingPlanDataSource,
    describeGeofenceCollectionResponse_tags,
    describeGeofenceCollectionResponse_httpStatus,
    describeGeofenceCollectionResponse_collectionArn,
    describeGeofenceCollectionResponse_collectionName,
    describeGeofenceCollectionResponse_createTime,
    describeGeofenceCollectionResponse_description,
    describeGeofenceCollectionResponse_updateTime,
  )
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:/ 'newDescribeGeofenceCollection' smart constructor.
data DescribeGeofenceCollection = DescribeGeofenceCollection'
  { -- | The name of the geofence collection.
    DescribeGeofenceCollection -> Text
collectionName :: Prelude.Text
  }
  deriving (DescribeGeofenceCollection -> DescribeGeofenceCollection -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeGeofenceCollection -> DescribeGeofenceCollection -> Bool
$c/= :: DescribeGeofenceCollection -> DescribeGeofenceCollection -> Bool
== :: DescribeGeofenceCollection -> DescribeGeofenceCollection -> Bool
$c== :: DescribeGeofenceCollection -> DescribeGeofenceCollection -> Bool
Prelude.Eq, ReadPrec [DescribeGeofenceCollection]
ReadPrec DescribeGeofenceCollection
Int -> ReadS DescribeGeofenceCollection
ReadS [DescribeGeofenceCollection]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeGeofenceCollection]
$creadListPrec :: ReadPrec [DescribeGeofenceCollection]
readPrec :: ReadPrec DescribeGeofenceCollection
$creadPrec :: ReadPrec DescribeGeofenceCollection
readList :: ReadS [DescribeGeofenceCollection]
$creadList :: ReadS [DescribeGeofenceCollection]
readsPrec :: Int -> ReadS DescribeGeofenceCollection
$creadsPrec :: Int -> ReadS DescribeGeofenceCollection
Prelude.Read, Int -> DescribeGeofenceCollection -> ShowS
[DescribeGeofenceCollection] -> ShowS
DescribeGeofenceCollection -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeGeofenceCollection] -> ShowS
$cshowList :: [DescribeGeofenceCollection] -> ShowS
show :: DescribeGeofenceCollection -> String
$cshow :: DescribeGeofenceCollection -> String
showsPrec :: Int -> DescribeGeofenceCollection -> ShowS
$cshowsPrec :: Int -> DescribeGeofenceCollection -> ShowS
Prelude.Show, forall x.
Rep DescribeGeofenceCollection x -> DescribeGeofenceCollection
forall x.
DescribeGeofenceCollection -> Rep DescribeGeofenceCollection x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeGeofenceCollection x -> DescribeGeofenceCollection
$cfrom :: forall x.
DescribeGeofenceCollection -> Rep DescribeGeofenceCollection x
Prelude.Generic)

-- |
-- Create a value of 'DescribeGeofenceCollection' 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:
--
-- 'collectionName', 'describeGeofenceCollection_collectionName' - The name of the geofence collection.
newDescribeGeofenceCollection ::
  -- | 'collectionName'
  Prelude.Text ->
  DescribeGeofenceCollection
newDescribeGeofenceCollection :: Text -> DescribeGeofenceCollection
newDescribeGeofenceCollection Text
pCollectionName_ =
  DescribeGeofenceCollection'
    { $sel:collectionName:DescribeGeofenceCollection' :: Text
collectionName =
        Text
pCollectionName_
    }

-- | The name of the geofence collection.
describeGeofenceCollection_collectionName :: Lens.Lens' DescribeGeofenceCollection Prelude.Text
describeGeofenceCollection_collectionName :: Lens' DescribeGeofenceCollection Text
describeGeofenceCollection_collectionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGeofenceCollection' {Text
collectionName :: Text
$sel:collectionName:DescribeGeofenceCollection' :: DescribeGeofenceCollection -> Text
collectionName} -> Text
collectionName) (\s :: DescribeGeofenceCollection
s@DescribeGeofenceCollection' {} Text
a -> DescribeGeofenceCollection
s {$sel:collectionName:DescribeGeofenceCollection' :: Text
collectionName = Text
a} :: DescribeGeofenceCollection)

instance Core.AWSRequest DescribeGeofenceCollection where
  type
    AWSResponse DescribeGeofenceCollection =
      DescribeGeofenceCollectionResponse
  request :: (Service -> Service)
-> DescribeGeofenceCollection -> Request DescribeGeofenceCollection
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 DescribeGeofenceCollection
-> ClientResponse ClientBody
-> m (Either
        Error (ClientResponse (AWSResponse DescribeGeofenceCollection)))
response =
    forall (m :: * -> *) a.
MonadResource m =>
(Int -> ResponseHeaders -> Object -> Either String (AWSResponse a))
-> (ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy a
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse a)))
Response.receiveJSON
      ( \Int
s ResponseHeaders
h Object
x ->
          Maybe Text
-> Maybe PricingPlan
-> Maybe Text
-> Maybe (HashMap Text Text)
-> Int
-> Text
-> Text
-> ISO8601
-> Text
-> ISO8601
-> DescribeGeofenceCollectionResponse
DescribeGeofenceCollectionResponse'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"KmsKeyId")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PricingPlan")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"PricingPlanDataSource")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String (Maybe a)
Data..?> Key
"Tags" forall (f :: * -> *) a. Functor f => f (Maybe a) -> a -> f a
Core..!@ forall a. Monoid a => a
Prelude.mempty)
            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))
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"CollectionArn")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"CollectionName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"CreateTime")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"Description")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Either String a
Data..:> Key
"UpdateTime")
      )

instance Prelude.Hashable DescribeGeofenceCollection where
  hashWithSalt :: Int -> DescribeGeofenceCollection -> Int
hashWithSalt Int
_salt DescribeGeofenceCollection' {Text
collectionName :: Text
$sel:collectionName:DescribeGeofenceCollection' :: DescribeGeofenceCollection -> Text
..} =
    Int
_salt forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
collectionName

instance Prelude.NFData DescribeGeofenceCollection where
  rnf :: DescribeGeofenceCollection -> ()
rnf DescribeGeofenceCollection' {Text
collectionName :: Text
$sel:collectionName:DescribeGeofenceCollection' :: DescribeGeofenceCollection -> Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Text
collectionName

instance Data.ToHeaders DescribeGeofenceCollection where
  toHeaders :: DescribeGeofenceCollection -> 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 DescribeGeofenceCollection where
  toPath :: DescribeGeofenceCollection -> ByteString
toPath DescribeGeofenceCollection' {Text
collectionName :: Text
$sel:collectionName:DescribeGeofenceCollection' :: DescribeGeofenceCollection -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/geofencing/v0/collections/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
collectionName
      ]

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

-- | /See:/ 'newDescribeGeofenceCollectionResponse' smart constructor.
data DescribeGeofenceCollectionResponse = DescribeGeofenceCollectionResponse'
  { -- | A key identifier for an
    -- <https://docs.aws.amazon.com/kms/latest/developerguide/create-keys.html AWS KMS customer managed key>
    -- assigned to the Amazon Location resource
    DescribeGeofenceCollectionResponse -> Maybe Text
kmsKeyId :: Prelude.Maybe Prelude.Text,
    -- | No longer used. Always returns @RequestBasedUsage@.
    DescribeGeofenceCollectionResponse -> Maybe PricingPlan
pricingPlan :: Prelude.Maybe PricingPlan,
    -- | No longer used. Always returns an empty string.
    DescribeGeofenceCollectionResponse -> Maybe Text
pricingPlanDataSource :: Prelude.Maybe Prelude.Text,
    -- | Displays the key, value pairs of tags associated with this resource.
    DescribeGeofenceCollectionResponse -> Maybe (HashMap Text Text)
tags :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | The response's http status code.
    DescribeGeofenceCollectionResponse -> Int
httpStatus :: Prelude.Int,
    -- | The Amazon Resource Name (ARN) for the geofence collection resource.
    -- Used when you need to specify a resource across all AWS.
    --
    -- -   Format example:
    --     @arn:aws:geo:region:account-id:geofence-collection\/ExampleGeofenceCollection@
    DescribeGeofenceCollectionResponse -> Text
collectionArn :: Prelude.Text,
    -- | The name of the geofence collection.
    DescribeGeofenceCollectionResponse -> Text
collectionName :: Prelude.Text,
    -- | The timestamp for when the geofence resource was created in
    -- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
    -- format: @YYYY-MM-DDThh:mm:ss.sssZ@
    DescribeGeofenceCollectionResponse -> ISO8601
createTime :: Data.ISO8601,
    -- | The optional description for the geofence collection.
    DescribeGeofenceCollectionResponse -> Text
description :: Prelude.Text,
    -- | The timestamp for when the geofence collection was last updated in
    -- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
    -- format: @YYYY-MM-DDThh:mm:ss.sssZ@
    DescribeGeofenceCollectionResponse -> ISO8601
updateTime :: Data.ISO8601
  }
  deriving (DescribeGeofenceCollectionResponse
-> DescribeGeofenceCollectionResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: DescribeGeofenceCollectionResponse
-> DescribeGeofenceCollectionResponse -> Bool
$c/= :: DescribeGeofenceCollectionResponse
-> DescribeGeofenceCollectionResponse -> Bool
== :: DescribeGeofenceCollectionResponse
-> DescribeGeofenceCollectionResponse -> Bool
$c== :: DescribeGeofenceCollectionResponse
-> DescribeGeofenceCollectionResponse -> Bool
Prelude.Eq, ReadPrec [DescribeGeofenceCollectionResponse]
ReadPrec DescribeGeofenceCollectionResponse
Int -> ReadS DescribeGeofenceCollectionResponse
ReadS [DescribeGeofenceCollectionResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [DescribeGeofenceCollectionResponse]
$creadListPrec :: ReadPrec [DescribeGeofenceCollectionResponse]
readPrec :: ReadPrec DescribeGeofenceCollectionResponse
$creadPrec :: ReadPrec DescribeGeofenceCollectionResponse
readList :: ReadS [DescribeGeofenceCollectionResponse]
$creadList :: ReadS [DescribeGeofenceCollectionResponse]
readsPrec :: Int -> ReadS DescribeGeofenceCollectionResponse
$creadsPrec :: Int -> ReadS DescribeGeofenceCollectionResponse
Prelude.Read, Int -> DescribeGeofenceCollectionResponse -> ShowS
[DescribeGeofenceCollectionResponse] -> ShowS
DescribeGeofenceCollectionResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [DescribeGeofenceCollectionResponse] -> ShowS
$cshowList :: [DescribeGeofenceCollectionResponse] -> ShowS
show :: DescribeGeofenceCollectionResponse -> String
$cshow :: DescribeGeofenceCollectionResponse -> String
showsPrec :: Int -> DescribeGeofenceCollectionResponse -> ShowS
$cshowsPrec :: Int -> DescribeGeofenceCollectionResponse -> ShowS
Prelude.Show, forall x.
Rep DescribeGeofenceCollectionResponse x
-> DescribeGeofenceCollectionResponse
forall x.
DescribeGeofenceCollectionResponse
-> Rep DescribeGeofenceCollectionResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x.
Rep DescribeGeofenceCollectionResponse x
-> DescribeGeofenceCollectionResponse
$cfrom :: forall x.
DescribeGeofenceCollectionResponse
-> Rep DescribeGeofenceCollectionResponse x
Prelude.Generic)

-- |
-- Create a value of 'DescribeGeofenceCollectionResponse' 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:
--
-- 'kmsKeyId', 'describeGeofenceCollectionResponse_kmsKeyId' - A key identifier for an
-- <https://docs.aws.amazon.com/kms/latest/developerguide/create-keys.html AWS KMS customer managed key>
-- assigned to the Amazon Location resource
--
-- 'pricingPlan', 'describeGeofenceCollectionResponse_pricingPlan' - No longer used. Always returns @RequestBasedUsage@.
--
-- 'pricingPlanDataSource', 'describeGeofenceCollectionResponse_pricingPlanDataSource' - No longer used. Always returns an empty string.
--
-- 'tags', 'describeGeofenceCollectionResponse_tags' - Displays the key, value pairs of tags associated with this resource.
--
-- 'httpStatus', 'describeGeofenceCollectionResponse_httpStatus' - The response's http status code.
--
-- 'collectionArn', 'describeGeofenceCollectionResponse_collectionArn' - The Amazon Resource Name (ARN) for the geofence collection resource.
-- Used when you need to specify a resource across all AWS.
--
-- -   Format example:
--     @arn:aws:geo:region:account-id:geofence-collection\/ExampleGeofenceCollection@
--
-- 'collectionName', 'describeGeofenceCollectionResponse_collectionName' - The name of the geofence collection.
--
-- 'createTime', 'describeGeofenceCollectionResponse_createTime' - The timestamp for when the geofence resource was created in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@
--
-- 'description', 'describeGeofenceCollectionResponse_description' - The optional description for the geofence collection.
--
-- 'updateTime', 'describeGeofenceCollectionResponse_updateTime' - The timestamp for when the geofence collection was last updated in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@
newDescribeGeofenceCollectionResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'collectionArn'
  Prelude.Text ->
  -- | 'collectionName'
  Prelude.Text ->
  -- | 'createTime'
  Prelude.UTCTime ->
  -- | 'description'
  Prelude.Text ->
  -- | 'updateTime'
  Prelude.UTCTime ->
  DescribeGeofenceCollectionResponse
newDescribeGeofenceCollectionResponse :: Int
-> Text
-> Text
-> UTCTime
-> Text
-> UTCTime
-> DescribeGeofenceCollectionResponse
newDescribeGeofenceCollectionResponse
  Int
pHttpStatus_
  Text
pCollectionArn_
  Text
pCollectionName_
  UTCTime
pCreateTime_
  Text
pDescription_
  UTCTime
pUpdateTime_ =
    DescribeGeofenceCollectionResponse'
      { $sel:kmsKeyId:DescribeGeofenceCollectionResponse' :: Maybe Text
kmsKeyId =
          forall a. Maybe a
Prelude.Nothing,
        $sel:pricingPlan:DescribeGeofenceCollectionResponse' :: Maybe PricingPlan
pricingPlan = forall a. Maybe a
Prelude.Nothing,
        $sel:pricingPlanDataSource:DescribeGeofenceCollectionResponse' :: Maybe Text
pricingPlanDataSource = forall a. Maybe a
Prelude.Nothing,
        $sel:tags:DescribeGeofenceCollectionResponse' :: Maybe (HashMap Text Text)
tags = forall a. Maybe a
Prelude.Nothing,
        $sel:httpStatus:DescribeGeofenceCollectionResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:collectionArn:DescribeGeofenceCollectionResponse' :: Text
collectionArn = Text
pCollectionArn_,
        $sel:collectionName:DescribeGeofenceCollectionResponse' :: Text
collectionName = Text
pCollectionName_,
        $sel:createTime:DescribeGeofenceCollectionResponse' :: ISO8601
createTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreateTime_,
        $sel:description:DescribeGeofenceCollectionResponse' :: Text
description = Text
pDescription_,
        $sel:updateTime:DescribeGeofenceCollectionResponse' :: ISO8601
updateTime =
          forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdateTime_
      }

-- | A key identifier for an
-- <https://docs.aws.amazon.com/kms/latest/developerguide/create-keys.html AWS KMS customer managed key>
-- assigned to the Amazon Location resource
describeGeofenceCollectionResponse_kmsKeyId :: Lens.Lens' DescribeGeofenceCollectionResponse (Prelude.Maybe Prelude.Text)
describeGeofenceCollectionResponse_kmsKeyId :: Lens' DescribeGeofenceCollectionResponse (Maybe Text)
describeGeofenceCollectionResponse_kmsKeyId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGeofenceCollectionResponse' {Maybe Text
kmsKeyId :: Maybe Text
$sel:kmsKeyId:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Maybe Text
kmsKeyId} -> Maybe Text
kmsKeyId) (\s :: DescribeGeofenceCollectionResponse
s@DescribeGeofenceCollectionResponse' {} Maybe Text
a -> DescribeGeofenceCollectionResponse
s {$sel:kmsKeyId:DescribeGeofenceCollectionResponse' :: Maybe Text
kmsKeyId = Maybe Text
a} :: DescribeGeofenceCollectionResponse)

-- | No longer used. Always returns @RequestBasedUsage@.
describeGeofenceCollectionResponse_pricingPlan :: Lens.Lens' DescribeGeofenceCollectionResponse (Prelude.Maybe PricingPlan)
describeGeofenceCollectionResponse_pricingPlan :: Lens' DescribeGeofenceCollectionResponse (Maybe PricingPlan)
describeGeofenceCollectionResponse_pricingPlan = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGeofenceCollectionResponse' {Maybe PricingPlan
pricingPlan :: Maybe PricingPlan
$sel:pricingPlan:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Maybe PricingPlan
pricingPlan} -> Maybe PricingPlan
pricingPlan) (\s :: DescribeGeofenceCollectionResponse
s@DescribeGeofenceCollectionResponse' {} Maybe PricingPlan
a -> DescribeGeofenceCollectionResponse
s {$sel:pricingPlan:DescribeGeofenceCollectionResponse' :: Maybe PricingPlan
pricingPlan = Maybe PricingPlan
a} :: DescribeGeofenceCollectionResponse)

-- | No longer used. Always returns an empty string.
describeGeofenceCollectionResponse_pricingPlanDataSource :: Lens.Lens' DescribeGeofenceCollectionResponse (Prelude.Maybe Prelude.Text)
describeGeofenceCollectionResponse_pricingPlanDataSource :: Lens' DescribeGeofenceCollectionResponse (Maybe Text)
describeGeofenceCollectionResponse_pricingPlanDataSource = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGeofenceCollectionResponse' {Maybe Text
pricingPlanDataSource :: Maybe Text
$sel:pricingPlanDataSource:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Maybe Text
pricingPlanDataSource} -> Maybe Text
pricingPlanDataSource) (\s :: DescribeGeofenceCollectionResponse
s@DescribeGeofenceCollectionResponse' {} Maybe Text
a -> DescribeGeofenceCollectionResponse
s {$sel:pricingPlanDataSource:DescribeGeofenceCollectionResponse' :: Maybe Text
pricingPlanDataSource = Maybe Text
a} :: DescribeGeofenceCollectionResponse)

-- | Displays the key, value pairs of tags associated with this resource.
describeGeofenceCollectionResponse_tags :: Lens.Lens' DescribeGeofenceCollectionResponse (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
describeGeofenceCollectionResponse_tags :: Lens'
  DescribeGeofenceCollectionResponse (Maybe (HashMap Text Text))
describeGeofenceCollectionResponse_tags = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGeofenceCollectionResponse' {Maybe (HashMap Text Text)
tags :: Maybe (HashMap Text Text)
$sel:tags:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Maybe (HashMap Text Text)
tags} -> Maybe (HashMap Text Text)
tags) (\s :: DescribeGeofenceCollectionResponse
s@DescribeGeofenceCollectionResponse' {} Maybe (HashMap Text Text)
a -> DescribeGeofenceCollectionResponse
s {$sel:tags:DescribeGeofenceCollectionResponse' :: Maybe (HashMap Text Text)
tags = Maybe (HashMap Text Text)
a} :: DescribeGeofenceCollectionResponse) 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

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

-- | The Amazon Resource Name (ARN) for the geofence collection resource.
-- Used when you need to specify a resource across all AWS.
--
-- -   Format example:
--     @arn:aws:geo:region:account-id:geofence-collection\/ExampleGeofenceCollection@
describeGeofenceCollectionResponse_collectionArn :: Lens.Lens' DescribeGeofenceCollectionResponse Prelude.Text
describeGeofenceCollectionResponse_collectionArn :: Lens' DescribeGeofenceCollectionResponse Text
describeGeofenceCollectionResponse_collectionArn = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGeofenceCollectionResponse' {Text
collectionArn :: Text
$sel:collectionArn:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Text
collectionArn} -> Text
collectionArn) (\s :: DescribeGeofenceCollectionResponse
s@DescribeGeofenceCollectionResponse' {} Text
a -> DescribeGeofenceCollectionResponse
s {$sel:collectionArn:DescribeGeofenceCollectionResponse' :: Text
collectionArn = Text
a} :: DescribeGeofenceCollectionResponse)

-- | The name of the geofence collection.
describeGeofenceCollectionResponse_collectionName :: Lens.Lens' DescribeGeofenceCollectionResponse Prelude.Text
describeGeofenceCollectionResponse_collectionName :: Lens' DescribeGeofenceCollectionResponse Text
describeGeofenceCollectionResponse_collectionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGeofenceCollectionResponse' {Text
collectionName :: Text
$sel:collectionName:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Text
collectionName} -> Text
collectionName) (\s :: DescribeGeofenceCollectionResponse
s@DescribeGeofenceCollectionResponse' {} Text
a -> DescribeGeofenceCollectionResponse
s {$sel:collectionName:DescribeGeofenceCollectionResponse' :: Text
collectionName = Text
a} :: DescribeGeofenceCollectionResponse)

-- | The timestamp for when the geofence resource was created in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@
describeGeofenceCollectionResponse_createTime :: Lens.Lens' DescribeGeofenceCollectionResponse Prelude.UTCTime
describeGeofenceCollectionResponse_createTime :: Lens' DescribeGeofenceCollectionResponse UTCTime
describeGeofenceCollectionResponse_createTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGeofenceCollectionResponse' {ISO8601
createTime :: ISO8601
$sel:createTime:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> ISO8601
createTime} -> ISO8601
createTime) (\s :: DescribeGeofenceCollectionResponse
s@DescribeGeofenceCollectionResponse' {} ISO8601
a -> DescribeGeofenceCollectionResponse
s {$sel:createTime:DescribeGeofenceCollectionResponse' :: ISO8601
createTime = ISO8601
a} :: DescribeGeofenceCollectionResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

-- | The optional description for the geofence collection.
describeGeofenceCollectionResponse_description :: Lens.Lens' DescribeGeofenceCollectionResponse Prelude.Text
describeGeofenceCollectionResponse_description :: Lens' DescribeGeofenceCollectionResponse Text
describeGeofenceCollectionResponse_description = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGeofenceCollectionResponse' {Text
description :: Text
$sel:description:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Text
description} -> Text
description) (\s :: DescribeGeofenceCollectionResponse
s@DescribeGeofenceCollectionResponse' {} Text
a -> DescribeGeofenceCollectionResponse
s {$sel:description:DescribeGeofenceCollectionResponse' :: Text
description = Text
a} :: DescribeGeofenceCollectionResponse)

-- | The timestamp for when the geofence collection was last updated in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@
describeGeofenceCollectionResponse_updateTime :: Lens.Lens' DescribeGeofenceCollectionResponse Prelude.UTCTime
describeGeofenceCollectionResponse_updateTime :: Lens' DescribeGeofenceCollectionResponse UTCTime
describeGeofenceCollectionResponse_updateTime = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\DescribeGeofenceCollectionResponse' {ISO8601
updateTime :: ISO8601
$sel:updateTime:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> ISO8601
updateTime} -> ISO8601
updateTime) (\s :: DescribeGeofenceCollectionResponse
s@DescribeGeofenceCollectionResponse' {} ISO8601
a -> DescribeGeofenceCollectionResponse
s {$sel:updateTime:DescribeGeofenceCollectionResponse' :: ISO8601
updateTime = ISO8601
a} :: DescribeGeofenceCollectionResponse) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance
  Prelude.NFData
    DescribeGeofenceCollectionResponse
  where
  rnf :: DescribeGeofenceCollectionResponse -> ()
rnf DescribeGeofenceCollectionResponse' {Int
Maybe Text
Maybe (HashMap Text Text)
Maybe PricingPlan
Text
ISO8601
updateTime :: ISO8601
description :: Text
createTime :: ISO8601
collectionName :: Text
collectionArn :: Text
httpStatus :: Int
tags :: Maybe (HashMap Text Text)
pricingPlanDataSource :: Maybe Text
pricingPlan :: Maybe PricingPlan
kmsKeyId :: Maybe Text
$sel:updateTime:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> ISO8601
$sel:description:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Text
$sel:createTime:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> ISO8601
$sel:collectionName:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Text
$sel:collectionArn:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Text
$sel:httpStatus:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Int
$sel:tags:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Maybe (HashMap Text Text)
$sel:pricingPlanDataSource:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Maybe Text
$sel:pricingPlan:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Maybe PricingPlan
$sel:kmsKeyId:DescribeGeofenceCollectionResponse' :: DescribeGeofenceCollectionResponse -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
kmsKeyId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe PricingPlan
pricingPlan
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
pricingPlanDataSource
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tags
      seq :: forall a b. a -> b -> b
`Prelude.seq` 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 Text
collectionArn
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
collectionName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
createTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
description
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
updateTime