{-# 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.Transcribe.Types.ContentRedaction
-- 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.Transcribe.Types.ContentRedaction 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.Transcribe.Types.PiiEntityType
import Amazonka.Transcribe.Types.RedactionOutput
import Amazonka.Transcribe.Types.RedactionType

-- | Makes it possible to redact or flag specified personally identifiable
-- information (PII) in your transcript. If you use @ContentRedaction@, you
-- must also include the sub-parameters: @PiiEntityTypes@,
-- @RedactionOutput@, and @RedactionType@.
--
-- /See:/ 'newContentRedaction' smart constructor.
data ContentRedaction = ContentRedaction'
  { -- | Specify which types of personally identifiable information (PII) you
    -- want to redact in your transcript. You can include as many types as
    -- you\'d like, or you can select @ALL@.
    ContentRedaction -> Maybe [PiiEntityType]
piiEntityTypes :: Prelude.Maybe [PiiEntityType],
    -- | Specify the category of information you want to redact; @PII@
    -- (personally identifiable information) is the only valid value. You can
    -- use @PiiEntityTypes@ to choose which types of PII you want to redact.
    ContentRedaction -> RedactionType
redactionType :: RedactionType,
    -- | Specify if you want only a redacted transcript, or if you want a
    -- redacted and an unredacted transcript.
    --
    -- When you choose @redacted@ Amazon Transcribe creates only a redacted
    -- transcript.
    --
    -- When you choose @redacted_and_unredacted@ Amazon Transcribe creates a
    -- redacted and an unredacted transcript (as two separate files).
    ContentRedaction -> RedactionOutput
redactionOutput :: RedactionOutput
  }
  deriving (ContentRedaction -> ContentRedaction -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: ContentRedaction -> ContentRedaction -> Bool
$c/= :: ContentRedaction -> ContentRedaction -> Bool
== :: ContentRedaction -> ContentRedaction -> Bool
$c== :: ContentRedaction -> ContentRedaction -> Bool
Prelude.Eq, ReadPrec [ContentRedaction]
ReadPrec ContentRedaction
Int -> ReadS ContentRedaction
ReadS [ContentRedaction]
forall a.
(Int -> ReadS a)
-> ReadS [a] -> ReadPrec a -> ReadPrec [a] -> Read a
readListPrec :: ReadPrec [ContentRedaction]
$creadListPrec :: ReadPrec [ContentRedaction]
readPrec :: ReadPrec ContentRedaction
$creadPrec :: ReadPrec ContentRedaction
readList :: ReadS [ContentRedaction]
$creadList :: ReadS [ContentRedaction]
readsPrec :: Int -> ReadS ContentRedaction
$creadsPrec :: Int -> ReadS ContentRedaction
Prelude.Read, Int -> ContentRedaction -> ShowS
[ContentRedaction] -> ShowS
ContentRedaction -> String
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
showList :: [ContentRedaction] -> ShowS
$cshowList :: [ContentRedaction] -> ShowS
show :: ContentRedaction -> String
$cshow :: ContentRedaction -> String
showsPrec :: Int -> ContentRedaction -> ShowS
$cshowsPrec :: Int -> ContentRedaction -> ShowS
Prelude.Show, forall x. Rep ContentRedaction x -> ContentRedaction
forall x. ContentRedaction -> Rep ContentRedaction x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
$cto :: forall x. Rep ContentRedaction x -> ContentRedaction
$cfrom :: forall x. ContentRedaction -> Rep ContentRedaction x
Prelude.Generic)

-- |
-- Create a value of 'ContentRedaction' 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:
--
-- 'piiEntityTypes', 'contentRedaction_piiEntityTypes' - Specify which types of personally identifiable information (PII) you
-- want to redact in your transcript. You can include as many types as
-- you\'d like, or you can select @ALL@.
--
-- 'redactionType', 'contentRedaction_redactionType' - Specify the category of information you want to redact; @PII@
-- (personally identifiable information) is the only valid value. You can
-- use @PiiEntityTypes@ to choose which types of PII you want to redact.
--
-- 'redactionOutput', 'contentRedaction_redactionOutput' - Specify if you want only a redacted transcript, or if you want a
-- redacted and an unredacted transcript.
--
-- When you choose @redacted@ Amazon Transcribe creates only a redacted
-- transcript.
--
-- When you choose @redacted_and_unredacted@ Amazon Transcribe creates a
-- redacted and an unredacted transcript (as two separate files).
newContentRedaction ::
  -- | 'redactionType'
  RedactionType ->
  -- | 'redactionOutput'
  RedactionOutput ->
  ContentRedaction
newContentRedaction :: RedactionType -> RedactionOutput -> ContentRedaction
newContentRedaction RedactionType
pRedactionType_ RedactionOutput
pRedactionOutput_ =
  ContentRedaction'
    { $sel:piiEntityTypes:ContentRedaction' :: Maybe [PiiEntityType]
piiEntityTypes = forall a. Maybe a
Prelude.Nothing,
      $sel:redactionType:ContentRedaction' :: RedactionType
redactionType = RedactionType
pRedactionType_,
      $sel:redactionOutput:ContentRedaction' :: RedactionOutput
redactionOutput = RedactionOutput
pRedactionOutput_
    }

-- | Specify which types of personally identifiable information (PII) you
-- want to redact in your transcript. You can include as many types as
-- you\'d like, or you can select @ALL@.
contentRedaction_piiEntityTypes :: Lens.Lens' ContentRedaction (Prelude.Maybe [PiiEntityType])
contentRedaction_piiEntityTypes :: Lens' ContentRedaction (Maybe [PiiEntityType])
contentRedaction_piiEntityTypes = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ContentRedaction' {Maybe [PiiEntityType]
piiEntityTypes :: Maybe [PiiEntityType]
$sel:piiEntityTypes:ContentRedaction' :: ContentRedaction -> Maybe [PiiEntityType]
piiEntityTypes} -> Maybe [PiiEntityType]
piiEntityTypes) (\s :: ContentRedaction
s@ContentRedaction' {} Maybe [PiiEntityType]
a -> ContentRedaction
s {$sel:piiEntityTypes:ContentRedaction' :: Maybe [PiiEntityType]
piiEntityTypes = Maybe [PiiEntityType]
a} :: ContentRedaction) 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

