{-# 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.Kendra.Types.Document
-- 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.Kendra.Types.Document where

import qualified Amazonka.Core as Core
import qualified Amazonka.Core.Lens.Internal as Lens
import qualified Amazonka.Data as Data
import Amazonka.Kendra.Types.ContentType
import Amazonka.Kendra.Types.DocumentAttribute
import Amazonka.Kendra.Types.HierarchicalPrincipal
import Amazonka.Kendra.Types.Principal
import Amazonka.Kendra.Types.S3Path
import qualified Amazonka.Prelude as Prelude

-- | A document in an index.
--
-- /See:/ 'newDocument' smart constructor.
data Document = Document'
  { -- | The identifier of the access control configuration that you want to
    -- apply to the document.
    Document -> Maybe Text
accessControlConfigurationId :: Prelude.Maybe Prelude.Text,
    -- | Information on principals (users and\/or groups) and which documents
    -- they should have access to. This is useful for user context filtering,
    -- where search results are filtered based on the user or their group
    -- access to documents.
    Document -> Maybe [Principal]
accessControlList :: Prelude.Maybe [Principal],
    -- | Custom attributes to apply to the document. Use the custom attributes to
    -- provide additional information for searching, to provide facets for
    -- refining searches, and to provide additional information in the query
    -- response.
    --
    -- For example, \'DataSourceId\' and \'DataSourceSyncJobId\' are custom
    -- attributes that provide information on the synchronization of documents
    -- running on a data source. Note, \'DataSourceSyncJobId\' could be an
    -- optional custom attribute as Amazon Kendra will use the ID of a running
    -- sync job.
    Document -> Maybe [DocumentAttribute]
attributes :: Prelude.Maybe [DocumentAttribute],
    -- | The contents of the document.
    --
    -- Documents passed to the @Blob@ parameter must be base64 encoded. Your
    -- code might not need to encode the document file bytes if you\'re using
    -- an Amazon Web Services SDK to call Amazon Kendra APIs. If you are
    -- calling the Amazon Kendra endpoint directly using REST, you must base64
    -- encode the contents before sending.
    Document -> Maybe Base64
blob :: Prelude.Maybe Data.Base64,
    -- | The file type of the document in the @Blob@ field.
    Document -> Maybe ContentType
contentType :: Prelude.Maybe ContentType,
    -- | The list of
    -- <https://docs.aws.amazon.com/kendra/latest/dg/API_Principal.html principal>
    -- lists that define the hierarchy for which documents users should have
    -- access to.
    Document -> Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList :: Prelude.Maybe (Prelude.NonEmpty HierarchicalPrincipal),
    Document -> Maybe S3Path
s3Path :: Prelude.Maybe S3Path,
    -- | The title of the document.
    Document -> Maybe Text
title :: Prelude.Maybe Prelude.Text,
    -- | A identifier of the document in the index.
    --
    -- Note, each document ID must be unique per index. You cannot create a
    -- data source to index your documents with their unique IDs and then use
    -- the @BatchPutDocument@ API to index the same documents, or vice versa.
    -- You can delete a data source and then use the @BatchPutDocument@ API to
    -- index the same documents, or vice versa.
    Document -> Text
id :: Prelude.Text
  }
  deriving (Document -> Document -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Document -> Document -> Bool
$c/= :: Document -> Document -> Bool
== :: Document -> Document -> Bool
$c== :: Document -> Document -> Bool
Prelude.Eq, ReadPrec [Document]
ReadPrec Document
Int -> ReadS Document
ReadS [Document]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [Document]
$creadListPrec :: ReadPrec [Document]
readPrec :: ReadPrec Document
$creadPrec :: ReadPrec Document
readList :: ReadS [Document]
$creadList :: ReadS [Document]
readsPrec :: Int -> ReadS Document
$creadsPrec :: Int -> ReadS Document
Prelude.Read, Int -> Document -> ShowS
[Document] -> ShowS
Document -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [Document] -> ShowS
$cshowList :: [Document] -> ShowS
show :: Document -> String
$cshow :: Document -> String
showsPrec :: Int -> Document -> ShowS
$cshowsPrec :: Int -> Document -> ShowS
Prelude.Show, forall x. Rep Document x -> Document
forall x. Document -> Rep Document x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep Document x -> Document
$cfrom :: forall x. Document -> Rep Document x
Prelude.Generic)

-- |
-- Create a value of 'Document' 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:
--
-- 'accessControlConfigurationId', 'document_accessControlConfigurationId' - The identifier of the access control configuration that you want to
-- apply to the document.
--
-- 'accessControlList', 'document_accessControlList' - Information on principals (users and\/or groups) and which documents
-- they should have access to. This is useful for user context filtering,
-- where search results are filtered based on the user or their group
-- access to documents.
--
-- 'attributes', 'document_attributes' - Custom attributes to apply to the document. Use the custom attributes to
-- provide additional information for searching, to provide facets for
-- refining searches, and to provide additional information in the query
-- response.
--
-- For example, \'DataSourceId\' and \'DataSourceSyncJobId\' are custom
-- attributes that provide information on the synchronization of documents
-- running on a data source. Note, \'DataSourceSyncJobId\' could be an
-- optional custom attribute as Amazon Kendra will use the ID of a running
-- sync job.
--
-- 'blob', 'document_blob' - The contents of the document.
--
-- Documents passed to the @Blob@ parameter must be base64 encoded. Your
-- code might not need to encode the document file bytes if you\'re using
-- an Amazon Web Services SDK to call Amazon Kendra APIs. If you are
-- calling the Amazon Kendra endpoint directly using REST, you must base64
-- encode the contents before sending.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
--
-- 'contentType', 'document_contentType' - The file type of the document in the @Blob@ field.
--
-- 'hierarchicalAccessControlList', 'document_hierarchicalAccessControlList' - The list of
-- <https://docs.aws.amazon.com/kendra/latest/dg/API_Principal.html principal>
-- lists that define the hierarchy for which documents users should have
-- access to.
--
-- 's3Path', 'document_s3Path' - Undocumented member.
--
-- 'title', 'document_title' - The title of the document.
--
-- 'id', 'document_id' - A identifier of the document in the index.
--
-- Note, each document ID must be unique per index. You cannot create a
-- data source to index your documents with their unique IDs and then use
-- the @BatchPutDocument@ API to index the same documents, or vice versa.
-- You can delete a data source and then use the @BatchPutDocument@ API to
-- index the same documents, or vice versa.
newDocument ::
  -- | 'id'
  Prelude.Text ->
  Document
newDocument :: Text -> Document
newDocument Text
pId_ =
  Document'
    { $sel:accessControlConfigurationId:Document' :: Maybe Text
accessControlConfigurationId =
        forall a. Maybe a
Prelude.Nothing,
      $sel:accessControlList:Document' :: Maybe [Principal]
accessControlList = forall a. Maybe a
Prelude.Nothing,
      $sel:attributes:Document' :: Maybe [DocumentAttribute]
attributes = forall a. Maybe a
Prelude.Nothing,
      $sel:blob:Document' :: Maybe Base64
blob = forall a. Maybe a
Prelude.Nothing,
      $sel:contentType:Document' :: Maybe ContentType
contentType = forall a. Maybe a
Prelude.Nothing,
      $sel:hierarchicalAccessControlList:Document' :: Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList = forall a. Maybe a
Prelude.Nothing,
      $sel:s3Path:Document' :: Maybe S3Path
s3Path = forall a. Maybe a
Prelude.Nothing,
      $sel:title:Document' :: Maybe Text
title = forall a. Maybe a
Prelude.Nothing,
      $sel:id:Document' :: Text
id = Text
pId_
    }

-- | The identifier of the access control configuration that you want to
-- apply to the document.
document_accessControlConfigurationId :: Lens.Lens' Document (Prelude.Maybe Prelude.Text)
document_accessControlConfigurationId :: Lens' Document (Maybe Text)
document_accessControlConfigurationId = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Document' {Maybe Text
accessControlConfigurationId :: Maybe Text
$sel:accessControlConfigurationId:Document' :: Document -> Maybe Text
accessControlConfigurationId} -> Maybe Text
accessControlConfigurationId) (\s :: Document
s@Document' {} Maybe Text
a -> Document
s {$sel:accessControlConfigurationId:Document' :: Maybe Text
accessControlConfigurationId = Maybe Text
a} :: Document)

