{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE RankNTypes #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

-- | Generate a Simple Tx with 1 inout, 1 output, and 1 DRep related Cert
module Test.Cardano.Ledger.Constrained.Trace.DrepCertTx where

import Cardano.Ledger.Coin (Coin (..), CompactForm)
import Cardano.Ledger.Conway.Governance (
  ConwayEraGov,
  GovActionId,
  GovActionState,
  PulsingSnapshot (..),
  computeDRepDistr,
  finishDRepPulser,
  newEpochStateDRepPulsingStateL,
  proposalsActionsMap,
  proposalsDeposits,
  proposalsGovStateL,
 )
import Cardano.Ledger.Conway.State hiding (drepDeposit)
import Cardano.Ledger.Conway.TxCert (ConwayGovCert (..), ConwayTxCert (..))
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.LedgerState (
  EpochState (..),
  LedgerState (..),
  NewEpochState (..),
  UTxOState (..),
  allObligations,
  esLStateL,
  esSnapshotsL,
  lsUTxOStateL,
  nesEsL,
  utxosGovStateL,
 )
import qualified Cardano.Ledger.UMap as UMap
import Data.Foldable (toList)
import qualified Data.Map.Strict as Map
import Data.Maybe.Strict (StrictMaybe (..))
import qualified Data.Set as Set
import qualified Debug.Trace as Debug
import Lens.Micro
import Test.Cardano.Ledger.Constrained.Ast (RootTarget (..), (^$))
import Test.Cardano.Ledger.Constrained.Classes (TxF (..), TxOutF (..))
import Test.Cardano.Ledger.Constrained.Combinators (itemFromSet)
import Test.Cardano.Ledger.Constrained.Preds.Tx (hashBody)
import Test.Cardano.Ledger.Constrained.Trace.Actions (
  certsAction,
  feesAction,
  inputsAction,
  outputsAction,
 )
import Test.Cardano.Ledger.Constrained.Trace.SimpleTx (
  completeTxBody,
  plutusFreeCredential,
  simpleTxBody,
 )
import Test.Cardano.Ledger.Constrained.Trace.TraceMonad (
  TraceM,
  epochProp,
  getTarget,
  getTerm,
  liftGen,
  mockChainProp,
  setVar,
  showPulserState,
  stepProp,
 )
import Test.Cardano.Ledger.Constrained.Vars
import Test.Cardano.Ledger.Generic.Fields (TxBodyField (..))
import Test.Cardano.Ledger.Generic.MockChain (MockBlock (..), MockChainState (..))
import Test.Cardano.Ledger.Generic.PrettyCore (pcNewEpochState, pcTxCert, ppList)
import Test.Cardano.Ledger.Generic.Proof (
  ConwayEra,
  Proof (..),
  Reflect (..),
  TxCertWit (..),
  whichTxCert,
 )
import Test.Cardano.Ledger.Generic.Updaters (newTxBody)
import Test.Tasty
import Test.Tasty.QuickCheck

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

-- | Fix the first Outputs field in a [TxBodyField], by applying the delta Coin to the first Output in that Outputs field
--   This is used to compensate for certificates which make deposits, and this Coin must come from somewhere, so it is
--   added (subtracted if the Coin is negative) from the first TxOut.
--   In rare occurrences, it is possible that 'delta' might be too negative to subtract from the input
--   in that case discard the trace. Note that in traces of length 150. this happens less than 1% of the time.
fixOutput :: EraTxOut era => Coin -> [TxBodyField era] -> TraceM era [TxBodyField era]
fixOutput :: forall era.
EraTxOut era =>
Coin -> [TxBodyField era] -> TraceM era [TxBodyField era]
fixOutput Coin
_ [] = [TxBodyField era] -> TraceM era [TxBodyField era]
forall a. a -> TraceM era a
forall (f :: * -> *) a. Applicative f => a -> f a
pure []
fixOutput delta :: Coin
delta@(Coin Integer
n) (Outputs' (TxOut era
txout : [TxOut era]
more) : [TxBodyField era]
others) =
  case TxOut era
txout TxOut era -> Getting Coin (TxOut era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxOut era) Coin
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL of
    Coin Integer
m ->
      if Integer
n Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
m Integer -> Integer -> Bool
forall a. Ord a => a -> a -> Bool
< Integer
0
        then TraceM era [TxBodyField era]
forall a. a
discard
        else [TxBodyField era] -> TraceM era [TxBodyField era]
forall a. a -> TraceM era a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (([TxOut era] -> TxBodyField era
forall era. [TxOut era] -> TxBodyField era
Outputs' ((TxOut era
txout TxOut era -> (TxOut era -> TxOut era) -> TxOut era
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era)
forall era. (HasCallStack, EraTxOut era) => Lens' (TxOut era) Coin
Lens' (TxOut era) Coin
coinTxOutL ((Coin -> Identity Coin) -> TxOut era -> Identity (TxOut era))
-> Coin -> TxOut era -> TxOut era
forall a s t. Monoid a => ASetter s t a a -> a -> s -> t
<>~ Coin
delta) TxOut era -> [TxOut era] -> [TxOut era]
forall a. a -> [a] -> [a]
: [TxOut era]
more)) TxBodyField era -> [TxBodyField era] -> [TxBodyField era]
forall a. a -> [a] -> [a]
: [TxBodyField era]
others)
fixOutput Coin
delta (TxBodyField era
x : [TxBodyField era]
xs) = (TxBodyField era
x TxBodyField era -> [TxBodyField era] -> [TxBodyField era]
forall a. a -> [a] -> [a]
:) ([TxBodyField era] -> [TxBodyField era])
-> TraceM era [TxBodyField era] -> TraceM era [TxBodyField era]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Coin -> [TxBodyField era] -> TraceM era [TxBodyField era]
forall era.
EraTxOut era =>
Coin -> [TxBodyField era] -> TraceM era [TxBodyField era]
fixOutput Coin
delta [TxBodyField era]
xs

