diff --git a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs index 7a69a7c71b1..d361543cf4c 100644 --- a/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs +++ b/eras/shelley/impl/testlib/Test/Cardano/Ledger/Shelley/Arbitrary.hs @@ -71,20 +71,17 @@ import Cardano.Ledger.Shelley.TxCert ( ) import Cardano.Ledger.Shelley.TxOut import Cardano.Ledger.Shelley.TxWits (ShelleyTxWits (ShelleyTxWits)) -import Control.Exception (assert) import Control.Monad.Identity (Identity) -import qualified Data.ByteString.Char8 as BS (length, pack) +import qualified Data.ByteString.Char8 as BS (pack) import qualified Data.ListMap as LM import qualified Data.Map.Strict as Map (fromList) import Data.Proxy (Proxy (Proxy)) -import qualified Data.Text as T (pack) -import qualified Data.Text.Encoding as T (encodeUtf8) import Data.Word (Word64) import Generic.Random (genericArbitraryU) import Numeric.Natural (Natural) import Test.Cardano.Chain.UTxO.Gen (genCompactTxOut) import Test.Cardano.Ledger.Common -import Test.Cardano.Ledger.Core.Arbitrary () +import Test.Cardano.Ledger.Core.Arbitrary (genMetadatumInt, genMetadatumString) import Test.Cardano.Ledger.Core.Utils (unsafeBoundRational) import Test.QuickCheck.Hedgehog (hedgehog) @@ -328,6 +325,7 @@ genMetadata metadataFrequency = [ (metadataFrequency, SJust <$> genMetadata') , (100 - metadataFrequency, pure SNothing) ] +{-# DEPRECATED genMetadata "In favor of `arbitrary`" #-} -- | Generate Metadata (and compute hash) of size up to 'metadataMaxSize' genMetadata' :: Era era => Gen (ShelleyTxAuxData era) @@ -335,6 +333,7 @@ genMetadata' = do n <- choose (1, metadataMaxSize) ShelleyTxAuxData . Map.fromList <$> vectorOf n genMetadatum +{-# DEPRECATED genMetadata' "In favor of `arbitrary`" #-} -- | Generate one of the Metadatum genMetadatum :: Gen (Word64, Metadatum) @@ -348,53 +347,22 @@ genMetadatum = do , genMetadatumList , genMetadatumMap ] +{-# DEPRECATED genMetadatum "In favor of `arbitrary`" #-} genDatumInt :: Gen Metadatum -genDatumInt = - I - <$> frequency - [ (8, choose (minVal, maxVal)) - , (1, pure minVal) - , (1, pure maxVal) - ] - where - minVal, maxVal :: Integer - minVal = -maxVal - maxVal = fromIntegral (maxBound :: Word64) +genDatumInt = genMetadatumInt +{-# DEPRECATED genDatumInt "In favor of `Test.Cardano.Ledger.Core.Arbitrary.genMetadatumInt`" #-} genDatumString :: Gen Metadatum -genDatumString = - sized $ \sz -> do - n <- choose (0, min sz 64) - cs <- genUtf8StringOfSize n - let s = T.pack cs - assert (BS.length (T.encodeUtf8 s) == n) $ - return (S s) - --- | Produce an arbitrary Unicode string such that it's UTF8 encoding size in --- bytes is exactly the given length. -genUtf8StringOfSize :: Int -> Gen [Char] -genUtf8StringOfSize 0 = return [] -genUtf8StringOfSize n = do - cz <- choose (1, min n 4) - c <- case cz of - 1 -> choose ('\x00000', '\x00007f') - 2 -> choose ('\x00080', '\x0007ff') - 3 -> - oneof - [ choose ('\x00800', '\x00d7ff') - , -- skipping UTF-16 surrogates d800--dfff - choose ('\x0e000', '\x00ffff') - ] - _ -> choose ('\x10000', '\x10ffff') - cs <- genUtf8StringOfSize (n - cz) - return (c : cs) +genDatumString = genMetadatumString +{-# DEPRECATED genDatumString "In favor of `Test.Cardano.Ledger.Core.Arbitrary.genMetadatumString`" #-} genDatumBytestring :: Gen Metadatum genDatumBytestring = sized $ \sz -> do n <- choose (0, min sz 64) B . BS.pack <$> vectorOf n arbitrary +{-# DEPRECATED genDatumBytestring "In favor of `Test.Cardano.Ledger.Core.Arbitrary.genMetadatumBytestring`" #-} -- | Generate a 'MD.List [Metadatum]' -- @@ -403,11 +371,13 @@ genDatumBytestring = -- of list or map Datum. genMetadatumList :: Gen Metadatum genMetadatumList = List <$> vectorOfMetadatumSimple +{-# DEPRECATED genMetadatumList "In favor of `Test.Cardano.Ledger.Core.Arbitrary.genMetadatumList`" #-} -- | Generate a 'MD.Map ('[(Metadatum, Metadatum)]') genMetadatumMap :: Gen Metadatum genMetadatumMap = Map <$> (zip <$> vectorOfMetadatumSimple <*> vectorOfMetadatumSimple) +{-# DEPRECATED genMetadatumMap "In favor of `Test.Cardano.Ledger.Core.Arbitrary.genMetadatumMap`" #-} vectorOfMetadatumSimple :: Gen [Metadatum] vectorOfMetadatumSimple = do @@ -420,6 +390,7 @@ vectorOfMetadatumSimple = do , genDatumBytestring ] ) +{-# DEPRECATED vectorOfMetadatumSimple "As no longer used" #-} ------------------------------------------------------------------------------------------ -- Era-independent generators ------------------------------------------------------------ @@ -533,37 +504,11 @@ genTx = maxTxWits :: Int maxTxWits = 5 -instance Arbitrary Metadatum where - arbitrary = sizedMetadatum maxMetadatumDepth - instance Era era => Arbitrary (ShelleyTxAuxData era) where arbitrary = ShelleyTxAuxData <$> arbitrary deriving newtype instance Arbitrary NominalDiffTimeMicro -maxMetadatumDepth :: Int -maxMetadatumDepth = 2 - -maxMetadatumListLens :: Int -maxMetadatumListLens = 5 - -sizedMetadatum :: Int -> Gen Metadatum -sizedMetadatum 0 = - oneof - [ I <$> arbitrary - , B <$> arbitrary - , S <$> (T.pack <$> arbitrary) - ] -sizedMetadatum n = - let xsGen = listOf (sizedMetadatum (n - 1)) - in oneof - [ Map <$> (zip <$> resize maxMetadatumListLens xsGen <*> xsGen) - , List <$> resize maxMetadatumListLens xsGen - , I <$> arbitrary - , B <$> arbitrary - , S <$> (T.pack <$> arbitrary) - ] - instance Arbitrary VotingPeriod where arbitrary = genericArbitraryU shrink = genericShrink diff --git a/libs/cardano-ledger-core/CHANGELOG.md b/libs/cardano-ledger-core/CHANGELOG.md index 728e457345e..1a2479d24ca 100644 --- a/libs/cardano-ledger-core/CHANGELOG.md +++ b/libs/cardano-ledger-core/CHANGELOG.md @@ -9,6 +9,11 @@ * Add function `mkCoinTxOut` in Core.hs * Move `Metadatum` from `cardano-ledger-shelley` into a new module `Cardano.Ledger.Metadata` +### `testlib` + +* Add `genMetadatumInt`, `genMetadatumString`, `genUtf8StringOfSize`, + `genMetadatumBytestring`, `genMetadatumList` and `genMetadatumMap` + ## 1.11.0.0 * Add `shouldSatisfyExpr` diff --git a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Arbitrary.hs b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Arbitrary.hs index 461e7b31a47..954f0d837db 100644 --- a/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Arbitrary.hs +++ b/libs/cardano-ledger-core/testlib/Test/Cardano/Ledger/Core/Arbitrary.hs @@ -36,6 +36,14 @@ module Test.Cardano.Ledger.Core.Arbitrary ( genValidAndUnknownCostModels, genValidCostModel, + -- * Metadata + genMetadatumInt, + genMetadatumString, + genUtf8StringOfSize, + genMetadatumBytestring, + genMetadatumList, + genMetadatumMap, + -- * Utils -- | Will need to find a better home in the future @@ -101,6 +109,7 @@ import Cardano.Ledger.Keys ( ) import Cardano.Ledger.Keys.Bootstrap (BootstrapWitness (..), ChainCode (..)) import Cardano.Ledger.Keys.WitVKey (WitVKey (..)) +import Cardano.Ledger.Metadata import Cardano.Ledger.Plutus.CostModels ( CostModel, CostModelApplyError (..), @@ -136,8 +145,10 @@ import Cardano.Ledger.UMap ( unify, ) import Cardano.Ledger.UTxO (UTxO (..)) +import Control.Exception (assert) import Control.Monad (replicateM) import Control.Monad.Identity (Identity) +import qualified Data.ByteString as BS (length, pack) import Data.GenValidity import Data.Int (Int64) import Data.Map.Strict (Map) @@ -146,6 +157,7 @@ import Data.Ratio ((%)) import Data.Set (Set) import qualified Data.Set as Set import qualified Data.Text as T +import qualified Data.Text.Encoding as T (encodeUtf8) import Data.Typeable import qualified Data.VMap as VMap import Data.Word (Word16, Word32, Word64, Word8) @@ -703,7 +715,7 @@ genRightPreferenceUMap = do pure (umap, Map.fromList $ zip subdomain coins) ------------------------------------------------------------------------------------------ --- Cardano.Ledger.CertState ------------------------------------------------------------------- +-- Cardano.Ledger.CertState -------------------------------------------------------------- ------------------------------------------------------------------------------------------ instance Era era => Arbitrary (CertState era) where @@ -784,7 +796,7 @@ instance Crypto c => Arbitrary (Stake c) where pure (Map.fromList list) ------------------------------------------------------------------------------------------ --- Cardano.Ledger.Core.TxCert ---------------------------------------------------------- +-- Cardano.Ledger.Core.TxCert ------------------------------------------------------------ ------------------------------------------------------------------------------------------ instance Crypto c => Arbitrary (PoolCert c) where @@ -796,7 +808,7 @@ instance Crypto c => Arbitrary (PoolCert c) where shrink = genericShrink ------------------------------------------------------------------------------------------ --- Cardano.Ledger.Plutus ---------------------------------------------------------- +-- Cardano.Ledger.Plutus ----------------------------------------------------------------- ------------------------------------------------------------------------------------------ instance Arbitrary Language where @@ -891,3 +903,73 @@ genCostModelValues lang = do listAtLeast x = do NonNegative y <- arbitrary replicateM (x + y) arbitrary + +------------------------------------------------------------------------------------------ +-- Cardano.Ledger.Metadata --------------------------------------------------------------- +------------------------------------------------------------------------------------------ + +-- | Generate one of the Metadatum +instance Arbitrary Metadatum where + arbitrary = do + oneof + [ genMetadatumInt + , genMetadatumString + , genMetadatumBytestring + , genMetadatumList + , genMetadatumMap + ] + +genMetadatumInt :: Gen Metadatum +genMetadatumInt = + I + <$> frequency + [ (7, choose (minVal, maxVal)) + , (1, choose (minVal, minVal + 5)) + , (1, choose (maxVal - 5, maxVal)) + , (1, arbitrary) + ] + where + minVal, maxVal :: Integer + minVal = -maxVal + maxVal = fromIntegral (maxBound :: Word64) + +genMetadatumString :: Gen Metadatum +genMetadatumString = + sized $ \sz -> do + n <- choose (0, min sz 64) + cs <- genUtf8StringOfSize n + let s = T.pack cs + assert (BS.length (T.encodeUtf8 s) == n) $ + pure (S s) + +-- | Produce an arbitrary Unicode string such that it's UTF8 encoding size in +-- bytes is exactly the given length. +genUtf8StringOfSize :: Int -> Gen [Char] +genUtf8StringOfSize 0 = return [] +genUtf8StringOfSize n = do + cz <- choose (1, min n 4) + c <- case cz of + 1 -> choose ('\x00000', '\x00007f') + 2 -> choose ('\x00080', '\x0007ff') + 3 -> + oneof + [ choose ('\x00800', '\x00d7ff') + , -- skipping UTF-16 surrogates d800--dfff + choose ('\x0e000', '\x00ffff') + ] + _ -> choose ('\x10000', '\x10ffff') + cs <- genUtf8StringOfSize (n - cz) + return (c : cs) + +genMetadatumBytestring :: Gen Metadatum +genMetadatumBytestring = do + n <- choose (0, 64) + B . BS.pack <$> vector n + +-- | Generate a `Cardano.Ledger.Metadata.List`, @List [Metadatum]@ +genMetadatumList :: Gen Metadatum +genMetadatumList = List <$> scale (`div` 2) arbitrary + +-- | Generate a `Cardano.Ledger.Metadata.Map`, i.e. @Map [(Metadatum, Metadatum)]'@ +genMetadatumMap :: Gen Metadatum +genMetadatumMap = Map <$> scale (`div` 2) arbitrary