IntersectMBO · Soupstraw · Apr 29, 2026 · Apr 30, 2026 · Apr 30, 2026 · Apr 30, 2026
@@ -132,6 +132,7 @@ library cddl
 
   build-depends:
     base,
+    cardano-ledger-core:cddl,
     cardano-ledger-alonzo,
     cardano-ledger-mary:cddl,
     heredoc,

@@ -435,6 +435,8 @@ plutus_data =
   / big_int
   / bounded_bytes
 
+;In reality the supported tags are 121..127, 1280..1400 and 101.
+;We only list some of the possible tags here.
 constr<a0> =
   #6.102([uint, [* a0]])
   / #6.121([* a0])

@@ -33,6 +33,18 @@ module Cardano.Ledger.Alonzo.HuddleSpec (
 ) where
 
 import Cardano.Ledger.Alonzo (AlonzoEra)
+import Cardano.Ledger.Huddle.Gen (
+  MonadGen (choose),
+  RuleTerm (..),
+  Term (..),
+  genArrayTerm,
+  generateFromGRef,
+  liftAntiGen,
+  listOf,
+  oneof,
+  scale,
+  (|!),
+ )
 import Cardano.Ledger.Mary.HuddleSpec
 import Data.Proxy (Proxy (..))
 import Data.Word (Word64)