-- | Information on principals (users and\/or groups) and which documents
-- they should have access to. This is useful for user context filtering,
-- where search results are filtered based on the user or their group
-- access to documents.
document_accessControlList :: Lens.Lens' Document (Prelude.Maybe [Principal])
document_accessControlList :: Lens' Document (Maybe [Principal])
document_accessControlList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Document' {Maybe [Principal]
accessControlList :: Maybe [Principal]
$sel:accessControlList:Document' :: Document -> Maybe [Principal]
accessControlList} -> Maybe [Principal]
accessControlList) (\s :: Document
s@Document' {} Maybe [Principal]
a -> Document
s {$sel:accessControlList:Document' :: Maybe [Principal]
accessControlList = Maybe [Principal]
a} :: Document) 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

-- | Custom attributes to apply to the document. Use the custom attributes to
-- provide additional information for searching, to provide facets for
-- refining searches, and to provide additional information in the query
-- response.
--
-- For example, \'DataSourceId\' and \'DataSourceSyncJobId\' are custom
-- attributes that provide information on the synchronization of documents
-- running on a data source. Note, \'DataSourceSyncJobId\' could be an
-- optional custom attribute as Amazon Kendra will use the ID of a running
-- sync job.
document_attributes :: Lens.Lens' Document (Prelude.Maybe [DocumentAttribute])
document_attributes :: Lens' Document (Maybe [DocumentAttribute])
document_attributes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Document' {Maybe [DocumentAttribute]
attributes :: Maybe [DocumentAttribute]
$sel:attributes:Document' :: Document -> Maybe [DocumentAttribute]
attributes} -> Maybe [DocumentAttribute]
attributes) (\s :: Document
s@Document' {} Maybe [DocumentAttribute]
a -> Document
s {$sel:attributes:Document' :: Maybe [DocumentAttribute]
attributes = Maybe [DocumentAttribute]
a} :: Document) 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 contents of the document.
--
-- Documents passed to the @Blob@ parameter must be base64 encoded. Your
-- code might not need to encode the document file bytes if you\'re using
-- an Amazon Web Services SDK to call Amazon Kendra APIs. If you are
-- calling the Amazon Kendra endpoint directly using REST, you must base64
-- encode the contents before sending.--
-- -- /Note:/ This 'Lens' automatically encodes and decodes Base64 data.
-- -- The underlying isomorphism will encode to Base64 representation during
-- -- serialisation, and decode from Base64 representation during deserialisation.
-- -- This 'Lens' accepts and returns only raw unencoded data.
document_blob :: Lens.Lens' Document (Prelude.Maybe Prelude.ByteString)
document_blob :: Lens' Document (Maybe ByteString)
document_blob = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Document' {Maybe Base64
blob :: Maybe Base64
$sel:blob:Document' :: Document -> Maybe Base64
blob} -> Maybe Base64
blob) (\s :: Document
s@Document' {} Maybe Base64
a -> Document
s {$sel:blob:Document' :: Maybe Base64
blob = Maybe Base64
a} :: Document) 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 Iso' Base64 ByteString
Data._Base64