-- | Compute a valid Cert, and the change in the stored Deposits from that Cert.
drepCert :: forall era. Reflect era => Proof era -> TraceM era (Coin, [TxBodyField era])
drepCert :: forall era.
Reflect era =>
Proof era -> TraceM era (Coin, [TxBodyField era])
drepCert Proof era
proof = case Proof era -> TxCertWit era
forall era. Proof era -> TxCertWit era
whichTxCert Proof era
proof of
  TxCertWit era
TxCertShelleyToBabbage -> (Coin, [TxBodyField era]) -> TraceM era (Coin, [TxBodyField era])
forall a. a -> TraceM era a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Coin
forall a. Monoid a => a
mempty, [])
  TxCertWit era
TxCertConwayToConway -> do
    Map ScriptHash (IsValid, ScriptF era)
plutusmap <- Term era (Map ScriptHash (IsValid, ScriptF era))
-> TraceM era (Map ScriptHash (IsValid, ScriptF era))
forall era a. Term era a -> TraceM era a
getTerm Term era (Map ScriptHash (IsValid, ScriptF era))
forall era.
Reflect era =>
Term era (Map ScriptHash (IsValid, ScriptF era))
plutusUniv
    Set (Credential 'DRepRole)
drepCreds <- (Credential 'DRepRole -> Bool)
-> Set (Credential 'DRepRole) -> Set (Credential 'DRepRole)
forall a. (a -> Bool) -> Set a -> Set a
Set.filter (Map ScriptHash (IsValid, ScriptF era)
-> Credential 'DRepRole -> Bool
forall a (kr :: KeyRole). Map ScriptHash a -> Credential kr -> Bool
plutusFreeCredential Map ScriptHash (IsValid, ScriptF era)
plutusmap) (Set (Credential 'DRepRole) -> Set (Credential 'DRepRole))
-> TraceM era (Set (Credential 'DRepRole))
-> TraceM era (Set (Credential 'DRepRole))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Term era (Set (Credential 'DRepRole))
-> TraceM era (Set (Credential 'DRepRole))
forall era a. Term era a -> TraceM era a
getTerm Term era (Set (Credential 'DRepRole))
forall era. Era era => Term era (Set (Credential 'DRepRole))
voteUniv
    (Credential 'DRepRole
cred, Set (Credential 'DRepRole)
_) <- Gen (Credential 'DRepRole, Set (Credential 'DRepRole))
-> TraceM era (Credential 'DRepRole, Set (Credential 'DRepRole))
forall a era. Gen a -> TraceM era a
liftGen ([String]
-> Set (Credential 'DRepRole)
-> Gen (Credential 'DRepRole, Set (Credential 'DRepRole))
forall a. [String] -> Set a -> Gen (a, Set a)
itemFromSet [] Set (Credential 'DRepRole)
drepCreds)
    -- TODO: Refactor
    Maybe DRepState
mdrepstate <- case forall era. Reflect era => Proof era
reify @era of
      Proof era
Conway -> RootTarget era Void (Maybe DRepState)
-> TraceM era (Maybe DRepState)
forall era r a. RootTarget era r a -> TraceM era a
getTarget (String
-> (Map (Credential 'DRepRole) DRepState -> Maybe DRepState)
-> RootTarget
     era Void (Map (Credential 'DRepRole) DRepState -> Maybe DRepState)
forall a b era. String -> (a -> b) -> RootTarget era Void (a -> b)
Constr String
"mapMember" (Credential 'DRepRole
-> Map (Credential 'DRepRole) DRepState -> Maybe DRepState
forall k a. Ord k => k -> Map k a -> Maybe a
Map.lookup Credential 'DRepRole
cred) RootTarget
  era Void (Map (Credential 'DRepRole) DRepState -> Maybe DRepState)
-> Term era (Map (Credential 'DRepRole) DRepState)
-> RootTarget era Void (Maybe DRepState)
forall era a t. Target era (a -> t) -> Term era a -> Target era t
^$ Term era (Map (Credential 'DRepRole) DRepState)
forall era.
ConwayEraCertState era =>
Term era (Map (Credential 'DRepRole) DRepState)
currentDRepState)
    deposit :: Coin
deposit@(Coin Integer
m) <- Term era Coin -> TraceM era Coin
forall era a. Term era a -> TraceM era a
getTerm (Proof era -> Term era Coin
forall era. ConwayEraPParams era => Proof era -> Term era Coin
drepDeposit Proof era
proof)
    case Maybe DRepState
mdrepstate of
      Maybe DRepState
Nothing -> (Coin, [TxBodyField era]) -> TraceM era (Coin, [TxBodyField era])
forall a. a -> TraceM era a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Coin
Coin (-Integer
m), [[TxCert era] -> TxBodyField era
forall era. [TxCert era] -> TxBodyField era
Certs' [ConwayGovCert -> ConwayTxCert era
forall era. ConwayGovCert -> ConwayTxCert era
ConwayTxCertGov (ConwayGovCert -> ConwayTxCert era)
-> ConwayGovCert -> ConwayTxCert era
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole -> Coin -> StrictMaybe Anchor -> ConwayGovCert
ConwayRegDRep Credential 'DRepRole
cred Coin
deposit StrictMaybe Anchor
forall a. StrictMaybe a
SNothing]])
      Just (DRepState EpochNo
_expiry StrictMaybe Anchor
_manchor Coin
_dep Set (Credential 'Staking)
_delegs) ->
        Gen (Coin, [TxBodyField era])
-> TraceM era (Coin, [TxBodyField era])
forall a era. Gen a -> TraceM era a
liftGen (Gen (Coin, [TxBodyField era])
 -> TraceM era (Coin, [TxBodyField era]))
-> Gen (Coin, [TxBodyField era])
-> TraceM era (Coin, [TxBodyField era])
forall a b. (a -> b) -> a -> b
$
          [Gen (Coin, [TxBodyField era])] -> Gen (Coin, [TxBodyField era])
forall a. HasCallStack => [Gen a] -> Gen a
oneof
            [ (Coin, [TxBodyField era]) -> Gen (Coin, [TxBodyField era])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Coin
deposit, [[TxCert era] -> TxBodyField era
forall era. [TxCert era] -> TxBodyField era
Certs' [ConwayGovCert -> ConwayTxCert era
forall era. ConwayGovCert -> ConwayTxCert era
ConwayTxCertGov (ConwayGovCert -> ConwayTxCert era)
-> ConwayGovCert -> ConwayTxCert era
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole -> Coin -> ConwayGovCert
ConwayUnRegDRep Credential 'DRepRole
cred Coin
deposit]])
            , do
                StrictMaybe Anchor
mAnchor <- Gen (StrictMaybe Anchor)
forall a. Arbitrary a => Gen a
arbitrary
                (Coin, [TxBodyField era]) -> Gen (Coin, [TxBodyField era])
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Integer -> Coin
Coin Integer
0, [[TxCert era] -> TxBodyField era
forall era. [TxCert era] -> TxBodyField era
Certs' [ConwayGovCert -> ConwayTxCert era
forall era. ConwayGovCert -> ConwayTxCert era
ConwayTxCertGov (ConwayGovCert -> ConwayTxCert era)
-> ConwayGovCert -> ConwayTxCert era
forall a b. (a -> b) -> a -> b
$ Credential 'DRepRole -> StrictMaybe Anchor -> ConwayGovCert
ConwayUpdateDRep Credential 'DRepRole
cred StrictMaybe Anchor
mAnchor]])
            ]

drepCertTx :: Reflect era => Coin -> Proof era -> TraceM era (TxF era)
drepCertTx :: forall era.
Reflect era =>
Coin -> Proof era -> TraceM era (TxF era)
drepCertTx Coin
maxFeeEstimate Proof era
proof = do
  [TxBodyField era]
simplefields <- Proof era -> Coin -> TraceM era [TxBodyField era]
forall era.
Reflect era =>
Proof era -> Coin -> TraceM era [TxBodyField era]
simpleTxBody Proof era
proof Coin
maxFeeEstimate
  (Coin
deltadeposit, [TxBodyField era]
certfields) <- Proof era -> TraceM era (Coin, [TxBodyField era])
forall era.
Reflect era =>
Proof era -> TraceM era (Coin, [TxBodyField era])
drepCert Proof era
proof
  TxBody era
txb <- do
    [TxBodyField era]
fields2 <- Coin -> [TxBodyField era] -> TraceM era [TxBodyField era]
forall era.
EraTxOut era =>
Coin -> [TxBodyField era] -> TraceM era [TxBodyField era]
fixOutput Coin
deltadeposit [TxBodyField era]
simplefields
    TxBody era -> TraceM era (TxBody era)
forall a. a -> TraceM era a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proof era -> [TxBodyField era] -> TxBody era
forall era.
EraTxBody era =>
Proof era -> [TxBodyField era] -> TxBody era
newTxBody Proof era
proof ([TxBodyField era]
fields2 [TxBodyField era] -> [TxBodyField era] -> [TxBodyField era]
forall a. [a] -> [a] -> [a]
++ [TxBodyField era]
certfields))
  Tx era
tx <- Proof era -> Coin -> TxBody era -> TraceM era (Tx era)
forall era.
Reflect era =>
Proof era -> Coin -> TxBody era -> TraceM era (Tx era)
completeTxBody Proof era
proof Coin
maxFeeEstimate TxBody era
txb
  Term era (TxF era) -> TxF era -> TraceM era ()
forall era t. Term era t -> t -> TraceM era ()
setVar Term era (TxF era)
forall era. Reflect era => Term era (TxF era)
txterm (Proof era -> Tx era -> TxF era
forall era. Proof era -> Tx era -> TxF era
TxF Proof era
proof Tx era
tx)
  TxF era -> TraceM era (TxF era)
forall a. a -> TraceM era a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Proof era -> Tx era -> TxF era
forall era. Proof era -> Tx era -> TxF era
TxF Proof era
proof Tx era
tx)

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

--   appropriate for a SimpleTx with DRepCerts.
--   Changes to the Env are done by side effects in the TraceM mondad.
applyDRepCertActions :: Reflect era => Proof era -> Tx era -> TraceM era ()
applyDRepCertActions :: forall era. Reflect era => Proof era -> Tx era -> TraceM era ()
applyDRepCertActions Proof era
proof Tx era
tx = do
  let txb :: TxBody era
txb = Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL
      feeCoin :: Coin
feeCoin = TxBody era
txb TxBody era -> Getting Coin (TxBody era) Coin -> Coin
forall s a. s -> Getting a s a -> a
^. Getting Coin (TxBody era) Coin
forall era. EraTxBody era => Lens' (TxBody era) Coin
Lens' (TxBody era) Coin
feeTxBodyL
      txbcerts :: StrictSeq (TxCert era)
txbcerts = TxBody era
txb TxBody era
-> Getting
     (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxCert era)) (TxBody era) (StrictSeq (TxCert era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL
  Proof era -> Set TxIn -> TraceM era ()
forall era. Era era => Proof era -> Set TxIn -> TraceM era ()
inputsAction Proof era
proof (TxBody era
txb TxBody era
-> Getting (Set TxIn) (TxBody era) (Set TxIn) -> Set TxIn
forall s a. s -> Getting a s a -> a
^. Getting (Set TxIn) (TxBody era) (Set TxIn)
forall era. EraTxBody era => Lens' (TxBody era) (Set TxIn)
Lens' (TxBody era) (Set TxIn)
inputsTxBodyL)
  Proof era -> TxBody era -> [TxOutF era] -> TraceM era ()
forall era.
Reflect era =>
Proof era -> TxBody era -> [TxOutF era] -> TraceM era ()
outputsAction Proof era
proof TxBody era
txb ((TxOut era -> TxOutF era) -> [TxOut era] -> [TxOutF era]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap (Proof era -> TxOut era -> TxOutF era
forall era. Proof era -> TxOut era -> TxOutF era
TxOutF Proof era
proof) (StrictSeq (TxOut era) -> [TxOut era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (TxBody era
txb TxBody era
-> Getting
     (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
-> StrictSeq (TxOut era)
forall s a. s -> Getting a s a -> a
^. Getting
  (StrictSeq (TxOut era)) (TxBody era) (StrictSeq (TxOut era))
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxOut era))
Lens' (TxBody era) (StrictSeq (TxOut era))
outputsTxBodyL)))
  Coin -> TraceM era ()
forall era. Era era => Coin -> TraceM era ()
feesAction Coin
feeCoin
  Proof era -> StrictSeq (TxCert era) -> TraceM era ()
forall (t :: * -> *) era.
(Foldable t, Era era) =>
Proof era -> t (TxCert era) -> TraceM era ()
certsAction Proof era
proof StrictSeq (TxCert era)
txbcerts

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

-- | Generate a Tx that can be made into a Trace, because it applies the
--   necessary Actions to update the Env. The Env must contain the Vars that
--   are updated by 'applyDRepCertActions' . It is best to intialize the whole
--   LedgerState to do this.
drepCertTxForTrace :: Reflect era => Coin -> Proof era -> TraceM era (Tx era)
drepCertTxForTrace :: forall era. Reflect era => Coin -> Proof era -> TraceM era (Tx era)
drepCertTxForTrace Coin
maxFeeEstimate Proof era
proof = do
  TxF Proof era
_ Tx era
tx <- Coin -> Proof era -> TraceM era (TxF era)
forall era.
Reflect era =>
Coin -> Proof era -> TraceM era (TxF era)
drepCertTx Coin
maxFeeEstimate Proof era
proof
  Proof era -> Tx era -> TraceM era ()
forall era. Reflect era => Proof era -> Tx era -> TraceM era ()
applyDRepCertActions Proof era
proof Tx era
tx
  Tx era -> TraceM era (Tx era)
forall a. a -> TraceM era a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Tx era
tx

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

drepTree :: TestTree
drepTree :: TestTree
drepTree =
  String -> [TestTree] -> TestTree
testGroup
    String
"DRep property Debug.traces"
    [ String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty
        String
"All Tx are valid on traces of length 150."
        (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
20
        (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Proof ConwayEra
-> Int
-> (Proof ConwayEra -> TraceM ConwayEra (Tx ConwayEra))
-> (Trace (MOCKCHAIN ConwayEra) -> Property)
-> Property
forall era.
(Reflect era, STS (MOCKCHAIN era)) =>
Proof era
-> Int
-> (Proof era -> TraceM era (Tx era))
-> (Trace (MOCKCHAIN era) -> Property)
-> Property
mockChainProp Proof ConwayEra
Conway Int
150 (forall era. Reflect era => Coin -> Proof era -> TraceM era (Tx era)
drepCertTxForTrace @ConwayEra (Integer -> Coin
Coin Integer
100000))
        ((Trace (MOCKCHAIN ConwayEra) -> Property) -> Property)
-> (Trace (MOCKCHAIN ConwayEra) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ (MockChainState ConwayEra
 -> MockBlock ConwayEra -> MockChainState ConwayEra -> Property)
-> Trace (MOCKCHAIN ConwayEra) -> Property
forall era.
(MockChainState era
 -> MockBlock era -> MockChainState era -> Property)
-> Trace (MOCKCHAIN era) -> Property
stepProp (Proof ConwayEra
-> MockChainState ConwayEra
-> MockBlock ConwayEra
-> MockChainState ConwayEra
-> Property
forall era.
Reflect era =>
Proof era
-> MockChainState era
-> MockBlock era
-> MockChainState era
-> Property
allValidSignals Proof ConwayEra
Conway)
    , String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty
        String
"Bruteforce = Pulsed, in every epoch, on traces of length 150"
        (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$ Int -> Property -> Property
forall prop. Testable prop => Int -> prop -> Property
withMaxSuccess Int
5
        (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ Proof ConwayEra
-> Int
-> (Proof ConwayEra -> TraceM ConwayEra (Tx ConwayEra))
-> (Trace (MOCKCHAIN ConwayEra) -> Property)
-> Property
forall era.
(Reflect era, STS (MOCKCHAIN era)) =>
Proof era
-> Int
-> (Proof era -> TraceM era (Tx era))
-> (Trace (MOCKCHAIN era) -> Property)
-> Property
mockChainProp Proof ConwayEra
Conway Int
150 (Coin -> Proof ConwayEra -> TraceM ConwayEra (Tx ConwayEra)
forall era. Reflect era => Coin -> Proof era -> TraceM era (Tx era)
drepCertTxForTrace (Integer -> Coin
Coin Integer
60000))
        ((Trace (MOCKCHAIN ConwayEra) -> Property) -> Property)
-> (Trace (MOCKCHAIN ConwayEra) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ (MockChainState ConwayEra -> MockChainState ConwayEra -> Property)
-> Trace (MOCKCHAIN ConwayEra) -> Property
forall era.
ConwayEraGov era =>
(MockChainState era -> MockChainState era -> Property)
-> Trace (MOCKCHAIN era) -> Property
epochProp MockChainState ConwayEra -> MockChainState ConwayEra -> Property
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
MockChainState era -> MockChainState era -> Property
pulserWorks
    ]

main :: IO ()
main :: IO ()
main = TestTree -> IO ()
defaultMain TestTree
drepTree

-- =================================================
-- Example functions that can be lifted to
-- Trace (MOCKCHAIN era) -> Property
-- using 'stepProp', 'deltaProp', 'preserveProp', and 'epochProp'
-- this lifted value is then passed to 'mockChainProp' to make a Property

getpp :: EraGov era => NewEpochState era -> PParams era
getpp :: forall era. EraGov era => NewEpochState era -> PParams era
getpp NewEpochState era
nes = NewEpochState era
nes NewEpochState era
-> Getting (PParams era) (NewEpochState era) (PParams era)
-> PParams era
forall s a. s -> Getting a s a -> a
^. ((EpochState era -> Const (PParams era) (EpochState era))
-> NewEpochState era -> Const (PParams era) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const (PParams era) (EpochState era))
 -> NewEpochState era -> Const (PParams era) (NewEpochState era))
-> ((PParams era -> Const (PParams era) (PParams era))
    -> EpochState era -> Const (PParams era) (EpochState era))
-> Getting (PParams era) (NewEpochState era) (PParams era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const (PParams era) (LedgerState era))
-> EpochState era -> Const (PParams era) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const (PParams era) (LedgerState era))
 -> EpochState era -> Const (PParams era) (EpochState era))
-> ((PParams era -> Const (PParams era) (PParams era))
    -> LedgerState era -> Const (PParams era) (LedgerState era))
-> (PParams era -> Const (PParams era) (PParams era))
-> EpochState era
-> Const (PParams era) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOState era -> Const (PParams era) (UTxOState era))
-> LedgerState era -> Const (PParams era) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL ((UTxOState era -> Const (PParams era) (UTxOState era))
 -> LedgerState era -> Const (PParams era) (LedgerState era))
-> ((PParams era -> Const (PParams era) (PParams era))
    -> UTxOState era -> Const (PParams era) (UTxOState era))
-> (PParams era -> Const (PParams era) (PParams era))
-> LedgerState era
-> Const (PParams era) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> Const (PParams era) (GovState era))
-> UTxOState era -> Const (PParams era) (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL ((GovState era -> Const (PParams era) (GovState era))
 -> UTxOState era -> Const (PParams era) (UTxOState era))
-> ((PParams era -> Const (PParams era) (PParams era))
    -> GovState era -> Const (PParams era) (GovState era))
-> (PParams era -> Const (PParams era) (PParams era))
-> UTxOState era
-> Const (PParams era) (UTxOState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PParams era -> Const (PParams era) (PParams era))
-> GovState era -> Const (PParams era) (GovState era)
forall era. EraGov era => Lens' (GovState era) (PParams era)
Lens' (GovState era) (PParams era)
curPParamsGovStateL)

getProposals ::
  ConwayEraGov era => NewEpochState era -> Map.Map GovActionId (GovActionState era)
getProposals :: forall era.
ConwayEraGov era =>
NewEpochState era -> Map GovActionId (GovActionState era)
getProposals NewEpochState era
nes =
  Proposals era -> Map GovActionId (GovActionState era)
forall era. Proposals era -> Map GovActionId (GovActionState era)
proposalsActionsMap
    (NewEpochState era
nes NewEpochState era
-> Getting (Proposals era) (NewEpochState era) (Proposals era)
-> Proposals era
forall s a. s -> Getting a s a -> a
^. ((EpochState era -> Const (Proposals era) (EpochState era))
-> NewEpochState era -> Const (Proposals era) (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const (Proposals era) (EpochState era))
 -> NewEpochState era -> Const (Proposals era) (NewEpochState era))
-> ((Proposals era -> Const (Proposals era) (Proposals era))
    -> EpochState era -> Const (Proposals era) (EpochState era))
-> Getting (Proposals era) (NewEpochState era) (Proposals era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (LedgerState era -> Const (Proposals era) (LedgerState era))
-> EpochState era -> Const (Proposals era) (EpochState era)
forall era (f :: * -> *).
Functor f =>
(LedgerState era -> f (LedgerState era))
-> EpochState era -> f (EpochState era)
esLStateL ((LedgerState era -> Const (Proposals era) (LedgerState era))
 -> EpochState era -> Const (Proposals era) (EpochState era))
-> ((Proposals era -> Const (Proposals era) (Proposals era))
    -> LedgerState era -> Const (Proposals era) (LedgerState era))
-> (Proposals era -> Const (Proposals era) (Proposals era))
-> EpochState era
-> Const (Proposals era) (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UTxOState era -> Const (Proposals era) (UTxOState era))
-> LedgerState era -> Const (Proposals era) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL ((UTxOState era -> Const (Proposals era) (UTxOState era))
 -> LedgerState era -> Const (Proposals era) (LedgerState era))
-> ((Proposals era -> Const (Proposals era) (Proposals era))
    -> UTxOState era -> Const (Proposals era) (UTxOState era))
-> (Proposals era -> Const (Proposals era) (Proposals era))
-> LedgerState era
-> Const (Proposals era) (LedgerState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> Const (Proposals era) (GovState era))
-> UTxOState era -> Const (Proposals era) (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL ((GovState era -> Const (Proposals era) (GovState era))
 -> UTxOState era -> Const (Proposals era) (UTxOState era))
-> ((Proposals era -> Const (Proposals era) (Proposals era))
    -> GovState era -> Const (Proposals era) (GovState era))
-> (Proposals era -> Const (Proposals era) (Proposals era))
-> UTxOState era
-> Const (Proposals era) (UTxOState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proposals era -> Const (Proposals era) (Proposals era))
-> GovState era -> Const (Proposals era) (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Proposals era)
Lens' (GovState era) (Proposals era)
proposalsGovStateL))

allValidSignals ::
  Reflect era => Proof era -> MockChainState era -> MockBlock era -> MockChainState era -> Property
allValidSignals :: forall era.
Reflect era =>
Proof era
-> MockChainState era
-> MockBlock era
-> MockChainState era
-> Property
allValidSignals Proof era
p (MockChainState NewEpochState era
nes NewEpochState era
_ SlotNo
slot Int
count) (MockBlock KeyHash 'StakePool
_ SlotNo
_ StrictSeq (Tx era)
_txs) MockChainState era
_stateN =
  String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
    (String
"\nCount " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
count String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
" Slot " String -> String -> String
forall a. [a] -> [a] -> [a]
++ SlotNo -> String
forall a. Show a => a -> String
show SlotNo
slot String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\n" String -> String -> String
forall a. [a] -> [a] -> [a]
++ PDoc -> String
forall a. Show a => a -> String
show (Proof era -> NewEpochState era -> PDoc
forall era. Reflect era => Proof era -> NewEpochState era -> PDoc
pcNewEpochState Proof era
p NewEpochState era
nes))
    (Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
True)

pulserWorks ::
  (ConwayEraGov era, ConwayEraCertState era) => MockChainState era -> MockChainState era -> Property
pulserWorks :: forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
MockChainState era -> MockChainState era -> Property
pulserWorks MockChainState era
mcsfirst MockChainState era
mcslast =
  String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample
    ( String
"\nFirst "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ MockChainState era -> String
forall era. ConwayEraGov era => MockChainState era -> String
showPulserState MockChainState era
mcsfirst
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nLast "
        String -> String -> String
forall a. [a] -> [a] -> [a]
++ MockChainState era -> String
forall era. ConwayEraGov era => MockChainState era -> String
showPulserState MockChainState era
mcslast
    )
    (NewEpochState era -> Map DRep (CompactForm Coin)
forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
NewEpochState era -> Map DRep (CompactForm Coin)
bruteForceDRepDistr (MockChainState era -> NewEpochState era
forall era. MockChainState era -> NewEpochState era
mcsTickNes MockChainState era
mcsfirst) Map DRep (CompactForm Coin)
-> Map DRep (CompactForm Coin) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== NewEpochState era -> Map DRep (CompactForm Coin)
forall era.
ConwayEraGov era =>
NewEpochState era -> Map DRep (CompactForm Coin)
extractPulsingDRepDistr (MockChainState era -> NewEpochState era
forall era. MockChainState era -> NewEpochState era
mcsNes MockChainState era
mcslast))

bruteForceDRepDistr ::
  forall era.
  (ConwayEraGov era, ConwayEraCertState era) =>
  NewEpochState era ->
  Map.Map DRep (CompactForm Coin)
bruteForceDRepDistr :: forall era.
(ConwayEraGov era, ConwayEraCertState era) =>
NewEpochState era -> Map DRep (CompactForm Coin)
bruteForceDRepDistr NewEpochState era
nes =
  (Map DRep (CompactForm Coin), PoolDistr)
-> Map DRep (CompactForm Coin)
forall a b. (a, b) -> a
fst ((Map DRep (CompactForm Coin), PoolDistr)
 -> Map DRep (CompactForm Coin))
-> (Map DRep (CompactForm Coin), PoolDistr)
-> Map DRep (CompactForm Coin)
forall a b. (a -> b) -> a -> b
$ InstantStake era
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'Staking) (CompactForm Coin)
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'Staking) UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
forall era.
EraStake era =>
InstantStake era
-> Map (Credential 'DRepRole) DRepState
-> Map (Credential 'Staking) (CompactForm Coin)
-> PoolDistr
-> Map DRep (CompactForm Coin)
-> Map (Credential 'Staking) UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
computeDRepDistr InstantStake era
instantStake Map (Credential 'DRepRole) DRepState
dreps Map (Credential 'Staking) (CompactForm Coin)
propDeps PoolDistr
poolD Map DRep (CompactForm Coin)
forall k a. Map k a
Map.empty (Map (Credential 'Staking) UMElem
 -> (Map DRep (CompactForm Coin), PoolDistr))
-> Map (Credential 'Staking) UMElem
-> (Map DRep (CompactForm Coin), PoolDistr)
forall a b. (a -> b) -> a -> b
$ UMap -> Map (Credential 'Staking) UMElem
UMap.umElems UMap
umap
  where
    ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState (NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes)
    propDeps :: Map (Credential 'Staking) (CompactForm Coin)
propDeps = Proposals era -> Map (Credential 'Staking) (CompactForm Coin)
forall era.
Proposals era -> Map (Credential 'Staking) (CompactForm Coin)
proposalsDeposits (Proposals era -> Map (Credential 'Staking) (CompactForm Coin))
-> Proposals era -> Map (Credential 'Staking) (CompactForm Coin)
forall a b. (a -> b) -> a -> b
$ LedgerState era
ls LedgerState era
-> Getting (Proposals era) (LedgerState era) (Proposals era)
-> Proposals era
forall s a. s -> Getting a s a -> a
^. (UTxOState era -> Const (Proposals era) (UTxOState era))
-> LedgerState era -> Const (Proposals era) (LedgerState era)
forall era (f :: * -> *).
Functor f =>
(UTxOState era -> f (UTxOState era))
-> LedgerState era -> f (LedgerState era)
lsUTxOStateL ((UTxOState era -> Const (Proposals era) (UTxOState era))
 -> LedgerState era -> Const (Proposals era) (LedgerState era))
-> ((Proposals era -> Const (Proposals era) (Proposals era))
    -> UTxOState era -> Const (Proposals era) (UTxOState era))
-> Getting (Proposals era) (LedgerState era) (Proposals era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (GovState era -> Const (Proposals era) (GovState era))
-> UTxOState era -> Const (Proposals era) (UTxOState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL ((GovState era -> Const (Proposals era) (GovState era))
 -> UTxOState era -> Const (Proposals era) (UTxOState era))
-> ((Proposals era -> Const (Proposals era) (Proposals era))
    -> GovState era -> Const (Proposals era) (GovState era))
-> (Proposals era -> Const (Proposals era) (Proposals era))
-> UTxOState era
-> Const (Proposals era) (UTxOState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Proposals era -> Const (Proposals era) (Proposals era))
-> GovState era -> Const (Proposals era) (GovState era)
forall era.
ConwayEraGov era =>
Lens' (GovState era) (Proposals era)
Lens' (GovState era) (Proposals era)
proposalsGovStateL
    poolD :: PoolDistr
poolD = NewEpochState era
nes NewEpochState era
-> Getting PoolDistr (NewEpochState era) PoolDistr -> PoolDistr
forall s a. s -> Getting a s a -> a
^. (EpochState era -> Const PoolDistr (EpochState era))
-> NewEpochState era -> Const PoolDistr (NewEpochState era)
forall era (f :: * -> *).
Functor f =>
(EpochState era -> f (EpochState era))
-> NewEpochState era -> f (NewEpochState era)
nesEsL ((EpochState era -> Const PoolDistr (EpochState era))
 -> NewEpochState era -> Const PoolDistr (NewEpochState era))
-> ((PoolDistr -> Const PoolDistr PoolDistr)
    -> EpochState era -> Const PoolDistr (EpochState era))
-> Getting PoolDistr (NewEpochState era) PoolDistr
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (SnapShots -> Const PoolDistr SnapShots)
-> EpochState era -> Const PoolDistr (EpochState era)
forall era (f :: * -> *).
Functor f =>
(SnapShots -> f SnapShots) -> EpochState era -> f (EpochState era)
esSnapshotsL ((SnapShots -> Const PoolDistr SnapShots)
 -> EpochState era -> Const PoolDistr (EpochState era))
-> ((PoolDistr -> Const PoolDistr PoolDistr)
    -> SnapShots -> Const PoolDistr SnapShots)
-> (PoolDistr -> Const PoolDistr PoolDistr)
-> EpochState era
-> Const PoolDistr (EpochState era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PoolDistr -> Const PoolDistr PoolDistr)
-> SnapShots -> Const PoolDistr SnapShots
Lens' SnapShots PoolDistr
ssStakeMarkPoolDistrL
    cs :: CertState era
cs = LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls
    instantStake :: InstantStake era
instantStake = LedgerState era
ls LedgerState era
-> Getting (InstantStake era) (LedgerState era) (InstantStake era)
-> InstantStake era
forall s a. s -> Getting a s a -> a
^. Getting (InstantStake era) (LedgerState era) (InstantStake era)
forall era. SimpleGetter (LedgerState era) (InstantStake era)
forall (t :: * -> *) era.
CanGetInstantStake t =>
SimpleGetter (t era) (InstantStake era)
instantStakeG
    umap :: UMap
umap = CertState era
cs CertState era -> Getting UMap (CertState era) UMap -> UMap
forall s a. s -> Getting a s a -> a
^. (DState era -> Const UMap (DState era))
-> CertState era -> Const UMap (CertState era)
forall era. EraCertState era => Lens' (CertState era) (DState era)
Lens' (CertState era) (DState era)
certDStateL ((DState era -> Const UMap (DState era))
 -> CertState era -> Const UMap (CertState era))
-> ((UMap -> Const UMap UMap)
    -> DState era -> Const UMap (DState era))
-> Getting UMap (CertState era) UMap
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (UMap -> Const UMap UMap) -> DState era -> Const UMap (DState era)
forall era (f :: * -> *).
Functor f =>
(UMap -> f UMap) -> DState era -> f (DState era)
dsUnifiedL
    dreps :: Map (Credential 'DRepRole) DRepState
dreps = CertState era
cs CertState era
-> Getting
     (Map (Credential 'DRepRole) DRepState)
     (CertState era)
     (Map (Credential 'DRepRole) DRepState)
-> Map (Credential 'DRepRole) DRepState
forall s a. s -> Getting a s a -> a
^. (VState era
 -> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> CertState era
-> Const (Map (Credential 'DRepRole) DRepState) (CertState era)
forall era.
ConwayEraCertState era =>
Lens' (CertState era) (VState era)
Lens' (CertState era) (VState era)
certVStateL ((VState era
  -> Const (Map (Credential 'DRepRole) DRepState) (VState era))
 -> CertState era
 -> Const (Map (Credential 'DRepRole) DRepState) (CertState era))
-> ((Map (Credential 'DRepRole) DRepState
     -> Const
          (Map (Credential 'DRepRole) DRepState)
          (Map (Credential 'DRepRole) DRepState))
    -> VState era
    -> Const (Map (Credential 'DRepRole) DRepState) (VState era))
-> Getting
     (Map (Credential 'DRepRole) DRepState)
     (CertState era)
     (Map (Credential 'DRepRole) DRepState)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (Map (Credential 'DRepRole) DRepState
 -> Const
      (Map (Credential 'DRepRole) DRepState)
      (Map (Credential 'DRepRole) DRepState))
-> VState era
-> Const (Map (Credential 'DRepRole) DRepState) (VState era)
forall era (f :: * -> *).
Functor f =>
(Map (Credential 'DRepRole) DRepState
 -> f (Map (Credential 'DRepRole) DRepState))
-> VState era -> f (VState era)
vsDRepsL

extractPulsingDRepDistr ::
  ConwayEraGov era =>
  NewEpochState era ->
  Map.Map DRep (CompactForm Coin)
extractPulsingDRepDistr :: forall era.
ConwayEraGov era =>
NewEpochState era -> Map DRep (CompactForm Coin)
extractPulsingDRepDistr NewEpochState era
nes =
  (PulsingSnapshot era -> Map DRep (CompactForm Coin)
forall era. PulsingSnapshot era -> Map DRep (CompactForm Coin)
psDRepDistr (PulsingSnapshot era -> Map DRep (CompactForm Coin))
-> (DRepPulsingState era -> PulsingSnapshot era)
-> DRepPulsingState era
-> Map DRep (CompactForm Coin)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (PulsingSnapshot era, RatifyState era) -> PulsingSnapshot era
forall a b. (a, b) -> a
fst ((PulsingSnapshot era, RatifyState era) -> PulsingSnapshot era)
-> (DRepPulsingState era -> (PulsingSnapshot era, RatifyState era))
-> DRepPulsingState era
-> PulsingSnapshot era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
forall era.
EraStake era =>
DRepPulsingState era -> (PulsingSnapshot era, RatifyState era)
finishDRepPulser) (NewEpochState era
nes NewEpochState era
-> Getting
     (DRepPulsingState era) (NewEpochState era) (DRepPulsingState era)
-> DRepPulsingState era
forall s a. s -> Getting a s a -> a
^. Getting
  (DRepPulsingState era) (NewEpochState era) (DRepPulsingState era)
forall era.
ConwayEraGov era =>
Lens' (NewEpochState era) (DRepPulsingState era)
Lens' (NewEpochState era) (DRepPulsingState era)
newEpochStateDRepPulsingStateL)

-- ===============================================
-- helper functions

showCerts :: Proof era -> [TxCert era] -> String
showCerts :: forall era. Proof era -> [TxCert era] -> String
showCerts Proof era
proof [TxCert era]
cs = PDoc -> String
forall a. Show a => a -> String
show ((TxCert era -> PDoc) -> [TxCert era] -> PDoc
forall x ann. (x -> Doc ann) -> [x] -> Doc ann
ppList (Proof era -> TxCert era -> PDoc
forall era. Proof era -> TxCert era -> PDoc
pcTxCert Proof era
proof) [TxCert era]
cs)

certsOf :: EraTx era => Tx era -> [TxCert era]
certsOf :: forall era. EraTx era => Tx era -> [TxCert era]
certsOf Tx era
tx = StrictSeq (TxCert era) -> [TxCert era]
forall a. StrictSeq a -> [a]
forall (t :: * -> *) a. Foldable t => t a -> [a]
toList (Tx era
tx Tx era
-> Getting
     (StrictSeq (TxCert era)) (Tx era) (StrictSeq (TxCert era))
-> StrictSeq (TxCert era)
forall s a. s -> Getting a s a -> a
^. ((TxBody era -> Const (StrictSeq (TxCert era)) (TxBody era))
-> Tx era -> Const (StrictSeq (TxCert era)) (Tx era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL ((TxBody era -> Const (StrictSeq (TxCert era)) (TxBody era))
 -> Tx era -> Const (StrictSeq (TxCert era)) (Tx era))
-> ((StrictSeq (TxCert era)
     -> Const (StrictSeq (TxCert era)) (StrictSeq (TxCert era)))
    -> TxBody era -> Const (StrictSeq (TxCert era)) (TxBody era))
-> Getting
     (StrictSeq (TxCert era)) (Tx era) (StrictSeq (TxCert era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (StrictSeq (TxCert era)
 -> Const (StrictSeq (TxCert era)) (StrictSeq (TxCert era)))
-> TxBody era -> Const (StrictSeq (TxCert era)) (TxBody era)
forall era.
EraTxBody era =>
Lens' (TxBody era) (StrictSeq (TxCert era))
Lens' (TxBody era) (StrictSeq (TxCert era))
certsTxBodyL))

hashTx :: EraTx era => Proof era -> Tx era -> Hash HASH EraIndependentTxBody
hashTx :: forall era.
EraTx era =>
Proof era -> Tx era -> Hash HASH EraIndependentTxBody
hashTx Proof era
proof Tx era
tx = Proof era -> TxBody era -> Hash HASH EraIndependentTxBody
forall era.
Proof era -> TxBody era -> Hash HASH EraIndependentTxBody
hashBody Proof era
proof (Tx era
tx Tx era -> Getting (TxBody era) (Tx era) (TxBody era) -> TxBody era
forall s a. s -> Getting a s a -> a
^. Getting (TxBody era) (Tx era) (TxBody era)
forall era. EraTx era => Lens' (Tx era) (TxBody era)
Lens' (Tx era) (TxBody era)
bodyTxL)

showMap :: (Show k, Show v) => String -> Map.Map k v -> String
showMap :: forall k v. (Show k, Show v) => String -> Map k v -> String
showMap String
msg Map k v
m = [String] -> String
unlines (String
msg String -> [String] -> [String]
forall a. a -> [a] -> [a]
: ((k, v) -> String) -> [(k, v)] -> [String]
forall a b. (a -> b) -> [a] -> [b]
map (k, v) -> String
forall a. Show a => a -> String
show (Map k v -> [(k, v)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k v
m))

traceMap :: (Show k, Show v) => String -> Map.Map k v -> a -> a
traceMap :: forall k v a. (Show k, Show v) => String -> Map k v -> a -> a
traceMap String
s Map k v
m = String -> a -> a
forall a. String -> a -> a
Debug.trace (String -> Map k v -> String
forall k v. (Show k, Show v) => String -> Map k v -> String
showMap String
s Map k v
m)

showPotObl :: (ConwayEraGov era, EraCertState era) => NewEpochState era -> String
showPotObl :: forall era.
(ConwayEraGov era, EraCertState era) =>
NewEpochState era -> String
showPotObl NewEpochState era
nes =
  String
"\nPOT "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Coin -> String
forall a. Show a => a -> String
show (UTxOState era -> Coin
forall era. UTxOState era -> Coin
utxosDeposited UTxOState era
us)
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ String
"\nAll "
    String -> String -> String
forall a. [a] -> [a] -> [a]
++ Obligations -> String
forall a. Show a => a -> String
show (CertState era -> GovState era -> Obligations
forall era.
(EraGov era, EraCertState era) =>
CertState era -> GovState era -> Obligations
allObligations CertState era
certSt (UTxOState era
us UTxOState era
-> Getting (GovState era) (UTxOState era) (GovState era)
-> GovState era
forall s a. s -> Getting a s a -> a
^. Getting (GovState era) (UTxOState era) (GovState era)
forall era (f :: * -> *).
Functor f =>
(GovState era -> f (GovState era))
-> UTxOState era -> f (UTxOState era)
utxosGovStateL))
  where
    es :: EpochState era
es = NewEpochState era -> EpochState era
forall era. NewEpochState era -> EpochState era
nesEs NewEpochState era
nes
    ls :: LedgerState era
ls = EpochState era -> LedgerState era
forall era. EpochState era -> LedgerState era
esLState EpochState era
es
    us :: UTxOState era
us = LedgerState era -> UTxOState era
forall era. LedgerState era -> UTxOState era
lsUTxOState LedgerState era
ls
    certSt :: CertState era
certSt = LedgerState era -> CertState era
forall era. LedgerState era -> CertState era
lsCertState LedgerState era
ls