{-# 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.EpochBoundary
import Cardano.Ledger.Shelley.Core
import Cardano.Ledger.Shelley.LedgerState
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
  , ToCBOR (StashedAVVMAddresses era)
  , EncCBOR (StashedAVVMAddresses era)
  ) =>
  NewEpochState era ->
  Expectation
goldenNewEpochStateExpectation :: forall era.
(HasCallStack, EraTxOut era, EraGov era,
 ToCBOR (StashedAVVMAddresses era),
 EncCBOR (StashedAVVMAddresses era)) =>
NewEpochState era -> Expectation
goldenNewEpochStateExpectation
  nes :: NewEpochState era
nes@NewEpochState
    { nesEs :: forall era. NewEpochState era -> EpochState era
nesEs =
      EpochState
        { esAccountState :: forall era. EpochState era -> AccountState
esAccountState = AccountState {Coin
asTreasury :: AccountState -> Coin
asReserves :: AccountState -> Coin
asReserves :: Coin
asTreasury :: Coin
..}
        , esSnapshots :: forall era. EpochState era -> SnapShots
esSnapshots = SnapShots {SnapShot
PoolDistr
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
ssFee :: Coin
ssStakeGo :: SnapShot
ssStakeSet :: SnapShot
ssStakeMarkPoolDistr :: PoolDistr
ssStakeMark :: SnapShot
..}
        , LedgerState era
NonMyopic
esLState :: forall era. EpochState era -> LedgerState era
esNonMyopic :: forall era. EpochState era -> NonMyopic
esNonMyopic :: NonMyopic
esLState :: LedgerState era
..
        }
    , StrictMaybe PulsingRewUpdate
PoolDistr
BlocksMade
EpochNo
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
stashedAVVMAddresses :: StashedAVVMAddresses era
nesPd :: PoolDistr
nesRu :: StrictMaybe PulsingRewUpdate
nesBcur :: BlocksMade
nesBprev :: BlocksMade
nesEL :: EpochNo
..
    } =
    forall a b.
(HasCallStack, ToCBOR a, ToCBOR b) =>
DiffView -> a -> b -> Expectation
expectGoldenToCBOR DiffView
DiffHex NewEpochState era
nes forall a b. (a -> b) -> a -> b
$
      forall a. Monoid a => [a] -> a
mconcat
        [ forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
7)
        , forall a. ToCBOR a => a -> Enc
E (Word64 -> Tokens -> Tokens
TkWord64 (EpochNo -> Word64
unEpochNo EpochNo
nesEL))
        , forall {k} {a}. (EncCBOR k, EncCBOR a) => Map k a -> Enc
mapEnc (BlocksMade -> Map (KeyHash 'StakePool) Natural
unBlocksMade BlocksMade
nesBprev)
        , forall {k} {a}. (EncCBOR k, EncCBOR a) => Map k a -> Enc
mapEnc (BlocksMade -> Map (KeyHash 'StakePool) Natural
unBlocksMade BlocksMade
nesBcur)
        , [Enc] -> Enc
Em
            [ forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
4)
            , [Enc] -> Enc
Em
                [ forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
2)
                , forall a. ToCBOR a => a -> Enc
E Coin
asTreasury
                , forall a. ToCBOR a => a -> Enc
E Coin
asReserves
                ]
            , forall a. ToCBOR a => a -> Enc
E LedgerState era
esLState
            , [Enc] -> Enc
Em
                [ 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
                , forall a. ToCBOR a => a -> Enc
E Coin
ssFee
                ]
            , forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver NonMyopic
esNonMyopic
            ]
        , forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver StrictMaybe PulsingRewUpdate
nesRu
        , forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver PoolDistr
nesPd
        , 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
        | forall k a. Map k a -> Int
Map.size Map k a
m forall a. Ord a => a -> a -> Bool
> Int
lengthThreshold =
            [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkMapBegin, Enc
me, forall a. ToCBOR a => a -> Enc
E Tokens -> Tokens
TkBreak]
        | Bool
otherwise =
            [Enc] -> Enc
Em [forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkMapLen (forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall k a. Map k a -> Int
Map.size Map k a
m))), Enc
me]
        where
          me :: Enc
me = [Enc] -> Enc
Em [forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver k
k forall a. Semigroup a => a -> a -> a
<> forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver a
v | (k
k, a
v) <- forall k a. Map k a -> [(k, a)]
Map.toList Map k a
m]
      snapShotEnc :: SnapShot -> Enc
snapShotEnc SnapShot {Stake
VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
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
ssPoolParams :: VMap VB VB (KeyHash 'StakePool) PoolParams
ssDelegations :: VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssStake :: Stake
..} =
        [Enc] -> Enc
Em
          [ forall a. ToCBOR a => a -> Enc
E (Word -> Tokens -> Tokens
TkListLen Word
3)
          , forall {k} {a}. (EncCBOR k, EncCBOR a) => Map k a -> Enc
mapEnc (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))
          , forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver VMap VB VB (Credential 'Staking) (KeyHash 'StakePool)
ssDelegations
          , forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver VMap VB VB (KeyHash 'StakePool) PoolParams
ssPoolParams
          ]