-- | The file type of the document in the @Blob@ field.
document_contentType :: Lens.Lens' Document (Prelude.Maybe ContentType)
document_contentType :: Lens' Document (Maybe ContentType)
document_contentType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Document' {Maybe ContentType
contentType :: Maybe ContentType
$sel:contentType:Document' :: Document -> Maybe ContentType
contentType} -> Maybe ContentType
contentType) (\s :: Document
s@Document' {} Maybe ContentType
a -> Document
s {$sel:contentType:Document' :: Maybe ContentType
contentType = Maybe ContentType
a} :: Document)

-- | The list of
-- <https://docs.aws.amazon.com/kendra/latest/dg/API_Principal.html principal>
-- lists that define the hierarchy for which documents users should have
-- access to.
document_hierarchicalAccessControlList :: Lens.Lens' Document (Prelude.Maybe (Prelude.NonEmpty HierarchicalPrincipal))
document_hierarchicalAccessControlList :: Lens' Document (Maybe (NonEmpty HierarchicalPrincipal))
document_hierarchicalAccessControlList = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Document' {Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList :: Maybe (NonEmpty HierarchicalPrincipal)
$sel:hierarchicalAccessControlList:Document' :: Document -> Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList} -> Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList) (\s :: Document
s@Document' {} Maybe (NonEmpty HierarchicalPrincipal)
a -> Document
s {$sel:hierarchicalAccessControlList:Document' :: Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList = Maybe (NonEmpty HierarchicalPrincipal)
a} :: Document) 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

