{-# LANGUAGE DeriveGeneric #-}
{-# LANGUAGE DuplicateRecordFields #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE StrictData #-}
{-# LANGUAGE NoImplicitPrelude #-}
{-# OPTIONS_GHC -fno-warn-unused-imports #-}
{-# OPTIONS_GHC -fno-warn-unused-matches #-}

-- Derived from AWS service descriptions, licensed under Apache 2.0.

-- |
-- Module      : Amazonka.Glacier.Types.S3Location
-- Copyright   : (c) 2013-2023 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay
-- Stability   : auto-generated
-- Portability : non-portable (GHC extensions)
module Amazonka.Glacier.Types.S3Location where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Glacier.Types.CannedACL
import Amazonka.Glacier.Types.Encryption
import Amazonka.Glacier.Types.Grant
import Amazonka.Glacier.Types.StorageClass
import qualified Amazonka.Prelude as Prelude

-- | Contains information about the location in Amazon S3 where the select
-- job results are stored.
--
-- /See:/ 'newS3Location' smart constructor.
data S3Location = S3Location'
  { -- | A list of grants that control access to the staged results.
    S3Location -> Maybe [Grant]
accessControlList :: Prelude.Maybe [Grant],
    -- | The name of the Amazon S3 bucket where the job results are stored.
    S3Location -> Maybe Text
bucketName :: Prelude.Maybe Prelude.Text,
    -- | The canned access control list (ACL) to apply to the job results.
    S3Location -> Maybe CannedACL
cannedACL :: Prelude.Maybe CannedACL,
    -- | Contains information about the encryption used to store the job results
    -- in Amazon S3.
    S3Location -> Maybe Encryption
encryption :: Prelude.Maybe Encryption,
    -- | The prefix that is prepended to the results for this request.
    S3Location -> Maybe Text
prefix :: Prelude.Maybe Prelude.Text,
    -- | The storage class used to store the job results.
    S3Location -> Maybe StorageClass
storageClass :: Prelude.Maybe StorageClass,
    -- | The tag-set that is applied to the job results.
    S3Location -> Maybe (HashMap Text Text)
tagging :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text),
    -- | A map of metadata to store with the job results in Amazon S3.
    S3Location -> Maybe (HashMap Text Text)
userMetadata :: Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text)
  }
  deriving (S3Location -> S3Location -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: S3Location -> S3Location -> Bool
$c/= :: S3Location -> S3Location -> Bool
== :: S3Location -> S3Location -> Bool
$c== :: S3Location -> S3Location -> Bool
Prelude.Eq, ReadPrec [S3Location]
ReadPrec S3Location
Int -> ReadS S3Location
ReadS [S3Location]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [S3Location]
$creadListPrec :: ReadPrec [S3Location]
readPrec :: ReadPrec S3Location
$creadPrec :: ReadPrec S3Location
readList :: ReadS [S3Location]
$creadList :: ReadS [S3Location]
readsPrec :: Int -> ReadS S3Location
$creadsPrec :: Int -> ReadS S3Location
Prelude.Read, Int -> S3Location -> ShowS
[S3Location] -> ShowS
S3Location -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [S3Location] -> ShowS
$cshowList :: [S3Location] -> ShowS
show :: S3Location -> String
$cshow :: S3Location -> String
showsPrec :: Int -> S3Location -> ShowS
$cshowsPrec :: Int -> S3Location -> ShowS
Prelude.Show, forall x. Rep S3Location x -> S3Location
forall x. S3Location -> Rep S3Location x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep S3Location x -> S3Location
$cfrom :: forall x. S3Location -> Rep S3Location x
Prelude.Generic)

-- |
-- Create a value of 'S3Location' 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:
--
-- 'accessControlList', 's3Location_accessControlList' - A list of grants that control access to the staged results.
--
-- 'bucketName', 's3Location_bucketName' - The name of the Amazon S3 bucket where the job results are stored.
--
-- 'cannedACL', 's3Location_cannedACL' - The canned access control list (ACL) to apply to the job results.
--
-- 'encryption', 's3Location_encryption' - Contains information about the encryption used to store the job results
-- in Amazon S3.
--
-- 'prefix', 's3Location_prefix' - The prefix that is prepended to the results for this request.
--
-- 'storageClass', 's3Location_storageClass' - The storage class used to store the job results.
--
-- 'tagging', 's3Location_tagging' - The tag-set that is applied to the job results.
--
-- 'userMetadata', 's3Location_userMetadata' - A map of metadata to store with the job results in Amazon S3.
newS3Location ::
  S3Location
newS3Location :: S3Location
newS3Location =
  S3Location'
    { $sel:accessControlList:S3Location' :: Maybe [Grant]
accessControlList = forall a. Maybe a
Prelude.Nothing,
      $sel:bucketName:S3Location' :: Maybe Text
bucketName = forall a. Maybe a
Prelude.Nothing,
      $sel:cannedACL:S3Location' :: Maybe CannedACL
cannedACL = forall a. Maybe a
Prelude.Nothing,
      $sel:encryption:S3Location' :: Maybe Encryption
encryption = forall a. Maybe a
Prelude.Nothing,
      $sel:prefix:S3Location' :: Maybe Text
prefix = forall a. Maybe a
Prelude.Nothing,
      $sel:storageClass:S3Location' :: Maybe StorageClass
storageClass = forall a. Maybe a
Prelude.Nothing,
      $sel:tagging:S3Location' :: Maybe (HashMap Text Text)
tagging = forall a. Maybe a
Prelude.Nothing,
      $sel:userMetadata:S3Location' :: Maybe (HashMap Text Text)
userMetadata = forall a. Maybe a
Prelude.Nothing
    }

-- | A list of grants that control access to the staged results.
s3Location_accessControlList :: Lens.Lens' S3Location (Prelude.Maybe [Grant])
s3Location_accessControlList :: Lens' S3Location (Maybe [Grant])
s3Location_accessControlList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3Location' {Maybe [Grant]
accessControlList :: Maybe [Grant]
$sel:accessControlList:S3Location' :: S3Location -> Maybe [Grant]
accessControlList} -> Maybe [Grant]
accessControlList) (\s :: S3Location
s@S3Location' {} Maybe [Grant]
a -> S3Location
s {$sel:accessControlList:S3Location' :: Maybe [Grant]
accessControlList = Maybe [Grant]
a} :: S3Location) 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 name of the Amazon S3 bucket where the job results are stored.
s3Location_bucketName :: Lens.Lens' S3Location (Prelude.Maybe Prelude.Text)
s3Location_bucketName :: Lens' S3Location (Maybe Text)
s3Location_bucketName = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3Location' {Maybe Text
bucketName :: Maybe Text
$sel:bucketName:S3Location' :: S3Location -> Maybe Text
bucketName} -> Maybe Text
bucketName) (\s :: S3Location
s@S3Location' {} Maybe Text
a -> S3Location
s {$sel:bucketName:S3Location' :: Maybe Text
bucketName = Maybe Text
a} :: S3Location)

