{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE ScopedTypeVariables #-}

-- | Serialisation roundtrip tests for Peras types
module Test.Consensus.Peras.Serialisation
  ( tests
  ) where

import Cardano.Binary (FromCBOR (..), ToCBOR (..), decodeFull, serialize)
import qualified Data.ByteString.Lazy as LazyByteString
import Test.Consensus.Peras.Util
  ( genPerasCert
  , genPerasVote
  , mkBucket
  , tabulatePerasCert
  , tabulatePerasVote
  )
import Test.QuickCheck
  ( Gen
  , Property
  , counterexample
  , forAll
  , tabulate
  , (===)
  )
import Test.Tasty (TestTree, testGroup)
import Test.Tasty.QuickCheck (testProperty)
import Test.Util.TestEnv (adjustQuickCheckTests)

tests :: TestTree
tests :: TestTree
tests =
  TestName -> [TestTree] -> TestTree
testGroup
    TestName
"Serialization roundtrip for Peras types"
    [ (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckTests (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10) (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Roundtrip for PerasVote" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
          Gen PerasVote -> (PerasVote -> Property -> Property) -> Property
forall a.
(Eq a, Show a, ToCBOR a, FromCBOR a) =>
Gen a -> (a -> Property -> Property) -> Property
prop_roundtrip
            -- Generate both persistent and non-persistent votes
            (Bool -> Gen PerasVote
genPerasVote Bool
True)
            PerasVote -> Property -> Property
tabulatePerasVote
    , (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckTests (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
10) (TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$
        TestName -> Property -> TestTree
forall a. Testable a => TestName -> a -> TestTree
testProperty TestName
"Roundtrip for PerasCert" (Property -> TestTree) -> Property -> TestTree
forall a b. (a -> b) -> a -> b
$
          Gen PerasCert -> (PerasCert -> Property -> Property) -> Property
forall a.
(Eq a, Show a, ToCBOR a, FromCBOR a) =>
Gen a -> (a -> Property -> Property) -> Property
prop_roundtrip
            -- Generate certs with both persistent and non-persistent votes
            (Bool -> Gen PerasCert
genPerasCert Bool
True)
            PerasCert -> Property -> Property
tabulatePerasCert
    ]

-- * Properties

prop_roundtrip ::
  forall a.
  ( Eq a
  , Show a
  , ToCBOR a
  , FromCBOR a
  ) =>
  Gen a ->
  (a -> Property -> Property) ->
  Property
prop_roundtrip :: forall a.
(Eq a, Show a, ToCBOR a, FromCBOR a) =>
Gen a -> (a -> Property -> Property) -> Property
prop_roundtrip Gen a
gen a -> Property -> Property
tabulateValue =
  Gen a -> (a -> Property) -> Property
forall a prop.
(Show a, Testable prop) =>
Gen a -> (a -> prop) -> Property
forAll Gen a
gen ((a -> Property) -> Property) -> (a -> Property) -> Property
forall a b. (a -> b) -> a -> b
$ \a
a -> do
    let encoded :: ByteString
encoded = a -> ByteString
forall a. ToCBOR a => a -> ByteString
serialize a
a
    let decoded :: Either DecoderError a
decoded = ByteString -> Either DecoderError a
forall a. FromCBOR a => ByteString -> Either DecoderError a
decodeFull ByteString
encoded
    a -> Property -> Property
tabulateValue a
a
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ByteString -> Property -> Property
tabulateEncodedSize ByteString
encoded
      (Property -> Property)
-> (Property -> Property) -> Property -> Property
forall b c a. (b -> c) -> (a -> b) -> a -> c
. TestName -> Property -> Property
forall prop. Testable prop => TestName -> prop -> Property
counterexample
        ( [TestName] -> TestName
unlines
            [ TestName
"Original value:"
            , a -> TestName
forall a. Show a => a -> TestName
show a
a
            , TestName
"Decoded value:"
            , Either DecoderError a -> TestName
forall a. Show a => a -> TestName
show Either DecoderError a
decoded
            ]
        )
      (Property -> Property) -> Property -> Property
forall a b. (a -> b) -> a -> b
$ a -> Either DecoderError a
forall a b. b -> Either a b
Right a
a Either DecoderError a -> Either DecoderError a -> Property
forall a. (Eq a, Show a) => a -> a -> Property
=== Either DecoderError a
decoded

-- * Tabulators

tabulateEncodedSize :: LazyByteString.ByteString -> Property -> Property
tabulateEncodedSize :: ByteString -> Property -> Property
tabulateEncodedSize ByteString
bytes =
  TestName -> [TestName] -> Property -> Property
forall prop.
Testable prop =>
TestName -> [TestName] -> prop -> Property
tabulate
    TestName
"Encoded size"
    [Int -> Int -> TestName -> TestName
mkBucket Int
1000 (Int64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (ByteString -> Int64
LazyByteString.length ByteString
bytes)) TestName
" bytes"]