-- | Undocumented member.
document_s3Path :: Lens.Lens' Document (Prelude.Maybe S3Path)
document_s3Path :: Lens' Document (Maybe S3Path)
document_s3Path = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Document' {Maybe S3Path
s3Path :: Maybe S3Path
$sel:s3Path:Document' :: Document -> Maybe S3Path
s3Path} -> Maybe S3Path
s3Path) (\s :: Document
s@Document' {} Maybe S3Path
a -> Document
s {$sel:s3Path:Document' :: Maybe S3Path
s3Path = Maybe S3Path
a} :: Document)

-- | The title of the document.
document_title :: Lens.Lens' Document (Prelude.Maybe Prelude.Text)
document_title :: Lens' Document (Maybe Text)
document_title = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Document' {Maybe Text
title :: Maybe Text
$sel:title:Document' :: Document -> Maybe Text
title} -> Maybe Text
title) (\s :: Document
s@Document' {} Maybe Text
a -> Document
s {$sel:title:Document' :: Maybe Text
title = Maybe Text
a} :: Document)

-- | A identifier of the document in the index.
--
-- Note, each document ID must be unique per index. You cannot create a
-- data source to index your documents with their unique IDs and then use
-- the @BatchPutDocument@ API to index the same documents, or vice versa.
-- You can delete a data source and then use the @BatchPutDocument@ API to
-- index the same documents, or vice versa.
document_id :: Lens.Lens' Document Prelude.Text
document_id :: Lens' Document Text
document_id = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\Document' {Text
id :: Text
$sel:id:Document' :: Document -> Text
id} -> Text
id) (\s :: Document
s@Document' {} Text
a -> Document
s {$sel:id:Document' :: Text
id = Text
a} :: Document)

instance Prelude.Hashable Document where
  hashWithSalt :: Int -> Document -> Int
hashWithSalt Int
_salt Document' {Maybe [DocumentAttribute]
Maybe [Principal]
Maybe (NonEmpty HierarchicalPrincipal)
Maybe Text
Maybe Base64
Maybe ContentType
Maybe S3Path
Text
id :: Text
title :: Maybe Text
s3Path :: Maybe S3Path
hierarchicalAccessControlList :: Maybe (NonEmpty HierarchicalPrincipal)
contentType :: Maybe ContentType
blob :: Maybe Base64
attributes :: Maybe [DocumentAttribute]
accessControlList :: Maybe [Principal]
accessControlConfigurationId :: Maybe Text
$sel:id:Document' :: Document -> Text
$sel:title:Document' :: Document -> Maybe Text
$sel:s3Path:Document' :: Document -> Maybe S3Path
$sel:hierarchicalAccessControlList:Document' :: Document -> Maybe (NonEmpty HierarchicalPrincipal)
$sel:contentType:Document' :: Document -> Maybe ContentType
$sel:blob:Document' :: Document -> Maybe Base64
$sel:attributes:Document' :: Document -> Maybe [DocumentAttribute]
$sel:accessControlList:Document' :: Document -> Maybe [Principal]
$sel:accessControlConfigurationId:Document' :: Document -> Maybe Text
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
accessControlConfigurationId
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [Principal]
accessControlList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [DocumentAttribute]
attributes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Base64
blob
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe ContentType
contentType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe S3Path
s3Path
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe Text
title
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Text
id

