{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Hydra.Chain.Direct.Fixture (
module Hydra.Chain.Direct.Fixture,
pparams,
systemStart,
slotLength,
epochInfo,
) where
import Hydra.Prelude
import Cardano.Ledger.Alonzo.Core (ppPricesL)
import Cardano.Ledger.Alonzo.Scripts (Prices (..))
import Cardano.Ledger.BaseTypes (BoundedRational (..))
import Cardano.Ledger.BaseTypes qualified as Ledger
import Cardano.Ledger.Coin (Coin (..))
import Cardano.Ledger.Core (PParams, ppMinFeeAL, ppMinFeeBL)
import Cardano.Slotting.Time qualified as Slotting
import Control.Lens ((.~))
import Data.Maybe (fromJust)
import Data.Time.Clock.POSIX (posixSecondsToUTCTime)
import Hydra.Cardano.Api (
LedgerEra,
NetworkId (Testnet),
NetworkMagic (NetworkMagic),
PolicyId,
TxIn,
genTxIn,
)
import Hydra.Contract.HeadTokens (headPolicyId)
import Hydra.Ledger.Cardano ()
import Hydra.Ledger.Cardano.Configuration (LedgerEnv, newLedgerEnv)
import Hydra.Ledger.Cardano.Evaluate (epochInfo, pparams, slotLength, systemStart)
testNetworkId :: NetworkId
testNetworkId :: NetworkId
testNetworkId = NetworkMagic -> NetworkId
Testnet (Word32 -> NetworkMagic
NetworkMagic Word32
42)
testPolicyId :: PolicyId
testPolicyId :: PolicyId
testPolicyId = TxIn -> PolicyId
headPolicyId TxIn
testSeedInput
testSeedInput :: TxIn
testSeedInput :: TxIn
testSeedInput = Gen TxIn -> Int -> TxIn
forall a. Gen a -> Int -> a
generateWith Gen TxIn
genTxIn Int
42
defaultLedgerEnv :: LedgerEnv LedgerEra
defaultLedgerEnv :: LedgerEnv LedgerEra
defaultLedgerEnv = PParams LedgerEra -> LedgerEnv LedgerEra
newLedgerEnv PParams LedgerEra
defaultPParams
defaultPParams :: PParams LedgerEra
defaultPParams :: PParams LedgerEra
defaultPParams =
PParams LedgerEra
PParams StandardBabbage
pparams
PParams StandardBabbage
-> (PParams StandardBabbage -> PParams StandardBabbage)
-> PParams StandardBabbage
forall a b. a -> (a -> b) -> b
& (Prices -> Identity Prices)
-> PParams StandardBabbage -> Identity (PParams StandardBabbage)
forall era. AlonzoEraPParams era => Lens' (PParams era) Prices
Lens' (PParams StandardBabbage) Prices
ppPricesL
((Prices -> Identity Prices)
-> PParams StandardBabbage -> Identity (PParams StandardBabbage))
-> Prices -> PParams StandardBabbage -> PParams StandardBabbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ ( Prices
{ prMem :: NonNegativeInterval
prMem = Maybe NonNegativeInterval -> NonNegativeInterval
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe NonNegativeInterval -> NonNegativeInterval)
-> Maybe NonNegativeInterval -> NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
0
, prSteps :: NonNegativeInterval
prSteps = Maybe NonNegativeInterval -> NonNegativeInterval
forall a. HasCallStack => Maybe a -> a
fromJust (Maybe NonNegativeInterval -> NonNegativeInterval)
-> Maybe NonNegativeInterval -> NonNegativeInterval
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe NonNegativeInterval
forall r. BoundedRational r => Rational -> Maybe r
boundRational Rational
0
}
)
PParams StandardBabbage
-> (PParams StandardBabbage -> PParams StandardBabbage)
-> PParams StandardBabbage
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams StandardBabbage -> Identity (PParams StandardBabbage)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams StandardBabbage) Coin
ppMinFeeAL ((Coin -> Identity Coin)
-> PParams StandardBabbage -> Identity (PParams StandardBabbage))
-> Coin -> PParams StandardBabbage -> PParams StandardBabbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
0
PParams StandardBabbage
-> (PParams StandardBabbage -> PParams StandardBabbage)
-> PParams StandardBabbage
forall a b. a -> (a -> b) -> b
& (Coin -> Identity Coin)
-> PParams StandardBabbage -> Identity (PParams StandardBabbage)
forall era. EraPParams era => Lens' (PParams era) Coin
Lens' (PParams StandardBabbage) Coin
ppMinFeeBL ((Coin -> Identity Coin)
-> PParams StandardBabbage -> Identity (PParams StandardBabbage))
-> Coin -> PParams StandardBabbage -> PParams StandardBabbage
forall s t a b. ASetter s t a b -> b -> s -> t
.~ Integer -> Coin
Coin Integer
0
defaultGlobals :: Ledger.Globals
defaultGlobals :: Globals
defaultGlobals =
Ledger.Globals
{ epochInfo :: EpochInfo (Either Text)
Ledger.epochInfo = EpochInfo (Either Text)
forall (m :: * -> *). Monad m => EpochInfo m
epochInfo
, slotsPerKESPeriod :: Word64
Ledger.slotsPerKESPeriod = Word64
20
, stabilityWindow :: Word64
Ledger.stabilityWindow = Word64
33
, randomnessStabilisationWindow :: Word64
Ledger.randomnessStabilisationWindow = Word64
33
, securityParameter :: Word64
Ledger.securityParameter = Word64
10
, maxKESEvo :: Word64
Ledger.maxKESEvo = Word64
10
, quorum :: Word64
Ledger.quorum = Word64
5
, maxMajorPV :: Version
Ledger.maxMajorPV = Version
forall a. Bounded a => a
maxBound
, maxLovelaceSupply :: Word64
Ledger.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
Ledger.activeSlotCoeff = PositiveUnitInterval -> ActiveSlotCoeff
Ledger.mkActiveSlotCoeff (PositiveUnitInterval -> ActiveSlotCoeff)
-> (Rational -> PositiveUnitInterval)
-> Rational
-> ActiveSlotCoeff
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Rational -> PositiveUnitInterval
forall {a}. BoundedRational a => Rational -> a
unsafeBoundRational (Rational -> ActiveSlotCoeff) -> Rational -> ActiveSlotCoeff
forall a b. (a -> b) -> a -> b
$ Rational
0.9
, networkId :: Network
Ledger.networkId = Network
Ledger.Testnet
, systemStart :: SystemStart
Ledger.systemStart = UTCTime -> SystemStart
Slotting.SystemStart (UTCTime -> SystemStart) -> UTCTime -> SystemStart
forall a b. (a -> b) -> a -> b
$ POSIXTime -> UTCTime
posixSecondsToUTCTime POSIXTime
0
}
where
unsafeBoundRational :: Rational -> a
unsafeBoundRational Rational
r =
a -> Maybe a -> a
forall a. a -> Maybe a -> a
fromMaybe (Text -> a
forall a t. (HasCallStack, IsText t) => t -> a
error (Text -> a) -> Text -> a
forall a b. (a -> b) -> a -> b
$ Text
"Could not convert from Rational: " Text -> Text -> Text
forall a. Semigroup a => a -> a -> a
<> Rational -> Text
forall b a. (Show a, IsString b) => a -> b
show Rational
r) (Maybe a -> a) -> Maybe a -> a
forall a b. (a -> b) -> a -> b
$ Rational -> Maybe a
forall r. BoundedRational r => Rational -> Maybe r
Ledger.boundRational Rational
r