{-# LANGUAGE CPP #-}
{-# LANGUAGE GeneralizedNewtypeDeriving #-}
{-# LANGUAGE LambdaCase #-}
{-# LANGUAGE MultiParamTypeClasses #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE StandaloneDeriving #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE TypeFamilies #-}
{-# LANGUAGE TypeOperators #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Cardano.Ledger.Binary.Arbitrary (
  genVersion,
  genByteArray,
  genByteString,
  genLazyByteString,
  genShortByteString,
)
where

import Cardano.Crypto.DSIGN.Class hiding (Signable)
import Cardano.Crypto.Util
import Cardano.Crypto.VRF.Class
import Cardano.Ledger.Binary.Version
import Cardano.Slotting.Block (BlockNo (..))
import Cardano.Slotting.Slot (EpochSize (..), WithOrigin (..))
import Cardano.Slotting.Time (SystemStart (..))
import Codec.CBOR.ByteArray (ByteArray (..))
import Codec.CBOR.ByteArray.Sliced (SlicedByteArray (..))
import Codec.CBOR.Term
import qualified Data.ByteString as BS (ByteString, pack, unpack)
import qualified Data.ByteString.Lazy as BSL (ByteString, fromChunks, fromStrict, toChunks)
import Numeric.Half
#if MIN_VERSION_bytestring(0,11,1)
import qualified Data.ByteString.Short as SBS
#else
import qualified Data.ByteString.Short.Internal as SBS
#endif
import qualified Data.Foldable as F
import Data.IP (IPv4, IPv6, toIPv4w, toIPv6w)
import Data.Maybe.Strict
import qualified Data.Primitive.ByteArray as Prim (ByteArray (..))
import Data.Proxy (Proxy (..))
import qualified Data.Sequence.Strict as SSeq
import qualified Data.Text as T
import qualified Data.Text.Lazy as TL
import qualified Data.VMap as VMap
import qualified Data.Vector.Primitive as VP
import Data.Word
import GHC.Stack
import System.Random.Stateful hiding (genByteString, genShortByteString)
import Test.Cardano.Ledger.Binary.Random (QC (QC))
import Test.Cardano.Slotting.Arbitrary ()
import Test.Crypto.Hash ()
import Test.Crypto.KES ()
import Test.Crypto.VRF ()
import Test.QuickCheck
import Test.QuickCheck.Instances ()

firstUnreservedTag :: Word64
firstUnreservedTag :: Word64
firstUnreservedTag = Word64
6

-- | Simple values that are either unassigned or don't have a specialized type already
simple :: [Word8]
simple :: [Word8]
simple = [Word8
0 .. Word8
19] forall a. [a] -> [a] -> [a]
++ [Word8
23] forall a. [a] -> [a] -> [a]
++ [Word8
32 ..]

instance Arbitrary Term where
  arbitrary :: Gen Term
arbitrary =
    forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Int -> Term
TInt forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (forall a. Bounded a => a
minBound, forall a. Bounded a => a
maxBound)
      , Integer -> Term
TInteger
          forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [Gen a] -> Gen a
oneof
            [ forall a. Random a => (a, a) -> Gen a
choose (forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Int) forall a. Num a => a -> a -> a
+ Integer
1, forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Word64))
            , forall a. Random a => (a, a) -> Gen a
choose (forall a. Num a => a -> a
negate (forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
maxBound :: Word64)), forall a. Integral a => a -> Integer
toInteger (forall a. Bounded a => a
minBound :: Int) forall a. Num a => a -> a -> a
- Integer
1)
            ]
      , ByteString -> Term
TBytes forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Gen ByteString
genByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonNegative a -> a
getNonNegative forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Arbitrary a => Gen a
arbitrary)
      , ByteString -> Term
TBytesI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Gen ByteString
genLazyByteString forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. NonNegative a -> a
getNonNegative forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< forall a. Arbitrary a => Gen a
arbitrary)
      , Text -> Term
TString forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , Text -> Term
TStringI forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , [Term] -> Term
TList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf forall a. Arbitrary a => Gen a
smallerTerm
      , [Term] -> Term