-- | Specify the category of information you want to redact; @PII@
-- (personally identifiable information) is the only valid value. You can
-- use @PiiEntityTypes@ to choose which types of PII you want to redact.
contentRedaction_redactionType :: Lens.Lens' ContentRedaction RedactionType
contentRedaction_redactionType :: Lens' ContentRedaction RedactionType
contentRedaction_redactionType = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ContentRedaction' {RedactionType
redactionType :: RedactionType
$sel:redactionType:ContentRedaction' :: ContentRedaction -> RedactionType
redactionType} -> RedactionType
redactionType) (\s :: ContentRedaction
s@ContentRedaction' {} RedactionType
a -> ContentRedaction
s {$sel:redactionType:ContentRedaction' :: RedactionType
redactionType = RedactionType
a} :: ContentRedaction)

-- | Specify if you want only a redacted transcript, or if you want a
-- redacted and an unredacted transcript.
--
-- When you choose @redacted@ Amazon Transcribe creates only a redacted
-- transcript.
--
-- When you choose @redacted_and_unredacted@ Amazon Transcribe creates a
-- redacted and an unredacted transcript (as two separate files).
contentRedaction_redactionOutput :: Lens.Lens' ContentRedaction RedactionOutput
contentRedaction_redactionOutput :: Lens' ContentRedaction RedactionOutput
contentRedaction_redactionOutput = forall s a b t. (s -> a) -> (s -> b -> t) -> Lens s t a b
Lens.lens (\ContentRedaction' {RedactionOutput
redactionOutput :: RedactionOutput
$sel:redactionOutput:ContentRedaction' :: ContentRedaction -> RedactionOutput
redactionOutput} -> RedactionOutput
redactionOutput) (\s :: ContentRedaction
s@ContentRedaction' {} RedactionOutput
a -> ContentRedaction
s {$sel:redactionOutput:ContentRedaction' :: RedactionOutput
redactionOutput = RedactionOutput
a} :: ContentRedaction)

