-- | The sizes the mempool charges for an endorser block agree with
-- the bytes 'encodeLeiosEb' writes.
module Test.Consensus.Shelley.EndorserBlock (tests) where

import qualified Codec.CBOR.Encoding as CBOR
import Codec.CBOR.Write (toStrictByteString)
import qualified Data.ByteString as BS
import qualified Data.Vector.Strict as V
import Ouroboros.Consensus.Ledger.SupportsMempool (ByteSize32 (..))
import Ouroboros.Consensus.Leios.Types
  ( BytesSize
  , LeiosEb (..)
  , TxHash (..)
  , encodeLeiosEb
  , encodeLeiosEbItemSize
  , encodeLeiosEbMaxFramingSize
  , leiosReferencesCapacity
  )
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck

tests :: TestTree
tests :: TestTree
tests =
  [Char] -> [TestTree] -> TestTree
testGroup
    [Char]
"Endorser block"
    [ [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"encodeLeiosEbItemSize consistent with encodeLeiosEb" Property
prop_referenceSizeConsistent
    , [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty [Char]
"encodeLeiosEb framing bounded by encodeLeiosEbMaxFramingSize" Property
prop_ebFramingBounded
    , [Char] -> Property -> TestTree
forall a. Testable a => [Char] -> a -> TestTree
testProperty
        [Char]
"leiosReferencesCapacity floors at zero instead of wrapping"
        Property
prop_referencesCapacityFloorsAtZero
    ]

genTxHash :: Gen TxHash
genTxHash :: Gen TxHash
genTxHash = ByteString -> TxHash
MkTxHash (ByteString -> TxHash)
-> ([Word8] -> ByteString) -> [Word8] -> TxHash
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [Word8] -> ByteString
BS.pack ([Word8] -> TxHash) -> Gen [Word8] -> Gen TxHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen Word8 -> Gen [Word8]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
32 Gen Word8
forall a. Arbitrary a => Gen a
arbitrary

-- | A tx size with good coverage of CBOR encoding boundaries.
-- Values 0-23 encode in 1 byte, 24-255 in 2 bytes, 256-65535 in 3 bytes.
genTxBytesSize :: Gen BytesSize
genTxBytesSize :: Gen Word32
genTxBytesSize =
  [(Int, Gen Word32)] -> Gen Word32
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
1, Word32 -> Gen Word32
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
55) -- smallest transaction
    , (Int
1, Word32 -> Gen Word32
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
16384) -- largest transaction
    , (Int
1, Word32 -> Gen Word32
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
255) -- boundary: last 2-byte CBOR uint
    , (Int
1, Word32 -> Gen Word32
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
256) -- boundary: first 3-byte CBOR uint
    , (Int
1, Word32 -> Gen Word32
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Word32
65536) -- first 5-byte CBOR uint
    , (Int
5, (Word32, Word32) -> Gen Word32
forall a. Enum a => (a, a) -> Gen a
chooseEnum (Word32
55, Word32
16384))
    ]

-- | The number of references with good coverage of CBOR encoding boundaries for
-- the map length: 0-23 in 1 byte, 24-255 in 2 bytes, 256 and more in 3 bytes.
genNumReferences :: Gen Int
genNumReferences :: Gen Int
genNumReferences =
  [(Int, Gen Int)] -> Gen Int
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
    [ (Int
1, Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
0)
    , (Int
1, Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
1)
    , (Int
1, Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
23)
    , (Int
1, Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
24)
    , (Int
1, Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
255)
    , (Int
1, Int -> Gen Int
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Int
256)
    , (Int
3, (Int, Int) -> Gen Int
chooseInt (Int
0, Int
1000))
    ]

genLeiosEb :: Int -> Gen LeiosEb
genLeiosEb :: Int -> Gen LeiosEb
genLeiosEb Int
numTxs =
  Vector (TxHash, Word32) -> LeiosEb
