{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Test.Consensus.Protocol.Praos.SelectView (tests) where
import qualified Cardano.Crypto.Hash as Crypto
import qualified Cardano.Crypto.Util as Crypto
import Cardano.Crypto.VRF (OutputVRF, mkTestOutputVRF)
import Cardano.Ledger.Crypto (Crypto (..), StandardCrypto)
import qualified Cardano.Ledger.Keys as SL
import Codec.Serialise (encode)
import Control.Monad
import Data.Containers.ListUtils (nubOrdOn)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.Protocol.Praos.Common
import Test.Cardano.Ledger.Binary.Arbitrary ()
import Test.Ouroboros.Consensus.Protocol
import Test.QuickCheck.Gen (Gen (..))
import Test.QuickCheck.Random (mkQCGen)
import Test.Tasty
import Test.Tasty.QuickCheck hiding (elements)
import Test.Util.QuickCheck
import Test.Util.TestEnv
tests :: TestTree
tests :: TestTree
tests = TestName -> [TestTree] -> TestTree
testGroup TestName
"PraosChainSelectView"
[ (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckTests (Int -> Int -> Int
forall a. Num a => a -> a -> a
* Int
50)
(TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ (Int -> Int) -> TestTree -> TestTree
adjustQuickCheckMaxSize (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
10)
(TestTree -> TestTree) -> TestTree -> TestTree
forall a b. (a -> b) -> a -> b
$ Proxy (PraosChainSelectView StandardCrypto) -> TestTree
forall a.
(ChainOrder a, Typeable a, Arbitrary a, Show a,
Arbitrary (ChainOrderConfig a), Show (ChainOrderConfig a)) =>
Proxy a -> TestTree
tests_chainOrder (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @(PraosChainSelectView StandardCrypto))
]
instance Crypto c => Arbitrary (PraosChainSelectView c) where
arbitrary :: Gen (PraosChainSelectView c)
arbitrary = do
Word64
size <- Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Gen Int -> Gen Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
getSize
BlockNo
csvChainLength <- Word64 -> BlockNo
BlockNo (Word64 -> BlockNo) -> Gen Word64 -> Gen BlockNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
size)
SlotNo
csvSlotNo <- Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
size)
VKey 'BlockIssuer c
csvIssuer <- [VKey 'BlockIssuer c] -> Gen (VKey 'BlockIssuer c)
forall a. HasCallStack => [a] -> Gen a
elements [VKey 'BlockIssuer c]
knownIssuers
Word64
csvIssueNo <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
10)
PraosChainSelectView c -> Gen (PraosChainSelectView c)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure PraosChainSelectView {
BlockNo
csvChainLength :: BlockNo
csvChainLength :: BlockNo
csvChainLength
, SlotNo
csvSlotNo :: SlotNo
csvSlotNo :: SlotNo
csvSlotNo
, VKey 'BlockIssuer c
csvIssuer :: VKey 'BlockIssuer c
csvIssuer :: VKey 'BlockIssuer c
csvIssuer
, Word64
csvIssueNo :: Word64
csvIssueNo :: Word64
csvIssueNo
, csvTieBreakVRF :: OutputVRF (VRF c)
csvTieBreakVRF = VKey 'BlockIssuer c -> SlotNo -> OutputVRF (VRF c)
mkVRFFor VKey 'BlockIssuer c
csvIssuer SlotNo
csvSlotNo
}
where
knownIssuers :: [SL.VKey SL.BlockIssuer c]
knownIssuers :: [VKey 'BlockIssuer c]
knownIssuers =
(VKey 'BlockIssuer c -> KeyHash 'BlockIssuer c)
-> [VKey 'BlockIssuer c] -> [VKey 'BlockIssuer c]
forall b a. Ord b => (a -> b) -> [a] -> [a]
nubOrdOn VKey 'BlockIssuer c -> KeyHash 'BlockIssuer c
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
SL.hashKey
([VKey 'BlockIssuer c] -> [VKey 'BlockIssuer c])
-> [VKey 'BlockIssuer c] -> [VKey 'BlockIssuer c]
forall a b. (a -> b) -> a -> b
$ Gen [VKey 'BlockIssuer c] -> QCGen -> Int -> [VKey 'BlockIssuer c]
forall a. Gen a -> QCGen -> Int -> a
unGen (Int -> Gen (VKey 'BlockIssuer c) -> Gen [VKey 'BlockIssuer c]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM Int
numIssuers (VerKeyDSIGN (DSIGN c) -> VKey 'BlockIssuer c
forall (kd :: KeyRole) c. VerKeyDSIGN (DSIGN c) -> VKey kd c
SL.VKey (VerKeyDSIGN (DSIGN c) -> VKey 'BlockIssuer c)
-> Gen (VerKeyDSIGN (DSIGN c)) -> Gen (VKey 'BlockIssuer c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (VerKeyDSIGN (DSIGN c))
forall a. Arbitrary a => Gen a
arbitrary)) QCGen
randomSeed Int
100
where
randomSeed :: QCGen
randomSeed = Int -> QCGen
mkQCGen Int
4
numIssuers :: Int
numIssuers = Int
10
mkVRFFor :: SL.VKey SL.BlockIssuer c -> SlotNo -> OutputVRF (VRF c)
mkVRFFor :: VKey 'BlockIssuer c -> SlotNo -> OutputVRF (VRF c)
mkVRFFor VKey 'BlockIssuer c
issuer SlotNo
slot =
Natural -> OutputVRF (VRF c)
forall v. VRFAlgorithm v => Natural -> OutputVRF v
mkTestOutputVRF
(Natural -> OutputVRF (VRF c)) -> Natural -> OutputVRF (VRF c)
forall a b. (a -> b) -> a -> b
$ ByteString -> Natural
Crypto.bytesToNatural
(ByteString -> Natural) -> ByteString -> Natural
forall a b. (a -> b) -> a -> b
$ Hash (ADDRHASH c) SlotNo -> ByteString
forall h a. Hash h a -> ByteString
Crypto.hashToBytes
(Hash (ADDRHASH c) SlotNo -> ByteString)
-> Hash (ADDRHASH c) SlotNo -> ByteString
forall a b. (a -> b) -> a -> b
$ Hash (ADDRHASH c) SlotNo
-> Hash (ADDRHASH c) SlotNo -> Hash (ADDRHASH c) SlotNo
forall h a. Hash h a -> Hash h a -> Hash h a
Crypto.xor (Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
-> Hash (ADDRHASH c) SlotNo
forall h a b. Hash h a -> Hash h b
Crypto.castHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
issuerHash)
(Hash (ADDRHASH c) SlotNo -> Hash (ADDRHASH c) SlotNo)
-> Hash (ADDRHASH c) SlotNo -> Hash (ADDRHASH c) SlotNo
forall a b. (a -> b) -> a -> b
$ (SlotNo -> Encoding) -> SlotNo -> Hash (ADDRHASH c) SlotNo
forall h a. HashAlgorithm h => (a -> Encoding) -> a -> Hash h a
Crypto.hashWithSerialiser SlotNo -> Encoding
forall a. Serialise a => a -> Encoding
encode SlotNo
slot
where
SL.KeyHash Hash (ADDRHASH c) (VerKeyDSIGN (DSIGN c))
issuerHash = VKey 'BlockIssuer c -> KeyHash 'BlockIssuer c
forall c (kd :: KeyRole). Crypto c => VKey kd c -> KeyHash kd c
SL.hashKey VKey 'BlockIssuer c
issuer
instance Arbitrary VRFTiebreakerFlavor where
arbitrary :: Gen VRFTiebreakerFlavor
arbitrary = [Gen VRFTiebreakerFlavor] -> Gen VRFTiebreakerFlavor
forall a. [Gen a] -> Gen a
oneof
[ VRFTiebreakerFlavor -> Gen VRFTiebreakerFlavor
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure VRFTiebreakerFlavor
UnrestrictedVRFTiebreaker
, do
Word64
size <- Word64 -> Word64 -> Word64
forall a. Ord a => a -> a -> a
max Word64
1 (Word64 -> Word64) -> (Int -> Word64) -> Int -> Word64
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Int -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Int -> Word64) -> Gen Int -> Gen Word64
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Int
getSize
SlotNo -> VRFTiebreakerFlavor
RestrictedVRFTiebreaker (SlotNo -> VRFTiebreakerFlavor)
-> (Word64 -> SlotNo) -> Word64 -> VRFTiebreakerFlavor
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo (Word64 -> VRFTiebreakerFlavor)
-> Gen Word64 -> Gen VRFTiebreakerFlavor
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
size)
]
shrink :: VRFTiebreakerFlavor -> [VRFTiebreakerFlavor]
shrink = \case
VRFTiebreakerFlavor
UnrestrictedVRFTiebreaker -> []
RestrictedVRFTiebreaker SlotNo
maxDist ->
VRFTiebreakerFlavor
UnrestrictedVRFTiebreaker
VRFTiebreakerFlavor
-> [VRFTiebreakerFlavor] -> [VRFTiebreakerFlavor]
forall a. a -> [a] -> [a]
: (SlotNo -> VRFTiebreakerFlavor
RestrictedVRFTiebreaker (SlotNo -> VRFTiebreakerFlavor)
-> [SlotNo] -> [VRFTiebreakerFlavor]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> SlotNo -> [SlotNo]
forall a. Arbitrary a => a -> [a]
shrink SlotNo
maxDist)