{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE TypeApplications #-}

-- | The Dijkstra predicate failures render to JSON.
--
-- These instances used to be @error@ stubs, so the first Dijkstra block that
-- failed validation crashed whichever thread forced its trace message. Each
-- case here goes through the full chain of instances for 'DijkstraEra', from
-- 'BlockTransitionError' or 'DijkstraLedgerPredFailure' down to the leaf
-- failure, and forces the encoded JSON.
module Test.Consensus.Tracing.Dijkstra (tests) where

import qualified Cardano.Crypto.Hash.Class as Crypto
import Cardano.Ledger.Address (AccountAddress (..), AccountId (..))
import Cardano.Ledger.BaseTypes (Network (..))
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Conway.Governance (Voter (..))
import qualified Cardano.Ledger.Conway.Rules as Conway
import Cardano.Ledger.Credential (Credential (..))
import Cardano.Ledger.Dijkstra (DijkstraEra)
import qualified Cardano.Ledger.Dijkstra.Rules as Dijkstra
import Cardano.Ledger.Hashes (KeyHash (..))
import Cardano.Ledger.Shelley.API (BlockTransitionError (..), Withdrawals (..))
import qualified Cardano.Ledger.Shelley.Rules as Shelley
import Cardano.Logging (DetailLevel (..), LogFormatting (..))
import Control.Exception (evaluate)
import qualified Data.Aeson as Aeson
import qualified Data.ByteString.Char8 as BS8
import qualified Data.ByteString.Lazy as BL
import qualified Data.List.NonEmpty as NonEmpty
import qualified Data.Map.Strict as Map
import Ouroboros.Consensus.Tracing ()
import Test.Tasty
import Test.Tasty.HUnit

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Dijkstra"
    [ TestName -> Assertion -> TestTree
testCase TestName
"BlockTransitionError" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName -> BlockTransitionError DijkstraEra -> Assertion
forall a. LogFormatting a => TestName -> a -> Assertion
rendersKind TestName
"DijkstraBbodyPredFail" (BlockTransitionError DijkstraEra -> Assertion)
-> BlockTransitionError DijkstraEra -> Assertion
forall a b. (a -> b) -> a -> b
$
          forall era.
NFData (PredicateFailure (EraRule "BBODY" era)) =>
NonEmpty (PredicateFailure (EraRule "BBODY" era))
-> BlockTransitionError era
BlockTransitionError @DijkstraEra (NonEmpty (PredicateFailure (EraRule "BBODY" DijkstraEra))
 -> BlockTransitionError DijkstraEra)
-> NonEmpty (PredicateFailure (EraRule "BBODY" DijkstraEra))
-> BlockTransitionError DijkstraEra
forall a b. (a -> b) -> a -> b
$
            PredicateFailure (EraRule "BBODY" DijkstraEra)
-> NonEmpty (PredicateFailure (EraRule "BBODY" DijkstraEra))
forall a. a -> NonEmpty a
NonEmpty.singleton (PredicateFailure (EraRule "BBODY" DijkstraEra)
 -> NonEmpty (PredicateFailure (EraRule "BBODY" DijkstraEra)))
-> PredicateFailure (EraRule "BBODY" DijkstraEra)
-> NonEmpty (PredicateFailure (EraRule "BBODY" DijkstraEra))
forall a b. (a -> b) -> a -> b
$
              PredicateFailure (EraRule "LEDGERS" DijkstraEra)
-> DijkstraBbodyPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "LEDGERS" era)
-> DijkstraBbodyPredFailure era
Dijkstra.LedgersFailure (PredicateFailure (EraRule "LEDGERS" DijkstraEra)
 -> DijkstraBbodyPredFailure DijkstraEra)
-> PredicateFailure (EraRule "LEDGERS" DijkstraEra)
-> DijkstraBbodyPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
                PredicateFailure (EraRule "LEDGER" DijkstraEra)
-> ShelleyLedgersPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "LEDGER" era)
-> ShelleyLedgersPredFailure era
Shelley.LedgerFailure (PredicateFailure (EraRule "LEDGER" DijkstraEra)
 -> ShelleyLedgersPredFailure DijkstraEra)
-> PredicateFailure (EraRule "LEDGER" DijkstraEra)
-> ShelleyLedgersPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
                  PredicateFailure (EraRule "UTXOW" DijkstraEra)
-> DijkstraLedgerPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> DijkstraLedgerPredFailure era
Dijkstra.DijkstraUtxowFailure (PredicateFailure (EraRule "UTXO" DijkstraEra)
-> DijkstraUtxowPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> DijkstraUtxowPredFailure era
Dijkstra.UtxoFailure PredicateFailure (EraRule "UTXO" DijkstraEra)
DijkstraUtxoPredFailure DijkstraEra
forall era. DijkstraUtxoPredFailure era
Dijkstra.InputSetEmptyUTxO)
    , TestName -> Assertion -> TestTree
testCase TestName
"LEDGER > UTXOW > UTXO" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName -> DijkstraLedgerPredFailure DijkstraEra -> Assertion
forall a. LogFormatting a => TestName -> a -> Assertion
rendersKind TestName
"InputSetEmptyUTxO" (DijkstraLedgerPredFailure DijkstraEra -> Assertion)
-> DijkstraLedgerPredFailure DijkstraEra -> Assertion
forall a b. (a -> b) -> a -> b
$
          DijkstraLedgerPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
ledger (PredicateFailure (EraRule "UTXOW" DijkstraEra)
-> DijkstraLedgerPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "UTXOW" era)
-> DijkstraLedgerPredFailure era
Dijkstra.DijkstraUtxowFailure (PredicateFailure (EraRule "UTXO" DijkstraEra)
-> DijkstraUtxowPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "UTXO" era)
-> DijkstraUtxowPredFailure era
Dijkstra.UtxoFailure PredicateFailure (EraRule "UTXO" DijkstraEra)
DijkstraUtxoPredFailure DijkstraEra
forall era. DijkstraUtxoPredFailure era
Dijkstra.InputSetEmptyUTxO))
    , TestName -> Assertion -> TestTree
testCase TestName
"LEDGER > ENTITIES" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName -> DijkstraLedgerPredFailure DijkstraEra -> Assertion
forall a. LogFormatting a => TestName -> a -> Assertion
rendersKind TestName
"WithdrawalAccountsMissing" (DijkstraLedgerPredFailure DijkstraEra -> Assertion)
-> DijkstraLedgerPredFailure DijkstraEra -> Assertion
forall a b. (a -> b) -> a -> b
$
          DijkstraLedgerPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
ledger (DijkstraLedgerPredFailure DijkstraEra
 -> DijkstraLedgerPredFailure DijkstraEra)
-> (EntitiesPredFailure DijkstraEra
    -> DijkstraLedgerPredFailure DijkstraEra)
-> EntitiesPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "ENTITIES" DijkstraEra)
-> DijkstraLedgerPredFailure DijkstraEra
EntitiesPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "ENTITIES" era)
-> DijkstraLedgerPredFailure era
Dijkstra.DijkstraEntitiesFailure (EntitiesPredFailure DijkstraEra
 -> DijkstraLedgerPredFailure DijkstraEra)
-> EntitiesPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
            Withdrawals -> EntitiesPredFailure DijkstraEra
forall era. Withdrawals -> EntitiesPredFailure era
Dijkstra.WithdrawalAccountsMissing (Map AccountAddress Coin -> Withdrawals
Withdrawals (AccountAddress -> Coin -> Map AccountAddress Coin
forall k a. k -> a -> Map k a
Map.singleton AccountAddress
account (Integer -> Coin
Coin Integer
1)))
    , TestName -> Assertion -> TestTree
testCase TestName
"LEDGER > ENTITIES > CERTS > CERT > POOL" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName -> DijkstraLedgerPredFailure DijkstraEra -> Assertion
forall a. LogFormatting a => TestName -> a -> Assertion
rendersKind TestName
"PoolFailure" (DijkstraLedgerPredFailure DijkstraEra -> Assertion)
-> DijkstraLedgerPredFailure DijkstraEra -> Assertion
forall a b. (a -> b) -> a -> b
$
          DijkstraLedgerPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
ledger (DijkstraLedgerPredFailure DijkstraEra
 -> DijkstraLedgerPredFailure DijkstraEra)
-> (ConwayCertPredFailure DijkstraEra
    -> DijkstraLedgerPredFailure DijkstraEra)
-> ConwayCertPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "ENTITIES" DijkstraEra)
-> DijkstraLedgerPredFailure DijkstraEra
EntitiesPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "ENTITIES" era)
-> DijkstraLedgerPredFailure era
Dijkstra.DijkstraEntitiesFailure (EntitiesPredFailure DijkstraEra
 -> DijkstraLedgerPredFailure DijkstraEra)
