{-# LANGUAGE NamedFieldPuns #-}
module Test.Cardano.Ledger.Shelley.Generator.TxAuxData (
genMetadata,
genMetadata',
) where
import Cardano.Ledger.BaseTypes (
StrictMaybe (..),
)
import Cardano.Ledger.Core
import Cardano.Ledger.Shelley.TxAuxData (
Metadatum (..),
ShelleyTxAuxData (..),
)
import Control.Exception (assert)
import qualified Data.ByteString.Char8 as BS (length, pack)
import qualified Data.Map.Strict as Map
import qualified Data.Text as T (pack)
import qualified Data.Text.Encoding as T
import Data.Word (Word64)
import Test.Cardano.Ledger.Shelley.Constants (Constants (..))
import Test.QuickCheck (Gen)
import qualified Test.QuickCheck as QC
collectionDatumMaxSize :: Int
collectionDatumMaxSize :: Int
collectionDatumMaxSize = Int
5
metadataMaxSize :: Int
metadataMaxSize :: Int
metadataMaxSize = Int
3
genMetadata :: Era era => Constants -> Gen (StrictMaybe (ShelleyTxAuxData era))
genMetadata :: forall era.
Era era =>
Constants -> Gen (StrictMaybe (ShelleyTxAuxData era))
genMetadata (Constants {Int
frequencyTxWithMetadata :: Constants -> Int
frequencyTxWithMetadata :: Int
frequencyTxWithMetadata}) =
[(Int, Gen (StrictMaybe (ShelleyTxAuxData era)))]
-> Gen (StrictMaybe (ShelleyTxAuxData era))
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
QC.frequency
[ (Int
frequencyTxWithMetadata, ShelleyTxAuxData era -> StrictMaybe (ShelleyTxAuxData era)
forall a. a -> StrictMaybe a
SJust (ShelleyTxAuxData era -> StrictMaybe (ShelleyTxAuxData era))
-> Gen (ShelleyTxAuxData era)
-> Gen (StrictMaybe (ShelleyTxAuxData era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyTxAuxData era)
forall era. Era era => Gen (ShelleyTxAuxData era)
genMetadata')
, (Int
100 Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
frequencyTxWithMetadata, StrictMaybe (ShelleyTxAuxData era)
-> Gen (StrictMaybe (ShelleyTxAuxData era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure StrictMaybe (ShelleyTxAuxData era)
forall a. StrictMaybe a
SNothing)
]
genMetadata' :: Era era => Gen (ShelleyTxAuxData era)
genMetadata' :: forall era. Era era => Gen (ShelleyTxAuxData era)
genMetadata' = do
Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
1, Int
metadataMaxSize)
Map Word64 Metadatum -> ShelleyTxAuxData era
forall era. Era era => Map Word64 Metadatum -> ShelleyTxAuxData era
ShelleyTxAuxData (Map Word64 Metadatum -> ShelleyTxAuxData era)
-> ([(Word64, Metadatum)] -> Map Word64 Metadatum)
-> [(Word64, Metadatum)]
-> ShelleyTxAuxData era
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(Word64, Metadatum)] -> Map Word64 Metadatum
forall k a. Ord k => [(k, a)] -> Map k a
Map.fromList
([(Word64, Metadatum)] -> ShelleyTxAuxData era)
-> Gen [(Word64, Metadatum)] -> Gen (ShelleyTxAuxData era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (Word64, Metadatum) -> Gen [(Word64, Metadatum)]
forall a. Int -> Gen a -> Gen [a]
QC.vectorOf Int
n Gen (Word64, Metadatum)
genMetadatum
genMetadatum :: Gen (Word64, Metadatum)
genMetadatum :: Gen (Word64, Metadatum)
genMetadatum = do
(,)
(Word64 -> Metadatum -> (Word64, Metadatum))
-> Gen Word64 -> Gen (Metadatum -> (Word64, Metadatum))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
QC.arbitrary
Gen (Metadatum -> (Word64, Metadatum))
-> Gen Metadatum -> Gen (Word64, Metadatum)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> ( [Gen Metadatum] -> Gen Metadatum
forall a. HasCallStack => [Gen a] -> Gen a
QC.oneof
[ Gen Metadatum
genDatumInt
, Gen Metadatum
genDatumString
, Gen Metadatum
genDatumBytestring
, Gen Metadatum
genMetadatumList
, Gen Metadatum
genMetadatumMap
]
)
genDatumInt :: Gen Metadatum
genDatumInt :: Gen Metadatum
genDatumInt =
Integer -> Metadatum
I
(Integer -> Metadatum) -> Gen Integer -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [(Int, Gen Integer)] -> Gen Integer
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
QC.frequency
[ (Int
8, (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
QC.choose (Integer
minVal, Integer
maxVal))
, (Int
1, Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
minVal)
, (Int
1, Integer -> Gen Integer
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Integer
maxVal)
]
where
minVal, maxVal :: Integer
minVal :: Integer
minVal = -Integer
maxVal
maxVal :: Integer
maxVal = Word64 -> Integer
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64
forall a. Bounded a => a
maxBound :: Word64)
genDatumString :: Gen Metadatum
genDatumString :: Gen Metadatum
genDatumString =
(Int -> Gen Metadatum) -> Gen Metadatum
forall a. (Int -> Gen a) -> Gen a
QC.sized ((Int -> Gen Metadatum) -> Gen Metadatum)
-> (Int -> Gen Metadatum) -> Gen Metadatum
forall a b. (a -> b) -> a -> b
$ \Int
sz -> do
Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
sz Int
64)
[Char]
cs <- Int -> Gen [Char]
genUtf8StringOfSize Int
n
let s :: Text
s = [Char] -> Text
T.pack [Char]
cs
Bool -> Gen Metadatum -> Gen Metadatum
forall a. HasCallStack => Bool -> a -> a
assert (ByteString -> Int
BS.length (Text -> ByteString
T.encodeUtf8 Text
s) Int -> Int -> Bool
forall a. Eq a => a -> a -> Bool
== Int
n) (Gen Metadatum -> Gen Metadatum) -> Gen Metadatum -> Gen Metadatum
forall a b. (a -> b) -> a -> b
$
Metadatum -> Gen Metadatum
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Text -> Metadatum
S Text
s)
genUtf8StringOfSize :: Int -> Gen [Char]
genUtf8StringOfSize :: Int -> Gen [Char]
genUtf8StringOfSize Int
0 = [Char] -> Gen [Char]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return []
genUtf8StringOfSize Int
n = do
Int
cz <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
1, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
n Int
4)
Char
c <- case Int
cz of
Int
1 -> (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
QC.choose (Char
'\x00000', Char
'\x00007f')
Int
2 -> (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
QC.choose (Char
'\x00080', Char
'\x0007ff')
Int
3 ->
[Gen Char] -> Gen Char
forall a. HasCallStack => [Gen a] -> Gen a
QC.oneof
[ (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
QC.choose (Char
'\x00800', Char
'\x00d7ff')
,
(Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
QC.choose (Char
'\x0e000', Char
'\x00ffff')
]
Int
_ -> (Char, Char) -> Gen Char
forall a. Random a => (a, a) -> Gen a
QC.choose (Char
'\x10000', Char
'\x10ffff')
[Char]
cs <- Int -> Gen [Char]
genUtf8StringOfSize (Int
n Int -> Int -> Int
forall a. Num a => a -> a -> a
- Int
cz)
[Char] -> Gen [Char]
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Char
c Char -> [Char] -> [Char]
forall a. a -> [a] -> [a]
: [Char]
cs)
genDatumBytestring :: Gen Metadatum
genDatumBytestring :: Gen Metadatum
genDatumBytestring =
(Int -> Gen Metadatum) -> Gen Metadatum
forall a. (Int -> Gen a) -> Gen a
QC.sized ((Int -> Gen Metadatum) -> Gen Metadatum)
-> (Int -> Gen Metadatum) -> Gen Metadatum
forall a b. (a -> b) -> a -> b
$ \Int
sz -> do
Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
0, Int -> Int -> Int
forall a. Ord a => a -> a -> a
min Int
sz Int
64)
ByteString -> Metadatum
B (ByteString -> Metadatum)
-> ([Char] -> ByteString) -> [Char] -> Metadatum
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Char] -> ByteString
BS.pack ([Char] -> Metadatum) -> Gen [Char] -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Char -> Gen [Char]
forall a. Int -> Gen a -> Gen [a]
QC.vectorOf Int
n Gen Char
forall a. Arbitrary a => Gen a
QC.arbitrary
genMetadatumList :: Gen Metadatum
genMetadatumList :: Gen Metadatum
genMetadatumList = [Metadatum] -> Metadatum
List ([Metadatum] -> Metadatum) -> Gen [Metadatum] -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Metadatum]
vectorOfMetadatumSimple
genMetadatumMap :: Gen Metadatum
genMetadatumMap :: Gen Metadatum
genMetadatumMap =
[(Metadatum, Metadatum)] -> Metadatum
Map ([(Metadatum, Metadatum)] -> Metadatum)
-> Gen [(Metadatum, Metadatum)] -> Gen Metadatum
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ([Metadatum] -> [Metadatum] -> [(Metadatum, Metadatum)]
forall a b. [a] -> [b] -> [(a, b)]
zip ([Metadatum] -> [Metadatum] -> [(Metadatum, Metadatum)])
-> Gen [Metadatum] -> Gen ([Metadatum] -> [(Metadatum, Metadatum)])
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen [Metadatum]
vectorOfMetadatumSimple Gen ([Metadatum] -> [(Metadatum, Metadatum)])
-> Gen [Metadatum] -> Gen [(Metadatum, Metadatum)]
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [Metadatum]
vectorOfMetadatumSimple)
vectorOfMetadatumSimple :: Gen [Metadatum]
vectorOfMetadatumSimple :: Gen [Metadatum]
vectorOfMetadatumSimple = do
Int
n <- (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
QC.choose (Int
1, Int
collectionDatumMaxSize)
Int -> Gen Metadatum -> Gen [Metadatum]
forall a. Int -> Gen a -> Gen [a]
QC.vectorOf
Int
n
( [Gen Metadatum] -> Gen Metadatum
forall a. HasCallStack => [Gen a] -> Gen a
QC.oneof
[ Gen Metadatum
genDatumInt
, Gen Metadatum
genDatumString
, Gen Metadatum
genDatumBytestring
]
)