fixup! Add MintBurn tests
Generate the endToEnd mints instead of hardcoding them.
Generate the endToEnd mints instead of hardcoding them.
import Control.Concurrent.STM qualified as IO
import Control.Exception (catch)
import Control.Lens qualified as Lens
import Control.Monad (forM, forM_, replicateM, void)
import Control.Monad (foldM, forM, forM_, replicateM, void)
import Control.Monad.IO.Class (liftIO)
import Data.ByteString.Lazy qualified as LBS
import Data.ByteString.Short qualified as SBS
import Data.Coerce (coerce)
import Data.List.NonEmpty (NonEmpty ((:|)))
import Data.List.NonEmpty qualified as NonEmpty
import Data.Map qualified as Map
import Data.Maybe (mapMaybe)
import Data.Set qualified as Set
-- | Create transactions, index them, query indexer and find mint events.
queryMintedValues :: Property
queryMintedValues = H.property $ do
(indexerMVar, insertedEvents, _) <- generateAndIndexEvents ":memory:"
(indexer, insertedEvents, _) <- generateAndIndexEvents ":memory:"
-- Query results:
indexer <- liftIO $ IO.readMVar indexerMVar
MintBurn.MintBurnResult queryResult <- liftIO $ RI.query RI.QEverything indexer MintBurn.Everything
-- Compare the sets of events inserted to the indexer and the set
-- gotten out of the indexer:
resume :: Property
resume = H.property $ do
-- Index events that overflow:
(indexerMVar, events, (bufferSize, nTx)) <- generateAndIndexEvents ":memory:"
(indexer, events, (bufferSize, nTx)) <- generateAndIndexEvents ":memory:"
-- Open a new indexer based off of the old indexers sql connection:
indexer <- liftIO $ mkNewIndexerBasedOnOldDb =<< IO.readMVar indexerMVar
MintBurn.MintBurnResult queryResult <- liftIO $ RI.query RI.QEverything indexer MintBurn.Everything
indexer' <- liftIO $ mkNewIndexerBasedOnOldDb indexer
MintBurn.MintBurnResult queryResult <- liftIO $ RI.query RI.QEverything indexer' MintBurn.Everything
let expected = MintBurn.groupBySlotNo $ take (eventsPersisted bufferSize (length events)) events
-- Report buffer overflow:
let overflow = bufferSize < nTx
-- than rollback point in query.
rewind :: Property
rewind = H.property $ do
(indexerMVar, events, (_bufferSize, nTx)) <- generateAndIndexEvents ":memory:"
(indexer, events, (_bufferSize, nTx)) <- generateAndIndexEvents ":memory:"
-- Rollback slot is from 0 to number of slots (slot numbers are from 0 to nTx - 1)
rollbackSlotNo <- fmap coerce $ forAll $ Gen.integral $ Range.constant 0 ((let w64 = fromIntegral nTx in if w64 == 0 then 0 else w64 - 1) :: Word64)
indexer <- liftIO $ IO.readMVar indexerMVar
let cp = C.ChainPoint rollbackSlotNo dummyBlockHeaderHash
rewoundIndexer <- let errMsg = "Failed to rewind! This shouldn't happen and the test should be fixed"
in maybe (fail errMsg) pure =<< liftIO (RI.rewind cp indexer)
-- mint event, put it in a transaction and submit it, find the
-- generated event passed back through the indexer.
endToEnd :: Property
endToEnd = H.integration $ (liftIO TN.setDarwinTmpdir >>) $ HE.runFinallies $ H.workspace "." $ \tempPath -> do
endToEnd = H.withShrinks 0 $ H.integration $ (liftIO TN.setDarwinTmpdir >>) $ HE.runFinallies $ H.workspace "." $ \tempPath -> do
base <- HE.noteM $ liftIO . IO.canonicalizePath =<< HE.getProjectBase
(localNodeConnectInfo, conf, runtime) <- TN.startTestnet TN.defaultTestnetOptions base tempPath
let networkId = TN.getNetworkId runtime
-- Create & submit transaction
pparams <- TN.getAlonzoProtocolParams localNodeConnectInfo
let assetName = "asset" :: C.AssetName
quantity = 1 :: C.Quantity
(policyId, policyWitness, mintedValues) = mkMintValue commonMintingPolicy [(assetName, quantity)]
mintValue = C.TxMintValue C.MultiAssetInAlonzoEra mintedValues (C.BuildTxWith $ Map.singleton policyId policyWitness)
txMintValue <- forAll genTxMintValue
genesisVKey :: C.VerificationKey C.GenesisUTxOKey <- TN.readAs (C.AsVerificationKey C.AsGenesisUTxOKey) $ tempPath </> "shelley/utxo-keys/utxo1.vkey"
genesisSKey :: C.SigningKey C.GenesisUTxOKey <- TN.readAs (C.AsSigningKey C.AsGenesisUTxOKey) $ tempPath </> "shelley/utxo-keys/utxo1.skey"
txOut =
C.TxOut
(C.AddressInEra (C.ShelleyAddressInEra C.ShelleyBasedEraAlonzo) address)
(C.TxOutValue C.MultiAssetInAlonzoEra $ C.lovelaceToValue amountReturned <> mintedValues)
(C.TxOutValue C.MultiAssetInAlonzoEra $ C.lovelaceToValue amountReturned <> getValue txMintValue)
C.TxOutDatumNone
C.ReferenceScriptNone
txBodyContent :: C.TxBodyContent C.BuildTx C.AlonzoEra
txBodyContent = (TN.emptyTxBodyContent fee pparams)
{ C.txIns = map (\txIn -> (txIn, C.BuildTxWith $ C.KeyWitness C.KeyWitnessForSpending)) txIns
, C.txOuts = [txOut]
, C.txProtocolParams = C.BuildTxWith $ Just pparams
, C.txMintValue = mintValue
, C.txMintValue = txMintValue
, C.txInsCollateral = C.TxInsCollateral C.CollateralInAlonzoEra txIns
}
txBody :: C.TxBody C.AlonzoEra <- H.leftFail $ C.makeTransactionBody txBodyContent
-- Receive event from the indexer, compare the mint that we
-- submitted above with the one we got from the indexer.
event <- liftIO $ IO.readChan indexedTxs
H.footnoteShow event
case MintBurn.txMintEventTxAssets event of
(_txId, ma :| []) :| [] -> let
MintBurn.MintAsset policyId' assetName' quantity' _redeemerIx' _redeemerData' = ma
in do
policyId' === policyId
assetName' === assetName
quantity' === quantity
(_txId, gottenMintEvents :: NonEmpty MintBurn.MintAsset) :| [] -> let
in equalSet (mintsToPolicyAssets $ NonEmpty.toList gottenMintEvents) (getPolicyAssets txMintValue)
_ -> fail "More than one mint/burn event, but we created only one!"
-- * Generators
-- | The workhorse of the test: generate an indexer, then generate
-- transactions to index, then index them.
generateAndIndexEvents :: FilePath -> H.PropertyT IO (IO.MVar MintBurn.MintBurnIndexer, [MintBurn.TxMintEvent], (Int, Int))
generateAndIndexEvents :: FilePath -> H.PropertyT IO (MintBurn.MintBurnIndexer, [MintBurn.TxMintEvent], (Int, Int))
generateAndIndexEvents dbPath = do
bufferSize <- forAll $ Gen.integral (Range.constant 1 10)
nTx <- forAll $ Gen.choice -- Number of events:
(events, (bufferSize, nTx)) <- forAll generateEvents
indexer <- liftIO $ do
indexer <- MintBurn.open dbPath bufferSize
foldM (\indexer' event -> RI.insert (MintBurn.MintBurnEvent event) indexer') indexer events
pure (indexer, events, (bufferSize, nTx))
generateEvents :: Gen ([MintBurn.TxMintEvent], (Int, Int))
generateEvents = do
bufferSize <- Gen.integral (Range.constant 1 10)
nTx <- Gen.choice -- Number of events:
[ Gen.constant 0 -- 1. no events generated
, Gen.integral $ Range.constant 0 bufferSize -- 2. buffer not filled
, Gen.integral $ Range.constant (bufferSize + 1) (bufferSize * 2) -- 3. guaranteed buffer overflow
]
-- Generate transactions
txAll' <- forAll $ forM [0 .. (nTx - 1)] $ \slotNoInt -> do
txAll' <- forM [0 .. (nTx - 1)] $ \slotNoInt -> do
tx <- genTxWithMint =<< genTxMintValue
pure (tx, fromIntegral slotNoInt :: C.SlotNo)
-- Filter out Left C.TxBodyError
txAll <- forM txAll' $ \case
(Right tx, slotNo) -> pure (tx, slotNo)
(Left txBodyError, _) -> fail $ "Failed to create a transaction! This shouldn't happen, the generator should be fixed. TxBodyError: " <> show txBodyError
-- Create indexer, convert transactions into indexer events, insert
-- these to the indexer, and also return the events:
indexerMVar <- liftIO $ IO.newMVar =<< MintBurn.open dbPath bufferSize
let events = mapMaybe (\(tx, slotNo) -> MintBurn.TxMintEvent slotNo dummyBlockHeaderHash . pure <$> MintBurn.txMints tx) txAll
liftIO $ forM_ events $ \event -> IO.modifyMVar_ indexerMVar (RI.insert $ MintBurn.MintBurnEvent event)
pure (indexerMVar, events, (bufferSize, nTx))
pure (events, (bufferSize, nTx))
genTxWithMint :: C.TxMintValue C.BuildTx C.AlonzoEra -> Gen (Either C.TxBodyError (C.Tx C.AlonzoEra))
genTxWithMint txMintValue = do
C.AdaAssetId -> Nothing
) $ C.valueToList mintedValues
_ -> []
getValue :: C.TxMintValue C.BuildTx C.AlonzoEra -> C.Value
getValue (C.TxMintValue C.MultiAssetInAlonzoEra value (C.BuildTxWith _policyIdToWitnessMap)) = value
mintsToPolicyAssets :: [MintBurn.MintAsset] -> [(C.PolicyId, C.AssetName, C.Quantity)]
mintsToPolicyAssets mints =
map (\mint -> (MintBurn.mintAssetPolicyId mint, MintBurn.mintAssetAssetName mint, MintBurn.mintAssetQuantity mint)) mints
Somehow, the previous constraints set failed building ouroboros-consensus. Pinning unix-bytestring seems to solve the problem.
Somehow, the previous constraints set failed building ouroboros-consensus. Pinning unix-bytestring seems to solve the problem.
Somehow, the previous constraints set failed building ouroboros-consensus. Pinning unix-bytestring seems to solve the problem.
Signed-off-by: Chris Gianelloni <[email protected]>
- Update readme to address issues and questions presented by CPS-0001 - Update CDDL to support a more flexible scoping structure for future expansion