{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE QuantifiedConstraints #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Consensus.Shelley.Generators (SomeResult (..)) where

import           Cardano.Ledger.Crypto (Crypto)
import           Cardano.Ledger.Era (toTxSeq)
import qualified Cardano.Ledger.Shelley.API as SL
import qualified Cardano.Protocol.TPraos.API as SL
import qualified Cardano.Protocol.TPraos.BHeader as SL
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 (PraosCrypto, 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.ConcreteCryptoTypes as SL
import           Test.Cardano.Ledger.Shelley.Constants (defaultConstants)
import           Test.Cardano.Ledger.Shelley.Generator.Presets (coreNodeKeys)
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 (..))

{-------------------------------------------------------------------------------
  Generators

  These are generators for roundtrip tests, so the generated values are not
  necessarily valid
-------------------------------------------------------------------------------}

-- | The upstream 'Arbitrary' instance for Shelley blocks does not generate
-- coherent blocks, so neither does this.
instance (CanMock (TPraos crypto) era, crypto ~ EraCrypto era)
  => Arbitrary (ShelleyBlock (TPraos crypto) era) where
  arbitrary :: Gen (ShelleyBlock (TPraos crypto) era)
arbitrary = do
    let allPoolKeys :: [AllIssuerKeys crypto 'GenesisDelegate]
allPoolKeys = ((KeyPair 'Genesis crypto, AllIssuerKeys crypto 'GenesisDelegate)
 -> AllIssuerKeys crypto 'GenesisDelegate)
-> [(KeyPair 'Genesis crypto,
     AllIssuerKeys crypto 'GenesisDelegate)]
-> [AllIssuerKeys crypto 'GenesisDelegate]
forall a b. (a -> b) -> [a] -> [b]
map (KeyPair 'Genesis crypto, AllIssuerKeys crypto 'GenesisDelegate)
-> AllIssuerKeys crypto 'GenesisDelegate
forall a b. (a, b) -> b
snd (Constants
-> [(KeyPair 'Genesis crypto,
     AllIssuerKeys crypto 'GenesisDelegate)]
forall c.
Crypto c =>
Constants
-> [(KeyPair 'Genesis c, AllIssuerKeys c 'GenesisDelegate)]
coreNodeKeys Constants
defaultConstants)
    Block (BHeader crypto) era -> ShelleyBlock (TPraos crypto) era
Block (ShelleyProtocolHeader (TPraos crypto)) era
-> ShelleyBlock (TPraos crypto) era
forall proto era.
ShelleyCompatible proto era =>
Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era
mkShelleyBlock (Block (BHeader crypto) era -> ShelleyBlock (TPraos crypto) era)
-> Gen (Block (BHeader crypto) era)
-> Gen (ShelleyBlock (TPraos crypto) era)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AllIssuerKeys crypto 'GenesisDelegate]
-> Gen (Block (BHeader crypto) era)
forall c era (r :: KeyRole).
(Signable (DSIGN c) (OCertSignable c), Signable (VRF c) Seed,
 Signable (KES c) (BHBody c), EraSegWits era, Arbitrary (Tx era),
 c ~ EraCrypto era) =>
[AllIssuerKeys c r] -> Gen (Block (BHeader c) era)
genBlock [AllIssuerKeys crypto 'GenesisDelegate]
allPoolKeys

instance (Praos.PraosCrypto crypto, CanMock (Praos crypto) era, crypto ~ EraCrypto 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)

-- | This uses a different upstream generator to ensure the header and block
-- body relate as expected.
instance (CanMock (TPraos crypto) era, crypto ~ EraCrypto era)
  => Arbitrary (Coherent (ShelleyBlock (TPraos crypto) era)) where
  arbitrary :: Gen (Coherent (ShelleyBlock (TPraos crypto) era))
arbitrary = do
    let allPoolKeys :: [AllIssuerKeys crypto 'GenesisDelegate]
allPoolKeys = ((KeyPair 'Genesis crypto, AllIssuerKeys crypto 'GenesisDelegate)
 -> AllIssuerKeys crypto 'GenesisDelegate)
-> [(KeyPair 'Genesis crypto,
     AllIssuerKeys crypto 'GenesisDelegate)]
-> [AllIssuerKeys crypto 'GenesisDelegate]
forall a b. (a -> b) -> [a] -> [b]
map (KeyPair 'Genesis crypto, AllIssuerKeys crypto 'GenesisDelegate)
-> AllIssuerKeys crypto 'GenesisDelegate
forall a b. (a, b) -> b
snd (Constants
-> [(KeyPair 'Genesis crypto,
     AllIssuerKeys crypto 'GenesisDelegate)]
forall c.
Crypto c =>
Constants
-> [(KeyPair 'Genesis c, AllIssuerKeys c 'GenesisDelegate)]
coreNodeKeys Constants
defaultConstants)
    ShelleyBlock (TPraos crypto) era
-> Coherent (ShelleyBlock (TPraos crypto) era)
forall a. a -> Coherent a
Coherent (ShelleyBlock (TPraos crypto) era
 -> Coherent (ShelleyBlock (TPraos crypto) era))
-> (Block (BHeader crypto) era -> ShelleyBlock (TPraos crypto) era)
-> Block (BHeader crypto) era
-> Coherent (ShelleyBlock (TPraos crypto) era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader crypto) era -> ShelleyBlock (TPraos crypto) era
Block (ShelleyProtocolHeader (TPraos crypto)) era
-> ShelleyBlock (TPraos crypto) era
forall proto era.
ShelleyCompatible proto era =>
Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era
mkShelleyBlock (Block (BHeader crypto) era
 -> Coherent (ShelleyBlock (TPraos crypto) era))
-> Gen (Block (BHeader crypto) era)
-> Gen (Coherent (ShelleyBlock (TPraos crypto) era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
-> Gen (Block (BHeader (EraCrypto era)) era)
forall era (r :: KeyRole).
(EraSegWits era, Arbitrary (Tx era),
 Signable (KES (EraCrypto era)) ~ SignableRepresentation,
 Signable (DSIGN (EraCrypto era)) ~ SignableRepresentation,
 PraosCrypto (EraCrypto era)) =>
[AllIssuerKeys (EraCrypto era) r]
-> Gen (Block (BHeader (EraCrypto era)) era)
genCoherentBlock [AllIssuerKeys crypto 'GenesisDelegate]
[AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
allPoolKeys

-- | Create a coherent Praos block
--
--   TODO Establish a coherent block without doing this translation from a
--   TPraos header.
instance (CanMock (Praos crypto) era, crypto ~ EraCrypto era)
  => Arbitrary (Coherent (ShelleyBlock (Praos crypto) era)) where
  arbitrary :: Gen (Coherent (ShelleyBlock (Praos crypto) era))
arbitrary = ShelleyBlock (Praos crypto) era
-> Coherent (ShelleyBlock (Praos crypto) era)
forall a. a -> Coherent a
Coherent (ShelleyBlock (Praos crypto) era
 -> Coherent (ShelleyBlock (Praos crypto) era))
-> (Block (BHeader crypto) era -> ShelleyBlock (Praos crypto) era)
-> Block (BHeader crypto) era
-> Coherent (ShelleyBlock (Praos crypto) era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Block (BHeader crypto) era -> ShelleyBlock (Praos crypto) era
Block (BHeader (EraCrypto era)) era
-> ShelleyBlock (Praos (EraCrypto era)) era
forall {era}.
(Assert
   (OrdCond
      (CmpNat (ProtVerLow era) (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerLow era)) 'True 'True 'False)
   (TypeError ...),
 Assert
   (OrdCond (CmpNat MinVersion (ProtVerHigh era)) 'True 'True 'False)
   (TypeError ...),
 ShelleyCompatible (Praos (EraCrypto era)) era,
 PraosCrypto (EraCrypto era),
 DecodeDisk
   (ShelleyBlock (Praos (EraCrypto era)) era)
   (PraosState (EraCrypto era)),
 EncodeDisk
   (ShelleyBlock (Praos (EraCrypto era)) era)
   (PraosState (EraCrypto era))) =>
Block (BHeader (EraCrypto era)) era
-> ShelleyBlock (Praos (EraCrypto era)) era
mkBlk (Block (BHeader crypto) era
 -> Coherent (ShelleyBlock (Praos crypto) era))
-> Gen (Block (BHeader crypto) era)
-> Gen (Coherent (ShelleyBlock (Praos crypto) era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
-> Gen (Block (BHeader (EraCrypto era)) era)
forall era (r :: KeyRole).
(EraSegWits era, Arbitrary (Tx era),
 Signable (KES (EraCrypto era)) ~ SignableRepresentation,
 Signable (DSIGN (EraCrypto era)) ~ SignableRepresentation,
 PraosCrypto (EraCrypto era)) =>
[AllIssuerKeys (EraCrypto era) r]
-> Gen (Block (BHeader (EraCrypto era)) era)
genCoherentBlock [AllIssuerKeys crypto 'GenesisDelegate]
[AllIssuerKeys (EraCrypto era) 'GenesisDelegate]
allPoolKeys
    where
      allPoolKeys :: [AllIssuerKeys crypto 'GenesisDelegate]
allPoolKeys = ((KeyPair 'Genesis crypto, AllIssuerKeys crypto 'GenesisDelegate)
 -> AllIssuerKeys crypto 'GenesisDelegate)
-> [(KeyPair 'Genesis crypto,
     AllIssuerKeys crypto 'GenesisDelegate)]
-> [AllIssuerKeys crypto 'GenesisDelegate]
forall a b. (a -> b) -> [a] -> [b]
map (KeyPair 'Genesis crypto, AllIssuerKeys crypto 'GenesisDelegate)
-> AllIssuerKeys crypto 'GenesisDelegate
forall a b. (a, b) -> b
snd (Constants
-> [(KeyPair 'Genesis crypto,
     AllIssuerKeys crypto 'GenesisDelegate)]
forall c.
Crypto c =>
Constants
-> [(KeyPair 'Genesis c, AllIssuerKeys c 'GenesisDelegate)]
coreNodeKeys Constants
defaultConstants)
      mkBlk :: Block (BHeader (EraCrypto era)) era
-> ShelleyBlock (Praos (EraCrypto era)) era
mkBlk Block (BHeader (EraCrypto era)) era
sleBlock = Block (ShelleyProtocolHeader (Praos (EraCrypto era))) era
-> ShelleyBlock (Praos (EraCrypto era)) era
forall proto era.
ShelleyCompatible proto era =>
Block (ShelleyProtocolHeader proto) era -> ShelleyBlock proto era
mkShelleyBlock (Block (ShelleyProtocolHeader (Praos (EraCrypto era))) era
 -> ShelleyBlock (Praos (EraCrypto era)) era)
-> Block (ShelleyProtocolHeader (Praos (EraCrypto era))) era
-> ShelleyBlock (Praos (EraCrypto era)) era
forall a b. (a -> b) -> a -> b
$ let
        SL.Block BHeader (EraCrypto era)
hdr1 TxSeq era
bdy = Block (BHeader (EraCrypto era)) era
sleBlock in Header (EraCrypto era)
-> TxSeq era -> Block (Header (EraCrypto era)) era
forall era h.
(Era era, EncCBORGroup (TxSeq era), EncCBOR h) =>
h -> TxSeq era -> Block h era
SL.Block (BHeader (EraCrypto era) -> Header (EraCrypto era)
forall c. Crypto c => BHeader c -> Header c
translateHeader BHeader (EraCrypto era)
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 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 c
Praos.hbPrev = BHBody c -> PrevHash c
forall c. BHBody c -> PrevHash c
SL.bheaderPrev BHBody c
bhBody,
            hbVk :: VKey 'BlockIssuer c
Praos.hbVk = BHBody c -> VKey 'BlockIssuer c
forall c. BHBody c -> VKey 'BlockIssuer c
SL.bheaderVk BHBody c
bhBody,
            hbVrfVk :: VerKeyVRF c
Praos.hbVrfVk = BHBody c -> VerKeyVRF c
forall c. BHBody c -> VerKeyVRF 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 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 c EraIndependentBlockBody
Praos.hbBodyHash = BHBody c -> Hash c EraIndependentBlockBody
forall c. BHBody c -> Hash c 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, crypto ~ EraCrypto 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, crypto ~ EraCrypto era)
  => Arbitrary (Header (ShelleyBlock (Praos crypto) era)) where
  arbitrary :: Gen (Header (ShelleyBlock (Praos crypto) era))
arbitrary = do
    Header crypto
hdr <- Gen (Header crypto)
forall a. Arbitrary a => Gen a
arbitrary
    Header (ShelleyBlock (Praos crypto) era)
-> Gen (Header (ShelleyBlock (Praos crypto) era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Header (ShelleyBlock (Praos crypto) era)
 -> Gen (Header (ShelleyBlock (Praos crypto) era)))
-> Header (ShelleyBlock (Praos crypto) era)
-> Gen (Header (ShelleyBlock (Praos crypto) era))
forall a b. (a -> b) -> a -> b
$ ShelleyProtocolHeader (Praos crypto)
-> ShelleyHash (ProtoCrypto (Praos crypto))
-> Header (ShelleyBlock (Praos crypto) era)
forall proto era.
ShelleyProtocolHeader proto
-> ShelleyHash (ProtoCrypto proto)
-> Header (ShelleyBlock proto era)
ShelleyHeader ShelleyProtocolHeader (Praos crypto)
Header crypto
hdr (Hash (ProtoCrypto (Praos crypto)) EraIndependentBlockHeader
-> ShelleyHash (ProtoCrypto (Praos crypto))
forall crypto.
Hash crypto EraIndependentBlockHeader -> ShelleyHash crypto
ShelleyHash (Hash (ProtoCrypto (Praos crypto)) EraIndependentBlockHeader
 -> ShelleyHash (ProtoCrypto (Praos crypto)))
-> Hash (ProtoCrypto (Praos crypto)) EraIndependentBlockHeader
-> ShelleyHash (ProtoCrypto (Praos crypto))
forall a b. (a -> b) -> a -> b
$ Header crypto -> Hash (HASH crypto) EraIndependentBlockHeader
forall crypto.
Crypto crypto =>
Header crypto -> Hash (HASH crypto) EraIndependentBlockHeader
Praos.headerHash Header crypto
hdr)

instance SL.Mock c => Arbitrary (ShelleyHash c) where
  arbitrary :: Gen (ShelleyHash c)
arbitrary = Hash (HASH c) EraIndependentBlockHeader -> ShelleyHash c
forall crypto.
Hash crypto EraIndependentBlockHeader -> ShelleyHash crypto
ShelleyHash (Hash (HASH c) EraIndependentBlockHeader -> ShelleyHash c)
-> Gen (Hash (HASH c) EraIndependentBlockHeader)
-> Gen (ShelleyHash c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash (HASH c) 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 (EraCrypto era) -> GenTxId (ShelleyBlock proto era)
TxId (ProtoCrypto proto) -> GenTxId (ShelleyBlock proto era)
forall proto era.
TxId (EraCrypto era) -> TxId (GenTx (ShelleyBlock proto era))
ShelleyTxId (TxId (ProtoCrypto proto) -> GenTxId (ShelleyBlock proto era))
-> Gen (TxId (ProtoCrypto proto))
-> Gen (GenTxId (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TxId (ProtoCrypto proto))
forall a. Arbitrary a => Gen a
arbitrary

instance CanMock proto era => Arbitrary (SomeSecond BlockQuery (ShelleyBlock proto era)) where
  arbitrary :: Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
arbitrary = [Gen (SomeSecond BlockQuery (ShelleyBlock proto era))]
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a. HasCallStack => [Gen a] -> Gen a
oneof
    [ SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Gen (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era) (Point (ShelleyBlock proto era))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery
  (ShelleyBlock proto era) (Point (ShelleyBlock proto era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era) (Point (ShelleyBlock proto era))
GetLedgerTip
    , SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Gen (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) EpochNo
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) EpochNo
forall proto era. BlockQuery (ShelleyBlock proto era) EpochNo
GetEpochNo
    , BlockQuery
  (ShelleyBlock proto era)
  (NonMyopicMemberRewards (ProtoCrypto proto))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (BlockQuery
   (ShelleyBlock proto era)
   (NonMyopicMemberRewards (ProtoCrypto proto))
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> (Set (Either Coin (Credential 'Staking (ProtoCrypto proto)))
    -> BlockQuery
         (ShelleyBlock proto era)
         (NonMyopicMemberRewards (ProtoCrypto proto)))
-> Set (Either Coin (Credential 'Staking (ProtoCrypto proto)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Either Coin (Credential 'Staking (EraCrypto era)))
-> BlockQuery
     (ShelleyBlock proto era) (NonMyopicMemberRewards (EraCrypto era))
Set (Either Coin (Credential 'Staking (ProtoCrypto proto)))
-> BlockQuery
     (ShelleyBlock proto era)
     (NonMyopicMemberRewards (ProtoCrypto proto))
forall era proto.
Set (Either Coin (Credential 'Staking (EraCrypto era)))
-> BlockQuery
     (ShelleyBlock proto era) (NonMyopicMemberRewards (EraCrypto era))
GetNonMyopicMemberRewards (Set (Either Coin (Credential 'Staking (ProtoCrypto proto)))
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> Gen
     (Set (Either Coin (Credential 'Staking (ProtoCrypto proto))))
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set (Either Coin (Credential 'Staking (ProtoCrypto proto))))
forall a. Arbitrary a => Gen a
arbitrary
    , SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Gen (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (PParams era)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (PParams era)
forall proto era. BlockQuery (ShelleyBlock proto era) (PParams era)
GetCurrentPParams
    , SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Gen (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (ProposedPPUpdates era)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (ProposedPPUpdates era)
forall proto era.
BlockQuery (ShelleyBlock proto era) (ProposedPPUpdates era)
GetProposedPParamsUpdates
    , SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Gen (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (PoolDistr (ProtoCrypto proto))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (PoolDistr (EraCrypto era))
BlockQuery (ShelleyBlock proto era) (PoolDistr (ProtoCrypto proto))
forall proto era.
BlockQuery (ShelleyBlock proto era) (PoolDistr (EraCrypto era))
GetStakeDistribution
    , SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Gen (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (EpochState era)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (EpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) (EpochState era)
DebugEpochState
    , (\(SomeSecond BlockQuery (ShelleyBlock proto era) b
q) -> BlockQuery (ShelleyBlock proto era) (Serialised b)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (BlockQuery (ShelleyBlock proto era) b
-> BlockQuery (ShelleyBlock proto era) (Serialised b)
forall proto era result.
BlockQuery (ShelleyBlock proto era) result
-> BlockQuery (ShelleyBlock proto era) (Serialised result)
GetCBOR BlockQuery (ShelleyBlock proto era) b
q)) (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a. Arbitrary a => Gen a
arbitrary
    , BlockQuery
  (ShelleyBlock proto era)
  (Delegations (ProtoCrypto proto),
   RewardAccounts (ProtoCrypto proto))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (BlockQuery
   (ShelleyBlock proto era)
   (Delegations (ProtoCrypto proto),
    RewardAccounts (ProtoCrypto proto))
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> (Set (Credential 'Staking (ProtoCrypto proto))
    -> BlockQuery
         (ShelleyBlock proto era)
         (Delegations (ProtoCrypto proto),
          RewardAccounts (ProtoCrypto proto)))
-> Set (Credential 'Staking (ProtoCrypto proto))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Set (Credential 'Staking (EraCrypto era))
-> BlockQuery
     (ShelleyBlock proto era)
     (Delegations (EraCrypto era), RewardAccounts (EraCrypto era))
Set (Credential 'Staking (ProtoCrypto proto))
-> BlockQuery
     (ShelleyBlock proto era)
     (Delegations (ProtoCrypto proto),
      RewardAccounts (ProtoCrypto proto))
forall era proto.
Set (Credential 'Staking (EraCrypto era))
-> BlockQuery
     (ShelleyBlock proto era)
     (Delegations (EraCrypto era), RewardAccounts (EraCrypto era))
GetFilteredDelegationsAndRewardAccounts (Set (Credential 'Staking (ProtoCrypto proto))
 -> SomeSecond BlockQuery (ShelleyBlock proto era))
-> Gen (Set (Credential 'Staking (ProtoCrypto proto)))
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set (Credential 'Staking (ProtoCrypto proto)))
forall a. Arbitrary a => Gen a
arbitrary
    , SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Gen (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (ShelleyBlock proto era) (CompactGenesis (ProtoCrypto proto))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery
  (ShelleyBlock proto era) (CompactGenesis (EraCrypto era))
BlockQuery
  (ShelleyBlock proto era) (CompactGenesis (ProtoCrypto proto))
forall proto era.
BlockQuery
  (ShelleyBlock proto era) (CompactGenesis (EraCrypto era))
GetGenesisConfig
    , SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SomeSecond BlockQuery (ShelleyBlock proto era)
 -> Gen (SomeSecond BlockQuery (ShelleyBlock proto era)))
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a b. (a -> b) -> a -> b
$ BlockQuery (ShelleyBlock proto era) (NewEpochState era)
-> SomeSecond BlockQuery (ShelleyBlock proto era)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond BlockQuery (ShelleyBlock proto era) (NewEpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) (NewEpochState era)
DebugNewEpochState
    ]

instance 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) (Point (ShelleyBlock proto era))
-> Point (ShelleyBlock proto era)
-> SomeResult (ShelleyBlock proto era)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult BlockQuery
  (ShelleyBlock proto era) (Point (ShelleyBlock proto era))
forall proto era.
BlockQuery
  (ShelleyBlock proto era) (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) EpochNo
-> EpochNo -> SomeResult (ShelleyBlock proto era)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult BlockQuery (ShelleyBlock proto era) EpochNo
forall proto era. BlockQuery (ShelleyBlock proto era) 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)
  (NonMyopicMemberRewards (ProtoCrypto proto))
-> NonMyopicMemberRewards (ProtoCrypto proto)
-> SomeResult (ShelleyBlock proto era)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult (BlockQuery
   (ShelleyBlock proto era)
   (NonMyopicMemberRewards (ProtoCrypto proto))
 -> NonMyopicMemberRewards (ProtoCrypto proto)
 -> SomeResult (ShelleyBlock proto era))
-> Gen
     (BlockQuery
        (ShelleyBlock proto era)
        (NonMyopicMemberRewards (ProtoCrypto proto)))
-> Gen
     (NonMyopicMemberRewards (ProtoCrypto proto)
      -> SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set (Either Coin (Credential 'Staking (EraCrypto era)))
-> BlockQuery
     (ShelleyBlock proto era) (NonMyopicMemberRewards (EraCrypto era))
Set (Either Coin (Credential 'Staking (ProtoCrypto proto)))
-> BlockQuery
     (ShelleyBlock proto era)
     (NonMyopicMemberRewards (ProtoCrypto proto))
forall era proto.
Set (Either Coin (Credential 'Staking (EraCrypto era)))
-> BlockQuery
     (ShelleyBlock proto era) (NonMyopicMemberRewards (EraCrypto era))
GetNonMyopicMemberRewards (Set (Either Coin (Credential 'Staking (ProtoCrypto proto)))
 -> BlockQuery
      (ShelleyBlock proto era)
      (NonMyopicMemberRewards (ProtoCrypto proto)))
-> Gen
     (Set (Either Coin (Credential 'Staking (ProtoCrypto proto))))
-> Gen
     (BlockQuery
        (ShelleyBlock proto era)
        (NonMyopicMemberRewards (ProtoCrypto proto)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set (Either Coin (Credential 'Staking (ProtoCrypto proto))))
forall a. Arbitrary a => Gen a
arbitrary) Gen
  (NonMyopicMemberRewards (ProtoCrypto proto)
   -> SomeResult (ShelleyBlock proto era))
-> Gen (NonMyopicMemberRewards (ProtoCrypto proto))
-> 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 (ProtoCrypto proto))
forall a. Arbitrary a => Gen a
arbitrary
    , BlockQuery (ShelleyBlock proto era) (PParams era)
-> PParams era -> SomeResult (ShelleyBlock proto era)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult BlockQuery (ShelleyBlock proto era) (PParams era)
forall proto era. BlockQuery (ShelleyBlock proto era) (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) (ProposedPPUpdates era)
-> ProposedPPUpdates era -> SomeResult (ShelleyBlock proto era)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult BlockQuery (ShelleyBlock proto era) (ProposedPPUpdates era)
forall proto era.
BlockQuery (ShelleyBlock proto era) (ProposedPPUpdates era)
GetProposedPParamsUpdates (ProposedPPUpdates era -> SomeResult (ShelleyBlock proto era))
-> Gen (ProposedPPUpdates era)
-> Gen (SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ProposedPPUpdates era)
forall a. Arbitrary a => Gen a
arbitrary
    , BlockQuery (ShelleyBlock proto era) (PoolDistr (ProtoCrypto proto))
-> PoolDistr (ProtoCrypto proto)
-> SomeResult (ShelleyBlock proto era)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult BlockQuery (ShelleyBlock proto era) (PoolDistr (EraCrypto era))
BlockQuery (ShelleyBlock proto era) (PoolDistr (ProtoCrypto proto))
forall proto era.
BlockQuery (ShelleyBlock proto era) (PoolDistr (EraCrypto era))
GetStakeDistribution (PoolDistr (ProtoCrypto proto)
 -> SomeResult (ShelleyBlock proto era))
-> (PoolDistr (ProtoCrypto proto) -> PoolDistr (ProtoCrypto proto))
-> PoolDistr (ProtoCrypto proto)
-> SomeResult (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. PoolDistr (ProtoCrypto proto) -> PoolDistr (ProtoCrypto proto)
forall c. PoolDistr c -> PoolDistr c
fromLedgerPoolDistr (PoolDistr (ProtoCrypto proto)
 -> SomeResult (ShelleyBlock proto era))
-> Gen (PoolDistr (ProtoCrypto proto))
-> Gen (SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (PoolDistr (ProtoCrypto proto))
forall a. Arbitrary a => Gen a
arbitrary
    , BlockQuery (ShelleyBlock proto era) (EpochState era)
-> EpochState era -> SomeResult (ShelleyBlock proto era)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult BlockQuery (ShelleyBlock proto era) (EpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) (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) result
q result
r) ->
        BlockQuery (ShelleyBlock proto era) (Serialised result)
-> Serialised result -> SomeResult (ShelleyBlock proto era)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult (BlockQuery (ShelleyBlock proto era) result
-> BlockQuery (ShelleyBlock proto era) (Serialised result)
forall proto era result.
BlockQuery (ShelleyBlock proto era) result
-> BlockQuery (ShelleyBlock proto era) (Serialised result)
GetCBOR BlockQuery (ShelleyBlock proto era) result
q) ((result -> Encoding) -> result -> Serialised result
forall a. (a -> Encoding) -> a -> Serialised a
mkSerialised (ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) result -> result -> Encoding
forall proto era result.
ShelleyCompatible proto era =>
ShelleyNodeToClientVersion
-> BlockQuery (ShelleyBlock proto era) result -> result -> Encoding
encodeShelleyResult ShelleyNodeToClientVersion
forall a. Bounded a => a
maxBound BlockQuery (ShelleyBlock proto era) 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)
  (Delegations (ProtoCrypto proto),
   RewardAccounts (ProtoCrypto proto))
-> (Delegations (ProtoCrypto proto),
    RewardAccounts (ProtoCrypto proto))
-> SomeResult (ShelleyBlock proto era)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult (BlockQuery
   (ShelleyBlock proto era)
   (Delegations (ProtoCrypto proto),
    RewardAccounts (ProtoCrypto proto))
 -> (Delegations (ProtoCrypto proto),
     RewardAccounts (ProtoCrypto proto))
 -> SomeResult (ShelleyBlock proto era))
-> Gen
     (BlockQuery
        (ShelleyBlock proto era)
        (Delegations (ProtoCrypto proto),
         RewardAccounts (ProtoCrypto proto)))
-> Gen
     ((Delegations (ProtoCrypto proto),
       RewardAccounts (ProtoCrypto proto))
      -> SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Set (Credential 'Staking (EraCrypto era))
-> BlockQuery
     (ShelleyBlock proto era)
     (Delegations (EraCrypto era), RewardAccounts (EraCrypto era))
Set (Credential 'Staking (ProtoCrypto proto))
-> BlockQuery
     (ShelleyBlock proto era)
     (Delegations (ProtoCrypto proto),
      RewardAccounts (ProtoCrypto proto))
forall era proto.
Set (Credential 'Staking (EraCrypto era))
-> BlockQuery
     (ShelleyBlock proto era)
     (Delegations (EraCrypto era), RewardAccounts (EraCrypto era))
GetFilteredDelegationsAndRewardAccounts (Set (Credential 'Staking (ProtoCrypto proto))
 -> BlockQuery
      (ShelleyBlock proto era)
      (Delegations (ProtoCrypto proto),
       RewardAccounts (ProtoCrypto proto)))
-> Gen (Set (Credential 'Staking (ProtoCrypto proto)))
-> Gen
     (BlockQuery
        (ShelleyBlock proto era)
        (Delegations (ProtoCrypto proto),
         RewardAccounts (ProtoCrypto proto)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Set (Credential 'Staking (ProtoCrypto proto)))
forall a. Arbitrary a => Gen a
arbitrary) Gen
  ((Delegations (ProtoCrypto proto),
    RewardAccounts (ProtoCrypto proto))
   -> SomeResult (ShelleyBlock proto era))
-> Gen
     (Delegations (ProtoCrypto proto),
      RewardAccounts (ProtoCrypto proto))
-> 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 (ProtoCrypto proto),
   RewardAccounts (ProtoCrypto proto))
forall a. Arbitrary a => Gen a
arbitrary
    , BlockQuery
  (ShelleyBlock proto era) (CompactGenesis (ProtoCrypto proto))
-> CompactGenesis (ProtoCrypto proto)
-> SomeResult (ShelleyBlock proto era)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult BlockQuery
  (ShelleyBlock proto era) (CompactGenesis (EraCrypto era))
BlockQuery
  (ShelleyBlock proto era) (CompactGenesis (ProtoCrypto proto))
forall proto era.
BlockQuery
  (ShelleyBlock proto era) (CompactGenesis (EraCrypto era))
GetGenesisConfig (CompactGenesis (ProtoCrypto proto)
 -> SomeResult (ShelleyBlock proto era))
-> (ShelleyGenesis (ProtoCrypto proto)
    -> CompactGenesis (ProtoCrypto proto))
-> ShelleyGenesis (ProtoCrypto proto)
-> SomeResult (ShelleyBlock proto era)
forall b c a. (b -> c) -> (a -> b) -> a -> c
. ShelleyGenesis (ProtoCrypto proto)
-> CompactGenesis (ProtoCrypto proto)
forall c. ShelleyGenesis c -> CompactGenesis c
compactGenesis (ShelleyGenesis (ProtoCrypto proto)
 -> SomeResult (ShelleyBlock proto era))
-> Gen (ShelleyGenesis (ProtoCrypto proto))
-> Gen (SomeResult (ShelleyBlock proto era))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ShelleyGenesis (ProtoCrypto proto))
forall a. Arbitrary a => Gen a
arbitrary
    , BlockQuery (ShelleyBlock proto era) (NewEpochState era)
-> NewEpochState era -> SomeResult (ShelleyBlock proto era)
forall result blk.
(Eq result, Show result, Typeable result) =>
BlockQuery blk result -> result -> SomeResult blk
SomeResult BlockQuery (ShelleyBlock proto era) (NewEpochState era)
forall proto era.
BlockQuery (ShelleyBlock proto era) (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 PraosCrypto c => Arbitrary (NonMyopicMemberRewards c) where
  arbitrary :: Gen (NonMyopicMemberRewards c)
arbitrary = Map
  (Either Coin (Credential 'Staking c))
  (Map (KeyHash 'StakePool c) Coin)
-> NonMyopicMemberRewards c
forall c.
Map
  (Either Coin (Credential 'Staking c))
  (Map (KeyHash 'StakePool c) Coin)
-> NonMyopicMemberRewards c
NonMyopicMemberRewards (Map
   (Either Coin (Credential 'Staking c))
   (Map (KeyHash 'StakePool c) Coin)
 -> NonMyopicMemberRewards c)
-> Gen
     (Map
        (Either Coin (Credential 'Staking c))
        (Map (KeyHash 'StakePool c) Coin))
-> Gen (NonMyopicMemberRewards c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen
  (Map
     (Either Coin (Credential 'Staking c))
     (Map (KeyHash 'StakePool c) 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 (ProtoCrypto proto)
-> Point (ShelleyBlock proto era)
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint (SlotNo
 -> ShelleyHash (ProtoCrypto proto)
 -> Point (ShelleyBlock proto era))
-> Gen SlotNo
-> Gen
     (ShelleyHash (ProtoCrypto proto) -> 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 (ProtoCrypto proto) -> Point (ShelleyBlock proto era))
-> Gen (ShelleyHash (ProtoCrypto proto))
-> 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 (ProtoCrypto proto))
forall a. Arbitrary a => Gen a
arbitrary

instance PraosCrypto c => Arbitrary (TPraosState c) where
  arbitrary :: Gen (TPraosState c)
arbitrary = do
      WithOrigin SlotNo
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))
        ]
      WithOrigin SlotNo -> ChainDepState c -> TPraosState c
forall c. WithOrigin SlotNo -> ChainDepState c -> TPraosState c
TPraosState WithOrigin SlotNo
lastSlot (ChainDepState c -> TPraosState c)
-> Gen (ChainDepState c) -> Gen (TPraosState c)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ChainDepState c)
forall a. Arbitrary a => Gen a
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 (ProtoCrypto proto)
-> ShelleyTip proto era
forall proto era.
SlotNo
-> BlockNo
-> HeaderHash (ShelleyBlock proto era)
-> ShelleyTip proto era
ShelleyTip
    (SlotNo
 -> BlockNo
 -> ShelleyHash (ProtoCrypto proto)
 -> ShelleyTip proto era)
-> Gen SlotNo
-> Gen
     (BlockNo
      -> ShelleyHash (ProtoCrypto proto) -> 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 (ProtoCrypto proto) -> ShelleyTip proto era)
-> Gen BlockNo
-> Gen (ShelleyHash (ProtoCrypto proto) -> 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 (ProtoCrypto proto) -> ShelleyTip proto era)
-> Gen (ShelleyHash (ProtoCrypto proto))
-> 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 (ProtoCrypto proto))
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 CanMock proto era => Arbitrary (LedgerState (ShelleyBlock proto era)) where
  arbitrary :: Gen (LedgerState (ShelleyBlock proto era))
arbitrary = WithOrigin (ShelleyTip proto era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerState (ShelleyBlock proto era)
forall proto era.
WithOrigin (ShelleyTip proto era)
-> NewEpochState era
-> ShelleyTransition
-> LedgerState (ShelleyBlock proto era)
ShelleyLedgerState
    (WithOrigin (ShelleyTip proto era)
 -> NewEpochState era
 -> ShelleyTransition
 -> LedgerState (ShelleyBlock proto era))
-> Gen (WithOrigin (ShelleyTip proto era))
-> Gen
     (NewEpochState era
      -> ShelleyTransition -> LedgerState (ShelleyBlock proto era))
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 -> LedgerState (ShelleyBlock proto era))
-> Gen (NewEpochState era)
-> Gen (ShelleyTransition -> LedgerState (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 (NewEpochState era)
forall a. Arbitrary a => Gen a
arbitrary
    Gen (ShelleyTransition -> LedgerState (ShelleyBlock proto era))
-> Gen ShelleyTransition
-> Gen (LedgerState (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 ShelleyTransition
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 (ProtoCrypto proto)
-> AnnTip (ShelleyBlock proto era)
forall blk. SlotNo -> BlockNo -> TipInfo blk -> AnnTip blk
AnnTip
    (SlotNo
 -> BlockNo
 -> ShelleyHash (ProtoCrypto proto)
 -> AnnTip (ShelleyBlock proto era))
-> Gen SlotNo
-> Gen
     (BlockNo
      -> ShelleyHash (ProtoCrypto proto)
      -> 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 (ProtoCrypto proto)
   -> AnnTip (ShelleyBlock proto era))
-> Gen BlockNo
-> Gen
     (ShelleyHash (ProtoCrypto proto)
      -> 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 (ProtoCrypto proto)
   -> AnnTip (ShelleyBlock proto era))
-> Gen (ShelleyHash (ProtoCrypto proto))
-> 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 (ProtoCrypto proto))
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 (f :: * -> *). TrivialDependency f => f (TrivialIndex f)
indexIsTrivial)

{-------------------------------------------------------------------------------
  Generators for cardano-ledger-specs
-------------------------------------------------------------------------------}

instance PraosCrypto c => Arbitrary (SL.ChainDepState c) where
  arbitrary :: Gen (ChainDepState c)
arbitrary = Gen (ChainDepState c)
forall a. (GArbitrary UnsizedOpts a, GUniformWeight a) => Gen a
genericArbitraryU
  shrink :: ChainDepState c -> [ChainDepState c]
shrink = ChainDepState c -> [ChainDepState c]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

{-------------------------------------------------------------------------------
  Versioned generators for serialisation
-------------------------------------------------------------------------------}

-- | Some 'Query's are only supported by 'ShelleyNodeToClientVersion2', so we
-- make sure to not generate those queries in combination with
-- 'ShelleyNodeToClientVersion1'.
instance CanMock proto era
      => Arbitrary (WithVersion ShelleyNodeToClientVersion (SomeSecond BlockQuery (ShelleyBlock proto era))) where
  arbitrary :: Gen
  (WithVersion
     ShelleyNodeToClientVersion
     (SomeSecond BlockQuery (ShelleyBlock proto era)))
arbitrary = do
      query :: SomeSecond BlockQuery (ShelleyBlock proto era)
query@(SomeSecond BlockQuery (ShelleyBlock proto era) b
q) <- Gen (SomeSecond BlockQuery (ShelleyBlock proto era))
forall a. Arbitrary a => Gen a
arbitrary
      ShelleyNodeToClientVersion
version <- Gen ShelleyNodeToClientVersion
forall a. Arbitrary a => Gen a
arbitrary Gen ShelleyNodeToClientVersion
-> (ShelleyNodeToClientVersion -> Bool)
-> Gen ShelleyNodeToClientVersion
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` BlockQuery (ShelleyBlock proto era) b
-> ShelleyNodeToClientVersion -> Bool
forall proto era result.
BlockQuery (ShelleyBlock proto era) result
-> ShelleyNodeToClientVersion -> Bool
querySupportedVersion BlockQuery (ShelleyBlock proto era) b
q
      WithVersion
  ShelleyNodeToClientVersion
  (SomeSecond BlockQuery (ShelleyBlock proto era))
-> Gen
     (WithVersion
        ShelleyNodeToClientVersion
        (SomeSecond BlockQuery (ShelleyBlock proto era)))
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (WithVersion
   ShelleyNodeToClientVersion
   (SomeSecond BlockQuery (ShelleyBlock proto era))
 -> Gen
      (WithVersion
         ShelleyNodeToClientVersion
         (SomeSecond BlockQuery (ShelleyBlock proto era))))
-> WithVersion
     ShelleyNodeToClientVersion
     (SomeSecond BlockQuery (ShelleyBlock proto era))
-> Gen
     (WithVersion
        ShelleyNodeToClientVersion
        (SomeSecond BlockQuery (ShelleyBlock proto era)))
forall a b. (a -> b) -> a -> b
$ ShelleyNodeToClientVersion
-> SomeSecond BlockQuery (ShelleyBlock proto era)
-> WithVersion
     ShelleyNodeToClientVersion
     (SomeSecond BlockQuery (ShelleyBlock proto era))
forall v a. v -> a -> WithVersion v a
WithVersion ShelleyNodeToClientVersion
version SomeSecond BlockQuery (ShelleyBlock proto era)
query