Added the rest of the property tests

Cleaned up the code. Alonzo tests now run the property tests. ormolised

alonzo/impl/src/Cardano/Ledger/Alonzo/Rules/Utxo.hs

@@ -183,7 +183,7 @@ data UtxoPredicateFailure era
     OutputBootAddrAttrsTooBig
       ![Core.TxOut era]
   | TriesToForgeADA
-  | -- | list of supplied bad transaction outputs
+  | -- | list of supplied bad transaction output triples (actualSize,PParameterMaxValue,TxOut)
     OutputTooBigUTxO
       ![(Int, Int, Core.TxOut era)]
   | InsufficientCollateral

alonzo/test/lib/Test/Cardano/Ledger/Alonzo/AlonzoEraGen.hs

@@ -174,7 +174,8 @@ genAlonzoPParamsDelta constants pp = do
   price <- genM (Prices <$> (Coin <$> choose (100, 5000)) <*> (Coin <$> choose (100, 5000)))
   mxTx <- genM (ExUnits <$> (choose (100, 5000)) <*> (choose (100, 5000)))
   mxBl <- genM (ExUnits <$> (choose (100, 5000)) <*> (choose (100, 5000)))
-  mxV <- genM (genNatural 4000 5000) -- Not too small
+  mxV <- genM (genNatural 4000 5000) -- Not too small, if this is too small then any Tx with Value
+  -- that has lots of policyIds will fail. The Shelley Era uses hard coded 4000
   let c = SJust 150
       mxC = SJust 10
   pure (Alonzo.extendPP shelleypp ada cost price mxTx mxBl mxV c mxC)
@@ -190,7 +191,7 @@ genAlonzoPParams constants = do
   price <- (Prices <$> (Coin <$> choose (100, 5000)) <*> (Coin <$> choose (100, 5000)))
   mxTx <- (ExUnits <$> (choose (100, 5000)) <*> (choose (100, 5000)))
   mxBl <- (ExUnits <$> (choose (100, 5000)) <*> (choose (100, 5000)))
-  mxV <- pure 10000 -- (genNatural 10000 50000) -- This can't be too small
+  mxV <- (genNatural 4000 10000) -- This can't be too small. Shelley uses Hard coded 4000
   let c = 150
       mxC = 10
   pure (Alonzo.extendPP shelleypp ada cost price mxTx mxBl mxV c mxC)

alonzo/test/test/Test/Cardano/Ledger/Alonzo/Trials.hs

