{-# LANGUAGE DataKinds #-}
{-# LANGUAGE DerivingVia #-}
{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE GADTs #-}
{-# LANGUAGE GeneralisedNewtypeDeriving #-}
{-# LANGUAGE NamedFieldPuns #-}
{-# LANGUAGE NumericUnderscores #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeOperators #-}
{-# LANGUAGE UndecidableInstances #-}

{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Util.Orphans.Arbitrary (
    SmallDiffTime (..)
  , genLimitedEpochSize
  , genLimitedSlotNo
  , genSmallEpochNo
  , genSmallSlotNo
    -- * Time
  , genNominalDiffTime50Years
  , genUTCTime50Years
  ) where

import           Data.Coerce (coerce)
import           Data.SOP.BasicFunctors
import           Data.SOP.Constraint
import           Data.SOP.Dict (Dict (..), all_NP, mapAll)
import           Data.SOP.NonEmpty (IsNonEmpty, ProofNonEmpty (..),
                     checkIsNonEmpty, isNonEmpty)
import           Data.SOP.Sing
import           Data.SOP.Strict
import           Data.Time
import           Data.Word (Word64)
import           Ouroboros.Consensus.Block
import           Ouroboros.Consensus.BlockchainTime
import           Ouroboros.Consensus.HardFork.Combinator (HardForkBlock,
                     HardForkChainDepState, HardForkState (..),
                     LedgerEraInfo (..), LedgerState (..), Mismatch (..),
                     MismatchEraInfo (..), SingleEraBlock (..), SingleEraInfo,
                     Telescope (..), proxySingle)
import           Ouroboros.Consensus.HardFork.Combinator.State (Current (..),
                     Past (..))
import           Ouroboros.Consensus.HardFork.History (Bound (..))
import           Ouroboros.Consensus.HeaderValidation (TipInfo)
import           Ouroboros.Consensus.Ledger.Abstract
import           Ouroboros.Consensus.Ledger.Query
import           Ouroboros.Consensus.Ledger.SupportsMempool
import           Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck
                     (ClockSkew)
import qualified Ouroboros.Consensus.MiniProtocol.ChainSync.Client.InFutureCheck as InFutureCheck
import           Ouroboros.Consensus.Node.ProtocolInfo
import           Ouroboros.Consensus.Protocol.Abstract (ChainDepState)
import           Ouroboros.Consensus.Storage.ChainDB.API (LoE (..))
import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Internal
                     (ChunkNo (..), ChunkSize (..), RelativeSlot (..))
import           Ouroboros.Consensus.Storage.ImmutableDB.Chunks.Layout
import qualified Ouroboros.Consensus.Storage.ImmutableDB.Impl.Index as Index
import           Ouroboros.Consensus.TypeFamilyWrappers
import           Ouroboros.Network.SizeInBytes
import           Test.Cardano.Slotting.Arbitrary ()
import           Test.QuickCheck hiding (Fixed (..))
import           Test.QuickCheck.Instances ()
import           Test.Util.Time (dawnOfTime)

minNumCoreNodes :: Word64
minNumCoreNodes :: Word64
minNumCoreNodes = Word64
2

instance Arbitrary NumCoreNodes where
  arbitrary :: Gen NumCoreNodes
arbitrary = Word64 -> NumCoreNodes
NumCoreNodes (Word64 -> NumCoreNodes) -> Gen Word64 -> Gen NumCoreNodes
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
minNumCoreNodes, Word64
5)
  shrink :: NumCoreNodes -> [NumCoreNodes]
shrink (NumCoreNodes Word64
n) = Word64 -> NumCoreNodes
NumCoreNodes (Word64 -> NumCoreNodes) -> [Word64] -> [NumCoreNodes]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ((Word64 -> Bool) -> [Word64] -> [Word64]
forall a. (a -> Bool) -> [a] -> [a]
filter (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
>= Word64
minNumCoreNodes) ([Word64] -> [Word64]) -> [Word64] -> [Word64]
forall a b. (a -> b) -> a -> b
$ Word64 -> [Word64]
forall a. Arbitrary a => a -> [a]
shrink Word64
n)

-- | Picks time span between 0 seconds and (roughly) 50 years
--
-- /Note/ - Arbitrary instance for `NominalDiffTime` comes from @quickcheck-instances@ and
-- it uses a much wider timespan.
genNominalDiffTime50Years :: Gen NominalDiffTime
genNominalDiffTime50Years :: Gen NominalDiffTime
genNominalDiffTime50Years = Double -> NominalDiffTime
conv (Double -> NominalDiffTime) -> Gen Double -> Gen NominalDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (Double
0, Double
50 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
daysPerYear Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
secondsPerDay)
  where
    conv :: Double -> NominalDiffTime
    conv :: Double -> NominalDiffTime
conv = Double -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac

-- | Picks moment between 'dawnOfTime' and (roughly) 50 years later
--
-- /Note/ - Arbitrary instance for `UTCTime` comes from @quickcheck-instances@ and it uses
-- a much wider timespan.
genUTCTime50Years :: Gen UTCTime
genUTCTime50Years :: Gen UTCTime
genUTCTime50Years = (NominalDiffTime -> UTCTime -> UTCTime
`addUTCTime` UTCTime
dawnOfTime) (NominalDiffTime -> UTCTime) -> Gen NominalDiffTime -> Gen UTCTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen NominalDiffTime
genNominalDiffTime50Years

-- | Length between 0.001 and 20 seconds, millisecond granularity
instance Arbitrary SlotLength where
  arbitrary :: Gen SlotLength
arbitrary = Integer -> SlotLength
slotLengthFromMillisec (Integer -> SlotLength) -> Gen Integer -> Gen SlotLength
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
1, Integer
20 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
1_000)

  -- Try to shrink the slot length to just "1", for tests where the slot length
  -- really doesn't matter very much
  shrink :: SlotLength -> [SlotLength]
shrink SlotLength
slotLen = if SlotLength
slotLen SlotLength -> SlotLength -> Bool
forall a. Eq a => a -> a -> Bool
/= SlotLength
oneSec then [SlotLength
oneSec] else []
    where
      oneSec :: SlotLength
oneSec = Integer -> SlotLength
slotLengthFromSec Integer
1

instance Arbitrary RelativeSlot where
  arbitrary :: Gen RelativeSlot
arbitrary = ChunkNo -> ChunkSize -> Word64 -> RelativeSlot
RelativeSlot (ChunkNo -> ChunkSize -> Word64 -> RelativeSlot)
-> Gen ChunkNo -> Gen (ChunkSize -> Word64 -> RelativeSlot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ChunkNo
forall a. Arbitrary a => Gen a
arbitrary Gen (ChunkSize -> Word64 -> RelativeSlot)
-> Gen ChunkSize -> Gen (Word64 -> RelativeSlot)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen ChunkSize
forall a. Arbitrary a => Gen a
arbitrary Gen (Word64 -> RelativeSlot) -> Gen Word64 -> Gen RelativeSlot
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

-- | The functions 'slotAtTime' and 'timeUntilNextSlot' suffer from arithmetic
-- overflow for very large values, so generate values that avoid overflow when
-- used in these two functions. The largest value generated is still sufficently
-- large to allow for 5e12 years worth of slots at a slot interval of 20
-- seconds.
genLimitedSlotNo :: Gen SlotNo
genLimitedSlotNo :: Gen SlotNo
genLimitedSlotNo =
    Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary Gen Word64 -> (Word64 -> Bool) -> Gen Word64
forall a. Gen a -> (a -> Bool) -> Gen a
`suchThat` (Word64 -> Word64 -> Bool
forall a. Ord a => a -> a -> Bool
< Word64
0x8000000000000000)

-- | Generate a small SlotNo for the state machine tests. The runtime of the
-- StateMachine prop_sequential tests is proportional the the upper bound.
genSmallSlotNo :: Gen SlotNo
genSmallSlotNo :: Gen SlotNo
genSmallSlotNo =
    Word64 -> SlotNo
SlotNo (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
0, Word64
1000)

-- | The tests for 'CumulEpochSizes' requires that the sum of a list of these
-- values does not overflow.
--
-- An epoch size must be > 0.
genLimitedEpochSize :: Gen EpochSize
genLimitedEpochSize :: Gen EpochSize
genLimitedEpochSize =
    Word64 -> EpochSize
EpochSize (Word64 -> EpochSize) -> Gen Word64 -> Gen EpochSize
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
100_000)

genSmallEpochNo :: Gen EpochNo
genSmallEpochNo :: Gen EpochNo
genSmallEpochNo =
    Word64 -> EpochNo
EpochNo (Word64 -> EpochNo) -> Gen Word64 -> Gen EpochNo
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
10000)

-- | This picks an 'EpochNo' between 0 and 10000
--
-- We don't pick larger values because we're not interested in testing overflow
-- due to huge epoch numbers and even huger slot numbers.
instance Arbitrary ChunkNo where
  arbitrary :: Gen ChunkNo
arbitrary = Word64 -> ChunkNo
ChunkNo (Word64 -> ChunkNo) -> Gen Word64 -> Gen ChunkNo
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
10000)
  shrink :: ChunkNo -> [ChunkNo]
shrink    = ChunkNo -> [ChunkNo]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

-- | Picks a 'ChunkSize' between 1 and 100, and randomly choose to enable EBBs
instance Arbitrary ChunkSize where
  arbitrary :: Gen ChunkSize
arbitrary = Bool -> Word64 -> ChunkSize
ChunkSize (Bool -> Word64 -> ChunkSize)
-> Gen Bool -> Gen (Word64 -> ChunkSize)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary Gen (Word64 -> ChunkSize) -> Gen Word64 -> Gen ChunkSize
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
1, Word64
100)
  shrink :: ChunkSize -> [ChunkSize]
shrink    = ChunkSize -> [ChunkSize]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary ChunkSlot where
  arbitrary :: Gen ChunkSlot
arbitrary = ChunkNo -> RelativeSlot -> ChunkSlot
UnsafeChunkSlot (ChunkNo -> RelativeSlot -> ChunkSlot)
-> Gen ChunkNo -> Gen (RelativeSlot -> ChunkSlot)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen ChunkNo
forall a. Arbitrary a => Gen a
arbitrary Gen (RelativeSlot -> ChunkSlot)
-> Gen RelativeSlot -> Gen ChunkSlot
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen RelativeSlot
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: ChunkSlot -> [ChunkSlot]
shrink    = ChunkSlot -> [ChunkSlot]
forall a.
(Generic a, RecursivelyShrink (Rep a), GSubterms (Rep a) a) =>
a -> [a]
genericShrink

instance Arbitrary ClockSkew where
  arbitrary :: Gen ClockSkew
arbitrary = Double -> ClockSkew
InFutureCheck.clockSkewInSeconds (Double -> ClockSkew) -> Gen Double -> Gen ClockSkew
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Double, Double) -> Gen Double
forall a. Random a => (a, a) -> Gen a
choose (Double
0, Double
5)
  shrink :: ClockSkew -> [ClockSkew]
shrink ClockSkew
skew = [[ClockSkew]] -> [ClockSkew]
forall (t :: * -> *) a. Foldable t => t [a] -> [a]
concat [
     -- Shrink to some simple values, including 0
     -- (it would be useful to know if a test fails only when having non-zero
     -- clock skew)
       [ ClockSkew
skew0 | ClockSkew
skew0 ClockSkew -> ClockSkew -> Bool
forall a. Ord a => a -> a -> Bool
< ClockSkew
skew ]
     , [ ClockSkew
skew1 | ClockSkew
skew1 ClockSkew -> ClockSkew -> Bool
forall a. Ord a => a -> a -> Bool
< ClockSkew
skew ]
     ]
    where
      skew0, skew1 :: ClockSkew
      skew0 :: ClockSkew
skew0 = Double -> ClockSkew
InFutureCheck.clockSkewInSeconds Double
0
      skew1 :: ClockSkew
skew1 = Double -> ClockSkew
InFutureCheck.clockSkewInSeconds Double
1

deriving newtype instance Arbitrary SizeInBytes

{-------------------------------------------------------------------------------
  SmallDiffTime
-------------------------------------------------------------------------------}

-- | Wrapper around NominalDiffTime with custom 'Arbitrary' instance
--
-- The default 'Arbitrary' instance for 'NominalDiffTime' isn't very useful:
--
-- * It tends to pick huge values
-- * It tends not to pick integer values
-- * It does not shrink
--
-- Our custom instance
--
-- * Picks values between 0 and (1000 * 20 * 10) seconds:
--   - Maximum segment length: 1000
--   - Maximum slot length: 20 seconds
--   - Maximum number of segments: 10
-- * With a 0.1 second precision
-- * Shrinks
newtype SmallDiffTime = SmallDiffTime NominalDiffTime
  deriving (Int -> SmallDiffTime -> ShowS
[SmallDiffTime] -> ShowS
SmallDiffTime -> String
(Int -> SmallDiffTime -> ShowS)
-> (SmallDiffTime -> String)
-> ([SmallDiffTime] -> ShowS)
-> Show SmallDiffTime
forall a.
(Int -> a -> ShowS) -> (a -> String) -> ([a] -> ShowS) -> Show a
$cshowsPrec :: Int -> SmallDiffTime -> ShowS
showsPrec :: Int -> SmallDiffTime -> ShowS
$cshow :: SmallDiffTime -> String
show :: SmallDiffTime -> String
$cshowList :: [SmallDiffTime] -> ShowS
showList :: [SmallDiffTime] -> ShowS
Show)

instance Arbitrary SmallDiffTime where
  arbitrary :: Gen SmallDiffTime
arbitrary = Integer -> SmallDiffTime
conv (Integer -> SmallDiffTime) -> Gen Integer -> Gen SmallDiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer
0, Integer
1000 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
20 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10 Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
* Integer
10)
    where
      -- NominalDiffTime conversion functions treat it as seconds
      conv :: Integer -> SmallDiffTime
      conv :: Integer -> SmallDiffTime
conv Integer
n = NominalDiffTime -> SmallDiffTime
SmallDiffTime (NominalDiffTime -> SmallDiffTime)
-> NominalDiffTime -> SmallDiffTime
forall a b. (a -> b) -> a -> b
$ Double -> NominalDiffTime
forall a b. (Real a, Fractional b) => a -> b
realToFrac Double
seconds
        where
          seconds :: Double
          seconds :: Double
seconds = Integer -> Double
forall a. Num a => Integer -> a
fromInteger Integer
n Double -> Double -> Double
forall a. Fractional a => a -> a -> a
/ Double
10

  -- try to shrink to some small, simple values
  -- (include 1.5 so that we can shrink to a simple, but yet not whole, value)
  shrink :: SmallDiffTime -> [SmallDiffTime]
shrink (SmallDiffTime NominalDiffTime
d) = (NominalDiffTime -> SmallDiffTime)
-> [NominalDiffTime] -> [SmallDiffTime]
forall a b. (a -> b) -> [a] -> [b]
map NominalDiffTime -> SmallDiffTime
SmallDiffTime ([NominalDiffTime] -> [SmallDiffTime])
-> [NominalDiffTime] -> [SmallDiffTime]
forall a b. (a -> b) -> a -> b
$
      (NominalDiffTime -> Bool) -> [NominalDiffTime] -> [NominalDiffTime]
forall a. (a -> Bool) -> [a] -> [a]
filter (NominalDiffTime -> NominalDiffTime -> Bool
forall a. Ord a => a -> a -> Bool
< NominalDiffTime
d) [NominalDiffTime
1, NominalDiffTime
1.5, NominalDiffTime
2, NominalDiffTime
3, NominalDiffTime
100]

{-------------------------------------------------------------------------------
  Auxiliary: time
-------------------------------------------------------------------------------}

-- | Average number of days per year
--
-- <https://en.wikipedia.org/wiki/Year>
daysPerYear :: Double
daysPerYear :: Double
daysPerYear = Double
365.2425

-- | Seconds per day
secondsPerDay :: Double
secondsPerDay :: Double
secondsPerDay = Double
24 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
60 Double -> Double -> Double
forall a. Num a => a -> a -> a
* Double
60

{-------------------------------------------------------------------------------
  Forwarding instances
-------------------------------------------------------------------------------}

-- | Forwarding
instance Arbitrary (ChainDepState (BlockProtocol blk))
      => Arbitrary (WrapChainDepState blk) where
  arbitrary :: Gen (WrapChainDepState blk)
arbitrary = ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
forall blk.
ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
WrapChainDepState (ChainDepState (BlockProtocol blk) -> WrapChainDepState blk)
-> Gen (ChainDepState (BlockProtocol blk))
-> Gen (WrapChainDepState blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ChainDepState (BlockProtocol blk))
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: WrapChainDepState blk -> [WrapChainDepState blk]
shrink WrapChainDepState blk
x  = ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
forall blk.
ChainDepState (BlockProtocol blk) -> WrapChainDepState blk
WrapChainDepState (ChainDepState (BlockProtocol blk) -> WrapChainDepState blk)
-> [ChainDepState (BlockProtocol blk)] -> [WrapChainDepState blk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ChainDepState (BlockProtocol blk)
-> [ChainDepState (BlockProtocol blk)]
forall a. Arbitrary a => a -> [a]
shrink (WrapChainDepState blk -> ChainDepState (BlockProtocol blk)
forall blk.
WrapChainDepState blk -> ChainDepState (BlockProtocol blk)
unwrapChainDepState WrapChainDepState blk
x)

-- | Forwarding
instance Arbitrary (HeaderHash blk)
      => Arbitrary (WrapHeaderHash blk) where
  arbitrary :: Gen (WrapHeaderHash blk)
arbitrary = HeaderHash blk -> WrapHeaderHash blk
forall blk. HeaderHash blk -> WrapHeaderHash blk
WrapHeaderHash (HeaderHash blk -> WrapHeaderHash blk)
-> Gen (HeaderHash blk) -> Gen (WrapHeaderHash blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (HeaderHash blk)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: WrapHeaderHash blk -> [WrapHeaderHash blk]
shrink WrapHeaderHash blk
x  = HeaderHash blk -> WrapHeaderHash blk
forall blk. HeaderHash blk -> WrapHeaderHash blk
WrapHeaderHash (HeaderHash blk -> WrapHeaderHash blk)
-> [HeaderHash blk] -> [WrapHeaderHash blk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> HeaderHash blk -> [HeaderHash blk]
forall a. Arbitrary a => a -> [a]
shrink (WrapHeaderHash blk -> HeaderHash blk
forall blk. WrapHeaderHash blk -> HeaderHash blk
unwrapHeaderHash WrapHeaderHash blk
x)

-- | Forwarding
instance Arbitrary (TipInfo blk)
      => Arbitrary (WrapTipInfo blk) where
  arbitrary :: Gen (WrapTipInfo blk)
arbitrary = TipInfo blk -> WrapTipInfo blk
forall blk. TipInfo blk -> WrapTipInfo blk
WrapTipInfo (TipInfo blk -> WrapTipInfo blk)
-> Gen (TipInfo blk) -> Gen (WrapTipInfo blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (TipInfo blk)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: WrapTipInfo blk -> [WrapTipInfo blk]
shrink WrapTipInfo blk
x  = TipInfo blk -> WrapTipInfo blk
forall blk. TipInfo blk -> WrapTipInfo blk
WrapTipInfo (TipInfo blk -> WrapTipInfo blk)
-> [TipInfo blk] -> [WrapTipInfo blk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> TipInfo blk -> [TipInfo blk]
forall a. Arbitrary a => a -> [a]
shrink (WrapTipInfo blk -> TipInfo blk
forall blk. WrapTipInfo blk -> TipInfo blk
unwrapTipInfo WrapTipInfo blk
x)

-- | Forwarding
instance Arbitrary a => Arbitrary (I a) where
  arbitrary :: Gen (I a)
arbitrary = a -> I a
forall a. a -> I a
I (a -> I a) -> Gen a -> Gen (I a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: I a -> [I a]
shrink  I a
x = a -> I a
forall a. a -> I a
I (a -> I a) -> [a] -> [I a]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> a -> [a]
forall a. Arbitrary a => a -> [a]
shrink (I a -> a
forall a. I a -> a
unI I a
x)

-- | Forwarding
instance Arbitrary (ApplyTxErr blk)
      => Arbitrary (WrapApplyTxErr blk) where
  arbitrary :: Gen (WrapApplyTxErr blk)
arbitrary = ApplyTxErr blk -> WrapApplyTxErr blk
forall blk. ApplyTxErr blk -> WrapApplyTxErr blk
WrapApplyTxErr (ApplyTxErr blk -> WrapApplyTxErr blk)
-> Gen (ApplyTxErr blk) -> Gen (WrapApplyTxErr blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ApplyTxErr blk)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: WrapApplyTxErr blk -> [WrapApplyTxErr blk]
shrink WrapApplyTxErr blk
x  = ApplyTxErr blk -> WrapApplyTxErr blk
forall blk. ApplyTxErr blk -> WrapApplyTxErr blk
WrapApplyTxErr (ApplyTxErr blk -> WrapApplyTxErr blk)
-> [ApplyTxErr blk] -> [WrapApplyTxErr blk]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> ApplyTxErr blk -> [ApplyTxErr blk]
forall a. Arbitrary a => a -> [a]
shrink (WrapApplyTxErr blk -> ApplyTxErr blk
forall blk. WrapApplyTxErr blk -> ApplyTxErr blk
unwrapApplyTxErr WrapApplyTxErr blk
x)

{-------------------------------------------------------------------------------
  NS
-------------------------------------------------------------------------------}

instance (All (Arbitrary `Compose` f) xs, IsNonEmpty xs)
      => Arbitrary (NS f xs) where
  arbitrary :: Gen (NS f xs)
arbitrary = case Proxy xs -> ProofNonEmpty xs
forall {a} (xs :: [a]) (proxy :: [a] -> *).
IsNonEmpty xs =>
proxy xs -> ProofNonEmpty xs
forall (proxy :: [*] -> *). proxy xs -> ProofNonEmpty xs
isNonEmpty (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs) of
      ProofNonEmpty Proxy x
_ Proxy xs1
pf -> case Proxy xs1 -> Maybe (ProofNonEmpty xs1)
forall {a} (xs :: [a]).
SListI xs =>
Proxy xs -> Maybe (ProofNonEmpty xs)
checkIsNonEmpty Proxy xs1
pf of
        Maybe (ProofNonEmpty xs1)
Nothing                    -> f x -> NS f xs
f x -> NS f (x : xs1)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (f x -> NS f xs) -> Gen (f x) -> Gen (NS f xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (f x)
forall a. Arbitrary a => Gen a
arbitrary
        Just (ProofNonEmpty Proxy x
_ Proxy xs1
pf') -> [(Int, Gen (NS f xs))] -> Gen (NS f xs)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
          [ (Int
1, f x -> NS f xs
f x -> NS f (x : x : xs1)
forall {k} (f :: k -> *) (x :: k) (xs1 :: [k]).
f x -> NS f (x : xs1)
Z (f x -> NS f xs) -> Gen (f x) -> Gen (NS f xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (f x)
forall a. Arbitrary a => Gen a
arbitrary)
            -- Use the number of remaining cases (one less than @xs@) as the
            -- weight so that the distribution is uniform
          , (Proxy xs1 -> Int
forall k (xs :: [k]) (proxy :: [k] -> *).
SListI xs =>
proxy xs -> Int
lengthSList Proxy xs1
pf', NS f (x : xs1) -> NS f xs
NS f (x : xs1) -> NS f (x : x : xs1)
forall {k} (f :: k -> *) (xs1 :: [k]) (x :: k).
NS f xs1 -> NS f (x : xs1)
S (NS f (x : xs1) -> NS f xs)
-> Gen (NS f (x : xs1)) -> Gen (NS f xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NS f (x : xs1))
forall a. Arbitrary a => Gen a
arbitrary)
          ]
  shrink :: NS f xs -> [NS f xs]
shrink = Proxy (Compose Arbitrary f)
-> (forall a. Compose Arbitrary f a => f a -> [f a])
-> NS f xs
-> [NS f xs]
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (g :: * -> *) (proxy :: (k -> Constraint) -> *)
       (f :: k -> *) (f' :: k -> *).
(HSequence h, AllN h c xs, Applicative g) =>
proxy c
-> (forall (a :: k). c a => f a -> g (f' a))
-> h f xs
-> g (h f' xs)
forall (c :: * -> Constraint) (xs :: [*]) (g :: * -> *)
       (proxy :: (* -> Constraint) -> *) (f :: * -> *) (f' :: * -> *).
(AllN NS c xs, Applicative g) =>
proxy c
-> (forall a. c a => f a -> g (f' a)) -> NS f xs -> g (NS f' xs)
hctraverse' (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @(Arbitrary `Compose` f)) f a -> [f a]
forall a. Arbitrary a => a -> [a]
forall a. Compose Arbitrary f a => f a -> [f a]
shrink

{-------------------------------------------------------------------------------
  Telescope & HardForkState
-------------------------------------------------------------------------------}

instance Arbitrary Bound where
  arbitrary :: Gen Bound
arbitrary =
      RelativeTime -> SlotNo -> EpochNo -> Bound
Bound
        (RelativeTime -> SlotNo -> EpochNo -> Bound)
-> Gen RelativeTime -> Gen (SlotNo -> EpochNo -> Bound)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (NominalDiffTime -> RelativeTime
RelativeTime (NominalDiffTime -> RelativeTime)
-> Gen NominalDiffTime -> Gen RelativeTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen NominalDiffTime
forall a. Arbitrary a => Gen a
arbitrary)
        Gen (SlotNo -> EpochNo -> Bound)
-> Gen SlotNo -> Gen (EpochNo -> Bound)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> SlotNo
SlotNo       (Word64 -> SlotNo) -> Gen Word64 -> Gen SlotNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary)
        Gen (EpochNo -> Bound) -> Gen EpochNo -> Gen Bound
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> (Word64 -> EpochNo
EpochNo      (Word64 -> EpochNo) -> Gen Word64 -> Gen EpochNo
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word64
forall a. Arbitrary a => Gen a
arbitrary)

instance Arbitrary (K Past blk) where
  arbitrary :: Gen (K Past blk)
arbitrary = Past -> K Past blk
forall k a (b :: k). a -> K a b
K (Past -> K Past blk) -> Gen Past -> Gen (K Past blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Bound -> Bound -> Past
Past (Bound -> Bound -> Past) -> Gen Bound -> Gen (Bound -> Past)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bound
forall a. Arbitrary a => Gen a
arbitrary Gen (Bound -> Past) -> Gen Bound -> Gen Past
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Bound
forall a. Arbitrary a => Gen a
arbitrary)

instance Arbitrary (f blk) => Arbitrary (Current f blk) where
  arbitrary :: Gen (Current f blk)
arbitrary = Bound -> f blk -> Current f blk
forall (f :: * -> *) blk. Bound -> f blk -> Current f blk
Current (Bound -> f blk -> Current f blk)
-> Gen Bound -> Gen (f blk -> Current f blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bound
forall a. Arbitrary a => Gen a
arbitrary Gen (f blk -> Current f blk) -> Gen (f blk) -> Gen (Current f blk)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (f blk)
forall a. Arbitrary a => Gen a
arbitrary

instance ( IsNonEmpty xs
         , All (Arbitrary `Compose` f) xs
         , All (Arbitrary `Compose` g) xs
         ) => Arbitrary (Telescope g f xs) where
  arbitrary :: Gen (Telescope g f xs)
arbitrary = case Proxy xs -> ProofNonEmpty xs
forall {a} (xs :: [a]) (proxy :: [a] -> *).
IsNonEmpty xs =>
proxy xs -> ProofNonEmpty xs
forall (proxy :: [*] -> *). proxy xs -> ProofNonEmpty xs
isNonEmpty (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs) of
      ProofNonEmpty Proxy x
_ Proxy xs1
pf -> case Proxy xs1 -> Maybe (ProofNonEmpty xs1)
forall {a} (xs :: [a]).
SListI xs =>
Proxy xs -> Maybe (ProofNonEmpty xs)
checkIsNonEmpty Proxy xs1
pf of
        Maybe (ProofNonEmpty xs1)
Nothing                    -> f x -> Telescope g f xs
f x -> Telescope g f (x : xs1)
forall {k} (f :: k -> *) (x :: k) (g :: k -> *) (xs1 :: [k]).
f x -> Telescope g f (x : xs1)
TZ (f x -> Telescope g f xs) -> Gen (f x) -> Gen (Telescope g f xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (f x)
forall a. Arbitrary a => Gen a
arbitrary
        Just (ProofNonEmpty Proxy x
_ Proxy xs1
pf') -> [(Int, Gen (Telescope g f xs))] -> Gen (Telescope g f xs)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
          [ (Int
1, f x -> Telescope g f xs
f x -> Telescope g f (x : x : xs1)
forall {k} (f :: k -> *) (x :: k) (g :: k -> *) (xs1 :: [k]).
f x -> Telescope g f (x : xs1)
TZ (f x -> Telescope g f xs) -> Gen (f x) -> Gen (Telescope g f xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (f x)
forall a. Arbitrary a => Gen a
arbitrary)
          , (Proxy xs1 -> Int
forall k (xs :: [k]) (proxy :: [k] -> *).
SListI xs =>
proxy xs -> Int
lengthSList Proxy xs1
pf', g x -> Telescope g f (x : xs1) -> Telescope g f xs
g x -> Telescope g f (x : xs1) -> Telescope g f (x : x : xs1)
forall {k} (g :: k -> *) (x :: k) (f :: k -> *) (xs1 :: [k]).
g x -> Telescope g f xs1 -> Telescope g f (x : xs1)
TS (g x -> Telescope g f (x : xs1) -> Telescope g f xs)
-> Gen (g x) -> Gen (Telescope g f (x : xs1) -> Telescope g f xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (g x)
forall a. Arbitrary a => Gen a
arbitrary Gen (Telescope g f (x : xs1) -> Telescope g f xs)
-> Gen (Telescope g f (x : xs1)) -> Gen (Telescope g f xs)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Telescope g f (x : xs1))
forall a. Arbitrary a => Gen a
arbitrary)
          ]
  shrink :: Telescope g f xs -> [Telescope g f xs]
shrink = Proxy (Compose Arbitrary f)
-> (forall a. Compose Arbitrary f a => f a -> [f a])
-> Telescope g f xs
-> [Telescope g f xs]
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (g :: * -> *) (proxy :: (k -> Constraint) -> *)
       (f :: k -> *) (f' :: k -> *).
(HSequence h, AllN h c xs, Applicative g) =>
proxy c
-> (forall (a :: k). c a => f a -> g (f' a))
-> h f xs
-> g (h f' xs)
forall (c :: * -> Constraint) (xs :: [*]) (g :: * -> *)
       (proxy :: (* -> Constraint) -> *) (f :: * -> *) (f' :: * -> *).
(AllN (Telescope g) c xs, Applicative g) =>
proxy c
-> (forall a. c a => f a -> g (f' a))
-> Telescope g f xs
-> g (Telescope g f' xs)
hctraverse' (forall {k} (t :: k). Proxy t
forall (t :: * -> Constraint). Proxy t
Proxy @(Arbitrary `Compose` f)) f a -> [f a]
forall a. Arbitrary a => a -> [a]
forall a. Compose Arbitrary f a => f a -> [f a]
shrink

instance (IsNonEmpty xs, SListI xs, All (Arbitrary `Compose` LedgerState) xs)
      => Arbitrary (LedgerState (HardForkBlock xs)) where
  arbitrary :: Gen (LedgerState (HardForkBlock xs))
arbitrary = case (Dict (All (Compose Arbitrary (K Past))) xs
dictKPast, Dict (All (Compose Arbitrary (Current LedgerState))) xs
dictCurrentLedgerState) of
      (Dict (All (Compose Arbitrary (K Past))) xs
Dict, Dict (All (Compose Arbitrary (Current LedgerState))) xs
Dict) -> Telescope (K Past) (Current LedgerState) xs
-> LedgerState (HardForkBlock xs)
inj (Telescope (K Past) (Current LedgerState) xs
 -> LedgerState (HardForkBlock xs))
-> Gen (Telescope (K Past) (Current LedgerState) xs)
-> Gen (LedgerState (HardForkBlock xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Telescope (K Past) (Current LedgerState) xs)
forall a. Arbitrary a => Gen a
arbitrary
    where
      inj ::
           Telescope (K Past) (Current LedgerState) xs
        -> LedgerState (HardForkBlock xs)
      inj :: Telescope (K Past) (Current LedgerState) xs
-> LedgerState (HardForkBlock xs)
inj = Telescope (K Past) (Current LedgerState) xs
-> LedgerState (HardForkBlock xs)
forall a b. Coercible a b => a -> b
coerce

      dictKPast :: Dict (All (Arbitrary `Compose` (K Past))) xs
      dictKPast :: Dict (All (Compose Arbitrary (K Past))) xs
dictKPast = NP (Dict (Compose Arbitrary (K Past))) xs
-> Dict (All (Compose Arbitrary (K Past))) xs
forall {k} (c :: k -> Constraint) (xs :: [k]).
NP (Dict c) xs -> Dict (All c) xs
all_NP (NP (Dict (Compose Arbitrary (K Past))) xs
 -> Dict (All (Compose Arbitrary (K Past))) xs)
-> NP (Dict (Compose Arbitrary (K Past))) xs
-> Dict (All (Compose Arbitrary (K Past))) xs
forall a b. (a -> b) -> a -> b
$ (forall a. Dict (Compose Arbitrary (K Past)) a)
-> NP (Dict (Compose Arbitrary (K Past))) xs
forall (xs :: [*]) (f :: * -> *).
SListIN NP xs =>
(forall a. f a) -> NP f xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure Dict (Compose Arbitrary (K Past)) a
forall a. Dict (Compose Arbitrary (K Past)) a
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

      dictCurrentLedgerState ::
           Dict (All (Arbitrary `Compose` (Current LedgerState))) xs
      dictCurrentLedgerState :: Dict (All (Compose Arbitrary (Current LedgerState))) xs
dictCurrentLedgerState =
          forall {k} (c :: k -> Constraint) (d :: k -> Constraint)
       (xs :: [k]).
(forall (a :: k). Dict c a -> Dict d a)
-> Dict (All c) xs -> Dict (All d) xs
forall (c :: * -> Constraint) (d :: * -> Constraint) (xs :: [*]).
(forall a. Dict c a -> Dict d a)
-> Dict (All c) xs -> Dict (All d) xs
mapAll
            @(Arbitrary `Compose` LedgerState)
            @(Arbitrary `Compose` Current LedgerState)
            (\Dict (Compose Arbitrary LedgerState) a
Dict -> Dict (Compose Arbitrary (Current LedgerState)) a
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict)
            Dict (All (Compose Arbitrary LedgerState)) xs
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

instance (IsNonEmpty xs, SListI xs, All (Arbitrary `Compose` WrapChainDepState) xs)
      => Arbitrary (HardForkChainDepState xs) where
  arbitrary :: Gen (HardForkChainDepState xs)
arbitrary = case (Dict (All (Compose Arbitrary (K Past))) xs
dictKPast, Dict (All (Compose Arbitrary (Current WrapChainDepState))) xs
dictCurrentWrapChainDepState) of
      (Dict (All (Compose Arbitrary (K Past))) xs
Dict, Dict (All (Compose Arbitrary (Current WrapChainDepState))) xs
Dict) -> Telescope (K Past) (Current WrapChainDepState) xs
-> HardForkChainDepState xs
inj (Telescope (K Past) (Current WrapChainDepState) xs
 -> HardForkChainDepState xs)
-> Gen (Telescope (K Past) (Current WrapChainDepState) xs)
-> Gen (HardForkChainDepState xs)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Telescope (K Past) (Current WrapChainDepState) xs)
forall a. Arbitrary a => Gen a
arbitrary
    where
      inj ::
           Telescope (K Past) (Current WrapChainDepState) xs
        -> HardForkChainDepState xs
      inj :: Telescope (K Past) (Current WrapChainDepState) xs
-> HardForkChainDepState xs
inj = Telescope (K Past) (Current WrapChainDepState) xs
-> HardForkChainDepState xs
forall a b. Coercible a b => a -> b
coerce

      dictKPast :: Dict (All (Arbitrary `Compose` (K Past))) xs
      dictKPast :: Dict (All (Compose Arbitrary (K Past))) xs
dictKPast = NP (Dict (Compose Arbitrary (K Past))) xs
-> Dict (All (Compose Arbitrary (K Past))) xs
forall {k} (c :: k -> Constraint) (xs :: [k]).
NP (Dict c) xs -> Dict (All c) xs
all_NP (NP (Dict (Compose Arbitrary (K Past))) xs
 -> Dict (All (Compose Arbitrary (K Past))) xs)
-> NP (Dict (Compose Arbitrary (K Past))) xs
-> Dict (All (Compose Arbitrary (K Past))) xs
forall a b. (a -> b) -> a -> b
$ (forall a. Dict (Compose Arbitrary (K Past)) a)
-> NP (Dict (Compose Arbitrary (K Past))) xs
forall (xs :: [*]) (f :: * -> *).
SListIN NP xs =>
(forall a. f a) -> NP f xs
forall k l (h :: (k -> *) -> l -> *) (xs :: l) (f :: k -> *).
(HPure h, SListIN h xs) =>
(forall (a :: k). f a) -> h f xs
hpure Dict (Compose Arbitrary (K Past)) a
forall a. Dict (Compose Arbitrary (K Past)) a
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

      dictCurrentWrapChainDepState ::
           Dict (All (Arbitrary `Compose` (Current WrapChainDepState))) xs
      dictCurrentWrapChainDepState :: Dict (All (Compose Arbitrary (Current WrapChainDepState))) xs
dictCurrentWrapChainDepState =
          forall {k} (c :: k -> Constraint) (d :: k -> Constraint)
       (xs :: [k]).
(forall (a :: k). Dict c a -> Dict d a)
-> Dict (All c) xs -> Dict (All d) xs
forall (c :: * -> Constraint) (d :: * -> Constraint) (xs :: [*]).
(forall a. Dict c a -> Dict d a)
-> Dict (All c) xs -> Dict (All d) xs
mapAll
            @(Arbitrary `Compose` WrapChainDepState)
            @(Arbitrary `Compose` Current WrapChainDepState)
            (\Dict (Compose Arbitrary WrapChainDepState) a
Dict -> Dict (Compose Arbitrary (Current WrapChainDepState)) a
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict)
            Dict (All (Compose Arbitrary WrapChainDepState)) xs
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

{-------------------------------------------------------------------------------
  Mismatch & MismatchEraInfo
-------------------------------------------------------------------------------}

instance ( IsNonEmpty xs
         , All (Arbitrary `Compose` f) (x ': xs)
         , All (Arbitrary `Compose` g) (x ': xs)
         ) => Arbitrary (Mismatch f g (x ': xs)) where
 arbitrary :: Gen (Mismatch f g (x : xs))
arbitrary = case Proxy xs -> ProofNonEmpty xs
forall {a} (xs :: [a]) (proxy :: [a] -> *).
IsNonEmpty xs =>
proxy xs -> ProofNonEmpty xs
forall (proxy :: [*] -> *). proxy xs -> ProofNonEmpty xs
isNonEmpty (forall (t :: [*]). Proxy t
forall {k} (t :: k). Proxy t
Proxy @xs) of
    ProofNonEmpty Proxy x
_ Proxy xs1
pf -> [(Int, Gen (Mismatch f g (x : xs)))] -> Gen (Mismatch f g (x : xs))
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency ([(Int, Gen (Mismatch f g (x : xs)))]
 -> Gen (Mismatch f g (x : xs)))
-> [(Int, Gen (Mismatch f g (x : xs)))]
-> Gen (Mismatch f g (x : xs))
forall a b. (a -> b) -> a -> b
$ [[(Int, Gen (Mismatch f g (x : xs)))]]
-> [(Int, Gen (Mismatch f g (x : xs)))]
forall a. Monoid a => [a] -> a
mconcat [
        -- length (x ': xs) = n + 1
        -- This line: n cases, the line below: also n cases.
        [ (Int
1, f x -> NS g xs -> Mismatch f g (x : xs)
forall {k} (f :: k -> *) (x :: k) (g :: k -> *) (xs1 :: [k]).
f x -> NS g xs1 -> Mismatch f g (x : xs1)
ML (f x -> NS g xs -> Mismatch f g (x : xs))
-> Gen (f x) -> Gen (NS g xs -> Mismatch f g (x : xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (f x)
forall a. Arbitrary a => Gen a
arbitrary Gen (NS g xs -> Mismatch f g (x : xs))
-> Gen (NS g xs) -> Gen (Mismatch f g (x : xs))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (NS g xs)
forall a. Arbitrary a => Gen a
arbitrary)
        , (Int
1, NS f xs -> g x -> Mismatch f g (x : xs)
forall {k} (f :: k -> *) (xs1 :: [k]) (g :: k -> *) (x :: k).
NS f xs1 -> g x -> Mismatch f g (x : xs1)
MR (NS f xs -> g x -> Mismatch f g (x : xs))
-> Gen (NS f xs) -> Gen (g x -> Mismatch f g (x : xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (NS f xs)
forall a. Arbitrary a => Gen a
arbitrary Gen (g x -> Mismatch f g (x : xs))
-> Gen (g x) -> Gen (Mismatch f g (x : xs))
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (g x)
forall a. Arbitrary a => Gen a
arbitrary)
        ]
      , case Proxy xs1 -> Maybe (ProofNonEmpty xs1)
forall {a} (xs :: [a]).
SListI xs =>
Proxy xs -> Maybe (ProofNonEmpty xs)
checkIsNonEmpty Proxy xs1
pf of
          Maybe (ProofNonEmpty xs1)
Nothing                     -> []
          -- The line below: n * (n - 1) cases. We want the weights to be
          -- proportional so that the distribution is uniform. We divide each
          -- weight by n to get 1 and 1 for the ML and MR cases above and n - 1 (=
          -- lengthSList pxs') for the MS case below.
          Just (ProofNonEmpty Proxy x
_ Proxy xs1
pxs') -> [(Proxy xs1 -> Int
forall k (xs :: [k]) (proxy :: [k] -> *).
SListI xs =>
proxy xs -> Int
lengthSList Proxy xs1
pxs', Mismatch f g xs -> Mismatch f g (x : xs)
forall {k} (f :: k -> *) (g :: k -> *) (xs1 :: [k]) (x :: k).
Mismatch f g xs1 -> Mismatch f g (x : xs1)
MS (Mismatch f g xs -> Mismatch f g (x : xs))
-> Gen (Mismatch f g xs) -> Gen (Mismatch f g (x : xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Mismatch f g xs)
forall a. Arbitrary a => Gen a
arbitrary)]
      ]

instance SingleEraBlock blk => Arbitrary (SingleEraInfo blk) where
  arbitrary :: Gen (SingleEraInfo blk)
arbitrary = SingleEraInfo blk -> Gen (SingleEraInfo blk)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (SingleEraInfo blk -> Gen (SingleEraInfo blk))
-> SingleEraInfo blk -> Gen (SingleEraInfo blk)
forall a b. (a -> b) -> a -> b
$ Proxy blk -> SingleEraInfo blk
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *). proxy blk -> SingleEraInfo blk
singleEraInfo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)

instance SingleEraBlock blk => Arbitrary (LedgerEraInfo blk) where
  arbitrary :: Gen (LedgerEraInfo blk)
arbitrary = LedgerEraInfo blk -> Gen (LedgerEraInfo blk)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (LedgerEraInfo blk -> Gen (LedgerEraInfo blk))
-> LedgerEraInfo blk -> Gen (LedgerEraInfo blk)
forall a b. (a -> b) -> a -> b
$ SingleEraInfo blk -> LedgerEraInfo blk
forall blk. SingleEraInfo blk -> LedgerEraInfo blk
LedgerEraInfo (SingleEraInfo blk -> LedgerEraInfo blk)
-> SingleEraInfo blk -> LedgerEraInfo blk
forall a b. (a -> b) -> a -> b
$ Proxy blk -> SingleEraInfo blk
forall blk (proxy :: * -> *).
SingleEraBlock blk =>
proxy blk -> SingleEraInfo blk
forall (proxy :: * -> *). proxy blk -> SingleEraInfo blk
singleEraInfo (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @blk)

instance (All SingleEraBlock (x ': xs), IsNonEmpty xs)
      => Arbitrary (MismatchEraInfo (x ': xs)) where
  arbitrary :: Gen (MismatchEraInfo (x : xs))
arbitrary =
      case (Dict (All (Compose Arbitrary SingleEraInfo)) (x : xs)
dictSingleEraInfo, Dict (All (Compose Arbitrary LedgerEraInfo)) (x : xs)
dictLedgerEraInfo) of
        (Dict (All (Compose Arbitrary SingleEraInfo)) (x : xs)
Dict, Dict (All (Compose Arbitrary LedgerEraInfo)) (x : xs)
Dict) -> Mismatch SingleEraInfo LedgerEraInfo (x : xs)
-> MismatchEraInfo (x : xs)
forall (xs :: [*]).
Mismatch SingleEraInfo LedgerEraInfo xs -> MismatchEraInfo xs
MismatchEraInfo (Mismatch SingleEraInfo LedgerEraInfo (x : xs)
 -> MismatchEraInfo (x : xs))
-> Gen (Mismatch SingleEraInfo LedgerEraInfo (x : xs))
-> Gen (MismatchEraInfo (x : xs))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Mismatch SingleEraInfo LedgerEraInfo (x : xs))
forall a. Arbitrary a => Gen a
arbitrary
    where
      dictSingleEraInfo ::
           Dict (All (Arbitrary `Compose` SingleEraInfo)) (x ': xs)
      dictSingleEraInfo :: Dict (All (Compose Arbitrary SingleEraInfo)) (x : xs)
dictSingleEraInfo = NP (Dict (Compose Arbitrary SingleEraInfo)) (x : xs)
-> Dict (All (Compose Arbitrary SingleEraInfo)) (x : xs)
forall {k} (c :: k -> Constraint) (xs :: [k]).
NP (Dict c) xs -> Dict (All c) xs
all_NP (NP (Dict (Compose Arbitrary SingleEraInfo)) (x : xs)
 -> Dict (All (Compose Arbitrary SingleEraInfo)) (x : xs))
-> NP (Dict (Compose Arbitrary SingleEraInfo)) (x : xs)
-> Dict (All (Compose Arbitrary SingleEraInfo)) (x : xs)
forall a b. (a -> b) -> a -> b
$ Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Dict (Compose Arbitrary SingleEraInfo) a)
-> NP (Dict (Compose Arbitrary SingleEraInfo)) (x : xs)
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
forall (c :: * -> Constraint) (xs :: [*])
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
AllN NP c xs =>
proxy c -> (forall a. c a => f a) -> NP f xs
hcpure Proxy SingleEraBlock
proxySingle Dict (Compose Arbitrary SingleEraInfo) a
forall a.
SingleEraBlock a =>
Dict (Compose Arbitrary SingleEraInfo) a
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

      dictLedgerEraInfo ::
           Dict (All (Arbitrary `Compose` LedgerEraInfo)) (x ': xs)
      dictLedgerEraInfo :: Dict (All (Compose Arbitrary LedgerEraInfo)) (x : xs)
dictLedgerEraInfo = NP (Dict (Compose Arbitrary LedgerEraInfo)) (x : xs)
-> Dict (All (Compose Arbitrary LedgerEraInfo)) (x : xs)
forall {k} (c :: k -> Constraint) (xs :: [k]).
NP (Dict c) xs -> Dict (All c) xs
all_NP (NP (Dict (Compose Arbitrary LedgerEraInfo)) (x : xs)
 -> Dict (All (Compose Arbitrary LedgerEraInfo)) (x : xs))
-> NP (Dict (Compose Arbitrary LedgerEraInfo)) (x : xs)
-> Dict (All (Compose Arbitrary LedgerEraInfo)) (x : xs)
forall a b. (a -> b) -> a -> b
$ Proxy SingleEraBlock
-> (forall a.
    SingleEraBlock a =>
    Dict (Compose Arbitrary LedgerEraInfo) a)
-> NP (Dict (Compose Arbitrary LedgerEraInfo)) (x : xs)
forall k l (h :: (k -> *) -> l -> *) (c :: k -> Constraint)
       (xs :: l) (proxy :: (k -> Constraint) -> *) (f :: k -> *).
(HPure h, AllN h c xs) =>
proxy c -> (forall (a :: k). c a => f a) -> h f xs
forall (c :: * -> Constraint) (xs :: [*])
       (proxy :: (* -> Constraint) -> *) (f :: * -> *).
AllN NP c xs =>
proxy c -> (forall a. c a => f a) -> NP f xs
hcpure Proxy SingleEraBlock
proxySingle Dict (Compose Arbitrary LedgerEraInfo) a
forall a.
SingleEraBlock a =>
Dict (Compose Arbitrary LedgerEraInfo) a
forall {k} (c :: k -> Constraint) (a :: k). c a => Dict c a
Dict

{-------------------------------------------------------------------------------
  Query
-------------------------------------------------------------------------------}

instance Arbitrary QueryVersion where
  arbitrary :: Gen QueryVersion
arbitrary = Gen QueryVersion
forall a. (Bounded a, Enum a) => Gen a
arbitraryBoundedEnum
  shrink :: QueryVersion -> [QueryVersion]
shrink QueryVersion
v = if QueryVersion
v QueryVersion -> QueryVersion -> Bool
forall a. Eq a => a -> a -> Bool
== QueryVersion
forall a. Bounded a => a
minBound then [] else [QueryVersion -> QueryVersion
forall a. Enum a => a -> a
pred QueryVersion
v]

instance Arbitrary (SomeSecond BlockQuery blk)
      => Arbitrary (SomeSecond Query blk) where
  arbitrary :: Gen (SomeSecond Query blk)
arbitrary = do
    SomeSecond BlockQuery blk b
someBlockQuery <- Gen (SomeSecond BlockQuery blk)
forall a. Arbitrary a => Gen a
arbitrary
    SomeSecond Query blk -> Gen (SomeSecond Query blk)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (Query blk b -> SomeSecond Query blk
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond (BlockQuery blk b -> Query blk b
forall blk result. BlockQuery blk result -> Query blk result
BlockQuery BlockQuery blk b
someBlockQuery))


instance Arbitrary Index.CacheConfig where
  arbitrary :: Gen CacheConfig
arbitrary = do
    Word32
pastChunksToCache <- [(Int, Gen Word32)] -> Gen Word32
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency
      -- Pick small values so that we exercise cache eviction
      [ (Int
1, Word32 -> Gen Word32
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
1)
      , (Int
1, Word32 -> Gen Word32
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Word32
2)
      , (Int
1, (Word32, Word32) -> Gen Word32
forall a. Random a => (a, a) -> Gen a
choose (Word32
3, Word32
10))
      ]
    -- TODO create a Cmd that advances time, so this is being exercised too.
    DiffTime
expireUnusedAfter <- (Int -> DiffTime
forall a b. (Integral a, Num b) => a -> b
fromIntegral :: Int -> DiffTime) (Int -> DiffTime) -> Gen Int -> Gen DiffTime
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int, Int) -> Gen Int
forall a. Random a => (a, a) -> Gen a
choose (Int
1, Int
100)
    CacheConfig -> Gen CacheConfig
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Index.CacheConfig {Word32
pastChunksToCache :: Word32
$sel:pastChunksToCache:CacheConfig :: Word32
Index.pastChunksToCache, DiffTime
expireUnusedAfter :: DiffTime
$sel:expireUnusedAfter:CacheConfig :: DiffTime
Index.expireUnusedAfter}

{-------------------------------------------------------------------------------
  LoE
-------------------------------------------------------------------------------}

instance Arbitrary a => Arbitrary (LoE a) where
  arbitrary :: Gen (LoE a)
arbitrary = [Gen (LoE a)] -> Gen (LoE a)
forall a. HasCallStack => [Gen a] -> Gen a
oneof [LoE a -> Gen (LoE a)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure LoE a
forall a. LoE a
LoEDisabled, a -> LoE a
forall a. a -> LoE a
LoEEnabled (a -> LoE a) -> Gen a -> Gen (LoE a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen a
forall a. Arbitrary a => Gen a
arbitrary]
  shrink :: LoE a -> [LoE a]
shrink LoE a
LoEDisabled    = []
  shrink (LoEEnabled a
x) = LoE a
forall a. LoE a
LoEDisabled LoE a -> [LoE a] -> [LoE a]
forall a. a -> [a] -> [a]
: (a -> LoE a) -> [a] -> [LoE a]
forall a b. (a -> b) -> [a] -> [b]
map a -> LoE a
forall a. a -> LoE a
LoEEnabled (a -> [a]
forall a. Arbitrary a => a -> [a]
shrink a
x)