{-# 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
casReserves :: ChainAccountState -> Coin
casTreasury :: ChainAccountState -> Coin
..}
        , esSnapshots :: forall era. EpochState era -> SnapShots
esSnapshots = SnapShots {Coin
PoolDistr
SnapShot
ssStakeMark :: SnapShot
ssStakeMarkPoolDistr :: PoolDistr
ssStakeSet :: SnapShot
ssStakeGo :: SnapShot
ssFee :: Coin
ssFee :: SnapShots -> Coin
ssStakeGo :: SnapShots -> SnapShot
ssStakeSet :: SnapShots -> SnapShot
ssStakeMarkPoolDistr :: SnapShots -> PoolDistr
ssStakeMark :: SnapShots -> SnapShot
..}
        , NonMyopic
LedgerState era
esLState :: LedgerState era
esNonMyopic :: NonMyopic
esNonMyopic :: forall era. EpochState era -> NonMyopic
esLState :: forall era. EpochState era -> LedgerState era
..
        }
    , StrictMaybe PulsingRewUpdate
EpochNo
BlocksMade
PoolDistr
StashedAVVMAddresses era
nesEL :: EpochNo
nesBprev :: BlocksMade
nesBcur :: BlocksMade
nesRu :: StrictMaybe PulsingRewUpdate
nesPd :: PoolDistr
stashedAVVMAddresses :: StashedAVVMAddresses era
stashedAVVMAddresses :: forall era. NewEpochState era -> StashedAVVMAddresses era
nesPd :: forall era. NewEpochState era -> PoolDistr
nesRu :: forall era. NewEpochState era -> StrictMaybe PulsingRewUpdate
nesBcur :: forall era. NewEpochState era -> BlocksMade
nesBprev :: forall era. NewEpochState era -> BlocksMade
nesEL :: forall era. NewEpochState era -> EpochNo
..
    } =
    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) StakePoolParams
VMap VB VB (Credential Staking) (KeyHash StakePool)
ssStake :: Stake
ssDelegations :: VMap VB VB (Credential Staking) (KeyHash StakePool)
ssPoolParams :: VMap VB VB (KeyHash StakePool) StakePoolParams
ssPoolParams :: SnapShot -> VMap VB VB (KeyHash StakePool) StakePoolParams
ssDelegations :: SnapShot -> VMap VB VB (Credential Staking) (KeyHash StakePool)
ssStake :: SnapShot -> Stake
..} =
        [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) StakePoolParams -> Enc
forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver VMap VB VB (KeyHash StakePool) StakePoolParams
ssPoolParams
          ]