TListI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf forall a. Arbitrary a => Gen a
smallerTerm
      , [(Term, Term)] -> Term
TMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf forall a. Arbitrary a => Gen a
smallerTerm
      , [(Term, Term)] -> Term
TMapI forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Gen a -> Gen [a]
listOf forall a. Arbitrary a => Gen a
smallerTerm
      , Word64 -> Term -> Term
TTagged forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Random a => (a, a) -> Gen a
choose (Word64
firstUnreservedTag, forall a. Bounded a => a
maxBound :: Word64) forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
smallerTerm
      , Bool -> Term
TBool forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
TNull
      , Word8 -> Term
TSimple forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. HasCallStack => [a] -> Gen a
elements [Word8]
simple
      , Float -> Term
THalf forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Float
genHalf
      , Float -> Term
TFloat forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      , Double -> Term
TDouble forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
      ]
    where
      smallerTerm :: Arbitrary a => Gen a
      smallerTerm :: forall a. Arbitrary a => Gen a
smallerTerm = forall a. (Int -> Int) -> Gen a -> Gen a
scale (forall a. Integral a => a -> a -> a
`div` Int
5) forall a. Arbitrary a => Gen a
arbitrary

  -- Shrinker was shamelessly stolen from cbor package.
  shrink :: Term -> [Term]
