Add generator for constant UTXO set

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} =

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

local-cluster/local-cluster.cabal

@@ -73,14 +73,17 @@ library
   exposed-modules:
     CardanoCluster
     CardanoNode
+    Hydra.Generator
     HydraNode
 
   build-depends:
     , aeson
     , 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,

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

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