@@ -129,19 +141,44 @@ requiredSignersRule pname p = pname =.= huddleRule1 @"set" p (huddleRule @"addr_
 constr :: IsType0 a => Proxy "constr" -> a -> GRuleCall
 constr pname =
   binding $ \x ->
-    pname
-      =.=
-      -- We use 'unType0 . toType0' to convert each 'Tagged ArrayChoice' to 'Choice Type2',
-      -- making the list homogeneous so that 'foldl1 (/)' can be used.
-      -- Ideally, we should have used `toChoice`, but it's not exported by `cuddle`.
-      foldl1
-        (/)
-        ( fmap
-            (unType0 . toType0)
-            ( tag 102 (arr [a VUInt, a $ arr [0 <+ a x]])
-                : [tag t (arr [0 <+ a x]) | t <- [121 .. 127] ++ [1280 .. 1400]]
-            )
-        )
+    comment
+      [str|In reality the supported tags are 121..127, 1280..1400 and 101.
+          |We only list some of the possible tags here.
+          |]
+      . withCBORGen (generator x)
+      $ pname
+        =.=
+        -- We use 'unType0 . toType0' to convert each 'Tagged ArrayChoice' to 'Choice Type2',
+        -- making the list homogeneous so that 'foldl1 (/)' can be used.
+        -- Ideally, we should have used `toChoice`, but it's not exported by `cuddle`.
+        foldl1
+          (/)
+          ( fmap
+              (unType0 . toType0)
+              ( tag 102 (arr [a VUInt, a $ arr [0 <+ a x]])
+                  : [tag t (arr [0 <+ a x]) | t <- [121 .. 127] ++ [1280 .. 1400]]
+              )
+          )
+  where
+    generator ref = do
+      t <-
+        liftAntiGen $
+          oneof [choose (121, 127), choose (1280, 1400)]
+            |! oneof [choose (0, 120), choose (128, 1279), choose (1401, 0xffffffffffffffff)]
+      let
+        unwrapElems = traverse $ \case
+          SingleTerm e -> pure e
+          _ -> error "Expected single term"
+      elems <-
+        scale (`div` 2) $
+          if t == 101
+            then do
+              uInt <- TInt <$> choose (0, 2 ^ (64 :: Int) - 1)
+              elems <- genArrayTerm =<< unwrapElems =<< listOf (generateFromGRef ref)
+              pure . SingleTerm <$> genArrayTerm [uInt, elems]
+            else listOf $ generateFromGRef ref
+      singleElems <- unwrapElems elems
+      SingleTerm . TTagged t <$> genArrayTerm singleElems
 
 instance HuddleGroup "operational_cert" AlonzoEra where
   huddleGroupNamed = shelleyOperationalCertGroup

@@ -167,6 +167,8 @@ plutus_data =
   / big_int
   / bounded_bytes
 
+;In reality the supported tags are 121..127, 1280..1400 and 101.
+;We only list some of the possible tags here.
 constr<a0> =
   #6.102([uint, [* a0]])
   / #6.121([* a0])

@@ -212,6 +212,8 @@ plutus_data =
   / big_int
   / bounded_bytes
 
+;In reality the supported tags are 121..127, 1280..1400 and 101.
+;We only list some of the possible tags here.
 constr<a0> =
   #6.102([uint, [* a0]])
   / #6.121([* a0])

@@ -3,6 +3,7 @@
 {-# LANGUAGE FlexibleContexts #-}
 {-# LANGUAGE FlexibleInstances #-}
 {-# LANGUAGE ImportQualifiedPost #-}
+{-# LANGUAGE LambdaCase #-}
 {-# LANGUAGE MonoLocalBinds #-}
 {-# LANGUAGE MultiParamTypeClasses #-}
 {-# LANGUAGE OverloadedLists #-}
@@ -11,6 +12,7 @@
 {-# LANGUAGE ScopedTypeVariables #-}
 {-# LANGUAGE TypeApplications #-}
 {-# LANGUAGE UndecidableInstances #-}
+{-# LANGUAGE ViewPatterns #-}
 {-# OPTIONS_GHC -Wno-orphans #-}
 
 module Cardano.Ledger.Conway.HuddleSpec (
@@ -65,6 +67,7 @@ module Cardano.Ledger.Conway.HuddleSpec (
   maybeTaggedNonemptySet,
   maybeTaggedNonemptyOset,
   conwayCostModelsGenerator,
+  generateMaybeTaggedSet,
 ) where
 
 import Cardano.Ledger.Babbage.HuddleSpec hiding (
@@ -83,17 +86,30 @@ import Cardano.Ledger.Huddle.Gen (
   MonadGen (choose, resize),
   RuleTerm (..),
   Term (..),
+  antiChoose,
+  antiVectorOfUnique,
+  arbitrary,
+  canonicalizeTerm,
+  faultyNum,
   genArrayTerm,
   genMapTerm,
   genRule,
+  generateFromGRef,
   liftAntiGen,
   oneof,
   replicateMNorm,
   shuffle,
+  unwrapSingle,
+  unwrapSingleOrError,
+  validateArrayTerm,
+  validateFromGRef,
   withAntiGen,
   (|!),
  )
 import Cardano.Ledger.Huddle.Gen qualified as Gen
+import Control.Monad (unless)
+import Data.Foldable (traverse_)
+import Data.List (nub)
 import Data.Proxy (Proxy (..))
 import Data.Traversable (forM)
 import Data.Word (Word64)
@@ -706,9 +722,40 @@ conwayRedeemer pname p =
       , "ex_units" ==> huddleRule @"ex_units" p
       ]
 
+generateMaybeTaggedSet :: Int -> CBORGen Term -> CBORGen Term
+generateMaybeTaggedSet nElems gen = do
+  elems <- withAntiGen (antiVectorOfUnique nElems) gen
+  elemsArr <- genArrayTerm elems
+  tagged <- arbitrary
+  if tagged
+    then do
+      t <- liftAntiGen $ faultyNum 258
+      pure $ TTagged t elemsArr
+    else pure elemsArr
+
 mkMaybeTaggedSet ::
-  forall name a. (KnownSymbol name, IsType0 a) => Proxy name -> Word64 -> a -> GRuleCall
-mkMaybeTaggedSet pname n = binding $ \x -> pname =.= tag 258 (arr [n <+ a x]) / sarr [n <+ a x]
+  forall name a. (KnownSymbol name, IsType0 a) => Proxy name -> Int -> a -> GRuleCall
+mkMaybeTaggedSet pname n = binding $ \x ->
+  withCBORGen (generator x)
+    . withValidator (validator x)
+    $ pname =.= tag 258 (arr [fromIntegral n <+ a x]) / sarr [fromIntegral n <+ a x]
+  where
+    generator :: GRef -> CBORGen RuleTerm
+    generator ref = do
+      nElems <- liftAntiGen . Gen.sized $ \sz ->
+        let sz' = max n sz in antiChoose (n, sz') (0, sz')
+      fmap SingleTerm . generateMaybeTaggedSet nElems $ unwrapSingleOrError <$> generateFromGRef ref
+    validator ref term = do
+      term_ <- unwrapSingle term
+      let
+        validateInner t = do
+          elems <- validateArrayTerm t
+          let canon = canonicalizeTerm <$> elems
+          unless (canon == nub canon) $ fail "not all elements are unique"
+          traverse_ (validateFromGRef ref) elems
+      case term_ of
+        TTagged t x | t == 258 -> validateInner x
+        x -> validateInner x
 
 maybeTaggedSet :: IsType0 a => Proxy "set" -> a -> GRuleCall
 maybeTaggedSet pname = mkMaybeTaggedSet pname 0

@@ -31,6 +31,7 @@ module Test.Cardano.Ledger.Conway.Arbitrary (
   genCommitteeGovAction,
   genConstitutionGovAction,
   genProposals,
+  genNonEmptyVotingProcedures,
   ProposalsNewActions (..),
   ProposalsForEnactment (..),
   ShuffledGovActionStates (..),
@@ -897,3 +898,8 @@ instance Arbitrary (TransitionConfig ConwayEra) where
 deriving newtype instance Arbitrary (Tx TopTx ConwayEra)
 
 deriving newtype instance Arbitrary (ApplyTxError ConwayEra)
+
+genNonEmptyVotingProcedures :: Era era => Gen (VotingProcedures era)
+genNonEmptyVotingProcedures =
+  VotingProcedures . Map.fromList <$> do
+    listOf1 $ (,) <$> arbitrary <*> (Map.fromList <$> listOf1 arbitrary)
@@ -210,16 +210,14 @@ library cddl
     -Wunused-packages
 
   build-depends:
-    QuickCheck,
     antigen,
     base,
+    cardano-ledger-core:cddl,
     cardano-ledger-conway:cddl,
     cardano-ledger-core:cddl,
     cardano-ledger-dijkstra,
     cborg,
-    cuddle,
     heredoc,
-    quickcheck-transformer,
     text,
 
 executable generate-cddl
@@ -265,6 +263,7 @@ test-suite tests
 
   build-depends:
     base,
+    cardano-data,
     cardano-ledger-alonzo:{cardano-ledger-alonzo, testlib},
     cardano-ledger-babbage:testlib,
     cardano-ledger-binary:testlib,

@@ -211,6 +211,8 @@ plutus_data =
   / big_int
   / bounded_bytes
 
+;In reality the supported tags are 121..127, 1280..1400 and 101.
+;We only list some of the possible tags here.
 constr<a0> =
   #6.102([uint, [* a0]])
   / #6.121([* a0])

@@ -34,18 +34,27 @@ module Cardano.Ledger.Dijkstra.HuddleSpec (
 
 import Cardano.Ledger.Conway.HuddleSpec hiding ()
 import Cardano.Ledger.Dijkstra (DijkstraEra)
-import Cardano.Ledger.Huddle.Gen (CBORGen, RuleTerm (..), genArrayTerm, liftAntiGen, withAntiGen)
-import Codec.CBOR.Cuddle.CBOR.Gen (generateFromName)
+import Cardano.Ledger.Huddle.Gen (
+  CBORGen,
+  MonadGen (choose, liftGen),
+  RuleTerm (..),
+  genArrayTerm,
+  genRule,
+  generateFromName,
+  liftAntiGen,
+  scale,
+  shuffle,
+  withAntiGen,
+ )
+import Cardano.Ledger.Huddle.Gen qualified as Gen
 import Codec.CBOR.Term (Term (..))
 import Control.Monad (zipWithM)
+import Data.Maybe (mapMaybe)
 import Data.Proxy (Proxy (..))
 import Data.Text ()
 import Data.Text qualified as T
 import Data.Word (Word16, Word64)
 import Test.AntiGen (withAnnotation, (|!))
-import Test.QuickCheck (choose, shuffle)
-import Test.QuickCheck qualified as QC
-import Test.QuickCheck.GenT (liftGen)
 import Text.Heredoc
 import Prelude hiding ((/))
 
@@ -92,7 +101,33 @@ subTransactionsRule ::
   Proxy era ->
   Rule
 subTransactionsRule pname p =
-  pname =.= huddleRule1 @"nonempty_oset" p (huddleRule @"sub_transaction" p)
+  withCBORGen generate $
+    pname =.= huddleRule1 @"nonempty_oset" p (huddleRule @"sub_transaction" p)
+  where
+    -- The Haskell representation is @OMap TxId (Tx SubTx era)@: dedup is by
+    -- body hash, so generated sub_transactions must have distinct bodies, not
+    -- just distinct full @[body, witness, aux]@ tuples.
+    generate = do
+      nElems <- Gen.sized $ \sz -> choose (1, max 1 (min sz 3))
+      let subTxGen = scale (`div` 2) $ genRule @"sub_transaction" @era
+      txs <- uniqueByBody nElems subTxGen
+      elemsArr <- genArrayTerm txs
+      tagged <- Gen.arbitrary
+      pure $ SingleTerm $ if tagged then TTagged 258 elemsArr else elemsArr
+    uniqueByBody :: Int -> CBORGen Term -> CBORGen [Term]
+    uniqueByBody n gen = loop [] n
+      where
+        triesPerElement = 20 :: Int
+        loop acc 0 = pure acc
+        loop acc k = attempt triesPerElement acc k
+        attempt 0 acc _ = pure acc
+        attempt tries acc k = do
+          tx <- gen
+          case bodyOf tx of
+            Just b | b `notElem` mapMaybe bodyOf acc -> loop (tx : acc) (k - 1)
+            _ -> attempt (tries - 1) acc k
+        bodyOf (TList (b : _)) = Just b
+        bodyOf _ = Nothing
 
 subTransactionRule ::
   forall era.
@@ -890,10 +925,13 @@ instance HuddleRule "block_body" DijkstraEra where
 
 blockBodyGen :: CBORGen RuleTerm
 blockBodyGen = do
-  numTxs <- liftGen . QC.sized $ \s -> choose (0 :: Int, s)
+  numTxs <- liftGen . Gen.sized $ \s -> choose (0 :: Int, s `div` 15)
   txs <-
     mapM
-      (\i -> withAntiGen (withAnnotation (T.pack $ show i)) $ generateFromName "transaction")
+      ( \i ->
+          withAntiGen (withAnnotation (T.pack $ show i)) . scale (`div` max 1 numTxs) $
+            generateFromName "transaction"
+      )
       [0 .. numTxs - 1]
   invalidIxIxs <-
     if numTxs == 0
@@ -917,7 +955,7 @@ blockBodyGen = do
   invalidTxIxsTerm <- genArrayTerm $ TInteger . toInteger <$> invalidIxIxs
   txsTerm <- withAntiGen (withAnnotation "transactions") $ genArrayTerm txs
   perasCertTerm <- generateFromName "peras_certificate"
-  SingleTerm <$> liftGen (genArrayTerm [invalidTxIxsTerm, txsTerm, perasCertTerm])
+  SingleTerm <$> genArrayTerm [invalidTxIxsTerm, txsTerm, perasCertTerm]
 
 instance HuddleRule "auxiliary_scripts" DijkstraEra where
   huddleRuleNamed = auxiliaryScriptsRule