{-# LANGUAGE ScopedTypeVariables #-}

-- | Property-based tests for 'Bitmap'
module Test.Consensus.Util.Bitmap (tests) where

import Cardano.Binary (decodeFull, serialize)
import qualified Data.Set as Set
import qualified Ouroboros.Consensus.Util.Bitmap as Bitmap
import Test.QuickCheck (Testable (..), counterexample, vectorOf)
import Test.Tasty
import Test.Tasty.QuickCheck
  ( Gen
  , Property
  , choose
  , forAll
  , testProperty
  , (===)
  )
import Test.Util.TestEnv (adjustQuickCheckTests)

tests :: TestTree
tests :: TestTree
tests =
  (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckTests (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
100) (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
    String -> [TestTree] -> TestTree
testGroup
      String
"Bitmap"
      [ String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty
          String
"prop_roundtrip_toIndices"
          Property
prop_roundtrip_toIndices
      , String -> Property -> TestTree
forall a. Testable a => String -> a -> TestTree
testProperty
          String
"prop_roundtrip_serialisation"
          Property
prop_roundtrip_serialisation
      ]

-- * Properties

-- | Converting from indices to bitmap and back preserves the indices.
prop_roundtrip_toIndices :: Property
prop_roundtrip_toIndices :: Property
prop_roundtrip_toIndices =
  Gen Int -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Int
genMaxIndex ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
maxIndex ->
    Gen Int -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Int
genNumIndices ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
numIndices -> do
      Gen [Int] -> ([Int] -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Int -> Int -> Gen [Int]
genIndices Int
numIndices Int
maxIndex) (([Int] -> Property) -> Property)
-> ([Int] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[Int]
indices -> do
        let bitmap :: Bitmap Int
bitmap = Int -> [Int] -> Bitmap Int
forall a. Integral a => a -> [a] -> Bitmap a
Bitmap.fromIndices Int
maxIndex [Int]
indices
        let indices' :: [Int]
indices' = Bitmap Int -> [Int]
forall a. Integral a => Bitmap a -> [a]
Bitmap.toIndices Bitmap Int
bitmap
        [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList [Int]
indices Set Int -> Set Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== [Int] -> Set Int
forall a. Ord a => [a] -> Set a
Set.fromList [Int]
indices'

-- | Serialisation roundtrip preserves the bitmap.
prop_roundtrip_serialisation :: Property
prop_roundtrip_serialisation :: Property
prop_roundtrip_serialisation =
  Gen Int -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Int
genMaxIndex ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
maxIndex ->
    Gen Int -> (Int -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen Int
genNumIndices ((Int -> Property) -> Property) -> (Int -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \Int
numIndices -> do
      Gen [Int] -> ([Int] -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll (Int -> Int -> Gen [Int]
genIndices Int
numIndices Int
maxIndex) (([Int] -> Property) -> Property)
-> ([Int] -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \[Int]
indices -> do
        let bitmap :: Bitmap Int
bitmap = Int -> [Int] -> Bitmap Int
forall a. Integral a => a -> [a] -> Bitmap a
Bitmap.fromIndices Int
maxIndex [Int]
indices
        let encoded :: ByteString
encoded = Bitmap Int -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize Bitmap Int
bitmap
        case ByteString -> Either DecoderError (Bitmap Int)
forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull ByteString
encoded of
          Left DecoderError
err ->
            String -> Property -> Property
forall prop. Testable prop => String -> prop -> Property
counterexample (String
"Deserialization failed: " String -> String -> String
forall a. Semigroup a => a -> a -> a
<> DecoderError -> String
forall a. Show a => a -> String
show DecoderError
err) (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$
              Bool -> Property
forall prop. Testable prop => prop -> Property
property Bool
False
          Right Bitmap Int
bitmap' ->
            Bitmap Int
bitmap Bitmap Int -> Bitmap Int -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Bitmap Int
bitmap'

-- * Generators

genMaxIndex :: Gen Int
genMaxIndex :: Gen Int
genMaxIndex =
  (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
10000)

genNumIndices :: Gen Int
genNumIndices :: Gen Int
genNumIndices =
  (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
100)

genIndices :: Int -> Int -> Gen [Int]
genIndices :: Int -> Int -> Gen [Int]
genIndices Int
numIndices Int
maxIndex =
  Int -> Gen Int -> Gen [Int]
forall a. Int -> Gen a -> Gen [a]
vectorOf Int
numIndices ((Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
0, Int
maxIndex))