{-|

Instances for obfuscating sensitive data (mainly text, not numbers) in various types.

Currently this is deterministic and does not provide much privacy.
It has been moved to a hidden --obfuscate flag, with the old --anon flag
now raising an error. See https://github.com/simonmichael/hledger/issues/2133 .

-}

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 = map anon . jtxns $ j
               , jparseparentaccounts  = map anonAccount $ jparseparentaccounts j
               , jparsealiases         = []  -- already applied
               , jdeclaredaccounts     = map (first anon) $ jdeclaredaccounts j
               , jdeclaredaccounttags  = mapKeys anon $ jdeclaredaccounttags j
               , jdeclaredaccounttypes = (map anon) <$> jdeclaredaccounttypes j
               }

instance Anon Posting where
    anon :: Posting -> Posting
anon Posting
p = Posting
p { paccount = anonAccount . paccount $ p
               , pcomment = T.empty
               , ptransaction = fmap anon . ptransaction $ p  -- Note that this will be overridden
               , poriginal = anon <$> poriginal 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 = map anon . tpostings $ txn
                                , tdescription = anon . tdescription $ txn
                                , tcode = anon . tcode $ txn
                                , tcomment = T.empty
                                }

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

instance Anon T.Text where anon :: Text -> Text
anon = String -> Text
T.pack (String -> Text) -> (Text -> String) -> Text -> Text
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 => a -> String -> String
showHex String
"" (Word32 -> String) -> (Text -> Word32) -> Text -> 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) -> (Text -> Int) -> Text -> Word32
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Text -> Int
forall a. Hashable a => a -> Int
hash