{-# 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 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] [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8
23] [Word8] -> [Word8] -> [Word8]
forall a. [a] -> [a] -> [a]
++ [Word8
32 ..]

instance Arbitrary Term where
  arbitrary :: Gen Term
arbitrary =
    [Gen Term] -> Gen Term
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Int -> Term
TInt (Int -> Term) -> Gen Int -> Gen Term
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
forall a. Bounded a => a
minBound, Int
forall a. Bounded a => a
maxBound)
      , Integer -> Term
TInteger
          (Integer -> Term) -> Gen Integer -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Gen Integer] -> Gen Integer
forall a. HasCallStack => [Gen a] -> Gen a
oneof
            [ (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
maxBound :: Int) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
+ Integer
1, Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
forall a. Bounded a => a
maxBound :: Word64))
            , (Integer, Integer) -> Gen Integer
forall a. Random a => (a, a) -> Gen a
choose (Integer -> Integer
forall a. Num a => a -> a
negate (Word64 -> Integer
forall a. Integral a => a -> Integer
toInteger (Word64
forall a. Bounded a => a
maxBound :: Word64)), Int -> Integer
forall a. Integral a => a -> Integer
toInteger (Int
forall a. Bounded a => a
minBound :: Int) Integer -> Integer -> Integer
forall a. Num a => a -> a -> a
- Integer
1)
            ]
      , ByteString -> Term
TBytes (ByteString -> Term) -> Gen ByteString -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Gen ByteString
genByteString (Int -> Gen ByteString)
-> (NonNegative Int -> Int) -> NonNegative Int -> Gen ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegative Int -> Int
forall a. NonNegative a -> a
getNonNegative (NonNegative Int -> Gen ByteString)
-> Gen (NonNegative Int) -> Gen ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary)
      , ByteString -> Term
TBytesI (ByteString -> Term) -> Gen ByteString -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Int -> Gen ByteString
genLazyByteString (Int -> Gen ByteString)
-> (NonNegative Int -> Int) -> NonNegative Int -> Gen ByteString
forall b c a. (b -> c) -> (a -> b) -> a -> c
. NonNegative Int -> Int
forall a. NonNegative a -> a
getNonNegative (NonNegative Int -> Gen ByteString)
-> Gen (NonNegative Int) -> Gen ByteString
forall (m :: * -> *) a b. Monad m => (a -> m b) -> m a -> m b
=<< Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary)
      , Text -> Term
TString (Text -> Term) -> (String -> Text) -> String -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
T.pack (String -> Term) -> Gen String -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary
      , Text -> Term
TStringI (Text -> Term) -> (String -> Text) -> String -> Term
forall b c a. (b -> c) -> (a -> b) -> a -> c
. String -> Text
TL.pack (String -> Term) -> Gen String -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen String
forall a. Arbitrary a => Gen a
arbitrary
      , [Term] -> Term
TList ([Term] -> Term) -> Gen [Term] -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Term -> Gen [Term]
forall a. Gen a -> Gen [a]
listOf Gen Term
forall a. Arbitrary a => Gen a
smallerTerm
      , [Term] -> Term
TListI ([Term] -> Term) -> Gen [Term] -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Term -> Gen [Term]
forall a. Gen a -> Gen [a]
listOf Gen Term
forall a. Arbitrary a => Gen a
smallerTerm
      , [(Term, Term)] -> Term
TMap ([(Term, Term)] -> Term) -> Gen [(Term, Term)] -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Term, Term) -> Gen [(Term, Term)]
forall a. Gen a -> Gen [a]
listOf Gen (Term, Term)
forall a. Arbitrary a => Gen a
smallerTerm
      , [(Term, Term)] -> Term
TMapI ([(Term, Term)] -> Term) -> Gen [(Term, Term)] -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Term, Term) -> Gen [(Term, Term)]
forall a. Gen a -> Gen [a]
listOf Gen (Term, Term)
forall a. Arbitrary a => Gen a
smallerTerm
      , Word64 -> Term -> Term