-- | The canned access control list (ACL) to apply to the job results.
s3Location_cannedACL :: Lens.Lens' S3Location (Prelude.Maybe CannedACL)
s3Location_cannedACL :: Lens' S3Location (Maybe CannedACL)
s3Location_cannedACL = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3Location' {Maybe CannedACL
cannedACL :: Maybe CannedACL
$sel:cannedACL:S3Location' :: S3Location -> Maybe CannedACL
cannedACL} -> Maybe CannedACL
cannedACL) (\s :: S3Location
s@S3Location' {} Maybe CannedACL
a -> S3Location
s {$sel:cannedACL:S3Location' :: Maybe CannedACL
cannedACL = Maybe CannedACL
a} :: S3Location)

-- | Contains information about the encryption used to store the job results
-- in Amazon S3.
s3Location_encryption :: Lens.Lens' S3Location (Prelude.Maybe Encryption)
s3Location_encryption :: Lens' S3Location (Maybe Encryption)
s3Location_encryption = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3Location' {Maybe Encryption
encryption :: Maybe Encryption
$sel:encryption:S3Location' :: S3Location -> Maybe Encryption
encryption} -> Maybe Encryption
encryption) (\s :: S3Location
s@S3Location' {} Maybe Encryption
a -> S3Location
s {$sel:encryption:S3Location' :: Maybe Encryption
encryption = Maybe Encryption
a} :: S3Location)

