Skip to content

Commit

Permalink
fixed unit tests
Browse files Browse the repository at this point in the history
  • Loading branch information
@nhenin
nhenin committed Sep 10, 2024
1 parent e149184 commit 5dbde29
Show file tree
Hide file tree
Showing 2 changed files with 244 additions and 13 deletions.
15 changes: 13 additions & 2 deletions marlowe-chain-sync/src/Language/Marlowe/Runtime/ChainSync/Api.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -164,11 +164,12 @@ import Cardano.Api.ProtocolParameters (
convertToLedgerProtocolParameters,
)
import qualified Cardano.Api.Script as Cardano.Api.Shelley
import Cardano.Api.Shelley (LedgerProtocolParameters)
import Cardano.Api.Shelley (LedgerProtocolParameters, ProtocolParameters (..))
import qualified Data.ByteString.Builder as BB
import Data.Reflection (give)

import Adapter.Cardano.Api.ProtocolParameters ()
import Data.Ratio ((%))

-- | Extends a type with a "Genesis" member.
data WithGenesis a = Genesis | At a
Expand Down Expand Up @@ -1452,7 +1453,17 @@ instance Query.RequestVariations ChainSyncQuery where
-- TODO (Refactor Deprecated ProtocolParameters) : Below three instances are ugly workarounds which still rely on deprecated ProtocolParameters.
-- They should be removed and replaced by statically defined protocol params - we have JSON files in the repo which
-- should be included in the code.
instance Variations ProtocolParameters

instance Variations ProtocolParameters where
variations =
( \ProtocolParameters{..} ->
ProtocolParameters
{ protocolParamPrices =
Just (C.ExecutionUnitPrices{priceExecutionSteps = 721 % 10000000, priceExecutionMemory = 577 % 10000})
, ..
}
)
<$> variations

