{-# 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.PutGeofence
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
--
-- Stores a geofence geometry in a given geofence collection, or updates
-- the geometry of an existing geofence if a geofence ID is included in the
-- request.
module Amazonka.Location.PutGeofence
  ( -- * Creating a Request
    PutGeofence (..),
    newPutGeofence,

    -- * Request Lenses
    putGeofence_collectionName,
    putGeofence_geofenceId,
    putGeofence_geometry,

    -- * Destructuring the Response
    PutGeofenceResponse (..),
    newPutGeofenceResponse,

    -- * Response Lenses
    putGeofenceResponse_httpStatus,
    putGeofenceResponse_createTime,
    putGeofenceResponse_geofenceId,
    putGeofenceResponse_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:/ 'newPutGeofence' smart constructor.
data PutGeofence = PutGeofence'
  { -- | The geofence collection to store the geofence in.
    PutGeofence -> Text
collectionName :: Prelude.Text,
    -- | An identifier for the geofence. For example, @ExampleGeofence-1@.
    PutGeofence -> Text
geofenceId :: Prelude.Text,
    -- | Contains the details to specify the position of the geofence. Can be
    -- either a polygon or a circle. Including both will return a validation
    -- error.
    --
    -- Each
    -- <https://docs.aws.amazon.com/location-geofences/latest/APIReference/API_GeofenceGeometry.html geofence polygon>
    -- can have a maximum of 1,000 vertices.
    PutGeofence -> GeofenceGeometry
geometry :: GeofenceGeometry
  }
  deriving (PutGeofence -> PutGeofence -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutGeofence -> PutGeofence -> Bool
$c/= :: PutGeofence -> PutGeofence -> Bool
== :: PutGeofence -> PutGeofence -> Bool
$c== :: PutGeofence -> PutGeofence -> Bool
Prelude.Eq, Int -> PutGeofence -> ShowS
[PutGeofence] -> ShowS
PutGeofence -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutGeofence] -> ShowS
$cshowList :: [PutGeofence] -> ShowS
show :: PutGeofence -> String
$cshow :: PutGeofence -> String
showsPrec :: Int -> PutGeofence -> ShowS
$cshowsPrec :: Int -> PutGeofence -> ShowS
Prelude.Show, forall x. Rep PutGeofence x -> PutGeofence
forall x. PutGeofence -> Rep PutGeofence x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutGeofence x -> PutGeofence
$cfrom :: forall x. PutGeofence -> Rep PutGeofence x
Prelude.Generic)

-- |
-- Create a value of 'PutGeofence' 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', 'putGeofence_collectionName' - The geofence collection to store the geofence in.
--
-- 'geofenceId', 'putGeofence_geofenceId' - An identifier for the geofence. For example, @ExampleGeofence-1@.
--
-- 'geometry', 'putGeofence_geometry' - Contains the details to specify the position of the geofence. Can be
-- either a polygon or a circle. Including both will return a validation
-- error.
--
-- Each
-- <https://docs.aws.amazon.com/location-geofences/latest/APIReference/API_GeofenceGeometry.html geofence polygon>
-- can have a maximum of 1,000 vertices.
newPutGeofence ::
  -- | 'collectionName'
  Prelude.Text ->
  -- | 'geofenceId'
  Prelude.Text ->
  -- | 'geometry'
  GeofenceGeometry ->
  PutGeofence
newPutGeofence :: Text -> Text -> GeofenceGeometry -> PutGeofence
newPutGeofence
  Text
pCollectionName_
  Text
pGeofenceId_
  GeofenceGeometry
pGeometry_ =
    PutGeofence'
      { $sel:collectionName:PutGeofence' :: Text
collectionName = Text
pCollectionName_,
        $sel:geofenceId:PutGeofence' :: Text
geofenceId = Text
pGeofenceId_,
        $sel:geometry:PutGeofence' :: GeofenceGeometry
geometry = GeofenceGeometry
pGeometry_
      }

-- | The geofence collection to store the geofence in.
putGeofence_collectionName :: Lens.Lens' PutGeofence Prelude.Text
putGeofence_collectionName :: Lens' PutGeofence Text
putGeofence_collectionName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutGeofence' {Text
collectionName :: Text
$sel:collectionName:PutGeofence' :: PutGeofence -> Text
collectionName} -> Text
collectionName) (\s :: PutGeofence
s@PutGeofence' {} Text
a -> PutGeofence
s {$sel:collectionName:PutGeofence' :: Text
collectionName = Text
a} :: PutGeofence)

