{-# 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.Class
import GHC.Stack (HasCallStack)
import Test.Cardano.Ledger.Shelley.ConcreteCryptoTypes (ExMock)
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 (EraCrypto era)) (TxOut era) -> UTxO era
UTxO forall a. Monoid a => a
mempty)

blockEx1 ::
  forall era.
  ( HasCallStack
  , EraSegWits era
  , ExMock (EraCrypto era)
  , ProtVerAtMost era 4
  , ProtVerAtMost era 6
  ) =>
  Block (BHeader (EraCrypto era)) era
blockEx1 :: forall era.
(HasCallStack, EraSegWits era, ExMock (EraCrypto era),
 ProtVerAtMost era 4, ProtVerAtMost era 6) =>
Block (BHeader (EraCrypto era)) era
blockEx1 =
  forall era (r :: KeyRole).
(EraSegWits era, Signable (VRF (EraCrypto era)) (WithResult Seed),
 Signable (KES (EraCrypto era)) (BHBody (EraCrypto era))) =>
HashHeader (EraCrypto era)
-> AllIssuerKeys (EraCrypto era) r
-> [Tx era]
-> SlotNo
-> BlockNo
-> Nonce
-> NatNonce
-> UnitInterval
-> Word
-> Word
-> OCert (EraCrypto era)
-> Block (BHeader (EraCrypto era)) era
mkBlockFakeVRF
    forall c. Crypto c => HashHeader c
lastByronHeaderHash
    (forall era.
(HasCallStack, EraPParams era) =>
PParams era
-> Word64 -> AllIssuerKeys (EraCrypto era) '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)
    (forall c. Crypto c => Nonce
nonce0 @(EraCrypto era))
    (Natural -> NatNonce
NatNonce Natural
1)
    forall a. Bounded a => a
minBound
    Word
0
    Word
0
    (forall c (r :: KeyRole).
(Crypto c, Signable (DSIGN c) (OCertSignable c)) =>
AllIssuerKeys c r -> Word64 -> KESPeriod -> OCert c
mkOCert (forall era.
(HasCallStack, EraPParams era) =>
PParams era
-> Word64 -> AllIssuerKeys (EraCrypto era) '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
  , ExMock (EraCrypto era)
  , ProtVerAtMost era 4
  , ProtVerAtMost era 6
  ) =>
  Nonce
blockNonce :: forall era.
(HasCallStack, EraSegWits era, ExMock (EraCrypto era),
 ProtVerAtMost era 4, ProtVerAtMost era 6) =>
Nonce
blockNonce = forall era. Era era => Block (BHeader (EraCrypto era)) era -> Nonce
getBlockNonce (forall era.
(HasCallStack, EraSegWits era, ExMock (EraCrypto era),
 ProtVerAtMost era 4, ProtVerAtMost era 6) =>
Block (BHeader (EraCrypto era)) era
blockEx1 @era)

expectedStEx1 ::
  forall era.
  ( EraSegWits era
  , ExMock (EraCrypto era)
  , ProtVerAtMost era 4
  , ProtVerAtMost era 6
  , EraGov era
  , Default (StashedAVVMAddresses era)
  ) =>
  ChainState era
expectedStEx1 :: forall era.
(EraSegWits era, ExMock (EraCrypto 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, ExMock (EraCrypto era),
 ProtVerAtMost era 4, ProtVerAtMost era 6) =>
Nonce
blockNonce @era) forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall era.
Era era =>
Block (BHeader (EraCrypto era)) era
-> ChainState era -> ChainState era
newLab forall era.
(HasCallStack, EraSegWits era, ExMock (EraCrypto era),
 ProtVerAtMost era 4, ProtVerAtMost era 6) =>
Block (BHeader (EraCrypto era)) era
blockEx1 forall a b. (a -> b) -> a -> b
$ 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 ::
  ( ExMock (EraCrypto era)
  , EraSegWits era
  , ProtVerAtMost era 4
  , ProtVerAtMost era 6
  , Default (StashedAVVMAddresses era)
  , EraGov era
  ) =>
  CHAINExample (BHeader (EraCrypto era)) era
exEmptyBlock :: forall era.
(ExMock (EraCrypto era), EraSegWits era, ProtVerAtMost era 4,
 ProtVerAtMost era 6, Default (StashedAVVMAddresses era),
 EraGov era) =>
CHAINExample (BHeader (EraCrypto era)) era
exEmptyBlock = forall h era.
ChainState era
-> Block h era
-> Either
     (NonEmpty (PredicateFailure (CHAIN era))) (ChainState era)
-> CHAINExample h 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, ExMock (EraCrypto era),
 ProtVerAtMost era 4, ProtVerAtMost era 6) =>
Block (BHeader (EraCrypto era)) era
blockEx1 (forall a b. b -> Either a b
Right forall era.
(EraSegWits era, ExMock (EraCrypto era), ProtVerAtMost era 4,
 ProtVerAtMost era 6, EraGov era,
 Default (StashedAVVMAddresses era)) =>
ChainState era
expectedStEx1)