@@ -4,68 +4,66 @@
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
-{-# OPTIONS_GHC -fno-warn-missing-signatures #-}
+-- Embed instances for (AlonzoEra TestCrypto)
 {-# OPTIONS_GHC -fno-warn-orphans #-}
-{-# OPTIONS_GHC -fno-warn-unused-binds #-}
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}
 
-module Test.Cardano.Ledger.Alonzo.Trials where
+module Test.Cardano.Ledger.Alonzo.Trials
+  ( alonzoPropertyTests,
+    genstuff,
+    genAlonzoTx,
+    genShelleyTx,
+    genAlonzoBlock,
+    genShelleyBlock,
+    adaPreservationChain,
+    collisionFreeComplete,
+    delegProperties,
+    minimalPropertyTests,
+    onlyValidChainSignalsAreGenerated,
+    onlyValidLedgerSignalsAreGenerated,
+    poolProperties,
+    propCompactAddrRoundTrip,
+    propCompactSerializationAgree,
+    propDecompactAddrLazy,
+    propDecompactShelleyLazyAddr,
+    propertyTests,
+    relevantCasesAreCovered,
+    removedAfterPoolreap,
+    go,
+    payscript,
+    stakescript,
+    scripts,
+  )
+where
 
-import Cardano.Ledger.Allegra (AllegraEra)
 import Cardano.Ledger.Alonzo (AlonzoEra)
-import Cardano.Ledger.Alonzo.PParams (PParams, PParams' (..), PParamsUpdate)
+import Cardano.Ledger.Alonzo.PParams (PParams' (..))
 import Cardano.Ledger.Alonzo.Rules.Bbody (AlonzoBBODY)
 import Cardano.Ledger.Alonzo.Rules.Utxow (AlonzoUTXOW)
-import Cardano.Ledger.Alonzo.Scripts (Script (..), ppScript)
+import Cardano.Ledger.Alonzo.Scripts (ppScript)
 import Cardano.Ledger.Coin (Coin (..))
 import qualified Cardano.Ledger.Core as Core
-import qualified Cardano.Ledger.Crypto as CC (Crypto)
 import Cardano.Ledger.Era (Era (Crypto))
-import Cardano.Ledger.Mary (MaryEra)
-import Cardano.Ledger.Pretty (PDoc, PrettyA (prettyA))
+import Cardano.Ledger.Pretty (PDoc)
 import Cardano.Ledger.Shelley (ShelleyEra)
-import Cardano.Ledger.Shelley.Constraints (UsesTxBody, UsesTxOut)
 import Cardano.Slotting.Slot (SlotNo (..))
 import Control.State.Transition.Extended (Embed (..), IRC (..), STS (..))
-import Control.State.Transition.Trace.Generator.QuickCheck (HasTrace, forAllTraceFromInitState)
 import Data.Default.Class (Default (def))
 import qualified Data.Map as Map
 import Data.Proxy (Proxy (..))
-import GHC.Natural
-import Shelley.Spec.Ledger.API (ApplyBlock)
-import Shelley.Spec.Ledger.API.Protocol (GetLedgerView)
-import Shelley.Spec.Ledger.API.Validation (ApplyBlock)
+import Shelley.Spec.Ledger.BlockChain (Block)
 import Shelley.Spec.Ledger.LedgerState (AccountState (..), DPState (..), DState, EpochState (..), LedgerState (..), NewEpochState (..), PState, UTxOState)
 import Shelley.Spec.Ledger.PParams (PParams' (..))
-import Shelley.Spec.Ledger.STS.Chain (CHAIN, ChainPredicateFailure (..), ChainState (..), initialShelleyState)
+import Shelley.Spec.Ledger.STS.Chain (CHAIN, ChainPredicateFailure (..), ChainState (..))
 import Shelley.Spec.Ledger.STS.Ledger (LEDGER, LedgerEnv (..), LedgerPredicateFailure (UtxowFailure))
 import Test.Cardano.Ledger.Alonzo.AlonzoEraGen ()
-import Test.Cardano.Ledger.Alonzo.Examples.Utxow (plutusScriptExamples, utxowExamples)
-import Test.Cardano.Ledger.Alonzo.Golden as Golden
-import qualified Test.Cardano.Ledger.Alonzo.Serialisation.CDDL as CDDL
-import qualified Test.Cardano.Ledger.Alonzo.Serialisation.Tripping as Tripping
-import qualified Test.Cardano.Ledger.Alonzo.Translation as Translation
 import Test.Cardano.Ledger.EraBuffet (TestCrypto)
-import Test.QuickCheck
-import Test.QuickCheck.Random (mkQCGen)
-import Test.Shelley.Spec.Ledger.ConcreteCryptoTypes (Mock)
 import Test.Shelley.Spec.Ledger.Generator.Block (genBlock)
 import Test.Shelley.Spec.Ledger.Generator.Constants (Constants (..))
-import Test.Shelley.Spec.Ledger.Generator.Core (GenEnv (..), KeySpace (..), mkBlock)
-import Test.Shelley.Spec.Ledger.Generator.EraGen
-  ( EraGen (..),
-    genEraAuxiliaryData,
-    genEraPParamsDelta,
-    genEraTxBody,
-    genGenesisValue,
-    genUtxo0,
-    updateEraTxBody,
-  )
-import Test.Shelley.Spec.Ledger.Generator.Presets (genEnv, genesisDelegs0)
-import Test.Shelley.Spec.Ledger.Generator.ScriptClass (ScriptClass (..), baseScripts, keyPairs, mkScriptsFromKeyPair, someScripts)
+import Test.Shelley.Spec.Ledger.Generator.Core (GenEnv (..), KeySpace (..))
+import Test.Shelley.Spec.Ledger.Generator.EraGen (EraGen (..))
+import Test.Shelley.Spec.Ledger.Generator.Presets (genEnv)
 import Test.Shelley.Spec.Ledger.Generator.ShelleyEraGen ()
-import Test.Shelley.Spec.Ledger.Generator.Trace.Chain (mkGenesisChainState, registerGenesisStaking)
-import Test.Shelley.Spec.Ledger.Generator.Trace.Ledger (genAccountState, mkGenesisLedgerState)
+import Test.Shelley.Spec.Ledger.Generator.Trace.Chain (mkGenesisChainState)
 import Test.Shelley.Spec.Ledger.Generator.Utxo (genTx)
 import Test.Shelley.Spec.Ledger.PropertyTests
   ( adaPreservationChain,
@@ -83,40 +81,16 @@ import Test.Shelley.Spec.Ledger.PropertyTests
     relevantCasesAreCovered,
     removedAfterPoolreap,
   )
-import Test.Shelley.Spec.Ledger.Rules.TestChain
-  ( adaPreservationChain,
-    collisionFreeComplete,
-    delegProperties,
-    forAllChainTrace,
-    poolProperties,
-    removedAfterPoolreap,
-  )
-import Test.Shelley.Spec.Ledger.Utils
-  ( ChainProperty,
-    maxLLSupply,
-    mkHash,
-    testGlobals,
-  )
 import Test.Tasty
 import Test.Tasty.QuickCheck
 
-kps = take 10 $ keyPairs @TestCrypto (geConstants ag)
-
-pretty :: PrettyA x => x -> PDoc
-pretty = prettyA
-
-ppS = ppScript
+-- ========================================================
 
-ledgerEnv :: forall era. (Default (Core.PParams era)) => LedgerEnv era
-ledgerEnv = LedgerEnv (SlotNo 0) 0 def (AccountState (Coin 0) (Coin 0))
-
-baz = genTx ag ledgerEnv
-
-ap :: Proxy (AlonzoEra TestCrypto)
-ap = Proxy @(AlonzoEra TestCrypto)
+instance Embed (AlonzoBBODY (AlonzoEra TestCrypto)) (CHAIN (AlonzoEra TestCrypto)) where
+  wrapFailed = BbodyFailure
 
-ag :: GenEnv (AlonzoEra TestCrypto)
-ag = genEnv ap
+instance Embed (AlonzoUTXOW (AlonzoEra TestCrypto)) (LEDGER (AlonzoEra TestCrypto)) where
+  wrapFailed = UtxowFailure
 
 genstuff ::
   (EraGen era, Default (State (Core.EraRule "PPUP" era))) =>
@@ -151,100 +125,70 @@ genstuff proxy f =
             pstate = _pstate dpstate
          in (f genenv chainstate newepochstate epochstate ledgerstate pparams utxostate dpstate dstate pstate)
 
+-- ======================================================================
+-- The following genXXX let one observe example generated XXX things
+-- these are very usefull to visualize what the the EraGen instances are doing.
+
+ap :: Proxy (AlonzoEra TestCrypto)
+ap = Proxy @(AlonzoEra TestCrypto)
+
+ledgerEnv :: forall era. Default (Core.PParams era) => LedgerEnv era
+ledgerEnv = LedgerEnv (SlotNo 0) 0 def (AccountState (Coin 0) (Coin 0))
+
+genAlonzoTx :: Gen (Core.Tx (AlonzoEra TestCrypto))
 genAlonzoTx = genstuff ap (\genv _cs _nep _ep _ls _pp utxo dp _d _p -> genTx genv ledgerEnv (utxo, dp))
 
+genAlonzoBlock :: Gen (Block (AlonzoEra TestCrypto))
+genAlonzoBlock = genstuff ap (\genv cs _nep _ep _ls _pp _utxo _dp _d _p -> genBlock genv cs)
+
+genShelleyTx :: Gen (Core.Tx (ShelleyEra TestCrypto))
 genShelleyTx =
   genstuff
     (Proxy @(ShelleyEra TestCrypto))
     (\genv _cs _nep _ep _ls _pp utxo dp _d _p -> genTx genv ledgerEnv (utxo, dp))
 
-genAlonzoBlock = genstuff ap (\genv cs _nep _ep _ls _pp _utxo _dp _d _p -> genBlock genv cs)
-
+genShelleyBlock :: Gen (Block (ShelleyEra TestCrypto))
 genShelleyBlock = genstuff (Proxy @(ShelleyEra TestCrypto)) (\genv cs _nep _ep _ls _pp _utxo _dp _d _p -> genBlock genv cs)
 
-foo = do
-  either' <- mkGenesisChainState (genEnv ap) (IRC ())
-  case either' of
-    Left _z -> error ("OOPS")
-    Right chainstate ->
-      let newepochstate = chainNes chainstate
-          epochstate = nesEs newepochstate
-          ledgerstate = esLState epochstate
-          pparams = esPp epochstate
-          utxostate = _utxoState ledgerstate
-          dpstate = _delegationState ledgerstate
-          dstate = _dstate dpstate
-          pstate = _pstate dpstate
-       in pure chainstate
-
-chain = generate foo
-
-env@(GenEnv keys constants) = genEnv (Proxy @(AlonzoEra TestCrypto))
+-- ==================================================================================================
+-- Scripts are generated when we call genEnv. They are stored fields inside the GenEnv structure.
+-- scripts, payscript, and stakescript let one observe the 'nth' generated script. Very usefull
+-- when debugging a Scriptic instance.
+
+keys :: KeySpace (AlonzoEra TestCrypto)
+_constants :: Constants
+(GenEnv keys _constants) = genEnv (Proxy @(AlonzoEra TestCrypto))
 
 -- in scripts n ranges over [0..149]
-scripts n = (\(x, y) -> (ppS x, ppS y)) ((ksMSigScripts keys) !! n)
+scripts :: Int -> (PDoc, PDoc)
+scripts n = (\(x, y) -> (ppScript x, ppScript y)) ((ksMSigScripts keys) !! n)
 
 -- in payscript and stakescript n ranges over [0..29]
-payscript n = (\(x, (y, _z)) -> (show x, ppS y)) ((Map.toList (ksIndexedPayScripts keys)) !! n)
-
-stakescript n = (\(x, (y, _z)) -> (show x, ppS y)) ((Map.toList (ksIndexedStakeScripts keys)) !! n)
-
-test = defaultMain (minimalPropertyTests @AT)
-
-bar = do cs <- foo; genBlock ag cs
-
-acs = mkGenesisChainState ag
+payscript :: Int -> (String, PDoc)
+payscript n = (\(x, (y, _z)) -> (show x, ppScript y)) ((Map.toList (ksIndexedPayScripts keys)) !! n)
 
-als = mkGenesisLedgerState ag
-
-instance Embed (AlonzoBBODY (AlonzoEra TestCrypto)) (CHAIN (AlonzoEra TestCrypto)) where
-  wrapFailed = BbodyFailure
-
-instance Embed (AlonzoUTXOW (AlonzoEra TestCrypto)) (LEDGER (AlonzoEra TestCrypto)) where
-  wrapFailed = UtxowFailure
+stakescript :: Int -> (String, PDoc)
+stakescript n = (\(x, (y, _z)) -> (show x, ppScript y)) ((Map.toList (ksIndexedStakeScripts keys)) !! n)
 
 -- ====================================================================================
 
-tests :: TestTree
-tests =
-  testGroup
-    "Alonzo tests"
-    [ Tripping.tests,
-      Translation.tests,
-      CDDL.tests 5,
-      Golden.goldenUTxOEntryMinAda,
-      plutusScriptExamples,
-      utxowExamples
-    ]
+delegTest :: TestTree
+delegTest = localOption (QuickCheckReplay (Just 6)) (testProperty "Delegation Properties" (delegProperties @(AlonzoEra TestCrypto)))
 
-{-
-alonzoProperty = testGroup
-    "Alonzo minimal property tests"
-    [ minimalPropertyTests @(AlonzoEra TestCrypto)
+alonzoPropertyTests :: TestTree
+alonzoPropertyTests =
+  testGroup
+    "Alonzo property tests"
+    [ delegTest,
+      minimalPropertyTests @(AlonzoEra TestCrypto)
     ]
--}
-
-type AT = AlonzoEra TestCrypto
-
-type T = TestCrypto
-
-main :: IO ()
-main = defaultMain tests
-
-cgen = mkQCGen 174256
-
--- 174256 on 23 try
--- 2 fails on 5 try
--- 6 fails on 1st try
 
+go :: IO ()
 go =
   defaultMain
     ( localOption
         (QuickCheckReplay (Just 6))
-        (testProperty "ADA" $ adaPreservationChain @(AlonzoEra TestCrypto))
+        -- (testProperty "preserves ADA" $ adaPreservationChain @(AlonzoEra TestCrypto))
+        -- (propertyTests  @(AlonzoEra TestCrypto))
+        (testProperty "Delegation Properties" (delegProperties @(AlonzoEra TestCrypto)))
     )
-
-maxvalsize :: Natural
-maxvalsize = 10000
-
-testPropertyAdaPreservation = (testProperty "Property test preserves ADA" $ adaPreservationChain @(AlonzoEra TestCrypto))

alonzo/test/test/Tests.hs

@@ -19,7 +19,7 @@ import Test.Cardano.Ledger.Alonzo.Golden as Golden
 import qualified Test.Cardano.Ledger.Alonzo.Serialisation.CDDL as CDDL
 import qualified Test.Cardano.Ledger.Alonzo.Serialisation.Tripping as Tripping
 import qualified Test.Cardano.Ledger.Alonzo.Translation as Translation
-import Test.Cardano.Ledger.Alonzo.Trials (testPropertyAdaPreservation)
+import Test.Cardano.Ledger.Alonzo.Trials (alonzoPropertyTests)
 import Test.Cardano.Ledger.EraBuffet (TestCrypto)
 import Test.QuickCheck
 import Test.Shelley.Spec.Ledger.Generator.Constants (Constants (..))
@@ -46,9 +46,7 @@ tests :: TestTree
 tests =
   testGroup
     "Alonzo tests"
-    [ -- testProperty "Property test ada preserved" (adaPreservationChain @(AlonzoEra TestCrypto)),
-      testPropertyAdaPreservation,
-      Tripping.tests,
+    [ alonzoPropertyTests,
       Translation.tests,
       CDDL.tests 5,
       Golden.goldenUTxOEntryMinAda,

shelley/chain-and-ledger/shelley-spec-ledger-test/src/Test/Shelley/Spec/Ledger/Generator/Utxo.hs

@@ -12,8 +12,6 @@
 {-# LANGUAGE TypeSynonymInstances #-}
 {-# LANGUAGE UndecidableInstances #-}
 
-{-# OPTIONS_GHC -fno-warn-unused-imports #-}  -- TODO FIX ME
-
 module Test.Shelley.Spec.Ledger.Generator.Utxo
   ( genTx,
     Delta (..),
@@ -367,17 +365,16 @@ genNextDelta
         -- increase when we add the delta to the tx?
         draftSize =
           sum
-            [ 5 :: Integer, -- safety net in case the coin or a list prefix rolls over into a larger encoding
-              --12 :: Integer, -- TODO the size calculation somehow needs extra buffer when minting tokens
-              20 :: Integer, -- TODO the size calculation somehow needs extra buffer when minting tokens  THIS IS NEW FIX ME
+            [ 5 :: Integer,  -- safety net in case the coin or a list prefix rolls over into a larger encoding
+              20 :: Integer, -- Fudge factor, Sometimes we need extra buffer when minting tokens.
+                             -- 20 has been empirically determined to make non failing Txs
               encodedLen (max dfees (Coin 0)) - 1,
               foldr (\a b -> b + encodedLen a) 0 extraInputs,
               encodedLen change,
               encodedLen extraWitnesses
             ]
-
         deltaFee = draftSize <×> Coin (fromIntegral (getField @"_minfeeA" pparams))
-                   <+> Coin (fromIntegral (getField @"_minfeeB" pparams))  -- TODO THIS IS NEW FIX ME
+                   <+> Coin (fromIntegral (getField @"_minfeeB" pparams))  -- This is usually very small, so might not have much effect.
         totalFee = baseTxFee <+> deltaFee :: Coin
         remainingFee = totalFee <-> dfees :: Coin
         changeAmount = getChangeAmount change