{-# 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.S3.Types.Object
-- 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.S3.Types.Object 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 Amazonka.S3.Internal
import Amazonka.S3.Types.ChecksumAlgorithm
import Amazonka.S3.Types.ObjectStorageClass
import Amazonka.S3.Types.Owner

-- | An object consists of data and its descriptive metadata.
--
-- /See:/ 'newObject' smart constructor.
data Object = Object'
  { -- | The algorithm that was used to create a checksum of the object.
    Object -> Maybe [ChecksumAlgorithm]
checksumAlgorithm :: Prelude.Maybe [ChecksumAlgorithm],
    -- | The owner of the object
    Object -> Maybe Owner
owner :: Prelude.Maybe Owner,
    -- | The entity tag is a hash of the object. The ETag reflects changes only
    -- to the contents of an object, not its metadata. The ETag may or may not
    -- be an MD5 digest of the object data. Whether or not it is depends on how
    -- the object was created and how it is encrypted as described below:
    --
    -- -   Objects created by the PUT Object, POST Object, or Copy operation,
    --     or through the Amazon Web Services Management Console, and are
    --     encrypted by SSE-S3 or plaintext, have ETags that are an MD5 digest
    --     of their object data.
    --
    -- -   Objects created by the PUT Object, POST Object, or Copy operation,
    --     or through the Amazon Web Services Management Console, and are
    --     encrypted by SSE-C or SSE-KMS, have ETags that are not an MD5 digest
    --     of their object data.
    --
    -- -   If an object is created by either the Multipart Upload or Part Copy
    --     operation, the ETag is not an MD5 digest, regardless of the method
    --     of encryption. If an object is larger than 16 MB, the Amazon Web
    --     Services Management Console will upload or copy that object as a
    --     Multipart Upload, and therefore the ETag will not be an MD5 digest.
    Object -> ETag
eTag :: ETag,
    -- | Size in bytes of the object
    Object -> Integer
size :: Prelude.Integer,
    -- | The name that you assign to an object. You use the object key to
    -- retrieve the object.
    Object -> ObjectKey
key :: ObjectKey,
    -- | The class of storage used to store the object.
    Object -> ObjectStorageClass
storageClass :: ObjectStorageClass,
    -- | Creation date of the object.
    Object -> RFC822
lastModified :: Data.RFC822
  }
  deriving (Object -> Object -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Object -> Object -> Bool
$c/= :: Object -> Object -> Bool
== :: Object -> Object -> Bool
$c== :: Object -> Object -> Bool
Prelude.Eq, ReadPrec [Object]
ReadPrec Object
Int -> ReadS Object
ReadS [Object]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Object]
$creadListPrec :: ReadPrec [Object]
readPrec :: ReadPrec Object
$creadPrec :: ReadPrec Object
readList :: ReadS [Object]
$creadList :: ReadS [Object]
readsPrec :: Int -> ReadS Object
$creadsPrec :: Int -> ReadS Object
Prelude.Read, Int -> Object -> ShowS
[Object] -> ShowS
Object -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Object] -> ShowS
$cshowList :: [Object] -> ShowS
show :: Object -> String
$cshow :: Object -> String
showsPrec :: Int -> Object -> ShowS
$cshowsPrec :: Int -> Object -> ShowS
Prelude.Show, forall x. Rep Object x -> Object
forall x. Object -> Rep Object x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Object x -> Object
$cfrom :: forall x. Object -> Rep Object x
Prelude.Generic)

-- |
-- Create a value of 'Object' 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:
--
-- 'checksumAlgorithm', 'object_checksumAlgorithm' - The algorithm that was used to create a checksum of the object.
--
-- 'owner', 'object_owner' - The owner of the object
--
-- 'eTag', 'object_eTag' - The entity tag is a hash of the object. The ETag reflects changes only
-- to the contents of an object, not its metadata. The ETag may or may not
-- be an MD5 digest of the object data. Whether or not it is depends on how
-- the object was created and how it is encrypted as described below:
--
-- -   Objects created by the PUT Object, POST Object, or Copy operation,
--     or through the Amazon Web Services Management Console, and are
--     encrypted by SSE-S3 or plaintext, have ETags that are an MD5 digest
--     of their object data.
--
-- -   Objects created by the PUT Object, POST Object, or Copy operation,
--     or through the Amazon Web Services Management Console, and are
--     encrypted by SSE-C or SSE-KMS, have ETags that are not an MD5 digest
--     of their object data.
--
-- -   If an object is created by either the Multipart Upload or Part Copy
--     operation, the ETag is not an MD5 digest, regardless of the method
--     of encryption. If an object is larger than 16 MB, the Amazon Web
--     Services Management Console will upload or copy that object as a
--     Multipart Upload, and therefore the ETag will not be an MD5 digest.
--
-- 'size', 'object_size' - Size in bytes of the object
--
-- 'key', 'object_key' - The name that you assign to an object. You use the object key to
-- retrieve the object.
--
-- 'storageClass', 'object_storageClass' - The class of storage used to store the object.
--
-- 'lastModified', 'object_lastModified' - Creation date of the object.
newObject ::
  -- | 'eTag'
  ETag ->
  -- | 'size'
  Prelude.Integer ->
  -- | 'key'
  ObjectKey ->
  -- | 'storageClass'
  ObjectStorageClass ->
  -- | 'lastModified'
  Prelude.UTCTime ->
  Object