-- | The prefix that is prepended to the results for this request.
s3Location_prefix :: Lens.Lens' S3Location (Prelude.Maybe Prelude.Text)
s3Location_prefix :: Lens' S3Location (Maybe Text)
s3Location_prefix = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3Location' {Maybe Text
prefix :: Maybe Text
$sel:prefix:S3Location' :: S3Location -> Maybe Text
prefix} -> Maybe Text
prefix) (\s :: S3Location
s@S3Location' {} Maybe Text
a -> S3Location
s {$sel:prefix:S3Location' :: Maybe Text
prefix = Maybe Text
a} :: S3Location)

-- | The storage class used to store the job results.
s3Location_storageClass :: Lens.Lens' S3Location (Prelude.Maybe StorageClass)
s3Location_storageClass :: Lens' S3Location (Maybe StorageClass)
s3Location_storageClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3Location' {Maybe StorageClass
storageClass :: Maybe StorageClass
$sel:storageClass:S3Location' :: S3Location -> Maybe StorageClass
storageClass} -> Maybe StorageClass
storageClass) (\s :: S3Location
s@S3Location' {} Maybe StorageClass
a -> S3Location
s {$sel:storageClass:S3Location' :: Maybe StorageClass
storageClass = Maybe StorageClass
a} :: S3Location)

-- | The tag-set that is applied to the job results.
s3Location_tagging :: Lens.Lens' S3Location (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
s3Location_tagging :: Lens' S3Location (Maybe (HashMap Text Text))
s3Location_tagging = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3Location' {Maybe (HashMap Text Text)
tagging :: Maybe (HashMap Text Text)
$sel:tagging:S3Location' :: S3Location -> Maybe (HashMap Text Text)
tagging} -> Maybe (HashMap Text Text)
tagging) (\s :: S3Location
s@S3Location' {} Maybe (HashMap Text Text)
a -> S3Location
s {$sel:tagging:S3Location' :: Maybe (HashMap Text Text)
tagging = Maybe (HashMap Text Text)
a} :: S3Location) 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

-- | A map of metadata to store with the job results in Amazon S3.
s3Location_userMetadata :: Lens.Lens' S3Location (Prelude.Maybe (Prelude.HashMap Prelude.Text Prelude.Text))
s3Location_userMetadata :: Lens' S3Location (Maybe (HashMap Text Text))
s3Location_userMetadata = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\S3Location' {Maybe (HashMap Text Text)
userMetadata :: Maybe (HashMap Text Text)
$sel:userMetadata:S3Location' :: S3Location -> Maybe (HashMap Text Text)
userMetadata} -> Maybe (HashMap Text Text)
userMetadata) (\s :: S3Location
s@S3Location' {} Maybe (HashMap Text Text)
a -> S3Location
s {$sel:userMetadata:S3Location' :: Maybe (HashMap Text Text)
userMetadata = Maybe (HashMap Text Text)
a} :: S3Location) 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 Data.FromJSON S3Location where
  parseJSON :: Value -> Parser S3Location
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"S3Location"
      ( \Object
x ->
          Maybe [Grant]
-> Maybe Text
-> Maybe CannedACL
-> Maybe Encryption
-> Maybe Text
-> Maybe StorageClass
-> Maybe (HashMap Text Text)
-> Maybe (HashMap Text Text)
-> S3Location
S3Location'
            forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> ( Object
x
                            forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"AccessControlList"
                            forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty
                        )
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"BucketName")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"CannedACL")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Encryption")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Prefix")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"StorageClass")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"Tagging" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser (Maybe a)
Data..:? Key
"UserMetadata" forall a. Parser (Maybe a) -> a -> Parser a
Data..!= forall a. Monoid a => a
Prelude.mempty)
      )

instance Prelude.Hashable S3Location where
  hashWithSalt :: Int -> S3Location -> Int
