{-# 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 (EraCrypto era)
esSnapshots = SnapShots {SnapShot (EraCrypto era)
PoolDistr (EraCrypto era)
Coin
$sel:ssStakeMark:SnapShots :: forall c. SnapShots c -> SnapShot c
$sel:ssStakeMarkPoolDistr:SnapShots :: forall c. SnapShots c -> PoolDistr c
$sel:ssStakeSet:SnapShots :: forall c. SnapShots c -> SnapShot c
$sel:ssStakeGo:SnapShots :: forall c. SnapShots c -> SnapShot c
$sel:ssFee:SnapShots :: forall c. SnapShots c -> Coin
ssFee :: Coin
ssStakeGo :: SnapShot (EraCrypto era)
ssStakeSet :: SnapShot (EraCrypto era)
ssStakeMarkPoolDistr :: PoolDistr (EraCrypto era)
ssStakeMark :: SnapShot (EraCrypto era)
..}
        , LedgerState era
NonMyopic (EraCrypto era)
esLState :: forall era. EpochState era -> LedgerState era
esNonMyopic :: forall era. EpochState era -> NonMyopic (EraCrypto era)
esNonMyopic :: NonMyopic (EraCrypto era)
esLState :: LedgerState era
..
        }
    , StrictMaybe (PulsingRewUpdate (EraCrypto era))
PoolDistr (EraCrypto era)
BlocksMade (EraCrypto era)
EpochNo
StashedAVVMAddresses era
nesEL :: forall era. NewEpochState era -> EpochNo
nesBprev :: forall era. NewEpochState era -> BlocksMade (EraCrypto era)
nesBcur :: forall era. NewEpochState era -> BlocksMade (EraCrypto era)
nesRu :: forall era.
NewEpochState era -> StrictMaybe (PulsingRewUpdate (EraCrypto era))
nesPd :: forall era. NewEpochState era -> PoolDistr (EraCrypto era)
stashedAVVMAddresses :: forall era. NewEpochState era -> StashedAVVMAddresses era
stashedAVVMAddresses :: StashedAVVMAddresses era
nesPd :: PoolDistr (EraCrypto era)
nesRu :: StrictMaybe (PulsingRewUpdate (EraCrypto era))
nesBcur :: BlocksMade (EraCrypto era)
nesBprev :: BlocksMade (EraCrypto era)
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 (forall c. BlocksMade c -> Map (KeyHash 'StakePool c) Natural
unBlocksMade BlocksMade (EraCrypto era)
nesBprev)
        , forall {k} {a}. (EncCBOR k, EncCBOR a) => Map k a -> Enc
mapEnc (forall c. BlocksMade c -> Map (KeyHash 'StakePool c) Natural
unBlocksMade BlocksMade (EraCrypto era)
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)
                , forall {c}. Crypto c => SnapShot c -> Enc
snapShotEnc SnapShot (EraCrypto era)
ssStakeMark
                , forall {c}. Crypto c => SnapShot c -> Enc
snapShotEnc SnapShot (EraCrypto era)
ssStakeSet
                , forall {c}. Crypto c => SnapShot c -> Enc
snapShotEnc SnapShot (EraCrypto era)
ssStakeGo
                , forall a. ToCBOR a => a -> Enc
E Coin
ssFee
                ]
            , forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver NonMyopic (EraCrypto era)
esNonMyopic
            ]
        , forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver StrictMaybe (PulsingRewUpdate (EraCrypto era))
nesRu
        , forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver PoolDistr (EraCrypto era)
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 c -> Enc
snapShotEnc SnapShot {Stake c
VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
$sel:ssStake:SnapShot :: forall c. SnapShot c -> Stake c
$sel:ssDelegations:SnapShot :: forall c.
SnapShot c
-> VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
$sel:ssPoolParams:SnapShot :: forall c.
SnapShot c -> VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
ssPoolParams :: VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
ssDelegations :: VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
ssStake :: Stake c
..} =
        [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 (forall c.
Stake c -> VMap VB VP (Credential 'Staking c) (CompactForm Coin)
unStake Stake c
ssStake))
          , forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver VMap VB VB (Credential 'Staking c) (KeyHash 'StakePool c)
ssDelegations
          , forall a. EncCBOR a => Version -> a -> Enc
Ev Version
ver VMap VB VB (KeyHash 'StakePool c) (PoolParams c)
ssPoolParams
          ]