Re-enabled some tests in Conway

Author: Soupstraw

eras/conway/impl/test/Test/Cardano/Ledger/Conway/Binary/CddlSpec.hs

@@ -15,6 +15,7 @@ import Cardano.Ledger.Conway.Governance (GovAction, ProposalProcedure, VotingPro
 import Cardano.Ledger.Conway.HuddleSpec (conwayCDDL)
 import Cardano.Ledger.Core
 import Cardano.Ledger.Plutus.Data (Data, Datum)
+import Test.Cardano.Ledger.Alonzo.Arbitrary (genNonEmptyRedeemers)
 import Test.Cardano.Ledger.Binary.Cddl (
   beforeAllCddlFile,
   cddlDecoderEquivalenceSpec,
@@ -26,6 +27,7 @@ import Test.Cardano.Ledger.Binary.Cuddle (
   huddleRoundTripAnnCborSpec,
   huddleRoundTripArbitraryValidate,
   huddleRoundTripCborSpec,
+  huddleRoundTripGenValidate,
   specWithHuddle,
  )
 import Test.Cardano.Ledger.Common
@@ -81,7 +83,7 @@ spec = do
       -- TxBody
       huddleRoundTripAnnCborSpec @(TxBody TopTx ConwayEra) v "transaction_body"
       -- TODO enable this once map/list expansion has been optimized in cuddle
-      xdescribe "hangs" $ huddleRoundTripArbitraryValidate @(TxBody TopTx ConwayEra) v "transaction_body"
+      xdescribe "fix scripts" $ huddleRoundTripArbitraryValidate @(TxBody TopTx ConwayEra) v "transaction_body"
       huddleRoundTripCborSpec @(TxBody TopTx ConwayEra) v "transaction_body"
       -- AuxData
       huddleRoundTripAnnCborSpec @(TxAuxData ConwayEra) v "auxiliary_data"
@@ -100,7 +102,7 @@ spec = do
       -- TxOut
       huddleRoundTripCborSpec @(TxOut ConwayEra) v "transaction_output"
       -- TODO fails because of `address`
-      xdescribe "fix address" $ huddleRoundTripArbitraryValidate @(TxOut ConwayEra) v "transaction_output"
+      xdescribe "fix scripts" $ huddleRoundTripArbitraryValidate @(TxOut ConwayEra) v "transaction_output"
       -- Script
       huddleRoundTripAnnCborSpec @(Script ConwayEra) v "script"
       -- TODO fails because of `plutus_v1_script`
@@ -118,16 +120,13 @@ spec = do
       huddleRoundTripCborSpec @(TxWits ConwayEra) v "transaction_witness_set"
       -- PParamsUpdate
       huddleRoundTripCborSpec @(PParamsUpdate ConwayEra) v "protocol_param_update"
-      -- TODO enable this once map/list expansion has been optimized in cuddle
-      xdescribe "hangs" $
-        huddleRoundTripArbitraryValidate @(PParamsUpdate ConwayEra) v "protocol_param_update"
+      huddleRoundTripArbitraryValidate @(PParamsUpdate ConwayEra) v "protocol_param_update"
       -- CostModels
       huddleRoundTripCborSpec @CostModels v "cost_models"
       huddleRoundTripArbitraryValidate @CostModels v "cost_models"
       -- Redeemers
       huddleRoundTripAnnCborSpec @(Redeemers ConwayEra) v "redeemers"
-      -- TODO arbitrary can generate empty redeemers, which is not allowed in the CDDL
-      xdescribe "fix redeemers" $ huddleRoundTripArbitraryValidate @(Redeemers ConwayEra) v "redeemers"
+      huddleRoundTripGenValidate @(Redeemers ConwayEra) genNonEmptyRedeemers v "redeemers"
       huddleRoundTripCborSpec @(Redeemers ConwayEra) v "redeemers"
       -- Tx
       huddleRoundTripAnnCborSpec @(Tx TopTx ConwayEra) v "transaction"
@@ -139,17 +138,13 @@ spec = do
       huddleRoundTripArbitraryValidate @(VotingProcedure ConwayEra) v "voting_procedure"
       -- ProposalProcedure
       huddleRoundTripCborSpec @(ProposalProcedure ConwayEra) v "proposal_procedure"
-      -- TODO This fails because of the hard-coded `reward_account` in the CDDL
-      xdescribe "fix reward_account" $
-        huddleRoundTripArbitraryValidate @(ProposalProcedure ConwayEra) v "proposal_procedure"
+      huddleRoundTripArbitraryValidate @(ProposalProcedure ConwayEra) v "proposal_procedure"
       -- GovAction
       huddleRoundTripCborSpec @(GovAction ConwayEra) v "gov_action"
-      -- TODO enable this once map/list expansion has been optimized in cuddle
-      xdescribe "hangs" $ huddleRoundTripArbitraryValidate @(GovAction ConwayEra) v "gov_action"
+      huddleRoundTripArbitraryValidate @(GovAction ConwayEra) v "gov_action"
       -- TxCert
       huddleRoundTripCborSpec @(TxCert ConwayEra) v "certificate"
-      -- TODO this fails because of the hard-coded `unit_interval` in the CDDL
-      xdescribe "fix unit_interval" $ huddleRoundTripArbitraryValidate @(TxCert ConwayEra) v "certificate"
+      huddleRoundTripArbitraryValidate @(TxCert ConwayEra) v "certificate"
       describe "DecCBOR instances equivalence via CDDL" $ do
         huddleDecoderEquivalenceSpec @(TxBody TopTx ConwayEra) v "transaction_body"
         huddleDecoderEquivalenceSpec @(TxAuxData ConwayEra) v "auxiliary_data"

eras/conway/impl/testlib/Test/Cardano/Ledger/Conway/Arbitrary.hs

@@ -37,7 +37,7 @@ module Test.Cardano.Ledger.Conway.Arbitrary (
 ) where
 
 import Cardano.Ledger.Alonzo.Plutus.Evaluate (CollectError)
-import Cardano.Ledger.BaseTypes (StrictMaybe (..))
+import Cardano.Ledger.BaseTypes (ProtVer (..), StrictMaybe (..))
 import Cardano.Ledger.Conway (ConwayEra, Tx (..))
 import Cardano.Ledger.Conway.Core
 import Cardano.Ledger.Conway.Genesis (ConwayGenesis (..))
@@ -505,8 +505,11 @@ instance
 genParameterChange :: Arbitrary (PParamsUpdate era) => Gen (GovAction era)
 genParameterChange = ParameterChange <$> arbitrary <*> arbitrary <*> arbitrary
 
-genHardForkInitiation :: Gen (GovAction era)
-genHardForkInitiation = HardForkInitiation <$> arbitrary <*> arbitrary
+genHardForkInitiation :: forall era. Era era => Gen (GovAction era)
+genHardForkInitiation =
+  HardForkInitiation
+    <$> arbitrary
+    <*> (ProtVer <$> elements (eraProtVersions @era) <*> arbitrary)
 
 genTreasuryWithdrawals :: Gen (GovAction era)
 genTreasuryWithdrawals = TreasuryWithdrawals <$> arbitrary <*> arbitrary

libs/cardano-ledger-binary/testlib/Test/Cardano/Ledger/Binary/Cuddle.hs

@@ -14,6 +14,7 @@ module Test.Cardano.Ledger.Binary.Cuddle (
   huddleRoundTripCborSpec,
   huddleRoundTripAnnCborSpec,
   writeSpec,
+  huddleRoundTripGenValidate,
   huddleRoundTripArbitraryValidate,
 ) where
 
@@ -71,7 +72,7 @@ import Test.Hspec (
   shouldBe,
  )
 import Test.Hspec.Core.Spec (Example (..), paramsQuickCheckArgs)
-import Test.QuickCheck (Arbitrary (..), Args (replay), Testable (..))
+import Test.QuickCheck (Arbitrary (..), Args (replay), Gen, Testable (..), forAll)
 import Test.QuickCheck.Random (QCGen, mkQCGen)
 import Text.Pretty.Simple (pShow)
 
@@ -237,21 +238,13 @@ cddlFailure encoding err =
       , "Generated diag: " <> CBOR.prettyHexEnc encoding
       ]
 
-huddleRoundTripArbitraryValidate ::
-  forall a.
-  ( DecCBOR a
-  , EncCBOR a
-  , Arbitrary a
-  , Show a
-  ) =>
-  Version ->
-  T.Text ->
-  SpecWith CuddleData
-huddleRoundTripArbitraryValidate version ruleName =
+huddleRoundTripGenValidate ::
+  forall a. (DecCBOR a, Show a, EncCBOR a) => Gen a -> Version -> T.Text -> SpecWith CuddleData
+huddleRoundTripGenValidate gen version ruleName =
   let lbl = label $ Proxy @a
    in describe "Encode an arbitrary value and check against CDDL"
         . it (T.unpack ruleName <> ": " <> T.unpack lbl)
-        $ \CuddleData {cddl} -> property $ \(val :: a) -> do
+        $ \CuddleData {cddl} -> property . forAll gen $ \(val :: a) -> do
           let
             bs = serialize' version val
             res = validateCBOR bs (Name ruleName) (mapIndex cddl)
@@ -280,6 +273,18 @@ huddleRoundTripArbitraryValidate version ruleName =
                           ]
                   _ -> pretty $ pShow err
 