hashWithSalt Int
_salt S3Location' {Maybe [Grant]
Maybe Text
Maybe (HashMap Text Text)
Maybe CannedACL
Maybe Encryption
Maybe StorageClass
userMetadata :: Maybe (HashMap Text Text)
tagging :: Maybe (HashMap Text Text)
storageClass :: Maybe StorageClass
prefix :: Maybe Text
encryption :: Maybe Encryption
cannedACL :: Maybe CannedACL
bucketName :: Maybe Text
accessControlList :: Maybe [Grant]
$sel:userMetadata:S3Location' :: S3Location -> Maybe (HashMap Text Text)
$sel:tagging:S3Location' :: S3Location -> Maybe (HashMap Text Text)
$sel:storageClass:S3Location' :: S3Location -> Maybe StorageClass
$sel:prefix:S3Location' :: S3Location -> Maybe Text
$sel:encryption:S3Location' :: S3Location -> Maybe Encryption
$sel:cannedACL:S3Location' :: S3Location -> Maybe CannedACL
$sel:bucketName:S3Location' :: S3Location -> Maybe Text
$sel:accessControlList:S3Location' :: S3Location -> Maybe [Grant]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Grant]
accessControlList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
bucketName
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe CannedACL
cannedACL
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Encryption
encryption
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
prefix
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe StorageClass
storageClass
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
tagging
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (HashMap Text Text)
userMetadata

instance Prelude.NFData S3Location where
  rnf :: S3Location -> ()
rnf S3Location' {Maybe [Grant]
Maybe Text
Maybe (HashMap Text Text)
Maybe CannedACL
Maybe Encryption
Maybe StorageClass
userMetadata :: Maybe (HashMap Text Text)
tagging :: Maybe (HashMap Text Text)
storageClass :: Maybe StorageClass
prefix :: Maybe Text
encryption :: Maybe Encryption
cannedACL :: Maybe CannedACL
bucketName :: Maybe Text
accessControlList :: Maybe [Grant]
$sel:userMetadata:S3Location' :: S3Location -> Maybe (HashMap Text Text)
$sel:tagging:S3Location' :: S3Location -> Maybe (HashMap Text Text)
$sel:storageClass:S3Location' :: S3Location -> Maybe StorageClass
$sel:prefix:S3Location' :: S3Location -> Maybe Text
$sel:encryption:S3Location' :: S3Location -> Maybe Encryption
$sel:cannedACL:S3Location' :: S3Location -> Maybe CannedACL
$sel:bucketName:S3Location' :: S3Location -> Maybe Text
$sel:accessControlList:S3Location' :: S3Location -> Maybe [Grant]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [Grant]
accessControlList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
bucketName
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe CannedACL
cannedACL
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Encryption
encryption
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
prefix
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe StorageClass
storageClass
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
tagging
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (HashMap Text Text)
userMetadata

instance Data.ToJSON S3Location where
  toJSON :: S3Location -> Value
toJSON S3Location' {Maybe [Grant]
Maybe Text
Maybe (HashMap Text Text)
Maybe CannedACL
Maybe Encryption
Maybe StorageClass
userMetadata :: Maybe (HashMap Text Text)
tagging :: Maybe (HashMap Text Text)
storageClass :: Maybe StorageClass
prefix :: Maybe Text
encryption :: Maybe Encryption
cannedACL :: Maybe CannedACL
bucketName :: Maybe Text
accessControlList :: Maybe [Grant]
$sel:userMetadata:S3Location' :: S3Location -> Maybe (HashMap Text Text)
$sel:tagging:S3Location' :: S3Location -> Maybe (HashMap Text Text)
$sel:storageClass:S3Location' :: S3Location -> Maybe StorageClass
$sel:prefix:S3Location' :: S3Location -> Maybe Text
$sel:encryption:S3Location' :: S3Location -> Maybe Encryption
$sel:cannedACL:S3Location' :: S3Location -> Maybe CannedACL
$sel:bucketName:S3Location' :: S3Location -> Maybe Text
$sel:accessControlList:S3Location' :: S3Location -> Maybe [Grant]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccessControlList" 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 [Grant]
accessControlList,
            (Key
"BucketName" 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 Text
bucketName,
            (Key
"CannedACL" 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 CannedACL
cannedACL,
            (Key
"Encryption" 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 Encryption
encryption,
            (Key
"Prefix" 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 Text
prefix,
            (Key
"StorageClass" 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 StorageClass
storageClass,
            (Key
"Tagging" 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 (HashMap Text Text)
tagging,
            (Key
"UserMetadata" 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 (HashMap Text Text)
userMetadata
          ]
      )