fixup! Add MintBurn tests
Separate generators from other helpers.
Separate generators from other helpers.
quantity' === quantity
_ -> fail "More than one mint/burn event, but we created only one!"
-- * Helpers
-- * Generators
-- | The workhorse of the test: generate an indexer, then generate
-- transactions to index, then index them.
liftIO $ forM_ events $ \event -> IO.modifyMVar_ indexerMVar (RI.insert $ MintBurn.MintBurnEvent event)
pure (indexerMVar, events, (bufferSize, nTx))
genTxWithMint :: C.TxMintValue C.BuildTx C.AlonzoEra -> Gen (Either C.TxBodyError (C.Tx C.AlonzoEra))
genTxWithMint txMintValue = do
txbc <- CGen.genTxBodyContent C.AlonzoEra
txIn <- CGen.genTxIn
pparams' :: C.ProtocolParameters <- CGen.genProtocolParameters
let
pparams = C.BuildTxWith $ Just pparams'
{ C.protocolParamUTxOCostPerWord = Just 1
, C.protocolParamPrices = Just $ C.ExecutionUnitPrices 1 1
, C.protocolParamMaxTxExUnits = Just $ C.ExecutionUnits 1 1
, C.protocolParamMaxBlockExUnits = Just $ C.ExecutionUnits 1 1
, C.protocolParamMaxValueSize = Just 1
, C.protocolParamCollateralPercent = Just 1
, C.protocolParamMaxCollateralInputs = Just 1
}
txbc' = txbc
{ C.txMintValue = txMintValue
, C.txInsCollateral = C.TxInsCollateral C.CollateralInAlonzoEra [txIn]
, C.txProtocolParams = pparams
}
pure $ do
txb <- C.makeTransactionBody txbc'
pure $ C.signShelleyTransaction txb []
-- | Helper to create tx with @[email protected], @[email protected] and @[email protected]
genTxWithAsset :: C.AssetName -> C.Quantity -> Gen (Either C.TxBodyError (C.Tx C.AlonzoEra))
genTxWithAsset assetName quantity = genTxWithMint $ C.TxMintValue C.MultiAssetInAlonzoEra mintedValues (C.BuildTxWith $ Map.singleton policyId policyWitness)
where (policyId, policyWitness, mintedValues) = mkMintValue commonMintingPolicy [(assetName, quantity)]
genTxMintValue :: Gen (C.TxMintValue C.BuildTx C.AlonzoEra)
genTxMintValue = do
n :: Int <- Gen.integral (Range.constant 1 5)
policyAssets <- replicateM n genAsset
let (policyId, policyWitness, mintedValues) = mkMintValue commonMintingPolicy policyAssets
pure $ C.TxMintValue C.MultiAssetInAlonzoEra mintedValues (C.BuildTxWith $ Map.singleton policyId policyWitness)
where
genAsset :: Gen (C.AssetName, C.Quantity)
genAsset = (,) <$> genAssetName <*> genQuantity
where
genAssetName = coerce @_ @C.AssetName <$> Gen.bytes (Range.constant 1 5)
genQuantity = coerce @Integer @C.Quantity <$> Gen.integral (Range.constant 1 100)
-- * Helpers
-- | Remove events that remained in buffer.
onlyPersisted :: Int -> [a] -> [a]
onlyPersisted bufferSize events = take (eventsPersisted bufferSize $ length events) $ events
mintedValues :: C.Value
mintedValues = C.valueFromList $ map (\(assetName, quantity) -> (C.AssetId policyId assetName, quantity)) policyAssets
genTxWithMint :: C.TxMintValue C.BuildTx C.AlonzoEra -> Gen (Either C.TxBodyError (C.Tx C.AlonzoEra))
genTxWithMint txMintValue = do
txbc <- CGen.genTxBodyContent C.AlonzoEra
txIn <- CGen.genTxIn
pparams' :: C.ProtocolParameters <- CGen.genProtocolParameters
let
pparams = C.BuildTxWith $ Just pparams'
{ C.protocolParamUTxOCostPerWord = Just 1
, C.protocolParamPrices = Just $ C.ExecutionUnitPrices 1 1
, C.protocolParamMaxTxExUnits = Just $ C.ExecutionUnits 1 1
, C.protocolParamMaxBlockExUnits = Just $ C.ExecutionUnits 1 1
, C.protocolParamMaxValueSize = Just 1
, C.protocolParamCollateralPercent = Just 1
, C.protocolParamMaxCollateralInputs = Just 1
}
txbc' = txbc
{ C.txMintValue = txMintValue
, C.txInsCollateral = C.TxInsCollateral C.CollateralInAlonzoEra [txIn]
, C.txProtocolParams = pparams
}
pure $ do
txb <- C.makeTransactionBody txbc'
pure $ C.signShelleyTransaction txb []
commonMintingPolicy :: PlutusV1.MintingPolicy
commonMintingPolicy = PlutusV1.mkMintingPolicyScript $$(PlutusTx.compile [||\_ _ -> ()||])
-- | Helper to create tx with @[email protected], @[email protected] and @[email protected]
genTxWithAsset :: C.AssetName -> C.Quantity -> Gen (Either C.TxBodyError (C.Tx C.AlonzoEra))
genTxWithAsset assetName quantity = genTxWithMint $ C.TxMintValue C.MultiAssetInAlonzoEra mintedValues (C.BuildTxWith $ Map.singleton policyId policyWitness)
where (policyId, policyWitness, mintedValues) = mkMintValue commonMintingPolicy [(assetName, quantity)]
-- | Recreate an indexe, useful because the sql connection to a
-- :memory: database can be reused.
mkNewIndexerBasedOnOldDb :: RI.State MintBurn.MintBurnHandle -> IO (RI.State MintBurn.MintBurnHandle)
equalSet :: (H.MonadTest m, Show a, Ord a) => [a] -> [a] -> m ()
equalSet a b = Set.fromList a === Set.fromList b
genTxMintValue :: Gen (C.TxMintValue C.BuildTx C.AlonzoEra)
genTxMintValue = do
n :: Int <- Gen.integral (Range.constant 1 5)
policyAssets <- replicateM n genAsset
let (policyId, policyWitness, mintedValues) = mkMintValue commonMintingPolicy policyAssets
pure $ C.TxMintValue C.MultiAssetInAlonzoEra mintedValues (C.BuildTxWith $ Map.singleton policyId policyWitness)
where
genAsset :: Gen (C.AssetName, C.Quantity)
genAsset = (,) <$> genAssetName <*> genQuantity
where
genAssetName = coerce @_ @C.AssetName <$> Gen.bytes (Range.constant 1 5)
genQuantity = coerce @Integer @C.Quantity <$> Gen.integral (Range.constant 1 100)
getPolicyAssets :: C.TxMintValue C.BuildTx C.AlonzoEra -> [(C.PolicyId, C.AssetName, C.Quantity)]
getPolicyAssets txMintValue = case txMintValue of
(C.TxMintValue C.MultiAssetInAlonzoEra mintedValues (C.BuildTxWith _policyIdToWitnessMap)) ->
This PR is to fix for the equivalent test criteria in marconi-chain-index unit tests. [PLT-1536]
- fix error: Class extends value undefined is not a constructor or null
4468: Backport fixes for 4465 to release/cardano-node-1.35.x branch r=coot a=coot # Description Cherry pick commits from #4467. # Checklist - Branch - [ ] Commit sequence broadly makes sense - [ ] Commits have useful messages - [ ] The documentation has been properly updated - [ ] New tests are added if needed and existing tests are updated - [ ] Any changes affecting Consensus packages must have an entry in the appropriate `changelog.d` directory created using [`scriv`](https://github.com/input-output-hk/scriv). If in doubt, see the [Consensus release process](../ouroboros-consensus/docs/ReleaseProcess.md). - [ ] Any changes in the Consensus API (every exposed function, type or module) that has changed its name, has been deleted, has been moved, or altered in some other significant way must leave behind a `DEPRECATED` warning that notifies downstream consumers. If deprecating a whole module, remember to add it to `./scripts/ci/check-stylish.sh` as otherwise `stylish-haskell` would un-deprecate it. - [ ] If this branch changes Network and has any consequences for downstream repositories or end users, said changes must be documented in [`interface-CHANGELOG.md`](../docs/interface-CHANGELOG.md) - [ ] If serialization changes, user-facing consequences (e.g. replay from genesis) are confirmed to be intentional. - Pull Request - [ ] Self-reviewed the diff - [ ] Useful pull request description at least containing the following information: - What does this PR change? - Why these changes were needed? - How does this affect downstream repositories and/or end-users? - Which ticket does this PR close (if any)? If it does, is it [linked](https://docs.github.com/en/issues/tracking-your-work-with-issues/linking-a-pull-request-to-an-issue)? - [ ] Reviewer requested Co-authored-by: Karl Knutsson <[email protected]> Co-authored-by: Marcin Szamotulski <[email protected]>
Make it an Either String Filepath so the left case signifies a builtin.
chore: document preview usage in readme
test: concurrent users metrics
Signed-off-by: Chris Gianelloni <[email protected]>
Co-authored-by: Michael Peyton Jones <[email protected]>