shrink (TInt Int
n) = [Int -> Term
TInt Int
n' | Int
n' <- forall a. Arbitrary a => a -> [a]
shrink Int
n]
  shrink (TInteger Integer
n) = [Integer -> Term
TInteger Integer
n' | Integer
n' <- forall a. Arbitrary a => a -> [a]
shrink Integer
n]
  shrink (TBytes ByteString
ws) = [ByteString -> Term
TBytes ([Word8] -> ByteString
BS.pack [Word8]
ws') | [Word8]
ws' <- forall a. Arbitrary a => a -> [a]
shrink (ByteString -> [Word8]
BS.unpack ByteString
ws)]
  shrink (TBytesI ByteString
wss) =
    [ ByteString -> Term
TBytesI ([ByteString] -> ByteString
BSL.fromChunks (forall a b. (a -> b) -> [a] -> [b]
map [Word8] -> ByteString
BS.pack [[Word8]]
wss'))
    | [[Word8]]
wss' <- forall a. Arbitrary a => a -> [a]
shrink (forall a b. (a -> b) -> [a] -> [b]
map ByteString -> [Word8]
BS.unpack (ByteString -> [ByteString]
BSL.toChunks ByteString
wss))
    ]
  shrink (TString Text
cs) = [Text -> Term
TString (String -> Text
T.pack String
cs') | String
cs' <- forall a. Arbitrary a => a -> [a]
shrink (Text -> String
T.unpack Text
cs)]
  shrink (TStringI Text
css) =
    [ Text -> Term
TStringI ([Text] -> Text
TL.fromChunks (forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
css'))
    | [String]
css' <- forall a. Arbitrary a => a -> [a]
shrink (forall a b. (a -> b) -> [a] -> [b]
map Text -> String
T.unpack (Text -> [Text]
TL.toChunks Text
css))
    ]
  shrink (TList xs :: [Term]
xs@[Term
x]) = Term
x forall a. a -> [a] -> [a]
: [[Term] -> Term
TList [Term]
xs' | [Term]
xs' <- forall a. Arbitrary a => a -> [a]
shrink [Term]
xs]
  shrink (TList [Term]
xs) = [[Term] -> Term
TList [Term]
xs' | [Term]
xs' <- forall a. Arbitrary a => a -> [a]
shrink [Term]
xs]
  shrink (TListI xs :: [Term]
xs@[Term
x]) = Term
x forall a. a -> [a] -> [a]
: [[Term] -> Term
TListI [Term]
xs' | [Term]
xs' <- forall a. Arbitrary a => a -> [a]
shrink [Term]
xs]
  shrink (TListI [Term]
xs) = [[Term] -> Term
TListI [Term]
xs' | [Term]
xs' <- forall a. Arbitrary a => a -> [a]
shrink [Term]
xs]
  shrink (TMap xys :: [(Term, Term)]
xys@[(Term
x, Term
y)]) = Term
x forall a. a -> [a] -> [a]
: Term
y forall a. a -> [a] -> [a]
: [[(Term, Term)] -> Term
TMap [(Term, Term)]
xys' | [(Term, Term)]
xys' <- forall a. Arbitrary a => a -> [a]
shrink [(Term, Term)]
xys]
  shrink (TMap [(Term, Term)]
xys) = [[(Term, Term)] -> Term
TMap [(Term, Term)]
xys' | [(Term, Term)]
xys' <- forall a. Arbitrary a => a -> [a]
shrink [(Term, Term)]
xys]
  shrink (TMapI xys :: [(Term, Term)]
xys@[(Term
x, Term
y)]) = Term
x forall a. a -> [a] -> [a]
: Term
y forall a. a -> [a] -> [a]
: [[(Term, Term)] -> Term
TMapI [(Term, Term)]
xys' | [(Term, Term)]
xys' <- forall a. Arbitrary a => a -> [a]
shrink [(Term, Term)]
xys]
  shrink (TMapI [(Term, Term)]
xys) = [[(Term, Term)] -> Term
TMapI [(Term, Term)]
xys' | [(Term, Term)]
xys' <- forall a. Arbitrary a => a -> [a]
shrink [(Term, Term)]
xys]
  shrink (TTagged Word64
w Term
t) =
    Term
t forall a. a -> [a] -> [a]
: [Word64 -> Term -> Term
TTagged Word64
w' Term
t' | (Word64
w', Term
t') <- forall a. Arbitrary a => a -> [a]
shrink (Word64
w, Term
t), forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w' forall a. Ord a => a -> a -> Bool
>= Word64
firstUnreservedTag]
  shrink (TBool Bool
_) = []
  shrink Term
TNull = []
  shrink (TSimple Word8
w) = [Word8 -> Term
TSimple Word8
w' | Word8
w' <- forall a. Arbitrary a => a -> [a]
shrink Word8
w, Word8
w forall (t :: * -> *) a. (Foldable t, Eq a) => a -> t a -> Bool
`elem` [Word8]
simple]
  shrink (THalf Float
_f) = []
  shrink (TFloat Float
f) = [Float -> Term
TFloat Float
f' | Float
f' <- forall a. Arbitrary a => a -> [a]
shrink Float
f]
  shrink (TDouble Double
f) = [Double -> Term
TDouble Double
f' | Double
f' <- forall a. Arbitrary a => a -> [a]
shrink Double
f]

genHalf :: Gen Float
genHalf :: Gen Float
genHalf = do
  Half
half <- CUShort -> Half
Half forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  if forall a. RealFloat a => a -> Bool
isInfinite Half
half Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isDenormalized Half
half Bool -> Bool -> Bool
|| forall a. RealFloat a => a -> Bool
isNaN Half
half
    then Gen Float
genHalf
    else forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ Half -> Float
fromHalf Half
half

deriving instance Arbitrary ByteArray

instance Arbitrary SlicedByteArray where
  arbitrary :: Gen SlicedByteArray
arbitrary = do
    NonNegative Int
off <- forall a. Arbitrary a => Gen a
arbitrary
    Positive Int
count <- forall a. Arbitrary a => Gen a
arbitrary
    NonNegative Int
slack <- forall a. Arbitrary a => Gen a
arbitrary
    let len :: Int
len = Int
off forall a. Num a => a -> a -> a
+ Int
count forall a. Num a => a -> a -> a
+ Int
slack
    ByteArray
ba <- Int -> Gen ByteArray
genByteArray Int
len
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ ByteArray -> Int -> Int -> SlicedByteArray
SBA ByteArray
ba Int
off Int
count

instance Arbitrary IPv4 where
  arbitrary :: Gen IPv4
arbitrary = Word32 -> IPv4
toIPv4w forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary IPv6 where
  arbitrary :: Gen IPv6
arbitrary = do
    (Word32, Word32, Word32, Word32)
t <- (,,,) forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> forall a. Arbitrary a => Gen a
arbitrary
    forall (f :: * -> *) a. Applicative f => a -> f a
pure forall a b. (a -> b) -> a -> b
$ (Word32, Word32, Word32, Word32) -> IPv6
toIPv6w (Word32, Word32, Word32, Word32)
t

instance (VP.Prim e, Arbitrary e) => Arbitrary (VP.Vector e) where
  arbitrary :: Gen (Vector e)
arbitrary = forall a. Prim a => [a] -> Vector a
VP.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: Vector e -> [Vector e]
shrink = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Prim a => [a] -> Vector a
VP.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Prim a => Vector a -> [a]
VP.toList

instance Arbitrary e => Arbitrary (SSeq.StrictSeq e) where
  arbitrary :: Gen (StrictSeq e)
arbitrary = forall a. [a] -> StrictSeq a
SSeq.fromList forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: StrictSeq e -> [StrictSeq e]
shrink = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. [a] -> StrictSeq a
SSeq.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (t :: * -> *) a. Foldable t => t a -> [a]
F.toList

instance Arbitrary e => Arbitrary (StrictMaybe e) where
  arbitrary :: Gen (StrictMaybe e)
arbitrary = forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: StrictMaybe e -> [StrictMaybe e]
shrink = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. StrictMaybe a -> Maybe a
strictMaybeToMaybe

instance
  (Ord k, VMap.Vector kv k, VMap.Vector vv v, Arbitrary k, Arbitrary v) =>
  Arbitrary (VMap.VMap kv vv k v)
  where
  arbitrary :: Gen (VMap kv vv k v)
arbitrary = forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary
  shrink :: VMap kv vv k v -> [VMap kv vv k v]
shrink = forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
[(k, v)] -> VMap kv vv k v
VMap.fromList forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall a. Arbitrary a => a -> [a]
shrink forall b c a. (b -> c) -> (a -> b) -> a -> c
. forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
VMap kv vv k v -> [(k, v)]
VMap.toList

instance DSIGNAlgorithm v => Arbitrary (VerKeyDSIGN v) where
  arbitrary :: Gen (VerKeyDSIGN v)
arbitrary = forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

errorInvalidSize :: HasCallStack => Int -> Maybe a -> Gen a
errorInvalidSize :: forall a. HasCallStack => Int -> Maybe a -> Gen a
errorInvalidSize Int
n = forall b a. b -> (a -> b) -> Maybe a -> b
maybe (forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Impossible: Invalid size " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Int
n) forall (f :: * -> *) a. Applicative f => a -> f a
pure

instance DSIGNAlgorithm v => Arbitrary (SignKeyDSIGN v) where
  arbitrary :: Gen (SignKeyDSIGN v)
arbitrary = do
    let n :: Int
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall {k} (t :: k). Proxy t
Proxy @v))
    ByteString
bs <- Int -> Gen ByteString
genByteString Int
n
    forall a. HasCallStack => Int -> Maybe a -> Gen a
errorInvalidSize Int
n forall a b. (a -> b) -> a -> b
$ forall v. DSIGNAlgorithm v => ByteString -> Maybe (SignKeyDSIGN v)
rawDeserialiseSignKeyDSIGN ByteString
bs

instance DSIGNAlgorithm v => Arbitrary (SigDSIGN v) where
  arbitrary :: Gen (SigDSIGN v)
arbitrary = do
    let n :: Int
n = forall a b. (Integral a, Num b) => a -> b
fromIntegral (forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN (forall {k} (t :: k). Proxy t
Proxy @v))
    ByteString
bs <- Int -> Gen ByteString
genByteString Int
n
    forall a. HasCallStack => Int -> Maybe a -> Gen a
errorInvalidSize Int
n forall a b. (a -> b) -> a -> b
$ forall v. DSIGNAlgorithm v => ByteString -> Maybe (SigDSIGN v)
rawDeserialiseSigDSIGN ByteString
bs

instance DSIGNAlgorithm v => Arbitrary (SignedDSIGN v a) where
  arbitrary :: Gen (SignedDSIGN v a)
arbitrary = forall v a. SigDSIGN v -> SignedDSIGN v a
SignedDSIGN forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary

instance
  (ContextVRF v ~ (), Signable v ~ SignableRepresentation, VRFAlgorithm v) =>
  Arbitrary (CertifiedVRF v a)
  where
  arbitrary :: Gen (CertifiedVRF v a)
arbitrary = forall v a. OutputVRF v -> CertVRF v -> CertifiedVRF v a
CertifiedVRF forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (CertVRF v)
genCertVRF
    where
      genCertVRF :: Gen (CertVRF v)
      genCertVRF :: Gen (CertVRF v)
genCertVRF = forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary t => Arbitrary (WithOrigin t) where
  arbitrary :: Gen (WithOrigin t)
arbitrary = forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
20, forall (f :: * -> *) a. Applicative f => a -> f a
pure forall t. WithOrigin t
Origin), (Int
80, forall t. t -> WithOrigin t
At forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary)]
  shrink :: WithOrigin t -> [WithOrigin t]
shrink = \case
    WithOrigin t
Origin -> []
    At t
x -> forall t. WithOrigin t
Origin forall a. a -> [a] -> [a]
: forall a b. (a -> b) -> [a] -> [b]
map forall t. t -> WithOrigin t
At (forall a. Arbitrary a => a -> [a]
shrink t
x)

deriving instance Arbitrary EpochSize

deriving instance Arbitrary SystemStart

deriving instance Arbitrary BlockNo

instance Arbitrary Version where
  arbitrary :: Gen Version
arbitrary = HasCallStack => Version -> Version -> Gen Version
genVersion forall a. Bounded a => a
minBound forall a. Bounded a => a
maxBound

genVersion :: HasCallStack => Version -> Version -> Gen Version
genVersion :: HasCallStack => Version -> Version -> Gen Version
genVersion Version
minVersion Version
maxVersion =
  Word64 -> Word64 -> Gen Version
genVersion64 (Version -> Word64
getVersion64 Version
minVersion) (Version -> Word64
getVersion64 Version
maxVersion)
  where
    genVersion64 :: Word64 -> Word64 -> Gen Version
genVersion64 Word64
minVersion64 Word64
maxVersion64 = do
      Word64
v64 <- forall a. Random a => (a, a) -> Gen a
choose (Word64
minVersion64, Word64
maxVersion64)
      case forall (m :: * -> *). MonadFail m => Word64 -> m Version
mkVersion64 Word64
v64 of
        Maybe Version
Nothing -> forall a. HasCallStack => String -> a
error forall a b. (a -> b) -> a -> b
$ String
"Impossible: Invalid version generated: " forall a. [a] -> [a] -> [a]
++ forall a. Show a => a -> String
show Word64
v64
        Just Version
v -> forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v

genByteString :: Int -> Gen BS.ByteString
genByteString :: Int -> Gen ByteString
genByteString Int
n = forall g (m :: * -> *). StatefulGen g m => Int -> g -> m ByteString
uniformByteStringM (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) QC
QC

genLazyByteString :: Int -> Gen BSL.ByteString
genLazyByteString :: Int -> Gen ByteString
genLazyByteString Int
n = ByteString -> ByteString
BSL.fromStrict forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Int -> Gen ByteString
genByteString Int
n

genShortByteString :: Int -> Gen SBS.ShortByteString
genShortByteString :: Int -> Gen ShortByteString
genShortByteString Int
n = forall g (m :: * -> *).
StatefulGen g m =>
Int -> g -> m ShortByteString
uniformShortByteString (forall a b. (Integral a, Num b) => a -> b
fromIntegral Int
n) QC
QC

genByteArray :: Int -> Gen Prim.ByteArray
genByteArray :: Int -> Gen ByteArray
genByteArray Int
n = do
  ShortByteString
sbs <- Int -> Gen ShortByteString
genShortByteString Int
n
  case ShortByteString
sbs of
    SBS.SBS ByteArray#
ba -> forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray# -> ByteArray
Prim.ByteArray ByteArray#
ba)