{-|

Instances for anonymizing sensitive data in various types.

Note that there is no clear way to anonymize numbers.

-}

module Hledger.Cli.Anon
    ( Anon(..)
    , anonAccount
    )
where

import Control.Arrow (first)
import Data.Hashable (hash)
import Data.Word (Word32)
import Numeric (showHex)
import qualified Data.Text as T

import Hledger.Data
import Data.Map (mapKeys)

class Anon a where
    -- | Consistent converter to structure with sensitive data anonymized
    anon :: a -> a

instance Anon Journal where
    -- Apply the anonymisation transformation on a journal after finalisation
    anon :: Journal -> Journal
anon Journal
j = Journal
j { jtxns :: [Transaction]
jtxns = forall a b. (a -> b) -> [a] -> [b]
map forall a. Anon a => a -> a
anon forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Transaction]
jtxns forall a b. (a -> b) -> a -> b
$ Journal
j
               , jparseparentaccounts :: [Text]
jparseparentaccounts  = forall a b. (a -> b) -> [a] -> [b]
map Text -> Text
anonAccount forall a b. (a -> b) -> a -> b
$ Journal -> [Text]
jparseparentaccounts Journal
j
               , jparsealiases :: [AccountAlias]
jparsealiases         = []  -- already applied
               , jdeclaredaccounts :: [(Text, AccountDeclarationInfo)]
jdeclaredaccounts     = forall a b. (a -> b) -> [a] -> [b]
map (forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first forall a. Anon a => a -> a
anon) forall a b. (a -> b) -> a -> b
$ Journal -> [(Text, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j
               , jdeclaredaccounttags :: Map Text [Tag]
jdeclaredaccounttags  = forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeys forall a. Anon a => a -> a
anon forall a b. (a -> b) -> a -> b
$ Journal -> Map Text [Tag]
jdeclaredaccounttags Journal
j
               , jdeclaredaccounttypes :: Map AccountType [Text]
jdeclaredaccounttypes = (forall a b. (a -> b) -> [a] -> [b]
map forall a. Anon a => a -> a
anon) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Journal -> Map AccountType [Text]
jdeclaredaccounttypes Journal
j
               }

instance Anon Posting where
    anon :: Posting -> Posting
anon Posting
p = Posting
p { paccount :: Text
paccount = Text -> Text
anonAccount forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Text
paccount forall a b. (a -> b) -> a -> b
$ Posting
p
               , pcomment :: Text
pcomment = Text
T.empty
               , ptransaction :: Maybe Transaction
ptransaction = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Anon a => a -> a
anon forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Maybe Transaction
ptransaction forall a b. (a -> b) -> a -> b
$ Posting
p  -- Note that this will be overridden
               , poriginal :: Maybe Posting
poriginal = forall a. Anon a => a -> a
anon forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Posting -> Maybe Posting
poriginal Posting
p
               }

instance Anon Transaction where
    anon :: Transaction -> Transaction
anon Transaction
txn = Transaction -> Transaction
txnTieKnot forall a b. (a -> b) -> a -> b
$ Transaction
txn { tpostings :: [Posting]
tpostings = forall a b. (a -> b) -> [a] -> [b]
map forall a. Anon a => a -> a
anon forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings forall a b. (a -> b) -> a -> b
$ Transaction
txn
                                , tdescription :: Text
tdescription = forall a. Anon a => a -> a
anon forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
tdescription forall a b. (a -> b) -> a -> b
$ Transaction
txn
                                , tcode :: Text
tcode = forall a. Anon a => a -> a
anon forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> Text
tcode forall a b. (a -> b) -> a -> b
$ Transaction
txn
                                , tcomment :: Text
tcomment = Text
T.empty
                                }

-- | Anonymize account name preserving hierarchy
anonAccount :: AccountName -> AccountName
anonAccount :: Text -> Text
anonAccount = Text -> [Text] -> Text
T.intercalate (String -> Text
T.pack String
":") forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b. (a -> b) -> [a] -> [b]
map forall a. Anon a => a -> a
anon forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Text -> [Text]
T.splitOn (String -> Text
T.pack String
":")

instance Anon T.Text where anon :: Text -> Text
anon = String -> Text
T.pack forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a b c. (a -> b -> c) -> b -> a -> c
flip forall a. (Integral a, Show a) => a -> ShowS
showHex String
"" forall b c a. (b -> c) -> (a -> b) -> a -> c
. (forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> Word32) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Hashable a => a -> Int
hash