{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE TypeFamilies #-}

-- | Tools for reporting things in readable manner. Used in Rules to implement
--   STS 'renderAssertionViolation' methods, and in Tests.
module Cardano.Ledger.Shelley.Rules.Reports (
  showCred,
  showIR,
  showKeyHash,
  showListy,
  showMap,
  showWithdrawal,
  showSafeHash,
  synopsisCoinMap,
  showTxCerts,
  produceEqualsConsumed,
)
where

import Cardano.Ledger.CertState (
  CertState (..),
  InstantaneousRewards (..),
 )
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Shelley.AdaPots (consumedTxBody, producedTxBody)
import Cardano.Ledger.Shelley.TxBody (RewardAccount (..), Withdrawals (..))
import Cardano.Ledger.UTxO (UTxO (..))
import Data.Foldable (fold, toList)
import qualified Data.Map.Strict as Map
import Lens.Micro ((^.))

-- ===============================================
-- Reporting Certificates

showCred :: Credential x -> String
showCred :: forall (x :: KeyRole). Credential x -> String
showCred (ScriptHashObj (ScriptHash Hash ADDRHASH EraIndependentScript
x)) = forall a. Show a => a -> String
show Hash ADDRHASH EraIndependentScript
x
showCred (KeyHashObj (KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
x)) = forall a. Show a => a -> String
show Hash ADDRHASH (VerKeyDSIGN DSIGN)
x

showKeyHash :: KeyHash x -> String
showKeyHash :: forall (x :: KeyRole). KeyHash x -> String
showKeyHash (KeyHash Hash ADDRHASH (VerKeyDSIGN DSIGN)
hash) = forall a. Int -> [a] -> [a]
take Int
10 (forall a. Show a => a -> String
show Hash ADDRHASH (VerKeyDSIGN DSIGN)
hash)

showCerts :: Show (TxCert era) => [TxCert era] -> String
showCerts :: forall era. Show (TxCert era) => [TxCert era] -> String
showCerts [TxCert era]
certs = [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map ((String
"  " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Show a => a -> String
show) [TxCert era]
certs)

showTxCerts :: EraTxBody era => TxBody era -> String
showTxCerts :: forall era. EraTxBody era => TxBody era -> String
showTxCerts TxBody era
txb = forall era. Show (TxCert era) => [TxCert era] -> String
showCerts (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TxBody era
txb forall s a. s -> Getting a s a -> a
^. forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL))

-- | Display a synopsis of a map to Coin
synopsisCoinMap :: Maybe (Map.Map k Coin) -> String
synopsisCoinMap :: forall k. Maybe (Map k Coin) -> String
synopsisCoinMap (Just Map k Coin
m) = String
"Count = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall k a. Map k a -> Int
Map.size Map k Coin
m) forall a. [a] -> [a] -> [a]
++ String
",  total = " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold Map k Coin
m)
synopsisCoinMap Maybe (Map k Coin)
Nothing = String
"SYNOPSIS NOTHING"

-- ===============================================
-- Printing Produced == Consumed

produceEqualsConsumed ::
  EraTxBody era =>
  PParams era ->
  CertState era ->
  UTxO era ->
  TxBody era ->
  String
produceEqualsConsumed :: forall era.
EraTxBody era =>
PParams era -> CertState era -> UTxO era -> TxBody era -> String
produceEqualsConsumed PParams era
pp CertState era
dpstate UTxO era
utxo TxBody era
txb =
  let consumedValue :: Consumed
consumedValue = forall era.
EraTxBody era =>
TxBody era -> PParams era -> CertState era -> UTxO era -> Consumed
consumedTxBody TxBody era
txb PParams era
pp CertState era
dpstate UTxO era
utxo
      producedValue :: Produced