instance Data.FromJSON ContentRedaction where
  parseJSON :: Value -> Parser ContentRedaction
parseJSON =
    forall a. String -> (Object -> Parser a) -> Value -> Parser a
Data.withObject
      String
"ContentRedaction"
      ( \Object
x ->
          Maybe [PiiEntityType]
-> RedactionType -> RedactionOutput -> ContentRedaction
ContentRedaction'
            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
"PiiEntityTypes" 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 a
Data..: Key
"RedactionType")
            forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
Prelude.<*> (Object
x forall a. FromJSON a => Object -> Key -> Parser a
Data..: Key
"RedactionOutput")
      )

instance Prelude.Hashable ContentRedaction where
  hashWithSalt :: Int -> ContentRedaction -> Int
hashWithSalt Int
_salt ContentRedaction' {Maybe [PiiEntityType]
RedactionOutput
RedactionType
redactionOutput :: RedactionOutput
redactionType :: RedactionType
piiEntityTypes :: Maybe [PiiEntityType]
$sel:redactionOutput:ContentRedaction' :: ContentRedaction -> RedactionOutput
$sel:redactionType:ContentRedaction' :: ContentRedaction -> RedactionType
$sel:piiEntityTypes:ContentRedaction' :: ContentRedaction -> Maybe [PiiEntityType]
..} =
    Int
_salt
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` Maybe [PiiEntityType]
piiEntityTypes
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RedactionType
redactionType
      forall a. Hashable a => Int -> a -> Int
`Prelude.hashWithSalt` RedactionOutput
redactionOutput

instance Prelude.NFData ContentRedaction where
  rnf :: ContentRedaction -> ()
rnf ContentRedaction' {Maybe [PiiEntityType]
RedactionOutput
RedactionType
redactionOutput :: RedactionOutput
redactionType :: RedactionType
piiEntityTypes :: Maybe [PiiEntityType]
$sel:redactionOutput:ContentRedaction' :: ContentRedaction -> RedactionOutput
$sel:redactionType:ContentRedaction' :: ContentRedaction -> RedactionType
$sel:piiEntityTypes:ContentRedaction' :: ContentRedaction -> Maybe [PiiEntityType]
..} =
    forall a. NFData a => a -> ()
Prelude.rnf Maybe [PiiEntityType]
piiEntityTypes
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RedactionType
redactionType
      seq :: forall a b. a -> b -> b
`Prelude.seq` forall a. NFData a => a -> ()
Prelude.rnf RedactionOutput
redactionOutput

instance Data.ToJSON ContentRedaction where
  toJSON :: ContentRedaction -> Value
toJSON ContentRedaction' {Maybe [PiiEntityType]
RedactionOutput
RedactionType
redactionOutput :: RedactionOutput
redactionType :: RedactionType
piiEntityTypes :: Maybe [PiiEntityType]
$sel:redactionOutput:ContentRedaction' :: ContentRedaction -> RedactionOutput
$sel:redactionType:ContentRedaction' :: ContentRedaction -> RedactionType
$sel:piiEntityTypes:ContentRedaction' :: ContentRedaction -> Maybe [PiiEntityType]
..} =
    [Pair] -> Value
Data.object
      ( forall a. [Maybe a] -> [a]
Prelude.catMaybes
          [ (Key
"PiiEntityTypes" 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 [PiiEntityType]
piiEntityTypes,
            forall a. a -> Maybe a
Prelude.Just (Key
"RedactionType" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= RedactionType
redactionType),
            forall a. a -> Maybe a
Prelude.Just
              (Key
"RedactionOutput" forall kv v. (KeyValue kv, ToJSON v) => Key -> v -> kv
Data..= RedactionOutput
redactionOutput)
          ]
      )