{-# 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{..}