producedValue = forall era.
EraTxBody era =>
TxBody era -> PParams era -> CertState era -> Produced
producedTxBody TxBody era
txb PParams era
pp CertState era
dpstate
   in ( String
"\n (Produce = Consumed) Report\n  certificates\n"
          forall a. [a] -> [a] -> [a]
++ forall era. EraTxBody era => TxBody era -> String
showTxCerts TxBody era
txb
          forall a. [a] -> [a] -> [a]
++ String
"\n  withdrawals "
          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show (forall (t :: * -> *) m. (Foldable t, Monoid m) => t m -> m
fold forall b c a. (b -> c) -> (a -> b) -> a -> c
. Withdrawals -> Map RewardAccount Coin
unWithdrawals forall a b. (a -> b) -> a -> b
$ TxBody era
txb forall s a. s -> Getting a s a -> a
^. forall era. EraTxBody era => Lens' (TxBody era) Withdrawals
withdrawalsTxBodyL)
          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Produced
producedValue
          forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Consumed
consumedValue
      )

-- ========================

showMap :: (t1 -> [Char]) -> (t2 -> [Char]) -> Map.Map t1 t2 -> String
showMap :: forall t1 t2.
(t1 -> String) -> (t2 -> String) -> Map t1 t2 -> String
showMap t1 -> String
showKey t2 -> String
showVal Map t1 t2
m = [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map (t1, t2) -> String
showpair (forall k a. Map k a -> [(k, a)]
Map.toList Map t1 t2
m))
  where
    showpair :: (t1, t2) -> String
showpair (t1
key, t2
val) = t1 -> String
showKey t1
key forall a. [a] -> [a] -> [a]
++ String
" -> " forall a. [a] -> [a] -> [a]
++ t2 -> String
showVal t2
val

showListy :: Foldable t => (a -> String) -> t a -> String
showListy :: forall (t :: * -> *) a.
Foldable t =>
(a -> String) -> t a -> String
showListy a -> String
showElem t a
list = [String] -> String
unlines (forall a b. (a -> b) -> [a] -> [b]
map a -> String
showElem (forall (t :: * -> *) a. Foldable t => t a -> [a]
toList t a
list))

showRewardAcct :: RewardAccount -> [Char]
showRewardAcct :: RewardAccount -> String
showRewardAcct (RewardAccount {raNetwork :: RewardAccount -> Network
raNetwork = Network
network, raCredential :: RewardAccount -> Credential 'Staking
raCredential = Credential 'Staking
cred}) =
  forall a. Show a => a -> String
show Network
network forall a. [a] -> [a] -> [a]
++ String
" " forall a. [a] -> [a] -> [a]
++ forall (x :: KeyRole). Credential x -> String
showCred Credential 'Staking
cred

showWithdrawal :: Withdrawals -> String
showWithdrawal :: Withdrawals -> String
showWithdrawal (Withdrawals Map RewardAccount Coin
m) = forall t1 t2.
(t1 -> String) -> (t2 -> String) -> Map t1 t2 -> String
showMap ((String
"   " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. RewardAccount -> String
showRewardAcct) forall a. Show a => a -> String
show Map RewardAccount Coin
m

showIR :: InstantaneousRewards -> String
showIR :: InstantaneousRewards -> String
showIR (InstantaneousRewards Map (Credential 'Staking) Coin
m Map (Credential 'Staking) Coin
n DeltaCoin
x DeltaCoin
y) =
  [String] -> String
unlines
    [ String
"IRReseves " forall a. [a] -> [a] -> [a]
++ forall t1 t2.
(t1 -> String) -> (t2 -> String) -> Map t1 t2 -> String
showMap ((String
"   " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
10 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: KeyRole). Credential x -> String
showCred) forall a. Show a => a -> String
show Map (Credential 'Staking) Coin
m
    , String
"IRTreasury " forall a. [a] -> [a] -> [a]
++ forall t1 t2.
(t1 -> String) -> (t2 -> String) -> Map t1 t2 -> String
showMap ((String
"   " forall a. [a] -> [a] -> [a]
++) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Int -> [a] -> [a]
take Int
10 forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (x :: KeyRole). Credential x -> String
showCred) forall a. Show a => a -> String
show Map (Credential 'Staking) Coin
n
    , String
"DeltaReserves " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DeltaCoin
x
    , String
"DeltaTreasury " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show DeltaCoin
y
    ]

showSafeHash :: SafeHash i -> String
showSafeHash :: forall i. SafeHash i -> String
showSafeHash SafeHash i
x = forall a. Int -> [a] -> [a]
take Int
12 (forall a. Show a => a -> String
show (forall i. SafeHash i -> Hash HASH i
extractHash SafeHash i
x))