-> (ConwayCertPredFailure DijkstraEra
    -> EntitiesPredFailure DijkstraEra)
-> ConwayCertPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "CERTS" DijkstraEra)
-> EntitiesPredFailure DijkstraEra
ConwayCertsPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era
Dijkstra.CertsFailure (ConwayCertsPredFailure DijkstraEra
 -> EntitiesPredFailure DijkstraEra)
-> (ConwayCertPredFailure DijkstraEra
    -> ConwayCertsPredFailure DijkstraEra)
-> ConwayCertPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "CERT" DijkstraEra)
-> ConwayCertsPredFailure DijkstraEra
ConwayCertPredFailure DijkstraEra
-> ConwayCertsPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
Conway.CertFailure (ConwayCertPredFailure DijkstraEra
 -> DijkstraLedgerPredFailure DijkstraEra)
-> ConwayCertPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
            PredicateFailure (EraRule "POOL" DijkstraEra)
-> ConwayCertPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "POOL" era) -> ConwayCertPredFailure era
Conway.PoolFailure (KeyHash StakePool -> DijkstraPoolPredFailure DijkstraEra
forall era. KeyHash StakePool -> DijkstraPoolPredFailure era
Dijkstra.StakePoolNotRegisteredOnKeyPOOL (Char -> KeyHash StakePool
forall (r :: KeyRole). Char -> KeyHash r
keyHash Char
'p'))
    , TestName -> Assertion -> TestTree
testCase TestName
"LEDGER > ENTITIES > CERTS > CERT > GOVCERT" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName -> DijkstraLedgerPredFailure DijkstraEra -> Assertion
forall a. LogFormatting a => TestName -> a -> Assertion
rendersKind TestName
"GovCertFailure" (DijkstraLedgerPredFailure DijkstraEra -> Assertion)
-> DijkstraLedgerPredFailure DijkstraEra -> Assertion
forall a b. (a -> b) -> a -> b
$
          DijkstraLedgerPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
ledger (DijkstraLedgerPredFailure DijkstraEra
 -> DijkstraLedgerPredFailure DijkstraEra)
-> (ConwayCertPredFailure DijkstraEra
    -> DijkstraLedgerPredFailure DijkstraEra)
-> ConwayCertPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "ENTITIES" DijkstraEra)
-> DijkstraLedgerPredFailure DijkstraEra
EntitiesPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "ENTITIES" era)
-> DijkstraLedgerPredFailure era
Dijkstra.DijkstraEntitiesFailure (EntitiesPredFailure DijkstraEra
 -> DijkstraLedgerPredFailure DijkstraEra)
-> (ConwayCertPredFailure DijkstraEra
    -> EntitiesPredFailure DijkstraEra)
-> ConwayCertPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "CERTS" DijkstraEra)
-> EntitiesPredFailure DijkstraEra
ConwayCertsPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "CERTS" era) -> EntitiesPredFailure era
Dijkstra.CertsFailure (ConwayCertsPredFailure DijkstraEra
 -> EntitiesPredFailure DijkstraEra)
-> (ConwayCertPredFailure DijkstraEra
    -> ConwayCertsPredFailure DijkstraEra)
-> ConwayCertPredFailure DijkstraEra
-> EntitiesPredFailure DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "CERT" DijkstraEra)
-> ConwayCertsPredFailure DijkstraEra
ConwayCertPredFailure DijkstraEra
-> ConwayCertsPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "CERT" era) -> ConwayCertsPredFailure era
Conway.CertFailure (ConwayCertPredFailure DijkstraEra
 -> DijkstraLedgerPredFailure DijkstraEra)
-> ConwayCertPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
            PredicateFailure (EraRule "GOVCERT" DijkstraEra)
-> ConwayCertPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "GOVCERT" era)
-> ConwayCertPredFailure era
Conway.GovCertFailure (Credential DRepRole -> DijkstraGovCertPredFailure DijkstraEra
forall era. Credential DRepRole -> DijkstraGovCertPredFailure era
Dijkstra.DijkstraDRepNotRegistered (KeyHash DRepRole -> Credential DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (Char -> KeyHash DRepRole
forall (r :: KeyRole). Char -> KeyHash r
keyHash Char
'd')))
    , TestName -> Assertion -> TestTree
