-- |
-- Module      : Amazonka.Data.Sensitive
-- Copyright   : (c) 2013-2021 Brendan Hay
-- License     : Mozilla Public License, v. 2.0.
-- Maintainer  : Brendan Hay <brendan.g.hay+amazonka@gmail.com>
-- Stability   : provisional
-- Portability : non-portable (GHC extensions)
module Amazonka.Data.Sensitive where

import Amazonka.Data.Body
import Amazonka.Data.ByteString
import Amazonka.Data.Headers
import Amazonka.Data.JSON
import Amazonka.Data.Log
import Amazonka.Data.Query
import Amazonka.Data.Text
import Amazonka.Data.XML
import Amazonka.Lens (iso)
import Amazonka.Prelude

-- | /Note/: read . show /= isomorphic
newtype Sensitive a = Sensitive {Sensitive a -> a
fromSensitive :: a}
  deriving stock (Sensitive a -> Sensitive a -> Bool
(Sensitive a -> Sensitive a -> Bool)
-> (Sensitive a -> Sensitive a -> Bool) -> Eq (Sensitive a)
forall a. Eq a => Sensitive a -> Sensitive a -> Bool
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
/= :: Sensitive a -> Sensitive a -> Bool
$c/= :: forall a. Eq a => Sensitive a -> Sensitive a -> Bool
== :: Sensitive a -> Sensitive a -> Bool
$c== :: forall a. Eq a => Sensitive a -> Sensitive a -> Bool
Eq, Eq (Sensitive a)
Eq (Sensitive a)
-> (Sensitive a -> Sensitive a -> Ordering)
-> (Sensitive a -> Sensitive a -> Bool)
-> (Sensitive a -> Sensitive a -> Bool)
-> (Sensitive a -> Sensitive a -> Bool)
-> (Sensitive a -> Sensitive a -> Bool)
-> (Sensitive a -> Sensitive a -> Sensitive a)
-> (Sensitive a -> Sensitive a -> Sensitive a)
-> Ord (Sensitive a)
Sensitive a -> Sensitive a -> Bool
Sensitive a -> Sensitive a -> Ordering
Sensitive a -> Sensitive a -> Sensitive a
forall a.
Eq a
-> (a -> a -> Ordering)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> Bool)
-> (a -> a -> a)
-> (a -> a -> a)
-> Ord a
forall a. Ord a => Eq (Sensitive a)
forall a. Ord a => Sensitive a -> Sensitive a -> Bool
forall a. Ord a => Sensitive a -> Sensitive a -> Ordering
forall a. Ord a => Sensitive a -> Sensitive a -> Sensitive a
min :: Sensitive a -> Sensitive a -> Sensitive a
$cmin :: forall a. Ord a => Sensitive a -> Sensitive a -> Sensitive a
max :: Sensitive a -> Sensitive a -> Sensitive a
$cmax :: forall a. Ord a => Sensitive a -> Sensitive a -> Sensitive a
>= :: Sensitive a -> Sensitive a -> Bool
$c>= :: forall a. Ord a => Sensitive a -> Sensitive a -> Bool
> :: Sensitive a -> Sensitive a -> Bool
$c> :: forall a. Ord a => Sensitive a -> Sensitive a -> Bool
<= :: Sensitive a -> Sensitive a -> Bool
$c<= :: forall a. Ord a => Sensitive a -> Sensitive a -> Bool
< :: Sensitive a -> Sensitive a -> Bool
$c< :: forall a. Ord a => Sensitive a -> Sensitive a -> Bool
compare :: Sensitive a -> Sensitive a -> Ordering
$ccompare :: forall a. Ord a => Sensitive a -> Sensitive a -> Ordering
$cp1Ord :: forall a. Ord a => Eq (Sensitive a)
Ord, (forall x. Sensitive a -> Rep (Sensitive a) x)
-> (forall x. Rep (Sensitive a) x -> Sensitive a)
-> Generic (Sensitive a)
forall x. Rep (Sensitive a) x -> Sensitive a
forall x. Sensitive a -> Rep (Sensitive a) x
forall a.
(forall x. a -> Rep a x) -> (forall x. Rep a x -> a) -> Generic a
forall a x. Rep (Sensitive a) x -> Sensitive a
forall a x. Sensitive a -> Rep (Sensitive a) x
$cto :: forall a x. Rep (Sensitive a) x -> Sensitive a
$cfrom :: forall a x. Sensitive a -> Rep (Sensitive a) x
Generic)
  deriving newtype
    ( String -> Sensitive a
(String -> Sensitive a) -> IsString (Sensitive a)
forall a. IsString a => String -> Sensitive a
forall a. (String -> a) -> IsString a
fromString :: String -> Sensitive a
$cfromString :: forall a. IsString a => String -> Sensitive a
IsString,
      b -> Sensitive a -> Sensitive a
NonEmpty (Sensitive a) -> Sensitive a
Sensitive a -> Sensitive a -> Sensitive a
(Sensitive a -> Sensitive a -> Sensitive a)
-> (NonEmpty (Sensitive a) -> Sensitive a)
-> (forall b. Integral b => b -> Sensitive a -> Sensitive a)
-> Semigroup (Sensitive a)
forall b. Integral b => b -> Sensitive a -> Sensitive a
forall a. Semigroup a => NonEmpty (Sensitive a) -> Sensitive a
forall a. Semigroup a => Sensitive a -> Sensitive a -> Sensitive a
forall a b.
(Semigroup a, Integral b) =>
b -> Sensitive a -> Sensitive a
forall a.
(a -> a -> a)
-> (NonEmpty a -> a)
-> (forall b. Integral b => b -> a -> a)
-> Semigroup a
stimes :: b -> Sensitive a -> Sensitive a
$cstimes :: forall a b.
(Semigroup a, Integral b) =>
b -> Sensitive a -> Sensitive a
sconcat :: NonEmpty (Sensitive a) -> Sensitive a
$csconcat :: forall a. Semigroup a => NonEmpty (Sensitive a) -> Sensitive a
<> :: Sensitive a -> Sensitive a -> Sensitive a
$c<> :: forall a. Semigroup a => Sensitive a -> Sensitive a -> Sensitive a
Semigroup,
      Semigroup (Sensitive a)
Sensitive a
Semigroup (Sensitive a)
-> Sensitive a
-> (Sensitive a -> Sensitive a -> Sensitive a)
-> ([Sensitive a] -> Sensitive a)
-> Monoid (Sensitive a)
[Sensitive a] -> Sensitive a
Sensitive a -> Sensitive a -> Sensitive a
forall a.
Semigroup a -> a -> (a -> a -> a) -> ([a] -> a) -> Monoid a
forall a. Monoid a => Semigroup (Sensitive a)
forall a. Monoid a => Sensitive a
forall a. Monoid a => [Sensitive a] -> Sensitive a
forall a. Monoid a => Sensitive a -> Sensitive a -> Sensitive a
mconcat :: [Sensitive a] -> Sensitive a
$cmconcat :: forall a. Monoid a => [Sensitive a] -> Sensitive a
mappend :: Sensitive a -> Sensitive a -> Sensitive a
$cmappend :: forall a. Monoid a => Sensitive a -> Sensitive a -> Sensitive a
mempty :: Sensitive a
$cmempty :: forall a. Monoid a => Sensitive a
$cp1Monoid :: forall a. Monoid a => Semigroup (Sensitive a)
Monoid,
      Sensitive a -> ByteString
(Sensitive a -> ByteString) -> ToByteString (Sensitive a)
forall a. ToByteString a => Sensitive a -> ByteString
forall a. (a -> ByteString) -> ToByteString a
toBS :: Sensitive a -> ByteString
$ctoBS :: forall a. ToByteString a => Sensitive a -> ByteString
ToByteString,
      Text -> Either String (Sensitive a)
(Text -> Either String (Sensitive a)) -> FromText (Sensitive a)
forall a. FromText a => Text -> Either String (Sensitive a)
forall a. (Text -> Either String a) -> FromText a
fromText :: Text -> Either String (Sensitive a)
$cfromText :: forall a. FromText a => Text -> Either String (Sensitive a)
FromText,
      Sensitive a -> Text
(Sensitive a -> Text) -> ToText (Sensitive a)
forall a. ToText a => Sensitive a -> Text
forall a. (a -> Text) -> ToText a
toText :: Sensitive a -> Text
$ctoText :: forall a. ToText a => Sensitive a -> Text
ToText,
      [Node] -> Either String (Sensitive a)
([Node] -> Either String (Sensitive a)) -> FromXML (Sensitive a)
forall a. FromXML a => [Node] -> Either String (Sensitive a)
forall a. ([Node] -> Either String a) -> FromXML a
parseXML :: [Node] -> Either String (Sensitive a)
$cparseXML :: forall a. FromXML a => [Node] -> Either String (Sensitive a)
FromXML,
      Sensitive a -> XML
(Sensitive a -> XML) -> ToXML (Sensitive a)
forall a. ToXML a => Sensitive a -> XML
forall a. (a -> XML) -> ToXML a
toXML :: Sensitive a -> XML
$ctoXML :: forall a. ToXML a => Sensitive a -> XML
ToXML,
      Sensitive a -> QueryString
(Sensitive a -> QueryString) -> ToQuery (Sensitive a)
forall a. ToQuery a => Sensitive a -> QueryString
forall a. (a -> QueryString) -> ToQuery a
toQuery :: Sensitive a -> QueryString
$ctoQuery :: forall a. ToQuery a => Sensitive a -> QueryString
ToQuery,
      [Sensitive a] -> Encoding
[Sensitive a] -> Value
Sensitive a -> Encoding
Sensitive a -> Value
(Sensitive a -> Value)
-> (Sensitive a -> Encoding)
-> ([Sensitive a] -> Value)
-> ([Sensitive a] -> Encoding)
-> ToJSON (Sensitive a)
forall a. ToJSON a => [Sensitive a] -> Encoding
forall a. ToJSON a => [Sensitive a] -> Value
forall a. ToJSON a => Sensitive a -> Encoding
forall a. ToJSON a => Sensitive a -> Value
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
toEncodingList :: [Sensitive a] -> Encoding
$ctoEncodingList :: forall a. ToJSON a => [Sensitive a] -> Encoding
toJSONList :: [Sensitive a] -> Value
$ctoJSONList :: forall a. ToJSON a => [Sensitive a] -> Value
toEncoding :: Sensitive a -> Encoding
$ctoEncoding :: forall a. ToJSON a => Sensitive a -> Encoding
toJSON :: Sensitive a -> Value
$ctoJSON :: forall a. ToJSON a => Sensitive a -> Value
ToJSON,
      Value -> Parser [Sensitive a]
Value -> Parser (Sensitive a)
(Value -> Parser (Sensitive a))
-> (Value -> Parser [Sensitive a]) -> FromJSON (Sensitive a)
forall a. FromJSON a => Value -> Parser [Sensitive a]
forall a. FromJSON a => Value -> Parser (Sensitive a)
forall a.
(Value -> Parser a) -> (Value -> Parser [a]) -> FromJSON a
parseJSONList :: Value -> Parser [Sensitive a]
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Sensitive a]
parseJSON :: Value -> Parser (Sensitive a)
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Sensitive a)
FromJSON,
      HeaderName -> Sensitive a -> [Header]