MkLeiosEb (Vector (TxHash, Word32) -> LeiosEb)
-> ([(TxHash, Word32)] -> Vector (TxHash, Word32))
-> [(TxHash, Word32)]
-> LeiosEb
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(TxHash, Word32)] -> Vector (TxHash, Word32)
forall a. [a] -> Vector a
V.fromList ([(TxHash, Word32)] -> LeiosEb)
-> Gen [(TxHash, Word32)] -> Gen LeiosEb
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen (TxHash, Word32) -> Gen [(TxHash, Word32)]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
numTxs ((,) (TxHash -> Word32 -> (TxHash, Word32))
-> Gen TxHash -> Gen (Word32 -> (TxHash, Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxHash
genTxHash Gen (Word32 -> (TxHash, Word32))
-> Gen Word32 -> Gen (TxHash, Word32)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
genTxBytesSize)

-- | The per-reference charge 'encodeLeiosEbItemSize', which the mempool charges a
-- transaction for its reference, agrees with the bytes 'encodeLeiosEb' writes
-- for that reference.
prop_referenceSizeConsistent :: Property
prop_referenceSizeConsistent :: Property
prop_referenceSizeConsistent =
  Gen (TxHash, Word32) -> ((TxHash, Word32) -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll ((,) (TxHash -> Word32 -> (TxHash, Word32))
-> Gen TxHash -> Gen (Word32 -> (TxHash, Word32))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxHash
genTxHash Gen (Word32 -> (TxHash, Word32))
-> Gen Word32 -> Gen (TxHash, Word32)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word32
genTxBytesSize) (((TxHash, Word32) -> Property) -> Property)
-> ((TxHash, Word32) -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \(txHash :: TxHash
txHash@(MkTxHash ByteString
bytes), Word32
txSize) ->
    let encoded :: ByteString
encoded = Encoding -> ByteString
toStrictByteString (Encoding -> ByteString) -> Encoding -> ByteString
forall a b. (a -> b) -> a -> b
$ ByteString -> Encoding
CBOR.encodeBytes ByteString
bytes Encoding -> Encoding -> Encoding
forall a. Semigroup a => a -> a -> a
<> Word32 -> Encoding
CBOR.encodeWord32 Word32
txSize
        ByteSize32 Word32
estimatedSize = ByteSize32 -> ByteSize32
encodeLeiosEbItemSize (Word32 -> ByteSize32
ByteSize32 Word32
txSize)
     in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample
          ([Char]
"reference: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> (TxHash, Word32) -> [Char]
forall a. Show a => a -> [Char]
show (TxHash
txHash, Word32
txSize))
          (Word32
estimatedSize Word32 -> Word32 -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int
BS.length ByteString
encoded))

-- | Whatever 'encodeLeiosEb' writes around the references stays within
-- 'encodeLeiosEbMaxFramingSize', the one-off amount capacities subtract.
prop_ebFramingBounded :: Property
prop_ebFramingBounded :: Property
prop_ebFramingBounded =
  Gen LeiosEb -> (LeiosEb -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Gen Int
genNumReferences Gen Int -> (Int -> Gen LeiosEb) -> Gen LeiosEb
forall a b. Gen a -> (a -> Gen b) -> Gen b
forall (m :: * -> *) a b. Monad m => m a -> (a -> m b) -> m b
>>= Int -> Gen LeiosEb
genLeiosEb) ((LeiosEb -> Property) -> Property)
-> (LeiosEb -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \LeiosEb
eb ->
    let actualSize :: Word32
actualSize = Int -> Word32
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word32) -> Int -> Word32
forall a b. (a -> b) -> a -> b
$ ByteString -> Int
BS.length (Encoding -> ByteString
toStrictByteString (LeiosEb -> Encoding
encodeLeiosEb LeiosEb
eb))
        itemsSize :: Word32
itemsSize =
          [Word32] -> Word32
forall a. Num a => [a] -> a
forall (t :: * -> *) a. (Foldable t, Num a) => t a -> a
sum
            [ ByteSize32 -> Word32
unByteSize32 (ByteSize32 -> ByteSize32
encodeLeiosEbItemSize (Word32 -> ByteSize32
ByteSize32 Word32
txSize))
            | (TxHash
_txHash, Word32
txSize) <- Vector (TxHash, Word32) -> [(TxHash, Word32)]
forall a. Vector a -> [a]
V.toList (LeiosEb -> Vector (TxHash, Word32)
leiosEbTxs LeiosEb
eb)
            ]
        framing :: Word32
framing = Word32
actualSize Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
- Word32
itemsSize
     in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample
          ([Char]
"references: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Int -> [Char]
forall a. Show a => a -> [Char]
show (Vector (TxHash, Word32) -> Int
forall a. Vector a -> Int
V.length (LeiosEb -> Vector (TxHash, Word32)
leiosEbTxs LeiosEb
eb)) [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> [Char]
", framing: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
framing)
          (Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$ Word32
actualSize Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word32
itemsSize Bool -> Bool -> Bool
&& Word32
framing Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= ByteSize32 -> Word32
unByteSize32 ByteSize32
encodeLeiosEbMaxFramingSize)

-- | A @maxEndorserBlockReferencesSize@ at or below the framing yields a zero
-- references capacity, so nothing fits. It never wraps around to \"no limit\",
-- which 'Data.Word.Word32' subtraction would do for a parameter of 0.
prop_referencesCapacityFloorsAtZero :: Property
prop_referencesCapacityFloorsAtZero :: Property
prop_referencesCapacityFloorsAtZero =
  Gen Word32 -> (Word32 -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Word32
genParamLimit ((Word32 -> Property) -> Property)
-> (Word32 -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Word32
paramLimit ->
    let capacity :: Word32
capacity = Word32 -> Word32
leiosReferencesCapacity Word32
paramLimit
     in [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample ([Char]
"capacity: " [Char] -> [Char] -> [Char]
forall a. Semigroup a => a -> a -> a
<> Word32 -> [Char]
forall a. Show a => a -> [Char]
show Word32
capacity) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
          [Property] -> Property
forall prop. Testable prop => [prop] -> Property
conjoin
            [ [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample [Char]
"capacity must never exceed the parameter (wrap-around)" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                Bool -> Property
forall prop. Testable prop => prop -> Property
property (Bool -> Property) -> Bool -> Property
forall a b. (a -> b) -> a -> b
$
                  Word32
capacity Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
<= Word32
paramLimit
            , [Char] -> Property -> Property
forall prop. Testable prop => [Char] -> prop -> Property
counterexample [Char]
"a parameter within the framing must yield zero capacity" (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
                Word32
paramLimit Word32 -> Word32 -> Bool
forall a. Ord a => a -> a -> Bool
> Word32
framing Bool -> Property -> Property
forall prop1 prop2.
(Testable prop1, Testable prop2) =>
prop1 -> prop2 -> Property
.||. Word32
capacity Word32 -> Word32 -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Word32
0
            ]
 where
  framing :: Word32
framing = ByteSize32 -> Word32
unByteSize32 ByteSize32
encodeLeiosEbMaxFramingSize

  -- Weighted towards the boundary a plain subtraction wraps on.
  genParamLimit :: Gen Word32
genParamLimit =
    [(Int, Gen Word32)] -> Gen Word32
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      [ (Int
4, (Word32, Word32) -> Gen Word32
forall a. Enum a => (a, a) -> Gen a
chooseEnum (Word32
0, Word32
framing))
      , (Int
1, (Word32, Word32) -> Gen Word32
forall a. Enum a => (a, a) -> Gen a
chooseEnum (Word32
framing Word32 -> Word32 -> Word32
forall a. Num a => a -> a -> a
+ Word32
1, Word32
forall a. Bounded a => a
maxBound))
      ]