{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}

module Hercules.API.Sensitive where

import Data.Aeson (FromJSON, ToJSON)
import Data.Functor.Identity (Identity (Identity))
import GHC.Generics (Generic)
import Prelude

-- | newtype wrapper to avoid leaking sensitive data through 'Show'
newtype Sensitive a = Sensitive {forall a. Sensitive a -> a
reveal :: a}
  deriving ((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
$cfrom :: forall a x. Sensitive a -> Rep (Sensitive a) x
from :: forall x. Sensitive a -> Rep (Sensitive a) x
$cto :: forall a x. Rep (Sensitive a) x -> Sensitive a
to :: forall x. Rep (Sensitive a) x -> Sensitive a
Generic)
  deriving newtype (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
$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
/= :: 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
$ccompare :: forall a. Ord a => Sensitive a -> Sensitive a -> Ordering
compare :: Sensitive a -> Sensitive a -> Ordering
$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
>= :: Sensitive a -> Sensitive a -> Bool
$cmax :: forall a. Ord a => Sensitive a -> Sensitive a -> Sensitive a
max :: Sensitive a -> Sensitive a -> Sensitive a
$cmin :: forall a. Ord a => Sensitive a -> Sensitive a -> Sensitive a
min :: Sensitive a -> Sensitive a -> Sensitive a
Ord, 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
$cmempty :: forall a. Monoid a => Sensitive a
mempty :: Sensitive a
$cmappend :: forall a. Monoid a => Sensitive a -> Sensitive a -> Sensitive a
mappend :: Sensitive a -> Sensitive a -> Sensitive a
$cmconcat :: forall a. Monoid a => [Sensitive a] -> Sensitive a
mconcat :: [Sensitive a] -> Sensitive a
Monoid, 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
$c<> :: forall a. Semigroup a => Sensitive a -> Sensitive a -> Sensitive a
<> :: Sensitive a -> Sensitive a -> Sensitive a
$csconcat :: forall a. Semigroup a => NonEmpty (Sensitive a) -> Sensitive a
sconcat :: NonEmpty (Sensitive a) -> Sensitive a
$cstimes :: forall a b.
(Semigroup a, Integral b) =>
b -> Sensitive a -> Sensitive a
stimes :: forall b. Integral b => b -> Sensitive a -> Sensitive a
Semigroup, [Sensitive a] -> Value
[Sensitive a] -> Encoding
Sensitive a -> Value
Sensitive a -> Encoding
(Sensitive a -> Value)
-> (Sensitive a -> Encoding)
-> ([Sensitive a] -> Value)
-> ([Sensitive a] -> Encoding)
-> ToJSON (Sensitive a)
forall a. ToJSON a => [Sensitive a] -> Value
forall a. ToJSON a => [Sensitive a] -> Encoding
forall a. ToJSON a => Sensitive a -> Value
forall a. ToJSON a => Sensitive a -> Encoding
forall a.
(a -> Value)
-> (a -> Encoding)
-> ([a] -> Value)
-> ([a] -> Encoding)
-> ToJSON a
$ctoJSON :: forall a. ToJSON a => Sensitive a -> Value
toJSON :: Sensitive a -> Value
$ctoEncoding :: forall a. ToJSON a => Sensitive a -> Encoding
toEncoding :: Sensitive a -> Encoding
$ctoJSONList :: forall a. ToJSON a => [Sensitive a] -> Value
toJSONList :: [Sensitive a] -> Value
$ctoEncodingList :: forall a. ToJSON a => [Sensitive a] -> Encoding
toEncodingList :: [Sensitive a] -> Encoding
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
$cparseJSON :: forall a. FromJSON a => Value -> Parser (Sensitive a)
parseJSON :: Value -> Parser (Sensitive a)
$cparseJSONList :: forall a. FromJSON a => Value -> Parser [Sensitive a]
parseJSONList :: Value -> Parser [Sensitive a]
FromJSON)
  deriving ((forall a b. (a -> b) -> Sensitive a -> Sensitive b)
-> (forall a b. a -> Sensitive b -> Sensitive a)
-> Functor Sensitive
forall a b. a -> Sensitive b -> Sensitive a
forall a b. (a -> b) -> Sensitive a -> Sensitive b
forall (f :: * -> *).
(forall a b. (a -> b) -> f a -> f b)
-> (forall a b. a -> f b -> f a) -> Functor f
$cfmap :: forall a b. (a -> b) -> Sensitive a -> Sensitive b
fmap :: forall a b. (a -> b) -> Sensitive a -> Sensitive b
$c<$ :: forall a b. a -> Sensitive b -> Sensitive a
<$ :: forall a b. a -> Sensitive b -> Sensitive a
Functor, Functor Sensitive
Functor Sensitive
-> (forall a. a -> Sensitive a)
-> (forall a b. Sensitive (a -> b) -> Sensitive a -> Sensitive b)
-> (forall a b c.
    (a -> b -> c) -> Sensitive a -> Sensitive b -> Sensitive c)
-> (forall a b. Sensitive a -> Sensitive b -> Sensitive b)
-> (forall a b. Sensitive a -> Sensitive b -> Sensitive a)
-> Applicative Sensitive
forall a. a -> Sensitive a
forall a b. Sensitive a -> Sensitive b -> Sensitive a
forall a b. Sensitive a -> Sensitive b -> Sensitive b
forall a b. Sensitive (a -> b) -> Sensitive a -> Sensitive b
forall a b c.
(a -> b -> c) -> Sensitive a -> Sensitive b -> Sensitive c
forall (f :: * -> *).
Functor f
-> (forall a. a -> f a)
-> (forall a b. f (a -> b) -> f a -> f b)
-> (forall a b c. (a -> b -> c) -> f a -> f b -> f c)
-> (forall a b. f a -> f b -> f b)
-> (forall a b. f a -> f b -> f a)
-> Applicative f
$cpure :: forall a. a -> Sensitive a
pure :: forall a. a -> Sensitive a
$c<*> :: forall a b. Sensitive (a -> b) -> Sensitive a -> Sensitive b
<*> :: forall a b. Sensitive (a -> b) -> Sensitive a -> Sensitive b
$cliftA2 :: forall a b c.
(a -> b -> c) -> Sensitive a -> Sensitive b -> Sensitive c
liftA2 :: forall a b c.
(a -> b -> c) -> Sensitive a -> Sensitive b -> Sensitive c
$c*> :: forall a b. Sensitive a -> Sensitive b -> Sensitive b
*> :: forall a b. Sensitive a -> Sensitive b -> Sensitive b
$c<* :: forall a b. Sensitive a -> Sensitive b -> Sensitive a
<* :: forall a b. Sensitive a -> Sensitive b -> Sensitive a
Applicative, Applicative Sensitive
Applicative Sensitive
-> (forall a b. Sensitive a -> (a -> Sensitive b) -> Sensitive b)
-> (forall a b. Sensitive a -> Sensitive b -> Sensitive b)
-> (forall a. a -> Sensitive a)
-> Monad Sensitive
forall a. a -> Sensitive a
forall a b. Sensitive a -> Sensitive b -> Sensitive b
forall a b. Sensitive a -> (a -> Sensitive b) -> Sensitive b
forall (m :: * -> *).
Applicative m
-> (forall a b. m a -> (a -> m b) -> m b)
-> (forall a b. m a -> m b -> m b)
-> (forall a. a -> m a)
-> Monad m
$c>>= :: forall a b. Sensitive a -> (a -> Sensitive b) -> Sensitive b
>>= :: forall a b. Sensitive a -> (a -> Sensitive b) -> Sensitive b
$c>> :: forall a b. Sensitive a -> Sensitive b -> Sensitive b
>> :: forall a b. Sensitive a -> Sensitive b -> Sensitive b
$creturn :: forall a. a -> Sensitive a
return :: forall a. a -> Sensitive a
Monad) via Identity

-- | @const "<sensitive>"@
instance Show (Sensitive a) where
  show :: Sensitive a -> String
show Sensitive a
_ = String
"<sensitive>"

revealContainer :: (Functor f) => Sensitive (f a) -> f (Sensitive a)
revealContainer :: forall (f :: * -> *) a.
Functor f =>
Sensitive (f a) -> f (Sensitive a)
revealContainer (Sensitive f a
fa) = a -> Sensitive a
forall a. a -> Sensitive a
Sensitive (a -> Sensitive a) -> f a -> f (Sensitive a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> f a
fa