instance Variations (Cardano.Api.Shelley.LedgerProtocolParameters BabbageEra) where
variations = case traverse (convertToLedgerProtocolParameters C.ShelleyBasedEraBabbage) variations of
Expand Down
242 changes: 231 additions & 11 deletions marlowe-cli/tests/Spec/Analysis.hs
View file
Original file line number Diff line number Diff line change
Expand Up @@ -7,7 +7,9 @@
{-# LANGUAGE RecordWildCards #-}
{-# HLINT ignore "Use underscore" #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-deprecations #-}
{-# OPTIONS_GHC -Wno-unrecognised-pragmas #-}
{-# OPTIONS_GHC -Wno-unused-top-binds #-}

-----------------------------------------------------------------------------

Expand All @@ -32,14 +34,15 @@ import Cardano.Api.Ledger qualified as Ledger
import Cardano.Api.Shelley (
AnyPlutusScriptVersion,
CostModel,
LedgerProtocolParameters (LedgerProtocolParameters),
ProtocolParametersConversionError (PpceVersionInvalid),
ShelleyLedgerEra,
fromAlonzoCostModels,
babbageEraOnwardsToShelleyBasedEra,
convertToLedgerProtocolParameters,
toAlonzoCostModels,
toAlonzoExUnits,
toAlonzoPrices,
)
import Cardano.Api.Shelley qualified as C
import Cardano.Ledger.Alonzo.PParams (
ppCollateralPercentageL,
ppCostModelsL,
Expand All @@ -66,7 +69,6 @@ import Cardano.Ledger.Core (
ppRhoL,
ppTauL,
)
import Contrib.Cardano.Api (ledgerProtVerToPlutusMajorProtocolVersion)
import Control.Monad.Except (runExceptT)
import Control.Monad.IO.Class (liftIO)
import Control.Monad.Reader (runReaderT)
Expand Down Expand Up @@ -118,10 +120,10 @@ import Language.Marlowe.Core.V1.Semantics.Types (
Value (Constant),
)
import Language.Marlowe.Extended.V1 (adaSymbol, adaToken)
import Lens.Micro ((&), (.~), (^.))
import Lens.Micro ((&), (.~))
import Plutus.V1.Ledger.SlotConfig (SlotConfig (SlotConfig))
import PlutusLedgerApi.V1.Value (tokenName)
import PlutusLedgerApi.V2 (POSIXTime (..))
import PlutusLedgerApi.V2 (MajorProtocolVersion (MajorProtocolVersion), POSIXTime (..))
import PlutusTx.AssocMap qualified as AM
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.HUnit (Assertion, assertBool, testCase)
Expand All @@ -143,17 +145,23 @@ checkTransactionCost Scenario{scContract, scState, scMerkleize, scExpected} =
. runExceptT
$ do
let era = C.BabbageEraOnwardsConway
protocolParameters = getTestnetProtocolParameters era
protocolVersion = ledgerProtVerToPlutusMajorProtocolVersion $ protocolParameters ^. ppProtocolVersionL
costModels = fromAlonzoCostModels $ protocolParameters ^. ppCostModelsL
legacyProtocolParameters = getLegacyProtocolParamaters
sbe = babbageEraOnwardsToShelleyBasedEra era
protocolParameters = either (error . show) id $ convertToLedgerProtocolParameters sbe legacyProtocolParameters -- getTestnetProtocolParameters era
-- protocolVersion = ledgerProtVerToPlutusMajorProtocolVersion $ protocolParameters ^. ppProtocolVersionL
-- costModels = fromAlonzoCostModels $ protocolParameters ^. ppCostModelsL
MarloweTransaction{..} <-
flip runReaderT (CliEnv era) $
initializeTransactionImpl
@C.PlutusScriptV2
(marloweParams "8bb3b343d8e404472337966a722150048c768d0a92a9813596c5338d")
(SlotConfig 0 1000)
protocolVersion
((\(C.CostModel c) -> fromIntegral <$> c) $ costModels M.! C.AnyPlutusScriptVersion C.PlutusScriptV2)
-- protocolVersion
-- ((\(C.CostModel c) -> fromIntegral <$> c) $ costModels M.! C.AnyPlutusScriptVersion C.PlutusScriptV2)
(MajorProtocolVersion $ fromEnum $ fst $ C.protocolParamProtocolVersion legacyProtocolParameters)
( (\(C.CostModel c) -> fromIntegral <$> c) $
C.protocolParamCostModels legacyProtocolParameters M.! C.AnyPlutusScriptVersion C.PlutusScriptV2
)
(C.Testnet $ C.NetworkMagic 1)
C.NoStakeAddress
scContract
Expand All @@ -171,7 +179,7 @@ checkTransactionCost Scenario{scContract, scState, scMerkleize, scExpected} =
ciSlotConfig = mtSlotConfig
contract = MerkleizedContract ciContract ciContinuations
transactions <- findTransactions unitAnnotator True contract (AlreadyInitialized scState)
actual <- checkExecutionCost era (LedgerProtocolParameters protocolParameters) ContractInstance{..} transactions False
actual <- checkExecutionCost era protocolParameters ContractInstance{..} transactions False
let lsbToText :: LBS.ByteString -> Text.Text
lsbToText = Text.decodeUtf8 . LBS.toStrict

Expand Down Expand Up @@ -592,3 +600,215 @@ getAlonzoCostModel =
, ("verifySchnorrSecp256k1Signature-memory-arguments", 10)
]
in (fromRight (error "malformed cost models for testnet : ") $ toAlonzoCostModels costmodels)

getLegacyProtocolParamaters :: C.ProtocolParameters
getLegacyProtocolParamaters =
C.ProtocolParameters
{ protocolParamProtocolVersion = (8, 0)
, protocolParamDecentralization = Nothing
, protocolParamExtraPraosEntropy = Nothing
, protocolParamMaxBlockHeaderSize = 1100
, protocolParamMaxBlockBodySize = 90112
, protocolParamMaxTxSize = 16384
, protocolParamTxFeeFixed = 155381
, protocolParamTxFeePerByte = 44
, protocolParamMinUTxOValue = Nothing
, protocolParamStakeAddressDeposit = Ledger.Coin 2000000
, protocolParamStakePoolDeposit = Ledger.Coin 500000000
, protocolParamMinPoolCost = Ledger.Coin 340000000
, protocolParamPoolRetireMaxEpoch = CI.EpochInterval 18
, protocolParamStakePoolTargetNum = 500
, protocolParamPoolPledgeInfluence = 3 % 10
, protocolParamMonetaryExpansion = 3 % 1000
, protocolParamTreasuryCut = 1 % 5
, protocolParamCostModels =
M.singleton
(C.AnyPlutusScriptVersion C.PlutusScriptV2)
. C.CostModel
. M.elems
$ M.fromList @String
[ ("addInteger-cpu-arguments-intercept", 205665)
, ("addInteger-cpu-arguments-slope", 812)
, ("addInteger-memory-arguments-intercept", 1)
, ("addInteger-memory-arguments-slope", 1)
, ("appendByteString-cpu-arguments-intercept", 1000)
, ("appendByteString-cpu-arguments-slope", 571)
, ("appendByteString-memory-arguments-intercept", 0)
, ("appendByteString-memory-arguments-slope", 1)
, ("appendString-cpu-arguments-intercept", 1000)
, ("appendString-cpu-arguments-slope", 24177)
, ("appendString-memory-arguments-intercept", 4)
, ("appendString-memory-arguments-slope", 1)
, ("bData-cpu-arguments", 1000)
, ("bData-memory-arguments", 32)
, ("blake2b_256-cpu-arguments-intercept", 117366)
, ("blake2b_256-cpu-arguments-slope", 10475)
, ("blake2b_256-memory-arguments", 4)
, ("cekApplyCost-exBudgetCPU", 23000)
, ("cekApplyCost-exBudgetMemory", 100)
, ("cekBuiltinCost-exBudgetCPU", 23000)
, ("cekBuiltinCost-exBudgetMemory", 100)
, ("cekConstCost-exBudgetCPU", 23000)
, ("cekConstCost-exBudgetMemory", 100)
, ("cekDelayCost-exBudgetCPU", 23000)
, ("cekDelayCost-exBudgetMemory", 100)
, ("cekForceCost-exBudgetCPU", 23000)
, ("cekForceCost-exBudgetMemory", 100)
, ("cekLamCost-exBudgetCPU", 23000)
, ("cekLamCost-exBudgetMemory", 100)
, ("cekStartupCost-exBudgetCPU", 100)
, ("cekStartupCost-exBudgetMemory", 100)
, ("cekVarCost-exBudgetCPU", 23000)
, ("cekVarCost-exBudgetMemory", 100)
, ("chooseData-cpu-arguments", 19537)
, ("chooseData-memory-arguments", 32)
, ("chooseList-cpu-arguments", 175354)
, ("chooseList-memory-arguments", 32)
, ("chooseUnit-cpu-arguments", 46417)
, ("chooseUnit-memory-arguments", 4)
, ("consByteString-cpu-arguments-intercept", 221973)
, ("consByteString-cpu-arguments-slope", 511)
, ("consByteString-memory-arguments-intercept", 0)
, ("consByteString-memory-arguments-slope", 1)
, ("constrData-cpu-arguments", 89141)
, ("constrData-memory-arguments", 32)
, ("decodeUtf8-cpu-arguments-intercept", 497525)
, ("decodeUtf8-cpu-arguments-slope", 14068)
, ("decodeUtf8-memory-arguments-intercept", 4)
, ("decodeUtf8-memory-arguments-slope", 2)
, ("divideInteger-cpu-arguments-constant", 196500)
, ("divideInteger-cpu-arguments-model-arguments-intercept", 453240)
, ("divideInteger-cpu-arguments-model-arguments-slope", 220)
, ("divideInteger-memory-arguments-intercept", 0)
, ("divideInteger-memory-arguments-minimum", 1)
, ("divideInteger-memory-arguments-slope", 1)
, ("encodeUtf8-cpu-arguments-intercept", 1000)
, ("encodeUtf8-cpu-arguments-slope", 28662)
, ("encodeUtf8-memory-arguments-intercept", 4)
, ("encodeUtf8-memory-arguments-slope", 2)
, ("equalsByteString-cpu-arguments-constant", 245000)
, ("equalsByteString-cpu-arguments-intercept", 216773)
, ("equalsByteString-cpu-arguments-slope", 62)
, ("equalsByteString-memory-arguments", 1)
, ("equalsData-cpu-arguments-intercept", 1060367)
, ("equalsData-cpu-arguments-slope", 12586)
, ("equalsData-memory-arguments", 1)
, ("equalsInteger-cpu-arguments-intercept", 208512)
, ("equalsInteger-cpu-arguments-slope", 421)
, ("equalsInteger-memory-arguments", 1)
, ("equalsString-cpu-arguments-constant", 187000)
, ("equalsString-cpu-arguments-intercept", 1000)
, ("equalsString-cpu-arguments-slope", 52998)
, ("equalsString-memory-arguments", 1)
, ("fstPair-cpu-arguments", 80436)
, ("fstPair-memory-arguments", 32)
, ("headList-cpu-arguments", 43249)
, ("headList-memory-arguments", 32)
, ("iData-cpu-arguments", 1000)
, ("iData-memory-arguments", 32)
, ("ifThenElse-cpu-arguments", 80556)
, ("ifThenElse-memory-arguments", 1)
, ("indexByteString-cpu-arguments", 57667)
, ("indexByteString-memory-arguments", 4)
, ("lengthOfByteString-cpu-arguments", 1000)
, ("lengthOfByteString-memory-arguments", 10)
, ("lessThanByteString-cpu-arguments-intercept", 197145)
, ("lessThanByteString-cpu-arguments-slope", 156)
, ("lessThanByteString-memory-arguments", 1)
, ("lessThanEqualsByteString-cpu-arguments-intercept", 197145)
, ("lessThanEqualsByteString-cpu-arguments-slope", 156)
, ("lessThanEqualsByteString-memory-arguments", 1)
, ("lessThanEqualsInteger-cpu-arguments-intercept", 204924)
, ("lessThanEqualsInteger-cpu-arguments-slope", 473)
, ("lessThanEqualsInteger-memory-arguments", 1)
, ("lessThanInteger-cpu-arguments-intercept", 208896)
, ("lessThanInteger-cpu-arguments-slope", 511)
, ("lessThanInteger-memory-arguments", 1)
, ("listData-cpu-arguments", 52467)
, ("listData-memory-arguments", 32)
, ("mapData-cpu-arguments", 64832)
, ("mapData-memory-arguments", 32)
, ("mkCons-cpu-arguments", 65493)
, ("mkCons-memory-arguments", 32)
, ("mkNilData-cpu-arguments", 22558)
, ("mkNilData-memory-arguments", 32)
, ("mkNilPairData-cpu-arguments", 16563)
, ("mkNilPairData-memory-arguments", 32)
, ("mkPairData-cpu-arguments", 76511)
, ("mkPairData-memory-arguments", 32)
, ("modInteger-cpu-arguments-constant", 196500)
, ("modInteger-cpu-arguments-model-arguments-intercept", 453240)
, ("modInteger-cpu-arguments-model-arguments-slope", 220)
, ("modInteger-memory-arguments-intercept", 0)
, ("modInteger-memory-arguments-minimum", 1)
, ("modInteger-memory-arguments-slope", 1)
, ("multiplyInteger-cpu-arguments-intercept", 69522)
, ("multiplyInteger-cpu-arguments-slope", 11687)
, ("multiplyInteger-memory-arguments-intercept", 0)
, ("multiplyInteger-memory-arguments-slope", 1)
, ("nullList-cpu-arguments", 60091)
, ("nullList-memory-arguments", 32)
, ("quotientInteger-cpu-arguments-constant", 196500)
, ("quotientInteger-cpu-arguments-model-arguments-intercept", 453240)
, ("quotientInteger-cpu-arguments-model-arguments-slope", 220)
, ("quotientInteger-memory-arguments-intercept", 0)
, ("quotientInteger-memory-arguments-minimum", 1)
, ("quotientInteger-memory-arguments-slope", 1)
, ("remainderInteger-cpu-arguments-constant", 196500)
, ("remainderInteger-cpu-arguments-model-arguments-intercept", 453240)
, ("remainderInteger-cpu-arguments-model-arguments-slope", 220)
, ("remainderInteger-memory-arguments-intercept", 0)
, ("remainderInteger-memory-arguments-minimum", 1)
, ("remainderInteger-memory-arguments-slope", 1)
, ("serialiseData-cpu-arguments-intercept", 1159724)
, ("serialiseData-cpu-arguments-slope", 392670)
, ("serialiseData-memory-arguments-intercept", 0)
, ("serialiseData-memory-arguments-slope", 2)
, ("sha2_256-cpu-arguments-intercept", 806990)
, ("sha2_256-cpu-arguments-slope", 30482)
, ("sha2_256-memory-arguments", 4)
, ("sha3_256-cpu-arguments-intercept", 1927926)
, ("sha3_256-cpu-arguments-slope", 82523)
, ("sha3_256-memory-arguments", 4)
, ("sliceByteString-cpu-arguments-intercept", 265318)
, ("sliceByteString-cpu-arguments-slope", 0)
, ("sliceByteString-memory-arguments-intercept", 4)
, ("sliceByteString-memory-arguments-slope", 0)
, ("sndPair-cpu-arguments", 85931)
, ("sndPair-memory-arguments", 32)
, ("subtractInteger-cpu-arguments-intercept", 205665)
, ("subtractInteger-cpu-arguments-slope", 812)
, ("subtractInteger-memory-arguments-intercept", 1)
, ("subtractInteger-memory-arguments-slope", 1)
, ("tailList-cpu-arguments", 41182)
, ("tailList-memory-arguments", 32)
, ("trace-cpu-arguments", 212342)
, ("trace-memory-arguments", 32)
, ("unBData-cpu-arguments", 31220)
, ("unBData-memory-arguments", 32)
, ("unConstrData-cpu-arguments", 32696)
, ("unConstrData-memory-arguments", 32)
, ("unIData-cpu-arguments", 43357)
, ("unIData-memory-arguments", 32)
, ("unListData-cpu-arguments", 32247)
, ("unListData-memory-arguments", 32)
, ("unMapData-cpu-arguments", 38314)
, ("unMapData-memory-arguments", 32)
, ("verifyEcdsaSecp256k1Signature-cpu-arguments", 35892428)
, ("verifyEcdsaSecp256k1Signature-memory-arguments", 10)
, ("verifyEd25519Signature-cpu-arguments-intercept", 57996947)
, ("verifyEd25519Signature-cpu-arguments-slope", 18975)
, ("verifyEd25519Signature-memory-arguments", 10)
, ("verifySchnorrSecp256k1Signature-cpu-arguments-intercept", 38887044)
, ("verifySchnorrSecp256k1Signature-cpu-arguments-slope", 32947)
, ("verifySchnorrSecp256k1Signature-memory-arguments", 10)
]
, protocolParamPrices =
Just (C.ExecutionUnitPrices{priceExecutionSteps = 721 % 10000000, priceExecutionMemory = 577 % 10000})
, protocolParamMaxTxExUnits = Just (C.ExecutionUnits{executionSteps = 10000000000, executionMemory = 14000000})
, protocolParamMaxBlockExUnits = Just (C.ExecutionUnits{executionSteps = 40000000000, executionMemory = 62000000})
, protocolParamMaxValueSize = Just 5000
, protocolParamCollateralPercent = Just 150
, protocolParamMaxCollateralInputs = Just 3
, protocolParamUTxOCostPerByte = Just (Ledger.Coin 4310)
}

0 comments on commit 5dbde29

Please sign in to comment.