{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-}
{-# OPTIONS_GHC -Wno-orphans #-}

-- | Generic Cardano constants for use in testing.
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)

-- * Cardano tx utilities

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

-- | Default environment for the L2 ledger using the fixed L1 'pparams' with
-- zeroed fees and prices. NOTE: This is using still a constant SlotNo = 1.
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