{-# LANGUAGE DataKinds #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}

module Test.Cardano.Ledger.Core.Utils (
  unsafeBoundRational,
  testGlobals,
  mkDummySafeHash,
  txInAt,
  mkActiveStake,
) where

import Cardano.Ledger.BaseTypes (
  EpochSize (..),
  Globals (..),
  Network (..),
  knownNonZeroBounded,
  mkActiveSlotCoeff,
  nonZero,
 )
import Cardano.Ledger.Coin (Coin)
import Cardano.Ledger.Compactible (toCompactPartial)
import Cardano.Ledger.Core
import Cardano.Ledger.Credential (Credential)
import Cardano.Ledger.Hashes (unsafeMakeSafeHash)
import Cardano.Ledger.State (ActiveStake (..), StakeWithDelegation (..))
import Cardano.Ledger.TxIn (TxIn, mkTxInPartial)
import Cardano.Slotting.EpochInfo (fixedEpochInfo)
import Cardano.Slotting.Time (SystemStart (..), mkSlotLength)
import Data.Map.Strict (Map)
import qualified Data.Map.Strict as Map
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import qualified Data.VMap as VMap
import Test.Cardano.Ledger.Binary.Random (mkDummyHash)
import Test.Cardano.Ledger.Common
import Test.Cardano.Ledger.Core.Rational (unsafeBoundRational)

testGlobals :: Globals
testGlobals :: Globals
testGlobals =
  Globals
    { epochInfo :: EpochInfo (Either Text)
epochInfo = EpochSize -> SlotLength -> EpochInfo (Either Text)
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo (Word64 -> EpochSize
EpochSize Word64
100) (NominalDiffTime -> SlotLength
mkSlotLength NominalDiffTime
1)
    , slotsPerKESPeriod :: Word64
slotsPerKESPeriod = Word64
20
    , stabilityWindow :: Word64
stabilityWindow = Word64
33
    , randomnessStabilisationWindow :: Word64
randomnessStabilisationWindow = Word64
33
    , securityParameter :: NonZero Word64
securityParameter = forall (n :: Natural) a.
(KnownNat n, 1 <= n, WithinBounds n a, Num a) =>
NonZero a
knownNonZeroBounded @10
    , maxKESEvo :: Word64
maxKESEvo = Word64
10
    , quorum :: Word64
quorum = Word64
5
    , maxLovelaceSupply :: Word64
maxLovelaceSupply = Word64
45 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000 Word64 -> Word64 -> Word64
forall a. Num a => a -> a -> a
* Word64
1000
    , activeSlotCoeff :: ActiveSlotCoeff
activeSlotCoeff = PositiveUnitInterval -> ActiveSlotCoeff
mkActiveSlotCoeff (PositiveUnitInterval -> ActiveSlotCoeff)
-> (Rational -> PositiveUnitInterval)
-> Rational
-> ActiveSlotCoeff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> PositiveUnitInterval
forall r.
(HasCallStack, Typeable r, BoundedRational r) =>
Rational -> r
unsafeBoundRational (Rational -> ActiveSlotCoeff) -> Rational -> ActiveSlotCoeff
forall a b. (a -> b) -> a -> b
$ Rational
0.9
    , networkId :: Network
networkId = Network
Testnet
    , systemStart :: SystemStart
systemStart = UTCTime -> SystemStart
SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ NominalDiffTime -> UTCTime
posixSecondsToUTCTime NominalDiffTime
0
    }

mkDummySafeHash :: forall a. Int -> SafeHash a
mkDummySafeHash :: forall a. Int -> SafeHash a
mkDummySafeHash = Hash HASH a -> SafeHash a
forall i. Hash HASH i -> SafeHash i
unsafeMakeSafeHash (Hash HASH a -> SafeHash a)
-> (Int -> Hash HASH a) -> Int -> SafeHash a
forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall h a b. (HashAlgorithm h, EncCBOR a) => a -> Hash h b
mkDummyHash @HASH

txInAt :: (HasCallStack, EraTx era) => Int -> Tx l era -> TxIn
txInAt :: forall era (l :: TxLevel).
(HasCallStack, EraTx era) =>
Int -> Tx l era -> TxIn
txInAt Int
index Tx l era
tx =
  let txId :: TxId
txId = Tx l era -> TxId
forall era (l :: TxLevel). EraTx era => Tx l era -> TxId
txIdTx Tx l era
tx
   in HasCallStack => TxId -> Integer -> TxIn
TxId -> Integer -> TxIn
mkTxInPartial TxId
txId (Int -> Integer
forall a. Integral a => a -> Integer
toInteger Int
index)

-- | Construct an @ActiveStake@ from separate maps of stake and delegations.
-- Only credentials present in both maps with non-zero stake are included.
mkActiveStake ::
  Map (Credential Staking) Coin ->
  Map (Credential Staking) (KeyHash StakePool) ->
  ActiveStake
mkActiveStake :: Map (Credential Staking) Coin
-> Map (Credential Staking) (KeyHash StakePool) -> ActiveStake
mkActiveStake Map (Credential Staking) Coin
stakeMap Map (Credential Staking) (KeyHash StakePool)
delegsMap =
  VMap VB VB (Credential Staking) StakeWithDelegation -> ActiveStake
ActiveStake
    (VMap VB VB (Credential Staking) StakeWithDelegation
 -> ActiveStake)
-> VMap VB VB (Credential Staking) StakeWithDelegation
-> ActiveStake
forall a b. (a -> b) -> a -> b
$ Map (Credential Staking) StakeWithDelegation
-> VMap VB VB (Credential Staking) StakeWithDelegation
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap
    (Map (Credential Staking) StakeWithDelegation
 -> VMap VB VB (Credential Staking) StakeWithDelegation)
-> Map (Credential Staking) StakeWithDelegation
-> VMap VB VB (Credential Staking) StakeWithDelegation
forall a b. (a -> b) -> a -> b
$ ((Coin, KeyHash StakePool) -> Maybe StakeWithDelegation)
-> Map (Credential Staking) (Coin, KeyHash StakePool)
-> Map (Credential Staking) StakeWithDelegation
forall a b k. (a -> Maybe b) -> Map k a -> Map k b
Map.mapMaybe
      (\(Coin
c, KeyHash StakePool
d) -> (NonZero (CompactForm Coin)
 -> KeyHash StakePool -> StakeWithDelegation)
-> KeyHash StakePool
-> NonZero (CompactForm Coin)
-> StakeWithDelegation
forall a b c. (a -> b -> c) -> b -> a -> c
flip NonZero (CompactForm Coin)
-> KeyHash StakePool -> StakeWithDelegation
StakeWithDelegation KeyHash StakePool
d (NonZero (CompactForm Coin) -> StakeWithDelegation)
-> Maybe (NonZero (CompactForm Coin)) -> Maybe StakeWithDelegation
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> CompactForm Coin -> Maybe (NonZero (CompactForm Coin))
forall a. HasZero a => a -> Maybe (NonZero a)
nonZero (Coin -> CompactForm Coin
forall a. (HasCallStack, Compactible a) => a -> CompactForm a
toCompactPartial Coin
c))
    (Map (Credential Staking) (Coin, KeyHash StakePool)
 -> Map (Credential Staking) StakeWithDelegation)
-> Map (Credential Staking) (Coin, KeyHash StakePool)
-> Map (Credential Staking) StakeWithDelegation
forall a b. (a -> b) -> a -> b
$ (Coin -> KeyHash StakePool -> (Coin, KeyHash StakePool))
-> Map (Credential Staking) Coin
-> Map (Credential Staking) (KeyHash StakePool)
-> Map (Credential Staking) (Coin, KeyHash StakePool)
forall k a b c.
Ord k =>
(a -> b -> c) -> Map k a -> Map k b -> Map k c
Map.intersectionWith (,) Map (Credential Staking) Coin
stakeMap Map (Credential Staking) (KeyHash StakePool)
delegsMap