testCase TestName
"LEDGER > GOV" (Assertion -> TestTree) -> Assertion -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName -> DijkstraLedgerPredFailure DijkstraEra -> Assertion
forall a. LogFormatting a => TestName -> a -> Assertion
rendersKind TestName
"VotersDoNotExist" (DijkstraLedgerPredFailure DijkstraEra -> Assertion)
-> DijkstraLedgerPredFailure DijkstraEra -> Assertion
forall a b. (a -> b) -> a -> b
$
          DijkstraLedgerPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
ledger (DijkstraLedgerPredFailure DijkstraEra
 -> DijkstraLedgerPredFailure DijkstraEra)
-> (DijkstraGovPredFailure DijkstraEra
    -> DijkstraLedgerPredFailure DijkstraEra)
-> DijkstraGovPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PredicateFailure (EraRule "GOV" DijkstraEra)
-> DijkstraLedgerPredFailure DijkstraEra
DijkstraGovPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall era.
PredicateFailure (EraRule "GOV" era)
-> DijkstraLedgerPredFailure era
Dijkstra.DijkstraGovFailure (DijkstraGovPredFailure DijkstraEra
 -> DijkstraLedgerPredFailure DijkstraEra)
-> DijkstraGovPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall a b. (a -> b) -> a -> b
$
            NonEmpty Voter -> DijkstraGovPredFailure DijkstraEra
forall era. NonEmpty Voter -> DijkstraGovPredFailure era
Dijkstra.VotersDoNotExist (Voter -> NonEmpty Voter
forall a. a -> NonEmpty a
NonEmpty.singleton (Credential DRepRole -> Voter
DRepVoter (KeyHash DRepRole -> Credential DRepRole
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (Char -> KeyHash DRepRole
forall (r :: KeyRole). Char -> KeyHash r
keyHash Char
'v'))))
    ]
 where
  ledger ::
    Dijkstra.DijkstraLedgerPredFailure DijkstraEra -> Dijkstra.DijkstraLedgerPredFailure DijkstraEra
  ledger :: DijkstraLedgerPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
ledger = DijkstraLedgerPredFailure DijkstraEra
-> DijkstraLedgerPredFailure DijkstraEra
forall a. a -> a
id

-- | Force the whole encoded message, as a tracer backend would, and check the
-- top-level @kind@.
rendersKind :: LogFormatting a => String -> a -> Assertion
rendersKind :: forall a. LogFormatting a => TestName -> a -> Assertion
rendersKind TestName
kind a
x = do
  rendered <- ByteString -> IO ByteString
forall a. a -> IO a
evaluate (ByteString -> IO ByteString)
-> (KeyMap Value -> ByteString) -> KeyMap Value -> IO ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. LazyByteString -> ByteString
BL.toStrict (LazyByteString -> ByteString)
-> (KeyMap Value -> LazyByteString) -> KeyMap Value -> ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. KeyMap Value -> LazyByteString
forall a. ToJSON a => a -> LazyByteString
Aeson.encode (KeyMap Value -> IO ByteString) -> KeyMap Value -> IO ByteString
forall a b. (a -> b) -> a -> b
$ DetailLevel -> a -> KeyMap Value
forall a. LogFormatting a => DetailLevel -> a -> KeyMap Value
forMachine DetailLevel
DDetailed a
x
  assertBool
    ("expected kind " <> show kind <> " in " <> BS8.unpack rendered)
    (BS8.pack ("\"kind\":\"" <> kind <> "\"") `BS8.isInfixOf` rendered)

keyHash :: Char -> KeyHash r
keyHash :: forall (r :: KeyRole). Char -> KeyHash r
keyHash Char
c = Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
forall (r :: KeyRole).
Hash ADDRHASH (VerKeyDSIGN DSIGN) -> KeyHash r
KeyHash (Hash ADDRHASH ByteString -> Hash ADDRHASH (VerKeyDSIGN DSIGN)
forall h a b. Hash h a -> Hash h b
Crypto.castHash ((ByteString -> ByteString)
-> ByteString -> Hash ADDRHASH ByteString
forall h a. HashAlgorithm h => (a -> ByteString) -> a -> Hash h a
Crypto.hashWith ByteString -> ByteString
forall a. a -> a
id (Char -> ByteString
BS8.singleton Char
c)))

account :: AccountAddress
account :: AccountAddress
account = Network -> AccountId -> AccountAddress
AccountAddress Network
Testnet (Credential Staking -> AccountId
AccountId (KeyHash Staking -> Credential Staking
forall (kr :: KeyRole). KeyHash kr -> Credential kr
KeyHashObj (Char -> KeyHash Staking
forall (r :: KeyRole). Char -> KeyHash r
keyHash Char
'a')))