-- | An identifier for the geofence. For example, @ExampleGeofence-1@.
putGeofence_geofenceId :: Lens.Lens' PutGeofence Prelude.Text
putGeofence_geofenceId :: Lens' PutGeofence Text
putGeofence_geofenceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutGeofence' {Text
geofenceId :: Text
$sel:geofenceId:PutGeofence' :: PutGeofence -> Text
geofenceId} -> Text
geofenceId) (\s :: PutGeofence
s@PutGeofence' {} Text
a -> PutGeofence
s {$sel:geofenceId:PutGeofence' :: Text
geofenceId = Text
a} :: PutGeofence)

-- | Contains the details to specify the position of the geofence. Can be
-- either a polygon or a circle. Including both will return a validation
-- error.
--
-- Each
-- <https://docs.aws.amazon.com/location-geofences/latest/APIReference/API_GeofenceGeometry.html geofence polygon>
-- can have a maximum of 1,000 vertices.
putGeofence_geometry :: Lens.Lens' PutGeofence GeofenceGeometry
putGeofence_geometry :: Lens' PutGeofence GeofenceGeometry
putGeofence_geometry = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutGeofence' {GeofenceGeometry
geometry :: GeofenceGeometry
$sel:geometry:PutGeofence' :: PutGeofence -> GeofenceGeometry
geometry} -> GeofenceGeometry
geometry) (\s :: PutGeofence
s@PutGeofence' {} GeofenceGeometry
a -> PutGeofence
s {$sel:geometry:PutGeofence' :: GeofenceGeometry
geometry = GeofenceGeometry
a} :: PutGeofence)

instance Core.AWSRequest PutGeofence where
  type AWSResponse PutGeofence = PutGeofenceResponse
  request :: (Service -> Service) -> PutGeofence -> Request PutGeofence
request Service -> Service
overrides =
    forall a. (ToRequest a, ToJSON a) => Service -> a -> Request a
Request.putJSON (Service -> Service
overrides Service
defaultService)
  response :: forall (m :: * -> *).
MonadResource m =>
(ByteStringLazy -> IO ByteStringLazy)
-> Service
-> Proxy PutGeofence
-> ClientResponse ClientBody
-> m (Either Error (ClientResponse (AWSResponse PutGeofence)))
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 ->
          Int -> ISO8601 -> Text -> ISO8601 -> PutGeofenceResponse
PutGeofenceResponse'
            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.<*> (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
"GeofenceId")
            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 PutGeofence where
  hashWithSalt :: Int -> PutGeofence -> Int
