{-|

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 = (Transaction -> Transaction) -> [Transaction] -> [Transaction]
forall a b. (a -> b) -> [a] -> [b]
map Transaction -> Transaction
forall a. Anon a => a -> a
anon ([Transaction] -> [Transaction])
-> (Journal -> [Transaction]) -> Journal -> [Transaction]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Journal -> [Transaction]
jtxns (Journal -> [Transaction]) -> Journal -> [Transaction]
forall a b. (a -> b) -> a -> b
$ Journal
j
               , jparseparentaccounts :: [AccountName]
jparseparentaccounts  = (AccountName -> AccountName) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map AccountName -> AccountName
anonAccount ([AccountName] -> [AccountName]) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> a -> b
$ Journal -> [AccountName]
jparseparentaccounts Journal
j
               , jparsealiases :: [AccountAlias]
jparsealiases         = []  -- already applied
               , jdeclaredaccounts :: [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts     = ((AccountName, AccountDeclarationInfo)
 -> (AccountName, AccountDeclarationInfo))
-> [(AccountName, AccountDeclarationInfo)]
-> [(AccountName, AccountDeclarationInfo)]
forall a b. (a -> b) -> [a] -> [b]
map ((AccountName -> AccountName)
-> (AccountName, AccountDeclarationInfo)
-> (AccountName, AccountDeclarationInfo)
forall (a :: * -> * -> *) b c d.
Arrow a =>
a b c -> a (b, d) (c, d)
first AccountName -> AccountName
forall a. Anon a => a -> a
anon) ([(AccountName, AccountDeclarationInfo)]
 -> [(AccountName, AccountDeclarationInfo)])
-> [(AccountName, AccountDeclarationInfo)]
-> [(AccountName, AccountDeclarationInfo)]
forall a b. (a -> b) -> a -> b
$ Journal -> [(AccountName, AccountDeclarationInfo)]
jdeclaredaccounts Journal
j
               , jdeclaredaccounttags :: Map AccountName [Tag]
jdeclaredaccounttags  = (AccountName -> AccountName)
-> Map AccountName [Tag] -> Map AccountName [Tag]
forall k2 k1 a. Ord k2 => (k1 -> k2) -> Map k1 a -> Map k2 a
mapKeys AccountName -> AccountName
forall a. Anon a => a -> a
anon (Map AccountName [Tag] -> Map AccountName [Tag])
-> Map AccountName [Tag] -> Map AccountName [Tag]
forall a b. (a -> b) -> a -> b
$ Journal -> Map AccountName [Tag]
jdeclaredaccounttags Journal
j
               , jdeclaredaccounttypes :: Map AccountType [AccountName]
jdeclaredaccounttypes = ((AccountName -> AccountName) -> [AccountName] -> [AccountName]
forall a b. (a -> b) -> [a] -> [b]
map AccountName -> AccountName
forall a. Anon a => a -> a
anon) ([AccountName] -> [AccountName])
-> Map AccountType [AccountName] -> Map AccountType [AccountName]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Journal -> Map AccountType [AccountName]
jdeclaredaccounttypes Journal
j
               }

instance Anon Posting where
    anon :: Posting -> Posting
anon Posting
p = Posting
p { paccount :: AccountName
paccount = AccountName -> AccountName
anonAccount (AccountName -> AccountName)
-> (Posting -> AccountName) -> Posting -> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> AccountName
paccount (Posting -> AccountName) -> Posting -> AccountName
forall a b. (a -> b) -> a -> b
$ Posting
p
               , pcomment :: AccountName
pcomment = AccountName
T.empty
               , ptransaction :: Maybe Transaction
ptransaction = (Transaction -> Transaction)
-> Maybe Transaction -> Maybe Transaction
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Transaction -> Transaction
forall a. Anon a => a -> a
anon (Maybe Transaction -> Maybe Transaction)
-> (Posting -> Maybe Transaction) -> Posting -> Maybe Transaction
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Posting -> Maybe Transaction
ptransaction (Posting -> Maybe Transaction) -> Posting -> Maybe Transaction
forall a b. (a -> b) -> a -> b
$ Posting
p  -- Note that this will be overridden
               , poriginal :: Maybe Posting
poriginal = Posting -> Posting
forall a. Anon a => a -> a
anon (Posting -> Posting) -> Maybe Posting -> Maybe Posting
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 (Transaction -> Transaction) -> Transaction -> Transaction
forall a b. (a -> b) -> a -> b
$ Transaction
txn { tpostings :: [Posting]
tpostings = (Posting -> Posting) -> [Posting] -> [Posting]
forall a b. (a -> b) -> [a] -> [b]
map Posting -> Posting
forall a. Anon a => a -> a
anon ([Posting] -> [Posting])
-> (Transaction -> [Posting]) -> Transaction -> [Posting]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> [Posting]
tpostings (Transaction -> [Posting]) -> Transaction -> [Posting]
forall a b. (a -> b) -> a -> b
$ Transaction
txn
                                , tdescription :: AccountName
tdescription = AccountName -> AccountName
forall a. Anon a => a -> a
anon (AccountName -> AccountName)
-> (Transaction -> AccountName) -> Transaction -> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> AccountName
tdescription (Transaction -> AccountName) -> Transaction -> AccountName
forall a b. (a -> b) -> a -> b
$ Transaction
txn
                                , tcode :: AccountName
tcode = AccountName -> AccountName
forall a. Anon a => a -> a
anon (AccountName -> AccountName)
-> (Transaction -> AccountName) -> Transaction -> AccountName
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Transaction -> AccountName
tcode (Transaction -> AccountName) -> Transaction -> AccountName
forall a b. (a -> b) -> a -> b
$ Transaction
txn
                                , tcomment :: AccountName
tcomment = AccountName
T.empty
                                }

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

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