bump cuddle to 1.7.0.0

Author: Soupstraw

cabal.project

@@ -27,8 +27,8 @@ source-repository-package
 source-repository-package
   type: git
   location: https://github.com/input-output-hk/cuddle.git
-  --sha256: sha256-B/YXpNnFEppqQkAHPFU6EmwzpFCPwdNLTVVSm0X+LTQ=
-  tag: 08e1745d144696827057f4e07c677b080bfeeaa4
+  --sha256: sha256-nUEFgDC7lQoSfwqjwDWhKfc/1ZOO/D+zPiBd7hoNaYs=
+  tag: 05a310bc6886f48e692a39456d353aab590203be
 
 -- NOTE: If you would like to update the above,
 -- see CONTRIBUTING.md#to-update-the-referenced-agda-ledger-spec

eras/alonzo/impl/cddl/lib/Cardano/Ledger/Alonzo/HuddleSpec.hs

@@ -36,7 +36,7 @@ import Cardano.Ledger.Alonzo (AlonzoEra)
 import Cardano.Ledger.Huddle.Gen (
   MonadGen (choose),
   Term (..),
-  WrappedTerm (..),
+  RuleTerm (..),
   genArrayTerm,
   generateFromGRef,
   liftAntiGen,
@@ -167,20 +167,20 @@ constr pname =
             |! oneof [choose (0, 120), choose (128, 1279), choose (1401, 0xffffffffffffffff)]
       let
         unwrapElems = traverse $ \case
-          S e -> pure e
+          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 . S <$> genArrayTerm [uInt, elems]
+              pure . SingleTerm <$> genArrayTerm [uInt, elems]
             else listOf $ generateFromGRef ref
       singleElems <- unwrapElems elems
-      S . TTagged t <$> genArrayTerm singleElems
+      SingleTerm . TTagged t <$> genArrayTerm singleElems
     validator ref = \case
-      S (TTagged t term)
+      SingleTerm (TTagged t term)
         | t >= 121 && t <= 127 || t >= 1280 && t <= 1400 -> do
             elems <- validateArrayTerm term
             forM_ elems $ validateFromGRef ref

eras/conway/impl/cddl/lib/Cardano/Ledger/Conway/HuddleSpec.hs

@@ -85,7 +85,7 @@ import Cardano.Ledger.Huddle.Gen (
   CBORGen,
   MonadGen (choose, resize),
   Term (..),
-  WrappedTerm (..),
+  RuleTerm (..),
   antiChoose,
   antiVectorOfUnique,
   arbitrary,
@@ -740,11 +740,11 @@ mkMaybeTaggedSet pname n = binding $ \x ->
     . withValidator (validator x)
     $ pname =.= tag 258 (arr [fromIntegral n <+ a x]) / sarr [fromIntegral n <+ a x]
   where
-    generator :: GRef -> CBORGen WrappedTerm
+    generator :: GRef -> CBORGen RuleTerm
     generator ref = do
       nElems <- liftAntiGen . Gen.sized $ \sz ->
         let sz' = max n sz in antiChoose (n, sz') (0, sz')
-      fmap S . generateMaybeTaggedSet nElems $ unwrapSingleOrError <$> generateFromGRef ref
+      fmap SingleTerm . generateMaybeTaggedSet nElems $ unwrapSingleOrError <$> generateFromGRef ref
     validator ref term = do
       term_ <- unwrapSingle term
       let
@@ -1100,7 +1100,7 @@ instance HuddleRule "language" ConwayEra where
 instance HuddleRule "potential_languages" ConwayEra where
   huddleRuleNamed pname _ = potentialLanguagesRule pname
 
-conwayCostModelsGenerator :: forall era. Era era => CBORGen WrappedTerm
+conwayCostModelsGenerator :: forall era. Era era => CBORGen RuleTerm
 conwayCostModelsGenerator = Gen.sized $ \size -> do
   nKeys <- choose (0, size)
   initialKeys <- take nKeys <$> shuffle [0 :: Int .. 255]
@@ -1119,7 +1119,7 @@ conwayCostModelsGenerator = Gen.sized $ \size -> do
     v <- withAntiGen (replicateMNorm nVals) $ genRule @"int64" @era
     vs <- genArrayTerm v
     pure (TInt k, vs)
-  S <$> genMapTerm kvs
+  SingleTerm <$> genMapTerm kvs
 
 instance HuddleRule "cost_models" ConwayEra where
   huddleRuleNamed pname p =

eras/dijkstra/impl/cardano-ledger-dijkstra.cabal

@@ -217,7 +217,6 @@ library cddl
     cardano-ledger-core:cddl,
     cardano-ledger-dijkstra,
     cborg,
-    cuddle,
     heredoc,
     text,
 

eras/dijkstra/impl/cddl/lib/Cardano/Ledger/Dijkstra/HuddleSpec.hs

@@ -35,16 +35,18 @@ module Cardano.Ledger.Dijkstra.HuddleSpec (
 import Cardano.Ledger.Conway.HuddleSpec hiding ()
 import Cardano.Ledger.Dijkstra (DijkstraEra)
 import Cardano.Ledger.Huddle.Gen (
+  CBORGen,
   MonadGen (choose, liftGen),
-  WrappedTerm (..),
+  RuleTerm (..),
   genArrayTerm,
   genRule,
   generateFromName,
+  liftAntiGen,
   scale,
   shuffle,
+  withAntiGen,
  )
 import Cardano.Ledger.Huddle.Gen qualified as Gen
-import Codec.CBOR.Cuddle.CDDL.CBORGenerator (CBORGen, liftAntiGen, withAntiGen)
 import Codec.CBOR.Term (Term (..))
 import Control.Monad (zipWithM)
 import Data.Maybe (mapMaybe)
@@ -111,7 +113,7 @@ subTransactionsRule pname p =
       txs <- uniqueByBody nElems subTxGen
       elemsArr <- genArrayTerm txs
       tagged <- Gen.arbitrary
-      pure $ S $ if tagged then TTagged 258 elemsArr else elemsArr
+      pure $ SingleTerm $ if tagged then TTagged 258 elemsArr else elemsArr
     uniqueByBody :: Int -> CBORGen Term -> CBORGen [Term]
     uniqueByBody n gen = loop [] n
       where
@@ -921,7 +923,7 @@ instance HuddleRule "block_body" DijkstraEra where
           , "peras_certificate" ==> huddleRule @"peras_certificate" era
           ]
 
-blockBodyGen :: CBORGen WrappedTerm
+blockBodyGen :: CBORGen RuleTerm
 blockBodyGen = do
   numTxs <- liftGen . Gen.sized $ \s -> choose (0 :: Int, s)
   txs <-
@@ -950,7 +952,7 @@ blockBodyGen = do
   invalidTxIxsTerm <- genArrayTerm $ TInteger . toInteger <$> invalidIxIxs
   txsTerm <- withAntiGen (withAnnotation "transactions") $ genArrayTerm txs
   perasCertTerm <- generateFromName "peras_certificate"
-  S <$> genArrayTerm [invalidTxIxsTerm, txsTerm, perasCertTerm]
+  SingleTerm <$> genArrayTerm [invalidTxIxsTerm, txsTerm, perasCertTerm]
 
 instance HuddleRule "auxiliary_scripts" DijkstraEra where
   huddleRuleNamed = auxiliaryScriptsRule

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

@@ -47,8 +47,8 @@ import Codec.CBOR.Cuddle.CBOR.Validator.Trace (
   prettyValidationTrace,
  )
 import Codec.CBOR.Cuddle.CDDL (Name (..))
-import Codec.CBOR.Cuddle.CDDL.CBORGenerator (runCBORGen, GenConfig (..))
 import Codec.CBOR.Cuddle.CDDL.CTree (CTreeRoot)
+import Codec.CBOR.Cuddle.CDDL.Custom.Generator (GenConfig (..), runCBORGen)
 import Codec.CBOR.Cuddle.CDDL.Resolve (MonoReferenced)
 import qualified Codec.CBOR.Cuddle.CDDL.Resolve as Cuddle
 import qualified Codec.CBOR.Cuddle.Huddle as Cuddle

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

@@ -25,7 +25,7 @@ import Cardano.Ledger.Huddle.Gen (
   CBORGen,
   CustomValidatorResult (..),
   MonadGen (..),
-  WrappedTerm (..),
+  RuleTerm (..),
   arbitrary,
   genArrayTerm,
   liftAntiGen,
@@ -53,8 +53,8 @@ genByteString n = BS.pack <$> vectorOf n arbitrary
 
 -- | Generator for plutus scripts that produces random bytestrings.
 -- This avoids collisions when scripts appear in sets (tag 258).
-plutusScriptGen :: MonadGen m => m WrappedTerm
-plutusScriptGen = S . TBytes <$> (genByteString =<< choose (8, 1024))
+plutusScriptGen :: MonadGen m => m RuleTerm
+plutusScriptGen = SingleTerm . TBytes <$> (genByteString =<< choose (8, 1024))
 
 instance Era era => HuddleRule "hash28" era where
   huddleRuleNamed pname _ = pname =.= VBytes `H.sized` (28 :: Word64)
@@ -101,7 +101,7 @@ instance Era era => HuddleRule "unit_interval" era where
             , genUnitInterval64 0 1000
             , genUnitInterval64 (max64 - 1000) max64
             ]
-        S . TTagged 30
+        SingleTerm . TTagged 30
           <$> genArrayTerm [TInteger $ toInteger n, TInteger $ toInteger d]
 
 instance Era era => HuddleRule "nonnegative_interval" era where
@@ -251,7 +251,7 @@ instance Era era => HuddleRule "address" era where
         paymentCred <- genHash28
         -- TODO use genBytesTerm once indefinite bytestring decoding has been fixed
         let bytesTerm = TBytes . BS.cons header $ paymentCred <> stakeCred
-        pure $ S bytesTerm
+        pure $ SingleTerm bytesTerm
 
 instance Era era => HuddleRule "reward_account" era where
   huddleRuleNamed pname _ = withCBORGen generator $ pname =.= VBytes
@@ -265,7 +265,7 @@ instance Era era => HuddleRule "reward_account" era where
           header = 0b11100000 .|. mainnetMask .|. scriptMask
         payload <- genHash28
         let term = TBytes $ BS.cons header payload
-        pure $ S term
+        pure $ SingleTerm term
 
 instance Era era => HuddleRule "transaction_index" era where
   huddleRuleNamed pname _ = pname =.= VUInt `H.sized` (2 :: Word64)
@@ -313,12 +313,12 @@ instance Era era => HuddleRule "stake_credential" era where
 instance Era era => HuddleRule "port" era where
   huddleRuleNamed pname _ = pname =.= VUInt `le` 65535
 
-ipGen :: Int -> CBORGen WrappedTerm
+ipGen :: Int -> CBORGen RuleTerm
 ipGen n = do
   l <- liftAntiGen $ choose (n, 1024) |! choose (0, pred n)
   bs <- genByteString l
   -- TODO Also generate with TBytesI
-  pure . S $ TBytes bs
+  pure . SingleTerm $ TBytes bs
 
 ipValidator :: Int -> Term -> CustomValidatorResult
 ipValidator n = \case

libs/cardano-ledger-core/cddl/Cardano/Ledger/Huddle/Gen.hs

@@ -10,16 +10,15 @@ module Cardano.Ledger.Huddle.Gen (
   -- * MonadGen
   module GenT,
 
-  -- * CBORGen
-  module CBORGen,
+  -- * Cuddle core
+  module CustomCore,
+  Term (..),
 
   -- * Term generators
-  Term (..),
-  WrappedTerm (..),
-  Name (..),
-  genRule,
+  module CustomGen,
   generateFromName,
   generateFromGRef,
+  genRule,
   genArrayTerm,
   genBytesTerm,
   genStringTerm,
@@ -28,6 +27,7 @@ module Cardano.Ledger.Huddle.Gen (
   unwrapSingleOrError,
 
   -- * Term validators
+  module CustomValidator,
   validateFromName,
   validateFromGRef,
   validateInt,
@@ -54,9 +54,12 @@ import Cardano.Ledger.Huddle (HuddleRule ())
 import Codec.CBOR.Cuddle.CBOR.Gen (generateFromGRef, generateFromName)
 import Codec.CBOR.Cuddle.CBOR.Validator (validateFromGRef, validateFromName)
 import Codec.CBOR.Cuddle.CDDL (Name (..))
-import Codec.CBOR.Cuddle.CDDL.CBORGenerator as CBORGen
 import Codec.CBOR.Cuddle.CDDL.CTree (nintMin, uintMax)
+import Codec.CBOR.Cuddle.CDDL.Custom.Core as CustomCore
+import Codec.CBOR.Cuddle.CDDL.Custom.Generator as CustomGen
+import Codec.CBOR.Cuddle.CDDL.Custom.Validator as CustomValidator
 import Control.Monad.Reader (asks)
+import Data.Bifunctor (Bifunctor (..))
 import Data.ByteString (ByteString)
 import qualified Data.ByteString.Lazy as LBS
 import Data.List (sortOn)
@@ -68,7 +71,6 @@ import GHC.TypeLits (symbolVal)
 import Test.AntiGen as AntiGen
 import qualified Test.QuickCheck as QC
 import Test.QuickCheck.GenT as GenT
-import Data.Bifunctor (Bifunctor(..))
 
 -- | A function for generating a term from a rule. The @HuddleRule@ constraint
 -- ensures that the rule is actually defined in that era.
@@ -156,48 +158,48 @@ canonicalizeTerm = \case
 
 -- Term validators
 
-validateInt :: Term -> CBORValidator Integer
+validateInt :: Term -> Validator Integer
 validateInt (TInt (toInteger -> x))
   | x >= nintMin || x <= uintMax = pure x
   | otherwise = fail "Number not in int range"
 validateInt _ = fail "Expected int"
 
-validateUInt :: Term -> CBORValidator Integer
+validateUInt :: Term -> Validator Integer
 validateUInt (TInt (toInteger -> x))
   | x >= 0 || x <= uintMax = pure x
   | otherwise = fail "Number not in uint range"
 validateUInt _ = fail "Expected uint"
 
-validateNInt :: Term -> CBORValidator Integer
+validateNInt :: Term -> Validator Integer
 validateNInt (TInt (toInteger -> x))
   | x >= nintMin || x < 0 = pure x
   | otherwise = fail "Number not in nint range"
 validateNInt _ = fail "Expected nint"
 
-validateArrayTerm :: Term -> CBORValidator [Term]
+validateArrayTerm :: Term -> Validator [Term]
 validateArrayTerm (TList xs) = pure xs
 validateArrayTerm (TListI xs) = pure xs
 validateArrayTerm _ = fail "Expected list"
 
-validateBytesTerm :: Term -> CBORValidator ByteString
+validateBytesTerm :: Term -> Validator ByteString
 validateBytesTerm (TBytes bs) = pure bs
 validateBytesTerm (TBytesI bs) = pure $ LBS.toStrict bs
 validateBytesTerm _ = fail "Expected bytes"
 
-validateStringTerm :: Term -> CBORValidator Text
+validateStringTerm :: Term -> Validator Text
 validateStringTerm (TString x) = pure x
 validateStringTerm (TStringI x) = pure $ LT.toStrict x
 validateStringTerm _ = fail "Expected string"
 
-validateMapTerm :: Term -> CBORValidator [(Term, Term)]
+validateMapTerm :: Term -> Validator [(Term, Term)]
 validateMapTerm (TMap xs) = pure xs
 validateMapTerm (TMapI xs) = pure xs
 validateMapTerm _ = fail "Expected map"
 
-unwrapSingle :: WrappedTerm -> CBORValidator Term
-unwrapSingle (S x) = pure x
+unwrapSingle :: RuleTerm -> Validator Term
+unwrapSingle (SingleTerm x) = pure x
 unwrapSingle _ = fail "Expected a single term"
 
-unwrapSingleOrError :: WrappedTerm -> Term
-unwrapSingleOrError (S x) = x
+unwrapSingleOrError :: RuleTerm -> Term
+unwrapSingleOrError (SingleTerm x) = x
 unwrapSingleOrError _ = error "Expected a single term"