instance Prelude.NFData Document where
  rnf :: Document -> ()
rnf Document' {Maybe [DocumentAttribute]
Maybe [Principal]
Maybe (NonEmpty HierarchicalPrincipal)
Maybe Text
Maybe Base64
Maybe ContentType
Maybe S3Path
Text
id :: Text
title :: Maybe Text
s3Path :: Maybe S3Path
hierarchicalAccessControlList :: Maybe (NonEmpty HierarchicalPrincipal)
contentType :: Maybe ContentType
blob :: Maybe Base64
attributes :: Maybe [DocumentAttribute]
accessControlList :: Maybe [Principal]
accessControlConfigurationId :: Maybe Text
$sel:id:Document' :: Document -> Text
$sel:title:Document' :: Document -> Maybe Text
$sel:s3Path:Document' :: Document -> Maybe S3Path
$sel:hierarchicalAccessControlList:Document' :: Document -> Maybe (NonEmpty HierarchicalPrincipal)
$sel:contentType:Document' :: Document -> Maybe ContentType
$sel:blob:Document' :: Document -> Maybe Base64
$sel:attributes:Document' :: Document -> Maybe [DocumentAttribute]
$sel:accessControlList:Document' :: Document -> Maybe [Principal]
$sel:accessControlConfigurationId:Document' :: Document -> Maybe Text
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
accessControlConfigurationId
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [Principal]
accessControlList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe [DocumentAttribute]
attributes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Base64
blob
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe ContentType
contentType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe S3Path
s3Path
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Maybe Text
title
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf Text
id

instance Data.ToJSON Document where
  toJSON :: Document -> Value
toJSON Document' {Maybe [DocumentAttribute]
Maybe [Principal]
Maybe (NonEmpty HierarchicalPrincipal)
Maybe Text
Maybe Base64
Maybe ContentType
Maybe S3Path
Text
id :: Text
title :: Maybe Text
s3Path :: Maybe S3Path
hierarchicalAccessControlList :: Maybe (NonEmpty HierarchicalPrincipal)
contentType :: Maybe ContentType
blob :: Maybe Base64
attributes :: Maybe [DocumentAttribute]
accessControlList :: Maybe [Principal]
accessControlConfigurationId :: Maybe Text
$sel:id:Document' :: Document -> Text
$sel:title:Document' :: Document -> Maybe Text
$sel:s3Path:Document' :: Document -> Maybe S3Path
$sel:hierarchicalAccessControlList:Document' :: Document -> Maybe (NonEmpty HierarchicalPrincipal)
$sel:contentType:Document' :: Document -> Maybe ContentType
$sel:blob:Document' :: Document -> Maybe Base64
$sel:attributes:Document' :: Document -> Maybe [DocumentAttribute]
$sel:accessControlList:Document' :: Document -> Maybe [Principal]
$sel:accessControlConfigurationId:Document' :: Document -> Maybe Text
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"AccessControlConfigurationId" 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
accessControlConfigurationId,
            (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 [Principal]
accessControlList,
            (Key
"Attributes" 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 [DocumentAttribute]
attributes,
            (Key
"Blob" 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 Base64
blob,
            (Key
"ContentType" 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 ContentType
contentType,
            (Key
"HierarchicalAccessControlList" 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 (NonEmpty HierarchicalPrincipal)
hierarchicalAccessControlList,
            (Key
"S3Path" 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 S3Path
s3Path,
            (Key
"Title" 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
title,
            forall a. a -> Maybe a
Prelude.Just (Key
"Id" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= Text
id)
          ]
      )