newObject :: ETag
-> Integer -> ObjectKey -> ObjectStorageClass -> UTCTime -> Object
newObject
  ETag
pETag_
  Integer
pSize_
  ObjectKey
pKey_
  ObjectStorageClass
pStorageClass_
  UTCTime
pLastModified_ =
    Object'
      { $sel:checksumAlgorithm:Object' :: Maybe [ChecksumAlgorithm]
checksumAlgorithm = forall a. Maybe a
Prelude.Nothing,
        $sel:owner:Object' :: Maybe Owner
owner = forall a. Maybe a
Prelude.Nothing,
        $sel:eTag:Object' :: ETag
eTag = ETag
pETag_,
        $sel:size:Object' :: Integer
size = Integer
pSize_,
        $sel:key:Object' :: ObjectKey
key = ObjectKey
pKey_,
        $sel:storageClass:Object' :: ObjectStorageClass
storageClass = ObjectStorageClass
pStorageClass_,
        $sel:lastModified:Object' :: RFC822
lastModified = forall (a :: Format). Iso' (Time a) UTCTime
Data._Time forall t b. AReview t b -> b -> t
Lens.# UTCTime
pLastModified_
      }

-- | The algorithm that was used to create a checksum of the object.
object_checksumAlgorithm :: Lens.Lens' Object (Prelude.Maybe [ChecksumAlgorithm])
object_checksumAlgorithm :: Lens' Object (Maybe [ChecksumAlgorithm])
object_checksumAlgorithm = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Object' {Maybe [ChecksumAlgorithm]
checksumAlgorithm :: Maybe [ChecksumAlgorithm]
$sel:checksumAlgorithm:Object' :: Object -> Maybe [ChecksumAlgorithm]
checksumAlgorithm} -> Maybe [ChecksumAlgorithm]
checksumAlgorithm) (\s :: Object
s@Object' {} Maybe [ChecksumAlgorithm]
a -> Object
s {$sel:checksumAlgorithm:Object' :: Maybe [ChecksumAlgorithm]
checksumAlgorithm = Maybe [ChecksumAlgorithm]
a} :: Object) 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 owner of the object
object_owner :: Lens.Lens' Object (Prelude.Maybe Owner)
object_owner :: Lens' Object (Maybe Owner)
object_owner = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Object' {Maybe Owner
owner :: Maybe Owner
$sel:owner:Object' :: Object -> Maybe Owner
owner} -> Maybe Owner
owner) (\s :: Object
s@Object' {} Maybe Owner
a -> Object
s {$sel:owner:Object' :: Maybe Owner
owner = Maybe Owner
a} :: Object)

-- | The entity tag is a hash of the object. The ETag reflects changes only
-- to the contents of an object, not its metadata. The ETag may or may not
-- be an MD5 digest of the object data. Whether or not it is depends on how
-- the object was created and how it is encrypted as described below:
--
-- -   Objects created by the PUT Object, POST Object, or Copy operation,
--     or through the Amazon Web Services Management Console, and are
--     encrypted by SSE-S3 or plaintext, have ETags that are an MD5 digest
--     of their object data.
--
-- -   Objects created by the PUT Object, POST Object, or Copy operation,
--     or through the Amazon Web Services Management Console, and are
--     encrypted by SSE-C or SSE-KMS, have ETags that are not an MD5 digest
--     of their object data.
--
-- -   If an object is created by either the Multipart Upload or Part Copy
--     operation, the ETag is not an MD5 digest, regardless of the method
--     of encryption. If an object is larger than 16 MB, the Amazon Web
--     Services Management Console will upload or copy that object as a
--     Multipart Upload, and therefore the ETag will not be an MD5 digest.
object_eTag :: Lens.Lens' Object ETag
object_eTag :: Lens' Object ETag
object_eTag = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Object' {ETag
eTag :: ETag
$sel:eTag:Object' :: Object -> ETag
eTag} -> ETag
eTag) (\s :: Object
s@Object' {} ETag
a -> Object
s {$sel:eTag:Object' :: ETag
eTag = ETag
a} :: Object)

-- | Size in bytes of the object
object_size :: Lens.Lens' Object Prelude.Integer
object_size :: Lens' Object Integer
object_size = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Object' {Integer
size :: Integer
$sel:size:Object' :: Object -> Integer
size} -> Integer
size) (\s :: Object
s@Object' {} Integer
a -> Object
s {$sel:size:Object' :: Integer
size = Integer
a} :: Object)

