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

module Hercules.Agent.Sensitive where

import Data.Binary
import Protolude
import Text.Show

-- | 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
$cto :: forall a x. Rep (Sensitive a) x -> Sensitive a
$cfrom :: forall a x. Sensitive a -> Rep (Sensitive a) x
Generic)
  deriving newtype (Get (Sensitive a)
[Sensitive a] -> Put
Sensitive a -> Put
(Sensitive a -> Put)
-> Get (Sensitive a)
-> ([Sensitive a] -> Put)
-> Binary (Sensitive a)
forall a. Binary a => Get (Sensitive a)
forall a. Binary a => [Sensitive a] -> Put
forall a. Binary a => Sensitive a -> Put
forall t. (t -> Put) -> Get t -> ([t] -> Put) -> Binary t
putList :: [Sensitive a] -> Put
$cputList :: forall a. Binary a => [Sensitive a] -> Put
get :: Get (Sensitive a)
$cget :: forall a. Binary a => Get (Sensitive a)
put :: Sensitive a -> Put
$cput :: forall a. Binary a => Sensitive a -> Put
Binary, 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
Ord)
  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
<$ :: forall a b. a -> Sensitive b -> Sensitive a
$c<$ :: forall a b. a -> Sensitive b -> Sensitive a
fmap :: forall a b. (a -> b) -> Sensitive a -> Sensitive b
$cfmap :: forall a b. (a -> b) -> Sensitive a -> Sensitive b
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
<* :: forall a b. Sensitive a -> Sensitive b -> Sensitive a
$c<* :: forall a b. Sensitive a -> Sensitive b -> Sensitive a
*> :: forall a b. Sensitive a -> Sensitive b -> Sensitive b
$c*> :: forall a b. Sensitive a -> Sensitive b -> Sensitive b
liftA2 :: forall a b c.
(a -> b -> c) -> Sensitive a -> Sensitive b -> Sensitive c
$cliftA2 :: forall a b c.
(a -> b -> c) -> Sensitive a -> Sensitive b -> Sensitive c
<*> :: forall a b. Sensitive (a -> b) -> Sensitive a -> Sensitive b
$c<*> :: forall a b. Sensitive (a -> b) -> Sensitive a -> Sensitive b
pure :: forall a. a -> Sensitive a
$cpure :: forall a. a -> 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
return :: forall a. a -> Sensitive a
$creturn :: forall a. a -> Sensitive a
>> :: forall a b. Sensitive a -> Sensitive b -> Sensitive b
$c>> :: forall a b. Sensitive a -> Sensitive b -> Sensitive b
>>= :: forall a b. Sensitive a -> (a -> Sensitive b) -> Sensitive b
$c>>= :: forall a b. Sensitive a -> (a -> Sensitive b) -> Sensitive b
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