{-# LANGUAGE FlexibleContexts #-}
{-# LANGUAGE FlexibleInstances #-}
{-# LANGUAGE OverloadedStrings #-}
{-# LANGUAGE RecordWildCards #-}
{-# LANGUAGE ScopedTypeVariables #-}
{-# LANGUAGE TypeApplications #-}
{-# LANGUAGE UndecidableInstances #-}
{-# OPTIONS_GHC -Wno-orphans #-}

module Test.Consensus.Ledger.Mock.Generators () where

import Cardano.Crypto.DSIGN
import Cardano.Crypto.Hash
import Codec.Serialise (Serialise, encode, serialise)
import qualified Data.ByteString.Lazy as Lazy
import qualified Data.Map.Strict as Map
import qualified Data.Set as Set
import Data.Typeable
import Ouroboros.Consensus.Block
import Ouroboros.Consensus.HeaderValidation
import Ouroboros.Consensus.Ledger.Basics
import Ouroboros.Consensus.Ledger.Query
import Ouroboros.Consensus.Ledger.SupportsMempool
import Ouroboros.Consensus.Ledger.Tables.Utils
import Ouroboros.Consensus.Mock.Ledger.Block
import Ouroboros.Consensus.Mock.Ledger.Block.BFT
import qualified Ouroboros.Consensus.Mock.Ledger.State as L
import qualified Ouroboros.Consensus.Mock.Ledger.UTxO as L
import Ouroboros.Consensus.Mock.Node.Serialisation ()
import Ouroboros.Consensus.Protocol.BFT
import Test.Crypto.Hash ()
import Test.QuickCheck
import Test.Util.Orphans.Arbitrary ()
import Test.Util.Serialisation.Roundtrip
import Test.Util.Serialisation.SomeResult (SomeResult (..))

{-------------------------------------------------------------------------------
  General instances
-------------------------------------------------------------------------------}

instance Arbitrary (HeaderHash blk) => Arbitrary (ChainHash blk) where
  arbitrary :: Gen (ChainHash blk)
arbitrary =
    [Gen (ChainHash blk)] -> Gen (ChainHash blk)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ ChainHash blk -> Gen (ChainHash blk)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return ChainHash blk
forall {k} (b :: k). ChainHash b
GenesisHash
      , HeaderHash blk -> ChainHash blk
forall {k} (b :: k). HeaderHash b -> ChainHash b
BlockHash (HeaderHash blk -> ChainHash blk)
-> Gen (HeaderHash blk) -> Gen (ChainHash blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (HeaderHash blk)
forall a. Arbitrary a => Gen a
arbitrary
      ]

instance Arbitrary (HeaderHash blk) => Arbitrary (Point blk) where
  arbitrary :: Gen (Point blk)
arbitrary =
    [Gen (Point blk)] -> Gen (Point blk)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ Point blk -> Gen (Point blk)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return Point blk
forall {k} (block :: k). Point block
GenesisPoint
      , SlotNo -> HeaderHash blk -> Point blk
forall {k} (block :: k). SlotNo -> HeaderHash block -> Point block
BlockPoint (SlotNo -> HeaderHash blk -> Point blk)
-> Gen SlotNo -> Gen (HeaderHash blk -> Point blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary Gen (HeaderHash blk -> Point blk)
-> Gen (HeaderHash blk) -> Gen (Point 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 (HeaderHash blk)
forall a. Arbitrary a => Gen a
arbitrary
      ]

{-------------------------------------------------------------------------------
  Generators
-------------------------------------------------------------------------------}

-- | This blindly creates random values, so the block will not be valid, but
-- this does not matter for serialisation tests.
instance
  (SimpleCrypto c, Arbitrary ext, Serialise ext) =>
  Arbitrary (SimpleBlock c ext)
  where
  arbitrary :: Gen (SimpleBlock c ext)
arbitrary = do
    simpleStdHeader <- Gen (SimpleStdHeader c ext)
forall a. Arbitrary a => Gen a
arbitrary
    body <- arbitrary
    ext <- arbitrary
    let hdr = (ext -> Encoding)
-> SimpleStdHeader c ext -> ext -> Header (SimpleBlock c ext)
forall c ext' ext.
SimpleCrypto c =>
(ext' -> Encoding)
-> SimpleStdHeader c ext
-> ext'
-> Header (SimpleBlock' c ext ext')
mkSimpleHeader ext -> Encoding
forall a. Serialise a => a -> Encoding
encode SimpleStdHeader c ext
simpleStdHeader ext
ext
    return $ SimpleBlock hdr body

-- | This blindly creates random values, so the block will not be valid, but
-- this does not matter for serialisation tests. Except we do touch-up the
-- 'simpleBodySize'; hence 'Coherent'.
instance
  (SimpleCrypto c, Arbitrary ext, Serialise ext) =>
  Arbitrary (Coherent (SimpleBlock c ext))
  where
  arbitrary :: Gen (Coherent (SimpleBlock c ext))
arbitrary = do
    simpleStdHeader <- Gen (SimpleStdHeader c ext)
forall a. Arbitrary a => Gen a
arbitrary
    body <- arbitrary
    ext <- arbitrary
    let simpleStdHeader' =
          SimpleStdHeader c ext
simpleStdHeader
            { -- Fill in the right body size, because we rely on this in the
              -- serialisation tests
              simpleBodySize = fromIntegral $ Lazy.length $ serialise body
            }
        hdr = (ext -> Encoding)
-> SimpleStdHeader c ext -> ext -> Header (SimpleBlock c ext)
forall c ext' ext.
SimpleCrypto c =>
(ext' -> Encoding)
-> SimpleStdHeader c ext
-> ext'
-> Header (SimpleBlock' c ext ext')
mkSimpleHeader ext -> Encoding
forall a. Serialise a => a -> Encoding
encode SimpleStdHeader c ext
simpleStdHeader' ext
ext
    return $ Coherent $ SimpleBlock hdr body

instance
  (SimpleCrypto c, Arbitrary ext, Serialise ext, Typeable ext) =>
  Arbitrary (Header (SimpleBlock c ext))
  where
  arbitrary :: Gen (Header (SimpleBlock c ext))
arbitrary = SimpleBlock c ext -> Header (SimpleBlock c ext)
forall blk. GetHeader blk => blk -> Header blk
getHeader (SimpleBlock c ext -> Header (SimpleBlock c ext))
-> Gen (SimpleBlock c ext) -> Gen (Header (SimpleBlock c ext))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (SimpleBlock c ext)
forall a. Arbitrary a => Gen a
arbitrary

instance
  (HashAlgorithm (SimpleHash c), Arbitrary ext, Serialise ext) =>
  Arbitrary (SimpleStdHeader c ext)
  where
  arbitrary :: Gen (SimpleStdHeader c ext)
arbitrary =
    ChainHash (SimpleBlock c ext)
-> SlotNo
-> BlockNo
-> Hash (SimpleHash c) SimpleBody
-> SizeInBytes
-> SimpleStdHeader c ext
forall c ext.
ChainHash (SimpleBlock c ext)
-> SlotNo
-> BlockNo
-> Hash (SimpleHash c) SimpleBody
-> SizeInBytes
-> SimpleStdHeader c ext
SimpleStdHeader
      (ChainHash (SimpleBlock c ext)
 -> SlotNo
 -> BlockNo
 -> Hash (SimpleHash c) SimpleBody
 -> SizeInBytes
 -> SimpleStdHeader c ext)
-> Gen (ChainHash (SimpleBlock c ext))
-> Gen
     (SlotNo
      -> BlockNo
      -> Hash (SimpleHash c) SimpleBody
      -> SizeInBytes
      -> SimpleStdHeader c ext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ChainHash (SimpleBlock c ext))
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (SlotNo
   -> BlockNo
   -> Hash (SimpleHash c) SimpleBody
   -> SizeInBytes
   -> SimpleStdHeader c ext)
-> Gen SlotNo
-> Gen
     (BlockNo
      -> Hash (SimpleHash c) SimpleBody
      -> SizeInBytes
      -> SimpleStdHeader c ext)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (BlockNo
   -> Hash (SimpleHash c) SimpleBody
   -> SizeInBytes
   -> SimpleStdHeader c ext)
-> Gen BlockNo
-> Gen
     (Hash (SimpleHash c) SimpleBody
      -> SizeInBytes -> SimpleStdHeader c ext)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen BlockNo
forall a. Arbitrary a => Gen a
arbitrary
      Gen
  (Hash (SimpleHash c) SimpleBody
   -> SizeInBytes -> SimpleStdHeader c ext)
-> Gen (Hash (SimpleHash c) SimpleBody)
-> Gen (SizeInBytes -> SimpleStdHeader c ext)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen (Hash (SimpleHash c) SimpleBody)
forall a. Arbitrary a => Gen a
arbitrary
      Gen (SizeInBytes -> SimpleStdHeader c ext)
-> Gen SizeInBytes -> Gen (SimpleStdHeader c ext)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen SizeInBytes
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary SimpleBody where
  arbitrary :: Gen SimpleBody
arbitrary = [Tx] -> SimpleBody
SimpleBody ([Tx] -> SimpleBody) -> Gen [Tx] -> Gen SimpleBody
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen Tx -> Gen [Tx]
forall a. Gen a -> Gen [a]
listOf Gen Tx
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (SomeSecond (NestedCtxt Header) (SimpleBlock c ext)) where
  arbitrary :: Gen (SomeSecond (NestedCtxt Header) (SimpleBlock c ext))
arbitrary = SomeSecond (NestedCtxt Header) (SimpleBlock c ext)
-> Gen (SomeSecond (NestedCtxt Header) (SimpleBlock c ext))
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeSecond (NestedCtxt Header) (SimpleBlock c ext)
 -> Gen (SomeSecond (NestedCtxt Header) (SimpleBlock c ext)))
-> SomeSecond (NestedCtxt Header) (SimpleBlock c ext)
-> Gen (SomeSecond (NestedCtxt Header) (SimpleBlock c ext))
forall a b. (a -> b) -> a -> b
$ NestedCtxt Header (SimpleBlock c ext) (Header (SimpleBlock c ext))
-> SomeSecond (NestedCtxt Header) (SimpleBlock c ext)
forall {k1} {k2} (f :: k1 -> k2 -> *) (a :: k1) (b :: k2).
f a b -> SomeSecond f a
SomeSecond NestedCtxt
  Header
  (SimpleBlock c ext)
  (TrivialIndex (NestedCtxt Header (SimpleBlock c ext)))
NestedCtxt Header (SimpleBlock c ext) (Header (SimpleBlock c ext))
forall k (f :: k -> *). TrivialDependency f => f (TrivialIndex f)
indexIsTrivial

instance Arbitrary (SomeBlockQuery (BlockQuery (SimpleBlock c ext))) where
  arbitrary :: Gen (SomeBlockQuery (BlockQuery (SimpleBlock c ext)))
arbitrary = SomeBlockQuery (BlockQuery (SimpleBlock c ext))
-> Gen (SomeBlockQuery (BlockQuery (SimpleBlock c ext)))
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (SomeBlockQuery (BlockQuery (SimpleBlock c ext))
 -> Gen (SomeBlockQuery (BlockQuery (SimpleBlock c ext))))
-> SomeBlockQuery (BlockQuery (SimpleBlock c ext))
-> Gen (SomeBlockQuery (BlockQuery (SimpleBlock c ext)))
forall a b. (a -> b) -> a -> b
$ BlockQuery
  (SimpleBlock c ext) 'QFNoTables (Point (SimpleBlock c ext))
-> SomeBlockQuery (BlockQuery (SimpleBlock c ext))
forall (q :: QueryFootprint -> * -> *)
       (footprint :: QueryFootprint) result.
SingI footprint =>
q footprint result -> SomeBlockQuery q
SomeBlockQuery BlockQuery
  (SimpleBlock c ext) 'QFNoTables (Point (SimpleBlock c ext))
forall c ext.
BlockQuery
  (SimpleBlock c ext) 'QFNoTables (Point (SimpleBlock c ext))
QueryLedgerTip

instance (SimpleCrypto c, Typeable ext) => Arbitrary (SomeResult (SimpleBlock c ext)) where
  arbitrary :: Gen (SomeResult (SimpleBlock c ext))
arbitrary = BlockQuery
  (SimpleBlock c ext) 'QFNoTables (Point (SimpleBlock c ext))
-> Point (SimpleBlock c ext) -> SomeResult (SimpleBlock c ext)
forall result blk (fp :: QueryFootprint).
(Eq result, Show result, Typeable result) =>
BlockQuery blk fp result -> result -> SomeResult blk
SomeResult BlockQuery
  (SimpleBlock c ext) 'QFNoTables (Point (SimpleBlock c ext))
forall c ext.
BlockQuery
  (SimpleBlock c ext) 'QFNoTables (Point (SimpleBlock c ext))
QueryLedgerTip (Point (SimpleBlock c ext) -> SomeResult (SimpleBlock c ext))
-> Gen (Point (SimpleBlock c ext))
-> Gen (SomeResult (SimpleBlock c ext))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Point (SimpleBlock c ext))
forall a. Arbitrary a => Gen a
arbitrary

instance
  (SimpleCrypto c, Typeable ext) =>
  Arbitrary (LedgerState (SimpleBlock c ext) EmptyMK)
  where
  arbitrary :: Gen (LedgerState (SimpleBlock c ext) EmptyMK)
arbitrary =
    LedgerState (SimpleBlock c ext) ValuesMK
-> LedgerState (SimpleBlock c ext) EmptyMK
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
HasLedgerTables l =>
l mk -> l EmptyMK
forgetLedgerTables
      (LedgerState (SimpleBlock c ext) ValuesMK
 -> LedgerState (SimpleBlock c ext) EmptyMK)
-> Gen (LedgerState (SimpleBlock c ext) ValuesMK)
-> Gen (LedgerState (SimpleBlock c ext) EmptyMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> forall a. Arbitrary a => Gen a
arbitrary @(LedgerState (SimpleBlock c ext) ValuesMK)

instance
  (SimpleCrypto c, Typeable ext) =>
  Arbitrary (LedgerState (SimpleBlock c ext) ValuesMK)
  where
  arbitrary :: Gen (LedgerState (SimpleBlock c ext) ValuesMK)
arbitrary =
    LedgerState (SimpleBlock c ext) EmptyMK
-> LedgerState (SimpleBlock c ext) ValuesMK
forall (l :: LedgerStateKind).
CanStowLedgerTables l =>
l EmptyMK -> l ValuesMK
unstowLedgerTables
      (LedgerState (SimpleBlock c ext) EmptyMK
 -> LedgerState (SimpleBlock c ext) ValuesMK)
-> (MockState (SimpleBlock c ext)
    -> LedgerState (SimpleBlock c ext) EmptyMK)
-> MockState (SimpleBlock c ext)
-> LedgerState (SimpleBlock c ext) ValuesMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. (MockState (SimpleBlock c ext)
 -> LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
 -> LedgerState (SimpleBlock c ext) EmptyMK)
-> LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
-> MockState (SimpleBlock c ext)
-> LedgerState (SimpleBlock c ext) EmptyMK
forall a b c. (a -> b -> c) -> b -> a -> c
flip MockState (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
-> LedgerState (SimpleBlock c ext) EmptyMK
forall c ext (mk :: * -> * -> *).
MockState (SimpleBlock c ext)
-> LedgerTables (LedgerState (SimpleBlock c ext)) mk
-> LedgerState (SimpleBlock c ext) mk
SimpleLedgerState LedgerTables (LedgerState (SimpleBlock c ext)) EmptyMK
forall (mk :: * -> * -> *) (l :: LedgerStateKind).
(ZeroableMK mk, LedgerTableConstraints l) =>
LedgerTables l mk
emptyLedgerTables
      (MockState (SimpleBlock c ext)
 -> LedgerState (SimpleBlock c ext) ValuesMK)
-> Gen (MockState (SimpleBlock c ext))
-> Gen (LedgerState (SimpleBlock c ext) ValuesMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (MockState (SimpleBlock c ext))
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary (LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK) where
  arbitrary :: Gen (LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK)
arbitrary = ValuesMK TxIn TxOut
-> LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK
ValuesMK
  (TxIn (LedgerState (SimpleBlock c ext)))
  (TxOut (LedgerState (SimpleBlock c ext)))
-> LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK
forall (l :: LedgerStateKind) (mk :: * -> * -> *).
mk (TxIn l) (TxOut l) -> LedgerTables l mk
LedgerTables (ValuesMK TxIn TxOut
 -> LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK)
-> (Map TxIn TxOut -> ValuesMK TxIn TxOut)
-> Map TxIn TxOut
-> LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK
forall b c a. (b -> c) -> (a -> b) -> a -> c
. Map TxIn TxOut -> ValuesMK TxIn TxOut
forall k v. Map k v -> ValuesMK k v
ValuesMK (Map TxIn TxOut
 -> LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK)
-> Gen (Map TxIn TxOut)
-> Gen (LedgerTables (LedgerState (SimpleBlock c ext)) ValuesMK)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Map TxIn TxOut)
forall a. Arbitrary a => Gen a
arbitrary

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

instance Arbitrary L.MockConfig where
  arbitrary :: Gen MockConfig
arbitrary = Maybe ByteSize32 -> MockConfig
L.MockConfig (Maybe ByteSize32 -> MockConfig)
-> Gen (Maybe ByteSize32) -> Gen MockConfig
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Maybe ByteSize32)
forall a. Arbitrary a => Gen a
arbitrary

instance
  Arbitrary (MockLedgerConfig c ext) =>
  Arbitrary (SimpleLedgerConfig c ext)
  where
  arbitrary :: Gen (SimpleLedgerConfig c ext)
arbitrary = MockLedgerConfig c ext
-> EraParams -> MockConfig -> SimpleLedgerConfig c ext
forall c ext.
MockLedgerConfig c ext
-> EraParams -> MockConfig -> SimpleLedgerConfig c ext
SimpleLedgerConfig (MockLedgerConfig c ext
 -> EraParams -> MockConfig -> SimpleLedgerConfig c ext)
-> Gen (MockLedgerConfig c ext)
-> Gen (EraParams -> MockConfig -> SimpleLedgerConfig c ext)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (MockLedgerConfig c ext)
forall a. Arbitrary a => Gen a
arbitrary Gen (EraParams -> MockConfig -> SimpleLedgerConfig c ext)
-> Gen EraParams -> Gen (MockConfig -> SimpleLedgerConfig c ext)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen EraParams
forall a. Arbitrary a => Gen a
arbitrary Gen (MockConfig -> SimpleLedgerConfig c ext)
-> Gen MockConfig -> Gen (SimpleLedgerConfig c ext)
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen MockConfig
forall a. Arbitrary a => Gen a
arbitrary

instance HashAlgorithm (SimpleHash c) => Arbitrary (AnnTip (SimpleBlock c ext)) where
  arbitrary :: Gen (AnnTip (SimpleBlock c ext))
arbitrary = do
    annTipSlotNo <- 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
    annTipBlockNo <- BlockNo <$> arbitrary
    annTipInfo <- arbitrary
    return AnnTip{..}

instance Arbitrary (GenTx (SimpleBlock c ext)) where
  arbitrary :: Gen (GenTx (SimpleBlock c ext))
arbitrary = do
    simpleGenTx <- Gen Tx
forall a. Arbitrary a => Gen a
arbitrary
    simpleGenTxId <- arbitrary
    return SimpleGenTx{..}

instance Arbitrary (TxId (GenTx (SimpleBlock c ext))) where
  arbitrary :: Gen (TxId (GenTx (SimpleBlock c ext)))
arbitrary = Hash SHA256 Tx -> TxId (GenTx (SimpleBlock c ext))
forall c ext. Hash SHA256 Tx -> TxId (GenTx (SimpleBlock c ext))
SimpleGenTxId (Hash SHA256 Tx -> TxId (GenTx (SimpleBlock c ext)))
-> Gen (Hash SHA256 Tx) -> Gen (TxId (GenTx (SimpleBlock c ext)))
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash SHA256 Tx)
forall a. Arbitrary a => Gen a
arbitrary

{-------------------------------------------------------------------------------
  Ledger

  TODO: This is /very/ minimal right now.
-------------------------------------------------------------------------------}

instance Arbitrary L.Tx where
  arbitrary :: Gen Tx
arbitrary =
    Expiry -> Set TxIn -> [TxOut] -> Tx
L.Tx Expiry
L.DoNotExpire
      (Set TxIn -> [TxOut] -> Tx)
-> Gen (Set TxIn) -> Gen ([TxOut] -> Tx)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Set TxIn -> Gen (Set TxIn)
forall a. a -> Gen a
forall (f :: * -> *) a. Applicative f => a -> f a
pure Set TxIn
forall a. Monoid a => a
mempty -- For simplicity
      Gen ([TxOut] -> Tx) -> Gen [TxOut] -> Gen Tx
forall a b. Gen (a -> b) -> Gen a -> Gen b
forall (f :: * -> *) a b. Applicative f => f (a -> b) -> f a -> f b
<*> Gen [TxOut]
forall a. Arbitrary a => Gen a
arbitrary

instance Arbitrary L.Addr where
  arbitrary :: Gen Addr
arbitrary = [Addr] -> Gen Addr
forall a. HasCallStack => [a] -> Gen a
elements [Addr
"a", Addr
"b", Addr
"c"]

instance Arbitrary (L.MockState blk) where
  arbitrary :: Gen (MockState blk)
arbitrary =
    MockState blk -> Gen (MockState blk)
forall a. a -> Gen a
forall (m :: * -> *) a. Monad m => a -> m a
return (MockState blk -> Gen (MockState blk))
-> MockState blk -> Gen (MockState blk)
forall a b. (a -> b) -> a -> b
$
      L.MockState
        { mockUtxo :: Map TxIn TxOut
mockUtxo = Map TxIn TxOut
forall k a. Map k a
Map.empty
        , mockConfirmed :: Set (Hash SHA256 Tx)
mockConfirmed = Set (Hash SHA256 Tx)
forall a. Set a
Set.empty
        , mockTip :: Point blk
mockTip = Point blk
forall {k} (block :: k). Point block
GenesisPoint
        }

instance Arbitrary (HeaderHash blk) => Arbitrary (L.MockError blk) where
  arbitrary :: Gen (MockError blk)
arbitrary =
    [Gen (MockError blk)] -> Gen (MockError blk)
forall a. HasCallStack => [Gen a] -> Gen a
oneof
      [ SlotNo -> SlotNo -> MockError blk
forall blk. SlotNo -> SlotNo -> MockError blk
L.MockExpired (SlotNo -> SlotNo -> MockError blk)
-> Gen SlotNo -> Gen (SlotNo -> MockError blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen SlotNo
forall a. Arbitrary a => Gen a
arbitrary Gen (SlotNo -> MockError blk) -> Gen SlotNo -> Gen (MockError 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 SlotNo
forall a. Arbitrary a => Gen a
arbitrary
      , -- , MockUtxOError <$> arbitrary -- TODO
        ChainHash blk -> ChainHash blk -> MockError blk
forall blk. ChainHash blk -> ChainHash blk -> MockError blk
L.MockInvalidHash (ChainHash blk -> ChainHash blk -> MockError blk)
-> Gen (ChainHash blk) -> Gen (ChainHash blk -> MockError blk)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (ChainHash blk)
forall a. Arbitrary a => Gen a
arbitrary Gen (ChainHash blk -> MockError blk)
-> Gen (ChainHash blk) -> Gen (MockError 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 (ChainHash blk)
forall a. Arbitrary a => Gen a
arbitrary
      ]

{-------------------------------------------------------------------------------
  Per protocol
-------------------------------------------------------------------------------}

instance Arbitrary (SimpleBftExt c BftMockCrypto) where
  arbitrary :: Gen (SimpleBftExt c BftMockCrypto)
arbitrary = do
    simpleBftExt <- Gen (BftFields BftMockCrypto (SignedSimpleBft c BftMockCrypto))
forall a. Arbitrary a => Gen a
arbitrary
    return SimpleBftExt{..}

instance Arbitrary (BftFields BftMockCrypto toSign) where
  arbitrary :: Gen (BftFields BftMockCrypto toSign)
arbitrary = do
    bftSignature <-
      SigDSIGN MockDSIGN -> SignedDSIGN MockDSIGN toSign
forall v a. SigDSIGN v -> SignedDSIGN v a
SignedDSIGN
        (SigDSIGN MockDSIGN -> SignedDSIGN MockDSIGN toSign)
-> Gen (SigDSIGN MockDSIGN) -> Gen (SignedDSIGN MockDSIGN toSign)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> (Hash ShortHash () -> Word64 -> SigDSIGN MockDSIGN
SigMockDSIGN (Hash ShortHash () -> Word64 -> SigDSIGN MockDSIGN)
-> Gen (Hash ShortHash ()) -> Gen (Word64 -> SigDSIGN MockDSIGN)
forall (f :: * -> *) a b. Functor f => (a -> b) -> f a -> f b
<$> Gen (Hash ShortHash ())
forall a. Arbitrary a => Gen a
arbitrary Gen (Word64 -> SigDSIGN MockDSIGN)
-> Gen Word64 -> Gen (SigDSIGN MockDSIGN)
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)
    return BftFields{..}