TTagged (Word64 -> Term -> Term) -> Gen Word64 -> Gen (Term -> Term)
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
firstUnreservedTag, Word64
forall a. Bounded a => a
maxBound :: Word64) Gen (Term -> Term) -> Gen Term -> Gen Term
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen Term
forall a. Arbitrary a => Gen a
smallerTerm
      , Bool -> Term
TBool (Bool -> Term) -> Gen Bool -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Bool
forall a. Arbitrary a => Gen a
arbitrary
      , Term -> Gen Term
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Term
TNull
      , Word8 -> Term
TSimple (Word8 -> Term) -> Gen Word8 -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> [Word8] -> Gen Word8
forall a. HasCallStack => [a] -> Gen a
elements [Word8]
simple
      , Float -> Term
THalf (Float -> Term) -> Gen Float -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Float
genHalf
      , Float -> Term
TFloat (Float -> Term) -> Gen Float -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Float
forall a. Arbitrary a => Gen a
arbitrary
      , Double -> Term
TDouble (Double -> Term) -> Gen Double -> Gen Term
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Double
forall a. Arbitrary a => Gen a
arbitrary
      ]
    where
      smallerTerm :: Arbitrary a => Gen a
      smallerTerm :: forall a. Arbitrary a => Gen a
smallerTerm = (Int -> Int) -> Gen a -> Gen a
forall a. (Int -> Int) -> Gen a -> Gen a
scale (Int -> Int -> Int
forall a. Integral a => a -> a -> a
`div` Int
5) Gen a
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' <- Int -> [Int]
forall a. Arbitrary a => a -> [a]
shrink Int
n]
  shrink (TInteger Integer
n) = [Integer -> Term
TInteger Integer
n' | Integer
n' <- Integer -> [Integer]
forall a. Arbitrary a => a -> [a]
shrink Integer
n]
  shrink (TBytes ByteString
ws) = [ByteString -> Term
TBytes ([Word8] -> ByteString
BS.pack [Word8]
ws') | [Word8]
ws' <- [Word8] -> [[Word8]]
forall a. Arbitrary a => a -> [a]
shrink (ByteString -> [Word8]
BS.unpack ByteString
ws)]
  shrink (TBytesI ByteString
wss) =
    [ ByteString -> Term
TBytesI ([ByteString] -> ByteString
BSL.fromChunks (([Word8] -> ByteString) -> [[Word8]] -> [ByteString]
forall a b. (a -> b) -> [a] -> [b]
map [Word8] -> ByteString
BS.pack [[Word8]]
wss'))
    | [[Word8]]
wss' <- [[Word8]] -> [[[Word8]]]
forall a. Arbitrary a => a -> [a]
shrink ((ByteString -> [Word8]) -> [ByteString] -> [[Word8]]
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' <- String -> [String]
forall a. Arbitrary a => a -> [a]
shrink (Text -> String
T.unpack Text
cs)]
  shrink (TStringI Text
css) =
    [ Text -> Term
TStringI ([Text] -> Text
TL.fromChunks ((String -> Text) -> [String] -> [Text]
forall a b. (a -> b) -> [a] -> [b]
map String -> Text
T.pack [String]
css'))
    | [String]
css' <- [String] -> [[String]]
forall a. Arbitrary a => a -> [a]
shrink ((Text -> String) -> [Text] -> [String]
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 Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: [[Term] -> Term
TList [Term]
xs' | [Term]
xs' <- [Term] -> [[Term]]
forall a. Arbitrary a => a -> [a]
shrink [Term]
xs]
  shrink (TList [Term]
xs) = [[Term] -> Term
TList [Term]
xs' | [Term]
xs' <- [Term] -> [[Term]]
forall a. Arbitrary a => a -> [a]
shrink [Term]
xs]
  shrink (TListI xs :: [Term]
xs@[Term
x]) = Term
x Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: [[Term] -> Term
TListI [Term]
xs' | [Term]
xs' <- [Term] -> [[Term]]
forall a. Arbitrary a => a -> [a]
shrink [Term]
xs]
  shrink (TListI [Term]
xs) = [[Term] -> Term
TListI [Term]
xs' | [Term]
xs' <- [Term] -> [[Term]]
forall a. Arbitrary a => a -> [a]
shrink [Term]
xs]
  shrink (TMap xys :: [(Term, Term)]
xys@[(Term
x, Term
y)]) = Term
x Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: Term
y Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: [[(Term, Term)] -> Term
TMap [(Term, Term)]
xys' | [(Term, Term)]
xys' <- [(Term, Term)] -> [[(Term, Term)]]
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' <- [(Term, Term)] -> [[(Term, Term)]]
forall a. Arbitrary a => a -> [a]
shrink [(Term, Term)]
xys]
  shrink (TMapI xys :: [(Term, Term)]
xys@[(Term
x, Term
y)]) = Term
x Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: Term
y Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: [[(Term, Term)] -> Term
TMapI [(Term, Term)]
xys' | [(Term, Term)]
xys' <- [(Term, Term)] -> [[(Term, Term)]]
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' <- [(Term, Term)] -> [[(Term, Term)]]
forall a. Arbitrary a => a -> [a]
shrink [(Term, Term)]
xys]
  shrink (TTagged Word64
w Term
t) =
    Term
t Term -> [Term] -> [Term]
forall a. a -> [a] -> [a]
: [Word64 -> Term -> Term
TTagged Word64
w' Term
t' | (Word64
w', Term
t') <- (Word64, Term) -> [(Word64, Term)]
forall a. Arbitrary a => a -> [a]
shrink (Word64
w, Term
t), Word64 -> Word64
forall a b. (Integral a, Num b) => a -> b
fromIntegral Word64
w' Word64 -> Word64 -> Bool
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' <- Word8 -> [Word8]
forall a. Arbitrary a => a -> [a]
shrink Word8
w, Word8
w Word8 -> [Word8] -> Bool
forall a. Eq a => a -> [a] -> Bool
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' <- Float -> [Float]
forall a. Arbitrary a => a -> [a]
shrink Float
f]
  shrink (TDouble Double
f) = [Double -> Term
TDouble Double
f' | Double
f' <- Double -> [Double]
forall a. Arbitrary a => a -> [a]
shrink Double
f]

genHalf :: Gen Float
genHalf :: Gen Float
genHalf = do
  Half
half <- CUShort -> Half
Half (CUShort -> Half) -> Gen CUShort -> Gen Half
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen CUShort
forall a. Arbitrary a => Gen a
arbitrary
  if Half -> Bool
forall a. RealFloat a => a -> Bool
isInfinite Half
half Bool -> Bool -> Bool
|| Half -> Bool
forall a. RealFloat a => a -> Bool
isDenormalized Half
half Bool -> Bool -> Bool
|| Half -> Bool
forall a. RealFloat a => a -> Bool
isNaN Half
half
    then Gen Float
genHalf
    else Float -> Gen Float
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (Float -> Gen Float) -> Float -> Gen Float
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 <- Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary
    Positive Int
count <- Gen (Positive Int)
forall a. Arbitrary a => Gen a
arbitrary
    NonNegative Int
slack <- Gen (NonNegative Int)
forall a. Arbitrary a => Gen a
arbitrary
    let len :: Int
len = Int
off Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
count Int -> Int -> Int
forall a. Num a => a -> a -> a
+ Int
slack
    ByteArray
ba <- Int -> Gen ByteArray
genByteArray Int
len
    SlicedByteArray -> Gen SlicedByteArray
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (SlicedByteArray -> Gen SlicedByteArray)
-> SlicedByteArray -> Gen SlicedByteArray
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 (Word32 -> IPv4) -> Gen Word32 -> Gen IPv4
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Word32
forall a. Arbitrary a => Gen a
arbitrary

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

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

instance Arbitrary e => Arbitrary (StrictMaybe e) where
  arbitrary :: Gen (StrictMaybe e)
arbitrary = Maybe e -> StrictMaybe e
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe (Maybe e -> StrictMaybe e) -> Gen (Maybe e) -> Gen (StrictMaybe e)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe e)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: StrictMaybe e -> [StrictMaybe e]
shrink = (Maybe e -> StrictMaybe e) -> [Maybe e] -> [StrictMaybe e]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap Maybe e -> StrictMaybe e
forall a. Maybe a -> StrictMaybe a
maybeToStrictMaybe ([Maybe e] -> [StrictMaybe e])
-> (StrictMaybe e -> [Maybe e]) -> StrictMaybe e -> [StrictMaybe e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Maybe e -> [Maybe e]
forall a. Arbitrary a => a -> [a]
shrink (Maybe e -> [Maybe e])
-> (StrictMaybe e -> Maybe e) -> StrictMaybe e -> [Maybe e]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. StrictMaybe e -> Maybe e
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 = Map k v -> VMap kv vv k v
forall (kv :: * -> *) k (vv :: * -> *) v.
(Vector kv k, Vector vv v) =>
Map k v -> VMap kv vv k v
VMap.fromMap (Map k v -> VMap kv vv k v)
-> Gen (Map k v) -> Gen (VMap kv vv k v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map k v)
forall a. Arbitrary a => Gen a
arbitrary
  shrink :: VMap kv vv k v -> [VMap kv vv k v]
shrink = ([(k, v)] -> VMap kv vv k v) -> [[(k, v)]] -> [VMap kv vv k v]
forall a b. (a -> b) -> [a] -> [b]
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
fmap [(k, v)] -> VMap kv vv k v
forall k (kv :: * -> *) (vv :: * -> *) v.
(Ord k, Vector kv k, Vector vv v) =>
[(k, v)] -> VMap kv vv k v
VMap.fromList ([[(k, v)]] -> [VMap kv vv k v])
-> (VMap kv vv k v -> [[(k, v)]])
-> VMap kv vv k v
-> [VMap kv vv k v]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. [(k, v)] -> [[(k, v)]]
forall a. Arbitrary a => a -> [a]
shrink ([(k, v)] -> [[(k, v)]])
-> (VMap kv vv k v -> [(k, v)]) -> VMap kv vv k v -> [[(k, v)]]
forall b c a. (b -> c) -> (a -> b) -> a -> c
. VMap kv vv k v -> [(k, v)]
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 = SignKeyDSIGN v -> VerKeyDSIGN v
forall v. DSIGNAlgorithm v => SignKeyDSIGN v -> VerKeyDSIGN v
deriveVerKeyDSIGN (SignKeyDSIGN v -> VerKeyDSIGN v)
-> Gen (SignKeyDSIGN v) -> Gen (VerKeyDSIGN v)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SignKeyDSIGN v)
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 = Gen a -> (a -> Gen a) -> Maybe a -> Gen a
forall b a. b -> (a -> b) -> Maybe a -> b
maybe (String -> Gen a
forall a. HasCallStack => String -> a
error (String -> Gen a) -> String -> Gen a
forall a b. (a -> b) -> a -> b
$ String
"Impossible: Invalid size " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Int -> String
forall a. Show a => a -> String
show Int
n) a -> Gen a
forall a. a -> Gen a
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 = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSignKeyDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v))
    ByteString
bs <- Int -> Gen ByteString
genByteString Int
n
    Int -> Maybe (SignKeyDSIGN v) -> Gen (SignKeyDSIGN v)
forall a. HasCallStack => Int -> Maybe a -> Gen a
errorInvalidSize Int
n (Maybe (SignKeyDSIGN v) -> Gen (SignKeyDSIGN v))
-> Maybe (SignKeyDSIGN v) -> Gen (SignKeyDSIGN v)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (SignKeyDSIGN v)
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 = Word -> Int
forall a b. (Integral a, Num b) => a -> b
fromIntegral (Proxy v -> Word
forall v (proxy :: * -> *). DSIGNAlgorithm v => proxy v -> Word
sizeSigDSIGN (forall t. Proxy t
forall {k} (t :: k). Proxy t
Proxy @v))
    ByteString
bs <- Int -> Gen ByteString
genByteString Int
n
    Int -> Maybe (SigDSIGN v) -> Gen (SigDSIGN v)
forall a. HasCallStack => Int -> Maybe a -> Gen a
errorInvalidSize Int
n (Maybe (SigDSIGN v) -> Gen (SigDSIGN v))
-> Maybe (SigDSIGN v) -> Gen (SigDSIGN v)
forall a b. (a -> b) -> a -> b
$ ByteString -> Maybe (SigDSIGN v)
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 = SigDSIGN v -> SignedDSIGN v a
forall v a. SigDSIGN v -> SignedDSIGN v a
SignedDSIGN (SigDSIGN v -> SignedDSIGN v a)
-> Gen (SigDSIGN v) -> Gen (SignedDSIGN v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SigDSIGN v)
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 = OutputVRF v -> CertVRF v -> CertifiedVRF v a
forall v a. OutputVRF v -> CertVRF v -> CertifiedVRF v a
CertifiedVRF (OutputVRF v -> CertVRF v -> CertifiedVRF v a)
-> Gen (OutputVRF v) -> Gen (CertVRF v -> CertifiedVRF v a)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (OutputVRF v)
forall a. Arbitrary a => Gen a
arbitrary Gen (CertVRF v -> CertifiedVRF v a)
-> Gen (CertVRF v) -> Gen (CertifiedVRF v a)
forall a b. Gen (a -> b) -> Gen a -> Gen b
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 = Gen (CertVRF v)
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary t => Arbitrary (WithOrigin t) where
  arbitrary :: Gen (WithOrigin t)
arbitrary = [(Int, Gen (WithOrigin t))] -> Gen (WithOrigin t)
forall a. HasCallStack => [(Int, Gen a)] -> Gen a
frequency [(Int
20, WithOrigin t -> Gen (WithOrigin t)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure WithOrigin t
forall t. WithOrigin t
Origin), (Int
80, t -> WithOrigin t
forall t. t -> WithOrigin t
At (t -> WithOrigin t) -> Gen t -> Gen (WithOrigin t)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen t
forall a. Arbitrary a => Gen a
arbitrary)]
  shrink :: WithOrigin t -> [WithOrigin t]
shrink = \case
    WithOrigin t
Origin -> []
    At t
x -> WithOrigin t
forall t. WithOrigin t
Origin WithOrigin t -> [WithOrigin t] -> [WithOrigin t]
forall a. a -> [a] -> [a]
: (t -> WithOrigin t) -> [t] -> [WithOrigin t]
forall a b. (a -> b) -> [a] -> [b]
map t -> WithOrigin t
forall t. t -> WithOrigin t
At (t -> [t]
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
Version -> Version -> Gen Version
genVersion Version
forall a. Bounded a => a
minBound Version
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 <- (Word64, Word64) -> Gen Word64
forall a. Random a => (a, a) -> Gen a
choose (Word64
minVersion64, Word64
maxVersion64)
      case Word64 -> Maybe Version
forall (m :: * -> *). MonadFail m => Word64 -> m Version
mkVersion64 Word64
v64 of
        Maybe Version
Nothing -> String -> Gen Version
forall a. HasCallStack => String -> a
error (String -> Gen Version) -> String -> Gen Version
forall a b. (a -> b) -> a -> b
$ String
"Impossible: Invalid version generated: " String -> String -> String
forall a. [a] -> [a] -> [a]
++ Word64 -> String
forall a. Show a => a -> String
show Word64
v64
        Just Version
v -> Version -> Gen Version
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Version
v

genByteString :: Int -> Gen BS.ByteString
genByteString :: Int -> Gen ByteString
genByteString Int
n = Int -> QC -> Gen ByteString
forall g (m :: * -> *). StatefulGen g m => Int -> g -> m ByteString
uniformByteStringM (Int -> Int
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 (ByteString -> ByteString) -> Gen ByteString -> Gen ByteString
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 = Int -> QC -> Gen ShortByteString
forall g (m :: * -> *).
StatefulGen g m =>
Int -> g -> m ShortByteString
uniformShortByteString (Int -> Int
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 -> ByteArray -> Gen ByteArray
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure (ByteArray# -> ByteArray
Prim.ByteArray ByteArray#
ba)