+huddleRoundTripArbitraryValidate ::
+  forall a.
+  ( DecCBOR a
+  , EncCBOR a
+  , Arbitrary a
+  , Show a
+  ) =>
+  Version ->
+  T.Text ->
+  SpecWith CuddleData
+huddleRoundTripArbitraryValidate = huddleRoundTripGenValidate $ arbitrary @a
+
 --------------------------------------------------------------------------------
 -- Writing specs to a file
 --------------------------------------------------------------------------------

libs/cardano-ledger-core/cddl/Cardano/Ledger/Core/HuddleSpec.hs

@@ -29,7 +29,6 @@ import Data.ByteString.Short (fromShort)
 import Data.List.NonEmpty (NonEmpty)
 import qualified Data.List.NonEmpty as NE
 import Data.Proxy (Proxy (..))
-import Data.Ratio (denominator, numerator)
 import qualified Data.Text as T
 import qualified Data.Text.Lazy as LT
 import Data.Word (Word64)
@@ -83,8 +82,11 @@ instance Era era => HuddleRule "unit_interval" era where
       $ pname =.= tag 30 (arr [a VUInt, a VUInt])
     where
       generator g = do
-        val <- toRational @Double <$> uniformRM (0.0, 1.0) g
-        S . TTagged 30 <$> genArrayTerm [TInteger $ numerator val, TInteger $ denominator val] g
+        -- TODO should we test with even larger values than Word64?
+        n <- uniformRM (0, maxBound @Word64) g
+        d <- uniformRM (n, maxBound @Word64) g
+        S . TTagged 30
+          <$> genArrayTerm [TInteger $ fromIntegral n, TInteger $ fromIntegral d] g
 
 instance Era era => HuddleRule "nonnegative_interval" era where
   huddleRuleNamed pname p =