{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Shelley.Binary.Golden (
  goldenNewEpochStateExpectation,
) where

import Cardano.Ledger.BaseTypes (BlocksMade (..), EpochNo (..))
import Cardano.Ledger.Binary (EncCBOR, lengthThreshold)
import Cardano.Ledger.Binary.Plain
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState
import Cardano.Ledger.State
import qualified Data.Map.Strict as Map
import qualified Data.VMap as VMap
import Test.Cardano.Ledger.Binary.Plain.Golden
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Shelley.Arbitrary ()

goldenNewEpochStateExpectation ::
  forall era.
  ( HasCallStack
  , EraTxOut era
  , EraGov era
  , EraStake era
  , ToCBOR (StashedAVVMAddresses era)
  , EncCBOR (StashedAVVMAddresses era)
  , EraCertState era
  ) =>
  NewEpochState era ->
  Expectation
goldenNewEpochStateExpectation :: forall era.
(HasCallStack, EraTxOut era, EraGov era, EraStake era,
 ToCBOR (StashedAVVMAddresses era),
 EncCBOR (StashedAVVMAddresses era), EraCertState era) =>
NewEpochState era -> Expectation
goldenNewEpochStateExpectation
  nes :: NewEpochState era
nes@NewEpochState
    { nesEs :: forall era. NewEpochState era -> EpochState era
nesEs =
      EpochState
        { esChainAccountState :: forall era. EpochState era -> ChainAccountState
esChainAccountState = ChainAccountState {Coin
casTreasury :: Coin
casReserves :: Coin
casTreasury :: ChainAccountState -> Coin
casReserves :: ChainAccountState -> Coin
..}
        , esSnapshots :: forall era. EpochState era -> SnapShots
esSnapshots = SnapShots {Coin
PoolDistr
SnapShot
ssStakeMark :: SnapShot
ssStakeMarkPoolDistr :: PoolDistr
ssStakeSet :: SnapShot
ssStakeGo :: SnapShot
ssFee :: Coin
$sel:ssStakeMark:SnapShots :: SnapShots -> SnapShot
$sel:ssStakeMarkPoolDistr:SnapShots :: SnapShots -> PoolDistr
$sel:ssStakeSet:SnapShots :: SnapShots -> SnapShot
$sel:ssStakeGo:SnapShots :: SnapShots -> SnapShot
$sel:ssFee:SnapShots :: SnapShots -> Coin
..}
        , NonMyopic
LedgerState era
esLState :: LedgerState era
esNonMyopic :: NonMyopic
esLState :: forall era. EpochState era -> LedgerState era
esNonMyopic :: forall era. EpochState era -> NonMyopic
..
        }
    , StrictMaybe PulsingRewUpdate
EpochNo
BlocksMade
PoolDistr
StashedAVVMAddresses era
nesEL :: EpochNo
nesBprev :: BlocksMade
nesBcur :: BlocksMade
nesRu :: StrictMaybe PulsingRewUpdate
nesPd :: PoolDistr
stashedAVVMAddresses :: StashedAVVMAddresses era
nesEL :: forall era. NewEpochState era -> EpochNo
nesBprev :: forall era. NewEpochState era -> BlocksMade
nesBcur :: forall era. NewEpochState era -> BlocksMade
nesRu :: forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
nesPd :: forall era. NewEpochState era -> PoolDistr
stashedAVVMAddresses :: forall era. NewEpochState era -> StashedAVVMAddresses era
..
    } =
    DiffView -> NewEpochState era -> Enc -> Expectation
forall a b.
(HasCallStack, ToCBOR a, ToCBOR b) =>
DiffView -> a -> b -> Expectation
expectGoldenToCBOR DiffView
DiffHex NewEpochState era
nes (Enc -> Expectation) -> Enc -> Expectation
forall a b. (a -> b) -> a -> b
$
      [Enc] -> Enc
forall a. Monoid a => [a] -> a
mconcat
        [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
7)
        , (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word64 -> Tokens -> Tokens
TkWord64 (EpochNo -> Word64
unEpochNo EpochNo
nesEL))
        , Map (KeyHash 'StakePool) Natural -> Enc
forall {k} {a}. (EncCBOR k, EncCBOR a) => Map k a -> Enc
mapEnc (BlocksMade -> Map (KeyHash 'StakePool) Natural
unBlocksMade BlocksMade
nesBprev)
        , Map (KeyHash 'StakePool) Natural -> Enc
forall {k} {a}. (EncCBOR k, EncCBOR a) => Map k a -> Enc
mapEnc (BlocksMade -> Map (KeyHash 'StakePool) Natural
unBlocksMade BlocksMade
nesBcur)
        , [Enc] -> Enc
Em
            [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
4)
            , [Enc] -> Enc
Em
                [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
2)
                , Coin -> Enc
forall a. ToCBOR a => a -> Enc
E Coin
casTreasury
                , Coin -> Enc
forall a. ToCBOR a => a -> Enc
E Coin
casReserves
                ]
            , LedgerState era -> Enc
forall a. ToCBOR a => a -> Enc
E LedgerState era
esLState
            , [Enc] -> Enc
Em
                [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
4)
                , SnapShot -> Enc
snapShotEnc SnapShot
ssStakeMark
                , SnapShot -> Enc
snapShotEnc SnapShot
ssStakeSet
                , SnapShot -> Enc
snapShotEnc SnapShot
ssStakeGo
                , Coin -> Enc
forall a. ToCBOR a => a -> Enc
E Coin
ssFee
                ]
            , Version -> NonMyopic -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver NonMyopic
esNonMyopic
            ]
        , Version -> StrictMaybe PulsingRewUpdate -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver StrictMaybe PulsingRewUpdate
nesRu
        , Version -> PoolDistr -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver PoolDistr
nesPd
        , StashedAVVMAddresses era -> Enc
forall a. ToCBOR a => a -> Enc
E StashedAVVMAddresses era
stashedAVVMAddresses
        ]
    where
      ver :: Version
ver = forall era. Era era => Version
eraProtVerLow @era
      mapEnc :: Map k a -> Enc
mapEnc Map k a
m
        | Map k a -> Int
forall k a. Map k a -> Int
Map.size Map k a
m Int -> Int -> Bool
forall a. Ord a => a -> a -> Bool
> Int
lengthThreshold =
            [Enc] -> Enc
Em [(Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkMapBegin, Enc
me, (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkBreak]
        | Bool
otherwise =
            [Enc] -> Enc
Em [(Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkMapLen (Int -> Word
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Map k a -> Int
forall k a. Map k a -> Int
Map.size Map k a
m))), Enc
me]
        where
          me :: Enc
me = [Enc] -> Enc
Em [Version -> k -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver k
k Enc -> Enc -> Enc
forall a. Semigroup a => a -> a -> a
<> Version -> a -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver a
v | (k
k, a
v) <- Map k a -> [(k, a)]
forall k a. Map k a -> [(k, a)]
Map.toList Map k a
m]
      snapShotEnc :: SnapShot -> Enc
snapShotEnc SnapShot {Stake
VMap VB VB (KeyHash 'StakePool) PoolParams
VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssStake :: Stake
ssDelegations :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssPoolParams :: VMap VB VB (KeyHash 'StakePool) PoolParams
$sel:ssStake:SnapShot :: SnapShot -> Stake
$sel:ssDelegations:SnapShot :: SnapShot -> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
$sel:ssPoolParams:SnapShot :: SnapShot -> VMap VB VB (KeyHash 'StakePool) PoolParams
..} =
        [Enc] -> Enc
Em
          [ (Tokens -> Tokens) -> Enc
forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
3)
          , Map (Credential 'Staking) (CompactForm Coin) -> Enc
forall {k} {a}. (EncCBOR k, EncCBOR a) => Map k a -> Enc
mapEnc (VMap VB VP (Credential 'Staking) (CompactForm Coin)
-> Map (Credential 'Staking) (CompactForm Coin)
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> Map k v
VMap.toMap (Stake -> VMap VB VP (Credential 'Staking) (CompactForm Coin)
unStake Stake
ssStake))
          , Version
-> VMap VB VB (Credential 'Staking) (KeyHash 'StakePool) -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssDelegations
          , Version -> VMap VB VB (KeyHash 'StakePool) PoolParams -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver VMap VB VB (KeyHash 'StakePool) PoolParams
ssPoolParams
          ]