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

module Test.Cardano.Ledger.Shelley.Examples.EmptyBlock (
  exEmptyBlock,
) where

import Cardano.Ledger.BaseTypes (Nonce)
import Cardano.Ledger.Block (Block)
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.Shelley.State
import Cardano.Ledger.Slot (BlockNo (..), SlotNo (..))
import Cardano.Protocol.TPraos.BHeader (BHeader)
import Cardano.Protocol.TPraos.OCert (KESPeriod (..))
import Data.Default
import GHC.Stack (HasCallStack)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (MockCrypto)
import Test.Cardano.Ledger.Shelley.Examples (CHAINExample (..))
import Test.Cardano.Ledger.Shelley.Examples.Combinators (
  evolveNonceUnfrozen,
  newLab,
 )
import Test.Cardano.Ledger.Shelley.Examples.Federation (coreNodeKeysBySchedule)
import Test.Cardano.Ledger.Shelley.Examples.Init (
  initSt,
  lastByronHeaderHash,
  nonce0,
  ppEx,
 )
import Test.Cardano.Ledger.Shelley.Generator.Core (
  NatNonce (..),
  mkBlockFakeVRF,
  mkOCert,
 )
import Test.Cardano.Ledger.Shelley.Rules.Chain (ChainState (..))
import Test.Cardano.Ledger.Shelley.Utils (getBlockNonce)

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

initStEx1 ::
  ( EraTxOut era
  , EraGov era
  , EraStake era
  , EraCertState era
  , ProtVerAtMost era 4
  , ProtVerAtMost era 6
  , Default (StashedAVVMAddresses era)
  ) =>
  ChainState era
initStEx1 :: forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era)) =>
ChainState era
initStEx1 = UTxO era -> ChainState era
forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era)) =>
UTxO era -> ChainState era
initSt (Map TxIn (TxOut era) -> UTxO era
forall era. Map TxIn (TxOut era) -> UTxO era
UTxO Map TxIn (TxOut era)
forall a. Monoid a => a
mempty)

blockEx1 ::
  forall era.
  ( HasCallStack
  , EraSegWits era
  , ProtVerAtMost era 4
  , ProtVerAtMost era 6
  ) =>
  Block (BHeader MockCrypto) era
blockEx1 :: forall era.
(HasCallStack, EraSegWits era, ProtVerAtMost era 4,
 ProtVerAtMost era 6) =>
Block (BHeader MockCrypto) era
blockEx1 =
  HashHeader
-> AllIssuerKeys MockCrypto 'GenesisDelegate
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert MockCrypto
-> Block (BHeader MockCrypto) era
forall era (r :: KeyRole) c.
(Crypto c, EraSegWits era, Signable (VRF c) (WithResult Seed),
 Signable (KES c) (BHBody c)) =>
HashHeader
-> AllIssuerKeys c r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert c
-> Block (BHeader c) era
mkBlockFakeVRF
    HashHeader
lastByronHeaderHash
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @era PParams era
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
10)
    []
    (Word64 -> SlotNo
SlotNo Word64
10)
    (Word64 -> BlockNo
BlockNo Word64
1)
    Nonce
nonce0
    (Natural -> NatNonce
NatNonce Natural
1)
    UnitInterval
forall a. Bounded a => a
minBound
    Word
0
    Word
0
    (AllIssuerKeys MockCrypto 'GenesisDelegate
-> Word64 -> KESPeriod -> OCert MockCrypto
forall c (r :: KeyRole).
Crypto c =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era -> Word64 -> AllIssuerKeys MockCrypto 'GenesisDelegate
coreNodeKeysBySchedule @era PParams era
forall era.
(EraPParams era, ProtVerAtMost era 4, ProtVerAtMost era 6) =>
PParams era
ppEx Word64
10) Word64
0 (Word -> KESPeriod
KESPeriod Word
0))

blockNonce ::
  forall era.
  ( HasCallStack
  , EraSegWits era
  , ProtVerAtMost era 4
  , ProtVerAtMost era 6
  ) =>
  Nonce
blockNonce :: forall era.
(HasCallStack, EraSegWits era, ProtVerAtMost era 4,
 ProtVerAtMost era 6) =>
Nonce
blockNonce = Block (BHeader MockCrypto) era -> Nonce
forall era. Block (BHeader MockCrypto) era -> Nonce
getBlockNonce (forall era.
(HasCallStack, EraSegWits era, ProtVerAtMost era 4,
 ProtVerAtMost era 6) =>
Block (BHeader MockCrypto) era
blockEx1 @era)

expectedStEx1 ::
  forall era.
  ( EraSegWits era
  , EraGov era
  , EraStake era
  , EraCertState era
  , ProtVerAtMost era 4
  , ProtVerAtMost era 6
  , Default (StashedAVVMAddresses era)
  ) =>
  ChainState era
expectedStEx1 :: forall era.
(EraSegWits era, EraGov era, EraStake era, EraCertState era,
 ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era)) =>
ChainState era
expectedStEx1 = Nonce -> ChainState era -> ChainState era
forall era. Nonce -> ChainState era -> ChainState era
evolveNonceUnfrozen (forall era.
(HasCallStack, EraSegWits era, ProtVerAtMost era 4,
 ProtVerAtMost era 6) =>
Nonce
blockNonce @era) (ChainState era -> ChainState era)
-> ChainState era -> ChainState era
forall a b. (a -> b) -> a -> b
$ Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
newLab Block (BHeader MockCrypto) era
forall era.
(HasCallStack, EraSegWits era, ProtVerAtMost era 4,
 ProtVerAtMost era 6) =>
Block (BHeader MockCrypto) era
blockEx1 ChainState era
forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era)) =>
ChainState era
initStEx1

-- | = Empty Block Example
--
-- This is the most minimal example of using the CHAIN STS transition.
-- It applies an empty block to an initial shelley chain state.
--
-- The only things that change in the chain state are the
-- evolving and candidate nonces, and the last applied block.
exEmptyBlock ::
  ( EraSegWits era
  , EraGov era
  , EraStake era
  , EraCertState era
  , ProtVerAtMost era 4
  , ProtVerAtMost era 6
  , Default (StashedAVVMAddresses era)
  ) =>
  CHAINExample era
exEmptyBlock :: forall era.
(EraSegWits era, EraGov era, EraStake era, EraCertState era,
 ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era)) =>
CHAINExample era
exEmptyBlock = ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample ChainState era
forall era.
(EraTxOut era, EraGov era, EraStake era, EraCertState era,
 ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era)) =>
ChainState era
initStEx1 Block (BHeader MockCrypto) era
forall era.
(HasCallStack, EraSegWits era, ProtVerAtMost era 4,
 ProtVerAtMost era 6) =>
Block (BHeader MockCrypto) era
blockEx1 (ChainState era
-> Either
     (NonEmpty (TestChainPredicateFailure era)) (ChainState era)
forall a b. b -> Either a b
Right ChainState era
forall era.
(EraSegWits era, EraGov era, EraStake era, EraCertState era,
 ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era)) =>
ChainState era
expectedStEx1)