(HeaderName -> Sensitive a -> [Header]) -> ToHeader (Sensitive a)
forall a. ToHeader a => HeaderName -> Sensitive a -> [Header]
forall a. (HeaderName -> a -> [Header]) -> ToHeader a
toHeader :: HeaderName -> Sensitive a -> [Header]
$ctoHeader :: forall a. ToHeader a => HeaderName -> Sensitive a -> [Header]
ToHeader,
      Sensitive a -> RequestBody
(Sensitive a -> RequestBody) -> ToBody (Sensitive a)
forall a. ToBody a => Sensitive a -> RequestBody
forall a. (a -> RequestBody) -> ToBody a
toBody :: Sensitive a -> RequestBody
$ctoBody :: forall a. ToBody a => Sensitive a -> RequestBody
ToBody,
      Int -> Sensitive a -> Int
Sensitive a -> Int
(Int -> Sensitive a -> Int)
-> (Sensitive a -> Int) -> Hashable (Sensitive a)
forall a. Hashable a => Int -> Sensitive a -> Int
forall a. Hashable a => Sensitive a -> Int
forall a. (Int -> a -> Int) -> (a -> Int) -> Hashable a
hash :: Sensitive a -> Int
$chash :: forall a. Hashable a => Sensitive a -> Int
hashWithSalt :: Int -> Sensitive a -> Int
$chashWithSalt :: forall a. Hashable a => Int -> Sensitive a -> Int
Hashable,
      Sensitive a -> ()
