{-# LANGUAGE DataKinds #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}
module Test.Consensus.Shelley.Generators (SomeResult (..)) where
import Cardano.Ledger.Core (TranslationContext, toTxSeq)
import Cardano.Ledger.Genesis
import qualified Cardano.Ledger.Shelley.API as SL
import Cardano.Ledger.Shelley.Translation
import Cardano.Ledger.State (InstantStake)
import Cardano.Protocol.Crypto (Crypto)
import qualified Cardano.Protocol.TPraos.API as SL
import qualified Cardano.Protocol.TPraos.BHeader as SL
import Cardano.Slotting.EpochInfo
import Control.Monad (replicateM)
import Data.Coerce (coerce)
import Generic.Random (genericArbitraryU)
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Abstract
import Ouroboros.Consensus.Ledger.Query
import Ouroboros.Consensus.Ledger.SupportsMempool
import Ouroboros.Consensus.Protocol.Praos (Praos)
import qualified Ouroboros.Consensus.Protocol.Praos as Praos
import qualified Ouroboros.Consensus.Protocol.Praos.Header as Praos
import Ouroboros.Consensus.Protocol.TPraos (TPraos, TPraosState (..))
import Ouroboros.Consensus.Shelley.Eras
import Ouroboros.Consensus.Shelley.Ledger
import Ouroboros.Consensus.Shelley.Ledger.Query.Types
import Ouroboros.Consensus.Shelley.Protocol.Praos ()
import Ouroboros.Consensus.Shelley.Protocol.TPraos ()
import Ouroboros.Network.Block (mkSerialised)
import Test.Cardano.Ledger.AllegraEraGen ()
import Test.Cardano.Ledger.Alonzo.AlonzoEraGen ()
import Test.Cardano.Ledger.MaryEraGen ()
import Test.Cardano.Ledger.Shelley.Constants (defaultConstants,
numCoreNodes)
import Test.Cardano.Ledger.Shelley.Generator.Presets (genIssuerKeys)
import Test.Cardano.Ledger.Shelley.Generator.ShelleyEraGen ()
import Test.Cardano.Ledger.Shelley.Serialisation.EraIndepGenerators
(genCoherentBlock)
import Test.Cardano.Ledger.Shelley.Serialisation.Generators ()
import Test.Cardano.Ledger.ShelleyMA.Serialisation.Generators ()
import Test.Cardano.Protocol.TPraos.Arbitrary (genBlock)
import Test.Consensus.Protocol.Serialisation.Generators ()
import Test.Consensus.Shelley.MockCrypto (CanMock)
import Test.QuickCheck hiding (Result)
import Test.Util.Orphans.Arbitrary ()
import Test.Util.Serialisation.Roundtrip (Coherent (..),
WithVersion (..))
import Test.Util.Serialisation.SomeResult (SomeResult (..))
instance (CanMock (TPraos crypto) era)
=> Arbitrary (ShelleyBlock (TPraos crypto) era) where
arbitrary :: Gen (ShelleyBlock (TPraos crypto) era)
arbitrary = do
allPoolKeys <-
Int
-> Gen (AllIssuerKeys crypto Any) -> Gen [AllIssuerKeys crypto Any]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Constants -> Word64
numCoreNodes Constants
defaultConstants)
(Gen (AllIssuerKeys crypto Any) -> Gen [AllIssuerKeys crypto Any])
-> Gen (AllIssuerKeys crypto Any) -> Gen [AllIssuerKeys crypto Any]
forall a b. (a -> b) -> a -> b
$ Constants -> Gen (AllIssuerKeys crypto Any)
forall c (r :: KeyRole).
Crypto c =>
Constants -> Gen (AllIssuerKeys c r)
genIssuerKeys Constants
defaultConstants
mkShelleyBlock <$> genBlock allPoolKeys
instance (Praos.PraosCrypto crypto, CanMock (Praos crypto) era)
=> Arbitrary (ShelleyBlock (Praos crypto) era) where
arbitrary :: Gen (ShelleyBlock (Praos crypto) era)
arbitrary = Block (ShelleyProtocolHeader (Praos crypto)) era
-> ShelleyBlock (Praos crypto) era
Block (Header crypto) era -> ShelleyBlock (Praos crypto) era
forall proto era.
ShelleyCompatible proto era =>
Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era
mkShelleyBlock (Block (Header crypto) era -> ShelleyBlock (Praos crypto) era)
-> Gen (Block (Header crypto) era)
-> Gen (ShelleyBlock (Praos crypto) era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Block (Header crypto) era)
blk
where blk :: Gen (Block (Header crypto) era)
blk = Header crypto -> TxSeq era -> Block (Header crypto) era
forall era h.
(Era era, EncCBORGroup (TxSeq era), EncCBOR h) =>
h -> TxSeq era -> Block h era
SL.Block (Header crypto -> TxSeq era -> Block (Header crypto) era)
-> Gen (Header crypto)
-> Gen (TxSeq era -> Block (Header crypto) era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Header crypto)
forall a. Arbitrary a => Gen a
arbitrary Gen (TxSeq era -> Block (Header crypto) era)
-> Gen (TxSeq era) -> Gen (Block (Header crypto) era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (forall era. EraSegWits era => StrictSeq (Tx era) -> TxSeq era
toTxSeq @era (StrictSeq (Tx era) -> TxSeq era)
-> Gen (StrictSeq (Tx era)) -> Gen (TxSeq era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (StrictSeq (Tx era))
forall a. Arbitrary a => Gen a
arbitrary)
instance (CanMock (TPraos crypto) era)
=> Arbitrary (Coherent (ShelleyBlock (TPraos crypto) era)) where
arbitrary :: Gen (Coherent (ShelleyBlock (TPraos crypto) era))
arbitrary = do
allPoolKeys <-
Int
-> Gen (AllIssuerKeys crypto Any) -> Gen [AllIssuerKeys crypto Any]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Constants -> Word64
numCoreNodes Constants
defaultConstants)
(Gen (AllIssuerKeys crypto Any) -> Gen [AllIssuerKeys crypto Any])
-> Gen (AllIssuerKeys crypto Any) -> Gen [AllIssuerKeys crypto Any]
forall a b. (a -> b) -> a -> b
$ Constants -> Gen (AllIssuerKeys crypto Any)
forall c (r :: KeyRole).
Crypto c =>
Constants -> Gen (AllIssuerKeys c r)
genIssuerKeys Constants
defaultConstants
Coherent . mkShelleyBlock <$> genCoherentBlock allPoolKeys
instance (CanMock (Praos crypto) era)
=> Arbitrary (Coherent (ShelleyBlock (Praos crypto) era)) where
arbitrary :: Gen (Coherent (ShelleyBlock (Praos crypto) era))
arbitrary = do
allPoolKeys <-
Int
-> Gen (AllIssuerKeys crypto Any) -> Gen [AllIssuerKeys crypto Any]
forall (m :: * -> *) a. Applicative m => Int -> m a -> m [a]
replicateM (Word64 -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Word64 -> Int) -> Word64 -> Int
forall a b. (a -> b) -> a -> b
$ Constants -> Word64
numCoreNodes Constants
defaultConstants)
(Gen (AllIssuerKeys crypto Any) -> Gen [AllIssuerKeys crypto Any])
-> Gen (AllIssuerKeys crypto Any) -> Gen [AllIssuerKeys crypto Any]
forall a b. (a -> b) -> a -> b
$ Constants -> Gen (AllIssuerKeys crypto Any)
forall c (r :: KeyRole).
Crypto c =>
Constants -> Gen (AllIssuerKeys c r)
genIssuerKeys Constants
defaultConstants
blk <- genCoherentBlock allPoolKeys
Coherent . mkBlk <$> pure blk
where
mkBlk :: Block (BHeader c) era -> ShelleyBlock (Praos c) era
mkBlk Block (BHeader c) era
sleBlock = Block (ShelleyProtocolHeader (Praos c)) era
-> ShelleyBlock (Praos c) era
forall proto era.
ShelleyCompatible proto era =>
Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era
mkShelleyBlock (Block (ShelleyProtocolHeader (Praos c)) era
-> ShelleyBlock (Praos c) era)
-> Block (ShelleyProtocolHeader (Praos c)) era
-> ShelleyBlock (Praos c) era
forall a b. (a -> b) -> a -> b
$ let
SL.Block BHeader c
hdr1 TxSeq era
bdy = Block (BHeader c) era
sleBlock in Header c -> TxSeq era -> Block (Header c) era
forall era h.
(Era era, EncCBORGroup (TxSeq era), EncCBOR h) =>
h -> TxSeq era -> Block h era
SL.Block (BHeader c -> Header c
forall c. Crypto c => BHeader c -> Header c
translateHeader BHeader c
hdr1) TxSeq era
bdy
translateHeader :: Crypto c => SL.BHeader c -> Praos.Header c
translateHeader :: forall c. Crypto c => BHeader c -> Header c
translateHeader (SL.BHeader BHBody c
bhBody SignedKES (KES c) (BHBody c)
bhSig) =
HeaderBody c -> SignedKES (KES c) (HeaderBody c) -> Header c
forall crypto.
Crypto crypto =>
HeaderBody crypto
-> SignedKES (KES crypto) (HeaderBody crypto) -> Header crypto
Praos.Header HeaderBody c
hBody SignedKES (KES c) (HeaderBody c)
hSig
where
hBody :: HeaderBody c
hBody = Praos.HeaderBody {
hbBlockNo :: BlockNo
Praos.hbBlockNo = BHBody c -> BlockNo
forall c. BHBody c -> BlockNo
SL.bheaderBlockNo BHBody c
bhBody,
hbSlotNo :: SlotNo
Praos.hbSlotNo = BHBody c -> SlotNo
forall c. BHBody c -> SlotNo
SL.bheaderSlotNo BHBody c
bhBody,
hbPrev :: PrevHash
Praos.hbPrev = BHBody c -> PrevHash
forall c. BHBody c -> PrevHash
SL.bheaderPrev BHBody c
bhBody,
hbVk :: VKey 'BlockIssuer
Praos.hbVk = BHBody c -> VKey 'BlockIssuer
forall c. BHBody c -> VKey 'BlockIssuer
SL.bheaderVk BHBody c
bhBody,
hbVrfVk :: VerKeyVRF (VRF c)
Praos.hbVrfVk = BHBody c -> VerKeyVRF (VRF c)
forall c. BHBody c -> VerKeyVRF (VRF c)
SL.bheaderVrfVk BHBody c
bhBody,
hbVrfRes :: CertifiedVRF (VRF c) InputVRF
Praos.hbVrfRes = CertifiedVRF (VRF c) Nonce -> CertifiedVRF (VRF c) InputVRF
forall a b. Coercible a b => a -> b
coerce (CertifiedVRF (VRF c) Nonce -> CertifiedVRF (VRF c) InputVRF)
-> CertifiedVRF (VRF c) Nonce -> CertifiedVRF (VRF c) InputVRF
forall a b. (a -> b) -> a -> b
$ BHBody c -> CertifiedVRF (VRF c) Nonce
forall c. BHBody c -> CertifiedVRF (VRF c) Nonce
SL.bheaderEta BHBody c
bhBody,
hbBodySize :: Word32
Praos.hbBodySize = BHBody c -> Word32
forall c. BHBody c -> Word32
SL.bsize BHBody c
bhBody,
hbBodyHash :: Hash HASH EraIndependentBlockBody
Praos.hbBodyHash = BHBody c -> Hash HASH EraIndependentBlockBody
forall c. BHBody c -> Hash HASH EraIndependentBlockBody
SL.bhash BHBody c
bhBody,
hbOCert :: OCert c
Praos.hbOCert = BHBody c -> OCert c
forall c. BHBody c -> OCert c
SL.bheaderOCert BHBody c
bhBody,
hbProtVer :: ProtVer
Praos.hbProtVer = BHBody c -> ProtVer
forall c. BHBody c -> ProtVer
SL.bprotver BHBody c
bhBody
}
hSig :: SignedKES (KES c) (HeaderBody c)
hSig = SignedKES (KES c) (BHBody c) -> SignedKES (KES c) (HeaderBody c)
forall a b. Coercible a b => a -> b
coerce SignedKES (KES c) (BHBody c)
bhSig
instance (CanMock (TPraos crypto) era)
=> Arbitrary (Header (ShelleyBlock (TPraos crypto) era)) where
arbitrary :: Gen (Header (ShelleyBlock (TPraos crypto) era))
arbitrary = ShelleyBlock (TPraos crypto) era
-> Header (ShelleyBlock (TPraos crypto) era)
forall blk. GetHeader blk => blk -> Header blk
getHeader (ShelleyBlock (TPraos crypto) era
-> Header (ShelleyBlock (TPraos crypto) era))
-> Gen (ShelleyBlock (TPraos crypto) era)
-> Gen (Header (ShelleyBlock (TPraos crypto) era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyBlock (TPraos crypto) era)
forall a. Arbitrary a => Gen a
arbitrary
instance (CanMock (Praos crypto) era)
=> Arbitrary (Header (ShelleyBlock (Praos crypto) era)) where
arbitrary :: Gen (Header (ShelleyBlock (Praos crypto) era))
arbitrary = do
hdr <- Gen (Header crypto)
forall a. Arbitrary a => Gen a
arbitrary
pure $ ShelleyHeader hdr (ShelleyHash $ Praos.headerHash hdr)
instance Arbitrary ShelleyHash where
arbitrary :: Gen ShelleyHash
arbitrary = Hash HASH EraIndependentBlockHeader -> ShelleyHash
ShelleyHash (Hash HASH EraIndependentBlockHeader -> ShelleyHash)
-> Gen (Hash HASH EraIndependentBlockHeader) -> Gen ShelleyHash
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash HASH EraIndependentBlockHeader)
forall a. Arbitrary a => Gen a
arbitrary
instance CanMock proto era => Arbitrary (GenTx (ShelleyBlock proto era)) where
arbitrary :: Gen (GenTx (ShelleyBlock proto era))
arbitrary = Tx era -> GenTx (ShelleyBlock proto era)
forall era proto.
ShelleyBasedEra era =>
Tx era -> GenTx (ShelleyBlock proto era)
mkShelleyTx (Tx era -> GenTx (ShelleyBlock proto era))
-> Gen (Tx era) -> Gen (GenTx (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Tx era)
forall a. Arbitrary a => Gen a
arbitrary
instance CanMock proto era => Arbitrary (GenTxId (ShelleyBlock proto era)) where
arbitrary :: Gen (GenTxId (ShelleyBlock proto era))
arbitrary = TxId -> GenTxId (ShelleyBlock proto era)
forall proto era. TxId -> TxId (GenTx (ShelleyBlock proto era))
ShelleyTxId (TxId -> GenTxId (ShelleyBlock proto era))
-> Gen TxId -> Gen (GenTxId (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen TxId
forall a. Arbitrary a => Gen a
arbitrary
instance CanMock proto era => Arbitrary (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))) where
arbitrary :: Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
arbitrary = [Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))]
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. HasCallStack => [Gen a] -> Gen a
oneof
[ SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Point (ShelleyBlock proto era))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
(footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Point (ShelleyBlock proto era))
forall proto era.
BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Point (ShelleyBlock proto era))
GetLedgerTip
, SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
(footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
GetEpochNo
, BlockQuery
(ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
(footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
(ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Set (Either Coin (Credential 'Staking))
-> BlockQuery
(ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards)
-> Set (Either Coin (Credential 'Staking))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Either Coin (Credential 'Staking))
-> BlockQuery
(ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
forall proto era.
Set (Either Coin (Credential 'Staking))
-> BlockQuery
(ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
GetNonMyopicMemberRewards (Set (Either Coin (Credential 'Staking))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Gen (Set (Either Coin (Credential 'Staking)))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set (Either Coin (Credential 'Staking)))
forall a. Arbitrary a => Gen a
arbitrary
, SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
(footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
GetCurrentPParams
, SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(PoolDistr (ProtoCrypto proto))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
(footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(PoolDistr (ProtoCrypto proto))
forall proto era.
BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(PoolDistr (ProtoCrypto proto))
GetStakeDistribution
, SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables (EpochState era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
(footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (EpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (EpochState era)
DebugEpochState
, (\(SomeBlockQuery BlockQuery (ShelleyBlock proto era) footprint result
q) -> BlockQuery (ShelleyBlock proto era) footprint (Serialised result)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
(footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery (ShelleyBlock proto era) footprint result
-> BlockQuery
(ShelleyBlock proto era) footprint (Serialised result)
forall proto era (fp :: QueryFootprint) result1.
BlockQuery (ShelleyBlock proto era) fp result1
-> BlockQuery (ShelleyBlock proto era) fp (Serialised result1)
GetCBOR BlockQuery (ShelleyBlock proto era) footprint result
q)) (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. Arbitrary a => Gen a
arbitrary
, BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Delegations, Map (Credential 'Staking) Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
(footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery (BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Delegations, Map (Credential 'Staking) Coin)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> (Set (Credential 'Staking)
-> BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Delegations, Map (Credential 'Staking) Coin))
-> Set (Credential 'Staking)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Credential 'Staking)
-> BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Delegations, Map (Credential 'Staking) Coin)
forall proto era.
Set (Credential 'Staking)
-> BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Delegations, Map (Credential 'Staking) Coin)
GetFilteredDelegationsAndRewardAccounts (Set (Credential 'Staking)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
-> Gen (Set (Credential 'Staking))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set (Credential 'Staking))
forall a. Arbitrary a => Gen a
arbitrary
, SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
(footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
GetGenesisConfig
, SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
-> Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) 'QFNoTables (NewEpochState era)
-> SomeBlockQuery (BlockQuery (ShelleyBlock proto era))
forall (q :: QueryFootprint -> * -> *)
(footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery (ShelleyBlock proto era) 'QFNoTables (NewEpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (NewEpochState era)
DebugNewEpochState
]
instance (Arbitrary (InstantStake era), CanMock proto era) => Arbitrary (SomeResult (ShelleyBlock proto era)) where
arbitrary :: Gen (SomeResult (ShelleyBlock proto era))
arbitrary = [Gen (SomeResult (ShelleyBlock proto era))]
-> Gen (SomeResult (ShelleyBlock proto era))
forall a. HasCallStack => [Gen a] -> Gen a
oneof
[ BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Point (ShelleyBlock proto era))
-> Point (ShelleyBlock proto era)
-> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Point (ShelleyBlock proto era))
forall proto era.
BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Point (ShelleyBlock proto era))
GetLedgerTip (Point (ShelleyBlock proto era)
-> SomeResult (ShelleyBlock proto era))
-> Gen (Point (ShelleyBlock proto era))
-> Gen (SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Point (ShelleyBlock proto era))
forall a. Arbitrary a => Gen a
arbitrary
, BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
-> EpochNo -> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables EpochNo
GetEpochNo (EpochNo -> SomeResult (ShelleyBlock proto era))
-> Gen EpochNo -> Gen (SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen EpochNo
forall a. Arbitrary a => Gen a
arbitrary
, BlockQuery
(ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
-> NonMyopicMemberRewards -> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult (BlockQuery
(ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
-> NonMyopicMemberRewards -> SomeResult (ShelleyBlock proto era))
-> Gen
(BlockQuery
(ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards)
-> Gen
(NonMyopicMemberRewards -> SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set (Either Coin (Credential 'Staking))
-> BlockQuery
(ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
forall proto era.
Set (Either Coin (Credential 'Staking))
-> BlockQuery
(ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards
GetNonMyopicMemberRewards (Set (Either Coin (Credential 'Staking))
-> BlockQuery
(ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards)
-> Gen (Set (Either Coin (Credential 'Staking)))
-> Gen
(BlockQuery
(ShelleyBlock proto era) 'QFNoTables NonMyopicMemberRewards)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set (Either Coin (Credential 'Staking)))
forall a. Arbitrary a => Gen a
arbitrary) Gen (NonMyopicMemberRewards -> SomeResult (ShelleyBlock proto era))
-> Gen NonMyopicMemberRewards
-> Gen (SomeResult (ShelleyBlock proto era))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen NonMyopicMemberRewards
forall a. Arbitrary a => Gen a
arbitrary
, BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
-> PParams era -> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (PParams era)
GetCurrentPParams (PParams era -> SomeResult (ShelleyBlock proto era))
-> Gen (PParams era) -> Gen (SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PParams era)
forall a. Arbitrary a => Gen a
arbitrary
, BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(PoolDistr (ProtoCrypto proto))
-> PoolDistr (ProtoCrypto proto)
-> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(PoolDistr (ProtoCrypto proto))
forall proto era.
BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(PoolDistr (ProtoCrypto proto))
GetStakeDistribution (PoolDistr (ProtoCrypto proto)
-> SomeResult (ShelleyBlock proto era))
-> (PoolDistr -> PoolDistr (ProtoCrypto proto))
-> PoolDistr
-> SomeResult (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolDistr -> PoolDistr (ProtoCrypto proto)
forall c. PoolDistr -> PoolDistr c
fromLedgerPoolDistr (PoolDistr -> SomeResult (ShelleyBlock proto era))
-> Gen PoolDistr -> Gen (SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen PoolDistr
forall a. Arbitrary a => Gen a
arbitrary
, BlockQuery (ShelleyBlock proto era) 'QFNoTables (EpochState era)
-> EpochState era -> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery (ShelleyBlock proto era) 'QFNoTables (EpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (EpochState era)
DebugEpochState (EpochState era -> SomeResult (ShelleyBlock proto era))
-> Gen (EpochState era)
-> Gen (SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (EpochState era)
forall a. Arbitrary a => Gen a
arbitrary
, (\(SomeResult BlockQuery (ShelleyBlock proto era) fp result
q result
r) ->
BlockQuery (ShelleyBlock proto era) fp (Serialised result)
-> Serialised result -> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult (BlockQuery (ShelleyBlock proto era) fp result
-> BlockQuery (ShelleyBlock proto era) fp (Serialised result)
forall proto era (fp :: QueryFootprint) result1.
BlockQuery (ShelleyBlock proto era) fp result1
-> BlockQuery (ShelleyBlock proto era) fp (Serialised result1)
GetCBOR BlockQuery (ShelleyBlock proto era) fp result
q) ((result -> Encoding) -> result -> Serialised result
forall a. (a -> Encoding) -> a -> Serialised a
mkSerialised (ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) fp result
-> result
-> Encoding
forall proto era (fp :: QueryFootprint) result.
ShelleyCompatible proto era =>
ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) fp result
-> result
-> Encoding
encodeShelleyResult ShelleyNodeToClientVersion
forall a. Bounded a => a
maxBound BlockQuery (ShelleyBlock proto era) fp result
q) result
r)) (SomeResult (ShelleyBlock proto era)
-> SomeResult (ShelleyBlock proto era))
-> Gen (SomeResult (ShelleyBlock proto era))
-> Gen (SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$>
Gen (SomeResult (ShelleyBlock proto era))
forall a. Arbitrary a => Gen a
arbitrary
, BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Delegations, Map (Credential 'Staking) Coin)
-> (Delegations, Map (Credential 'Staking) Coin)
-> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult (BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Delegations, Map (Credential 'Staking) Coin)
-> (Delegations, Map (Credential 'Staking) Coin)
-> SomeResult (ShelleyBlock proto era))
-> Gen
(BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Delegations, Map (Credential 'Staking) Coin))
-> Gen
((Delegations, Map (Credential 'Staking) Coin)
-> SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set (Credential 'Staking)
-> BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Delegations, Map (Credential 'Staking) Coin)
forall proto era.
Set (Credential 'Staking)
-> BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Delegations, Map (Credential 'Staking) Coin)
GetFilteredDelegationsAndRewardAccounts (Set (Credential 'Staking)
-> BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Delegations, Map (Credential 'Staking) Coin))
-> Gen (Set (Credential 'Staking))
-> Gen
(BlockQuery
(ShelleyBlock proto era)
'QFNoTables
(Delegations, Map (Credential 'Staking) Coin))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set (Credential 'Staking))
forall a. Arbitrary a => Gen a
arbitrary) Gen
((Delegations, Map (Credential 'Staking) Coin)
-> SomeResult (ShelleyBlock proto era))
-> Gen (Delegations, Map (Credential 'Staking) Coin)
-> Gen (SomeResult (ShelleyBlock proto era))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Delegations, Map (Credential 'Staking) Coin)
forall a. Arbitrary a => Gen a
arbitrary
, BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
-> CompactGenesis -> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables CompactGenesis
GetGenesisConfig (CompactGenesis -> SomeResult (ShelleyBlock proto era))
-> (ShelleyGenesis -> CompactGenesis)
-> ShelleyGenesis
-> SomeResult (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesis -> CompactGenesis
compactGenesis (ShelleyGenesis -> SomeResult (ShelleyBlock proto era))
-> Gen ShelleyGenesis -> Gen (SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ShelleyGenesis
forall a. Arbitrary a => Gen a
arbitrary
, BlockQuery (ShelleyBlock proto era) 'QFNoTables (NewEpochState era)
-> NewEpochState era -> SomeResult (ShelleyBlock proto era)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery (ShelleyBlock proto era) 'QFNoTables (NewEpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) 'QFNoTables (NewEpochState era)
DebugNewEpochState (NewEpochState era -> SomeResult (ShelleyBlock proto era))
-> Gen (NewEpochState era)
-> Gen (SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NewEpochState era)
forall a. Arbitrary a => Gen a
arbitrary
]
instance Arbitrary NonMyopicMemberRewards where
arbitrary :: Gen NonMyopicMemberRewards
arbitrary = Map
(Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
-> NonMyopicMemberRewards
NonMyopicMemberRewards (Map
(Either Coin (Credential 'Staking)) (Map (KeyHash 'StakePool) Coin)
-> NonMyopicMemberRewards)
-> Gen
(Map
(Either Coin (Credential 'Staking))
(Map (KeyHash 'StakePool) Coin))
-> Gen NonMyopicMemberRewards
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen
(Map
(Either Coin (Credential 'Staking))
(Map (KeyHash 'StakePool) Coin))
forall a. Arbitrary a => Gen a
arbitrary
instance CanMock proto era => Arbitrary (Point (ShelleyBlock proto era)) where
arbitrary :: Gen (Point (ShelleyBlock proto era))
arbitrary = SlotNo
-> HeaderHash (ShelleyBlock proto era)
-> Point (ShelleyBlock proto era)
SlotNo -> ShelleyHash -> Point (ShelleyBlock proto era)
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint (SlotNo -> ShelleyHash -> Point (ShelleyBlock proto era))
-> Gen SlotNo
-> Gen (ShelleyHash -> Point (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary Gen (ShelleyHash -> Point (ShelleyBlock proto era))
-> Gen ShelleyHash -> Gen (Point (ShelleyBlock proto era))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ShelleyHash
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary TPraosState where
arbitrary :: Gen TPraosState
arbitrary = do
lastSlot <- [(Int, Gen (WithOrigin SlotNo))] -> Gen (WithOrigin SlotNo)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
[ (Int
1, WithOrigin SlotNo -> Gen (WithOrigin SlotNo)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return WithOrigin SlotNo
forall t. WithOrigin t
Origin)
, (Int
5, SlotNo -> WithOrigin SlotNo
forall t. t -> WithOrigin t
NotOrigin (SlotNo -> WithOrigin SlotNo)
-> (Word64 -> SlotNo) -> Word64 -> WithOrigin SlotNo
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Word64 -> SlotNo
SlotNo (Word64 -> WithOrigin SlotNo)
-> Gen Word64 -> Gen (WithOrigin 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
0, Word64
100))
]
TPraosState lastSlot <$> arbitrary
instance CanMock proto era=> Arbitrary (ShelleyTip proto era) where
arbitrary :: Gen (ShelleyTip proto era)
arbitrary = SlotNo
-> BlockNo
-> HeaderHash (ShelleyBlock proto era)
-> ShelleyTip proto era
SlotNo -> BlockNo -> ShelleyHash -> ShelleyTip proto era
forall proto era.
SlotNo
-> BlockNo
-> HeaderHash (ShelleyBlock proto era)
-> ShelleyTip proto era
ShelleyTip
(SlotNo -> BlockNo -> ShelleyHash -> ShelleyTip proto era)
-> Gen SlotNo
-> Gen (BlockNo -> ShelleyHash -> ShelleyTip proto era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary
Gen (BlockNo -> ShelleyHash -> ShelleyTip proto era)
-> Gen BlockNo -> Gen (ShelleyHash -> ShelleyTip proto era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen BlockNo
forall a. Arbitrary a => Gen a
arbitrary
Gen (ShelleyHash -> ShelleyTip proto era)
-> Gen ShelleyHash -> Gen (ShelleyTip proto era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ShelleyHash
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary ShelleyTransition where
arbitrary :: Gen ShelleyTransition
arbitrary = Word32 -> ShelleyTransition
ShelleyTransitionInfo (Word32 -> ShelleyTransition)
-> Gen Word32 -> Gen ShelleyTransition
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary
instance (Arbitrary (InstantStake era), CanMock proto era)
=> Arbitrary (LedgerState (ShelleyBlock proto era) EmptyMK) where
arbitrary :: Gen (LedgerState (ShelleyBlock proto era) EmptyMK)
arbitrary = WithOrigin (ShelleyTip proto era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
-> LedgerState (ShelleyBlock proto era) EmptyMK
forall proto era (mk :: * -> * -> *).
WithOrigin (ShelleyTip proto era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
-> LedgerState (ShelleyBlock proto era) mk
ShelleyLedgerState
(WithOrigin (ShelleyTip proto era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
-> LedgerState (ShelleyBlock proto era) EmptyMK)
-> Gen (WithOrigin (ShelleyTip proto era))
-> Gen
(NewEpochState era
-> ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
-> LedgerState (ShelleyBlock proto era) EmptyMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (WithOrigin (ShelleyTip proto era))
forall a. Arbitrary a => Gen a
arbitrary
Gen
(NewEpochState era
-> ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
-> LedgerState (ShelleyBlock proto era) EmptyMK)
-> Gen (NewEpochState era)
-> Gen
(ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
-> LedgerState (ShelleyBlock proto era) EmptyMK)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (NewEpochState era)
forall a. Arbitrary a => Gen a
arbitrary
Gen
(ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
-> LedgerState (ShelleyBlock proto era) EmptyMK)
-> Gen ShelleyTransition
-> Gen
(LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
-> LedgerState (ShelleyBlock proto era) EmptyMK)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ShelleyTransition
forall a. Arbitrary a => Gen a
arbitrary
Gen
(LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
-> LedgerState (ShelleyBlock proto era) EmptyMK)
-> Gen
(LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK)
-> Gen (LedgerState (ShelleyBlock proto era) EmptyMK)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
-> Gen
(LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (EmptyMK
(TxIn (LedgerState (ShelleyBlock proto era)))
(TxOut (LedgerState (ShelleyBlock proto era)))
-> LedgerTables (LedgerState (ShelleyBlock proto era)) EmptyMK
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables EmptyMK TxIn (TxOut era)
EmptyMK
(TxIn (LedgerState (ShelleyBlock proto era)))
(TxOut (LedgerState (ShelleyBlock proto era)))
forall k v. EmptyMK k v
EmptyMK)
instance (Arbitrary (InstantStake era), CanMock proto era)
=> Arbitrary (LedgerState (ShelleyBlock proto era) ValuesMK) where
arbitrary :: Gen (LedgerState (ShelleyBlock proto era) ValuesMK)
arbitrary = WithOrigin (ShelleyTip proto era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
-> LedgerState (ShelleyBlock proto era) ValuesMK
forall proto era (mk :: * -> * -> *).
WithOrigin (ShelleyTip proto era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) mk
-> LedgerState (ShelleyBlock proto era) mk
ShelleyLedgerState
(WithOrigin (ShelleyTip proto era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
-> LedgerState (ShelleyBlock proto era) ValuesMK)
-> Gen (WithOrigin (ShelleyTip proto era))
-> Gen
(NewEpochState era
-> ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
-> LedgerState (ShelleyBlock proto era) ValuesMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (WithOrigin (ShelleyTip proto era))
forall a. Arbitrary a => Gen a
arbitrary
Gen
(NewEpochState era
-> ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
-> LedgerState (ShelleyBlock proto era) ValuesMK)
-> Gen (NewEpochState era)
-> Gen
(ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
-> LedgerState (ShelleyBlock proto era) ValuesMK)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (NewEpochState era)
forall a. Arbitrary a => Gen a
arbitrary
Gen
(ShelleyTransition
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
-> LedgerState (ShelleyBlock proto era) ValuesMK)
-> Gen ShelleyTransition
-> Gen
(LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
-> LedgerState (ShelleyBlock proto era) ValuesMK)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ShelleyTransition
forall a. Arbitrary a => Gen a
arbitrary
Gen
(LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
-> LedgerState (ShelleyBlock proto era) ValuesMK)
-> Gen
(LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
-> Gen (LedgerState (ShelleyBlock proto era) ValuesMK)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (ValuesMK TxIn (TxOut era)
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
ValuesMK
(TxIn (LedgerState (ShelleyBlock proto era)))
(TxOut (LedgerState (ShelleyBlock proto era)))
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables (ValuesMK TxIn (TxOut era)
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
-> (Map TxIn (TxOut era) -> ValuesMK TxIn (TxOut era))
-> Map TxIn (TxOut era)
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn (TxOut era) -> ValuesMK TxIn (TxOut era)
forall k v. Map k v -> ValuesMK k v
ValuesMK (Map TxIn (TxOut era)
-> LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
-> Gen (Map TxIn (TxOut era))
-> Gen
(LedgerTables (LedgerState (ShelleyBlock proto era)) ValuesMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map TxIn (TxOut era))
forall a. Arbitrary a => Gen a
arbitrary)
instance CanMock proto era => Arbitrary (AnnTip (ShelleyBlock proto era)) where
arbitrary :: Gen (AnnTip (ShelleyBlock proto era))
arbitrary = SlotNo
-> BlockNo
-> TipInfo (ShelleyBlock proto era)
-> AnnTip (ShelleyBlock proto era)
SlotNo -> BlockNo -> ShelleyHash -> AnnTip (ShelleyBlock proto era)
forall blk. SlotNo -> BlockNo -> TipInfo blk -> AnnTip blk
AnnTip
(SlotNo
-> BlockNo -> ShelleyHash -> AnnTip (ShelleyBlock proto era))
-> Gen SlotNo
-> Gen (BlockNo -> ShelleyHash -> AnnTip (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary
Gen (BlockNo -> ShelleyHash -> AnnTip (ShelleyBlock proto era))
-> Gen BlockNo
-> Gen (ShelleyHash -> AnnTip (ShelleyBlock proto era))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> BlockNo
BlockNo (Word64 -> BlockNo) -> Gen Word64 -> Gen BlockNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary)
Gen (ShelleyHash -> AnnTip (ShelleyBlock proto era))
-> Gen ShelleyHash -> Gen (AnnTip (ShelleyBlock proto era))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ShelleyHash
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary ShelleyNodeToNodeVersion where
arbitrary :: Gen ShelleyNodeToNodeVersion
arbitrary = Gen ShelleyNodeToNodeVersion
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum
instance Arbitrary ShelleyNodeToClientVersion where
arbitrary :: Gen ShelleyNodeToClientVersion
arbitrary = Gen ShelleyNodeToClientVersion
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum
instance ShelleyBasedEra era
=> Arbitrary (SomeSecond (NestedCtxt f) (ShelleyBlock proto era)) where
arbitrary :: Gen (SomeSecond (NestedCtxt f) (ShelleyBlock proto era))
arbitrary = SomeSecond (NestedCtxt f) (ShelleyBlock proto era)
-> Gen (SomeSecond (NestedCtxt f) (ShelleyBlock proto era))
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (NestedCtxt f (ShelleyBlock proto era) (f (ShelleyBlock proto era))
-> SomeSecond (NestedCtxt f) (ShelleyBlock proto era)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond NestedCtxt f (ShelleyBlock proto era) (f (ShelleyBlock proto era))
NestedCtxt
f
(ShelleyBlock proto era)
(TrivialIndex (NestedCtxt f (ShelleyBlock proto era)))
forall k (f :: k -> *). TrivialDependency f => f (TrivialIndex f)
indexIsTrivial)
instance ( Arbitrary (TranslationContext era)
) => Arbitrary (ShelleyLedgerConfig era) where
arbitrary :: Gen (ShelleyLedgerConfig era)
arbitrary = CompactGenesis
-> Globals -> TranslationContext era -> ShelleyLedgerConfig era
forall era.
CompactGenesis
-> Globals -> TranslationContext era -> ShelleyLedgerConfig era
ShelleyLedgerConfig
(CompactGenesis
-> Globals -> TranslationContext era -> ShelleyLedgerConfig era)
-> Gen CompactGenesis
-> Gen
(Globals -> TranslationContext era -> ShelleyLedgerConfig era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen CompactGenesis
forall a. Arbitrary a => Gen a
arbitrary
Gen (Globals -> TranslationContext era -> ShelleyLedgerConfig era)
-> Gen Globals
-> Gen (TranslationContext era -> ShelleyLedgerConfig era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Globals
arbitraryGlobalsWithFixedEpochInfo
Gen (TranslationContext era -> ShelleyLedgerConfig era)
-> Gen (TranslationContext era) -> Gen (ShelleyLedgerConfig era)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (TranslationContext era)
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary CompactGenesis where
arbitrary :: Gen CompactGenesis
arbitrary = ShelleyGenesis -> CompactGenesis
compactGenesis (ShelleyGenesis -> CompactGenesis)
-> Gen ShelleyGenesis -> Gen CompactGenesis
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ShelleyGenesis
forall a. Arbitrary a => Gen a
arbitrary
arbitraryGlobalsWithFixedEpochInfo :: Gen SL.Globals
arbitraryGlobalsWithFixedEpochInfo :: Gen Globals
arbitraryGlobalsWithFixedEpochInfo = EpochInfo (Either Text)
-> Word64
-> Word64
-> Word64
-> NonZero Word64
-> Word64
-> Word64
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals
SL.Globals
(EpochInfo (Either Text)
-> Word64
-> Word64
-> Word64
-> NonZero Word64
-> Word64
-> Word64
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals)
-> Gen (EpochInfo (Either Text))
-> Gen
(Word64
-> Word64
-> Word64
-> NonZero Word64
-> Word64
-> Word64
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (EpochInfo (Either Text))
forall (m :: * -> *). Monad m => Gen (EpochInfo m)
arbitraryFixedEpochInfo
Gen
(Word64
-> Word64
-> Word64
-> NonZero Word64
-> Word64
-> Word64
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals)
-> Gen Word64
-> Gen
(Word64
-> Word64
-> NonZero Word64
-> Word64
-> Word64
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
Gen
(Word64
-> Word64
-> NonZero Word64
-> Word64
-> Word64
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals)
-> Gen Word64
-> Gen
(Word64
-> NonZero Word64
-> Word64
-> Word64
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
Gen
(Word64
-> NonZero Word64
-> Word64
-> Word64
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals)
-> Gen Word64
-> Gen
(NonZero Word64
-> Word64
-> Word64
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
Gen
(NonZero Word64
-> Word64
-> Word64
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals)
-> Gen (NonZero Word64)
-> Gen
(Word64
-> Word64
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (NonZero Word64)
forall a. Arbitrary a => Gen a
arbitrary
Gen
(Word64
-> Word64
-> Word64
-> ActiveSlotCoeff
-> Network
-> SystemStart
-> Globals)
-> Gen Word64
-> Gen
(Word64
-> Word64 -> ActiveSlotCoeff -> Network -> SystemStart -> Globals)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
Gen
(Word64
-> Word64 -> ActiveSlotCoeff -> Network -> SystemStart -> Globals)
-> Gen Word64
-> Gen
(Word64 -> ActiveSlotCoeff -> Network -> SystemStart -> Globals)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
Gen
(Word64 -> ActiveSlotCoeff -> Network -> SystemStart -> Globals)
-> Gen Word64
-> Gen (ActiveSlotCoeff -> Network -> SystemStart -> Globals)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
Gen (ActiveSlotCoeff -> Network -> SystemStart -> Globals)
-> Gen ActiveSlotCoeff -> Gen (Network -> SystemStart -> Globals)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ActiveSlotCoeff
forall a. Arbitrary a => Gen a
arbitrary
Gen (Network -> SystemStart -> Globals)
-> Gen Network -> Gen (SystemStart -> Globals)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Network
forall a. Arbitrary a => Gen a
arbitrary
Gen (SystemStart -> Globals) -> Gen SystemStart -> Gen Globals
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SystemStart
forall a. Arbitrary a => Gen a
arbitrary
arbitraryFixedEpochInfo :: Monad m => Gen (EpochInfo m)
arbitraryFixedEpochInfo :: forall (m :: * -> *). Monad m => Gen (EpochInfo m)
arbitraryFixedEpochInfo = EpochSize -> SlotLength -> EpochInfo m
forall (m :: * -> *).
Monad m =>
EpochSize -> SlotLength -> EpochInfo m
fixedEpochInfo (EpochSize -> SlotLength -> EpochInfo m)
-> Gen EpochSize -> Gen (SlotLength -> EpochInfo m)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen EpochSize
forall a. Arbitrary a => Gen a
arbitrary Gen (SlotLength -> EpochInfo m)
-> Gen SlotLength -> Gen (EpochInfo m)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SlotLength
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary (NoGenesis era) where
arbitrary :: Gen (NoGenesis era)
arbitrary = NoGenesis era -> Gen (NoGenesis era)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure NoGenesis era
forall era. NoGenesis era
NoGenesis
instance Arbitrary FromByronTranslationContext where
arbitrary :: Gen FromByronTranslationContext
arbitrary = Map (KeyHash 'Genesis) GenDelegPair
-> PParams ShelleyEra -> Word64 -> FromByronTranslationContext
FromByronTranslationContext (Map (KeyHash 'Genesis) GenDelegPair
-> PParams ShelleyEra -> Word64 -> FromByronTranslationContext)
-> Gen (Map (KeyHash 'Genesis) GenDelegPair)
-> Gen
(PParams ShelleyEra -> Word64 -> FromByronTranslationContext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map (KeyHash 'Genesis) GenDelegPair)
forall a. Arbitrary a => Gen a
arbitrary Gen (PParams ShelleyEra -> Word64 -> FromByronTranslationContext)
-> Gen (PParams ShelleyEra)
-> Gen (Word64 -> FromByronTranslationContext)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (PParams ShelleyEra)
forall a. Arbitrary a => Gen a
arbitrary Gen (Word64 -> FromByronTranslationContext)
-> Gen Word64 -> Gen FromByronTranslationContext
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary
instance Arbitrary SL.ChainDepState where
arbitrary :: Gen ChainDepState
arbitrary = Gen ChainDepState
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
shrink :: ChainDepState -> [ChainDepState]
shrink = ChainDepState -> [ChainDepState]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink
instance CanMock proto era
=> Arbitrary (WithVersion ShelleyNodeToClientVersion (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))) where
arbitrary :: Gen
(WithVersion
ShelleyNodeToClientVersion
(SomeBlockQuery (BlockQuery (ShelleyBlock proto era))))
arbitrary = do
query@(SomeBlockQuery q) <- Gen (SomeBlockQuery (BlockQuery (ShelleyBlock proto era)))
forall a. Arbitrary a => Gen a
arbitrary
version <- arbitrary `suchThat` blockQueryIsSupportedOnVersion q
return $ WithVersion version query