hashWithSalt Int
_salt PutGeofence' {Text
GeofenceGeometry
geometry :: GeofenceGeometry
geofenceId :: Text
collectionName :: Text
$sel:geometry:PutGeofence' :: PutGeofence -> GeofenceGeometry
$sel:geofenceId:PutGeofence' :: PutGeofence -> Text
$sel:collectionName:PutGeofence' :: PutGeofence -> Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
collectionName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
geofenceId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` GeofenceGeometry
geometry

instance Prelude.NFData PutGeofence where
  rnf :: PutGeofence -> ()
rnf PutGeofence' {Text
GeofenceGeometry
geometry :: GeofenceGeometry
geofenceId :: Text
collectionName :: Text
$sel:geometry:PutGeofence' :: PutGeofence -> GeofenceGeometry
$sel:geofenceId:PutGeofence' :: PutGeofence -> Text
$sel:collectionName:PutGeofence' :: PutGeofence -> Text
..} =
    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 Text
geofenceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf GeofenceGeometry
geometry

instance Data.ToHeaders PutGeofence where
  toHeaders :: PutGeofence -> 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.ToJSON PutGeofence where
  toJSON :: PutGeofence -> Value
toJSON PutGeofence' {Text
GeofenceGeometry
geometry :: GeofenceGeometry
geofenceId :: Text
collectionName :: Text
$sel:geometry:PutGeofence' :: PutGeofence -> GeofenceGeometry
$sel:geofenceId:PutGeofence' :: PutGeofence -> Text
$sel:collectionName:PutGeofence' :: PutGeofence -> Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [forall a. a -> Maybe a
Prelude.Just (Key
"Geometry" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= GeofenceGeometry
geometry)]
      )

instance Data.ToPath PutGeofence where
  toPath :: PutGeofence -> ByteString
toPath PutGeofence' {Text
GeofenceGeometry
geometry :: GeofenceGeometry
geofenceId :: Text
collectionName :: Text
$sel:geometry:PutGeofence' :: PutGeofence -> GeofenceGeometry
$sel:geofenceId:PutGeofence' :: PutGeofence -> Text
$sel:collectionName:PutGeofence' :: PutGeofence -> Text
..} =
    forall a. Monoid a => [a] -> a
Prelude.mconcat
      [ ByteString
"/geofencing/v0/collections/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
collectionName,
        ByteString
"/geofences/",
        forall a. ToByteString a => a -> ByteString
Data.toBS Text
geofenceId
      ]

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

-- | /See:/ 'newPutGeofenceResponse' smart constructor.
data PutGeofenceResponse = PutGeofenceResponse'
  { -- | The response's http status code.
    PutGeofenceResponse -> Int
httpStatus :: Prelude.Int,
    -- | The timestamp for when the geofence was created in
    -- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
    -- format: @YYYY-MM-DDThh:mm:ss.sssZ@
    PutGeofenceResponse -> ISO8601
createTime :: Data.ISO8601,
    -- | The geofence identifier entered in the request.
    PutGeofenceResponse -> Text
geofenceId :: Prelude.Text,
    -- | The timestamp for when the geofence was last updated in
    -- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
    -- format: @YYYY-MM-DDThh:mm:ss.sssZ@
    PutGeofenceResponse -> ISO8601
updateTime :: Data.ISO8601
  }
  deriving (PutGeofenceResponse -> PutGeofenceResponse -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: PutGeofenceResponse -> PutGeofenceResponse -> Bool
$c/= :: PutGeofenceResponse -> PutGeofenceResponse -> Bool
== :: PutGeofenceResponse -> PutGeofenceResponse -> Bool
$c== :: PutGeofenceResponse -> PutGeofenceResponse -> Bool
Prelude.Eq, ReadPrec [PutGeofenceResponse]
ReadPrec PutGeofenceResponse
Int -> ReadS PutGeofenceResponse
ReadS [PutGeofenceResponse]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [PutGeofenceResponse]
$creadListPrec :: ReadPrec [PutGeofenceResponse]
readPrec :: ReadPrec PutGeofenceResponse
$creadPrec :: ReadPrec PutGeofenceResponse
readList :: ReadS [PutGeofenceResponse]
$creadList :: ReadS [PutGeofenceResponse]
readsPrec :: Int -> ReadS PutGeofenceResponse
$creadsPrec :: Int -> ReadS PutGeofenceResponse
Prelude.Read, Int -> PutGeofenceResponse -> ShowS
[PutGeofenceResponse] -> ShowS
PutGeofenceResponse -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [PutGeofenceResponse] -> ShowS
$cshowList :: [PutGeofenceResponse] -> ShowS
show :: PutGeofenceResponse -> String
$cshow :: PutGeofenceResponse -> String
showsPrec :: Int -> PutGeofenceResponse -> ShowS
$cshowsPrec :: Int -> PutGeofenceResponse -> ShowS
Prelude.Show, forall x. Rep PutGeofenceResponse x -> PutGeofenceResponse
forall x. PutGeofenceResponse -> Rep PutGeofenceResponse x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep PutGeofenceResponse x -> PutGeofenceResponse
$cfrom :: forall x. PutGeofenceResponse -> Rep PutGeofenceResponse x
Prelude.Generic)

-- |
-- Create a value of 'PutGeofenceResponse' 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', 'putGeofenceResponse_httpStatus' - The response's http status code.
--
-- 'createTime', 'putGeofenceResponse_createTime' - The timestamp for when the geofence was created in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@
--
-- 'geofenceId', 'putGeofenceResponse_geofenceId' - The geofence identifier entered in the request.
--
-- 'updateTime', 'putGeofenceResponse_updateTime' - The timestamp for when the geofence was last updated in
-- <https://www.iso.org/iso-8601-date-and-time-format.html ISO 8601>
-- format: @YYYY-MM-DDThh:mm:ss.sssZ@
newPutGeofenceResponse ::
  -- | 'httpStatus'
  Prelude.Int ->
  -- | 'createTime'
  Prelude.UTCTime ->
  -- | 'geofenceId'
  Prelude.Text ->
  -- | 'updateTime'
  Prelude.UTCTime ->
  PutGeofenceResponse
newPutGeofenceResponse :: Int -> UTCTime -> Text -> UTCTime -> PutGeofenceResponse
newPutGeofenceResponse
  Int
pHttpStatus_
  UTCTime
pCreateTime_
  Text
pGeofenceId_
  UTCTime
pUpdateTime_ =
    PutGeofenceResponse'
      { $sel:httpStatus:PutGeofenceResponse' :: Int
httpStatus = Int
pHttpStatus_,
        $sel:createTime:PutGeofenceResponse' :: ISO8601
createTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pCreateTime_,
        $sel:geofenceId:PutGeofenceResponse' :: Text
geofenceId = Text
pGeofenceId_,
        $sel:updateTime:PutGeofenceResponse' :: ISO8601
updateTime = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pUpdateTime_
      }

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

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

-- | The geofence identifier entered in the request.
putGeofenceResponse_geofenceId :: Lens.Lens' PutGeofenceResponse Prelude.Text
putGeofenceResponse_geofenceId :: Lens' PutGeofenceResponse Text
putGeofenceResponse_geofenceId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\PutGeofenceResponse' {Text
geofenceId :: Text
$sel:geofenceId:PutGeofenceResponse' :: PutGeofenceResponse -> Text
geofenceId} -> Text
geofenceId) (\s :: PutGeofenceResponse
s@PutGeofenceResponse' {} Text
a -> PutGeofenceResponse
s {$sel:geofenceId:PutGeofenceResponse' :: Text
geofenceId = Text
a} :: PutGeofenceResponse)

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

instance Prelude.NFData PutGeofenceResponse where
  rnf :: PutGeofenceResponse -> ()
rnf PutGeofenceResponse' {Int
Text
ISO8601
updateTime :: ISO8601
geofenceId :: Text
createTime :: ISO8601
httpStatus :: Int
$sel:updateTime:PutGeofenceResponse' :: PutGeofenceResponse -> ISO8601
$sel:geofenceId:PutGeofenceResponse' :: PutGeofenceResponse -> Text
$sel:createTime:PutGeofenceResponse' :: PutGeofenceResponse -> ISO8601
$sel:httpStatus:PutGeofenceResponse' :: PutGeofenceResponse -> 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 ISO8601
createTime
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
geofenceId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ISO8601
updateTime