Move Arbitrary Metadatum instance into Core testlib

IntersectMBO · Apr 16, 2024 · 8931d44 · 8931d44
1 parent 5c5c2b9
commit 8931d44
Show file tree

Hide file tree

Showing 3 changed files with 103 additions and 71 deletions.
diff --git 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,13 +325,15 @@ 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)
 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
@@ -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
@@ -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