{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeFamilies #-}

module Test.Cardano.Ledger.State.StakePoolSpec (spec) where

import Cardano.Ledger.BaseTypes (EpochNo, StrictMaybe (..))
import Cardano.Ledger.Coin
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.State
import Data.Set (Set)
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Arbitrary ()

spec :: Spec
spec :: Spec
spec = do
  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"StakePoolState" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String
-> ((StakePoolParams (ZonkAny 1), CompactForm Coin,
     Set (Credential Staking), EpochNo, StrictMaybe BlsKeyState)
    -> Property)
-> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
"mkStakePoolState/stakePoolStateToPoolParams round-trip" (((StakePoolParams (ZonkAny 1), CompactForm Coin,
   Set (Credential Staking), EpochNo, StrictMaybe BlsKeyState)
  -> Property)
 -> Spec)
-> ((StakePoolParams (ZonkAny 1), CompactForm Coin,
     Set (Credential Staking), EpochNo, StrictMaybe BlsKeyState)
    -> Property)
-> Spec
forall a b. (a -> b) -> a -> b
$
      \( StakePoolParams (ZonkAny 1)
stakePoolParams :: StakePoolParams era
         , CompactForm Coin
deposit :: CompactForm Coin
         , Set (Credential Staking)
delegs :: Set (Credential Staking)
         , EpochNo
epochNo :: EpochNo
         , StrictMaybe BlsKeyState
blsKeyState
         ) ->
          let poolId :: KeyHash StakePool
poolId = StakePoolParams (ZonkAny 1) -> KeyHash StakePool
forall era. StakePoolParams era -> KeyHash StakePool
sppId StakePoolParams (ZonkAny 1)
stakePoolParams
              network :: Network
network = AccountAddress -> Network
aaNetworkId (AccountAddress -> Network) -> AccountAddress -> Network
forall a b. (a -> b) -> a -> b
$ StakePoolParams (ZonkAny 1) -> AccountAddress
forall era. StakePoolParams era -> AccountAddress
sppAccountAddress StakePoolParams (ZonkAny 1)
stakePoolParams
              stakePoolState :: StakePoolState
stakePoolState = EpochNo
-> StrictMaybe BlsKeyState
-> CompactForm Coin
-> Set (Credential Staking)
-> StakePoolParams (ZonkAny 1)
-> StakePoolState
forall era.
EpochNo
-> StrictMaybe BlsKeyState
-> CompactForm Coin
-> Set (Credential Staking)
-> StakePoolParams era
-> StakePoolState
mkStakePoolState EpochNo
epochNo StrictMaybe BlsKeyState
blsKeyState CompactForm Coin
deposit Set (Credential Staking)
delegs StakePoolParams (ZonkAny 1)
stakePoolParams
              stakePoolParams' :: StakePoolParams (ZonkAny 1)
stakePoolParams' = Network
-> KeyHash StakePool
-> StakePoolState
-> StakePoolParams (ZonkAny 1)
forall era.
Network
-> KeyHash StakePool -> StakePoolState -> StakePoolParams era
stakePoolStateToStakePoolParams Network
network KeyHash StakePool
poolId StakePoolState
stakePoolState
           in StakePoolParams (ZonkAny 1)
stakePoolParams StakePoolParams (ZonkAny 1)
-> StakePoolParams (ZonkAny 1) -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== StakePoolParams (ZonkAny 1)
stakePoolParams'

  String -> Spec -> Spec
forall a. HasCallStack => String -> SpecWith a -> SpecWith a
describe String
"BLS key registration epoch" (Spec -> Spec) -> Spec -> Spec
forall a b. (a -> b) -> a -> b
$ do
    String -> StateKey -> ParamsKey -> ExpectedStateOutcome -> Spec
blsKeyUpdateProp String
"No key in the state, none in the params" StateKey
NoStateKey ParamsKey
NoParamsKey ExpectedStateOutcome
NoKeyRegistration
    String -> StateKey -> ParamsKey -> ExpectedStateOutcome -> Spec
blsKeyUpdateProp String
"No key in the state, one in the params" StateKey
NoStateKey ParamsKey
FreshKey ExpectedStateOutcome
FreshRegistration
    String -> StateKey -> ParamsKey -> ExpectedStateOutcome -> Spec
blsKeyUpdateProp String
"Existing key is dropped" StateKey
HasStateKey ParamsKey
NoParamsKey ExpectedStateOutcome
NoKeyRegistration
    String -> StateKey -> ParamsKey -> ExpectedStateOutcome -> Spec
blsKeyUpdateProp String
"The same key is registered again" StateKey
HasStateKey ParamsKey
SameAsStateKey ExpectedStateOutcome
OriginalRegistration
    String -> StateKey -> ParamsKey -> ExpectedStateOutcome -> Spec
blsKeyUpdateProp String
"A different key is registered" StateKey
HasStateKey ParamsKey
FreshKey ExpectedStateOutcome
FreshRegistration

data StateKey = NoStateKey | HasStateKey deriving (StateKey -> StateKey -> Bool
(StateKey -> StateKey -> Bool)
-> (StateKey -> StateKey -> Bool) -> Eq StateKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: StateKey -> StateKey -> Bool
== :: StateKey -> StateKey -> Bool
$c/= :: StateKey -> StateKey -> Bool
/= :: StateKey -> StateKey -> Bool
Eq, Int -> StateKey -> ShowS
[StateKey] -> ShowS
StateKey -> String
(Int -> StateKey -> ShowS)
-> (StateKey -> String) -> ([StateKey] -> ShowS) -> Show StateKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> StateKey -> ShowS
showsPrec :: Int -> StateKey -> ShowS
$cshow :: StateKey -> String
show :: StateKey -> String
$cshowList :: [StateKey] -> ShowS
showList :: [StateKey] -> ShowS
Show)

data ParamsKey = NoParamsKey | SameAsStateKey | FreshKey deriving (ParamsKey -> ParamsKey -> Bool
(ParamsKey -> ParamsKey -> Bool)
-> (ParamsKey -> ParamsKey -> Bool) -> Eq ParamsKey
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ParamsKey -> ParamsKey -> Bool
== :: ParamsKey -> ParamsKey -> Bool
$c/= :: ParamsKey -> ParamsKey -> Bool
/= :: ParamsKey -> ParamsKey -> Bool
Eq, Int -> ParamsKey -> ShowS
[ParamsKey] -> ShowS
ParamsKey -> String
(Int -> ParamsKey -> ShowS)
-> (ParamsKey -> String)
-> ([ParamsKey] -> ShowS)
-> Show ParamsKey
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ParamsKey -> ShowS
showsPrec :: Int -> ParamsKey -> ShowS
$cshow :: ParamsKey -> String
show :: ParamsKey -> String
$cshowList :: [ParamsKey] -> ShowS
showList :: [ParamsKey] -> ShowS
Show)

data ExpectedStateOutcome = NoKeyRegistration | OriginalRegistration | FreshRegistration
  deriving (ExpectedStateOutcome -> ExpectedStateOutcome -> Bool
(ExpectedStateOutcome -> ExpectedStateOutcome -> Bool)
-> (ExpectedStateOutcome -> ExpectedStateOutcome -> Bool)
-> Eq ExpectedStateOutcome
forall a. (a -> a -> Bool) -> (a -> a -> Bool) -> Eq a
$c== :: ExpectedStateOutcome -> ExpectedStateOutcome -> Bool
== :: ExpectedStateOutcome -> ExpectedStateOutcome -> Bool
$c/= :: ExpectedStateOutcome -> ExpectedStateOutcome -> Bool
/= :: ExpectedStateOutcome -> ExpectedStateOutcome -> Bool
Eq, Int -> ExpectedStateOutcome -> ShowS
[ExpectedStateOutcome] -> ShowS
ExpectedStateOutcome -> String
(Int -> ExpectedStateOutcome -> ShowS)
-> (ExpectedStateOutcome -> String)
-> ([ExpectedStateOutcome] -> ShowS)
-> Show ExpectedStateOutcome
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> ExpectedStateOutcome -> ShowS
showsPrec :: Int -> ExpectedStateOutcome -> ShowS
$cshow :: ExpectedStateOutcome -> String
show :: ExpectedStateOutcome -> String
$cshowList :: [ExpectedStateOutcome] -> ShowS
showList :: [ExpectedStateOutcome] -> ShowS
Show)

blsKeyUpdateProp :: String -> StateKey -> ParamsKey -> ExpectedStateOutcome -> Spec
blsKeyUpdateProp :: String -> StateKey -> ParamsKey -> ExpectedStateOutcome -> Spec
blsKeyUpdateProp String
msg StateKey
keyInStateSpec ParamsKey
keyInParamsSpec ExpectedStateOutcome
expectedOutcome =
  String
-> (EpochNo
    -> BlsKeyState
    -> BlsKey
    -> CompactForm Coin
    -> Set (Credential Staking)
    -> StakePoolParams (ZonkAny 0)
    -> Property)
-> Spec
forall prop.
(HasCallStack, Testable prop) =>
String -> prop -> Spec
prop String
msg ((EpochNo
  -> BlsKeyState
  -> BlsKey
  -> CompactForm Coin
  -> Set (Credential Staking)
  -> StakePoolParams (ZonkAny 0)
  -> Property)
 -> Spec)
-> (EpochNo
    -> BlsKeyState
    -> BlsKey
    -> CompactForm Coin
    -> Set (Credential Staking)
    -> StakePoolParams (ZonkAny 0)
    -> Property)
-> Spec
forall a b. (a -> b) -> a -> b
$
    \EpochNo
epochNo (BlsKeyState
blsKeyState :: BlsKeyState) BlsKey
freshBlsKey CompactForm Coin
deposit Set (Credential Staking)
delegs StakePoolParams (ZonkAny 0)
spp ->
      BlsKeyState -> BlsKey
bksKey BlsKeyState
blsKeyState
        BlsKey -> BlsKey -> Bool
forall a. Eq a => a -> a -> Bool
/= BlsKey
freshBlsKey
          Bool -> Property -> Property
forall prop. Testable prop => Bool -> prop -> Property
==> let
                keyInParams :: StrictMaybe BlsKey
keyInParams = case ParamsKey
keyInParamsSpec of
                  ParamsKey
NoParamsKey -> StrictMaybe BlsKey
forall a. StrictMaybe a
SNothing
                  ParamsKey
SameAsStateKey -> BlsKey -> StrictMaybe BlsKey
forall a. a -> StrictMaybe a
SJust (BlsKey -> StrictMaybe BlsKey) -> BlsKey -> StrictMaybe BlsKey
forall a b. (a -> b) -> a -> b
$ BlsKeyState -> BlsKey
bksKey BlsKeyState
blsKeyState
                  ParamsKey
FreshKey -> BlsKey -> StrictMaybe BlsKey
forall a. a -> StrictMaybe a
SJust BlsKey
freshBlsKey
                mbBlsKeyState :: StrictMaybe BlsKeyState
mbBlsKeyState = case StateKey
keyInStateSpec of
                  StateKey
NoStateKey -> StrictMaybe BlsKeyState
forall a. StrictMaybe a
SNothing
                  StateKey
HasStateKey -> BlsKeyState -> StrictMaybe BlsKeyState
forall a. a -> StrictMaybe a
SJust BlsKeyState
blsKeyState
                updatedBlsKeyState :: StrictMaybe BlsKeyState
updatedBlsKeyState =
                  StakePoolState -> StrictMaybe BlsKeyState
spsBlsKey (StakePoolState -> StrictMaybe BlsKeyState)
-> StakePoolState -> StrictMaybe BlsKeyState
forall a b. (a -> b) -> a -> b
$ EpochNo
-> StrictMaybe BlsKeyState
-> CompactForm Coin
-> Set (Credential Staking)
-> StakePoolParams (ZonkAny 2)
-> StakePoolState
forall era.
EpochNo
-> StrictMaybe BlsKeyState
-> CompactForm Coin
-> Set (Credential Staking)
-> StakePoolParams era
-> StakePoolState
mkStakePoolState EpochNo
epochNo StrictMaybe BlsKeyState
mbBlsKeyState CompactForm Coin
deposit Set (Credential Staking)
delegs (StakePoolParams (ZonkAny 0)
spp {sppBlsKey = keyInParams})
                expectedBlsKeyState :: StrictMaybe BlsKeyState
expectedBlsKeyState = case ExpectedStateOutcome
expectedOutcome of
                  ExpectedStateOutcome
NoKeyRegistration -> StrictMaybe BlsKeyState
forall a. StrictMaybe a
SNothing
                  ExpectedStateOutcome
OriginalRegistration -> StrictMaybe BlsKeyState
mbBlsKeyState
                  ExpectedStateOutcome
FreshRegistration -> BlsKeyState -> StrictMaybe BlsKeyState
forall a. a -> StrictMaybe a
SJust (BlsKey -> EpochNo -> BlsKeyState
BlsKeyState BlsKey
freshBlsKey EpochNo
epochNo)
               in
                StrictMaybe BlsKeyState
updatedBlsKeyState StrictMaybe BlsKeyState -> StrictMaybe BlsKeyState -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== StrictMaybe BlsKeyState
expectedBlsKeyState