diff --git a/hydra-node/src/Hydra/Ledger/Cardano.hs b/hydra-node/src/Hydra/Ledger/Cardano.hs index d3ec18109bc..9e0bd3a715d 100644 --- a/hydra-node/src/Hydra/Ledger/Cardano.hs +++ b/hydra-node/src/Hydra/Ledger/Cardano.hs @@ -68,6 +68,7 @@ import qualified Data.Set as Set import qualified Data.Text as T import qualified Data.Text as Text import Data.Time.Clock.POSIX (posixSecondsToUTCTime) +import GHC.Records (getField) import Hydra.Ledger (Balance (..), Ledger (..), Tx (..), ValidationError (ValidationError)) import Hydra.Party (Party (Party), vkey) import Shelley.Spec.Ledger.API (Wdrl (Wdrl), unWdrl, _maxTxSize) @@ -165,9 +166,6 @@ genKeyPair = do sk <- fromJust . rawDeserialiseSignKeyDSIGN . fromList <$> vectorOf 64 arbitrary pure $ Cardano.KeyPair (Cardano.VKey (deriveVerKeyDSIGN sk)) sk -size :: Utxo CardanoTx -> Int -size = length . Cardano.unUTxO - -- Construct a simple transaction which spends a UTXO, to the given address, -- signed by the given key. mkSimpleCardanoTx :: @@ -532,6 +530,12 @@ instance FromJSONKey Cardano.AssetName where Left e -> fail $ "decoding base16: " <> show e Right bytes -> pure $ Cardano.AssetName bytes +genOutput :: Cardano.VKey 'Cardano.Payment StandardCrypto -> Gen TxOut +genOutput vk = + -- NOTE: Scaling a bit the generator to get non-trivial outputs with some + -- funds, and not just a few lovelaces. + Cardano.TxOut (mkVkAddress vk) <$> scale (* 8) arbitrary + --- --- Certificates --- @@ -582,14 +586,33 @@ genUtxoFor :: Cardano.VKey 'Cardano.Payment StandardCrypto -> Gen (Utxo CardanoT genUtxoFor vk = do n <- arbitrary `suchThat` (> 0) inputs <- vectorOf n arbitrary - outputs <- vectorOf n genOutput + outputs <- vectorOf n (genOutput vk) pure $ Cardano.UTxO $ Map.fromList $ zip inputs outputs - where - genOutput :: Gen TxOut - genOutput = - -- NOTE: Scaling a bit the generator to get non-trivial outputs with some - -- funds, and not just a few lovelaces. - Cardano.TxOut (mkVkAddress vk) <$> scale (* 8) arbitrary + +-- | Generate a single UTXO owned by 'vk'. +genOneUtxoFor :: Cardano.VKey 'Cardano.Payment StandardCrypto -> Gen (Utxo CardanoTx) +genOneUtxoFor vk = do + input <- arbitrary + -- NOTE(AB): calling this generator while running a property will yield larger and larger + -- values (quikcheck increases the 'size' parameter upon success) up to the point they are + -- too large to fit in a transaction and validation fails in the ledger + output <- scale (const 1) $ genOutput vk + pure $ Cardano.UTxO $ Map.singleton input output + +size :: Utxo CardanoTx -> Int +size = length . Cardano.unUTxO + +utxoToList :: Utxo CardanoTx -> [(TxIn, TxOut)] +utxoToList = Map.toList . Cardano.unUTxO + +utxoValue :: Utxo CardanoTx -> Cardano.Value StandardCrypto +utxoValue = mconcat . map (getField @"value") . Map.elems . Cardano.unUTxO + +utxoFromTx :: CardanoTx -> Utxo CardanoTx +utxoFromTx CardanoTx{id, body = (Cardano.TxBody _ outputs _ _ _ _ _ _ _)} = + let txOuts = toList outputs + txIns = map (Cardano.TxIn id) [0 .. fromIntegral (length txOuts)] + in Cardano.UTxO $ Map.fromList $ zip txIns txOuts -- -- Witnesses @@ -759,6 +782,9 @@ getAddress :: Party -> CardanoAddress getAddress = mkVkAddress . vKey . getCredentials +verificationKey :: Cardano.KeyPair r crypto -> Cardano.VKey r crypto +verificationKey = Cardano.vKey + -- | Generate a Utxo set for a given party "out of thin air". faucetUtxo :: Party -> Map TxIn TxOut faucetUtxo party@Party{vkey} = diff --git a/local-cluster/bench/Bench/EndToEnd.hs b/local-cluster/bench/Bench/EndToEnd.hs index e269d23bdc3..a8893819230 100644 --- a/local-cluster/bench/Bench/EndToEnd.hs +++ b/local-cluster/bench/Bench/EndToEnd.hs @@ -32,8 +32,9 @@ import Data.Scientific (Scientific) import Data.Set ((\\)) import qualified Data.Set as Set import Data.Time (nominalDiffTimeToSeconds) +import Hydra.Generator (Dataset (..)) import Hydra.Ledger (Tx, TxId, Utxo, txId) -import Hydra.Ledger.Cardano (CardanoTx, genFixedSizeSequenceOfValidTransactions, genUtxo) +import Hydra.Ledger.Cardano (CardanoTx) import Hydra.Logging (showLogsOnFailure) import Hydra.Party (deriveParty, generateKey) import HydraNode ( @@ -50,7 +51,6 @@ import HydraNode ( withNewClient, ) import System.FilePath (()) -import Test.QuickCheck (generate) import Text.Printf (printf) aliceSk, bobSk, carolSk :: SignKeyDSIGN MockDSIGN @@ -63,18 +63,6 @@ aliceVk = deriveVerKeyDSIGN aliceSk bobVk = deriveVerKeyDSIGN bobSk carolVk = deriveVerKeyDSIGN carolSk -data Dataset = Dataset - { initialUtxo :: Utxo CardanoTx - , transactionsSequence :: [CardanoTx] - } - deriving (Eq, Show, Generic, ToJSON, FromJSON) - -generateDataset :: Int -> IO Dataset -generateDataset sequenceLength = do - initialUtxo <- generate genUtxo - transactionsSequence <- generate $ genFixedSizeSequenceOfValidTransactions sequenceLength initialUtxo - pure Dataset{initialUtxo, transactionsSequence} - data Event = Event { submittedAt :: UTCTime , validAt :: Maybe UTCTime diff --git a/local-cluster/local-cluster.cabal b/local-cluster/local-cluster.cabal index 946da2a2504..46e59db2b0f 100644 --- a/local-cluster/local-cluster.cabal +++ b/local-cluster/local-cluster.cabal @@ -73,6 +73,7 @@ library exposed-modules: CardanoCluster CardanoNode + Hydra.Generator HydraNode build-depends: @@ -80,7 +81,9 @@ library , async , base >=4.7 && <5 , bytestring + , cardano-api , cardano-crypto-class + , containers , contra-tracer , directory , filepath @@ -93,6 +96,7 @@ library , iohk-monitoring , network , process + , QuickCheck , random-shuffle , retry , say @@ -126,6 +130,7 @@ test-suite integration other-modules: Spec Test.EndToEndSpec + Test.GeneratorSpec Test.LocalClusterSpec build-depends: @@ -144,10 +149,12 @@ test-suite integration , lens , lens-aeson , local-cluster + , QuickCheck , regex-tdfa , say , strict-containers , temporary + , text build-tool-depends: hspec-discover:hspec-discover -any, hydra-node:hydra-node -any, diff --git a/local-cluster/src/Hydra/Generator.hs b/local-cluster/src/Hydra/Generator.hs new file mode 100644 index 00000000000..63027aa2d65 --- /dev/null +++ b/local-cluster/src/Hydra/Generator.hs @@ -0,0 +1,70 @@ +{-# LANGUAGE DeriveAnyClass #-} +{-# LANGUAGE TypeApplications #-} + +module Hydra.Generator where + +import Hydra.Prelude hiding (size) + +import Control.Monad (foldM) +import qualified Data.List as List +import Hydra.Ledger (Utxo) +import Hydra.Ledger.Cardano ( + CardanoKeyPair, + CardanoTx, + genFixedSizeSequenceOfValidTransactions, + genKeyPair, + genOneUtxoFor, + genUtxo, + mkSimpleCardanoTx, + mkVkAddress, + utxoFromTx, + utxoToList, + utxoValue, + verificationKey, + ) +import Test.QuickCheck (Gen, generate) +import Test.QuickCheck.Gen (Gen (MkGen)) +import Test.QuickCheck.Random (mkQCGen) + +-- | A 'Dataset' that can be run for testing purpose. +-- The 'transactionSequence' is guaranteed to be applicable, in sequence, to the 'initialUtxo' +-- set. +data Dataset = Dataset + { initialUtxo :: Utxo CardanoTx + , transactionsSequence :: [CardanoTx] + } + deriving (Eq, Show, Generic, ToJSON, FromJSON) + +-- | Generate an arbitrary UTXO set and a sequence of transactions for this set. +generateDataset :: Int -> IO Dataset +generateDataset sequenceLength = do + initialUtxo <- generate genUtxo + transactionsSequence <- generate $ genFixedSizeSequenceOfValidTransactions sequenceLength initialUtxo + pure Dataset{initialUtxo, transactionsSequence} + +-- | Generate a 'Dataset' which does not grow the UTXO set over time. +generateConstantUtxoDataset :: Int -> IO Dataset +generateConstantUtxoDataset = generate . genConstantUtxoDataset + +genConstantUtxoDataset :: Int -> Gen Dataset +genConstantUtxoDataset len = do + keyPair <- genKeyPair + initialUtxo <- genOneUtxoFor (verificationKey keyPair) + + transactionsSequence <- reverse . thrd <$> foldM generateOneTransfer (initialUtxo, keyPair, []) [1 .. len] + pure $ Dataset{initialUtxo, transactionsSequence} + where + thrd (_, _, c) = c + generateOneTransfer (utxo, keyPair, txs) _ = do + recipient <- genKeyPair + let txin = List.head $ utxoToList utxo + tx = mkSimpleCardanoTx txin (mkVkAddress (verificationKey recipient), utxoValue utxo) keyPair + utxo' = utxoFromTx tx + pure $ (utxo', recipient, tx : txs) + +mkCredentials :: Int -> CardanoKeyPair +mkCredentials = generateWith genKeyPair + +generateWith :: Gen a -> Int -> a +generateWith (MkGen runGen) seed = + runGen (mkQCGen seed) 30 diff --git a/local-cluster/test/Test/GeneratorSpec.hs b/local-cluster/test/Test/GeneratorSpec.hs new file mode 100644 index 00000000000..2dc100657e6 --- /dev/null +++ b/local-cluster/test/Test/GeneratorSpec.hs @@ -0,0 +1,54 @@ +{-# OPTIONS_GHC -Wno-deprecations #-} +{-# OPTIONS_GHC -Wno-incomplete-uni-patterns #-} + +module Test.GeneratorSpec where + +import Hydra.Prelude +import Test.Hydra.Prelude + +import Data.Aeson (eitherDecode, encode) +import qualified Data.ByteString.Lazy as LBS +import Data.Text (unpack) +import Hydra.Generator (Dataset (..), genConstantUtxoDataset) +import Hydra.Ledger (Utxo, applyTransactions) +import Hydra.Ledger.Cardano as Ledger +import Test.QuickCheck (Positive (Positive), Property, counterexample, forAll) + +spec :: Spec +spec = parallel $ do + prop "compute values from UTXO set" prop_computeValueFromUtxo + prop "generates a Dataset that keeps UTXO constant" prop_keepsUtxoConstant + it "correctly applies generated dataset" $ do + let result = eitherDecode sample + case result of + Left err -> failure $ show err + Right Dataset{initialUtxo, transactionsSequence} -> do + let finalUtxo = foldl' apply initialUtxo transactionsSequence + + Ledger.size finalUtxo `shouldBe` Ledger.size initialUtxo + +sample :: LBS.ByteString +sample = "{\"initialUtxo\":{\"03170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c111314#355\":{\"address\":\"addr_test1vp5thrqjwutvmyuv7z29m4d89m920hx0esa4k62v3sn69vq6wd4s9\",\"value\":{\"lovelace\":1}}},\"transactionsSequence\":[{\"witnesses\":{\"scripts\":{},\"keys\":[\"820082582081822e271db8f620bd5114ea5ab6230893f2a4023dcbc22af4534dc57aaa6c57584013c7f57c39b2496c4f1394cb72f9e2dd8c1c09cbf91002c0084a9444430b7cf531e2e9faf412a8a7eed984d8af2df06aa4cd0d78127ca753bb827f9a313cbb03\"]},\"body\":{\"outputs\":[{\"address\":\"addr_test1vzfngrkamuwyl4l7c0a7hmvgw6c8n23cpxgvte0a9jrnvts47xzsz\",\"value\":{\"lovelace\":1}}],\"mint\":{\"lovelace\":0},\"auxiliaryDataHash\":null,\"withdrawals\":[],\"certificates\":[],\"fees\":0,\"inputs\":[\"03170a2e7597b7b7e3d84c05391d139a62b157e78786d8c082f29dcf4c111314#355\"],\"validity\":{\"notBefore\":null,\"notAfter\":null}},\"id\":\"45d2b14e693c054e5263c9cd21fb7425c71fec21d800dff55e26e0ede4257ef0\",\"auxiliaryData\":null},{\"witnesses\":{\"scripts\":{},\"keys\":[\"8200825820639edbce929ccafb73bc1bdf9b9cc909895c91a92607c245a36008d989a8194a584043ffeb945ed3d01a2119b7b0ddaeab60b9b8c6c7eb068542ac6c274ae8519fc4c48b7e642120618b926ae74f599c9aeba64d274a41ed0fd6a5ce355a4ebeab0d\"]},\"body\":{\"outputs\":[{\"address\":\"addr_test1vr8x79xestxpf6zr9699h6wcp9gdlrs3mf0fgrznz4akylgzvg0ra\",\"value\":{\"lovelace\":1}}],\"mint\":{\"lovelace\":0},\"auxiliaryDataHash\":null,\"withdrawals\":[],\"certificates\":[],\"fees\":0,\"inputs\":[\"45d2b14e693c054e5263c9cd21fb7425c71fec21d800dff55e26e0ede4257ef0#0\"],\"validity\":{\"notBefore\":null,\"notAfter\":null}},\"id\":\"0f454f74df9f83e5b604570d87b1c44d9aeb3ed745dbc560242568d193ac5620\",\"auxiliaryData\":null}]}" + +prop_computeValueFromUtxo :: Property +prop_computeValueFromUtxo = + forAll genUtxo $ \utxo -> + utxoValue utxo /= mempty + +prop_keepsUtxoConstant :: Property +prop_keepsUtxoConstant = + forAll arbitrary $ \(Positive n) -> + forAll (genConstantUtxoDataset n) $ \Dataset{initialUtxo, transactionsSequence} -> + let finalUtxo = foldl' apply initialUtxo transactionsSequence + in Ledger.size finalUtxo == Ledger.size initialUtxo + & counterexample ("\ntransactions: " <> jsonString transactionsSequence) + & counterexample ("\nutxo: " <> jsonString initialUtxo) + +apply :: Utxo CardanoTx -> CardanoTx -> Utxo CardanoTx +apply utxo tx = + case applyTransactions Ledger.cardanoLedger utxo [tx] of + Left err -> error $ "invalid generated data set" <> show err + Right finalUtxo -> finalUtxo + +jsonString :: ToJSON a => a -> String +jsonString = unpack . decodeUtf8 . encode