-- | The name that you assign to an object. You use the object key to
-- retrieve the object.
object_key :: Lens.Lens' Object ObjectKey
object_key :: Lens' Object ObjectKey
object_key = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Object' {ObjectKey
key :: ObjectKey
$sel:key:Object' :: Object -> ObjectKey
key} -> ObjectKey
key) (\s :: Object
s@Object' {} ObjectKey
a -> Object
s {$sel:key:Object' :: ObjectKey
key = ObjectKey
a} :: Object)

-- | The class of storage used to store the object.
object_storageClass :: Lens.Lens' Object ObjectStorageClass
object_storageClass :: Lens' Object ObjectStorageClass
object_storageClass = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Object' {ObjectStorageClass
storageClass :: ObjectStorageClass
$sel:storageClass:Object' :: Object -> ObjectStorageClass
storageClass} -> ObjectStorageClass
storageClass) (\s :: Object
s@Object' {} ObjectStorageClass
a -> Object
s {$sel:storageClass:Object' :: ObjectStorageClass
storageClass = ObjectStorageClass
a} :: Object)

-- | Creation date of the object.
object_lastModified :: Lens.Lens' Object Prelude.UTCTime
object_lastModified :: Lens' Object UTCTime
object_lastModified = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Object' {RFC822
lastModified :: RFC822
$sel:lastModified:Object' :: Object -> RFC822
lastModified} -> RFC822
lastModified) (\s :: Object
s@Object' {} RFC822
a -> Object
s {$sel:lastModified:Object' :: RFC822
lastModified = RFC822
a} :: Object) forall b c a. (b -> c) -> (a -> b) -> a -> c
Prelude.. forall (a :: Format). Iso' (Time a) UTCTime
Data._Time

instance Data.FromXML Object where
  parseXML :: [Node] -> Either String Object
parseXML [Node]
x =
    Maybe [ChecksumAlgorithm]
-> Maybe Owner
-> ETag
-> Integer
-> ObjectKey
-> ObjectStorageClass
-> RFC822
-> Object
Object'
      forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
Prelude.<$> (forall (f :: * -> *) a b.
Applicative f =>
([a] -> f b) -> [a] -> f (Maybe b)
Core.may (forall a. FromXML a => Text -> [Node] -> Either String [a]
Data.parseXMLList Text
"ChecksumAlgorithm") [Node]
x)
      forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> ([Node]
x forall a. FromXML a => [Node] -> Text -> Either String (Maybe a)
Data..@? Text
"Owner")
      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
"ETag")
      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
"Size")
      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
"Key")
      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
"StorageClass")
      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
"LastModified")

instance Prelude.Hashable Object where
  hashWithSalt :: Int -> Object -> Int
hashWithSalt Int
_salt Object' {Integer
Maybe [ChecksumAlgorithm]
Maybe Owner
RFC822
ObjectKey
ETag
ObjectStorageClass
lastModified :: RFC822
storageClass :: ObjectStorageClass
key :: ObjectKey
size :: Integer
eTag :: ETag
owner :: Maybe Owner
checksumAlgorithm :: Maybe [ChecksumAlgorithm]
$sel:lastModified:Object' :: Object -> RFC822
$sel:storageClass:Object' :: Object -> ObjectStorageClass
$sel:key:Object' :: Object -> ObjectKey
$sel:size:Object' :: Object -> Integer
$sel:eTag:Object' :: Object -> ETag
$sel:owner:Object' :: Object -> Maybe Owner
$sel:checksumAlgorithm:Object' :: Object -> Maybe [ChecksumAlgorithm]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [ChecksumAlgorithm]
checksumAlgorithm
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Owner
owner
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ETag
eTag
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Integer
size
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ObjectKey
key
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` ObjectStorageClass
storageClass
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RFC822
lastModified

instance Prelude.NFData Object where
  rnf :: Object -> ()
rnf Object' {Integer
Maybe [ChecksumAlgorithm]
Maybe Owner
RFC822
ObjectKey
ETag
ObjectStorageClass
lastModified :: RFC822
storageClass :: ObjectStorageClass
key :: ObjectKey
size :: Integer
eTag :: ETag
owner :: Maybe Owner
checksumAlgorithm :: Maybe [ChecksumAlgorithm]
$sel:lastModified:Object' :: Object -> RFC822
$sel:storageClass:Object' :: Object -> ObjectStorageClass
$sel:key:Object' :: Object -> ObjectKey
$sel:size:Object' :: Object -> Integer
$sel:eTag:Object' :: Object -> ETag
$sel:owner:Object' :: Object -> Maybe Owner
$sel:checksumAlgorithm:Object' :: Object -> Maybe [ChecksumAlgorithm]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [ChecksumAlgorithm]
checksumAlgorithm
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Owner
owner
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ETag
eTag
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Integer
size
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ObjectKey
key
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf ObjectStorageClass
storageClass
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RFC822
lastModified