{-# 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.Slot (BlockNo (..), SlotNo (..))
import Cardano.Ledger.UTxO (UTxO (..))
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
  , ProtVerAtMost era 4
  , ProtVerAtMost era 6
  , Default (StashedAVVMAddresses era)
  , EraGov era
  ) =>
  ChainState era
initStEx1 :: forall era.
(EraTxOut era, ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era), EraGov era) =>
ChainState era
initStEx1 = forall era.
(EraTxOut era, ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era), EraGov era) =>
UTxO era -> ChainState era
initSt (forall era. Map TxIn (TxOut era) -> UTxO era
UTxO 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 =
  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 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)
    forall a. Bounded a => a
minBound
    Word
0
    Word
0
    (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 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 = 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
  , ProtVerAtMost era 4
  , ProtVerAtMost era 6
  , EraGov era
  , Default (StashedAVVMAddresses era)
  ) =>
  ChainState era
expectedStEx1 :: forall era.
(EraSegWits era, ProtVerAtMost era 4, ProtVerAtMost era 6,
 EraGov era, Default (StashedAVVMAddresses era)) =>
ChainState era
expectedStEx1 = forall era. Nonce -> ChainState era -> ChainState era
evolveNonceUnfrozen (forall era.
(HasCallStack, EraSegWits era, ProtVerAtMost era 4,
 ProtVerAtMost era 6) =>
Nonce
blockNonce @era) forall a b. (a -> b) -> a -> b
$ forall era.
Block (BHeader MockCrypto) era -> ChainState era -> ChainState era
newLab forall era.
(HasCallStack, EraSegWits era, ProtVerAtMost era 4,
 ProtVerAtMost era 6) =>
Block (BHeader MockCrypto) era
blockEx1 forall era.
(EraTxOut era, ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era), EraGov 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
  , ProtVerAtMost era 4
  , ProtVerAtMost era 6
  , Default (StashedAVVMAddresses era)
  , EraGov era
  ) =>
  CHAINExample era
exEmptyBlock :: forall era.
(EraSegWits era, ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era), EraGov era) =>
CHAINExample era
exEmptyBlock = forall era.
ChainState era
-> Block (BHeader MockCrypto) era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample era
CHAINExample forall era.
(EraTxOut era, ProtVerAtMost era 4, ProtVerAtMost era 6,
 Default (StashedAVVMAddresses era), EraGov era) =>
ChainState era
initStEx1 forall era.
(HasCallStack, EraSegWits era, ProtVerAtMost era 4,
 ProtVerAtMost era 6) =>
Block (BHeader MockCrypto) era
blockEx1 (forall a b. b -> Either a b
Right forall era.
(EraSegWits era, ProtVerAtMost era 4, ProtVerAtMost era 6,
 EraGov era, Default (StashedAVVMAddresses era)) =>
ChainState era
expectedStEx1)