(Sensitive a -> ()) -> NFData (Sensitive a)
forall a. NFData a => Sensitive a -> ()
forall a. (a -> ()) -> NFData a
rnf :: Sensitive a -> ()
$crnf :: forall a. NFData a => Sensitive a -> ()
NFData,
      Int -> [Item (Sensitive a)] -> Sensitive a
[Item (Sensitive a)] -> Sensitive a
Sensitive a -> [Item (Sensitive a)]
([Item (Sensitive a)] -> Sensitive a)
-> (Int -> [Item (Sensitive a)] -> Sensitive a)
-> (Sensitive a -> [Item (Sensitive a)])
-> IsList (Sensitive a)
forall a. IsList a => Int -> [Item (Sensitive a)] -> Sensitive a
forall a. IsList a => [Item (Sensitive a)] -> Sensitive a
forall a. IsList a => Sensitive a -> [Item (Sensitive a)]
forall l.
([Item l] -> l)
-> (Int -> [Item l] -> l) -> (l -> [Item l]) -> IsList l
toList :: Sensitive a -> [Item (Sensitive a)]
$ctoList :: forall a. IsList a => Sensitive a -> [Item (Sensitive a)]
fromListN :: Int -> [Item (Sensitive a)] -> Sensitive a
$cfromListN :: forall a. IsList a => Int -> [Item (Sensitive a)] -> Sensitive a
fromList :: [Item (Sensitive a)] -> Sensitive a
$cfromList :: forall a. IsList a => [Item (Sensitive a)] -> Sensitive a
IsList
    )

instance Show (Sensitive a) where
  show :: Sensitive a -> String
show = String -> Sensitive a -> String
forall a b. a -> b -> a
const String
"******"

instance ToLog (Sensitive a) where
  build :: Sensitive a -> ByteStringBuilder
build = ByteStringBuilder -> Sensitive a -> ByteStringBuilder
forall a b. a -> b -> a
const ByteStringBuilder
"******"

_Sensitive :: Iso' (Sensitive a) a
_Sensitive :: p a (f a) -> p (Sensitive a) (f (Sensitive a))
_Sensitive = (Sensitive a -> a)
-> (a -> Sensitive a) -> Iso (Sensitive a) (Sensitive a) a a
forall s a b t. (s -> a) -> (b -> t) -> Iso s t a b
iso Sensitive a -> a
forall a. Sensitive a -> a
fromSensitive a -> Sensitive a
forall a. a -> Sensitive a
Sensitive